{-# 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
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)