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