-- |
-- Module      :  Configuration.Dotenv.Types
-- Copyright   :  © 2015–2020 Stack Builders Inc.
-- License     :  MIT
--
-- Maintainer  :  Stack Builders <hackage@stackbuilders.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Parser for files in dotenv format. These files generally consist of lines
-- with the form key=value. Comments and blank lines are also supported. More
-- information on the dotenv format can be found in the project README and the
-- test suite.

{-# 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           Text.Megaparsec                     (Parsec, anySingle,
                                                      between, eof, noneOf,
                                                      oneOf, sepEndBy, (<?>))
import           Text.Megaparsec.Char                (alphaNumChar, char,
                                                      digitChar, eol,
                                                      letterChar, spaceChar)
import qualified Text.Megaparsec.Char.Lexer          as L

type Parser = Parsec Void String

data QuoteType = SingleQuote | DoubleQuote

-- | Returns a parser for a Dotenv configuration file. Accepts key and value
-- arguments separated by @=@. Comments in all positions are handled
-- appropriately.
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))

-- | Parse a single environment variable assignment.
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

-- | Variables must start with a letter or underscore, and may contain
-- letters, digits or '_' character after the first character.
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: quoted or unquoted.
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")

-- | Parse a value quoted with given character.
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 =
  String -> VarFragment
CommandInterpolation
    (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 Char
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar)
    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"

----------------------------------------------------------------------------
-- Boilerplate and whitespace setup

-- | Lexeme wrapper that takes care of consuming of white space.
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 #-}

-- | Space consumer. Consumes all white space including comments, but never
-- consumes newlines.
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 #-}

-- | Just like 'sc' but also eats newlines.
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 #-}

-- | Just like 'spaceChar', but does not consume newlines.
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' #-}

-- | Skip line comment and stop before newline character without consuming
-- it.
skipLineComment :: Parser ()
skipLineComment :: ParsecT Void String Identity ()
skipLineComment = 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 #-}