content: 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         -- ^ Parser name to print when error
           -> (t -> String)  -- ^ Function to build error string
           -> (t -> Bool)    -- ^ Predicate to satisfy
           -> Parser t t     -- ^ Result parser
  satisfy' n ef p = do
    c <- token
    noteP (n ++ ": " ++ ef c) . guard $ p c
    return c
  
  -- | make satisfy parser with monoid-empty error.
  satisfy :: (t -> Bool) -> Parser t t
  satisfy p = do
    c <- token
    guard $ p c -- expect empty error
    return c
  
  list :: Eq t => [t] -> Parser t [t]
  list = mapM (satisfy . (==))
  