Megaparsec parser for indented multi-line expressions

indented-expr.hs

-- Parse expressions layed out on multiple lines (as long as they're indented).
-- It works by using the standard @makeExprParser@ and passing it versions of,
-- say, the @lexeme'@ combinator that check the current indentation against an
-- initial one.
{-# LANGUAGE OverloadedStrings #-}

import Control.Monad (guard)
import Control.Monad.Combinators.Expr
import Data.Void
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer as L (decimal, indentLevel, lexeme, space)
import Text.Pretty.Simple (pPrintNoColor)

--------------------------------------------------------------------------------
main :: IO ()
main = do
  let input = "1 + 2\n\n3 + 4\n  * 5\n\n3 + 4 *\n  5"
  parseTest' expressions input

-- | Same as "parseTest" but use "pPrintNoColor".
parseTest'
  :: ( ShowErrorComponent e
     , Show a
     , VisualStream s
     , TraversableStream s
     )
  => Parsec e s a
  -> s  
  -> IO ()
parseTest' p input =
  case parse p "" input of
    Left e -> putStr (errorBundlePretty e)
    Right x -> pPrintNoColor x
  
--------------------------------------------------------------------------------
data Expr
  = Lit Integer
  | Add Expr Expr
  | Mul Expr Expr
  deriving (Eq, Show)

type Parser = Parsec Void String

-- Top-level parser that starts by capturing the initial indentation level.
expressions :: Parser [Expr] 
expressions = many (L.indentLevel >>= expr)

expr :: Pos -> Parser Expr
expr initialIndent = makeExprParser term' (operatorTable initialIndent)
 where
  term' = Lit <$> decimal' initialIndent

operatorTable :: Pos -> [[Operator Parser Expr]]
operatorTable initialIndent =
  [ [InfixL (Mul <$ symbol' initialIndent "*")]
  , [InfixL (Add <$ symbol' initialIndent "+")]
  ]

--------------------------------------------------------------------------------
decimal' :: Pos -> Parser Integer
decimal' initialIndent = lexeme' initialIndent decimal

-- Custom symbol that checks against the passed indentation.
symbol' :: Pos -> String -> Parser String
symbol' initialIndent = lexeme' initialIndent . string

-- Custom lexeme that checks against the passed indentation.
lexeme' :: Pos -> Parser a -> Parser a
lexeme' initialIndent p = do
  currentIndent <- L.indentLevel
  guard (currentIndent >= initialIndent)
  lexeme scn p

scn :: Parser ()
scn = L.space space1 empty empty