X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FParser.hs;h=90c52696fbb4293e95849e5335758d7a255913bd;hb=1196f43ecedbb123515065f0440844864af906fb;hp=44cf1558584932f6f71f59609069b3da4a5fa949;hpb=83db536d11e8efb26848318ad4514b825f412460;p=Lucu.git diff --git a/Network/HTTP/Lucu/Parser.hs b/Network/HTTP/Lucu/Parser.hs index 44cf155..90c5269 100644 --- a/Network/HTTP/Lucu/Parser.hs +++ b/Network/HTTP/Lucu/Parser.hs @@ -33,6 +33,7 @@ module Network.HTTP.Lucu.Parser , char , string , (<|>) + , choice , oneOf , digit , hexDigit @@ -51,9 +52,8 @@ module Network.HTTP.Lucu.Parser where import Control.Monad.State.Strict -import Data.ByteString.Base (LazyByteString) -import Data.ByteString.Lazy () -import qualified Data.ByteString.Lazy.Char8 as B +import qualified Data.ByteString.Lazy as Lazy (ByteString) +import qualified Data.ByteString.Lazy.Char8 as B hiding (ByteString) -- |@'Parser' a@ is obviously a parser which parses and returns @a@. newtype Parser a = Parser { @@ -63,7 +63,7 @@ newtype Parser a = Parser { data ParserState = PST { - pstInput :: LazyByteString + pstInput :: Lazy.ByteString , pstIsEOFFatal :: !Bool } deriving (Eq, Show) @@ -95,7 +95,7 @@ failP = fail undefined -- |@'parse' p bstr@ parses @bstr@ with @p@ and returns @(# result, -- remaining #)@. -parse :: Parser a -> LazyByteString -> (# ParserResult a, LazyByteString #) +parse :: Parser a -> Lazy.ByteString -> (# ParserResult a, Lazy.ByteString #) parse p input -- input は lazy である必要有り。 = p `seq` let (result, state') = runState (runParser p) (PST input True) @@ -103,7 +103,7 @@ parse p input -- input は lazy である必要有り。 result `seq` (# result, pstInput state' #) -- pstInput state' も lazy である必要有り。 -- |@'parseStr' p str@ packs @str@ and parses it. -parseStr :: Parser a -> String -> (# ParserResult a, LazyByteString #) +parseStr :: Parser a -> String -> (# ParserResult a, Lazy.ByteString #) parseStr p input = p `seq` -- input は lazy である必要有り。 parse p (B.pack input) @@ -167,7 +167,7 @@ infixr 0 <|> (<|>) :: Parser a -> Parser a -> Parser a f <|> g = f `seq` g `seq` - Parser $! do saved <- get -- 状態を保存 + Parser $! do saved <- get -- 状態を保存 result <- runParser f case result of Success a -> return $! Success a @@ -180,13 +180,26 @@ f <|> g runParser g +choice :: [Parser a] -> Parser a +choice = foldl (<|>) failP + + oneOf :: [Char] -> Parser Char oneOf = foldl (<|>) failP . map char notFollowedBy :: Parser a -> Parser () -notFollowedBy p = p `seq` - (p >> failP) <|> return () +notFollowedBy p + = p `seq` + Parser $! do saved <- get -- 状態を保存 + result <- runParser p + case result of + Success _ -> do put saved -- 状態を復歸 + return IllegalInput + IllegalInput -> do put saved -- 状態を復歸 + return $! Success () + ReachedEOF -> do put saved -- 状態を復歸 + return $! Success () digit :: Parser Char