-- | This module contains the definitions for a generic parser, with -- running state. These are the parts that are shared between the State -- and StateLazy variations. Do not import this module directly, but only -- via T.P.Poly.State or T.P.Poly.StateLazy. module Text.ParserCombinators.Poly.StateParser ( -- * The Parser datatype Parser(P) -- datatype, instance of: Functor, Monad, PolyParse , Result(..) -- internal to the parser monad -- ** basic parsers , next -- :: Parser s t t , eof -- :: Parser s t () , satisfy -- :: (t->Bool) -> Parser s t t , onFail -- :: Parser s t a -> Parser s t a -> Parser s t a -- ** State-handling , stUpdate -- :: (s->s) -> Parser s t () , stQuery -- :: (s->a) -> Parser s t a , stGet -- :: Parser s t s -- ** re-parsing , reparse -- :: [t] -> Parser s t () ) where import Text.ParserCombinators.Poly.Base import Text.ParserCombinators.Poly.Result -- | This @Parser@ datatype is a fairly generic parsing monad with error -- reporting, and running state. -- It can be used for arbitrary token types, not just String input. -- (If you do not require a running state, use module Poly.Plain instead) newtype Parser s t a = P (s -> [t] -> Result ([t],s) a) instance Functor (Parser s t) where fmap f (P p) = P (\s-> fmap f . p s) instance Monad (Parser s t) where return x = P (\s ts-> Success (ts,s) x) fail e = P (\s ts-> Failure (ts,s) e) (P f) >>= g = P (\s-> continue . f s) where continue (Success (ts,s) x) = let (P g') = g x in g' s ts continue (Committed r) = Committed (continue r) continue (Failure tss e) = Failure tss e instance Commitment (Parser s t) where commit (P p) = P (\s-> Committed . squash . p s) where squash (Committed r) = squash r squash r = r (P p) `adjustErr` f = P (\s-> adjust . p s) where adjust (Failure zs e) = Failure zs (f e) adjust (Committed r) = Committed (adjust r) adjust good = good oneOf' = accum [] where accum errs [] = fail ("failed to parse any of the possible choices:\n" ++indent 2 (concatMap showErr (reverse errs))) accum errs ((e,P p):ps) = P (\s ts-> case p s ts of Failure _ err -> let (P p) = accum ((e,err):errs) ps in p s ts r@(Success _ a) -> r r@(Committed _) -> r ) showErr (name,err) = name++":\n"++indent 2 err infixl 6 `onFail` -- not sure about precedence 6? -- | @p `onFail` q@ means parse p, unless p fails, in which case -- parse q instead. -- Can be chained together to give multiple attempts to parse something. -- (Note that q could itself be a failing parser, e.g. to change the error -- message from that defined in p to something different.) -- However, a severe failure in p cannot be ignored. onFail :: Parser s t a -> Parser s t a -> Parser s t a (P p) `onFail` (P q) = P (\s ts-> continue s ts $ p s ts) where continue s ts (Failure _ _) = q s ts -- continue _ _ (Committed r) = r -- no, remain Committed continue _ _ r = r ------------------------------------------------------------------------ -- | Simply return the next token in the input tokenstream. next :: Parser s t t next = P (\s ts-> case ts of [] -> Failure ([],s) "Ran out of input (EOF)" (t:ts') -> Success (ts',s) t ) -- | Succeed if the end of file/input has been reached, fail otherwise. eof :: Parser s t () eof = P (\s ts-> case ts of [] -> Success ([],s) () (t:ts') -> Failure (ts,s) "Expected end of input (eof)" ) -- | Return the next token if it satisfies the given predicate. satisfy :: (t->Bool) -> Parser s t t satisfy pred = do { x <- next ; if pred x then return x else fail "Parse.satisfy: failed" } ------------------------------------------------------------------------ -- State handling -- | Update the internal state. stUpdate :: (s->s) -> Parser s t () stUpdate f = P (\s ts-> Success (ts, f s) ()) -- | Query the internal state. stQuery :: (s->a) -> Parser s t a stQuery f = P (\s ts-> Success (ts,s) (f s)) -- | Deliver the entire internal state. stGet :: Parser s t s stGet = P (\s ts-> Success (ts,s) s) ------------------------------------------------------------------------ -- | Push some tokens back onto the front of the input stream and reparse. -- This is useful e.g. for recursively expanding macros. When the -- user-parser recognises a macro use, it can lookup the macro -- expansion from the parse state, lex it, and then stuff the -- lexed expansion back down into the parser. reparse :: [t] -> Parser s t () reparse ts = P (\s inp-> Success ((ts++inp),s) ()) ------------------------------------------------------------------------