( Parser(..)
, ParserResult(..)
- , parse -- Parser a -> ByteString -> ParserResult a
+ , 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
, 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 (ParserResult a)
+ runParser :: State ParserState (ParserResult a)
}
+type ParserState = (ByteString, IsEOFFatal)
+
+type IsEOFFatal = Bool
+
data ParserResult a = Success a
| IllegalInput -- 受理出來ない入力があった
| ReachedEOF -- 限界を越えて讀まうとした
-- (>>=) :: 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
Success a -> runParser (f a)
IllegalInput -> do put saved -- 状態を復歸
return IllegalInput
- ReachedEOF -> return ReachedEOF
+ ReachedEOF -> if isEOFFatal then
+ return ReachedEOF
+ else
+ do put saved
+ return IllegalInput
return = Parser . return . Success
fail _ = Parser $ return IllegalInput
parse :: Parser a -> ByteString -> (ParserResult a, ByteString)
-parse p input = runState (runParser p) input
+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 ReachedEOF
else
do let c = B.head input
- put (B.tail input)
+ 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
satisfy f = do c <- anyChar
unless (f c) (fail "")
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
Success a -> return $ Success a
IllegalInput -> do put saved -- 状態を復歸
runParser g
- ReachedEOF -> return ReachedEOF
+ ReachedEOF -> if isEOFFatal then
+ return ReachedEOF
+ else
+ do put saved
+ runParser g
oneOf :: [Char] -> Parser Char
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 ' '