{-# 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
( Stream
, State(..)
, 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 { unParse :: ReaderT (ParseMode n v e s) (Parsec (CustomError s) s) a }
deriving newtype (Functor, Applicative, Alternative, Monad, MonadFail, MonadPlus)
deriving newtype (MonadReader (ParseMode n v e s))
deriving newtype (MonadParsec (CustomError s) s)
instance Parsec.Stream s => Locate (Parse n v e s) where
getPosition = fromSourcePos <$> 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 parser mode@ParseMode { filename } content =
case Parsec.runParser' parsec initState of
(_, Left bundle) -> throwError $ fromParseErrorBundle bundle
(Parsec.State { stateInput }, Right e) -> pure (e, stateInput)
where
parsec = runReaderT (unParse parser) mode
initState = Parsec.State
{ stateInput = content
, stateOffset = 0
, statePosState = Parsec.PosState
{ pstateInput = content
, pstateOffset = 0
, pstateSourcePos = Parsec.initialPos filename
, pstateTabWidth = Parsec.defaultTabWidth
, pstateLinePrefix = ""
}
#if MIN_VERSION_megaparsec(8,0,0)
, stateParseErrors = []
#endif
}