-- |
-- 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                       (liftM)
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)

-- | 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 :: Bool -> [(String, String)] -> m ()
load Bool
override = ((String, String) -> m (String, String))
-> [(String, String)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> (String, String) -> m (String, String)
forall (m :: * -> *).
MonadIO m =>
Bool -> (String, String) -> m (String, String)
applySetting 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 [(String, String)] -- ^ Environment variables loaded
loadFile :: Config -> m [(String, String)]
loadFile Config{Bool
[String]
configOverride :: Config -> Bool
configExamplePath :: Config -> [String]
configPath :: Config -> [String]
configOverride :: Bool
configExamplePath :: [String]
configPath :: [String]
..} = do
  [(String, String)]
environment <- IO [(String, String)] -> m [(String, String)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(String, String)]
getEnvironment
  [(String, String)]
readedVars <- [[(String, String)]] -> [(String, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(String, String)]] -> [(String, String)])
-> m [[(String, String)]] -> m [(String, String)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (String -> m [(String, String)])
-> [String] -> m [[(String, String)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> m [(String, String)]
forall (m :: * -> *). MonadIO m => String -> m [(String, String)]
parseFile [String]
configPath
  [(String, String)]
neededVars <- [[(String, String)]] -> [(String, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(String, String)]] -> [(String, String)])
-> m [[(String, String)]] -> m [(String, String)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (String -> m [(String, String)])
-> [String] -> m [[(String, String)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> m [(String, String)]
forall (m :: * -> *). MonadIO m => String -> m [(String, String)]
parseFile [String]
configExamplePath
  let coincidences :: [(String, String)]
coincidences = ([(String, String)]
environment [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Eq a => [a] -> [a] -> [a]
`union` [(String, String)]
readedVars) [(String, String)] -> [(String, String)] -> [(String, String)]
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 = (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
env1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
env2
      intersectEnvs :: [(String, b)] -> [(String, b)] -> [(String, b)]
intersectEnvs = ((String, b) -> (String, b) -> Bool)
-> [(String, b)] -> [(String, b)] -> [(String, b)]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
intersectBy (String, b) -> (String, b) -> Bool
forall a b b. Eq a => (a, b) -> (a, b) -> Bool
cmpEnvs
      unionEnvs :: [(String, b)] -> [(String, b)] -> [(String, b)]
unionEnvs = ((String, b) -> (String, b) -> Bool)
-> [(String, b)] -> [(String, b)] -> [(String, b)]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
unionBy (String, b) -> (String, b) -> Bool
forall a b b. Eq a => (a, b) -> (a, b) -> Bool
cmpEnvs
      vars :: [(String, String)]
vars =
        if (Bool -> Bool
not (Bool -> Bool)
-> ([(String, String)] -> Bool) -> [(String, String)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [(String, String)]
neededVars
          then
            if [(String, String)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, String)]
neededVars Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(String, String)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, String)]
coincidences
              then [(String, String)]
readedVars [(String, String)] -> [(String, String)] -> [(String, String)]
forall b. [(String, b)] -> [(String, b)] -> [(String, b)]
`unionEnvs` [(String, String)]
neededVars
              else String -> [(String, String)]
forall a. HasCallStack => String -> a
error (String -> [(String, String)]) -> String -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ String
"Missing env vars! Please, check (this/these) var(s) (is/are) set:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((String, String) -> String) -> [(String, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> String -> String
forall a. [a] -> [a] -> [a]
(++) String
" " (String -> String)
-> ((String, String) -> String) -> (String, String) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
neededVars
          else [(String, String)]
readedVars
  ((String, String) -> m (String, String))
-> [(String, String)] -> m [(String, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> (String, String) -> m (String, String)
forall (m :: * -> *).
MonadIO m =>
Bool -> (String, String) -> m (String, String)
applySetting Bool
configOverride) [(String, String)]
vars

-- | 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 :: String -> m [(String, String)]
parseFile String
f = do
  String
contents <- IO String -> m String
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 (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 => Bool -> (String, String) -> m (String, String)
applySetting :: Bool -> (String, String) -> m (String, String)
applySetting Bool
override (String
key, String
value) =
  if Bool
override
    then IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> String -> IO ()
setEnv String
key String
value) m () -> m (String, String) -> m (String, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String, String) -> m (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
key, String
value)
    else do
      Maybe String
res <- IO (Maybe String) -> m (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv String
key

      case Maybe String
res of
        Maybe String
Nothing -> IO (String, String) -> m (String, String)
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
$ String -> String -> IO ()
setEnv String
key String
value IO () -> IO (String, String) -> IO (String, String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String, String) -> IO (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
key, String
value)
        Just String
_  -> (String, String) -> m (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
key, String
value)

-- | 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 :: 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.
(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)