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 :: String -> Error -> String
unError s :: String
s = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
s (Maybe String -> String)
-> (Error -> Maybe String) -> Error -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Maybe String
forall a. Last a -> Maybe a
getLast
type Parser t = StateT [t] (Except Error)
runParser :: Parser t a -> [t] -> Either String (a, [t])
runParser :: Parser t a -> [t] -> Either String (a, [t])
runParser p :: Parser t a
p = Except String (a, [t]) -> Either String (a, [t])
forall e a. Except e a -> Either e a
runExcept (Except String (a, [t]) -> Either String (a, [t]))
-> ([t] -> Except String (a, [t])) -> [t] -> Either String (a, [t])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Error -> String)
-> Except Error (a, [t]) -> Except String (a, [t])
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept (String -> Error -> String
unError "runParser: parse error.") (Except Error (a, [t]) -> Except String (a, [t]))
-> ([t] -> Except Error (a, [t])) -> [t] -> Except String (a, [t])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser t a -> [t] -> Except Error (a, [t])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Parser t a
p
evalParser :: Parser t a -> [t] -> Either String a
evalParser :: Parser t a -> [t] -> Either String a
evalParser p :: Parser t a
p = Except String a -> Either String a
forall e a. Except e a -> Either e a
runExcept (Except String a -> Either String a)
-> ([t] -> Except String a) -> [t] -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Error -> String) -> Except Error a -> Except String a
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept (String -> Error -> String
unError "evalParser: parse error.") (Except Error a -> Except String a)
-> ([t] -> Except Error a) -> [t] -> Except String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser t a -> [t] -> Except Error a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Parser t a
p
errorE :: String -> Except Error a
errorE :: String -> Except Error a
errorE = Error -> Except Error a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Error -> Except Error a)
-> (String -> Error) -> String -> Except Error a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Error
forall a. Maybe a -> Last a
Last (Maybe String -> Error)
-> (String -> Maybe String) -> String -> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just
errorP :: String -> Parser t a
errorP :: String -> Parser t a
errorP = ([t] -> ExceptT Error Identity (a, [t])) -> Parser t a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (([t] -> ExceptT Error Identity (a, [t])) -> Parser t a)
-> (String -> [t] -> ExceptT Error Identity (a, [t]))
-> String
-> Parser t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT Error Identity (a, [t])
-> [t] -> ExceptT Error Identity (a, [t])
forall a b. a -> b -> a
const (ExceptT Error Identity (a, [t])
-> [t] -> ExceptT Error Identity (a, [t]))
-> (String -> ExceptT Error Identity (a, [t]))
-> String
-> [t]
-> ExceptT Error Identity (a, [t])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT Error Identity (a, [t])
forall a. String -> Except Error a
errorE
noteP :: String -> Maybe a -> Parser t a
noteP :: String -> Maybe a -> Parser t a
noteP s :: String
s = Parser t a -> (a -> Parser t a) -> Maybe a -> Parser t a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser t a
forall t a. String -> Parser t a
errorP String
s) a -> Parser t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
token :: Parser t t
token :: Parser t t
token = do
[t]
cs0 <- StateT [t] (Except Error) [t]
forall (m :: * -> *) s. Monad m => StateT s m s
get
case [t]
cs0 of
c :: t
c:cs :: [t]
cs -> do
[t] -> StateT [t] (Except Error) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put [t]
cs
t -> Parser t t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
c
[] ->
String -> Parser t t
forall t a. String -> Parser t a
errorP "token: end of input"
eof :: Parser t ()
eof :: Parser t ()
eof = do
[t]
cs <- StateT [t] (Except Error) [t]
forall (m :: * -> *) s. Monad m => StateT s m s
get
case [t]
cs of
[] -> () -> Parser t ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
_:_ -> String -> Parser t ()
forall t a. String -> Parser t a
errorP "eof: not empty input"
sink :: Parser t [t]
sink :: Parser t [t]
sink = do
[t]
cs <- Parser t [t]
forall (m :: * -> *) s. Monad m => StateT s m s
get
[t] -> StateT [t] (Except Error) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put []
[t] -> Parser t [t]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [t]
cs
satisfy' :: String
-> (t -> String)
-> (t -> Bool)
-> Parser t t
satisfy' :: String -> (t -> String) -> (t -> Bool) -> Parser t t
satisfy' n :: String
n ef :: t -> String
ef p :: t -> Bool
p = do
t
c <- Parser t t
forall t. Parser t t
token
String -> Maybe () -> Parser t ()
forall a t. String -> Maybe a -> Parser t a
noteP (String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ t -> String
ef t
c) (Maybe () -> Parser t ())
-> (Bool -> Maybe ()) -> Bool -> Parser t ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser t ()) -> Bool -> Parser t ()
forall a b. (a -> b) -> a -> b
$ t -> Bool
p t
c
t -> Parser t t
forall (m :: * -> *) a. Monad m => a -> m a
return t
c
satisfy :: (t -> Bool) -> Parser t t
satisfy :: (t -> Bool) -> Parser t t
satisfy p :: t -> Bool
p = do
t
c <- Parser t t
forall t. Parser t t
token
Bool -> StateT [t] (Except Error) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> StateT [t] (Except Error) ())
-> Bool -> StateT [t] (Except Error) ()
forall a b. (a -> b) -> a -> b
$ t -> Bool
p t
c
t -> Parser t t
forall (m :: * -> *) a. Monad m => a -> m a
return t
c
list :: Eq t => [t] -> Parser t [t]
list :: [t] -> Parser t [t]
list = (t -> StateT [t] (Except Error) t) -> [t] -> Parser t [t]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((t -> Bool) -> StateT [t] (Except Error) t
forall t. (t -> Bool) -> Parser t t
satisfy ((t -> Bool) -> StateT [t] (Except Error) t)
-> (t -> t -> Bool) -> t -> StateT [t] (Except Error) t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> t -> Bool
forall a. Eq a => a -> a -> Bool
(==))