module Network.HTTP.Lucu.Parser
( Parser(..)
- , parse -- Parser a -> ByteString -> Maybe (a, ByteString)
+ , ParserResult(..)
+ , parse -- Parser a -> ByteString -> ParserResult a
, anyChar -- Parser Char
, satisfy -- (Char -> Bool) -> Parser Char
, char -- Char -> Parser Char
import Data.ByteString.Lazy.Char8 (ByteString)
data Parser a = Parser {
- runParser :: State ByteString (Maybe a)
+ runParser :: State ByteString (ParserResult a)
}
+data ParserResult a = Success a
+ | IllegalInput -- 受理出來ない入力があった
+ | ReachedEOF -- 限界を越えて讀まうとした
+
-- (>>=) :: Parser a -> (a -> Parser b) -> Parser b
instance Monad Parser where
p >>= f = Parser $ do saved <- get -- 失敗した時の爲に状態を保存
result <- runParser p
case result of
- Just a -> runParser (f a)
- Nothing -> do put saved -- 状態を復歸
- return Nothing
- return = Parser . return . Just
- fail _ = Parser $ return Nothing
+ Success a -> runParser (f a)
+ IllegalInput -> do put saved -- 状態を復歸
+ return IllegalInput
+ ReachedEOF -> return ReachedEOF
+ return = Parser . return . Success
+ fail _ = Parser $ return IllegalInput
-parse :: Parser a -> ByteString -> Maybe (a, ByteString)
-parse p input = case runState (runParser p) input of
- (Just a , input') -> Just (a, input')
- (Nothing, _ ) -> Nothing
+parse :: Parser a -> ByteString -> (ParserResult a, ByteString)
+parse p input = runState (runParser p) input
anyChar :: Parser Char
anyChar = Parser $ do input <- get
if B.null input then
- return Nothing
+ return ReachedEOF
else
do let c = B.head input
put (B.tail input)
- return (Just c)
+ return (Success c)
satisfy :: (Char -> Bool) -> Parser Char
f <|> g = Parser $ do saved <- get -- 状態を保存
result <- runParser f
case result of
- Just a -> return (Just a)
- Nothing -> do put saved -- 状態を復歸
- runParser g
+ Success a -> return $ Success a
+ IllegalInput -> do put saved -- 状態を復歸
+ runParser g
+ ReachedEOF -> return ReachedEOF
oneOf :: [Char] -> Parser Char