Megaparsec, backtracking user state with StateT and ParsecT - haskell

Question

Using Megaparsec 5.
Following this guide, I can achieve a back-tracking user-state by combining StateT and ParsecT (non-defined types should be obvious/irrelevant):
type MyParser a = StateT UserState (ParsecT Dec T.Text Identity) a
if I run a parser p :: MyParser a, like this:
parsed = runParser (runStateT p initialUserState) "" input
The type of parsed is:
Either (ParseError Char Dec) (a, UserState)
Which means, in case of error, the user state is lost.
Is there any way to have it in both cases?
EDIT:
Could I perhaps, in case of error, use a custom error component instead of Dec (a feature introduced in 5.0) and encapsulate the user state in there?

Answer 1

You can use a custom error component combined with the observing function for this purpose (see this great post for more information):
{-# 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
In the above snipped, observing functions a bit like a try/catch block that catches a parse error, then reads the current state and adds the it to the custom error component. The custom error component in turn is returned when runParser returns a ParseError.
Here's a demonstration how this function could be used:
a = trackState $ do
put (MyState 6)
string "foo"
b = trackState $ do
put (MyState 5)
a
main = putStrLn (show $ runParser (runStateT b (MyState 0)) "" "bar")
In reality you would probably want to do something more clever (for instance I imagine you could also add the entire stack of states you go through while traversing the stack).

Answer 2

You could try sandwiching ParserT between two States, like
type MyParser a = StateT UserState (ParsecT Dec T.Text (State UsersState)) a
And write special-purpose put and modify operations that, after changing the outer state, copy the entire state into the inner State monad using put.
That way, even if parsing fails, you'll have the last "state before failure" available from the inner State monad.

Answer 3

I hit similar problem. I use default typing state:
type SubDefPos = Int
type SubDefName = String
data MyParserSt = MyParserSt {
subDefs :: [(SubDefPos, SubDefName)]
}
ParsecT Void String (StateT MyParserSt Identity) Expr
Every change to user state is supplied with the value of getOffset to be able to reject later if current position is less than position from the state.