-- | This module provides functions to set environment variables or retrieve an environment variable list according to a 'RichEnv' object input, which defines:
--
-- * A list of environment variables to be set with their values.
-- * Mapping the name from one existing environment variable name to another (If there's an environment variable @__FOO=bar__@, a mapping @__(\"SOME\", \"FOO\")__@ will generate an environment variable definition @__SOME__@ with the contents of the variable @__FOO__@).
-- * Mapping the prefixes of existing environment variables to a new prefix (If there's an environment variable @__FOO_VAR=bar__@, a prefix mapping @__(\"SOME\", [\"FOO\"])__@ will generate an environment variable definition @__SOME_VAR__@ with the contents of the variable @__FOO_VAR__@).
module RichEnv
  ( -- * Types
    RichEnv (..),
    Environment,

    -- * Environment transformations
    toEnvList,
    toEnvMap,

    -- * Functions using 'IO' to get the environment from the current process
    setRichEnv,
    setRichEnvFromCurrent,
    toEnvListFromCurrent,
    toEnvMapFromCurrent,
    clearEnvironment,
  )
where

import Data.HashMap.Strict qualified as HM
import Data.Text (Text)
import RichEnv.Setters (richEnvToValues, valuesToEnv, valuesToEnvList)
import RichEnv.Types (Environment, RichEnv (..), fromEnvironment, toEnvironment)
import RichEnv.Types.Values (Values (unValues))
import System.Environment (getEnvironment, unsetEnv)

-- | Get a key-value list of environment variables processing the passed environment with the 'RichEnv' input.
--
-- > toEnvList re env = valuesToEnvList (toEnvValues re env)
toEnvList :: RichEnv -> Environment -> Environment
toEnvList :: RichEnv -> Environment -> Environment
toEnvList RichEnv
re = Values -> Environment
valuesToEnvList (Values -> Environment)
-> (Environment -> Values) -> Environment -> Environment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RichEnv -> Environment -> Values
toEnvValues RichEnv
re

-- | Get a hashmap of environment variables processing the passed environment with the 'RichEnv' input. The idea is that the output could be passed to functions like [Yaml](https://hackage.haskell.org/package/yaml)'s [applyEnvValue](https://hackage.haskell.org/package/yaml/docs/Data-Yaml-Config.html#v:applyEnvValue).
--
-- > toEnvMap re env = unValues (toEnvValues re env)
toEnvMap :: RichEnv -> Environment -> HM.HashMap Text Text
toEnvMap :: RichEnv -> Environment -> HashMap Text Text
toEnvMap RichEnv
re = Values -> HashMap Text Text
unValues (Values -> HashMap Text Text)
-> (Environment -> Values) -> Environment -> HashMap Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RichEnv -> Environment -> Values
toEnvValues RichEnv
re

-- | Builds a 'Values' object from the 'RichEnv' input and a list of environment variables.
toEnvValues :: RichEnv -> Environment -> Values
toEnvValues :: RichEnv -> Environment -> Values
toEnvValues = RichEnv -> Environment -> Values
richEnvToValues

-- | Sets the environment variables available for the current process abiding to the 'RichEnv' rules.
setRichEnv :: RichEnv -> Environment -> IO ()
setRichEnv :: RichEnv -> Environment -> IO ()
setRichEnv RichEnv
re Environment
env = do
  [(String, String)] -> IO ()
clearEnvironment ([(String, String)] -> IO ()) -> [(String, String)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Environment -> [(String, String)]
fromEnvironment Environment
env
  Values -> IO ()
valuesToEnv (RichEnv -> Environment -> Values
richEnvToValues RichEnv
re Environment
env)

-- | Sets the environment variables available for the current process by checking the current environment variables and applying the 'RichEnv' rules.
--
-- > setRichEnvFromCurrent re = getEnvironment >>= setRichEnv re . toEnvironment
setRichEnvFromCurrent :: RichEnv -> IO ()
setRichEnvFromCurrent :: RichEnv -> IO ()
setRichEnvFromCurrent RichEnv
re = IO [(String, String)]
getEnvironment IO [(String, String)] -> ([(String, String)] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RichEnv -> Environment -> IO ()
setRichEnv RichEnv
re (Environment -> IO ())
-> ([(String, String)] -> Environment)
-> [(String, String)]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> Environment
toEnvironment

-- | Get a key-value list of environment variables processing the current environment with the 'RichEnv' input.
--
-- > toEnvListFromCurrent re = toEnvList re . toEnvironment <$> getEnvironment
toEnvListFromCurrent :: RichEnv -> IO Environment
toEnvListFromCurrent :: RichEnv -> IO Environment
toEnvListFromCurrent RichEnv
re = RichEnv -> Environment -> Environment
toEnvList RichEnv
re (Environment -> Environment)
-> ([(String, String)] -> Environment)
-> [(String, String)]
-> Environment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> Environment
toEnvironment ([(String, String)] -> Environment)
-> IO [(String, String)] -> IO Environment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, String)]
getEnvironment

-- | Get a hashmap of environment variables processing the current environment with the 'RichEnv' input. The idea is that the output could be passed to functions like [Yaml](https://hackage.haskell.org/package/yaml)'s [applyEnvValue](https://hackage.haskell.org/package/yaml/docs/Data-Yaml-Config.html#v:applyEnvValue).
--
-- > toEnvMapFromCurrent re = toEnvMap re . toEnvironment <$> getEnvironment
toEnvMapFromCurrent :: RichEnv -> IO (HM.HashMap Text Text)
toEnvMapFromCurrent :: RichEnv -> IO (HashMap Text Text)
toEnvMapFromCurrent RichEnv
re = RichEnv -> Environment -> HashMap Text Text
toEnvMap RichEnv
re (Environment -> HashMap Text Text)
-> ([(String, String)] -> Environment)
-> [(String, String)]
-> HashMap Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> Environment
toEnvironment ([(String, String)] -> HashMap Text Text)
-> IO [(String, String)] -> IO (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, String)]
getEnvironment

-- | Builds a 'Values' object from the 'RichEnv' input and the current environment variables.
--
-- > toEnvValuesFromCurrent re = toEnvValues re . toEnvironment <$> getEnvironment
_toEnvValuesFromCurrent :: RichEnv -> IO Values
_toEnvValuesFromCurrent :: RichEnv -> IO Values
_toEnvValuesFromCurrent RichEnv
re = RichEnv -> Environment -> Values
toEnvValues RichEnv
re (Environment -> Values)
-> ([(String, String)] -> Environment)
-> [(String, String)]
-> Values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> Environment
toEnvironment ([(String, String)] -> Values)
-> IO [(String, String)] -> IO Values
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, String)]
getEnvironment

-- | Clears all environment variables of the current process.
clearEnvironment ::
  [(String, String)] ->
  IO ()
clearEnvironment :: [(String, String)] -> IO ()
clearEnvironment = ((String, String) -> IO ()) -> [(String, String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
unsetEnv (String -> IO ())
-> ((String, String) -> String) -> (String, String) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst)