{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts,
             UndecidableInstances, StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, RankNTypes, FlexibleInstances #-}
{-# OPTIONS_HADDOCK not-home #-}

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


import qualified Control.Exception as E
import Control.Monad()
import Control.Monad.Free (hoistFree)
import Control.Monad.Trans
import Control.Monad.Identity

import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Reader.Class
import Control.Monad.State.Class
import Control.Monad.Cont.Class
import Control.Monad.Error.Class

import Data.IORef
import Text.Parsec.Pos
import Text.Parsec.Error
import qualified Text.Parsec.Free as F
import qualified Text.Parsec.Free.Eval as F
import qualified Text.Parsec.Free.Log as F
import qualified "parsec" Text.Parsec.Prim as P
import "parsec" Text.Parsec.Prim (Stream, State(..))

type ParsecT = F.ParsecDSL

runParsecT :: ParsecT s u m a -> F.ParsecDSL s u m a
runParsecT :: forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
runParsecT = forall a. a -> a
id

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 = forall s u (m :: * -> *) a. String -> ParsecDSL s u m a
F.unexpected

type Parsec s u = ParsecT s u Identity

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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

parserReturn :: a -> ParsecT s u m a
parserReturn :: forall a s u (m :: * -> *). a -> ParsecT s u m a
parserReturn = forall (m :: * -> *) a. Monad m => a -> m a
return

parserBind :: ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
parserBind :: forall s u (m :: * -> *) a b.
ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
parserBind = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)

parserFail :: String -> ParsecT s u m a
parserFail :: forall s u (m :: * -> *) a. String -> ParsecDSL s u m a
parserFail = forall s u (m :: * -> *) a. String -> ParsecDSL s u m a
F.parserFail

parserZero :: ParsecT s u m a
parserZero :: forall s u (m :: * -> *) a. ParsecT s u m a
parserZero = forall s u (m :: * -> *) a. ParsecT s u m a
F.parserZero

parserPlus :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
parserPlus :: forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
parserPlus = forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
F.parserPlus

infix  0 <?>
infixr 1 <|>

(<?>) :: (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
(<?>) = forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
label

(<|>) :: (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
(<|>) = forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
parserPlus

-- | 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 = forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
F.label

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 = forall s u (m :: * -> *) a.
ParsecT s u m a -> [String] -> ParsecT s u m a
F.labels

tokens :: (Monad m, 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]
tokens :: forall (m :: * -> *) s t u.
(Monad m, Stream s m t, Eq t) =>
([t] -> String)
-> (SourcePos -> [t] -> SourcePos) -> [t] -> ParsecT s u m [t]
tokens = forall s (m :: * -> *) t u.
(Stream s m t, Eq t) =>
([t] -> String)
-> (SourcePos -> [t] -> SourcePos) -> [t] -> ParsecDSL s u m [t]
F.tokens

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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
F.try

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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
F.lookAhead

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
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 = 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 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 forall a. Identity a -> a
runIdentity (forall s (m :: * -> *) t. Stream s m t => s -> m (Maybe (t, s))
P.uncons s
ts) of
                             Maybe (t, s)
Nothing -> t -> SourcePos
tokpos t
tok
                             Just (t
tok',s
_) -> t -> SourcePos
tokpos t
tok'

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
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 = 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 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
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 = 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
F.tokenPrimEx

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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
F.many

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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
F.skipMany

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 = forall a s u (m :: * -> *).
(a -> [a] -> [a]) -> ParsecT s u m a -> ParsecT s u m [a]
F.manyAccum

runPT :: (Monad m, Show t, Stream s m t)
      => ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)
runPT :: forall (m :: * -> *) t s u a.
(Monad m, Show t, Stream s m t) =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runPT = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
P.runPT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s u (m :: * -> *) t a.
(Show t, Stream s m t) =>
ParsecDSL s u m a -> ParsecT s u m a
F.eval

runPTLog :: (MonadIO m, MonadReader F.LogType m, Show t, Stream s m t)
         => ParsecT s u m a -> u -> SourceName -> s
         -> m (Either ParseError a)
runPTLog :: forall (m :: * -> *) t s u a.
(MonadIO m, MonadReader LogType m, Show t, Stream s m t) =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runPTLog = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
P.runPT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) s t u a.
(MonadIO m, MonadReader LogType m, Stream s m t, Show t) =>
ParsecDSL s u m a -> ParsecT s u m a
F.evalLog

runP :: (Show t, Stream s Identity t)
     => Parsec s u a -> u -> SourceName -> s -> Either ParseError a
runP :: forall t s u a.
(Show t, Stream s Identity t) =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runP Parsec s u a
p u
u String
n s
s = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
P.runPT (forall s u (m :: * -> *) t a.
(Show t, Stream s m t) =>
ParsecDSL s u m a -> ParsecT s u m a
F.eval Parsec s u a
p) u
u String
n s
s

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

runParserTLog :: (MonadIO m, MonadReader F.LogType m, Show t, Stream s m t)
              => ParsecT s u m a
              -> u
              -> SourceName
              -> s
              -> m (Either ParseError a)
runParserTLog :: forall (m :: * -> *) t s u a.
(MonadIO m, MonadReader LogType m, Show t, Stream s m t) =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserTLog = forall (m :: * -> *) t s u a.
(MonadIO m, MonadReader LogType m, Show t, Stream s m t) =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runPTLog

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

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

parseTest :: (Show t, Stream s Identity t, Show a)
          => Parsec s () a -> s -> IO ()
parseTest :: forall t s a.
(Show t, Stream s Identity t, Show a) =>
Parsec s () a -> s -> IO ()
parseTest Parsec s () a
p s
input
    = case forall t s a.
(Show t, 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 "
                       forall a. Show a => a -> IO ()
print ParseError
err
        Right a
x  -> forall a. Show a => a -> IO ()
print a
x

parseTestLog' :: (MonadIO m, MonadReader F.LogType m, Show t, Stream s m t, Show a)
              => ParsecT s () m a -> s -> m ()
parseTestLog' :: forall (m :: * -> *) t s a.
(MonadIO m, MonadReader LogType m, Show t, Stream s m t, Show a) =>
ParsecT s () m a -> s -> m ()
parseTestLog' ParsecT s () m a
p s
input = do
    Either ParseError a
eres <- forall (m :: * -> *) t s u a.
(MonadIO m, MonadReader LogType m, Show t, Stream s m t) =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runPTLog ParsecT s () m a
p () String
"" s
input
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ case Either ParseError a
eres of
        Left ParseError
err -> do String -> IO ()
putStr String
"parse error at "
                       forall a. Show a => a -> IO ()
print ParseError
err
        Right a
x -> forall a. Show a => a -> IO ()
print a
x

parseTestLog :: (Show t, Stream s (ReaderT F.LogType IO) t, Show a)
             => Bool -- ^ If True, display every parse, not just the interesting ones
             -> ParsecT s () (ReaderT F.LogType IO) a -> s -> IO ()
parseTestLog :: forall t s a.
(Show t, Stream s (ReaderT LogType IO) t, Show a) =>
Bool -> ParsecT s () (ReaderT LogType IO) a -> s -> IO ()
parseTestLog Bool
b ParsecT s () (ReaderT LogType IO) a
p s
input = do
    LogType
lg <- forall a. a -> IO (IORef a)
newIORef []
    Either SomeException ()
eres <- forall e a. Exception e => IO a -> IO (Either e a)
E.try forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) t s a.
(MonadIO m, MonadReader LogType m, Show t, Stream s m t, Show a) =>
ParsecT s () m a -> s -> m ()
parseTestLog' ParsecT s () (ReaderT LogType IO) a
p s
input) LogType
lg
    String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ case Either SomeException ()
eres of
        Left SomeException
err -> String
"EXCEPTION => " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (SomeException
err :: E.SomeException)
        Right ()
a  -> String
"Result => " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ()
a
    [ParseLog]
theLog <- forall a. IORef a -> IO a
readIORef LogType
lg
    String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ Bool -> [ParseLog] -> String
F.renderLog Bool
b [ParseLog]
theLog

-- | 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 = forall s u (m :: * -> *). ParsecDSL s u m (State s u)
F.getParserState

-- | @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 = forall s u (m :: * -> *). State s u -> ParsecDSL s u m (State s u)
F.setParserState

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

updateParserState :: Monad m => (State s u -> State s u) -> ParsecT s u m (State s u)
updateParserState :: forall (m :: * -> *) s u.
Monad m =>
(State s u -> State s u) -> ParsecT s u m (State s u)
updateParserState = forall s u (m :: * -> *).
(State s u -> State s u) -> ParsecDSL s u m (State s u)
F.updateParserState

-- < 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 = forall s u (m :: * -> *). ParsecDSL s u m u
F.getState

-- | @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 = forall u s (m :: * -> *). u -> ParsecDSL s u m ()
F.putState

-- | @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 = forall u s (m :: * -> *). (u -> u) -> ParsecDSL s u m ()
F.modifyState

-- 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 = 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 = forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState