{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolymorphicComponents #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Text.Parsec.Prim
-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
-- License     :  BSD-style (see the LICENSE file)
--
-- Maintainer  :  derek.a.elkins@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-- The primitive parser combinators.
--
-----------------------------------------------------------------------------

{-# OPTIONS_HADDOCK not-home #-}

module Text.Parsec.Prim
    ( unknownError
    , sysUnExpectError
    , unexpected
    , ParsecT
    , runParsecT
    , mkPT
    , Parsec
    , Consumed(..)
    , Reply(..)
    , State(..)
    , parsecMap
    , parserReturn
    , parserBind
    , mergeErrorReply
    , parserFail
    , parserZero
    , parserPlus
    , (<?>)
    , (<|>)
    , label
    , labels
    , lookAhead
    , Stream(..)
    , tokens
    , try
    , token
    , tokenPrim
    , tokenPrimEx
    , many
    , skipMany
    , manyAccum
    , runPT
    , runP
    , runParserT
    , runParser
    , parse
    , parseTest
    , getPosition
    , getInput
    , setPosition
    , setInput
    , getParserState
    , setParserState
    , updateParserState
    , getState
    , putState
    , modifyState
    , setState
    , updateState
    ) where


import Prelude hiding (sequence)
import qualified Data.ByteString.Lazy.Char8 as CL
import qualified Data.ByteString.Char8 as C

import Data.Typeable ( Typeable )

import qualified Data.Text as Text
import qualified Data.Text.Lazy as TextL

-- To define Monoid instance
import qualified Data.List.NonEmpty as NE
import Data.List ( genericReplicate )
import Data.Traversable (sequence)
import qualified Data.Functor as Functor ( Functor(..) )
import qualified Data.Semigroup as Semigroup ( Semigroup(..) )
import qualified Data.Monoid as Monoid ( Monoid(..) )

import qualified Control.Applicative as Applicative ( Applicative(..), Alternative(..), liftA2 )
import Control.Monad hiding (sequence)
import Control.Monad.Trans
import Control.Monad.Identity hiding (sequence)
import qualified Control.Monad.Fail as Fail

import Control.Monad.Reader.Class
import Control.Monad.State.Class
import Control.Monad.Cont.Class
import Control.Monad.Error.Class

import Text.Parsec.Pos
import Text.Parsec.Error

unknownError :: State s u -> ParseError
unknownError :: forall s u. State s u -> ParseError
unknownError State s u
state        = SourcePos -> ParseError
newErrorUnknown (State s u -> SourcePos
forall s u. State s u -> SourcePos
statePos State s u
state)

sysUnExpectError :: String -> SourcePos -> Reply s u a
sysUnExpectError :: forall s u a. String -> SourcePos -> Reply s u a
sysUnExpectError String
msg SourcePos
pos  = ParseError -> Reply s u a
forall s u a. ParseError -> Reply s u a
Error (Message -> SourcePos -> ParseError
newErrorMessage (String -> Message
SysUnExpect String
msg) SourcePos
pos)

-- | The parser @unexpected msg@ always fails with an unexpected error
-- message @msg@ without consuming any input.
--
-- The parsers 'fail', ('<?>') and @unexpected@ are the three parsers
-- used to generate error messages. Of these, only ('<?>') is commonly
-- used. For an example of the use of @unexpected@, see the definition
-- of 'Text.Parsec.Combinator.notFollowedBy'.

unexpected :: (Stream s m t) => String -> ParsecT s u m a
unexpected :: forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected String
msg
    = (forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m a)
-> (forall b.
    State s u
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ \State s u
s a -> State s u -> ParseError -> m b
_ ParseError -> m b
_ a -> State s u -> ParseError -> m b
_ ParseError -> m b
eerr ->
      ParseError -> m b
eerr (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ Message -> SourcePos -> ParseError
newErrorMessage (String -> Message
UnExpect String
msg) (State s u -> SourcePos
forall s u. State s u -> SourcePos
statePos State s u
s)

-- | ParserT monad transformer and Parser type

-- | @ParsecT s u m a@ is a parser with stream type @s@, user state type @u@,
-- underlying monad @m@ and return type @a@.  Parsec is strict in the user state.
-- If this is undesirable, simply use a data type like @data Box a = Box a@ and
-- the state type @Box YourStateType@ to add a level of indirection.

newtype ParsecT s u m a
    = ParsecT {forall s u (m :: * -> *) a.
ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
unParser :: forall b .
                 State s u
              -> (a -> State s u -> ParseError -> m b) -- consumed ok
              -> (ParseError -> m b)                   -- consumed err
              -> (a -> State s u -> ParseError -> m b) -- empty ok
              -> (ParseError -> m b)                   -- empty err
              -> m b
             }
#if MIN_VERSION_base(4,7,0)
     deriving ( Typeable )
     -- GHC 7.6 doesn't like deriving instances of Typeabl1 for types with
     -- non-* type-arguments.
#endif

-- | Low-level unpacking of the ParsecT type. To run your parser, please look to
-- runPT, runP, runParserT, runParser and other such functions.
runParsecT :: Monad m => ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
{-# INLINABLE runParsecT #-}
runParsecT :: forall (m :: * -> *) s u a.
Monad m =>
ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
runParsecT ParsecT s u m a
p State s u
s = ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
forall s u (m :: * -> *) a.
ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
unParser ParsecT s u m a
p State s u
s a -> State s u -> ParseError -> m (Consumed (m (Reply s u a)))
forall {m :: * -> *} {m :: * -> *} {a} {s} {u}.
(Monad m, Monad m) =>
a -> State s u -> ParseError -> m (Consumed (m (Reply s u a)))
cok ParseError -> m (Consumed (m (Reply s u a)))
forall {m :: * -> *} {m :: * -> *} {s} {u} {a}.
(Monad m, Monad m) =>
ParseError -> m (Consumed (m (Reply s u a)))
cerr a -> State s u -> ParseError -> m (Consumed (m (Reply s u a)))
forall {m :: * -> *} {m :: * -> *} {a} {s} {u}.
(Monad m, Monad m) =>
a -> State s u -> ParseError -> m (Consumed (m (Reply s u a)))
eok ParseError -> m (Consumed (m (Reply s u a)))
forall {m :: * -> *} {m :: * -> *} {s} {u} {a}.
(Monad m, Monad m) =>
ParseError -> m (Consumed (m (Reply s u a)))
eerr
    where cok :: a -> State s u -> ParseError -> m (Consumed (m (Reply s u a)))
cok a
a State s u
s' ParseError
err = Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a))))
-> (Reply s u a -> Consumed (m (Reply s u a)))
-> Reply s u a
-> m (Consumed (m (Reply s u a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Reply s u a) -> Consumed (m (Reply s u a))
forall a. a -> Consumed a
Consumed (m (Reply s u a) -> Consumed (m (Reply s u a)))
-> (Reply s u a -> m (Reply s u a))
-> Reply s u a
-> Consumed (m (Reply s u a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply s u a -> m (Reply s u a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reply s u a -> m (Consumed (m (Reply s u a))))
-> Reply s u a -> m (Consumed (m (Reply s u a)))
forall a b. (a -> b) -> a -> b
$ a -> State s u -> ParseError -> Reply s u a
forall s u a. a -> State s u -> ParseError -> Reply s u a
Ok a
a State s u
s' ParseError
err
          cerr :: ParseError -> m (Consumed (m (Reply s u a)))
cerr ParseError
err = Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a))))
-> (Reply s u a -> Consumed (m (Reply s u a)))
-> Reply s u a
-> m (Consumed (m (Reply s u a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Reply s u a) -> Consumed (m (Reply s u a))
forall a. a -> Consumed a
Consumed (m (Reply s u a) -> Consumed (m (Reply s u a)))
-> (Reply s u a -> m (Reply s u a))
-> Reply s u a
-> Consumed (m (Reply s u a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply s u a -> m (Reply s u a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reply s u a -> m (Consumed (m (Reply s u a))))
-> Reply s u a -> m (Consumed (m (Reply s u a)))
forall a b. (a -> b) -> a -> b
$ ParseError -> Reply s u a
forall s u a. ParseError -> Reply s u a
Error ParseError
err
          eok :: a -> State s u -> ParseError -> m (Consumed (m (Reply s u a)))
eok a
a State s u
s' ParseError
err = Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a))))
-> (Reply s u a -> Consumed (m (Reply s u a)))
-> Reply s u a
-> m (Consumed (m (Reply s u a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Reply s u a) -> Consumed (m (Reply s u a))
forall a. a -> Consumed a
Empty (m (Reply s u a) -> Consumed (m (Reply s u a)))
-> (Reply s u a -> m (Reply s u a))
-> Reply s u a
-> Consumed (m (Reply s u a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply s u a -> m (Reply s u a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reply s u a -> m (Consumed (m (Reply s u a))))
-> Reply s u a -> m (Consumed (m (Reply s u a)))
forall a b. (a -> b) -> a -> b
$ a -> State s u -> ParseError -> Reply s u a
forall s u a. a -> State s u -> ParseError -> Reply s u a
Ok a
a State s u
s' ParseError
err
          eerr :: ParseError -> m (Consumed (m (Reply s u a)))
eerr ParseError
err = Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u a))))
-> (Reply s u a -> Consumed (m (Reply s u a)))
-> Reply s u a
-> m (Consumed (m (Reply s u a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Reply s u a) -> Consumed (m (Reply s u a))
forall a. a -> Consumed a
Empty (m (Reply s u a) -> Consumed (m (Reply s u a)))
-> (Reply s u a -> m (Reply s u a))
-> Reply s u a
-> Consumed (m (Reply s u a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply s u a -> m (Reply s u a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Reply s u a -> m (Consumed (m (Reply s u a))))
-> Reply s u a -> m (Consumed (m (Reply s u a)))
forall a b. (a -> b) -> a -> b
$ ParseError -> Reply s u a
forall s u a. ParseError -> Reply s u a
Error ParseError
err

-- | Low-level creation of the ParsecT type. You really shouldn't have to do this.
mkPT :: Monad m => (State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
{-# INLINABLE mkPT #-}
mkPT :: forall (m :: * -> *) s u a.
Monad m =>
(State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
mkPT State s u -> m (Consumed (m (Reply s u a)))
k = (forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m a)
-> (forall b.
    State s u
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ \State s u
s a -> State s u -> ParseError -> m b
cok ParseError -> m b
cerr a -> State s u -> ParseError -> m b
eok ParseError -> m b
eerr -> do
           Consumed (m (Reply s u a))
cons <- State s u -> m (Consumed (m (Reply s u a)))
k State s u
s
           case Consumed (m (Reply s u a))
cons of
             Consumed m (Reply s u a)
mrep -> do
                       Reply s u a
rep <- m (Reply s u a)
mrep
                       case Reply s u a
rep of
                         Ok a
x State s u
s' ParseError
err -> a -> State s u -> ParseError -> m b
cok a
x State s u
s' ParseError
err
                         Error ParseError
err -> ParseError -> m b
cerr ParseError
err
             Empty m (Reply s u a)
mrep -> do
                       Reply s u a
rep <- m (Reply s u a)
mrep
                       case Reply s u a
rep of
                         Ok a
x State s u
s' ParseError
err -> a -> State s u -> ParseError -> m b
eok a
x State s u
s' ParseError
err
                         Error ParseError
err -> ParseError -> m b
eerr ParseError
err

type Parsec s u = ParsecT s u Identity

data Consumed a  = Consumed a
                 | Empty !a
    deriving ( Typeable )

data Reply s u a = Ok a !(State s u) ParseError
                 | Error ParseError
    deriving ( Typeable )

data State s u = State {
      forall s u. State s u -> s
stateInput :: s,
      forall s u. State s u -> SourcePos
statePos   :: !SourcePos,
      forall s u. State s u -> u
stateUser  :: !u
    }
    deriving ( Typeable )

-- | The 'Semigroup' instance for 'ParsecT' is used to append the result
-- of several parsers, for example:
--
-- @
-- (many $ char 'a') <> (many $ char 'b')
-- @
--
-- The above will parse a string like @"aabbb"@ and return a successful
-- parse result @"aabbb"@. Compare against the below which will
-- produce a result of @"bbb"@ for the same input:
--
-- @
-- (many $ char 'a') >> (many $ char 'b')
-- (many $ char 'a') *> (many $ char 'b')
-- @
--
-- @since 3.1.12
instance Semigroup.Semigroup a => Semigroup.Semigroup (ParsecT s u m a) where
    -- | Combines two parsers like '*>', '>>' and @do {...;...}@
    --  /but/ also combines their results with (<>) instead of
    --  discarding the first.
    <> :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<>)     = (a -> a -> a)
-> ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)

#if MIN_VERSION_base(4,8,0)
    sconcat :: NonEmpty (ParsecT s u m a) -> ParsecT s u m a
sconcat  = (NonEmpty a -> a) -> ParsecT s u m (NonEmpty a) -> ParsecT s u m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty a -> a
forall a. Semigroup a => NonEmpty a -> a
Semigroup.sconcat (ParsecT s u m (NonEmpty a) -> ParsecT s u m a)
-> (NonEmpty (ParsecT s u m a) -> ParsecT s u m (NonEmpty a))
-> NonEmpty (ParsecT s u m a)
-> ParsecT s u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (ParsecT s u m a) -> ParsecT s u m (NonEmpty a)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
#else
    sconcat  = fmap (Semigroup.sconcat . NE.fromList) . sequence . NE.toList
#endif
    stimes :: forall b. Integral b => b -> ParsecT s u m a -> ParsecT s u m a
stimes b
b = NonEmpty (ParsecT s u m a) -> ParsecT s u m a
forall a. Semigroup a => NonEmpty a -> a
Semigroup.sconcat (NonEmpty (ParsecT s u m a) -> ParsecT s u m a)
-> (ParsecT s u m a -> NonEmpty (ParsecT s u m a))
-> ParsecT s u m a
-> ParsecT s u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT s u m a] -> NonEmpty (ParsecT s u m a)
forall a. [a] -> NonEmpty a
NE.fromList ([ParsecT s u m a] -> NonEmpty (ParsecT s u m a))
-> (ParsecT s u m a -> [ParsecT s u m a])
-> ParsecT s u m a
-> NonEmpty (ParsecT s u m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ParsecT s u m a -> [ParsecT s u m a]
forall i a. Integral i => i -> a -> [a]
genericReplicate b
b

-- | The 'Monoid' instance for 'ParsecT' is used for the same purposes as
-- the 'Semigroup' instance.
--
-- @since 3.1.12
instance ( Monoid.Monoid a
         , Semigroup.Semigroup (ParsecT s u m a)
         ) => Monoid.Monoid (ParsecT s u m a) where
    -- | A parser that always succeeds, consumes no input, and
    --  returns the underlying 'Monoid''s 'mempty' value
    mempty :: ParsecT s u m a
mempty = a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
Applicative.pure a
forall a. Monoid a => a
Monoid.mempty

    -- | See 'ParsecT''s 'Semigroup.<>' implementation
    mappend :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
mappend = ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)

    mconcat :: [ParsecT s u m a] -> ParsecT s u m a
mconcat = ([a] -> a) -> ParsecT s u m [a] -> ParsecT s u m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Functor.fmap [a] -> a
forall a. Monoid a => [a] -> a
Monoid.mconcat (ParsecT s u m [a] -> ParsecT s u m a)
-> ([ParsecT s u m a] -> ParsecT s u m [a])
-> [ParsecT s u m a]
-> ParsecT s u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT s u m a] -> ParsecT s u m [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence

instance Functor Consumed where
    fmap :: forall a b. (a -> b) -> Consumed a -> Consumed b
fmap a -> b
f (Consumed a
x) = b -> Consumed b
forall a. a -> Consumed a
Consumed (a -> b
f a
x)
    fmap a -> b
f (Empty a
x)    = b -> Consumed b
forall a. a -> Consumed a
Empty (a -> b
f a
x)

instance Functor (Reply s u) where
    fmap :: forall a b. (a -> b) -> Reply s u a -> Reply s u b
fmap a -> b
f (Ok a
x State s u
s ParseError
e) = b -> State s u -> ParseError -> Reply s u b
forall s u a. a -> State s u -> ParseError -> Reply s u a
Ok (a -> b
f a
x) State s u
s ParseError
e
    fmap a -> b
_ (Error ParseError
e) = ParseError -> Reply s u b
forall s u a. ParseError -> Reply s u a
Error ParseError
e -- XXX

instance Functor (ParsecT s u m) where
    fmap :: forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
fmap a -> b
f ParsecT s u m a
p = (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall a b s u (m :: * -> *).
(a -> b) -> ParsecT s u m a -> ParsecT s u m b
parsecMap a -> b
f ParsecT s u m a
p

parsecMap :: (a -> b) -> ParsecT s u m a -> ParsecT s u m b
parsecMap :: forall a b s u (m :: * -> *).
(a -> b) -> ParsecT s u m a -> ParsecT s u m b
parsecMap a -> b
f ParsecT s u m a
p
    = (forall b.
 State s u
 -> (b -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (b -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m b
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> (b -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> (b -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m b)
-> (forall b.
    State s u
    -> (b -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> (b -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m b
forall a b. (a -> b) -> a -> b
$ \State s u
s b -> State s u -> ParseError -> m b
cok ParseError -> m b
cerr b -> State s u -> ParseError -> m b
eok ParseError -> m b
eerr ->
      ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
forall s u (m :: * -> *) a.
ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
unParser ParsecT s u m a
p State s u
s (b -> State s u -> ParseError -> m b
cok (b -> State s u -> ParseError -> m b)
-> (a -> b) -> a -> State s u -> ParseError -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) ParseError -> m b
cerr (b -> State s u -> ParseError -> m b
eok (b -> State s u -> ParseError -> m b)
-> (a -> b) -> a -> State s u -> ParseError -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) ParseError -> m b
eerr

instance Applicative.Applicative (ParsecT s u m) where
    pure :: forall a. a -> ParsecT s u m a
pure = a -> ParsecT s u m a
forall a s u (m :: * -> *). a -> ParsecT s u m a
parserReturn
    <*> :: forall a b.
ParsecT s u m (a -> b) -> ParsecT s u m a -> ParsecT s u m b
(<*>) = ParsecT s u m (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap -- TODO: Can this be optimized?
    ParsecT s u m a
p1 *> :: forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
*> ParsecT s u m b
p2 = ParsecT s u m a
p1 ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
forall s u (m :: * -> *) a b.
ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
`parserBind` ParsecT s u m b -> a -> ParsecT s u m b
forall a b. a -> b -> a
const ParsecT s u m b
p2
    ParsecT s u m a
p1 <* :: forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
<* ParsecT s u m b
p2 = do { a
x1 <- ParsecT s u m a
p1 ; ParsecT s u m b -> ParsecT s u m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT s u m b
p2 ; a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x1 }

instance Applicative.Alternative (ParsecT s u m) where
    empty :: forall a. ParsecT s u m a
empty = ParsecT s u m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    <|> :: forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<|>) = ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance Monad (ParsecT s u m) where
    return :: forall a. a -> ParsecT s u m a
return = a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
Applicative.pure
    ParsecT s u m a
p >>= :: forall a b.
ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
>>= a -> ParsecT s u m b
f = ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
forall s u (m :: * -> *) a b.
ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
parserBind ParsecT s u m a
p a -> ParsecT s u m b
f
    >> :: forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
(>>) = ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(Applicative.*>)
#if !MIN_VERSION_base(4,13,0)
    fail = Fail.fail
#endif

-- | @since 3.1.12.0
instance Fail.MonadFail (ParsecT s u m) where
    fail :: forall a. String -> ParsecT s u m a
fail = String -> ParsecT s u m a
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail

instance (MonadIO m) => MonadIO (ParsecT s u m) where
    liftIO :: forall a. IO a -> ParsecT s u m a
liftIO = m a -> ParsecT s u m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ParsecT s u m a)
-> (IO a -> m a) -> IO a -> ParsecT s u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance (MonadReader r m) => MonadReader r (ParsecT s u m) where
    ask :: ParsecT s u m r
ask = m r -> ParsecT s u m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
    local :: forall a. (r -> r) -> ParsecT s u m a -> ParsecT s u m a
local r -> r
f ParsecT s u m a
p = (State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
forall (m :: * -> *) s u a.
Monad m =>
(State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
mkPT ((State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a)
-> (State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ \State s u
s -> (r -> r)
-> m (Consumed (m (Reply s u a))) -> m (Consumed (m (Reply s u a)))
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
forall (m :: * -> *) s u a.
Monad m =>
ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
runParsecT ParsecT s u m a
p State s u
s)

-- I'm presuming the user might want a separate, non-backtracking
-- state aside from the Parsec user state.
instance (MonadState s m) => MonadState s (ParsecT s' u m) where
    get :: ParsecT s' u m s
get = m s -> ParsecT s' u m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
    put :: s -> ParsecT s' u m ()
put = m () -> ParsecT s' u m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ParsecT s' u m ())
-> (s -> m ()) -> s -> ParsecT s' u m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

instance (MonadCont m) => MonadCont (ParsecT s u m) where
    callCC :: forall a b.
((a -> ParsecT s u m b) -> ParsecT s u m a) -> ParsecT s u m a
callCC (a -> ParsecT s u m b) -> ParsecT s u m a
f = (State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
forall (m :: * -> *) s u a.
Monad m =>
(State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
mkPT ((State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a)
-> (State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ \State s u
s ->
          ((Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u b))))
 -> m (Consumed (m (Reply s u a))))
-> m (Consumed (m (Reply s u a)))
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (((Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u b))))
  -> m (Consumed (m (Reply s u a))))
 -> m (Consumed (m (Reply s u a))))
-> ((Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u b))))
    -> m (Consumed (m (Reply s u a))))
-> m (Consumed (m (Reply s u a)))
forall a b. (a -> b) -> a -> b
$ \Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u b)))
c ->
          ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
forall (m :: * -> *) s u a.
Monad m =>
ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
runParsecT ((a -> ParsecT s u m b) -> ParsecT s u m a
f (\a
a -> (State s u -> m (Consumed (m (Reply s u b)))) -> ParsecT s u m b
forall (m :: * -> *) s u a.
Monad m =>
(State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
mkPT ((State s u -> m (Consumed (m (Reply s u b)))) -> ParsecT s u m b)
-> (State s u -> m (Consumed (m (Reply s u b)))) -> ParsecT s u m b
forall a b. (a -> b) -> a -> b
$ \State s u
s' -> Consumed (m (Reply s u a)) -> m (Consumed (m (Reply s u b)))
c (State s u -> a -> Consumed (m (Reply s u a))
forall {m :: * -> *} {s} {u} {a}.
Monad m =>
State s u -> a -> Consumed (m (Reply s u a))
pack State s u
s' a
a))) State s u
s

     where pack :: State s u -> a -> Consumed (m (Reply s u a))
pack State s u
s a
a= m (Reply s u a) -> Consumed (m (Reply s u a))
forall a. a -> Consumed a
Empty (m (Reply s u a) -> Consumed (m (Reply s u a)))
-> m (Reply s u a) -> Consumed (m (Reply s u a))
forall a b. (a -> b) -> a -> b
$ Reply s u a -> m (Reply s u a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> State s u -> ParseError -> Reply s u a
forall s u a. a -> State s u -> ParseError -> Reply s u a
Ok a
a State s u
s (State s u -> ParseError
forall s u. State s u -> ParseError
unknownError State s u
s))

instance (MonadError e m) => MonadError e (ParsecT s u m) where
    throwError :: forall a. e -> ParsecT s u m a
throwError = m a -> ParsecT s u m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ParsecT s u m a) -> (e -> m a) -> e -> ParsecT s u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
    ParsecT s u m a
p catchError :: forall a.
ParsecT s u m a -> (e -> ParsecT s u m a) -> ParsecT s u m a
`catchError` e -> ParsecT s u m a
h = (State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
forall (m :: * -> *) s u a.
Monad m =>
(State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
mkPT ((State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a)
-> (State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ \State s u
s ->
        ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
forall (m :: * -> *) s u a.
Monad m =>
ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
runParsecT ParsecT s u m a
p State s u
s m (Consumed (m (Reply s u a)))
-> (e -> m (Consumed (m (Reply s u a))))
-> m (Consumed (m (Reply s u a)))
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \e
e ->
            ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
forall (m :: * -> *) s u a.
Monad m =>
ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
runParsecT (e -> ParsecT s u m a
h e
e) State s u
s

parserReturn :: a -> ParsecT s u m a
parserReturn :: forall a s u (m :: * -> *). a -> ParsecT s u m a
parserReturn a
x
    = (forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m a)
-> (forall b.
    State s u
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ \State s u
s a -> State s u -> ParseError -> m b
_ ParseError -> m b
_ a -> State s u -> ParseError -> m b
eok ParseError -> m b
_ ->
      a -> State s u -> ParseError -> m b
eok a
x State s u
s (State s u -> ParseError
forall s u. State s u -> ParseError
unknownError State s u
s)

parserBind :: ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
{-# INLINE parserBind #-}
parserBind :: forall s u (m :: * -> *) a b.
ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
parserBind ParsecT s u m a
m a -> ParsecT s u m b
k
  = (forall b.
 State s u
 -> (b -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (b -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m b
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> (b -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> (b -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m b)
-> (forall b.
    State s u
    -> (b -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> (b -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m b
forall a b. (a -> b) -> a -> b
$ \State s u
s b -> State s u -> ParseError -> m b
cok ParseError -> m b
cerr b -> State s u -> ParseError -> m b
eok ParseError -> m b
eerr ->
    let
        -- consumed-okay case for m
        mcok :: a -> State s u -> ParseError -> m b
mcok a
x State s u
s ParseError
err =
            let
                 -- if (k x) consumes, those go straigt up
                 pcok :: b -> State s u -> ParseError -> m b
pcok = b -> State s u -> ParseError -> m b
cok
                 pcerr :: ParseError -> m b
pcerr = ParseError -> m b
cerr

                 -- if (k x) doesn't consume input, but is okay,
                 -- we still return in the consumed continuation
                 peok :: b -> State s u -> ParseError -> m b
peok b
x State s u
s ParseError
err' = b -> State s u -> ParseError -> m b
cok b
x State s u
s (ParseError -> ParseError -> ParseError
mergeError ParseError
err ParseError
err')

                 -- if (k x) doesn't consume input, but errors,
                 -- we return the error in the 'consumed-error'
                 -- continuation
                 peerr :: ParseError -> m b
peerr ParseError
err' = ParseError -> m b
cerr (ParseError -> ParseError -> ParseError
mergeError ParseError
err ParseError
err')
            in  ParsecT s u m b
-> forall b.
   State s u
   -> (b -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (b -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
forall s u (m :: * -> *) a.
ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
unParser (a -> ParsecT s u m b
k a
x) State s u
s b -> State s u -> ParseError -> m b
pcok ParseError -> m b
pcerr b -> State s u -> ParseError -> m b
peok ParseError -> m b
peerr

        -- empty-ok case for m
        meok :: a -> State s u -> ParseError -> m b
meok a
x State s u
s ParseError
err =
            let
                -- in these cases, (k x) can return as empty
                pcok :: b -> State s u -> ParseError -> m b
pcok = b -> State s u -> ParseError -> m b
cok
                peok :: b -> State s u -> ParseError -> m b
peok b
x State s u
s ParseError
err' = b -> State s u -> ParseError -> m b
eok b
x State s u
s (ParseError -> ParseError -> ParseError
mergeError ParseError
err ParseError
err')
                pcerr :: ParseError -> m b
pcerr = ParseError -> m b
cerr
                peerr :: ParseError -> m b
peerr ParseError
err' = ParseError -> m b
eerr (ParseError -> ParseError -> ParseError
mergeError ParseError
err ParseError
err')
            in  ParsecT s u m b
-> forall b.
   State s u
   -> (b -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (b -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
forall s u (m :: * -> *) a.
ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
unParser (a -> ParsecT s u m b
k a
x) State s u
s b -> State s u -> ParseError -> m b
pcok ParseError -> m b
pcerr b -> State s u -> ParseError -> m b
peok ParseError -> m b
peerr
        -- consumed-error case for m
        mcerr :: ParseError -> m b
mcerr = ParseError -> m b
cerr

        -- empty-error case for m
        meerr :: ParseError -> m b
meerr = ParseError -> m b
eerr

    in ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
forall s u (m :: * -> *) a.
ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
unParser ParsecT s u m a
m State s u
s a -> State s u -> ParseError -> m b
mcok ParseError -> m b
mcerr a -> State s u -> ParseError -> m b
meok ParseError -> m b
meerr


mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a
mergeErrorReply :: forall s u a. ParseError -> Reply s u a -> Reply s u a
mergeErrorReply ParseError
err1 Reply s u a
reply -- XXX where to put it?
    = case Reply s u a
reply of
        Ok a
x State s u
state ParseError
err2 -> a -> State s u -> ParseError -> Reply s u a
forall s u a. a -> State s u -> ParseError -> Reply s u a
Ok a
x State s u
state (ParseError -> ParseError -> ParseError
mergeError ParseError
err1 ParseError
err2)
        Error ParseError
err2      -> ParseError -> Reply s u a
forall s u a. ParseError -> Reply s u a
Error (ParseError -> ParseError -> ParseError
mergeError ParseError
err1 ParseError
err2)

parserFail :: String -> ParsecT s u m a
parserFail :: forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail String
msg
    = (forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m a)
-> (forall b.
    State s u
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ \State s u
s a -> State s u -> ParseError -> m b
_ ParseError -> m b
_ a -> State s u -> ParseError -> m b
_ ParseError -> m b
eerr ->
      ParseError -> m b
eerr (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ Message -> SourcePos -> ParseError
newErrorMessage (String -> Message
Message String
msg) (State s u -> SourcePos
forall s u. State s u -> SourcePos
statePos State s u
s)

instance MonadPlus (ParsecT s u m) where
    mzero :: forall a. ParsecT s u m a
mzero = ParsecT s u m a
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
    mplus :: forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
mplus ParsecT s u m a
p1 ParsecT s u m a
p2 = ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
parserPlus ParsecT s u m a
p1 ParsecT s u m a
p2

-- | @parserZero@ always fails without consuming any input. @parserZero@ is defined
-- equal to the 'mzero' member of the 'MonadPlus' class and to the 'Control.Applicative.empty' member
-- of the 'Control.Applicative.Alternative' class.

parserZero :: ParsecT s u m a
parserZero :: forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
    = (forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m a)
-> (forall b.
    State s u
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ \State s u
s a -> State s u -> ParseError -> m b
_ ParseError -> m b
_ a -> State s u -> ParseError -> m b
_ ParseError -> m b
eerr ->
      ParseError -> m b
eerr (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ State s u -> ParseError
forall s u. State s u -> ParseError
unknownError State s u
s

parserPlus :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
{-# INLINE parserPlus #-}
parserPlus :: forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
parserPlus ParsecT s u m a
m ParsecT s u m a
n
    = (forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m a)
-> (forall b.
    State s u
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ \State s u
s a -> State s u -> ParseError -> m b
cok ParseError -> m b
cerr a -> State s u -> ParseError -> m b
eok ParseError -> m b
eerr ->
      let
          meerr :: ParseError -> m b
meerr ParseError
err =
              let
                  neok :: a -> State s u -> ParseError -> m b
neok a
y State s u
s' ParseError
err' = a -> State s u -> ParseError -> m b
eok a
y State s u
s' (ParseError -> ParseError -> ParseError
mergeError ParseError
err ParseError
err')
                  neerr :: ParseError -> m b
neerr ParseError
err' = ParseError -> m b
eerr (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ ParseError -> ParseError -> ParseError
mergeError ParseError
err ParseError
err'
              in ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
forall s u (m :: * -> *) a.
ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
unParser ParsecT s u m a
n State s u
s a -> State s u -> ParseError -> m b
cok ParseError -> m b
cerr a -> State s u -> ParseError -> m b
neok ParseError -> m b
neerr
      in ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
forall s u (m :: * -> *) a.
ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
unParser ParsecT s u m a
m State s u
s a -> State s u -> ParseError -> m b
cok ParseError -> m b
cerr a -> State s u -> ParseError -> m b
eok ParseError -> m b
meerr

instance MonadTrans (ParsecT s u) where
    lift :: forall (m :: * -> *) a. Monad m => m a -> ParsecT s u m a
lift m a
amb = (forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m a)
-> (forall b.
    State s u
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ \State s u
s a -> State s u -> ParseError -> m b
_ ParseError -> m b
_ a -> State s u -> ParseError -> m b
eok ParseError -> m b
_ -> do
               a
a <- m a
amb
               a -> State s u -> ParseError -> m b
eok a
a State s u
s (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ State s u -> ParseError
forall s u. State s u -> ParseError
unknownError State s u
s

infix  0 <?>
infixr 1 <|>

-- | The parser @p \<?> msg@ behaves as parser @p@, but whenever the
-- parser @p@ fails /without consuming any input/, it replaces expect
-- error messages with the expect error message @msg@.
--
-- This is normally used at the end of a set alternatives where we want
-- to return an error message in terms of a higher level construct
-- rather than returning all possible characters. For example, if the
-- @expr@ parser from the 'try' example would fail, the error
-- message is: '...: expecting expression'. Without the @(\<?>)@
-- combinator, the message would be like '...: expecting \"let\" or
-- letter', which is less friendly.

(<?>) :: (ParsecT s u m a) -> String -> (ParsecT s u m a)
ParsecT s u m a
p <?> :: forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
msg = ParsecT s u m a -> String -> ParsecT s u m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
label ParsecT s u m a
p String
msg

-- | This combinator implements choice. The parser @p \<|> q@ first
-- applies @p@. If it succeeds, the value of @p@ is returned. If @p@
-- fails /without consuming any input/, parser @q@ is tried. This
-- combinator is defined equal to the 'mplus' member of the 'MonadPlus'
-- class and the ('Control.Applicative.<|>') member of 'Control.Applicative.Alternative'.
--
-- The parser is called /predictive/ since @q@ is only tried when
-- parser @p@ didn't consume any input (i.e.. the look ahead is 1).
-- This non-backtracking behaviour allows for both an efficient
-- implementation of the parser combinators and the generation of good
-- error messages.

(<|>) :: (ParsecT s u m a) -> (ParsecT s u m a) -> (ParsecT s u m a)
ParsecT s u m a
p1 <|> :: forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m a
p2 = ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus ParsecT s u m a
p1 ParsecT s u m a
p2

-- | A synonym for @\<?>@, but as a function instead of an operator.
label :: ParsecT s u m a -> String -> ParsecT s u m a
label :: forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
label ParsecT s u m a
p String
msg
  = ParsecT s u m a -> [String] -> ParsecT s u m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> [String] -> ParsecT s u m a
labels ParsecT s u m a
p [String
msg]

labels :: ParsecT s u m a -> [String] -> ParsecT s u m a
labels :: forall s u (m :: * -> *) a.
ParsecT s u m a -> [String] -> ParsecT s u m a
labels ParsecT s u m a
p [String]
msgs =
    (forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m a)
-> (forall b.
    State s u
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ \State s u
s a -> State s u -> ParseError -> m b
cok ParseError -> m b
cerr a -> State s u -> ParseError -> m b
eok ParseError -> m b
eerr ->
    let eok' :: a -> State s u -> ParseError -> m b
eok' a
x State s u
s' ParseError
error = a -> State s u -> ParseError -> m b
eok a
x State s u
s' (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ if ParseError -> Bool
errorIsUnknown ParseError
error
                  then ParseError
error
                  else ParseError -> [String] -> ParseError
setExpectErrors ParseError
error [String]
msgs
        eerr' :: ParseError -> m b
eerr' ParseError
err = ParseError -> m b
eerr (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ ParseError -> [String] -> ParseError
setExpectErrors ParseError
err [String]
msgs

    in ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
forall s u (m :: * -> *) a.
ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
unParser ParsecT s u m a
p State s u
s a -> State s u -> ParseError -> m b
cok ParseError -> m b
cerr a -> State s u -> ParseError -> m b
eok' ParseError -> m b
eerr'

 where
   setExpectErrors :: ParseError -> [String] -> ParseError
setExpectErrors ParseError
err []         = Message -> ParseError -> ParseError
setErrorMessage (String -> Message
Expect String
"") ParseError
err
   setExpectErrors ParseError
err [String
msg]      = Message -> ParseError -> ParseError
setErrorMessage (String -> Message
Expect String
msg) ParseError
err
   setExpectErrors ParseError
err (String
msg:[String]
msgs)
       = (String -> ParseError -> ParseError)
-> ParseError -> [String] -> ParseError
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\String
msg' ParseError
err' -> Message -> ParseError -> ParseError
addErrorMessage (String -> Message
Expect String
msg') ParseError
err')
         (Message -> ParseError -> ParseError
setErrorMessage (String -> Message
Expect String
msg) ParseError
err) [String]
msgs

-- TODO: There should be a stronger statement that can be made about this

-- | An instance of @Stream@ has stream type @s@, underlying monad @m@ and token type @t@ determined by the stream
--
-- Some rough guidelines for a \"correct\" instance of Stream:
--
--    * unfoldM uncons gives the [t] corresponding to the stream
--
--    * A @Stream@ instance is responsible for maintaining the \"position within the stream\" in the stream state @s@.  This is trivial unless you are using the monad in a non-trivial way.

class (Monad m) => Stream s m t | s -> t where
    uncons :: s -> m (Maybe (t,s))

instance (Monad m) => Stream [tok] m tok where
    uncons :: [tok] -> m (Maybe (tok, [tok]))
uncons []     = Maybe (tok, [tok]) -> m (Maybe (tok, [tok]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (tok, [tok]) -> m (Maybe (tok, [tok])))
-> Maybe (tok, [tok]) -> m (Maybe (tok, [tok]))
forall a b. (a -> b) -> a -> b
$ Maybe (tok, [tok])
forall a. Maybe a
Nothing
    uncons (tok
t:[tok]
ts) = Maybe (tok, [tok]) -> m (Maybe (tok, [tok]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (tok, [tok]) -> m (Maybe (tok, [tok])))
-> Maybe (tok, [tok]) -> m (Maybe (tok, [tok]))
forall a b. (a -> b) -> a -> b
$ (tok, [tok]) -> Maybe (tok, [tok])
forall a. a -> Maybe a
Just (tok
t,[tok]
ts)
    {-# INLINE uncons #-}


instance (Monad m) => Stream CL.ByteString m Char where
    uncons :: ByteString -> m (Maybe (Char, ByteString))
uncons = Maybe (Char, ByteString) -> m (Maybe (Char, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Char, ByteString) -> m (Maybe (Char, ByteString)))
-> (ByteString -> Maybe (Char, ByteString))
-> ByteString
-> m (Maybe (Char, ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Char, ByteString)
CL.uncons

instance (Monad m) => Stream C.ByteString m Char where
    uncons :: ByteString -> m (Maybe (Char, ByteString))
uncons = Maybe (Char, ByteString) -> m (Maybe (Char, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Char, ByteString) -> m (Maybe (Char, ByteString)))
-> (ByteString -> Maybe (Char, ByteString))
-> ByteString
-> m (Maybe (Char, ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Char, ByteString)
C.uncons

instance (Monad m) => Stream Text.Text m Char where
    uncons :: Text -> m (Maybe (Char, Text))
uncons = Maybe (Char, Text) -> m (Maybe (Char, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Char, Text) -> m (Maybe (Char, Text)))
-> (Text -> Maybe (Char, Text)) -> Text -> m (Maybe (Char, Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
Text.uncons
    {-# INLINE uncons #-}

instance (Monad m) => Stream TextL.Text m Char where
    uncons :: Text -> m (Maybe (Char, Text))
uncons = Maybe (Char, Text) -> m (Maybe (Char, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Char, Text) -> m (Maybe (Char, Text)))
-> (Text -> Maybe (Char, Text)) -> Text -> m (Maybe (Char, Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
TextL.uncons
    {-# INLINE uncons #-}


tokens :: (Stream s m t, Eq t)
       => ([t] -> String)      -- Pretty print a list of tokens
       -> (SourcePos -> [t] -> SourcePos)
       -> [t]                  -- List of tokens to parse
       -> ParsecT s u m [t]
{-# INLINE tokens #-}
tokens :: forall s (m :: * -> *) t u.
(Stream s m t, Eq t) =>
([t] -> String)
-> (SourcePos -> [t] -> SourcePos) -> [t] -> ParsecT s u m [t]
tokens [t] -> String
_ SourcePos -> [t] -> SourcePos
_ []
    = (forall b.
 State s u
 -> ([t] -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> ([t] -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m [t]
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> ([t] -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> ([t] -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m [t])
-> (forall b.
    State s u
    -> ([t] -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> ([t] -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m [t]
forall a b. (a -> b) -> a -> b
$ \State s u
s [t] -> State s u -> ParseError -> m b
_ ParseError -> m b
_ [t] -> State s u -> ParseError -> m b
eok ParseError -> m b
_ ->
      [t] -> State s u -> ParseError -> m b
eok [] State s u
s (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ State s u -> ParseError
forall s u. State s u -> ParseError
unknownError State s u
s
tokens [t] -> String
showTokens SourcePos -> [t] -> SourcePos
nextposs tts :: [t]
tts@(t
tok:[t]
toks)
    = (forall b.
 State s u
 -> ([t] -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> ([t] -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m [t]
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> ([t] -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> ([t] -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m [t])
-> (forall b.
    State s u
    -> ([t] -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> ([t] -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m [t]
forall a b. (a -> b) -> a -> b
$ \(State s
input SourcePos
pos u
u) [t] -> State s u -> ParseError -> m b
cok ParseError -> m b
cerr [t] -> State s u -> ParseError -> m b
_eok ParseError -> m b
eerr ->
    let
        errEof :: ParseError
errEof = (Message -> ParseError -> ParseError
setErrorMessage (String -> Message
Expect ([t] -> String
showTokens [t]
tts))
                  (Message -> SourcePos -> ParseError
newErrorMessage (String -> Message
SysUnExpect String
"") SourcePos
pos))

        errExpect :: t -> ParseError
errExpect t
x = (Message -> ParseError -> ParseError
setErrorMessage (String -> Message
Expect ([t] -> String
showTokens [t]
tts))
                       (Message -> SourcePos -> ParseError
newErrorMessage (String -> Message
SysUnExpect ([t] -> String
showTokens [t
x])) SourcePos
pos))

        walk :: [t] -> s -> m b
walk []     s
rs = s -> m b
ok s
rs
        walk (t
t:[t]
ts) s
rs = do
          Maybe (t, s)
sr <- s -> m (Maybe (t, s))
forall s (m :: * -> *) t. Stream s m t => s -> m (Maybe (t, s))
uncons s
rs
          case Maybe (t, s)
sr of
            Maybe (t, s)
Nothing                 -> ParseError -> m b
cerr (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ ParseError
errEof
            Just (t
x,s
xs) | t
t t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
x    -> [t] -> s -> m b
walk [t]
ts s
xs
                        | Bool
otherwise -> ParseError -> m b
cerr (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ t -> ParseError
errExpect t
x

        ok :: s -> m b
ok s
rs = let pos' :: SourcePos
pos' = SourcePos -> [t] -> SourcePos
nextposs SourcePos
pos [t]
tts
                    s' :: State s u
s' = s -> SourcePos -> u -> State s u
forall s u. s -> SourcePos -> u -> State s u
State s
rs SourcePos
pos' u
u
                in [t] -> State s u -> ParseError -> m b
cok [t]
tts State s u
s' (SourcePos -> ParseError
newErrorUnknown SourcePos
pos')
    in do
        Maybe (t, s)
sr <- s -> m (Maybe (t, s))
forall s (m :: * -> *) t. Stream s m t => s -> m (Maybe (t, s))
uncons s
input
        case Maybe (t, s)
sr of
            Maybe (t, s)
Nothing         -> ParseError -> m b
eerr (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ ParseError
errEof
            Just (t
x,s
xs)
                | t
tok t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
x  -> [t] -> s -> m b
walk [t]
toks s
xs
                | Bool
otherwise -> ParseError -> m b
eerr (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ t -> ParseError
errExpect t
x

-- | The parser @try p@ behaves like parser @p@, except that it
-- pretends that it hasn't consumed any input when an error occurs.
--
-- This combinator is used whenever arbitrary look ahead is needed.
-- Since it pretends that it hasn't consumed any input when @p@ fails,
-- the ('<|>') combinator will try its second alternative even when the
-- first parser failed while consuming input.
--
-- The @try@ combinator can for example be used to distinguish
-- identifiers and reserved words. Both reserved words and identifiers
-- are a sequence of letters. Whenever we expect a certain reserved
-- word where we can also expect an identifier we have to use the @try@
-- combinator. Suppose we write:
--
-- >  expr        = letExpr <|> identifier <?> "expression"
-- >
-- >  letExpr     = do{ string "let"; ... }
-- >  identifier  = many1 letter
--
-- If the user writes \"lexical\", the parser fails with: @unexpected
-- \'x\', expecting \'t\' in \"let\"@. Indeed, since the ('<|>') combinator
-- only tries alternatives when the first alternative hasn't consumed
-- input, the @identifier@ parser is never tried (because the prefix
-- \"le\" of the @string \"let\"@ parser is already consumed). The
-- right behaviour can be obtained by adding the @try@ combinator:
--
-- >  expr        = letExpr <|> identifier <?> "expression"
-- >
-- >  letExpr     = do{ try (string "let"); ... }
-- >  identifier  = many1 letter

try :: ParsecT s u m a -> ParsecT s u m a
try :: forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m a
p =
    (forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m a)
-> (forall b.
    State s u
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ \State s u
s a -> State s u -> ParseError -> m b
cok ParseError -> m b
_ a -> State s u -> ParseError -> m b
eok ParseError -> m b
eerr ->
    ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
forall s u (m :: * -> *) a.
ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
unParser ParsecT s u m a
p State s u
s a -> State s u -> ParseError -> m b
cok ParseError -> m b
eerr a -> State s u -> ParseError -> m b
eok ParseError -> m b
eerr

-- | @lookAhead p@ parses @p@ without consuming any input.
--
-- If @p@ fails and consumes some input, so does @lookAhead@. Combine with 'try'
-- if this is undesirable.

lookAhead :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m a
lookAhead :: forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT s u m a
p =
    (forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m a)
-> (forall b.
    State s u
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ \State s u
s a -> State s u -> ParseError -> m b
_ ParseError -> m b
cerr a -> State s u -> ParseError -> m b
eok ParseError -> m b
eerr -> do
        let eok' :: a -> p -> p -> m b
eok' a
a p
_ p
_ = a -> State s u -> ParseError -> m b
eok a
a State s u
s (SourcePos -> ParseError
newErrorUnknown (State s u -> SourcePos
forall s u. State s u -> SourcePos
statePos State s u
s))
        ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
forall s u (m :: * -> *) a.
ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
unParser ParsecT s u m a
p State s u
s a -> State s u -> ParseError -> m b
forall {p} {p}. a -> p -> p -> m b
eok' ParseError -> m b
cerr a -> State s u -> ParseError -> m b
forall {p} {p}. a -> p -> p -> m b
eok' ParseError -> m b
eerr

-- | The parser @token showTok posFromTok testTok@ accepts a token @t@
-- with result @x@ when the function @testTok t@ returns @'Just' x@. The
-- source position of the @t@ should be returned by @posFromTok t@ and
-- the token can be shown using @showTok t@.
--
-- This combinator is expressed in terms of 'tokenPrim'.
-- It is used to accept user defined token streams. For example,
-- suppose that we have a stream of basic tokens tupled with source
-- positions. We can then define a parser that accepts single tokens as:
--
-- >  mytoken x
-- >    = token showTok posFromTok testTok
-- >    where
-- >      showTok (pos,t)     = show t
-- >      posFromTok (pos,t)  = pos
-- >      testTok (pos,t)     = if x == t then Just t else Nothing

token :: (Stream s Identity t)
      => (t -> String)            -- ^ Token pretty-printing function.
      -> (t -> SourcePos)         -- ^ Computes the position of a token.
      -> (t -> Maybe a)           -- ^ Matching function for the token to parse.
      -> Parsec s u a
{-# INLINABLE token #-}
token :: forall s t a u.
Stream s Identity t =>
(t -> String) -> (t -> SourcePos) -> (t -> Maybe a) -> Parsec s u a
token t -> String
showToken t -> SourcePos
tokpos t -> Maybe a
test = (t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u Identity a
forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrim t -> String
showToken SourcePos -> t -> s -> SourcePos
forall {s} {p}. Stream s Identity t => p -> t -> s -> SourcePos
nextpos t -> Maybe a
test
    where
        nextpos :: p -> t -> s -> SourcePos
nextpos p
_ t
tok s
ts = case Identity (Maybe (t, s)) -> Maybe (t, s)
forall a. Identity a -> a
runIdentity (s -> Identity (Maybe (t, s))
forall s (m :: * -> *) t. Stream s m t => s -> m (Maybe (t, s))
uncons s
ts) of
                             Maybe (t, s)
Nothing -> t -> SourcePos
tokpos t
tok
                             Just (t
tok',s
_) -> t -> SourcePos
tokpos t
tok'

-- | The parser @tokenPrim showTok nextPos testTok@ accepts a token @t@
-- with result @x@ when the function @testTok t@ returns @'Just' x@. The
-- token can be shown using @showTok t@. The position of the /next/
-- token should be returned when @nextPos@ is called with the current
-- source position @pos@, the current token @t@ and the rest of the
-- tokens @toks@, @nextPos pos t toks@.
--
-- This is the most primitive combinator for accepting tokens. For
-- example, the 'Text.Parsec.Char.char' parser could be implemented as:
--
-- >  char c
-- >    = tokenPrim showChar nextPos testChar
-- >    where
-- >      showChar x        = "'" ++ x ++ "'"
-- >      testChar x        = if x == c then Just x else Nothing
-- >      nextPos pos x xs  = updatePosChar pos x

tokenPrim :: (Stream s m t)
          => (t -> String)                      -- ^ Token pretty-printing function.
          -> (SourcePos -> t -> s -> SourcePos) -- ^ Next position calculating function.
          -> (t -> Maybe a)                     -- ^ Matching function for the token to parse.
          -> ParsecT s u m a
{-# INLINE tokenPrim #-}
tokenPrim :: forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrim t -> String
showToken SourcePos -> t -> s -> SourcePos
nextpos t -> Maybe a
test = (t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> Maybe (SourcePos -> t -> s -> u -> u)
-> (t -> Maybe a)
-> ParsecT s u m a
forall s (m :: * -> *) t u a.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> Maybe (SourcePos -> t -> s -> u -> u)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrimEx t -> String
showToken SourcePos -> t -> s -> SourcePos
nextpos Maybe (SourcePos -> t -> s -> u -> u)
forall a. Maybe a
Nothing t -> Maybe a
test

tokenPrimEx :: (Stream s m t)
            => (t -> String)
            -> (SourcePos -> t -> s -> SourcePos)
            -> Maybe (SourcePos -> t -> s -> u -> u)
            -> (t -> Maybe a)
            -> ParsecT s u m a
{-# INLINE tokenPrimEx #-}
tokenPrimEx :: forall s (m :: * -> *) t u a.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> Maybe (SourcePos -> t -> s -> u -> u)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrimEx t -> String
showToken SourcePos -> t -> s -> SourcePos
nextpos Maybe (SourcePos -> t -> s -> u -> u)
Nothing t -> Maybe a
test
  = (forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m a)
-> (forall b.
    State s u
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ \(State s
input SourcePos
pos u
user) a -> State s u -> ParseError -> m b
cok ParseError -> m b
_cerr a -> State s u -> ParseError -> m b
_eok ParseError -> m b
eerr -> do
      Maybe (t, s)
r <- s -> m (Maybe (t, s))
forall s (m :: * -> *) t. Stream s m t => s -> m (Maybe (t, s))
uncons s
input
      case Maybe (t, s)
r of
        Maybe (t, s)
Nothing -> ParseError -> m b
eerr (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ String -> SourcePos -> ParseError
unexpectError String
"" SourcePos
pos
        Just (t
c,s
cs)
         -> case t -> Maybe a
test t
c of
              Just a
x -> let newpos :: SourcePos
newpos = SourcePos -> t -> s -> SourcePos
nextpos SourcePos
pos t
c s
cs
                            newstate :: State s u
newstate = s -> SourcePos -> u -> State s u
forall s u. s -> SourcePos -> u -> State s u
State s
cs SourcePos
newpos u
user
                        in SourcePos -> m b -> m b
seq SourcePos
newpos (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ State s u -> m b -> m b
seq State s u
newstate (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$
                           a -> State s u -> ParseError -> m b
cok a
x State s u
newstate (SourcePos -> ParseError
newErrorUnknown SourcePos
newpos)
              Maybe a
Nothing -> ParseError -> m b
eerr (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ String -> SourcePos -> ParseError
unexpectError (t -> String
showToken t
c) SourcePos
pos
tokenPrimEx t -> String
showToken SourcePos -> t -> s -> SourcePos
nextpos (Just SourcePos -> t -> s -> u -> u
nextState) t -> Maybe a
test
  = (forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> (a -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m a)
-> (forall b.
    State s u
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> (a -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ \(State s
input SourcePos
pos u
user) a -> State s u -> ParseError -> m b
cok ParseError -> m b
_cerr a -> State s u -> ParseError -> m b
_eok ParseError -> m b
eerr -> do
      Maybe (t, s)
r <- s -> m (Maybe (t, s))
forall s (m :: * -> *) t. Stream s m t => s -> m (Maybe (t, s))
uncons s
input
      case Maybe (t, s)
r of
        Maybe (t, s)
Nothing -> ParseError -> m b
eerr (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ String -> SourcePos -> ParseError
unexpectError String
"" SourcePos
pos
        Just (t
c,s
cs)
         -> case t -> Maybe a
test t
c of
              Just a
x -> let newpos :: SourcePos
newpos = SourcePos -> t -> s -> SourcePos
nextpos SourcePos
pos t
c s
cs
                            newUser :: u
newUser = SourcePos -> t -> s -> u -> u
nextState SourcePos
pos t
c s
cs u
user
                            newstate :: State s u
newstate = s -> SourcePos -> u -> State s u
forall s u. s -> SourcePos -> u -> State s u
State s
cs SourcePos
newpos u
newUser
                        in SourcePos -> m b -> m b
seq SourcePos
newpos (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ State s u -> m b -> m b
seq State s u
newstate (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$
                           a -> State s u -> ParseError -> m b
cok a
x State s u
newstate (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ SourcePos -> ParseError
newErrorUnknown SourcePos
newpos
              Maybe a
Nothing -> ParseError -> m b
eerr (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ String -> SourcePos -> ParseError
unexpectError (t -> String
showToken t
c) SourcePos
pos

unexpectError :: String -> SourcePos -> ParseError
unexpectError :: String -> SourcePos -> ParseError
unexpectError String
msg SourcePos
pos = Message -> SourcePos -> ParseError
newErrorMessage (String -> Message
SysUnExpect String
msg) SourcePos
pos


-- | @many p@ applies the parser @p@ /zero/ or more times. Returns a
--    list of the returned values of @p@.
--
-- >  identifier  = do{ c  <- letter
-- >                  ; cs <- many (alphaNum <|> char '_')
-- >                  ; return (c:cs)
-- >                  }

many :: ParsecT s u m a -> ParsecT s u m [a]
many :: forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s u m a
p
  = do [a]
xs <- (a -> [a] -> [a]) -> ParsecT s u m a -> ParsecT s u m [a]
forall a s u (m :: * -> *).
(a -> [a] -> [a]) -> ParsecT s u m a -> ParsecT s u m [a]
manyAccum (:) ParsecT s u m a
p
       [a] -> ParsecT s u m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs)

-- | @skipMany p@ applies the parser @p@ /zero/ or more times, skipping
-- its result.
--
-- >  spaces  = skipMany space

skipMany :: ParsecT s u m a -> ParsecT s u m ()
skipMany :: forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT s u m a
p
  = do [a]
_ <- (a -> [a] -> [a]) -> ParsecT s u m a -> ParsecT s u m [a]
forall a s u (m :: * -> *).
(a -> [a] -> [a]) -> ParsecT s u m a -> ParsecT s u m [a]
manyAccum (\a
_ [a]
_ -> []) ParsecT s u m a
p
       () -> ParsecT s u m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

manyAccum :: (a -> [a] -> [a])
          -> ParsecT s u m a
          -> ParsecT s u m [a]
manyAccum :: forall a s u (m :: * -> *).
(a -> [a] -> [a]) -> ParsecT s u m a -> ParsecT s u m [a]
manyAccum a -> [a] -> [a]
acc ParsecT s u m a
p =
    (forall b.
 State s u
 -> ([a] -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> ([a] -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m [a]
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> ([a] -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> ([a] -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m [a])
-> (forall b.
    State s u
    -> ([a] -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> ([a] -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m [a]
forall a b. (a -> b) -> a -> b
$ \State s u
s [a] -> State s u -> ParseError -> m b
cok ParseError -> m b
cerr [a] -> State s u -> ParseError -> m b
eok ParseError -> m b
_eerr ->
    let walk :: [a] -> a -> State s u -> ParseError -> m b
walk [a]
xs a
x State s u
s' ParseError
_err =
            ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
forall s u (m :: * -> *) a.
ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
unParser ParsecT s u m a
p State s u
s'
              ([a]
-> (a -> State s u -> ParseError -> m b)
-> a
-> State s u
-> ParseError
-> m b
seq [a]
xs ((a -> State s u -> ParseError -> m b)
 -> a -> State s u -> ParseError -> m b)
-> (a -> State s u -> ParseError -> m b)
-> a
-> State s u
-> ParseError
-> m b
forall a b. (a -> b) -> a -> b
$ [a] -> a -> State s u -> ParseError -> m b
walk ([a] -> a -> State s u -> ParseError -> m b)
-> [a] -> a -> State s u -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ a -> [a] -> [a]
acc a
x [a]
xs)  -- consumed-ok
              ParseError -> m b
cerr                        -- consumed-err
              a -> State s u -> ParseError -> m b
forall a. a
manyErr                     -- empty-ok
              (\ParseError
e -> [a] -> State s u -> ParseError -> m b
cok (a -> [a] -> [a]
acc a
x [a]
xs) State s u
s' ParseError
e) -- empty-err
    in ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
forall s u (m :: * -> *) a.
ParsecT s u m a
-> forall b.
   State s u
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> (a -> State s u -> ParseError -> m b)
   -> (ParseError -> m b)
   -> m b
unParser ParsecT s u m a
p State s u
s ([a] -> a -> State s u -> ParseError -> m b
walk []) ParseError -> m b
cerr a -> State s u -> ParseError -> m b
forall a. a
manyErr (\ParseError
e -> [a] -> State s u -> ParseError -> m b
eok [] State s u
s ParseError
e)

manyErr :: a
manyErr :: forall a. a
manyErr = String -> a
forall a. HasCallStack => String -> a
error String
"Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."


-- < Running a parser: monadic (runPT) and pure (runP)

runPT :: (Stream s m t)
      => ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)
{-# INLINABLE runPT #-}
runPT :: forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runPT ParsecT s u m a
p u
u String
name s
s
    = do Consumed (m (Reply s u a))
res <- ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
forall (m :: * -> *) s u a.
Monad m =>
ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
runParsecT ParsecT s u m a
p (s -> SourcePos -> u -> State s u
forall s u. s -> SourcePos -> u -> State s u
State s
s (String -> SourcePos
initialPos String
name) u
u)
         Reply s u a
r <- Consumed (m (Reply s u a)) -> m (Reply s u a)
forall {a}. Consumed a -> a
parserReply Consumed (m (Reply s u a))
res
         case Reply s u a
r of
           Ok a
x State s u
_ ParseError
_  -> Either ParseError a -> m (Either ParseError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either ParseError a
forall a b. b -> Either a b
Right a
x)
           Error ParseError
err -> Either ParseError a -> m (Either ParseError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseError -> Either ParseError a
forall a b. a -> Either a b
Left ParseError
err)
    where
        parserReply :: Consumed a -> a
parserReply Consumed a
res
            = case Consumed a
res of
                Consumed a
r -> a
r
                Empty    a
r -> a
r

runP :: (Stream s Identity t)
     => Parsec s u a -> u -> SourceName -> s -> Either ParseError a
runP :: forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runP Parsec s u a
p u
u String
name s
s = Identity (Either ParseError a) -> Either ParseError a
forall a. Identity a -> a
runIdentity (Identity (Either ParseError a) -> Either ParseError a)
-> Identity (Either ParseError a) -> Either ParseError a
forall a b. (a -> b) -> a -> b
$ Parsec s u a -> u -> String -> s -> Identity (Either ParseError a)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runPT Parsec s u a
p u
u String
name s
s

-- | The most general way to run a parser. @runParserT p state filePath
-- input@ runs parser @p@ on the input list of tokens @input@,
-- obtained from source @filePath@ with the initial user state @st@.
-- The @filePath@ is only used in error messages and may be the empty
-- string. Returns a computation in the underlying monad @m@ that return either a 'ParseError' ('Left') or a
-- value of type @a@ ('Right').

runParserT :: (Stream s m t)
           => ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)
runParserT :: forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT = ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runPT

-- | The most general way to run a parser over the Identity monad. @runParser p state filePath
-- input@ runs parser @p@ on the input list of tokens @input@,
-- obtained from source @filePath@ with the initial user state @st@.
-- The @filePath@ is only used in error messages and may be the empty
-- string. Returns either a 'ParseError' ('Left') or a
-- value of type @a@ ('Right').
--
-- >  parseFromFile p fname
-- >    = do{ input <- readFile fname
-- >        ; return (runParser p () fname input)
-- >        }

runParser :: (Stream s Identity t)
          => Parsec s u a -> u -> SourceName -> s -> Either ParseError a
runParser :: forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser = Parsec s u a -> u -> String -> s -> Either ParseError a
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runP

-- | @parse p filePath input@ runs a parser @p@ over Identity without user
-- state. The @filePath@ is only used in error messages and may be the
-- empty string. Returns either a 'ParseError' ('Left')
-- or a value of type @a@ ('Right').
--
-- >  main    = case (parse numbers "" "11, 2, 43") of
-- >             Left err  -> print err
-- >             Right xs  -> print (sum xs)
-- >
-- >  numbers = commaSep integer

parse :: (Stream s Identity t)
      => Parsec s () a -> SourceName -> s -> Either ParseError a
parse :: forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec s () a
p = Parsec s () a -> () -> String -> s -> Either ParseError a
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runP Parsec s () a
p ()

-- | The expression @parseTest p input@ applies a parser @p@ against
-- input @input@ and prints the result to stdout. Used for testing
-- parsers.

parseTest :: (Stream s Identity t, Show a)
          => Parsec s () a -> s -> IO ()
parseTest :: forall s t a.
(Stream s Identity t, Show a) =>
Parsec s () a -> s -> IO ()
parseTest Parsec s () a
p s
input
    = case Parsec s () a -> String -> s -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec s () a
p String
"" s
input of
        Left ParseError
err -> do String -> IO ()
putStr String
"parse error at "
                       ParseError -> IO ()
forall a. Show a => a -> IO ()
print ParseError
err
        Right a
x  -> a -> IO ()
forall a. Show a => a -> IO ()
print a
x

-- < Parser state combinators

-- | Returns the current source position. See also 'SourcePos'.

getPosition :: (Monad m) => ParsecT s u m SourcePos
getPosition :: forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition = do State s u
state <- ParsecT s u m (State s u)
forall (m :: * -> *) s u. Monad m => ParsecT s u m (State s u)
getParserState
                 SourcePos -> ParsecT s u m SourcePos
forall (m :: * -> *) a. Monad m => a -> m a
return (State s u -> SourcePos
forall s u. State s u -> SourcePos
statePos State s u
state)

-- | Returns the current input

getInput :: (Monad m) => ParsecT s u m s
getInput :: forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput = do State s u
state <- ParsecT s u m (State s u)
forall (m :: * -> *) s u. Monad m => ParsecT s u m (State s u)
getParserState
              s -> ParsecT s u m s
forall (m :: * -> *) a. Monad m => a -> m a
return (State s u -> s
forall s u. State s u -> s
stateInput State s u
state)

-- | @setPosition pos@ sets the current source position to @pos@.

setPosition :: (Monad m) => SourcePos -> ParsecT s u m ()
setPosition :: forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos
    = do State s u
_ <- (State s u -> State s u) -> ParsecT s u m (State s u)
forall s u (m :: * -> *).
(State s u -> State s u) -> ParsecT s u m (State s u)
updateParserState (\(State s
input SourcePos
_ u
user) -> s -> SourcePos -> u -> State s u
forall s u. s -> SourcePos -> u -> State s u
State s
input SourcePos
pos u
user)
         () -> ParsecT s u m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | @setInput input@ continues parsing with @input@. The 'getInput' and
-- @setInput@ functions can for example be used to deal with #include
-- files.

setInput :: (Monad m) => s -> ParsecT s u m ()
setInput :: forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput s
input
    = do State s u
_ <- (State s u -> State s u) -> ParsecT s u m (State s u)
forall s u (m :: * -> *).
(State s u -> State s u) -> ParsecT s u m (State s u)
updateParserState (\(State s
_ SourcePos
pos u
user) -> s -> SourcePos -> u -> State s u
forall s u. s -> SourcePos -> u -> State s u
State s
input SourcePos
pos u
user)
         () -> ParsecT s u m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Returns the full parser state as a 'State' record.

getParserState :: (Monad m) => ParsecT s u m (State s u)
getParserState :: forall (m :: * -> *) s u. Monad m => ParsecT s u m (State s u)
getParserState = (State s u -> State s u) -> ParsecT s u m (State s u)
forall s u (m :: * -> *).
(State s u -> State s u) -> ParsecT s u m (State s u)
updateParserState State s u -> State s u
forall a. a -> a
id

-- | @setParserState st@ set the full parser state to @st@.

setParserState :: (Monad m) => State s u -> ParsecT s u m (State s u)
setParserState :: forall (m :: * -> *) s u.
Monad m =>
State s u -> ParsecT s u m (State s u)
setParserState State s u
st = (State s u -> State s u) -> ParsecT s u m (State s u)
forall s u (m :: * -> *).
(State s u -> State s u) -> ParsecT s u m (State s u)
updateParserState (State s u -> State s u -> State s u
forall a b. a -> b -> a
const State s u
st)

-- | @updateParserState f@ applies function @f@ to the parser state.

updateParserState :: (State s u -> State s u) -> ParsecT s u m (State s u)
updateParserState :: forall s u (m :: * -> *).
(State s u -> State s u) -> ParsecT s u m (State s u)
updateParserState State s u -> State s u
f =
    (forall b.
 State s u
 -> (State s u -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (State s u -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m (State s u)
forall s u (m :: * -> *) a.
(forall b.
 State s u
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> (a -> State s u -> ParseError -> m b)
 -> (ParseError -> m b)
 -> m b)
-> ParsecT s u m a
ParsecT ((forall b.
  State s u
  -> (State s u -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> (State s u -> State s u -> ParseError -> m b)
  -> (ParseError -> m b)
  -> m b)
 -> ParsecT s u m (State s u))
-> (forall b.
    State s u
    -> (State s u -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> (State s u -> State s u -> ParseError -> m b)
    -> (ParseError -> m b)
    -> m b)
-> ParsecT s u m (State s u)
forall a b. (a -> b) -> a -> b
$ \State s u
s State s u -> State s u -> ParseError -> m b
_ ParseError -> m b
_ State s u -> State s u -> ParseError -> m b
eok ParseError -> m b
_ ->
    let s' :: State s u
s' = State s u -> State s u
f State s u
s
    in State s u -> State s u -> ParseError -> m b
eok State s u
s' State s u
s' (ParseError -> m b) -> ParseError -> m b
forall a b. (a -> b) -> a -> b
$ State s u -> ParseError
forall s u. State s u -> ParseError
unknownError State s u
s'

-- < User state combinators

-- | Returns the current user state.

getState :: (Monad m) => ParsecT s u m u
getState :: forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState = State s u -> u
forall s u. State s u -> u
stateUser (State s u -> u) -> ParsecT s u m (State s u) -> ParsecT s u m u
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ParsecT s u m (State s u)
forall (m :: * -> *) s u. Monad m => ParsecT s u m (State s u)
getParserState

-- | @putState st@ set the user state to @st@.

putState :: (Monad m) => u -> ParsecT s u m ()
putState :: forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState u
u = do State s u
_ <- (State s u -> State s u) -> ParsecT s u m (State s u)
forall s u (m :: * -> *).
(State s u -> State s u) -> ParsecT s u m (State s u)
updateParserState ((State s u -> State s u) -> ParsecT s u m (State s u))
-> (State s u -> State s u) -> ParsecT s u m (State s u)
forall a b. (a -> b) -> a -> b
$ \State s u
s -> State s u
s { stateUser :: u
stateUser = u
u }
                () -> ParsecT s u m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | @modifyState f@ applies function @f@ to the user state. Suppose
-- that we want to count identifiers in a source, we could use the user
-- state as:
--
-- >  expr  = do{ x <- identifier
-- >            ; modifyState (+1)
-- >            ; return (Id x)
-- >            }

modifyState :: (Monad m) => (u -> u) -> ParsecT s u m ()
modifyState :: forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState u -> u
f = do State s u
_ <- (State s u -> State s u) -> ParsecT s u m (State s u)
forall s u (m :: * -> *).
(State s u -> State s u) -> ParsecT s u m (State s u)
updateParserState ((State s u -> State s u) -> ParsecT s u m (State s u))
-> (State s u -> State s u) -> ParsecT s u m (State s u)
forall a b. (a -> b) -> a -> b
$ \State s u
s -> State s u
s { stateUser :: u
stateUser = u -> u
f (State s u -> u
forall s u. State s u -> u
stateUser State s u
s) }
                   () -> ParsecT s u m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- XXX Compat

-- | An alias for putState for backwards compatibility.

setState :: (Monad m) => u -> ParsecT s u m ()
setState :: forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState = u -> ParsecT s u m ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState

-- | An alias for modifyState for backwards compatibility.

updateState :: (Monad m) => (u -> u) -> ParsecT s u m ()
updateState :: forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState = (u -> u) -> ParsecT s u m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState