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