{-# 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 (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)
load ::
MonadIO m =>
Bool
-> [(String, String)]
-> 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
:: MonadIO m
=> Config
-> m [(String, String)]
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
parseFile ::
MonadIO m =>
FilePath
-> m [(String, String)]
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)
onMissingFile :: MonadCatch m
=> m a
-> m a
-> 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)