-- |
-- 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 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

-- | 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 = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between Parser ()
scn forall e s (m :: * -> *). MonadParsec e s m => m ()
eof (forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepEndBy Parser ParsedVariable
envLine (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
scn))

-- | Parse a single environment variable assignment.
envLine :: Parser ParsedVariable
envLine :: Parser ParsedVariable
envLine = [Char] -> VarValue -> ParsedVariable
ParsedVariable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Parser a -> Parser a
lexeme ParsecT Void [Char] Identity [Char]
variableName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parser a -> Parser a
lexeme (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'=')) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> Parser a
lexeme Parser 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 [Char] Identity [Char]
variableName = ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void [Char] Identity (Token [Char])
firstChar forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Void [Char] Identity (Token [Char])
otherChar) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"variable name"
  where
    firstChar :: ParsecT Void [Char] Identity (Token [Char])
firstChar = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_'  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar
    otherChar :: ParsecT Void [Char] Identity (Token [Char])
otherChar = ParsecT Void [Char] Identity (Token [Char])
firstChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar

-- | Value: quoted or unquoted.
value :: Parser VarValue
value :: Parser VarValue
value = (Parser VarValue
quotedValue forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser VarValue
unquotedValue) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"variable value"
  where
    quotedValue :: Parser VarValue
quotedValue   = QuoteType -> Parser VarValue
quotedWith QuoteType
SingleQuote forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> QuoteType -> Parser VarValue
quotedWith QuoteType
DoubleQuote
    unquotedValue :: Parser VarValue
unquotedValue = VarContents -> VarValue
Unquoted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ([Char] -> Parser VarFragment
fragment [Char]
"\'\" \t\n\r")

-- | Parse a value quoted with given character.
quotedWith :: QuoteType -> Parser VarValue
quotedWith :: QuoteType -> Parser VarValue
quotedWith QuoteType
SingleQuote = VarContents -> VarValue
SingleQuoted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\'') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\'') (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ([Char] -> Parser VarFragment
literalValueFragment [Char]
"\'\\"))
quotedWith QuoteType
DoubleQuote = VarContents -> VarValue
DoubleQuoted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\"') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\"') (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ([Char] -> Parser VarFragment
fragment [Char]
"\""))

fragment :: String -> Parser VarFragment
fragment :: [Char] -> Parser VarFragment
fragment [Char]
charsToEscape =
  Parser VarFragment
interpolatedValueCommandInterpolation
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser VarFragment
interpolatedValueVarInterpolation
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser VarFragment
literalValueFragment (Char
'$' forall a. a -> [a] -> [a]
: Char
'\\' forall a. a -> [a] -> [a]
: [Char]
charsToEscape)

interpolatedValueVarInterpolation :: Parser VarFragment
interpolatedValueVarInterpolation :: Parser VarFragment
interpolatedValueVarInterpolation = [Char] -> VarFragment
VarInterpolation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                            (forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between ([Char] -> ParsecT Void [Char] Identity [Char]
symbol [Char]
"${") ([Char] -> ParsecT Void [Char] Identity [Char]
symbol [Char]
"}") ParsecT Void [Char] Identity [Char]
variableName forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                            (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'$' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void [Char] Identity [Char]
variableName))
  where
    symbol :: Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
symbol                = forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parser ()
sc

interpolatedValueCommandInterpolation :: Parser VarFragment
interpolatedValueCommandInterpolation :: Parser VarFragment
interpolatedValueCommandInterpolation = do
  [[Char]]
ws <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between ([Char] -> ParsecT Void [Char] Identity [Char]
symbol [Char]
"$(") ([Char] -> ParsecT Void [Char] Identity [Char]
symbol [Char]
")") Parser [[Char]]
ShellWords.parser
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case [[Char]]
ws of
      ([Char]
commandName:[[Char]]
arguments) -> [Char] -> [[Char]] -> VarFragment
CommandInterpolation [Char]
commandName [[Char]]
arguments
      [[Char]]
_ -> [Char] -> VarFragment
VarLiteral [Char]
"" -- Interpret "$()" as an empty value
    where
      symbol :: Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
symbol = forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parser ()
sc

literalValueFragment :: String -> Parser VarFragment
literalValueFragment :: [Char] -> Parser VarFragment
literalValueFragment [Char]
charsToEscape = [Char] -> VarFragment
VarLiteral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT Void [Char] Identity (Token [Char])
escapedChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity (Token [Char])
normalChar)
  where
    escapedChar :: ParsecT Void [Char] Identity (Token [Char])
escapedChar = (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"escaped character"
    normalChar :: ParsecT Void [Char] Identity (Token [Char])
normalChar  = forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char]
charsToEscape forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"unescaped character"

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

-- | Lexeme wrapper that takes care of consuming of white space.
lexeme :: Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme = forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme Parser ()
sc
{-# INLINE lexeme #-}

-- | Space consumer. Consumes all white space including comments, but never
-- consumes newlines.
sc :: Parser ()
sc :: Parser ()
sc = forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space (forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void [Char] Identity Char
spaceChar') Parser ()
skipLineComment forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE sc #-}

-- | Just like 'sc' but also eats newlines.
scn :: Parser ()
scn :: Parser ()
scn = forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar) Parser ()
skipLineComment forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE scn #-}

-- | Just like 'spaceChar', but does not consume newlines.
spaceChar' :: Parser Char
spaceChar' :: ParsecT Void [Char] Identity Char
spaceChar' = forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf ([Char]
" \t" :: String)
{-# INLINE spaceChar' #-}

-- | Skip line comment and stop before newline character without consuming
-- it.
skipLineComment :: Parser ()
skipLineComment :: Parser ()
skipLineComment = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment Tokens [Char]
"#"
{-# INLINE skipLineComment #-}