Megaparsec,使用StateT和ParsecT回溯用户状态

cor*_*nuz 7 haskell megaparsec

使用Megaparsec 5.按照本指南,我可以通过组合StateTParsecT(非定义类型应该是显而易见的/不相关的)来实现反向跟踪用户状态:

type MyParser a = StateT UserState (ParsecT Dec T.Text Identity) a
Run Code Online (Sandbox Code Playgroud)

如果我运行解析器p :: MyParser a,像这样:

parsed = runParser (runStateT p initialUserState) "" input
Run Code Online (Sandbox Code Playgroud)

类型parsed是:

Either (ParseError Char Dec) (a, UserState)
Run Code Online (Sandbox Code Playgroud)

这意味着,如果出现错误,用户状态将丢失.

在这两种情况下都有办法吗?

编辑: 我可能,如果出现错误,可能使用自定义错误组件而不是Dec(5.0中引入的功能)并将用户状态封装在那里?

Dan*_*elM 2

您可以将自定义错误组件与该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
Run Code Online (Sandbox Code Playgroud)

在上面的片段中,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") 
Run Code Online (Sandbox Code Playgroud)

实际上,您可能想做一些更聪明的事情(例如,我想您还可以添加在遍历堆栈时经历的整个状态堆栈)。