{-# 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
)
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
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
}