-- |
-- Module      :  Configuration.Dotenv.Types
-- Copyright   :  © 2015–2020 Stack Builders Inc.
-- License     :  MIT
--
-- Maintainer  :  Stack Builders <hackage@stackbuilders.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- This module contains common functions to load and read dotenv files.
{-# LANGUAGE RecordWildCards #-}

module Configuration.Dotenv
  ( -- * Dotenv Load Functions
    load
  , loadFile
  , parseFile
  , onMissingFile
  , configParser
    -- * Dotenv Types
  , module Configuration.Dotenv.Types
  ) where

import           Configuration.Dotenv.Environment    (getEnvironment, lookupEnv,
                                                      setEnv)
import           Configuration.Dotenv.Parse          (configParser)
import           Configuration.Dotenv.ParsedVariable (interpolateParsedVariables)
import           Configuration.Dotenv.Types          (Config (..),
                                                      defaultConfig)
import           Control.Exception                   (throw)
import           Control.Monad                       (unless, when)
import           Control.Monad.Catch
import           Control.Monad.IO.Class              (MonadIO (..))
import           Control.Monad.Reader                (ReaderT, ask, runReaderT)
import           Control.Monad.Trans                 (lift)
import           Data.Function                       (on)
import           Data.List                           (intercalate, union, (\\))
import           Data.List.NonEmpty                  (NonEmpty (..))
import qualified Data.List.NonEmpty                  as NE
import           Data.Map                            (fromList, toList)
import           System.IO.Error                     (isDoesNotExistError)
import           Text.Megaparsec                     (errorBundlePretty, parse)

-- | Monad Stack for the application
type DotEnv m a = ReaderT Config m a

-- | Loads the given list of options into the environment. Optionally
-- override existing variables with values from Dotenv files.
load ::
     MonadIO m
  => Bool -- ^ Override existing settings?
  -> [(String, String)] -- ^ List of values to be set in environment
  -> m ()
load :: forall (m :: * -> *).
MonadIO m =>
Bool -> [(String, String)] -> m ()
load Bool
override [(String, String)]
kv =
  ReaderT Config m () -> Config -> m ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (((String, String) -> ReaderT Config m (String, String))
-> [(String, String)] -> ReaderT Config m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, String) -> ReaderT Config m (String, String)
forall (m :: * -> *).
MonadIO m =>
(String, String) -> DotEnv m (String, String)
applySetting ([(String, String)] -> [(String, String)]
nubByLastVar [(String, String)]
kv)) Config
defaultConfig {configOverride = override}

-- | @loadFile@ parses the environment variables defined in the dotenv example
-- file and checks if they are defined in the dotenv file or in the environment.
-- It also allows to override the environment variables defined in the environment
-- with the values defined in the dotenv file.
loadFile ::
     MonadIO m
  => Config -- ^ Dotenv configuration
  -> m ()
loadFile :: forall (m :: * -> *). MonadIO m => Config -> m ()
loadFile config :: Config
config@Config {Bool
[String]
configOverride :: Config -> Bool
configPath :: [String]
configExamplePath :: [String]
configOverride :: Bool
configVerbose :: Bool
configDryRun :: Bool
allowDuplicates :: Bool
configPath :: Config -> [String]
configExamplePath :: Config -> [String]
configVerbose :: Config -> Bool
configDryRun :: Config -> Bool
allowDuplicates :: Config -> Bool
..} = do
  [(String, String)]
environment <- IO [(String, String)] -> m [(String, String)]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(String, String)]
getEnvironment

  [(String, String)]
