module Text.Parser.List
( Parser, runParser, evalParser
, Error, errorE, errorP, noteP
, token, eof, sink, satisfy', satisfy, list
) where
import Control.Applicative (pure)
import Control.Monad (guard)
import Control.Monad.Trans.State.Strict (StateT (..), evalStateT, get, put)
import Control.Monad.Trans.Except (Except, runExcept, withExcept, throwE)
import Data.Monoid (Last (..))
import Data.Maybe (fromMaybe)
type Error = Last String
unError :: String -> Error -> String
unError s = fromMaybe s . getLast
type Parser t = StateT [t] (Except Error)
runParser :: Parser t a -> [t] -> Either String (a, [t])
runParser p = runExcept . withExcept (unError "runParser: parse error.") . runStateT p
evalParser :: Parser t a -> [t] -> Either String a
evalParser p = runExcept . withExcept (unError "evalParser: parse error.") . evalStateT p
errorE :: String -> Except Error a
errorE = throwE . Last . Just
errorP :: String -> Parser t a
errorP = StateT . const . errorE
noteP :: String -> Maybe a -> Parser t a
noteP s = maybe (errorP s) pure
token :: Parser t t
token = do
cs0 <- get
case cs0 of
c:cs -> do
put cs
pure c
[] ->
errorP "token: end of input"
eof :: Parser t ()
eof = do
cs <- get
case cs of
[] -> pure ()
_:_ -> errorP "eof: not empty input"
sink :: Parser t [t]
sink = do
cs <- get
put []
pure cs
satisfy' :: String
-> (t -> String)
-> (t -> Bool)
-> Parser t t
satisfy' n ef p = do
c <- token
noteP (n ++ ": " ++ ef c) . guard $ p c
return c
satisfy :: (t -> Bool) -> Parser t t
satisfy p = do
c <- token
guard $ p c
return c
list :: Eq t => [t] -> Parser t [t]
list = mapM (satisfy . (==))