-- | Conventional @.env@ handling
module Freckle.App.Dotenv
  ( load
  , loadTest
  , loadFile
  ) where

import Freckle.App.Prelude

import qualified Configuration.Dotenv.Compat as Dotenv
import System.FilePath (takeDirectory, (</>))
import UnliftIO.Directory (doesFileExist, getCurrentDirectory)

-- | Call 'loadFile' with @.env@
load :: IO ()
load :: IO ()
load = FilePath -> IO ()
loadFile FilePath
".env"

-- | Call 'loadFile' with @.env.test@
loadTest :: IO ()
loadTest :: IO ()
loadTest = FilePath -> IO ()
loadFile FilePath
".env.test"

-- | An opinionated 'Configuration.Dotenv.loadFile'
--
-- Additional behaviors:
--
-- 1. Attempt to locate the file in parent directories too
--
--    We, sadly, have a monorepository. So we need to locate a @.env@ file in
--    parent directories when running tests in sub-directories.
--
-- 2. Silently ignore no file found
--
--    Since this is used by 'Freckle.App.Test.withApp', which we aim to use in
--    every non-trivial project, we can't fail in projects that don't need or
--    have a @.env(.test)@ file (such as this one!).
--
-- 3. Use the @.env.example@ feature, but only if one exists alongside
loadFile :: FilePath -> IO ()
loadFile :: FilePath -> IO ()
loadFile = (FilePath -> IO ()) -> Maybe FilePath -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ FilePath -> IO ()
forall {m :: * -> *}. MonadIO m => FilePath -> m ()
go (Maybe FilePath -> IO ())
-> (FilePath -> IO (Maybe FilePath)) -> FilePath -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FilePath -> IO (Maybe FilePath)
locateInParents
 where
  go :: FilePath -> m ()
go FilePath
path = do
    let examplePath :: FilePath
examplePath = FilePath -> FilePath
takeDirectory FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
".env.example"
    Bool
exampleExists <- FilePath -> m Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
doesFileExist FilePath
examplePath

    m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      Config -> m ()
forall (m :: * -> *). MonadIO m => Config -> m ()
Dotenv.loadFile (Config -> m ()) -> Config -> m ()
forall a b. (a -> b) -> a -> b
$
        Config
Dotenv.defaultConfig
          { configPath :: [FilePath]
Dotenv.configPath = [FilePath
path]
          , configExamplePath :: [FilePath]
Dotenv.configExamplePath = [FilePath
examplePath | Bool
exampleExists]
          }

locateInParents :: FilePath -> IO (Maybe FilePath)
locateInParents :: FilePath -> IO (Maybe FilePath)
locateInParents FilePath
path = FilePath -> IO (Maybe FilePath)
go (FilePath -> IO (Maybe FilePath))
-> IO FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO FilePath
forall (m :: * -> *). MonadIO m => m FilePath
getCurrentDirectory
 where
  go :: FilePath -> IO (Maybe FilePath)
go FilePath
cwd = do
    let absPath :: FilePath
absPath = FilePath
cwd FilePath -> FilePath -> FilePath
</> FilePath
path

    Bool
exists <- FilePath -> IO Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
doesFileExist FilePath
absPath

    if Bool
exists
      then Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
absPath
      else if FilePath
cwd FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"/" then Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing else FilePath -> IO (Maybe FilePath)
go (FilePath -> IO (Maybe FilePath))
-> FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
cwd