-- |
--
-- Module:      Language.Egison.Parser.Pattern.Prim.Parse
-- Description: Parser monad
-- Stability:   experimental
--
-- This module defines a parser monad 'Parse'.

{-# LANGUAGE CPP #-}

module Language.Egison.Parser.Pattern.Prim.Parse
  ( Parse
  , runParse
  )
where

import           Control.Applicative            ( Alternative )
import           Control.Monad.Except           ( MonadError(..) )
import           Control.Monad.Reader           ( ReaderT
                                                , MonadReader(..)
                                                , runReaderT
                                                )
import           Control.Monad.Fail             ( MonadFail )
import           Control.Monad                  ( MonadPlus )

import           Text.Megaparsec                ( Parsec
                                                , MonadParsec
                                                , State(..)
                                                , PosState(..)
                                                )
import qualified Text.Megaparsec               as Parsec
                                                ( State(..)
#if MIN_VERSION_megaparsec(9,0,0)
                                                , TraversableStream(..)
#else
                                                , Stream(..)
#endif
                                                , PosState(..)
                                                , runParser'
                                                , initialPos
                                                , defaultTabWidth
                                                , getSourcePos
                                                )

import           Language.Egison.Parser.Pattern.Prim.Source
                                                ( Source )
import           Language.Egison.Parser.Pattern.Prim.Location
                                                ( Locate(..)
                                                , fromSourcePos
                                                )
import           Language.Egison.Parser.Pattern.Prim.ParseMode
                                                ( ParseMode(..) )
import           Language.Egison.Parser.Pattern.Prim.Error
                                                ( Errors
                                                , CustomError
                                                , fromParseErrorBundle
                                                )


-- | Parser monad.
newtype Parse n v e s a = Parse { Parse n v e s a
-> ReaderT (ParseMode n v e s) (Parsec (CustomError s) s) a
unParse :: ReaderT (ParseMode n v e s) (Parsec (CustomError s) s) a }
  deriving newtype (a -> Parse n v e s b -> Parse n v e s a
(a -> b) -> Parse n v e s a -> Parse n v e s b
(forall a b. (a -> b) -> Parse n v e s a -> Parse n v e s b)
-> (forall a b. a -> Parse n v e s b -> Parse n v e s a)
-> Functor (Parse n v e s)
forall a b. a -> Parse n v e s b -> Parse n v e s a
forall a b. (a -> b) -> Parse n v e s a -> Parse n v e s b
forall n v e s a b. a -> Parse n v e s b -> Parse n v e s a
forall n v e s a b. (a -> b) -> Parse n v e s a -> Parse n v e s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Parse n v e s b -> Parse n v e s a
$c<$ :: forall n v e s a b. a -> Parse n v e s b -> Parse n v e s a
fmap :: (a -> b) -> Parse n v e s a -> Parse n v e s b
$cfmap :: forall n v e s a b. (a -> b) -> Parse n v e s a -> Parse n v e s b
Functor, Functor (Parse n v e s)
a -> Parse n v e s a
Functor (Parse n v e s)
-> (forall a. a -> Parse n v e s a)
-> (forall a b.
    Parse n v e s (a -> b) -> Parse n v e s a -> Parse n v e s b)
-> (forall a b c.
    (a -> b -> c)
    -> Parse n v e s a -> Parse n v e s b -> Parse n v e s c)
-> (forall a b.
    Parse n v e s a -> Parse n v e s b -> Parse n v e s b)
-> (forall a b.
    Parse n v e s a -> Parse n v e s b -> Parse n v e s a)
-> Applicative (Parse n v e s)
Parse n v e s a -> Parse n v e s b -> Parse n v e s b
Parse n v e s a -> Parse n v e s b -> Parse n v e s a
Parse n v e s (a -> b) -> Parse n v e s a -> Parse n v e s b
(a -> b -> c)
-> Parse n v e s a -> Parse n v e s b -> Parse n v e s c
forall a. a -> Parse n v e s a
forall a b. Parse n v e s a -> Parse n v e s b -> Parse n v e s a
forall a b. Parse n v e s a -> Parse n v e s b -> Parse n v e s b
forall a b.
Parse n v e s (a -> b) -> Parse n v e s a -> Parse n v e s b
forall a b c.
(a -> b -> c)
-> Parse n v e s a -> Parse n v e s b -> Parse n v e s c
forall n v e s. Stream s => Functor (Parse n v e s)
forall n v e s a. Stream s => a -> Parse n v e s a
forall n v e s a b.
Stream s =>
Parse n v e s a -> Parse n v e s b -> Parse n v e s a
forall n v e s a b.
Stream s =>
Parse n v e s a -> Parse n v e s b -> Parse n v e s b
forall n v e s a b.
Stream s =>
Parse n v e s (a -> b) -> Parse n v e s a -> Parse n v e s b
forall n v e s a b c.
Stream s =>
(a -> b -> c)
-> Parse n v e s a -> Parse n v e s b -> Parse n v e s c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Parse n v e s a -> Parse n v e s b -> Parse n v e s a
$c<* :: forall n v e s a b.
Stream s =>
Parse n v e s a -> Parse n v e s b -> Parse n v e s a
*> :: Parse n v e s a -> Parse n v e s b -> Parse n v e s b
$c*> :: forall n v e s a b.
Stream s =>
Parse n v e s a -> Parse n v e s b -> Parse n v e s b
liftA2 :: (a -> b -> c)
-> Parse n v e s a -> Parse n v e s b -> Parse n v e s c
$cliftA2 :: forall n v e s a b c.
Stream s =>
(a -> b -> c)
-> Parse n v e s a -> Parse n v e s b -> Parse n v e s c
<*> :: Parse n v e s (a -> b) -> Parse n v e s a -> Parse n v e s b
$c<*> :: forall n v e s a b.
Stream s =>
Parse n v e s (a -> b) -> Parse n v e s a -> Parse n v e s b
pure :: a -> Parse n v e s a
$cpure :: forall n v e s a. Stream s => a -> Parse n v e s a
$cp1Applicative :: forall n v e s. Stream s => Functor (Parse n v e s)
Applicative, Applicative (Parse n v e s)
Parse n v e s a
Applicative (Parse n v e s)
-> (forall a. Parse n v e s a)
-> (forall a.
    Parse n v e s a -> Parse n v e s a -> Parse n v e s a)
-> (forall a. Parse n v e s a -> Parse n v e s [a])
-> (forall a. Parse n v e s a -> Parse n v e s [a])
-> Alternative (Parse n v e s)
Parse n v e s a -> Parse n v e s a -> Parse n v e s a
Parse n v e s a -> Parse n v e s [a]
Parse n v e s a -> Parse n v e s [a]
forall a. Parse n v e s a
forall a. Parse n v e s a -> Parse n v e s [a]
forall a. Parse n v e s a -> Parse n v e s a -> Parse n v e s a
forall n v e s. Stream s => Applicative (Parse n v e s)
forall n v e s a. Stream s => Parse n v e s a
forall n v e s a. Stream s => Parse n v e s a -> Parse n v e s [a]
forall n v e s a.
Stream s =>
Parse n v e s a -> Parse n v e s a -> Parse n v e s a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: Parse n v e s a -> Parse n v e s [a]
$cmany :: forall n v e s a. Stream s => Parse n v e s a -> Parse n v e s [a]
some :: Parse n v e s a -> Parse n v e s [a]
$csome :: forall n v e s a. Stream s => Parse n v e s a -> Parse n v e s [a]
<|> :: Parse n v e s a -> Parse n v e s a -> Parse n v e s a
$c<|> :: forall n v e s a.
Stream s =>
Parse n v e s a -> Parse n v e s a -> Parse n v e s a
empty :: Parse n v e s a
$cempty :: forall n v e s a. Stream s => Parse n v e s a
$cp1Alternative :: forall n v e s. Stream s => Applicative (Parse n v e s)
Alternative, Applicative (Parse n v e s)
a -> Parse n v e s a
Applicative (Parse n v e s)
-> (forall a b.
    Parse n v e s a -> (a -> Parse n v e s b) -> Parse n v e s b)
-> (forall a b.
    Parse n v e s a -> Parse n v e s b -> Parse n v e s b)
-> (forall a. a -> Parse n v e s a)
-> Monad (Parse n v e s)
Parse n v e s a -> (a -> Parse n v e s b) -> Parse n v e s b
Parse n v e s a -> Parse n v e s b -> Parse n v e s b
forall a. a -> Parse n v e s a
forall a b. Parse n v e s a -> Parse n v e s b -> Parse n v e s b
forall a b.
Parse n v e s a -> (a -> Parse n v e s b) -> Parse n v e s b
forall n v e s. Stream s => Applicative (Parse n v e s)
forall n v e s a. Stream s => a -> Parse n v e s a
forall n v e s a b.
Stream s =>
Parse n v e s a -> Parse n v e s b -> Parse n v e s b
forall n v e s a b.
Stream s =>
Parse n v e s a -> (a -> Parse n v e s b) -> Parse n v e s b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Parse n v e s a
$creturn :: forall n v e s a. Stream s => a -> Parse n v e s a
>> :: Parse n v e s a -> Parse n v e s b -> Parse n v e s b
$c>> :: forall n v e s a b.
Stream s =>
Parse n v e s a -> Parse n v e s b -> Parse n v e s b
>>= :: Parse n v e s a -> (a -> Parse n v e s b) -> Parse n v e s b
$c>>= :: forall n v e s a b.
Stream s =>
Parse n v e s a -> (a -> Parse n v e s b) -> Parse n v e s b
$cp1Monad :: forall n v e s. Stream s => Applicative (Parse n v e s)
Monad, Monad (Parse n v e s)
Monad (Parse n v e s)
-> (forall a. String -> Parse n v e s a)
-> MonadFail (Parse n v e s)
String -> Parse n v e s a
forall a. String -> Parse n v e s a
forall n v e s. Stream s => Monad (Parse n v e s)
forall n v e s a. Stream s => String -> Parse n v e s a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> Parse n v e s a
$cfail :: forall n v e s a. Stream s => String -> Parse n v e s a
$cp1MonadFail :: forall n v e s. Stream s => Monad (Parse n v e s)
MonadFail, Monad (Parse n v e s)
Alternative (Parse n v e s)
Parse n v e s a
Alternative (Parse n v e s)
-> Monad (Parse n v e s)
-> (forall a. Parse n v e s a)
-> (forall a.
    Parse n v e s a -> Parse n v e s a -> Parse n v e s a)
-> MonadPlus (Parse n v e s)
Parse n v e s a -> Parse n v e s a -> Parse n v e s a
forall a. Parse n v e s a
forall a. Parse n v e s a -> Parse n v e s a -> Parse n v e s a
forall n v e s. Stream s => Monad (Parse n v e s)
forall n v e s. Stream s => Alternative (Parse n v e s)
forall n v e s a. Stream s => Parse n v e s a
forall n v e s a.
Stream s =>
Parse n v e s a -> Parse n v e s a -> Parse n v e s a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: Parse n v e s a -> Parse n v e s a -> Parse n v e s a
$cmplus :: forall n v e s a.
Stream s =>
Parse n v e s a -> Parse n v e s a -> Parse n v e s a
mzero :: Parse n v e s a
$cmzero :: forall n v e s a. Stream s => Parse n v e s a
$cp2MonadPlus :: forall n v e s. Stream s => Monad (Parse n v e s)
$cp1MonadPlus :: forall n v e s. Stream s => Alternative (Parse n v e s)
MonadPlus)
  deriving newtype (MonadReader (ParseMode n v e s))
  deriving newtype (MonadParsec (CustomError s) s)

#if MIN_VERSION_megaparsec(9,0,0)
instance Parsec.TraversableStream s => Locate (Parse n v e s) where
#else
instance Parsec.Stream s => Locate (Parse n v e s) where
#endif
  getPosition :: Parse n v e s Position
getPosition = SourcePos -> Position
fromSourcePos (SourcePos -> Position)
-> Parse n v e s SourcePos -> Parse n v e s Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse n v e s SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
Parsec.getSourcePos


-- | Run 'Parse' monad and produce a parse result.
runParse
  :: (Source s, MonadError (Errors s) m)
  => Parse n v e s a
  -> ParseMode n v e s
  -> s
  -> m (a, s)
runParse :: Parse n v e s a -> ParseMode n v e s -> s -> m (a, s)
runParse Parse n v e s a
parser mode :: ParseMode n v e s
mode@ParseMode { String
$sel:filename:ParseMode :: forall n v e s. ParseMode n v e s -> String
filename :: String
filename } s
content =
  case Parsec (CustomError s) s a
-> State s (CustomError s)
-> (State s (CustomError s),
    Either (ParseErrorBundle s (CustomError s)) a)
forall e s a.
Parsec e s a
-> State s e -> (State s e, Either (ParseErrorBundle s e) a)
Parsec.runParser' Parsec (CustomError s) s a
parsec State s (CustomError s)
initState of
    (State s (CustomError s)
_, Left ParseErrorBundle s (CustomError s)
bundle) -> Errors s -> m (a, s)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Errors s -> m (a, s)) -> Errors s -> m (a, s)
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle s (CustomError s) -> Errors s
forall s.
TraversableStream s =>
ParseErrorBundle s (CustomError s) -> Errors s
fromParseErrorBundle ParseErrorBundle s (CustomError s)
bundle
    (Parsec.State { s
stateInput :: forall s e. State s e -> s
stateInput :: s
stateInput }, Right a
e) -> (a, s) -> m (a, s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
e, s
stateInput)
 where
  parsec :: Parsec (CustomError s) s a
parsec    = ReaderT (ParseMode n v e s) (Parsec (CustomError s) s) a
-> ParseMode n v e s -> Parsec (CustomError s) s a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Parse n v e s a
-> ReaderT (ParseMode n v e s) (Parsec (CustomError s) s) a
forall n v e s a.
Parse n v e s a
-> ReaderT (ParseMode n v e s) (Parsec (CustomError s) s) a
unParse Parse n v e s a
parser) ParseMode n v e s
mode
  initState :: State s (CustomError s)
initState = State :: forall s e. s -> Int -> PosState s -> [ParseError s e] -> State s e
Parsec.State
    { stateInput :: s
stateInput       = s
content
    , stateOffset :: Int
stateOffset      = Int
0
    , statePosState :: PosState s
statePosState    = PosState :: forall s. s -> Int -> SourcePos -> Pos -> String -> PosState s
Parsec.PosState
                           { pstateInput :: s
pstateInput      = s
content
                           , pstateOffset :: Int
pstateOffset     = Int
0
                           , pstateSourcePos :: SourcePos
pstateSourcePos  = String -> SourcePos
Parsec.initialPos String
filename
                           , pstateTabWidth :: Pos
pstateTabWidth   = Pos
Parsec.defaultTabWidth
                           , pstateLinePrefix :: String
pstateLinePrefix = String
""
                           }
#if MIN_VERSION_megaparsec(8,0,0)
    , stateParseErrors :: [ParseError s (CustomError s)]
stateParseErrors = []
#endif
    }