{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Configuration.Dotenv.Parse (configParser) where
import Configuration.Dotenv.ParsedVariable
#if MIN_VERSION_base(4,8,0)
import Control.Applicative (empty, many, some, (<|>))
#else
import Control.Applicative (empty, many, some, (*>),
(<$>), (<*), (<*>), (<|>))
#endif
import Control.Monad (void)
import Data.Void (Void)
import Text.Megaparsec (Parsec, anySingle, between, eof,
sepEndBy, (<?>), oneOf,
noneOf)
import Text.Megaparsec.Char (alphaNumChar, char, eol,
spaceChar, digitChar,
letterChar)
import qualified Text.Megaparsec.Char.Lexer as L
type Parser = Parsec Void String
data QuoteType = SingleQuote | DoubleQuote
configParser :: Parser [ParsedVariable]
configParser = between scn eof (sepEndBy envLine (eol <* scn))
envLine :: Parser ParsedVariable
envLine = ParsedVariable <$> (lexeme variableName <* lexeme (char '=')) <*> lexeme value
variableName :: Parser VarName
variableName = ((:) <$> firstChar <*> many otherChar) <?> "variable name"
where
firstChar = char '_' <|> letterChar
otherChar = firstChar <|> digitChar
value :: Parser VarValue
value = (quotedValue <|> unquotedValue) <?> "variable value"
where
quotedValue = quotedWith SingleQuote <|> quotedWith DoubleQuote
unquotedValue = Unquoted <$> many (fragment "\'\" \t\n\r")
quotedWith :: QuoteType -> Parser VarValue
quotedWith SingleQuote = SingleQuoted <$> between (char '\'') (char '\'') (many (literalValueFragment "\'\\"))
quotedWith DoubleQuote = DoubleQuoted <$> between (char '\"') (char '\"') (many (fragment "\""))
fragment :: String -> Parser VarFragment
fragment charsToEscape =
interpolatedValueCommandInterpolation
<|> interpolatedValueVarInterpolation
<|> literalValueFragment ('$' : '\\' : charsToEscape)
interpolatedValueVarInterpolation :: Parser VarFragment
interpolatedValueVarInterpolation = VarInterpolation <$>
((between (symbol "${") (symbol "}") variableName) <|>
(char '$' >> variableName))
where
symbol = L.symbol sc
interpolatedValueCommandInterpolation :: Parser VarFragment
interpolatedValueCommandInterpolation =
CommandInterpolation
<$> between (symbol "$(") (symbol ")") (many alphaNumChar)
where
symbol = L.symbol sc
literalValueFragment :: String -> Parser VarFragment
literalValueFragment charsToEscape = VarLiteral <$> some (escapedChar <|> normalChar)
where
escapedChar = (char '\\' *> anySingle) <?> "escaped character"
normalChar = noneOf charsToEscape <?> "unescaped character"
lexeme :: Parser a -> Parser a
lexeme = L.lexeme sc
{-# INLINE lexeme #-}
sc :: Parser ()
sc = L.space (void spaceChar') skipLineComment empty
{-# INLINE sc #-}
scn :: Parser ()
scn = L.space (void spaceChar) skipLineComment empty
{-# INLINE scn #-}
spaceChar' :: Parser Char
spaceChar' = oneOf (" \t" :: String)
{-# INLINE spaceChar' #-}
skipLineComment :: Parser ()
#if MIN_VERSION_megaparsec(5,1,0)
skipLineComment = L.skipLineComment "#"
#else
skipLineComment = p >> void (manyTill anyChar n)
where p = string "#"
n = lookAhead (void newline) <|> eof
#endif
{-# INLINE skipLineComment #-}