{-# LANGUAGE RecordWildCards #-}
module Configuration.Dotenv
(
load
, loadFile
, parseFile
, onMissingFile
, configParser
, 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)
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 =
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 ::
MonadIO m
=> Config
-> 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)
parseFile ::
MonadIO m
=> FilePath
-> m [(String, String)]
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)
-> 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
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)
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
"'"
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 = (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)
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