lit-0.1.1.0: src/Parse.hs

{-# LANGUAGE OverloadedStrings #-}
module Parse where
import Text.Parsec
import Text.Parsec.Text
import qualified Data.Text as T

import Types
encode :: T.Text -> String -> [Chunk]
encode txt fileName =
    case (parse entire fileName txt) of
    Left err -> []
    Right result -> result
entire :: Parser Program
entire = manyTill chunk eof
chunk :: Parser Chunk
chunk = (try def) <|> prose
prose :: Parser Chunk
prose = grabLine >>= (\line -> return $ Prose line)
def :: Parser Chunk
def = do
    (indent, header, lineNum) <- title
    parts <- manyTill (part indent) $ endDef indent
    return $ Def lineNum header parts
endDef :: String -> Parser ()
endDef indent = try $ do { skipMany newline; notFollowedBy (string indent) <|> (lookAhead title >> parserReturn ()) }
-- Returns (indent, macro-name, SourcePos)
title :: Parser (String, T.Text, SourcePos)
title = do
    pos <- getPosition
    indent <- many ws
    name <- packM =<< between (string "<<") (string ">>=") (many notDelim)
    newline
    return $ (indent, T.strip name, pos)
notDelim = noneOf ">="
part :: String -> Parser Part
part indent =
    try (string indent >> varLine) <|>
    try (string indent >> defLine) <|>
    (grabLine >>= \extra -> return $ Code extra)
varLine :: Parser Part
varLine = do
    indent <- packM =<< many ws
    name <- packM =<< between (string "<<") (string ">>") (many notDelim)
    newline
    return $ Ref name indent
defLine :: Parser Part
defLine = do
    line <- grabLine
    return $ Code line
grabLine :: Parser T.Text
grabLine = do
    line <- many (noneOf "\n\r")
    last <- newline
    return $ T.pack $ line ++ [last]
ws :: Parser Char
ws = char ' ' <|> char '\t'
packM str = return $ T.pack str
textP :: Parsec T.Text () T.Text ->  T.Text -> T.Text
textP p txt =
    case (parse p "" txt) of
    Left err -> T.empty
    Right result -> result

chunkP :: Parsec T.Text () Chunk ->  T.Text -> Maybe Chunk
chunkP p txt =
    case (parse p "" txt) of
    Left err -> Nothing
    Right result -> Just result