-- |
--  Module      : Cfg.Env
--  Copyright   : © Jonathan Lorimer, 2023
--  License     : MIT
--  Maintainer  : jonathanlorimer@pm.me
--  Stability   : stable
--
-- @since 0.0.2.0
--
-- This module contains all the functions for interacting with environment
-- variables as a configuration source.
module Cfg.Env
  ( -- * Retrieval Functions
    envSourceSep
  , envSource
  , getEnvConfigSep
  , getEnvConfig

    -- * Printing Functions
  , printDotEnv'
  , printDotEnv
  )
where

import Cfg
import Cfg.Env.Keys
import Cfg.Parser
import Cfg.Source
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO (writeFile)
import KeyTree
import System.Environment (lookupEnv)
import Prelude hiding (writeFile)

-- | This function folds the tree from root to leaf accumulating the keys along
-- the way. At the leaf we lookup the aggregated key in the environment, if
-- there is a default then we use that for missing keys.
--
-- If you are looking at the source code this is what the functions in the
-- @where@ clause do:
--
--    - @valF@: Gets called on 'Pure' values in the original tree passed in,
--    these indicate defaulted values, so we use the default if looking the
--    value up in the environment failed.
--
--    - @accF@: This operates on the accumulated key, and is responsible for
--    looking up the value in the environment when we hit the @Free M.empty@
--    case.
--
--    - @stepF@: This is the step function for the fold and accumulates the
--    keys as we traverse down the tree.
--
--    - @mkKey@: This function is the same as 'Cfg.Env.Keys.getEnvKey' except
--    that it uses @flip mappend@. The reason for this is that we insert keys
--    into the accumulator as we traverse down so they end up in reversed
--    order, then we @foldr@ over them so we just need to make sure that we are
--    placing the elements at the end of the list on the left hand side of the
--    aggregate key.
--
-- @since 0.0.1.0
envSourceSep
  :: forall m
   . (MonadIO m)
  => Text
  -- ^ Separator
  -> KeyTree Text Text
  -- ^ Configuration source
  -> m (KeyTree Text Text)
  -- ^ Configuration tree with values filled in
envSourceSep :: forall (m :: * -> *).
MonadIO m =>
Text -> KeyTree Text Text -> m (KeyTree Text Text)
envSourceSep Text
sep = ([Text] -> Text -> m Text)
-> ([Text] -> m (Maybe Text))
-> (Text -> [Text] -> Map Text (KeyTree Text Text) -> [Text])
-> [Text]
-> KeyTree Text Text
-> m (KeyTree Text Text)
forall (f :: * -> *) k v a v'.
(Applicative f, Eq k, Eq v) =>
(a -> v -> f v')
-> (a -> f (Maybe v'))
-> (k -> a -> Map k (Free (Map k) v) -> a)
-> a
-> Free (Map k) v
-> f (KeyTree k v')
mayAppendTraverse [Text] -> Text -> m Text
valF [Text] -> m (Maybe Text)
accF Text -> [Text] -> Map Text (KeyTree Text Text) -> [Text]
stepF []
 where
  valF :: [Text] -> Text -> m Text
  valF :: [Text] -> Text -> m Text
valF [Text]
keys Text
def = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
def (Maybe Text -> Text) -> m (Maybe Text) -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m (Maybe Text)
accF [Text]
keys

  accF :: [Text] -> m (Maybe Text)
  accF :: [Text] -> m (Maybe Text)
accF = (Maybe String -> Maybe Text) -> m (Maybe String) -> m (Maybe Text)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Maybe String -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack) (m (Maybe String) -> m (Maybe Text))
-> ([Text] -> m (Maybe String)) -> [Text] -> m (Maybe Text)
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) -> m (Maybe String))
-> ([Text] -> IO (Maybe String)) -> [Text] -> m (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
lookupEnv (String -> IO (Maybe String))
-> ([Text] -> String) -> [Text] -> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> ([Text] -> Text) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
mkKey

  stepF :: Text -> [Text] -> KeyForest Text Text -> [Text]
  stepF :: Text -> [Text] -> Map Text (KeyTree Text Text) -> [Text]
stepF Text
key [Text]
acc Map Text (KeyTree Text Text)
_ = Text
key Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc

  mkKey :: [Text] -> Text
  mkKey :: [Text] -> Text
mkKey [Text]
keys = (Text -> Text -> Text) -> Text -> [Text] -> Text
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Text -> Text -> Text) -> Text -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend) Text
"" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
sep [Text]
keys

