{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}
module Text.ParserCombinators.Poly.StateLazy
  ( -- * The Parser datatype
    Parser(P)	-- datatype, instance of: Functor, Monad, PolyParse
  , Result(..)	-- internal to the parser monad
  , runParser	-- :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
    -- ** Basic parsers
  , next	-- :: Parser s t t
  , eof		-- :: Parser s t ()
  , satisfy	-- :: (t->Bool) -> Parser s t t
  , onFail      -- :: Parser s t a -> Parser s t a -> Parser s t a
  , manyFinally	-- :: Parser s t a -> Parser s t z -> Parser s t [a]
    -- ** State-handling
  , stUpdate    -- :: (s->s) -> Parser s t ()
  , stQuery     -- :: (s->a) -> Parser s t a
  , stGet       -- :: Parser s t s
    -- ** Re-parsing
  , reparse	-- :: [t] -> Parser s t ()
    -- * Re-export all more general combinators
  , module Text.ParserCombinators.Poly.Base
  , module Control.Applicative
  ) where


import Text.ParserCombinators.Poly.Base hiding (manyFinally)
import Text.ParserCombinators.Poly.Result
import qualified Text.ParserCombinators.Poly.StateParser as P
import Control.Applicative
import qualified Control.Monad.Fail as Fail

#if __GLASGOW_HASKELL__
import Control.Exception hiding (bracket)
throwE :: String -> a
throwE :: String -> a
throwE String
msg = ErrorCall -> a
forall a e. Exception e => e -> a
throw (String -> ErrorCall
ErrorCall String
msg)
#else
throwE :: String -> a
throwE msg = error msg
#endif