vars <- case ([String] -> Maybe (NonEmpty String)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [String]
configPath, [String] -> Maybe (NonEmpty String)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [String]
configExamplePath) of
    (Maybe (NonEmpty String)
Nothing, Maybe (NonEmpty String)
_) -> [(String, String)] -> m [(String, String)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    (Just NonEmpty String
envs, Maybe (NonEmpty String)
Nothing) -> NonEmpty [(String, String)] -> [(String, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (NonEmpty [(String, String)] -> [(String, String)])
-> m (NonEmpty [(String, String)]) -> m [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> m [(String, String)])
-> NonEmpty String -> m (NonEmpty [(String, String)])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM String -> m [(String, String)]
forall (m :: * -> *). MonadIO m => String -> m [(String, String)]
parseFile NonEmpty String
envs
    (Just NonEmpty String
envs, Just NonEmpty String
envExamples) -> do
      [(String, String)]
readVars <- NonEmpty [(String, String)] -> [(String, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (NonEmpty [(String, String)] -> [(String, String)])
-> m (NonEmpty [(String, String)]) -> m [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> m [(String, String)])
-> NonEmpty String -> m (NonEmpty [(String, String)])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM String -> m [(String, String)]
forall (m :: * -> *). MonadIO m => String -> m [(String, String)]
parseFile NonEmpty String
envs
      [String]
neededKeys <- ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst ([(String, String)] -> [String])
-> (NonEmpty [(String, String)] -> [(String, String)])
-> NonEmpty [(String, String)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty [(String, String)] -> [(String, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (NonEmpty [(String, String)] -> [String])
-> m (NonEmpty [(String, String)]) -> m [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> m [(String, String)])
-> NonEmpty String -> m (NonEmpty [(String, String)])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM String -> m [(String, String)]
forall (m :: * -> *). MonadIO m => String -> m [(String, String)]
parseFile NonEmpty String
envExamples

      let
        presentKeys :: [String]
presentKeys = ([String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
union ([String] -> [String] -> [String])
-> ([(String, String)] -> [String])
-> [(String, String)]
-> [(String, String)]
-> [String]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
environment [(String, String)]
readVars
        missingKeys :: [String]
missingKeys = [String]
neededKeys [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
presentKeys

      [(String, String)] -> m [(String, String)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(String, String)] -> m [(String, String)])
-> [(String, String)] -> m [(String, String)]
forall a b. (a -> b) -> a -> b
$
        if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
missingKeys
          then [(String, String)]
readVars
          else String -> [(String, String)]
forall a. HasCallStack => String -> a
error (String -> [(String, String)]) -> String -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ String
"The following variables are present in "
            , String -> NonEmpty String -> String
showPaths String
"one of " NonEmpty String
envExamples
            , String
", but not set in the current environment, or "
            , String -> NonEmpty String -> String
showPaths String
"any of " NonEmpty String
envs
            , String
": "
            , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
missingKeys
            ]

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allowDuplicates (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ([String] -> m ()
forall (m :: * -> *). MonadIO m => [String] -> m ()
lookUpDuplicates ([String] -> m ())
-> ([(String, String)] -> [String]) -> [(String, String)] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
vars
  ReaderT Config m () -> Config -> m ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (((String, String) -> ReaderT Config m (String, String))
-> [(String, String)] -> ReaderT Config m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, String) -> ReaderT Config m (String, String)
forall (m :: * -> *).
MonadIO m =>
(String, String) -> DotEnv m (String, String)
applySetting ([(String, String)] -> [(String, String)]
nubByLastVar [(String, String)]
vars)) Config
config
 where
  showPaths :: String -> NonEmpty FilePath -> String
  showPaths :: String -> NonEmpty String -> String
showPaths String
_ (String
p:|[]) = String
p
  showPaths String
prefix NonEmpty String
ps = String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty String
ps)

-- | Parses the given dotenv file and returns values /without/ adding them to
-- the environment.
parseFile ::
     MonadIO m
  => FilePath -- ^ A file containing options to read
  -> m [(String, String)] -- ^ Variables contained in the file
parseFile :: forall (m :: * -> *). MonadIO m => String -> m [(String, String)]
parseFile String
f = do
  String
contents <- IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile String
f
  case Parsec Void String [ParsedVariable]
-> String
-> String
-> Either (ParseErrorBundle String Void) [ParsedVariable]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void String [ParsedVariable]
configParser String
f String
contents of
    Left ParseErrorBundle String Void
e        -> String -> m [(String, String)]
forall a. HasCallStack => String -> a
error (String -> m [(String, String)]) -> String -> m [(String, String)]
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle String Void
e
    Right [ParsedVariable]
options -> IO [(String, String)] -> m [(String, String)]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(String, String)] -> m [(String, String)])
-> IO [(String, String)] -> m [(String, String)]
forall a b. (a -> b) -> a -> b
$ [ParsedVariable] -> IO [(String, String)]
interpolateParsedVariables [ParsedVariable]
options

applySetting ::
     MonadIO m
  => (String, String) -- ^ A key-value pair to set in the environment
  -> DotEnv m (String, String)
applySetting :: forall (m :: * -> *).
MonadIO m =>
(String, String) -> DotEnv m (String, String)
applySetting kv :: (String, String)
kv@(String
k, String
v) = do
  Config {Bool
[String]
configOverride :: Config -> Bool
configPath :: Config -> [String]
configExamplePath :: Config -> [String]
configVerbose :: Config -> Bool
configDryRun :: Config -> Bool
allowDuplicates :: Config -> Bool
configPath :: [String]
configExamplePath :: [String]
configOverride :: Bool
configVerbose :: Bool
configDryRun :: Bool
allowDuplicates :: Bool
..} <- ReaderT Config m Config
forall r (m :: * -> *). MonadReader r m => m r
ask
  if Bool
configOverride
    then (String, String) -> DotEnv m ()
forall (m :: * -> *). MonadIO m => (String, String) -> DotEnv m ()
info (String, String)
kv DotEnv m ()
-> DotEnv m (String, String) -> DotEnv m (String, String)
forall a b.
ReaderT Config m a -> ReaderT Config m b -> ReaderT Config m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DotEnv m (String, String)
setEnv'
    else do
      Maybe String
res <- m (Maybe String) -> ReaderT Config m (Maybe String)
forall (m :: * -> *) a. Monad m => m a -> ReaderT Config m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe String) -> ReaderT Config m (Maybe String))
-> (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String)
-> ReaderT Config m (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe String) -> m (Maybe String)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> ReaderT Config m (Maybe String))
-> IO (Maybe String) -> ReaderT Config m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv String
k
      case Maybe String
res of
        Maybe String
Nothing -> (String, String) -> DotEnv m ()
forall (m :: * -> *). MonadIO m => (String, String) -> DotEnv m ()
info (String, String)
kv DotEnv m ()
-> DotEnv m (String, String) -> DotEnv m (String, String)
forall a b.
ReaderT Config m a -> ReaderT Config m b -> ReaderT Config m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DotEnv m (String, String)
setEnv'
        Just String
_  -> (String, String) -> DotEnv m (String, String)
forall a. a -> ReaderT Config m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String, String)
kv
  where
    setEnv' :: DotEnv m (String, String)
setEnv' = m (String, String) -> DotEnv m (String, String)
forall (m :: * -> *) a. Monad m => m a -> ReaderT Config m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (String, String) -> DotEnv m (String, String))
-> (IO (String, String) -> m (String, String))
-> IO (String, String)
-> DotEnv m (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (String, String) -> m (String, String)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (String, String) -> DotEnv m (String, String))
-> IO (String, String) -> DotEnv m (String, String)
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
setEnv String
k String
v IO () -> IO (String, String) -> IO (String, String)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String, String) -> IO (String, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String, String)
kv

-- | The function logs in console when a variable is loaded into the
-- environment.
info :: MonadIO m => (String, String) -> DotEnv m ()
info :: forall (m :: * -> *). MonadIO m => (String, String) -> DotEnv m ()
info (String
key, String
value) = do
  Config {Bool
[String]
configOverride :: Config -> Bool
configPath :: Config -> [String]
configExamplePath :: Config -> [String]
configVerbose :: Config -> Bool
configDryRun :: Config -> Bool
allowDuplicates :: Config -> Bool
configPath :: [String]
configExamplePath :: [String]
configOverride :: Bool
configVerbose :: Bool
configDryRun :: Bool
allowDuplicates :: Bool
..} <- ReaderT Config m Config
forall r (m :: * -> *). MonadReader r m => m r
ask
  Bool -> DotEnv m () -> DotEnv m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
configVerbose Bool -> Bool -> Bool
|| Bool
configDryRun) (DotEnv m () -> DotEnv m ()) -> DotEnv m () -> DotEnv m ()
forall a b. (a -> b) -> a -> b
$
    m () -> DotEnv m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT Config m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> DotEnv m ()) -> (IO () -> m ()) -> IO () -> DotEnv m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DotEnv m ()) -> IO () -> DotEnv m ()
