module FP.Parser.GreedyParser where
import FP.Prelude
import FP.Pretty
import FP.Parser.Common
import FP.Parser.Effects
newtype GreedyParser t a = GreedyParser
{ runGreedyParser ∷
ReaderT (ParserEnv t)
(StateT (ParserState t)
(FailureT
(Writer (ParserOut t)))) a
}
deriving
(Functor,Monad
,MonadFailure
,MonadReader (ParserEnv t)
,MonadState (ParserState t)
,MonadWriter (ParserOut t)
)
gpFail ∷ GreedyParser t a
gpFail = do
pi ← getL parserStateInputL
ek ← askL parserEnvErrorStackL
pc ← getL parserStateErrorContextL
tell $ ParserOut bot $ SourceErrorMaybe $ errorSourceLocalContext pi ek pc
abort
gpPluck ∷ GreedyParser t t
gpPluck = do
SourceInput ts nextLoc ← getL parserStateInputL
case unconsStream ts of
Nothing → gpAppendError "more input" gpFail
Just (x,ts') → do
let nextNextLoc = case unconsStream ts' of
Nothing → bumpCol nextLoc
Just (x',_) → locRangeBegin $ sourceTokenRange x'
putL parserStateInputL $ SourceInput ts' nextNextLoc
fmt ← askL parserEnvRenderFormatL
modifyL parserStateErrorContextL $ \ pc → pc ⧺ sourceLocalContextFromToken fmt x
modifyL parserStateCaptureContextL $ \ pc → pc ⧺ sourceLocalContextFromToken fmt x
return $ sourceTokenValue x
gpAppendError ∷ 𝕊 → GreedyParser t a → GreedyParser t a
gpAppendError msg xM = do
(stack,msg') ← askL parserEnvErrorStackL
local (update parserEnvErrorStackL (msg':stack,msg)) xM
gpNewContext ∷ Lens (ParserState t) (SourceContextPrefix t) → GreedyParser t a → GreedyParser t (a,SourceContextPrefix t)
gpNewContext 𝓁 xM = do
pc ← getL 𝓁
putL 𝓁 $ pushSourceLocalContext pc
x ← xM
pc' ← getL 𝓁
putL 𝓁 $ pc ⧺ pc'
return (x,pc')
gpCapture ∷ GreedyParser t a → GreedyParser t (a,SourceContextPrefix t)
gpCapture = gpNewContext parserStateCaptureContextL
gpRender ∷ Format → GreedyParser t s → GreedyParser t s
gpRender fmt = local $ alter parserEnvRenderFormatL $ (⧺) [fmt]
gpEnd ∷ GreedyParser t ()
gpEnd = do
ts ← getL (sourceInputStreamL ⌾ parserStateInputL)
when (shape justL $ unconsStream ts) $ gpAppendError "end of stream" gpFail
gpCatch ∷ GreedyParser t a → GreedyParser t a → GreedyParser t a
gpCatch = (<|>)