indent_parser_cheatsheet.hs

import Data.Functor.Identity
import Text.Parsec
import Text.Parsec.Indent


example1 = "asdf(1 2 3):\n  foo\n  x:\n    y\n    z:\n      q\n  a"

-- Data structures

data Tree = Node [Value] [Tree]
  deriving (Eq, Show)

data Value = Val String | Paren [Value]
  deriving (Eq, Show)

-- Top level parse function
parseTree text = runIdentity $ runIndentParserT (root <* eof) () "<input>" text

-- utilities for printing the result

render :: String -> Tree -> String
render indent (Node s children) =
  let renderedChildren = concat [
        "\n" ++ (render ("  " ++ indent) child)
        | child <- children ]
      body = indent ++ renderVals s
  in if null children
     then body
     else body ++ ":" ++ renderedChildren

renderVals vs = unwords $ map renderVal vs

renderVal :: Value -> String
renderVal (Val s) = s
renderVal (Paren vs) = "(" ++ renderVals vs ++ ")"

-- parsers

-- parses the root of a tree
root = do
  try parseParent <|> parseLine

-- parses a node with children
parseParent = withBlock Node parseHeader root

-- parses the header of a node with children
parseHeader = do
  header <- values
  _ <- string ":\n"
  _ <- many (char ' ')
  return header

-- parses a line without children
parseLine = do
  line <- values
  _ <- optionMaybe $ try $ do
    _ <- string "\n"
    many (char ' ')
  return $ Node line []

-- parses values within a line
values = sepBy1 value linearSpace

-- parses a single value or values in parens
value = try parenVals <|> (Val <$> word)

-- parses values in parens
parenVals :: IndentParser String () Value
parenVals = withPos $ do
  _ <- string "("
  _ <- spaces
  vals <- sepEndBy (indented *> value) spaces
  _ <- sameOrIndented *> string ")"
  return $ Paren vals

-- a single word
word :: IndentParser String () String
word = many1 (noneOf " \n\t:()")

-- spaces without newlines
linearSpace = many1 (char ' ')