{-# 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
    , tokens'
    , try
    , token
    , tokenPrim
    , tokenPrimEx
    , many
    , skipMany
    , manyAccum
    , many1
    , 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 (MonadPlus (..), ap, void, liftM)
import Control.Monad.Trans (MonadTrans (lift), MonadIO (liftIO))
import Control.Monad.Identity (Identity, runIdentity)
import qualified Control.Monad.Fail as Fail

import Control.Monad.Reader.Class (MonadReader (..))
import Control.Monad.State.Class (MonadState (..))
import Control.Monad.Cont.Class (MonadCont (..))
import Control.Monad.Error.Class (MonadError (..))

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 Typeable 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 a. a -> m 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 a. a -> m 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 a. a -> m 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 a. a -> m 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 a. a -> m 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 a. a -> m 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 a. a -> m 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 a. a -> m 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
           cons <- State s u -> m (Consumed (m (Reply s u a)))
k State s u
s
           case cons of
             Consumed m (Reply s u a)
mrep -> do
                       rep <- m (Reply s u a)
mrep
                       case 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
                       rep <- m (Reply s u a)
mrep
                       case 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 a b c.
(a -> b -> c)
-> ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m c
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 a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
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)
forall (m :: * -> *) a. Monad m => NonEmpty (m a) -> m (NonEmpty 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. HasCallStack => [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 a. 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 a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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 { x1 <- ParsecT s u m a
p1 ; void p2 ; return x1 }

instance Applicative.Alternative (ParsecT s u m) where
    empty :: forall a. ParsecT s u m a
empty = ParsecT s u m a
forall a. 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 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

    -- TODO: https://github.com/haskell/parsec/issues/179
    -- investigate what's wrong with haddock
    --
    -- many = many
    -- some = many1

instance Monad (ParsecT s u m) where
    return :: forall a. a -> ParsecT s u m a
return = a -> ParsecT s u m a
forall a. 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 a 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 (m :: * -> *) a. Monad m => 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 a. 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 (m :: * -> *) a. Monad m => m a -> ParsecT s u m a
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 a. (r -> r) -> m a -> m 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 (m :: * -> *) a. Monad m => m a -> ParsecT s' u m a
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 (m :: * -> *) a. Monad m => m a -> ParsecT s' u m a
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 a b. ((a -> m b) -> m a) -> m 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 a. a -> m 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 (m :: * -> *) a. Monad m => 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 a. 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 a. m a -> (e -> m a) -> m 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
          | ParseError -> Bool
errorIsUnknown ParseError
err = 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
cok ParseError -> m b
cerr b -> State s u -> ParseError -> m b
cok ParseError -> m b
cerr
          | Bool
otherwise =
            let
                 -- if (k x) consumes, those go straight 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
          | ParseError -> Bool
errorIsUnknown ParseError
err = 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
cok ParseError -> m b
cerr b -> State s u -> ParseError -> m b
eok ParseError -> m b
eerr
          | Bool
otherwise =
            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 <- m a
amb
               eok a s $ unknownError 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 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 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 a b. (a -> b -> b) -> b -> [a] -> b
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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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
          sr <- s -> m (Maybe (t, s))
forall s (m :: * -> *) t. Stream s m t => s -> m (Maybe (t, s))
uncons s
rs
          case 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
        sr <- s -> m (Maybe (t, s))
forall s (m :: * -> *) t. Stream s m t => s -> m (Maybe (t, s))
uncons s
input
        case 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

-- | Like 'tokens', but doesn't consume matching prefix.
--
-- @since 3.1.16.0
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
          sr <- s -> m (Maybe (t, s))
forall s (m :: * -> *) t. Stream s m t => s -> m (Maybe (t, s))
uncons s
rs
          case 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
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
eerr (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
        sr <- s -> m (Maybe (t, s))
forall s (m :: * -> *) t. Stream s m t => s -> m (Maybe (t, s))
uncons s
input
        case 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
      r <- s -> m (Maybe (t, s))
forall s (m :: * -> *) t. Stream s m t => s -> m (Maybe (t, s))
uncons s
input
      case 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
forall a b. a -> b -> 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
forall a b. a -> b -> 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
      r <- s -> m (Maybe (t, s))
forall s (m :: * -> *) t. Stream s m t => s -> m (Maybe (t, s))
uncons s
input
      case 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
forall a b. a -> b -> 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
forall a b. a -> b -> 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 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
       return (reverse xs)

-- | @many1 p@ applies the parser @p@ /one/ or more times. Returns a
-- list of the returned values of @p@.
--
-- >  word  = many1 letter

many1 :: ParsecT s u m a -> ParsecT s u m [a]
{-# INLINABLE many1 #-}
many1 :: forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m a
p = do{ x <- ParsecT s u m a
p; xs <- many p; return (x: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]) -> 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
       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
forall a b. a -> b -> 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 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)
         r <- parserReply res
         case r of
           Ok a
x State s u
_ ParseError
_  -> Either ParseError a -> m (Either ParseError a)
forall a. a -> m 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 a. a -> m 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 <- ParsecT s u m (State s u)
forall (m :: * -> *) s u. Monad m => ParsecT s u m (State s u)
getParserState
                 return (statePos 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 <- ParsecT s u m (State s u)
forall (m :: * -> *) s u. Monad m => ParsecT s u m (State s u)
getParserState
              return (stateInput 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) -> 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)
         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) -> 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)
         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) -> 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 }
                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) -> 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 = f (stateUser s) }
                   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