Indent parser for megaparsec

LayoutParser.hs

module LayoutParser (
  LayoutParser,
  indented,
  linefold,
  line,
  saveIndent,
  align,
  runLayoutParser
) where

import Text.Megaparsec
import Text.Megaparsec.Text.Lazy
import qualified Data.Text.Lazy as L
import Text.Megaparsec.Pos
import Control.Monad.State

type LayoutParser a = StateT SourcePos Parser a

-- | Parses only when indented past the level of the reference
indented :: LayoutParser ()
indented = do
    pos <- getPosition
    s <- get
    if sourceColumn pos <= sourceColumn s then fail "not indented" else do
        put $ setSourceLine s (sourceLine pos)
        return ()

-- | Parses only when indented past the level of the reference or on the same line
linefold :: LayoutParser ()
linefold = line <|> indented

-- | Parses only on the line as the reference
line :: LayoutParser ()
line = do
    pos <- getPosition
    s <- get
    when (sourceLine pos /= sourceLine s) (fail "over one line")

-- | Parses using the current location for indentation reference
saveIndent :: LayoutParser a -> LayoutParser a
saveIndent x = do
    a <- get
    p <- getPosition
    r <- put p >> x
    put a >> return r

-- | Ensures the current indentation level matches that of the reference
align :: LayoutParser ()
align = do
    s <- get
    p <- getPosition
    when (sourceColumn p /= sourceColumn s) (fail "indentation doesn't match")

runLayout :: LayoutParser a -> String -> Parser a
runLayout p file = fst <$> runStateT p (initialPos file)

runLayoutParser :: LayoutParser a -> String -> L.Text -> Either ParseError a
runLayoutParser p file source = runParser (runLayout p file) file source