-- |
-- 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
      -- * 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.Monad.Trans                 (lift)
import           Control.Monad.Reader                (ReaderT, ask, runReaderT)
import           Control.Exception                   (throw)
import           Control.Monad                       (unless, when)
import           Control.Monad.Catch
import           Control.Monad.IO.Class              (MonadIO (..))
import           Data.List                           (intersectBy, union,
                                                      unionBy)
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 =
  forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *).
MonadIO m =>
(String, String) -> DotEnv m (String, String)
applySetting [(String, String)]
kv) Config
defaultConfig {configOverride :: Bool
configOverride = Bool
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]
allowDuplicates :: Config -> Bool
configVerbose :: Config -> Bool
configExamplePath :: Config -> [String]
configPath :: Config -> [String]
allowDuplicates :: Bool
configVerbose :: Bool
configOverride :: Bool
configExamplePath :: [String]
configPath :: [String]
configOverride :: Config -> Bool
..} = do
  [(String, String)]
environment <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(String, String)]
getEnvironment
  [(String, String)]
readVars <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). MonadIO m => String -> m [(String, String)]
parseFile [String]
configPath)
  [(String, String)]
neededVars <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). MonadIO m => String -> m [(String, String)]
parseFile [String]
configExamplePath)
  let coincidences :: [(String, String)]
coincidences = ([(String, String)]
environment forall a. Eq a => [a] -> [a] -> [a]
`union` [(String, String)]
readVars) forall {b}. [(String, b)] -> [(String, b)] -> [(String, b)]
`intersectEnvs` [(String, String)]
neededVars
      cmpEnvs :: (a, b) -> (a, b) -> Bool
cmpEnvs (a, b)
env1 (a, b)
env2 = forall a b. (a, b) -> a
fst (a, b)
env1 forall a. Eq a => a -> a -> Bool
== forall a b. (a, b) -> a
fst (a, b)
env2
      intersectEnvs :: [(String, b)] -> [(String, b)] -> [(String, b)]
intersectEnvs = forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
intersectBy forall {a} {b} {b}. Eq a => (a, b) -> (a, b) -> Bool
cmpEnvs
      unionEnvs :: [(String, b)] -> [(String, b)] -> [(String, b)]
unionEnvs = forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
unionBy forall {a} {b} {b}. Eq a => (a, b) -> (a, b) -> Bool
cmpEnvs
      vars :: [(String, String)]
vars =
        if (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [(String, String)]
neededVars
          then if forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, String)]
neededVars forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, String)]
coincidences
                 then [(String, String)]
readVars forall {b}. [(String, b)] -> [(String, b)] -> [(String, b)]
`unionEnvs` [(String, String)]
neededVars
                 else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
                      String
"Missing env vars! Please, check (this/these) var(s) (is/are) set:" forall a. [a] -> [a] -> [a]
++
                      forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. [a] -> [a] -> [a]
(++) String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, String)]
neededVars
          else [(String, String)]
readVars
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allowDuplicates forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *). MonadIO m => [String] -> m ()
lookUpDuplicates forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst) [(String, String)]
vars
  forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *).
MonadIO m =>
(String, String) -> DotEnv m (String, String)
applySetting [(String, String)]
vars) Config
config

-- | 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile String
f
  case forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parser [ParsedVariable]
configParser String
f String
contents of
    Left ParseErrorBundle String Void
e        -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle String Void
e
    Right [ParsedVariable]
options -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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]
allowDuplicates :: Bool
configVerbose :: Bool
configOverride :: Bool
configExamplePath :: [String]
configPath :: [String]
allowDuplicates :: Config -> Bool
configVerbose :: Config -> Bool
configExamplePath :: Config -> [String]
configPath :: Config -> [String]
configOverride :: Config -> Bool
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
  if Bool
configOverride
    then forall (m :: * -> *). MonadIO m => (String, String) -> DotEnv m ()
info (String, String)
kv forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DotEnv m (String, String)
setEnv'
    else do
      Maybe String
res <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv String
k
      case Maybe String
res of
        Maybe String
Nothing -> forall (m :: * -> *). MonadIO m => (String, String) -> DotEnv m ()
info (String, String)
kv forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DotEnv m (String, String)
setEnv'
        Just String
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return (String, String)
kv
  where
    setEnv' :: DotEnv m (String, String)
setEnv' = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
setEnv String
k String
v forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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]
allowDuplicates :: Bool
configVerbose :: Bool
configOverride :: Bool
configExamplePath :: [String]
configPath :: [String]
allowDuplicates :: Config -> Bool
configVerbose :: Config -> Bool
configExamplePath :: Config -> [String]
configPath :: Config -> [String]
configOverride :: Config -> Bool
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
configVerbose forall a b. (a -> b) -> a -> b
$
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"[INFO]: Load env '" forall a. [a] -> [a] -> [a]
++ String
key forall a. [a] -> [a] -> [a]
++ String
"' with value '" forall a. [a] -> [a] -> [a]
++ String
value 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 = 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 (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 =
  forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$
  String -> IOError
userError forall a b. (a -> b) -> a -> b
$
  String
"[ERROR]: Env '" forall a. [a] -> [a] -> [a]
++
  String
key 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 [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
lookUpDuplicates [String
_] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
lookUpDuplicates (String
x:[String]
xs) =
  if String
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
xs
    then forall (m :: * -> *). MonadIO m => String -> m ()
forbidDuplicates String
x
    else forall (m :: * -> *). MonadIO m => [String] -> m ()
lookUpDuplicates [String]
xs