-- | The only differences between a State and a StateLazy parser are the
--   instance of Applicative, and the type (and implementation) of runParser.
--   We therefore need to /newtype/ the original Parser type, to allow it
--   to have a different instance.
newtype Parser s t a = P (P.Parser s t a)
#ifdef __GLASGOW_HASKELL__
        deriving (a -> Parser s t b -> Parser s t a
(a -> b) -> Parser s t a -> Parser s t b
(forall a b. (a -> b) -> Parser s t a -> Parser s t b)
-> (forall a b. a -> Parser s t b -> Parser s t a)
-> Functor (Parser s t)
forall a b. a -> Parser s t b -> Parser s t a
forall a b. (a -> b) -> Parser s t a -> Parser s t b
forall s t a b. a -> Parser s t b -> Parser s t a
forall s t a b. (a -> b) -> Parser s t a -> Parser s t b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Parser s t b -> Parser s t a
$c<$ :: forall s t a b. a -> Parser s t b -> Parser s t a
fmap :: (a -> b) -> Parser s t a -> Parser s t b
$cfmap :: forall s t a b. (a -> b) -> Parser s t a -> Parser s t b
Functor,Applicative (Parser s t)
a -> Parser s t a
Applicative (Parser s t)
-> (forall a b.
    Parser s t a -> (a -> Parser s t b) -> Parser s t b)
-> (forall a b. Parser s t a -> Parser s t b -> Parser s t b)
-> (forall a. a -> Parser s t a)
-> Monad (Parser s t)
Parser s t a -> (a -> Parser s t b) -> Parser s t b
Parser s t a -> Parser s t b -> Parser s t b
forall a. a -> Parser s t a
forall s t. Applicative (Parser s t)
forall a b. Parser s t a -> Parser s t b -> Parser s t b
forall a b. Parser s t a -> (a -> Parser s t b) -> Parser s t b
forall s t a. a -> Parser s t a
forall s t a b. Parser s t a -> Parser s t b -> Parser s t b
forall s t a b. Parser s t a -> (a -> Parser s t b) -> Parser s t b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Parser s t a
$creturn :: forall s t a. a -> Parser s t a
>> :: Parser s t a -> Parser s t b -> Parser s t b
$c>> :: forall s t a b. Parser s t a -> Parser s t b -> Parser s t b
>>= :: Parser s t a -> (a -> Parser s t b) -> Parser s t b
$c>>= :: forall s t a b. Parser s t a -> (a -> Parser s t b) -> Parser s t b
$cp1Monad :: forall s t. Applicative (Parser s t)
Monad,Monad (Parser s t)
Monad (Parser s t)
-> (forall a. String -> Parser s t a) -> MonadFail (Parser s t)
String -> Parser s t a
forall a. String -> Parser s t a
forall s t. Monad (Parser s t)
forall s t a. String -> Parser s t a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> Parser s t a
$cfail :: forall s t a. String -> Parser s t a
$cp1MonadFail :: forall s t. Monad (Parser s t)
Fail.MonadFail,[(String, Parser s t a)] -> Parser s t a
Parser s t a -> Parser s t a
Parser s t a -> (String -> String) -> Parser s t a
(forall a. Parser s t a -> Parser s t a)
-> (forall a. Parser s t a -> (String -> String) -> Parser s t a)
-> (forall a. [(String, Parser s t a)] -> Parser s t a)
-> Commitment (Parser s t)
forall a. [(String, Parser s t a)] -> Parser s t a
forall a. Parser s t a -> Parser s t a
forall a. Parser s t a -> (String -> String) -> Parser s t a
forall s t a. [(String, Parser s t a)] -> Parser s t a
forall s t a. Parser s t a -> Parser s t a
forall s t a. Parser s t a -> (String -> String) -> Parser s t a
forall (p :: * -> *).
(forall a. p a -> p a)
-> (forall a. p a -> (String -> String) -> p a)
-> (forall a. [(String, p a)] -> p a)
-> Commitment p
oneOf' :: [(String, Parser s t a)] -> Parser s t a
$coneOf' :: forall s t a. [(String, Parser s t a)] -> Parser s t a
adjustErr :: Parser s t a -> (String -> String) -> Parser s t a
$cadjustErr :: forall s t a. Parser s t a -> (String -> String) -> Parser s t a
commit :: Parser s t a -> Parser s t a
$ccommit :: forall s t a. Parser s t a -> Parser s t a
Commitment)
#else
instance Functor (Parser s t) where
    fmap f (P p) = P (fmap f p)
instance Monad (Parser s t) where
    return x  = P (return x)
    fail      = Fail.fail
    (P f) >>= g = P (f >>= (\(P g')->g') . g)
instance Fail.MonadFail (Parser s t) where
    fail e    = P (fail e)
instance Commitment (Parser s t) where
    commit (P p)   = P (commit p)
    (P p) `adjustErr` f  = P (p `adjustErr` f)
#endif

-- | Apply a parser to an input token sequence.
runParser :: Parser s t a -> s -> [t] -> (a, s, [t])
runParser :: Parser s t a -> s -> [t] -> (a, s, [t])
runParser (P (P.P s -> [t] -> Result ([t], s) a
p)) = \s
s -> Result ([t], s) a -> (a, s, [t])
forall z s a. Result (z, s) a -> (a, s, z)
fromResult (Result ([t], s) a -> (a, s, [t]))
-> ([t] -> Result ([t], s) a) -> [t] -> (a, s, [t])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> [t] -> Result ([t], s) a
p s
s
  where
    fromResult :: Result (z,s) a -> (a, s, z)
    fromResult :: Result (z, s) a -> (a, s, z)
fromResult (Success (z
z,s
s) a
a)  =  (a
a, s
s, z
z)
    fromResult (Failure   (z, s)
_   String
e)  =  String -> (a, s, z)
forall a. String -> a
throwE String
e
    fromResult (Committed Result (z, s) a
r)      =  Result (z, s) a -> (a, s, z)
forall z s a. Result (z, s) a -> (a, s, z)
fromResult Result (z, s) a
r


instance Applicative (Parser s t) where
    pure :: a -> Parser s t a
pure a
f    = a -> Parser s t a
forall (m :: * -> *) a. Monad m => a -> m a
return a
f
    --   Apply a parsed function to a parsed value.  This version
    --   is strict in the result of the function parser, but
    --   lazy in the result of the argument parser.  (Argument laziness is
    --   the distinctive feature over other implementations.)
    (P (P.P s -> [t] -> Result ([t], s) (a -> b)
pf)) <*> :: Parser s t (a -> b) -> Parser s t a -> Parser s t b
<*> Parser s t a
px = Parser s t b -> Parser s t b
forall s t a. Parser s t a -> Parser s t 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.P (\s
s-> Result ([t], s) (a -> b) -> Result ([t], s) b
forall a. Result ([t], s) (a -> a) -> Result ([t], s) a
continue (Result ([t], s) (a -> b) -> Result ([t], s) b)
-> ([t] -> Result ([t], s) (a -> b)) -> [t] -> Result ([t], s) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> [t] -> Result ([t], s) (a -> b)
pf s
s))
      where
        continue :: Result ([t], s) (a -> a) -> Result ([t], s) a
