Debugging megaparsec transofrmer using `MonadParsecDbg` class

Main.hs

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | This module contains usage example of suggested `MonadParsecDbg` type class,
-- minimized, but, I hope, demonstrative
--
-- If someone have better solution, I would like to see it
module Main where

import Control.Monad.State
import Data.Void
import Text.Megaparsec hiding (State, parseTest)
import Text.Megaparsec.Debug (dbg)

-- | Wrapping state in newtype to see it better in output
newtype Depth = Depth Int
  deriving (Eq, Ord, Show, Enum)

-- Two solutions for such test task: count 'x'/'y' symbols
-- situated in round brackets (correctly working with nested brackets)
-- Solutions are the same, except the types and first lines, where dbg function is called

type Parser = ParsecT Void String (State Depth)

-- | Composed monad-style with new `MonadParsecDebug` type class
xCounter :: Parser Int
xCounter = do
  ch <- dbg "counter x" $ optional anySingle
  case ch of
    Just '(' -> do
      modify succ
      xCounter
    Just ')' -> do
      modify pred
      xCounter
    Just 'x' -> do
      inBracket <- gets (> Depth 0)
      if inBracket
        then (+ 1) <$> xCounter
        else xCounter
    Just _ -> xCounter
    Nothing -> return 0

-- | The same solution with concrete transformers without `MonadParsecDebug`
yCounter :: Parser Int
yCounter = do
  ch <- dbg "counter y" $ optional anySingle
  case ch of
    Just '(' -> do
      modify succ
      yCounter
    Just ')' -> do
      modify pred
      yCounter
    Just 'y' -> do
      inBracket <- gets (> Depth 0)
      if inBracket
        then (+ 1) <$> yCounter
        else yCounter
    Just _ -> yCounter
    Nothing -> return 0

-- Testing at the same sample
-- Output:
--
-- xCounter
-- counter> IN: "x(xa(x))a"
-- counter> MATCH (COK): 'x'
-- counter> VALUE: (Just 'x',Depth 0)
--
-- counter> IN: "(xa(x))a"
-- counter> MATCH (COK): '('
-- counter> VALUE: (Just '(',Depth 0)
--
-- counter> IN: "xa(x))a"
-- counter> MATCH (COK): 'x'
-- counter> VALUE: (Just 'x',Depth 1)
--
-- ...
-- yCounter
-- counter> IN: "y(ya(y))a"
-- counter> MATCH (COK): 'y'
-- counter> VALUE: Just 'y'
--
-- counter> IN: "(ya(y))a"
-- counter> MATCH (COK): '('
-- counter> VALUE: Just '('
--
-- counter> IN: "ya(y))a"
-- counter> MATCH (COK): 'y'
-- counter> VALUE: Just 'y'
-- ...
main :: IO ()
main = do
  putStrLn "xCounter"
  parseTest xCounter "x(xa(x))a"
  putStrLn "yCounter"
  parseTest yCounter "y(ya(y))a"

-- | The expression @'parseTest' p input@ applies the parser @p@ on the
-- input @input@ and prints the result to stdout. Useful for testing.
parseTest ::
  Show a =>
  -- | Parser to run
  Parser a ->
  -- | Input for parser
  String ->
  IO ()
parseTest p input =
  case evalState (runParserT p "" input) (Depth 0) of
    Left e -> putStr (errorBundlePretty e)
    Right x -> print x

-- $> main