module Text.ParserCombinators.Poly.StateText
(
Parser(P)
, Result(..)
, runParser
, next
, eof
, satisfy
, onFail
, manySatisfy
, many1Satisfy
, stUpdate
, stQuery
, stGet
, reparse
, module Text.ParserCombinators.Poly.Base
, module Control.Applicative
) where
import Text.ParserCombinators.Poly.Base
import Text.ParserCombinators.Poly.Result
import qualified Data.Text.Lazy as T
import Data.Text.Lazy (Text)
import Control.Applicative
import qualified Control.Monad.Fail as Fail
newtype Parser s a = P (s -> Text -> Result (Text,s) a)
runParser :: Parser s a -> s -> Text -> (Either String a, s, Text)
runParser :: forall s a. Parser s a -> s -> Text -> (Either String a, s, Text)
runParser (P s -> Text -> Result (Text, s) a
p) = \s
s -> forall {a} {c} {b}. (a, (c, b)) -> (a, b, c)
reTuple forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall z a. Result z a -> (Either String a, z)
resultToEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Text -> Result (Text, s) a
p s
s
where
reTuple :: (a, (c, b)) -> (a, b, c)
reTuple (a
either, (c
z,b
s)) = (a
either, b
s, c
z)
instance Functor (Parser s) where
fmap :: forall a b. (a -> b) -> Parser s a -> Parser s b
fmap a -> b
f (P s -> Text -> Result (Text, s) a
p) = forall s a. (s -> Text -> Result (Text, s) a) -> Parser s a
P (\s
s-> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Text -> Result (Text, s) a
p s
s)
instance Monad (Parser s) where
return :: forall a. a -> Parser s a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
(P s -> Text -> Result (Text, s) a
f) >>= :: forall a b. Parser s a -> (a -> Parser s b) -> Parser s b
>>= a -> Parser s b
g = forall s a. (s -> Text -> Result (Text, s) a) -> Parser s a
P (\s
s-> Result (Text, s) a -> Result (Text, s) b
continue forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Text -> Result (Text, s) a
f s
s)
where
continue :: Result (Text, s) a -> Result (Text, s) b
continue (Success (Text
ts,s
s) a
x) = let (P s -> Text -> Result (Text, s) b
g') = a -> Parser s b
g a
x in s -> Text -> Result (Text, s) b
g' s
s Text
ts
continue (Committed Result (Text, s) a
r) = forall z a. Result z a -> Result z a
Committed (Result (Text, s) a -> Result (Text, s) b
continue Result (Text, s) a
r)
continue (Failure (Text, s)
ts String
e) = forall z a. z -> String -> Result z a
Failure (Text, s)
ts String
e
#if !MIN_VERSION_base(4,13,0)
fail = Fail.fail
#endif
instance Fail.MonadFail (Parser s) where
fail :: forall a. String -> Parser s a
fail String
e = forall s a. (s -> Text -> Result (Text, s) a) -> Parser s a
P (\s
s Text
ts-> forall z a. z -> String -> Result z a
Failure (Text
ts,s
s) String
e)
instance Commitment (Parser s) where
commit :: forall a. Parser s a -> Parser s a
commit (P s -> Text -> Result (Text, s) a
p) = forall s a. (s -> Text -> Result (Text, s) a) -> Parser s a
P (\s
s-> forall z a. Result z a -> Result z a
Committed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall z a. Result z a -> Result z a
squash forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Text -> Result (Text, s) a
p s
s)
where
squash :: Result z a -> Result z a
squash (Committed Result z a
r) = Result z a -> Result z a
squash Result z a
r
squash Result z a
r = Result z a
r
(P s -> Text -> Result (Text, s) a
p) adjustErr :: forall a. Parser s a -> (String -> String) -> Parser s a
`adjustErr` String -> String
f = forall s a. (s -> Text -> Result (Text, s) a) -> Parser s a
P (\s
s-> forall z a. Result z a -> Result z a
adjust forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Text -> Result (Text, s) a
p s
s)
where
adjust :: Result z a -> Result z a
adjust (Failure z
z String
e) = forall z a. z -> String -> Result z a
Failure z
z (String -> String
f String
e)
adjust (Committed Result z a
r) = forall z a. Result z a -> Result z a
Committed (Result z a -> Result z a
adjust Result z a
r)
adjust Result z a
good = Result z a
good
oneOf' :: forall a. [(String, Parser s a)] -> Parser s a
oneOf' = forall {s} {a}.
[(String, String)] -> [(String, Parser s a)] -> Parser s a
accum []
where accum :: [(String, String)] -> [(String, Parser s a)] -> Parser s a
accum [(String, String)]
errs [] =
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"failed to parse any of the possible choices:\n"
forall a. [a] -> [a] -> [a]
++Int -> String -> String
indent Int
2 (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String) -> String
showErr (forall a. [a] -> [a]
reverse [(String, String)]
errs)))
accum [(String, String)]
errs ((String
e,P s -> Text -> Result (Text, s) a
p):[(String, Parser s a)]
ps) =
forall s a. (s -> Text -> Result (Text, s) a) -> Parser s a
P (\s
s Text
ts-> case s -> Text -> Result (Text, s) a
p s
s Text
ts of
Failure (Text, s)
_ String
err ->
let (P s -> Text -> Result (Text, s) a
p') = [(String, String)] -> [(String, Parser s a)] -> Parser s a
accum ((String
e,String
err)forall a. a -> [a] -> [a]
:[(String, String)]
errs) [(String, Parser s a)]
ps
in s -> Text -> Result (Text, s) a
p' s
s Text
ts
r :: Result (Text, s) a
r@(Success (Text, s)
_ a
_) -> Result (Text, s) a
r
r :: Result (Text, s) a
r@(Committed Result (Text, s) a
_) -> Result (Text, s) a
r )
showErr :: (String, String) -> String
showErr (String
name,String
err) = String
nameforall a. [a] -> [a] -> [a]
++String
":\n"forall a. [a] -> [a] -> [a]
++Int -> String -> String
indent Int
2 String
err
instance Applicative (Parser s) where
pure :: forall a. a -> Parser s a
pure a
x = forall s a. (s -> Text -> Result (Text, s) a) -> Parser s a
P (\s
s Text
ts-> forall z a. z -> a -> Result z a
Success (Text
ts,s
s) a
x)
Parser s (a -> b)
pf <*> :: forall a b. Parser s (a -> b) -> Parser s a -> Parser s b
<*> Parser s a
px = do { a -> b
f <- Parser s (a -> b)
pf; a
x <- Parser s a
px; forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
x) }
#if defined(GLASGOW_HASKELL) && GLASGOW_HASKELL > 610
p <* q = p `discard` q
#endif
instance Alternative (Parser s) where
empty :: forall a. Parser s a
empty = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no parse"
Parser s a
p <|> :: forall a. Parser s a -> Parser s a -> Parser s a
<|> Parser s a
q = Parser s a
p forall s a. Parser s a -> Parser s a -> Parser s a
`onFail` Parser s a
q
instance PolyParse (Parser s)
next :: Parser s Char
next :: forall s. Parser s Char
next = forall s a. (s -> Text -> Result (Text, s) a) -> Parser s a
P (\s
s Text
bs-> case Text -> Maybe (Char, Text)
T.uncons Text
bs of
Maybe (Char, Text)
Nothing -> forall z a. z -> String -> Result z a
Failure (Text
bs,s
s) String
"Ran out of input (EOF)"
Just (Char
c, Text
bs') -> forall z a. z -> a -> Result z a
Success (Text
bs',s
s) Char
c )
eof :: Parser s ()
eof :: forall s. Parser s ()
eof = forall s a. (s -> Text -> Result (Text, s) a) -> Parser s a
P (\s
s Text
bs -> if Text -> Bool
T.null Text
bs
then forall z a. z -> a -> Result z a
Success (Text
bs,s
s) ()
else forall z a. z -> String -> Result z a
Failure (Text
bs,s
s) String
"Expected end of input (EOF)" )
satisfy :: (Char -> Bool) -> Parser s Char
satisfy :: forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
f = do { Char
x <- forall s. Parser s Char
next
; if Char -> Bool
f Char
x then forall (m :: * -> *) a. Monad m => a -> m a
return Char
x else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Parse.satisfy: failed"
}
onFail :: Parser s a -> Parser s a -> Parser s a
(P s -> Text -> Result (Text, s) a
p) onFail :: forall s a. Parser s a -> Parser s a -> Parser s a
`onFail` (P s -> Text -> Result (Text, s) a
q) = forall s a. (s -> Text -> Result (Text, s) a) -> Parser s a
P (\s
s Text
ts-> s -> Text -> Result (Text, s) a -> Result (Text, s) a
continue s
s Text
ts forall a b. (a -> b) -> a -> b
$ s -> Text -> Result (Text, s) a
p s
s Text
ts)
where continue :: s -> Text -> Result (Text, s) a -> Result (Text, s) a
continue s
s Text
ts (Failure (Text, s)
_ String
_) = s -> Text -> Result (Text, s) a
q s
s Text
ts
continue s
_ Text
_ Result (Text, s) a
r = Result (Text, s) a
r
manySatisfy :: (Char->Bool) -> Parser s Text
manySatisfy :: forall s. (Char -> Bool) -> Parser s Text
manySatisfy Char -> Bool
f = forall s a. (s -> Text -> Result (Text, s) a) -> Parser s a
P (\s
s Text
bs-> let (Text
pre,Text
suf) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
f Text
bs in forall z a. z -> a -> Result z a
Success (Text
suf,s
s) Text
pre)
many1Satisfy :: (Char->Bool) -> Parser s Text
many1Satisfy :: forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
f = do Text
x <- forall s. (Char -> Bool) -> Parser s Text
manySatisfy Char -> Bool
f
if Text -> Bool
T.null Text
x then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Parse.many1Satisfy: failed"
else forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
stUpdate :: (s->s) -> Parser s ()
stUpdate :: forall s. (s -> s) -> Parser s ()
stUpdate s -> s
f = forall s a. (s -> Text -> Result (Text, s) a) -> Parser s a
P (\s
s Text
bs-> forall z a. z -> a -> Result z a
Success (Text
bs, s -> s
f s
s) ())
stQuery :: (s->a) -> Parser s a
stQuery :: forall s a. (s -> a) -> Parser s a
stQuery s -> a
f = forall s a. (s -> Text -> Result (Text, s) a) -> Parser s a
P (\s
s Text
bs-> forall z a. z -> a -> Result z a
Success (Text
bs,s
s) (s -> a
f s
s))
stGet :: Parser s s
stGet :: forall s. Parser s s
stGet = forall s a. (s -> Text -> Result (Text, s) a) -> Parser s a
P (\s
s Text
bs-> forall z a. z -> a -> Result z a
Success (Text
bs,s
s) s
s)
reparse :: Text -> Parser s ()
reparse :: forall s. Text -> Parser s ()
reparse Text
ts = forall s a. (s -> Text -> Result (Text, s) a) -> Parser s a
P (\s
s Text
inp-> forall z a. z -> a -> Result z a
Success (Text
ts Text -> Text -> Text
`T.append` Text
inp,s
s) ())