    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 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 :: forall t a. Parser t a -> [t] -> Either String (a, [t])
    runParser 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 String
    "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 :: forall t a. Parser t a -> [t] -> Either String a
    evalParser 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 String
    "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 :: forall a. String -> Except Error a
    errorE = Error -> ExceptT Error Identity a
    forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
    throwE (Error -> ExceptT Error Identity a)
    -> (String -> Error) -> String -> ExceptT Error Identity 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 :: forall t a. String -> Parser t a
    errorP = ([t] -> Except Error (a, [t]))
    -> StateT [t] (ExceptT Error Identity) a
    forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
    StateT (([t] -> Except Error (a, [t]))
     -> StateT [t] (ExceptT Error Identity) a)
    -> (String -> [t] -> Except Error (a, [t]))
    -> String
    -> StateT [t] (ExceptT Error Identity) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Except Error (a, [t]) -> [t] -> Except Error (a, [t])
    forall a b. a -> b -> a
    const (Except Error (a, [t]) -> [t] -> Except Error (a, [t]))
    -> (String -> Except Error (a, [t]))
    -> String
    -> [t]
    -> Except Error (a, [t])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Except Error (a, [t])
    forall a. String -> Except Error a
    errorE

    noteP :: String -> Maybe a -> Parser t a
    noteP :: forall a t. String -> Maybe a -> Parser t a
    noteP 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 a. a -> StateT [t] (ExceptT Error Identity) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure

    token :: Parser t t
    token :: forall t. Parser t t
    token = do
      cs0 <- StateT [t] (ExceptT Error Identity) [t]
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
      case cs0 of
        t
    c:[t]
    cs  ->  do
          [t] -> StateT [t] (ExceptT Error Identity) ()
    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
    put [t]
    cs
          t -> StateT [t] (ExceptT Error Identity) t
    forall a. a -> StateT [t] (ExceptT Error Identity) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure t
    c
        []    ->
          String -> StateT [t] (ExceptT Error Identity) t
    forall t a. String -> Parser t a
    errorP String
    "token: end of input"

    eof :: Parser t ()
    eof :: forall t. Parser t ()
    eof = do
      cs <- StateT [t] (ExceptT Error Identity) [t]
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
      case cs of
        []   ->  () -> StateT [t] (ExceptT Error Identity) ()
    forall a. a -> StateT [t] (ExceptT Error Identity) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
        t
    _:[t]
    _  ->  String -> StateT [t] (ExceptT Error Identity) ()
    forall t a. String -> Parser t a
    errorP String
    "eof: not empty input"

    sink :: Parser t [t]
    sink :: forall t. Parser t [t]
    sink = do
      cs <- StateT [t] (ExceptT Error Identity) [t]
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
      put []
      pure cs

    satisfy' :: String         -- ^ Parser name to print when error
             -> (t -> String)  -- ^ Function to build error string
             -> (t -> Bool)    -- ^ Predicate to satisfy
             -> Parser t t     -- ^ Result parser
    satisfy' :: forall t. String -> (t -> String) -> (t -> Bool) -> Parser t t
    satisfy' String
    n t -> String
    ef t -> Bool
    p = do
      c <- Parser t t
    forall t. Parser t t
    token
      noteP (n ++ ": " ++ ef c) . guard $ p c
      return c

    -- | make satisfy parser with monoid-empty error.
    satisfy :: (t -> Bool) -> Parser t t
    satisfy :: forall t. (t -> Bool) -> Parser t t
    satisfy t -> Bool
    p = do
      c <- Parser t t
    forall t. Parser t t
    token
      guard $ p c -- expect empty error
      return c

    list :: Eq t => [t] -> Parser t [t]
    list :: forall t. Eq t => [t] -> Parser t [t]
    list = (t -> StateT [t] (ExceptT Error Identity) t)
    -> [t] -> StateT [t] (ExceptT Error Identity) [t]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((t -> Bool) -> StateT [t] (ExceptT Error Identity) t
    forall t. (t -> Bool) -> Parser t t
    satisfy ((t -> Bool) -> StateT [t] (ExceptT Error Identity) t)
    -> (t -> t -> Bool) -> t -> StateT [t] (ExceptT Error Identity) t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . t -> t -> Bool
    forall a. Eq a => a -> a -> Bool
    (==))