{-# LANGUAGE OverloadedStrings #-}
module Configuration.Dotenv.Parse (configParser) where
import Configuration.Dotenv.ParsedVariable
import Control.Applicative (empty, many, some, (<|>))
import Control.Monad (void)
import Data.Void (Void)
import qualified ShellWords
import Text.Megaparsec (Parsec, anySingle,
between, eof, noneOf,
oneOf, sepEndBy, (<?>))
import Text.Megaparsec.Char (char, digitChar, eol,
letterChar, spaceChar)
import qualified Text.Megaparsec.Char.Lexer as L
type Parser = Parsec Void String
data QuoteType = SingleQuote | DoubleQuote
configParser :: Parser [ParsedVariable]
configParser :: Parser [ParsedVariable]
configParser = ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> Parser [ParsedVariable]
-> Parser [ParsedVariable]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between ParsecT Void String Identity ()
scn ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof (ParsecT Void String Identity ParsedVariable
-> ParsecT Void String Identity String -> Parser [ParsedVariable]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepEndBy ParsecT Void String Identity ParsedVariable
envLine (ParsecT Void String Identity String
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol ParsecT Void String Identity String
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
scn))
envLine :: Parser ParsedVariable
envLine :: ParsecT Void String Identity ParsedVariable
envLine = String -> VarValue -> ParsedVariable
ParsedVariable (String -> VarValue -> ParsedVariable)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (VarValue -> ParsedVariable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a. Parser a -> Parser a
lexeme ParsecT Void String Identity String
variableName ParsecT Void String Identity String
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a. Parser a -> Parser a
lexeme (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'=')) ParsecT Void String Identity (VarValue -> ParsedVariable)
-> ParsecT Void String Identity VarValue
-> ParsecT Void String Identity ParsedVariable
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void String Identity VarValue
-> ParsecT Void String Identity VarValue
forall a. Parser a -> Parser a
lexeme ParsecT Void String Identity VarValue
value
variableName :: Parser VarName
variableName :: ParsecT Void String Identity String
variableName = ((:) (Char -> String -> String)
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity Char
firstChar ParsecT Void String Identity (String -> String)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Void String Identity Char
otherChar) ParsecT Void String Identity String
-> String -> ParsecT Void String Identity String
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"variable name"
where
firstChar :: ParsecT Void String Identity Char
firstChar = Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'_' ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar
otherChar :: ParsecT Void String Identity Char
otherChar = ParsecT Void String Identity Char
firstChar ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
value :: Parser VarValue
value :: ParsecT Void String Identity VarValue
value = (ParsecT Void String Identity VarValue
quotedValue ParsecT Void String Identity VarValue
-> ParsecT Void String Identity VarValue
-> ParsecT Void String Identity VarValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity VarValue
unquotedValue) ParsecT Void String Identity VarValue
-> String -> ParsecT Void String Identity VarValue
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"variable value"
where
quotedValue :: ParsecT Void String Identity VarValue
quotedValue = QuoteType -> ParsecT Void String Identity VarValue
quotedWith QuoteType
SingleQuote ParsecT Void String Identity VarValue
-> ParsecT Void String Identity VarValue
-> ParsecT Void String Identity VarValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> QuoteType -> ParsecT Void String Identity VarValue
quotedWith QuoteType
DoubleQuote
unquotedValue :: ParsecT Void String Identity VarValue
unquotedValue = VarContents -> VarValue
Unquoted (VarContents -> VarValue)
-> ParsecT Void String Identity VarContents
-> ParsecT Void String Identity VarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity VarFragment
-> ParsecT Void String Identity VarContents
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (String -> ParsecT Void String Identity VarFragment
fragment String
"\'\" \t\n\r")
quotedWith :: QuoteType -> Parser VarValue
quotedWith :: QuoteType -> ParsecT Void String Identity VarValue
quotedWith QuoteType
SingleQuote = VarContents -> VarValue
SingleQuoted (VarContents -> VarValue)
-> ParsecT Void String Identity VarContents
-> ParsecT Void String Identity VarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity VarContents
-> ParsecT Void String Identity VarContents
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\'') (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\'') (ParsecT Void String Identity VarFragment
-> ParsecT Void String Identity VarContents
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (String -> ParsecT Void String Identity VarFragment
literalValueFragment String
"\'\\"))
quotedWith QuoteType
DoubleQuote = VarContents -> VarValue
DoubleQuoted (VarContents -> VarValue)
-> ParsecT Void String Identity VarContents
-> ParsecT Void String Identity VarValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity VarContents
-> ParsecT Void String Identity VarContents
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\"') (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\"') (ParsecT Void String Identity VarFragment
-> ParsecT Void String Identity VarContents
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (String -> ParsecT Void String Identity VarFragment
fragment String
"\""))
fragment :: String -> Parser VarFragment
fragment :: String -> ParsecT Void String Identity VarFragment
fragment String
charsToEscape =
ParsecT Void String Identity VarFragment
interpolatedValueCommandInterpolation
ParsecT Void String Identity VarFragment
-> ParsecT Void String Identity VarFragment
-> ParsecT Void String Identity VarFragment
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity VarFragment
interpolatedValueVarInterpolation
ParsecT Void String Identity VarFragment
-> ParsecT Void String Identity VarFragment
-> ParsecT Void String Identity VarFragment
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT Void String Identity VarFragment
literalValueFragment (Char
'$' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: String
charsToEscape)
interpolatedValueVarInterpolation :: Parser VarFragment
interpolatedValueVarInterpolation :: ParsecT Void String Identity VarFragment
interpolatedValueVarInterpolation = String -> VarFragment
VarInterpolation (String -> VarFragment)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity VarFragment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
((ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity String
symbol String
"${") (String -> ParsecT Void String Identity String
symbol String
"}") ParsecT Void String Identity String
variableName) ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'$' ParsecT Void String Identity Char
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void String Identity String
variableName))
where
symbol :: Tokens String -> ParsecT Void String Identity (Tokens String)
symbol = ParsecT Void String Identity ()
-> Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol ParsecT Void String Identity ()
sc
interpolatedValueCommandInterpolation :: Parser VarFragment
interpolatedValueCommandInterpolation :: ParsecT Void String Identity VarFragment
interpolatedValueCommandInterpolation = do
[String]
ws <- ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity [String]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity String
symbol String
"$(") (String -> ParsecT Void String Identity String
symbol String
")") ParsecT Void String Identity [String]
ShellWords.parser
VarFragment -> ParsecT Void String Identity VarFragment
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VarFragment -> ParsecT Void String Identity VarFragment)
-> VarFragment -> ParsecT Void String Identity VarFragment
forall a b. (a -> b) -> a -> b
$ case [String]
ws of
(String
commandName:[String]
arguments) -> String -> [String] -> VarFragment
CommandInterpolation String
commandName [String]
arguments
[String]
_ -> String -> VarFragment
VarLiteral String
""
where
symbol :: Tokens String -> ParsecT Void String Identity (Tokens String)
symbol = ParsecT Void String Identity ()
-> Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol ParsecT Void String Identity ()
sc
literalValueFragment :: String -> Parser VarFragment
literalValueFragment :: String -> ParsecT Void String Identity VarFragment
literalValueFragment String
charsToEscape = String -> VarFragment
VarLiteral (String -> VarFragment)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity VarFragment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT Void String Identity Char
escapedChar ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity Char
normalChar)
where
escapedChar :: ParsecT Void String Identity Char
escapedChar = (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\\' ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle) ParsecT Void String Identity Char
-> String -> ParsecT Void String Identity Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"escaped character"
normalChar :: ParsecT Void String Identity Char
normalChar = [Token String] -> ParsecT Void String Identity (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
[Token String]
charsToEscape ParsecT Void String Identity Char
-> String -> ParsecT Void String Identity Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"unescaped character"
lexeme :: Parser a -> Parser a
lexeme :: Parser a -> Parser a
lexeme = ParsecT Void String Identity () -> Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void String Identity ()
sc
{-# INLINE lexeme #-}
sc :: Parser ()
sc :: ParsecT Void String Identity ()
sc = ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space (ParsecT Void String Identity Char
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity Char
spaceChar') ParsecT Void String Identity ()
skipLineComment ParsecT Void String Identity ()
forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE sc #-}
scn :: Parser ()
scn :: ParsecT Void String Identity ()
scn = ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space (ParsecT Void String Identity Char
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar) ParsecT Void String Identity ()
skipLineComment ParsecT Void String Identity ()
forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE scn #-}
spaceChar' :: Parser Char
spaceChar' :: ParsecT Void String Identity Char
spaceChar' = [Token String] -> ParsecT Void String Identity (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
" \t" :: String)
{-# INLINE spaceChar' #-}
skipLineComment :: Parser ()
= Tokens String -> ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment Tokens String
"#"
{-# INLINE skipLineComment #-}