potrero/src/Parser.hs

{-# LANGUAGE OverloadedStrings #-}

module Parser where

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

import 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

parseResult :: Text.Text -> Result
parseResult t
  | "@" `Text.isPrefixOf` Text.strip t =
    ResultRoll (Text.tail (Text.strip t))
  | otherwise =
    ResultText (Text.strip t)

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 = parseResult (Text.tail message)
         in TableEntry range 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)