module Text.ParserCombinators.Poly.Plain
(
Parser(P)
, runParser
, next
, satisfy
, reparse
, module Text.ParserCombinators.Poly.Base
) where
import Text.ParserCombinators.Poly.Base
newtype Parser t a = P ([t] -> (EitherE String a, [t]))
type EitherE a b = Either (Bool,a) b
runParser :: Parser t a -> [t] -> (Either String a, [t])
runParser (P p) =
(\ (e,ts)-> (case e of {Left (_,m)->Left m; Right m->Right m}, ts) )
. p
instance Functor (Parser t) where
fmap f (P p) = P (\ts-> case p ts of
(Left msg, ts') -> (Left msg, ts')
(Right x, ts') -> (Right (f x), ts'))
instance Monad (Parser t) where
return x = P (\ts-> (Right x, ts))
(P f) >>= g = P (\ts-> case f ts of
(Left msg, ts') -> (Left msg, ts')
(Right x, ts') -> let (P g') = g x in g' ts')
fail e = P (\ts-> (Left (False,e), ts))
instance PolyParse (Parser t) where
commit (P p) = P (\ts-> case p ts of
(Left (_,e), ts') -> (Left (True,e), ts')
right -> right )
(P p) `adjustErr` f = P (\ts-> case p ts of
(Left (b,msg), ts') -> (Left (b,(f msg)), ts')
right -> right )
(P p) `onFail` (P q) = P (\ts-> case p ts of
r@(Left (True,_), _) -> r
(Left _, _) -> q ts
right -> right )
oneOf' = accum []
where accum errs [] =
case filter isBad errs of
[] -> fail ("failed to parse any of the possible choices:\n"
++indent 2 (concatMap showErr (reverse errs)))
[(_,(_,e))] -> failBad e
es -> failBad ("one of the following failures occurred:\n"
++indent 2 (concatMap showErr (reverse es)))
accum errs ((e,P p):ps) =
P (\ts-> case p ts of
(Left err,_) -> let (P p) = accum ((e,err):errs) ps
in p ts
right -> right )
showErr (name,(_,err)) = name++":\n"++indent 2 err
isBad (_,(b,_)) = b
next :: Parser t t
next = P (\ts-> case ts of
[] -> (Left (False,"Ran out of input (EOF)"), [])
(t:ts') -> (Right t, ts') )
satisfy :: (t->Bool) -> Parser t t
satisfy pred = do { x <- next
; if pred x then return x else fail "Parse.satisfy: failed"
}
reparse :: [t] -> Parser t ()
reparse ts = P (\inp-> (Right (), ts++inp))