continue (Success ([t]
z,s
s) a -> a
f) = let (a
x,s
s',[t]
z') = Parser s t a -> s -> [t] -> (a, s, [t])
forall s t a. Parser s t a -> s -> [t] -> (a, s, [t])
runParser Parser s t a
px s
s [t]
z
                                     in ([t], s) -> a -> Result ([t], s) a
forall z a. z -> a -> Result z a
Success ([t]
z',s
s') (a -> a
f a
x)
        continue (Failure ([t], s)
zs String
e)    = ([t], s) -> String -> Result ([t], s) a
forall z a. z -> String -> Result z a
Failure ([t], s)
zs String
e
        continue (Committed Result ([t], s) (a -> a)
r)     = Result ([t], s) a -> Result ([t], s) a
forall z a. Result z a -> Result z a
Committed (Result ([t], s) (a -> a) -> Result ([t], s) a
continue Result ([t], s) (a -> a)
r)
#if defined(GLASGOW_HASKELL) && GLASGOW_HASKELL > 610
    p  <*  q  = p `discard` q
#endif

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 String
"no parse"
    Parser s t a
p <|> :: Parser s t a -> Parser s t a -> Parser s t a
<|> 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)

------------------------------------------------------------------------

-- | Simply return the next token in the input tokenstream.
next    ::  Parser s t t
next :: Parser s t t
next    = Parser s t t -> Parser s t t
forall s t a. Parser s t a -> Parser s t a
P Parser s t t
forall s t. Parser s t t
P.next

-- | Succeed if the end of file/input has been reached, fail otherwise.
eof     :: Parser s t ()
eof :: Parser s t ()
eof     = Parser s t () -> Parser s t ()
forall s t a. Parser s t a -> Parser s t a
P Parser s t ()
forall s t. Parser s t ()
P.eof

-- | Return the next token if it satisfies the given predicate.
satisfy :: (t->Bool) -> Parser s t t
satisfy :: (t -> Bool) -> Parser s t t
satisfy = Parser s t t -> Parser s t t
forall s t a. Parser s t a -> Parser s t a
P (Parser s t t -> Parser s t t)
-> ((t -> Bool) -> Parser s t t) -> (t -> Bool) -> Parser s t t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> Bool) -> Parser s t t
forall t s. (t -> Bool) -> Parser s t t
P.satisfy

-- | @p `onFail` q@ means parse p, unless p fails, in which case
--   parse q instead.
--   Can be chained together to give multiple attempts to parse something.
--   (Note that q could itself be a failing parser, e.g. to change the error
--   message from that defined in p to something different.)
--   However, a severe failure in p cannot be ignored.
onFail  :: Parser s t a -> Parser s t a -> Parser s t a
onFail :: Parser s t a -> Parser s t a -> Parser s t a
onFail (P Parser s t a
a) (P Parser s t a
b) = Parser s t a -> Parser s t a
forall s t a. Parser s t a -> Parser s t a
P (Parser s t a
a 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
`P.onFail` Parser s t a
b)

