module Text.ParserCombinators.Poly.StateParser
(
Parser(P)
, Result(..)
, next
, eof
, satisfy
, onFail
, stUpdate
, stQuery
, stGet
, reparse
) where
import Text.ParserCombinators.Poly.Base
import Text.ParserCombinators.Poly.Result
import Control.Applicative
import qualified Control.Monad.Fail as Fail
newtype Parser s t a = P (s -> [t] -> Result ([t],s) a)
instance Functor (Parser s t) where
fmap :: (a -> b) -> Parser s t a -> Parser s t b
fmap f :: a -> b
f (P p :: s -> [t] -> Result ([t], s) a
p) = (s -> [t] -> Result ([t], s) b) -> Parser s t b
forall s t a. (s -> [t] -> Result ([t], s) a) -> Parser s t a
P (\s :: s
s-> (a -> b) -> Result ([t], s) a -> Result ([t], s) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Result ([t], s) a -> Result ([t], s) b)
-> ([t] -> Result ([t], s) a) -> [t] -> Result ([t], s) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> [t] -> Result ([t], s) a
p s
s)
instance Applicative (Parser s t) where
pure :: a -> Parser s t a
pure x :: a
x = (s -> [t] -> Result ([t], s) a) -> Parser s t a
forall s t a. (s -> [t] -> Result ([t], s) a) -> Parser s t a
P (\s :: s
s ts :: [t]
ts-> ([t], s) -> a -> Result ([t], s) a
forall z a. z -> a -> Result z a
Success ([t]
ts,s
s) a
x)
pf :: Parser s t (a -> b)
pf <*> :: Parser s t (a -> b) -> Parser s t a -> Parser s t b
<*> px :: Parser s t a
px = do { a -> b
f <- Parser s t (a -> b)
pf; a
x <- Parser s t a
px; b -> Parser s t b
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 Monad (Parser s t) where
return :: a -> Parser s t a
return = a -> Parser s t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(P f :: s -> [t] -> Result ([t], s) a
f) >>= :: Parser s t a -> (a -> Parser s t b) -> Parser s t b
>>= g :: a -> Parser s t b
g = (s -> [t] -> Result ([t], s) b) -> Parser s t b
forall s t a. (s -> [t] -> Result ([t], s) a) -> Parser s t a
P (\s :: s
s-> Result ([t], s) a -> Result ([t], s) b
continue (Result ([t], s) a -> Result ([t], s) b)
-> ([t] -> Result ([t], s) a) -> [t] -> Result ([t], s) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> [t] -> Result ([t], s) a
f s
s)
where
continue :: Result ([t], s) a -> Result ([t], s) b
continue (Success (ts :: [t]
ts,s :: s
s) x :: a
x) = let (P g' :: s -> [t] -> Result ([t], s) b
g') = a -> Parser s t b
g a
x in s -> [t] -> Result ([t], s) b
g' s
s [t]
ts
continue (Committed r :: Result ([t], s) a
r) = Result ([t], s) b -> Result ([t], s) b
forall z a. Result z a -> Result z a
Committed (Result ([t], s) a -> Result ([t], s) b
continue Result ([t], s) a
r)
continue (Failure tss :: ([t], s)
tss e :: String
e) = ([t], s) -> String -> Result ([t], s) b
forall z a. z -> String -> Result z a
Failure ([t], s)
tss String
e
#if !MIN_VERSION_base(4,13,0)
fail = Fail.fail
#endif
instance Fail.MonadFail (Parser s t) where
fail :: String -> Parser s t a
fail e :: String
e = (s -> [t] -> Result ([t], s) a) -> Parser s t a
forall s t a. (s -> [t] -> Result ([t], s) a) -> Parser s t a
P (\s :: s
s ts :: [t]
ts-> ([t], s) -> String -> Result ([t], s) a
forall z a. z -> String -> Result z a
Failure ([t]
ts,s
s) String
e)
instance Alternative (Parser s t) where
empty :: Parser s t a
empty = String -> Parser s t a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "no parse"
p :: Parser s t a
p <|> :: Parser s t a -> Parser s t a -> Parser s t a
<|> q :: Parser s t a
q = Parser s t a
p Parser s t a -> Parser s t a -> Parser s t a
forall s t a. Parser s t a -> Parser s t a -> Parser s t a
`onFail` Parser s t a
q
instance PolyParse (Parser s t)
instance Commitment (Parser s t) where
commit :: Parser s t a -> Parser s t a
commit (P p :: s -> [t] -> Result ([t], s) a
p) = (s -> [t] -> Result ([t], s) a) -> Parser s t a
forall s t a. (s -> [t] -> Result ([t], s) a) -> Parser s t a
P (\s :: s
s-> Result ([t], s) a -> Result ([t], s) a
forall z a. Result z a -> Result z a
Committed (Result ([t], s) a -> Result ([t], s) a)
-> ([t] -> Result ([t], s) a) -> [t] -> Result ([t], s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result ([t], s) a -> Result ([t], s) a
forall z a. Result z a -> Result z a
squash (Result ([t], s) a -> Result ([t], s) a)
-> ([t] -> Result ([t], s) a) -> [t] -> Result ([t], s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> [t] -> Result ([t], s) a
p s
s)
where
squash :: Result z a -> Result z a
squash (Committed r :: Result z a
r) = Result z a -> Result z a
squash Result z a
r
squash r :: Result z a
r = Result z a
r
(P p :: s -> [t] -> Result ([t], s) a
p) adjustErr :: Parser s t a -> (String -> String) -> Parser s t a
`adjustErr` f :: String -> String
f = (s -> [t] -> Result ([t], s) a) -> Parser s t a
forall s t a. (s -> [t] -> Result ([t], s) a) -> Parser s t a
P (\s :: s
s-> Result ([t], s) a -> Result ([t], s) a
forall z a. Result z a -> Result z a
adjust (Result ([t], s) a -> Result ([t], s) a)
-> ([t] -> Result ([t], s) a) -> [t] -> Result ([t], s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> [t] -> Result ([t], s) a
p s
s)
where
adjust :: Result z a -> Result z a
adjust (Failure zs :: z
zs e :: String
e) = z -> String -> Result z a
forall z a. z -> String -> Result z a
Failure z
zs (String -> String
f String
e)
adjust (Committed r :: Result z a
r) = Result z a -> Result z a
forall z a. Result z a -> Result z a
Committed (Result z a -> Result z a
adjust Result z a
r)
adjust good :: Result z a
good = Result z a
good
oneOf' :: [(String, Parser s t a)] -> Parser s t a
oneOf' = [(String, String)] -> [(String, Parser s t a)] -> Parser s t a
forall s t a.
[(String, String)] -> [(String, Parser s t a)] -> Parser s t a
accum []
where accum :: [(String, String)] -> [(String, Parser s t a)] -> Parser s t a
accum errs :: [(String, String)]
errs [] =
String -> Parser s t a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("failed to parse any of the possible choices:\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String -> String
indent 2 (((String, String) -> String) -> [(String, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String) -> String
showErr ([(String, String)] -> [(String, String)]
forall a. [a] -> [a]
reverse [(String, String)]
errs)))
accum errs :: [(String, String)]
errs ((e :: String
e,P p :: s -> [t] -> Result ([t], s) a
p):ps :: [(String, Parser s t a)]
ps) =
(s -> [t] -> Result ([t], s) a) -> Parser s t a
forall s t a. (s -> [t] -> Result ([t], s) a) -> Parser s t a
P (\s :: s
s ts :: [t]
ts-> case s -> [t] -> Result ([t], s) a
p s
s [t]
ts of
Failure _ err :: String
err ->
let (P p :: s -> [t] -> Result ([t], s) a
p) = [(String, String)] -> [(String, Parser s t a)] -> Parser s t a
accum ((String
e,String
err)(String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:[(String, String)]
errs) [(String, Parser s t a)]
ps
in s -> [t] -> Result ([t], s) a
p s
s [t]
ts
r :: Result ([t], s) a
r@(Success _ a :: a
a) -> Result ([t], s) a
r
r :: Result ([t], s) a
r@(Committed _) -> Result ([t], s) a
r )
showErr :: (String, String) -> String
showErr (name :: String
name,err :: String
err) = String
nameString -> String -> String
forall a. [a] -> [a] -> [a]
++":\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String -> String
indent 2 String
err
infixl 6 `onFail`
onFail :: Parser s t a -> Parser s t a -> Parser s t a
(P p :: s -> [t] -> Result ([t], s) a
p) onFail :: Parser s t a -> Parser s t a -> Parser s t a
`onFail` (P q :: s -> [t] -> Result ([t], s) a
q) = (s -> [t] -> Result ([t], s) a) -> Parser s t a
forall s t a. (s -> [t] -> Result ([t], s) a) -> Parser s t a
P (\s :: s
s ts :: [t]
ts-> s -> [t] -> Result ([t], s) a -> Result ([t], s) a
continue s
s [t]
ts (Result ([t], s) a -> Result ([t], s) a)
-> Result ([t], s) a -> Result ([t], s) a
forall a b. (a -> b) -> a -> b
$ s -> [t] -> Result ([t], s) a
p s
s [t]
ts)
where
continue :: s -> [t] -> Result ([t], s) a -> Result ([t], s) a
continue s :: s
s ts :: [t]
ts (Failure _ _) = s -> [t] -> Result ([t], s) a
q s
s [t]
ts
continue _ _ r :: Result ([t], s) a
r = Result ([t], s) a
r
next :: Parser s t t
next :: Parser s t t
next = (s -> [t] -> Result ([t], s) t) -> Parser s t t
forall s t a. (s -> [t] -> Result ([t], s) a) -> Parser s t a
P (\s :: s
s ts :: [t]
ts-> case [t]
ts of
[] -> ([t], s) -> String -> Result ([t], s) t
forall z a. z -> String -> Result z a
Failure ([],s
s) "Ran out of input (EOF)"
(t :: t
t:ts' :: [t]
ts') -> ([t], s) -> t -> Result ([t], s) t
forall z a. z -> a -> Result z a
Success ([t]
ts',s
s) t
t )
eof :: Parser s t ()
eof :: Parser s t ()
eof = (s -> [t] -> Result ([t], s) ()) -> Parser s t ()
forall s t a. (s -> [t] -> Result ([t], s) a) -> Parser s t a
P (\s :: s
s ts :: [t]
ts-> case [t]
ts of
[] -> ([t], s) -> () -> Result ([t], s) ()
forall z a. z -> a -> Result z a
Success ([],s
s) ()
(t :: t
t:ts' :: [t]
ts') -> ([t], s) -> String -> Result ([t], s) ()
forall z a. z -> String -> Result z a
Failure ([t]
ts,s
s) "Expected end of input (eof)" )
satisfy :: (t->Bool) -> Parser s t t
satisfy :: (t -> Bool) -> Parser s t t
satisfy pred :: t -> Bool
pred = do { t
x <- Parser s t t
forall s t. Parser s t t
next
; if t -> Bool
pred t
x then t -> Parser s t t
forall (m :: * -> *) a. Monad m => a -> m a
return t
x else String -> Parser s t t
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Parse.satisfy: failed"
}
stUpdate :: (s->s) -> Parser s t ()
stUpdate :: (s -> s) -> Parser s t ()
stUpdate f :: s -> s
f = (s -> [t] -> Result ([t], s) ()) -> Parser s t ()
forall s t a. (s -> [t] -> Result ([t], s) a) -> Parser s t a
P (\s :: s
s ts :: [t]
ts-> ([t], s) -> () -> Result ([t], s) ()
forall z a. z -> a -> Result z a
Success ([t]
ts, s -> s
f s
s) ())
stQuery :: (s->a) -> Parser s t a
stQuery :: (s -> a) -> Parser s t a
stQuery f :: s -> a
f = (s -> [t] -> Result ([t], s) a) -> Parser s t a
forall s t a. (s -> [t] -> Result ([t], s) a) -> Parser s t a
P (\s :: s
s ts :: [t]
ts-> ([t], s) -> a -> Result ([t], s) a
forall z a. z -> a -> Result z a
Success ([t]
ts,s
s) (s -> a
f s
s))
stGet :: Parser s t s
stGet :: Parser s t s
stGet = (s -> [t] -> Result ([t], s) s) -> Parser s t s
forall s t a. (s -> [t] -> Result ([t], s) a) -> Parser s t a
P (\s :: s
s ts :: [t]
ts-> ([t], s) -> s -> Result ([t], s) s
forall z a. z -> a -> Result z a
Success ([t]
ts,s
s) s
s)
reparse :: [t] -> Parser s t ()
reparse :: [t] -> Parser s t ()
reparse ts :: [t]
ts = (s -> [t] -> Result ([t], s) ()) -> Parser s t ()
forall s t a. (s -> [t] -> Result ([t], s) a) -> Parser s t a
P (\s :: s
s inp :: [t]
inp-> ([t], s) -> () -> Result ([t], s) ()
forall z a. z -> a -> Result z a
Success (([t]
ts[t] -> [t] -> [t]
forall a. [a] -> [a] -> [a]
++[t]
inp),s
s) ())