module Data.Conf.Internal
where
import Control.Monad (void)
import Data.Conf.Types
import Data.Either
import Data.Maybe (catMaybes, fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import Text.Megaparsec
import Text.Megaparsec.Text
conf :: Parser Conf
conf = label "conf" $
postProcessStatementLines <$> manyTill confStatementLines eof
skipSpace :: Parser ()
skipSpace = void $ many spaceChar
confStatement :: Parser ConfStatement
confStatement = label "confStatement" $
try (ConfStatementComment <$> comment)
<|> try (ConfStatementBlock <$> block)
<|> ConfStatementExpression <$> expression
confStatementLines :: Parser [ConfStatement]
confStatementLines = do
skipSpace
s <- confStatement
me <- optional $ try $ case s of
ConfStatementComment _ -> eol >> return ConfStatementEmptyLine
_ -> eol >> eol >> return ConfStatementEmptyLine
skipSpace
return $ catMaybes [Just s, me]
postProcessStatementLines :: [[ConfStatement]] -> [ConfStatement]
postProcessStatementLines = removeTrailing . concat
where
removeTrailing [] = []
removeTrailing xs | last xs == ConfStatementEmptyLine = init xs
| otherwise = xs
comment :: Parser Comment
comment = label "comment" $ do
_ <- string "#"
c <- fromMaybe ' ' <$> optional (char ' ')
Comment . Text.pack . (c:) <$> manyTill anyChar eol
block :: Parser Block
block = label "block" $ do
s <- flip someTill (char '{') $ do
k <- Text.pack <$>
some (noneOf ['{', ' ', '}', ';'])
skipSpace
return k
skipSpace
Block s . postProcessStatementLines <$>
manyTill confStatementLines (char '}')
expression :: Parser Expression
expression = label "expression" $ do
s <- manyTill (letterChar <|> char '_' <|> char '-') spaceChar
skipSpace
as <- manyTill argument (char ';')
return $ Expression (Text.pack s) as
argument :: Parser Text
argument = label "argument" $
Text.pack <$> some (noneOf [';'])