-- | Push some tokens back onto the front of the input stream and reparse.
--   This is useful e.g. for recursively expanding macros.  When the
--   user-parser recognises a macro use, it can lookup the macro
--   expansion from the parse state, lex it, and then stuff the
--   lexed expansion back down into the parser.
reparse :: [t] -> Parser s t ()
reparse :: [t] -> Parser s t ()
reparse = Parser s t () -> Parser s t ()
forall s t a. Parser s t a -> Parser s t a
P (Parser s t () -> Parser s t ())
-> ([t] -> Parser s t ()) -> [t] -> Parser s t ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [t] -> Parser s t ()
forall t s. [t] -> Parser s t ()
P.reparse

------------------------------------------------------------------------
-- State handling

-- | Update the internal state.
stUpdate   :: (s->s) -> Parser s t ()
stUpdate :: (s -> s) -> Parser s t ()
stUpdate s -> s
f  = Parser s t () -> Parser s t ()
forall s t a. Parser s t a -> Parser s t a
P ((s -> s) -> Parser s t ()
forall s t. (s -> s) -> Parser s t ()
P.stUpdate s -> s
f)

-- | Query the internal state.
stQuery    :: (s->a) -> Parser s t a
stQuery :: (s -> a) -> Parser s t a
stQuery s -> a
f   = Parser s t a -> Parser s t a
forall s t a. Parser s t a -> Parser s t a
P ((s -> a) -> Parser s t a
forall s a t. (s -> a) -> Parser s t a
P.stQuery s -> a
f)

-- | Deliver the entire internal state.
stGet      :: Parser s t s
stGet :: Parser s t s
stGet       = Parser s t s -> Parser s t s
forall s t a. Parser s t a -> Parser s t a
P (Parser s t s
forall s t. Parser s t s
P.stGet)

------------------------------------------------------------------------


manyFinally :: Parser s t a -> Parser s t z -> Parser s t [a]
{-
manyFinally pp@(P p) pt@(P t) = P (\s ts -> item s ts (p s ts))
    where
      item _ _  (Success ts s x) = success ts s x
      item s ts (Failure _ _ e)  = terminate (t s ts)
      item s ts (Committed r)    = Committed (within r)

      success ts s x =
            let (tail,s',ts') = runParser (manyFinally pp pt) s ts
            in Success ts' s' (x:tail)

      terminate (Success ts s _) = Success ts s []
      terminate (Failure ts s e) = Failure ts s e
      terminate (Committed r)    = Committed (terminate r)

      within (Success ts s x)    = success ts s x
      within (Failure ts s e)    = Failure ts s e
      within (Committed r)       = within r
-}

manyFinally :: Parser s t a -> Parser s t z -> Parser s t [a]
manyFinally Parser s t a
p Parser s t z
z =
    (do a
x <- Parser s t a
p; ([a] -> [a]) -> Parser s t ([a] -> [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) Parser s t ([a] -> [a]) -> Parser s t [a] -> Parser s t [a]
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Parser s t a -> Parser s t z -> Parser s t [a]
forall s t a z. Parser s t a -> Parser s t z -> Parser s t [a]
manyFinally Parser s t a
p Parser s t z
z)
      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`
    (do Parser s t z
z; [a] -> Parser s t [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
      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`
    [(String, Parser s t [a])] -> Parser s t [a]
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
oneOf' [ (String
"item in sequence",    (do Parser s t a
p; [a] -> Parser s t [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []))
           , (String
"sequence terminator", (do Parser s t z
z; [a] -> Parser s t [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [])) ]

------------------------------------------------------------------------