forall a b. (a -> b) -> a -> b
$
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ (String, String) -> String
infoStr (String
key, String
value)

-- | The function prints out the variables
infoStr :: (String, String) -> String
infoStr :: (String, String) -> String
infoStr (String
key, String
value) =  String
"[INFO]: Load env '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' with value '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
value String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"

-- | The helper allows to avoid exceptions in the case of missing files and
-- perform some action instead.
--
-- @since 0.3.1.0
onMissingFile ::
     MonadCatch m
  => m a -- ^ Action to perform that may fail because of missing file
  -> m a -- ^ Action to perform if file is indeed missing
  -> m a
onMissingFile :: forall (m :: * -> *) a. MonadCatch m => m a -> m a -> m a
onMissingFile m a
f m a
h = (IOError -> Bool) -> m a -> (IOError -> m a) -> m a
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> Bool) -> m a -> (e -> m a) -> m a
catchIf IOError -> Bool
isDoesNotExistError m a
f (m a -> IOError -> m a
forall a b. a -> b -> a
const m a
h)

-- | The helper throws an exception if the allow duplicate is set to False.
forbidDuplicates :: MonadIO m => String -> m ()
forbidDuplicates :: forall (m :: * -> *). MonadIO m => String -> m ()
forbidDuplicates String
key =
  IOError -> m ()
forall a e. Exception e => e -> a
throw (IOError -> m ()) -> IOError -> m ()
forall a b. (a -> b) -> a -> b
$
  String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$
  String
"[ERROR]: Env '" String -> String -> String
forall a. [a] -> [a] -> [a]
++
  String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++
  String
"' is duplicated in a dotenv file. Please, fix that (or remove --no-dups)."

lookUpDuplicates :: MonadIO m => [String] -> m ()
lookUpDuplicates :: forall (m :: * -> *). MonadIO m => [String] -> m ()
lookUpDuplicates [] = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
lookUpDuplicates [String
_] = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
lookUpDuplicates (String
x:[String]
xs) =
  if String
x String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
xs
    then String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
forbidDuplicates String
x
    else [String] -> m ()
forall (m :: * -> *). MonadIO m => [String] -> m ()
lookUpDuplicates [String]
xs

nubByLastVar :: [(String, String)] -> [(String, String)]
nubByLastVar :: [(String, String)] -> [(String, String)]
nubByLastVar = Map String String -> [(String, String)]
forall k a. Map k a -> [(k, a)]
toList (Map String String -> [(String, String)])
-> ([(String, String)] -> Map String String)
-> [(String, String)]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
fromList