potrero/src/Potrero/Parser.hs

{-# LANGUAGE OverloadedStrings #-}

module Potrero.Parser where

import qualified Data.Char as Char
import qualified Data.Text as Text

import           Potrero.Types

data LineType
  = TableDecl Int Text.Text
  | TableEntry Range Result
    deriving (Eq, Show)

indentAmount :: Text.Text -> Int
indentAmount = Text.length . Text.takeWhile Char.isSpace

parseRange :: Text.Text -> Range
parseRange t
  | Text.all Char.isNumber (Text.strip t) =
    let n = read (Text.unpack t) in Range n n
  | otherwise =
    let (x, y) = Text.breakOn "-" (Text.strip t)
        n = read (Text.unpack x)
        m = read (Text.unpack (Text.tail y))
    in Range n m

parseFragments :: Text.Text -> [Fragment]
parseFragments t =
  let (frag, roll) = Text.breakOn "@{" t
  in case roll of
    "" -> [FragText frag]
    _ ->
      let (name, rest) = Text.breakOn "}" (Text.drop 2 roll)
      in FragText frag : FragRoll name : parseFragments (Text.tail rest)

parseLines :: [Text.Text] -> [LineType]
parseLines = go
  where
     go [] = []
     go (t:ts)
       | Text.all Char.isSpace t = go ts
       | Text.any (== ':') t =
         let (rangeTxt, message) = Text.breakOn ":" t
             range = parseRange rangeTxt
             msg = parseFragments (Text.tail message)
         in TableEntry range (Result msg) : go ts
       | otherwise =
         TableDecl (indentAmount t) (Text.strip t) : go ts

parseTable :: Text.Text -> [Table]
parseTable = parseTop [] . parseLines . Text.lines
  where
    parseTop _ [] = []
    parseTop ctx (TableDecl n name:xs) =
      parseTop ((n, name) : [ c | c <- ctx, fst c < n]) xs
    parseTop ctx (TableEntry r m:xs) =
      let (table, rest) = gatherEntries ctx xs [(r, m)]
      in table : parseTop ctx rest
    gatherEntries ctx (TableEntry r m:xs) es =
      gatherEntries ctx xs ((r, m) : es)
    gatherEntries ctx rs es =
      let name = Text.intercalate "/" (reverse (map snd ctx))
      in (Table name (reverse es), rs)