1module Text.ParserCombinators.Poly.Text 2 ( -- * The Parser datatype 3 Parser(P) 4 , Result(..) 5 , runParser 6 -- ** Basic parsers 7 , next 8 , eof 9 , satisfy 10 , onFail 11 -- ** Derived parsers (but implemented more efficiently) 12 , manySatisfy 13 , many1Satisfy 14 -- ** Re-parsing 15 , reparse 16 -- * Re-export all more general combinators 17 , module Text.ParserCombinators.Poly.Base 18 , module Control.Applicative 19 ) where 20 21 22import Text.ParserCombinators.Poly.Base 23import Text.ParserCombinators.Poly.Result 24import qualified Data.Text.Lazy as T 25import Data.Text.Lazy (Text) 26import Control.Applicative 27import qualified Control.Monad.Fail as Fail 28 29-- | This @Parser@ datatype is a specialised parsing monad with error 30-- reporting. Whereas the standard version can be used for arbitrary 31-- token types, this version is specialised to Text input only. 32newtype Parser a = P (Text -> Result Text a) 33 34-- | Apply a parser to an input token sequence. 35runParser :: Parser a -> Text -> (Either String a, Text) 36runParser (P p) = resultToEither . p 37 38instance Functor Parser where 39 fmap f (P p) = P (fmap f . p) 40 41instance Monad Parser where 42 return = pure 43 (P f) >>= g = P (continue . f) 44 where 45 continue (Success ts x) = let (P g') = g x in g' ts 46 continue (Committed r) = Committed (continue r) 47 continue (Failure ts e) = Failure ts e 48 49#if !MIN_VERSION_base(4,13,0) 50 fail = Fail.fail 51#endif 52 53instance Fail.MonadFail Parser where 54 fail e = P (\ts-> Failure ts e) 55 56instance Commitment Parser where 57 commit (P p) = P (Committed . squash . p) 58 where 59 squash (Committed r) = squash r 60 squash r = r 61 (P p) `adjustErr` f = P (adjust . p) 62 where 63 adjust (Failure z e) = Failure z (f e) 64 adjust (Committed r) = Committed (adjust r) 65 adjust good = good 66 67 oneOf' = accum [] 68 where accum errs [] = 69 fail ("failed to parse any of the possible choices:\n" 70 ++indent 2 (concatMap showErr (reverse errs))) 71 accum errs ((e,P p):ps) = 72 P (\ts-> case p ts of 73 Failure _ err -> 74 let (P p') = accum ((e,err):errs) ps 75 in p' ts 76 r@(Success _ _) -> r 77 r@(Committed _) -> r ) 78 showErr (name,err) = name++":\n"++indent 2 err 79 80instance Applicative Parser where 81 pure x = P (\ts-> Success ts x) 82 pf <*> px = do { f <- pf; x <- px; return (f x) } 83#if defined(GLASGOW_HASKELL) && GLASGOW_HASKELL > 610 84 p <* q = p `discard` q 85#endif 86 87instance Alternative Parser where 88 empty = fail "no parse" 89 p <|> q = p `onFail` q 90 91instance PolyParse Parser 92 93------------------------------------------------------------------------ 94 95-- | Simply return the next token in the input tokenstream. 96next :: Parser Char 97next = P (\bs-> case T.uncons bs of 98 Nothing -> Failure bs "Ran out of input (EOF)" 99 Just (c, bs') -> Success bs' c ) 100 101-- | Succeed if the end of file/input has been reached, fail otherwise. 102eof :: Parser () 103eof = P (\bs -> if T.null bs 104 then Success bs () 105 else Failure bs "Expected end of input (EOF)" ) 106 107-- | Return the next token if it satisfies the given predicate. 108satisfy :: (Char -> Bool) -> Parser Char 109satisfy f = do { x <- next 110 ; if f x then return x else fail "Parse.satisfy: failed" 111 } 112 113-- | @p `onFail` q@ means parse p, unless p fails, in which case 114-- parse q instead. 115-- Can be chained together to give multiple attempts to parse something. 116-- (Note that q could itself be a failing parser, e.g. to change the error 117-- message from that defined in p to something different.) 118-- However, a severe failure in p cannot be ignored. 119onFail :: Parser a -> Parser a -> Parser a 120(P p) `onFail` (P q) = P (\ts-> continue ts $ p ts) 121 where continue ts (Failure _ _) = q ts 122 -- continue _ (Committed r) = r -- no, remain Committed 123 continue _ r = r 124 125------------------------------------------------------------------------ 126 127-- | @manySatisfy p@ is a more efficient fused version of @many (satisfy p)@ 128manySatisfy :: (Char->Bool) -> Parser Text 129manySatisfy f = P (\bs-> let (pre,suf) = T.span f bs in Success suf pre) 130 131-- | @many1Satisfy p@ is a more efficient fused version of @many1 (satisfy p)@ 132many1Satisfy :: (Char->Bool) -> Parser Text 133many1Satisfy f = do x <- manySatisfy f 134 if T.null x then fail "Parse.many1Satisfy: failed" 135 else return x 136 137------------------------------------------------------------------------ 138 139-- | Push some tokens back onto the front of the input stream and reparse. 140-- This is useful e.g. for recursively expanding macros. When the 141-- user-parser recognises a macro use, it can lookup the macro 142-- expansion from the parse state, lex it, and then stuff the 143-- lexed expansion back down into the parser. 144reparse :: Text -> Parser () 145reparse ts = P (\inp-> Success (ts `T.append` inp) ()) 146 147------------------------------------------------------------------------ 148