module Network.HTTP.Lucu.Parser
( Parser(..)
- , parse -- Parser a -> ByteString -> Maybe (a, ByteString)
+ , ParserResult(..)
+
+ , parse -- Parser a -> ByteString -> (ParserResult a, ByteString)
+ , parseStr -- Parser a -> String -> (ParserResult a, ByteString)
+
, anyChar -- Parser Char
+ , eof -- Parser ()
+ , allowEOF -- Parser a -> Parser a
, satisfy -- (Char -> Bool) -> Parser Char
, char -- Char -> Parser Char
, string -- String -> Parser String
, (<|>) -- Parser a -> Parser a -> Parser a
, oneOf -- [Char] -> Parser Char
, digit -- Parser Char
+ , hexDigit -- Parser Char
, notFollowedBy -- Parser a -> Parser ()
, many -- Parser a -> Parser [a]
, many1 -- Parser a -> Parser [a]
, manyTill -- Parser a -> Parser end -> Parser [a]
, many1Till -- Parser a -> Parser end -> Parser [a]
, option -- a -> Parser a -> Parser a
+ , sepBy -- Parser a -> Parser sep -> Parser [a]
+ , sepBy1 -- Parser a -> Parser sep -> Parser [a]
+
, sp -- Parser Char
, ht -- Parser Char
, crlf -- Parser String
import Data.ByteString.Lazy.Char8 (ByteString)
data Parser a = Parser {
- runParser :: State ByteString (Maybe a)
+ runParser :: State ParserState (ParserResult a)
}
+type ParserState = (ByteString, IsEOFFatal)
+
+type IsEOFFatal = Bool
+
+data ParserResult a = Success a
+ | IllegalInput -- 受理出來ない入力があった
+ | ReachedEOF -- 限界を越えて讀まうとした
+ deriving (Eq, Show)
+
-- (>>=) :: Parser a -> (a -> Parser b) -> Parser b
instance Monad Parser where
- p >>= f = Parser $ do saved <- get -- 失敗した時の爲に状態を保存
+ p >>= f = Parser $ do saved@(_, isEOFFatal) <- 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 -> if isEOFFatal then
+ return ReachedEOF
+ else
+ do put saved
+ return IllegalInput
+ 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 = let (result, (input', _)) = runState (runParser p) (input, True)
+ in
+ (result, input')
+
+
+parseStr :: Parser a -> String -> (ParserResult a, ByteString)
+parseStr p input = parse p $ B.pack input
anyChar :: Parser Char
-anyChar = Parser $ do input <- get
+anyChar = Parser $ do (input, isEOFFatal) <- get
if B.null input then
- return Nothing
+ return ReachedEOF
else
do let c = B.head input
- put (B.tail input)
- return (Just c)
+ put (B.tail input, isEOFFatal)
+ return (Success c)
+
+
+eof :: Parser ()
+eof = Parser $ do (input, _) <- get
+ if B.null input then
+ return $ Success ()
+ else
+ return IllegalInput
+
+
+allowEOF :: Parser a -> Parser a
+allowEOF f = Parser $ do (input, isEOFFatal) <- get
+ put (input, False)
+
+ result <- runParser f
+
+ (input', _) <- get
+ put (input', isEOFFatal)
+
+ return result
satisfy :: (Char -> Bool) -> Parser Char
infixr 0 <|>
(<|>) :: Parser a -> Parser a -> Parser a
-f <|> g = Parser $ do saved <- get -- 状態を保存
+f <|> g = Parser $ do saved@(_, isEOFFatal) <- 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 -> if isEOFFatal then
+ return ReachedEOF
+ else
+ do put saved
+ runParser g
oneOf :: [Char] -> Parser Char
digit :: Parser Char
-digit = oneOf "0123456789"
+digit = do c <- anyChar
+ if c >= '0' && c <= '9' then
+ return c
+ else
+ fail ""
+
+
+hexDigit :: Parser Char
+hexDigit = do c <- anyChar
+ if (c >= '0' && c <= '9') ||
+ (c >= 'a' && c <= 'f') ||
+ (c >= 'A' && c <= 'F') then
+ return c
+ else
+ fail ""
many :: Parser a -> Parser [a]
option def p = p <|> return def
+sepBy :: Parser a -> Parser sep -> Parser [a]
+sepBy p sep = sepBy1 p sep <|> return []
+
+
+sepBy1 :: Parser a -> Parser sep -> Parser [a]
+sepBy1 p sep = do x <- p
+ xs <- many $ sep >> p
+ return (x:xs)
+
+
sp :: Parser Char
sp = char ' '