-- | This function is the same as 'envSourceSep' but with the separator specialized to \"_\".
--
-- >>> import System.Environment
-- >>> import Data.Map qualified as M
-- >>> setEnv "A_B" "Functor"
-- >>> setEnv "A_C" "Applicative"
-- >>> setEnv "A_D" "Monad"
-- >>> envSource $ Free $ M.fromList [("A", Free $ M.fromList [("B", Free M.empty), ("C", Free M.empty), ("D", Free M.empty)])]
-- Free (fromList [("A",Free (fromList [("B",Pure "Functor"),("C",Pure "Applicative"),("D",Pure "Monad")]))])
--
-- @since 0.0.1.0
envSource :: (MonadFail m, MonadIO m) => KeyTree Text Text -> m (KeyTree Text Text)
envSource :: forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
KeyTree Text Text -> m (KeyTree Text Text)
envSource = Text -> KeyTree Text Text -> m (KeyTree Text Text)
forall (m :: * -> *).
MonadIO m =>
Text -> KeyTree Text Text -> m (KeyTree Text Text)
envSourceSep Text
"_"

-- | This function can be used to print a dotenv style file with all the
-- aggregate keys, none of the values will be filled in.
--
-- Useful for testing what your expected environment variables should look
-- like, and generating an env var file template.
--
-- @since 0.0.1.0
printDotEnv'
  :: FilePath
  -- ^ Destination filepath
  -> Text
  -- ^ Separator
  -> KeyTree Text Text
  -- ^ Source representation
  -> IO ()
printDotEnv' :: String -> Text -> KeyTree Text Text -> IO ()
printDotEnv' String
path Text
sep = String -> Text -> IO ()
writeFile String
path (Text -> IO ())
-> (KeyTree Text Text -> Text) -> KeyTree Text Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
line -> Text
"export " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=\n") ([Text] -> Text)
-> (KeyTree Text Text -> [Text]) -> KeyTree Text Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> KeyTree Text Text -> [Text]
showEnvKeys' Text
sep

-- | Requires a type annotation for your configuration type (with a
-- 'ConfigSource' and 'ConfigParser' instance), and a separator, and will go
-- out and fetch the values from environment variables then return your type
-- parsed from those values.
--
-- @getEnvConfigSep \@AppConfig "_"@
--
-- @since 0.0.1.0
getEnvConfigSep
  :: forall a m
   . (MonadFail m, MonadIO m, ConfigSource a, ConfigParser a)
  => Text
  -- ^ Separator
  -> m (Either ConfigParseError a)
getEnvConfigSep :: forall a (m :: * -> *).
(MonadFail m, MonadIO m, ConfigSource a, ConfigParser a) =>
Text -> m (Either ConfigParseError a)
getEnvConfigSep Text
sep = FetchSource m -> m (Either ConfigParseError a)
forall a (m :: * -> *).
(Monad m, ConfigSource a, ConfigParser a) =>
FetchSource m -> m (Either ConfigParseError a)
getConfig (FetchSource m -> m (Either ConfigParseError a))
-> FetchSource m -> m (Either ConfigParseError a)
forall a b. (a -> b) -> a -> b
$ Text -> FetchSource m
forall (m :: * -> *).
MonadIO m =>
Text -> KeyTree Text Text -> m (KeyTree Text Text)
envSourceSep Text
sep

-- | The same as 'getEnvConfigSep' but with the separator hard coded to \"_\"
--
-- @since 0.0.1.0
getEnvConfig
  :: forall a m. (MonadFail m, MonadIO m, ConfigSource a, ConfigParser a) => m (Either ConfigParseError a)
getEnvConfig :: forall a (m :: * -> *).
(MonadFail m, MonadIO m, ConfigSource a, ConfigParser a) =>
m (Either ConfigParseError a)
getEnvConfig = FetchSource m -> m (Either ConfigParseError a)
forall a (m :: * -> *).
(Monad m, ConfigSource a, ConfigParser a) =>
FetchSource m -> m (Either ConfigParseError a)
getConfig (FetchSource m -> m (Either ConfigParseError a))
-> FetchSource m -> m (Either ConfigParseError a)
forall a b. (a -> b) -> a -> b
$ FetchSource m
forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
KeyTree Text Text -> m (KeyTree Text Text)
envSource

-- | The same as 'printDotEnv'' but with the separator hard coded to \"_\" and
-- it uses a type application to generate the configuration source tree
-- representation.
--
-- @printDotEnv \@AppConfig ".env"@
--
-- @since 0.0.1.0
printDotEnv :: forall a. (ConfigSource a) => FilePath -> IO ()
printDotEnv :: forall {k} (a :: k). ConfigSource a => String -> IO ()
printDotEnv String
path =
  String -> Text -> IO ()
writeFile String
path
    (Text -> IO ())
-> (KeyTree Text Text -> Text) -> KeyTree Text Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
line -> Text
"export " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=\n")
    ([Text] -> Text)
-> (KeyTree Text Text -> [Text]) -> KeyTree Text Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> KeyTree Text Text -> [Text]
showEnvKeys' Text
"_"
    (KeyTree Text Text -> IO ()) -> KeyTree Text Text -> IO ()
forall a b. (a -> b) -> a -> b
$ forall (a :: k). ConfigSource a => KeyTree Text Text
forall {k} (a :: k). ConfigSource a => KeyTree Text Text
configSource @a