-- |
--
-- This is effectively a port of dotenv, whose README explains it best:
--
-- > Storing configuration in the environment is one of the tenets of a
-- > twelve-factor app. Anything that is likely to change between deployment
-- > environments–such as resource handles for databases or credentials for
-- > external services–should be extracted from the code into environment
-- > variables.
-- >
-- > But it is not always practical to set environment variables on development
-- > machines or continuous integration servers where multiple projects are run.
-- > dotenv loads variables from a .env file into ENV when the environment is
-- > bootstrapped.
--
-- <https://github.com/bkeepers/dotenv>
--
-- This library exposes functions for doing just that.
--
module LoadEnv
    ( loadEnv
    , loadEnvFrom
    , loadEnvFromAbsolute
    ) where

import Control.Monad (unless, (<=<))
import Data.Bool (bool)
import Data.Foldable (for_, traverse_)
import Data.List (inits)
import Data.Maybe (isJust)
import LoadEnv.Parse
import System.Directory
    (doesFileExist, findFile, getCurrentDirectory, makeAbsolute)
import System.Environment (lookupEnv, setEnv)
import System.FilePath (isRelative, joinPath, splitDirectories)
import Text.Parsec.String (parseFromFile)

-- | @'loadEnvFrom' \".env\"@
loadEnv :: IO ()
loadEnv :: IO ()
loadEnv = FilePath -> IO ()
loadEnvFrom FilePath
".env"

-- | Parse the given file and set variables in the process's environment
--
-- Variables can be declared in the following form:
--
-- > FOO=bar
-- > FOO="bar"
-- > FOO='bar'
--
-- Declarations may optionally be preceded by @\"export \"@, which will be
-- ignored. Trailing whitespace is ignored. Quotes inside quoted values or
-- spaces in unquoted values must be escaped with a backlash. Invalid lines are
-- silently ignored.
--
-- __NOTE__: If the file-name is relative, the directory tree will be traversed
-- up to @\/@ looking for the file in each parent. Use @'loadEnvFromAbsolute'@
-- to avoid this.
--
loadEnvFrom :: FilePath -> IO ()
loadEnvFrom :: FilePath -> IO ()
loadEnvFrom FilePath
name = do
    Maybe FilePath
mFile <- if FilePath -> Bool
isRelative FilePath
name
        then ([FilePath] -> FilePath -> IO (Maybe FilePath))
-> FilePath -> [FilePath] -> IO (Maybe FilePath)
forall a b c. (a -> b -> c) -> b -> a -> c
flip [FilePath] -> FilePath -> IO (Maybe FilePath)
findFile FilePath
name ([FilePath] -> IO (Maybe FilePath))
-> (FilePath -> [FilePath]) -> FilePath -> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
takeDirectories (FilePath -> IO (Maybe FilePath))
-> IO FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO FilePath
getCurrentDirectory
        else Maybe FilePath -> Maybe FilePath -> Bool -> Maybe FilePath
forall a. a -> a -> Bool -> a
bool Maybe FilePath
forall a. Maybe a
Nothing (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
name) (Bool -> Maybe FilePath) -> IO Bool -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesFileExist FilePath
name

    Maybe FilePath -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe FilePath
mFile ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
file -> do
        Either ParseError Environment
result <- Parser Environment
-> FilePath -> IO (Either ParseError Environment)
forall a. Parser a -> FilePath -> IO (Either ParseError a)
parseFromFile Parser Environment
parseEnvironment FilePath
file
        (ParseError -> IO ())
-> (Environment -> IO ()) -> Either ParseError Environment -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> IO ()
forall a. Show a => a -> IO ()
print (((FilePath, FilePath) -> IO ()) -> Environment -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (((FilePath, FilePath) -> IO ()) -> Environment -> IO ())
-> ((FilePath, FilePath) -> IO ()) -> Environment -> IO ()
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath -> IO ()) -> (FilePath, FilePath) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> FilePath -> IO ()
defaultEnv) Either ParseError Environment
result

defaultEnv :: String -> String -> IO ()
defaultEnv :: FilePath -> FilePath -> IO ()
defaultEnv FilePath
k FilePath
v = do
    Bool
exists <- Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FilePath -> Bool) -> IO (Maybe FilePath) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
k
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
setEnv FilePath
k FilePath
v

-- | @'loadEnvFrom'@, but don't traverse up the directory tree
loadEnvFromAbsolute :: FilePath -> IO ()
loadEnvFromAbsolute :: FilePath -> IO ()
loadEnvFromAbsolute = FilePath -> IO ()
loadEnvFrom (FilePath -> IO ())
-> (FilePath -> IO FilePath) -> FilePath -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FilePath -> IO FilePath
makeAbsolute

-- | Get all directory names of a directory
--
-- Includes itself as the first element of the output.
--
-- >>> takeDirectories "/foo/bar/baz"
-- ["/foo/bar/baz","/foo/bar","/foo","/"]
--
-- Leading path-separator is meaningful, and determines if the root directory is
-- included or not.
--
-- >>> takeDirectories "foo/bar/baz"
-- ["foo/bar/baz","foo/bar","foo"]
--
-- Trailing path-separator is not meaningful.
--
-- >>> takeDirectories "/foo/bar/baz/"
-- ["/foo/bar/baz","/foo/bar","/foo","/"]
--
takeDirectories :: FilePath -> [FilePath]
takeDirectories :: FilePath -> [FilePath]
takeDirectories = ([FilePath] -> FilePath) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map [FilePath] -> FilePath
joinPath ([[FilePath]] -> [FilePath])
-> (FilePath -> [[FilePath]]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[FilePath]] -> [[FilePath]]
forall a. [a] -> [a]
reverse ([[FilePath]] -> [[FilePath]])
-> (FilePath -> [[FilePath]]) -> FilePath -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[FilePath]] -> [[FilePath]]
forall a. Int -> [a] -> [a]
drop Int
1 ([[FilePath]] -> [[FilePath]])
-> (FilePath -> [[FilePath]]) -> FilePath -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [[FilePath]]
forall a. [a] -> [[a]]
inits ([FilePath] -> [[FilePath]])
-> (FilePath -> [FilePath]) -> FilePath -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories