{-# LANGUAGE RecordWildCards #-}
module Configuration.Dotenv
(
load
, loadFile
, parseFile
, onMissingFile
, 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.Function (on)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import Data.List ((\\), intercalate, union)
import System.IO.Error (isDoesNotExistError)
import Text.Megaparsec (errorBundlePretty, parse)
type DotEnv m a = ReaderT Config m a
load ::
MonadIO m
=> Bool
-> [(String, String)]
-> 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 ::
MonadIO m
=> Config
-> 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)]
vars <- case (forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [String]
configPath, forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [String]
configExamplePath) of
(Maybe (NonEmpty String)
Nothing, Maybe (NonEmpty String)
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
(Just NonEmpty String
envs, Maybe (NonEmpty String)
Nothing) -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 NonEmpty String
envs
(Just NonEmpty String
envs, Just NonEmpty String
envExamples) -> do
[(String, String)]
readVars <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 NonEmpty String
envs
[String]
neededKeys <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 NonEmpty String
envExamples
let
presentKeys :: [String]
presentKeys = (forall a. Eq a => [a] -> [a] -> [a]
union forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst) [(String, String)]
environment [(String, String)]
readVars
missingKeys :: [String]
missingKeys = [String]
neededKeys forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
presentKeys
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
missingKeys
then [(String, String)]
readVars
else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ 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
": "
, forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
missingKeys
]
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
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 forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a. NonEmpty a -> [a]
NE.toList NonEmpty String
ps)
parseFile ::
MonadIO m
=> FilePath
-> m [(String, String)]
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)
-> 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
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
"'"
onMissingFile ::
MonadCatch m
=> m a
-> m a
-> 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.
(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)
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