observing
为此,您可以将自定义错误组件与函数结合使用(有关更多信息,请参阅这篇精彩的帖子):
{-# LANGUAGE RecordWildCards #-}
module Main where
import Text.Megaparsec
import qualified Data.Set as Set
import Control.Monad.State.Lazy
data MyState = MyState Int deriving (Ord, Eq, Show)
data MyErrorComponent = MyErrorComponent (Maybe MyState) deriving (Ord, Eq, Show)
instance ErrorComponent MyErrorComponent where
representFail _ = MyErrorComponent Nothing
representIndentation _ _ _= MyErrorComponent Nothing
type Parser = StateT MyState (Parsec MyErrorComponent String)
trackState :: Parser a -> Parser a
trackState parser = do
result <- observing parser -- run parser but don't fail right away
case result of
Right x -> return x -- if it succeeds we're done here
Left ParseError {..} -> do
state <- get -- read the current state to add it to the error component
failure errorUnexpected errorExpected $
if Set.null errorCustom then Set.singleton (MyErrorComponent $ Just state) else errorCustom
在上面的片段中,observing
函数有点像try
/catch
块,它捕获解析错误,然后读取当前状态并将其添加到自定义错误组件中。当runParser
返回一个ParseError
.
下面是如何使用这个函数的演示:
a = trackState $ do
put (MyState 6)
string "foo"
b = trackState $ do
put (MyState 5)
a
main = putStrLn (show $ runParser (runStateT b (MyState 0)) "" "bar")
实际上,您可能想要做一些更聪明的事情(例如,我想您还可以添加遍历堆栈时经历的整个状态堆栈)。