1{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} 2module Text.ParserCombinators.Poly.StateLazy 3 ( -- * The Parser datatype 4 Parser(P) -- datatype, instance of: Functor, Monad, PolyParse 5 , Result(..) -- internal to the parser monad 6 , runParser -- :: Parser s t a -> s -> [t] -> (Either String a, s, [t]) 7 -- ** Basic parsers 8 , next -- :: Parser s t t 9 , eof -- :: Parser s t () 10 , satisfy -- :: (t->Bool) -> Parser s t t 11 , onFail -- :: Parser s t a -> Parser s t a -> Parser s t a 12 , manyFinally -- :: Parser s t a -> Parser s t z -> Parser s t [a] 13 -- ** State-handling 14 , stUpdate -- :: (s->s) -> Parser s t () 15 , stQuery -- :: (s->a) -> Parser s t a 16 , stGet -- :: Parser s t s 17 -- ** Re-parsing 18 , reparse -- :: [t] -> Parser s t () 19 -- * Re-export all more general combinators 20 , module Text.ParserCombinators.Poly.Base 21 , module Control.Applicative 22 ) where 23 24 25import Text.ParserCombinators.Poly.Base hiding (manyFinally) 26import Text.ParserCombinators.Poly.Result 27import qualified Text.ParserCombinators.Poly.StateParser as P 28import Control.Applicative 29import qualified Control.Monad.Fail as Fail 30 31#if __GLASGOW_HASKELL__ 32import Control.Exception hiding (bracket) 33throwE :: String -> a 34throwE msg = throw (ErrorCall msg) 35#else 36throwE :: String -> a 37throwE msg = error msg 38#endif 39 40-- | The only differences between a State and a StateLazy parser are the 41-- instance of Applicative, and the type (and implementation) of runParser. 42-- We therefore need to /newtype/ the original Parser type, to allow it 43-- to have a different instance. 44newtype Parser s t a = P (P.Parser s t a) 45#ifdef __GLASGOW_HASKELL__ 46 deriving (Functor,Monad,Fail.MonadFail,Commitment) 47#else 48instance Functor (Parser s t) where 49 fmap f (P p) = P (fmap f p) 50instance Monad (Parser s t) where 51 return x = P (return x) 52 fail = Fail.fail 53 (P f) >>= g = P (f >>= (\(P g')->g') . g) 54instance Fail.MonadFail (Parser s t) where 55 fail e = P (fail e) 56instance Commitment (Parser s t) where 57 commit (P p) = P (commit p) 58 (P p) `adjustErr` f = P (p `adjustErr` f) 59#endif 60 61-- | Apply a parser to an input token sequence. 62runParser :: Parser s t a -> s -> [t] -> (a, s, [t]) 63runParser (P (P.P p)) = \s -> fromResult . p s 64 where 65 fromResult :: Result (z,s) a -> (a, s, z) 66 fromResult (Success (z,s) a) = (a, s, z) 67 fromResult (Failure _ e) = throwE e 68 fromResult (Committed r) = fromResult r 69 70 71instance Applicative (Parser s t) where 72 pure f = return f 73 -- Apply a parsed function to a parsed value. This version 74 -- is strict in the result of the function parser, but 75 -- lazy in the result of the argument parser. (Argument laziness is 76 -- the distinctive feature over other implementations.) 77 (P (P.P pf)) <*> px = P (P.P (\s-> continue . pf s)) 78 where 79 continue (Success (z,s) f) = let (x,s',z') = runParser px s z 80 in Success (z',s') (f x) 81 continue (Failure zs e) = Failure zs e 82 continue (Committed r) = Committed (continue r) 83#if defined(GLASGOW_HASKELL) && GLASGOW_HASKELL > 610 84 p <* q = p `discard` q 85#endif 86 87instance Alternative (Parser s t) where 88 empty = fail "no parse" 89 p <|> q = p `onFail` q 90 91instance PolyParse (Parser s t) 92 93------------------------------------------------------------------------ 94 95-- | Simply return the next token in the input tokenstream. 96next :: Parser s t t 97next = P P.next 98 99-- | Succeed if the end of file/input has been reached, fail otherwise. 100eof :: Parser s t () 101eof = P P.eof 102 103-- | Return the next token if it satisfies the given predicate. 104satisfy :: (t->Bool) -> Parser s t t 105satisfy = P . P.satisfy 106 107-- | @p `onFail` q@ means parse p, unless p fails, in which case 108-- parse q instead. 109-- Can be chained together to give multiple attempts to parse something. 110-- (Note that q could itself be a failing parser, e.g. to change the error 111-- message from that defined in p to something different.) 112-- However, a severe failure in p cannot be ignored. 113onFail :: Parser s t a -> Parser s t a -> Parser s t a 114onFail (P a) (P b) = P (a `P.onFail` b) 115 116-- | Push some tokens back onto the front of the input stream and reparse. 117-- This is useful e.g. for recursively expanding macros. When the 118-- user-parser recognises a macro use, it can lookup the macro 119-- expansion from the parse state, lex it, and then stuff the 120-- lexed expansion back down into the parser. 121reparse :: [t] -> Parser s t () 122reparse = P . P.reparse 123 124------------------------------------------------------------------------ 125-- State handling 126 127-- | Update the internal state. 128stUpdate :: (s->s) -> Parser s t () 129stUpdate f = P (P.stUpdate f) 130 131-- | Query the internal state. 132stQuery :: (s->a) -> Parser s t a 133stQuery f = P (P.stQuery f) 134 135-- | Deliver the entire internal state. 136stGet :: Parser s t s 137stGet = P (P.stGet) 138 139------------------------------------------------------------------------ 140 141 142manyFinally :: Parser s t a -> Parser s t z -> Parser s t [a] 143{- 144manyFinally pp@(P p) pt@(P t) = P (\s ts -> item s ts (p s ts)) 145 where 146 item _ _ (Success ts s x) = success ts s x 147 item s ts (Failure _ _ e) = terminate (t s ts) 148 item s ts (Committed r) = Committed (within r) 149 150 success ts s x = 151 let (tail,s',ts') = runParser (manyFinally pp pt) s ts 152 in Success ts' s' (x:tail) 153 154 terminate (Success ts s _) = Success ts s [] 155 terminate (Failure ts s e) = Failure ts s e 156 terminate (Committed r) = Committed (terminate r) 157 158 within (Success ts s x) = success ts s x 159 within (Failure ts s e) = Failure ts s e 160 within (Committed r) = within r 161-} 162 163manyFinally p z = 164 (do x <- p; return (x:) `apply` manyFinally p z) 165 `onFail` 166 (do z; return []) 167 `onFail` 168 oneOf' [ ("item in sequence", (do p; return [])) 169 , ("sequence terminator", (do z; return [])) ] 170 171------------------------------------------------------------------------ 172