-- | This module contains functions for setting environment variables from the 'RichEnv' types as well as functions for transforming between the different types used by this library ('Values', 'Mappings' and 'Prefixes').
module RichEnv.Setters (mappingsToValues, prefixesToValues, valuesToEnv, valuesToEnvList, richEnvToValues) where

import Data.Bifunctor (first)
import Data.HashMap.Strict qualified as HM
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import RichEnv.Types (Environment, RichEnv (..), fromEnvironment)
import RichEnv.Types.Mappings (Mappings (Mappings, unMappings))
import RichEnv.Types.Prefixes (Prefixes (Prefixes, unPrefixes))
import RichEnv.Types.Values (Values (Values, unValues))
import System.Environment (setEnv)

-- | Takes a 'Values' object and sets its contents as environment variables.
valuesToEnv :: Values -> IO ()
valuesToEnv :: Values -> IO ()
valuesToEnv = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IO ()
setEnv) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> [(String, String)]
fromEnvironment forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HM.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values -> HashMap Text Text
unValues

-- | Takes a 'Values' object and transforms it into a list of key-value pairs representing environment variables.
--
-- > valuesToEnvList = Data.HashMap.Strict.toList . unValues
valuesToEnvList :: Values -> Environment
valuesToEnvList :: Values -> Environment
valuesToEnvList = forall k v. HashMap k v -> [(k, v)]
HM.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values -> HashMap Text Text
unValues

-- | Takes an environment variable list and all the name mappings and prepares a set of environment variables according to the RichEnv rules.
--
-- >>> mappingsToValues [("FOO", "bar"), ("SOME", "thing")] (Mappings $ HM.fromList [("OTHER", "FOO")])
-- Values {unValues = fromList [("OTHER","bar")]}
mappingsToValues :: Environment -> Mappings -> Values
mappingsToValues :: Environment -> Mappings -> Values
mappingsToValues Environment
_ (Mappings HashMap Text Text
m) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap Text Text
m = forall a. Monoid a => a
mempty
mappingsToValues Environment
currentEnv Mappings
m =
  let mappings' :: HashMap Text Text
mappings' = Mappings -> HashMap Text Text
unMappings Mappings
m
      value :: Text -> Maybe Text
value Text
from = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
from Environment
currentEnv
      setMappingValue :: k -> Maybe v -> HashMap k v -> HashMap k v
setMappingValue k
_ Maybe v
Nothing = forall a. a -> a
id
      setMappingValue k
k (Just v
v) = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert k
k v
v
      mappingsToValues' :: k -> Text -> HashMap k Text -> HashMap k Text
mappingsToValues' k
k Text
v = forall {k} {v}.
Hashable k =>
k -> Maybe v -> HashMap k v -> HashMap k v
setMappingValue k
k (Text -> Maybe Text
value Text
v)
   in HashMap Text Text -> Values
Values forall a b. (a -> b) -> a -> b
$ forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey' forall {k}.
Hashable k =>
k -> Text -> HashMap k Text -> HashMap k Text
mappingsToValues' forall a. Monoid a => a
mempty HashMap Text Text
mappings'

-- | Takes an environment variable list and all the prefix mappings and prepares a set of environment variables according to the 'RichEnv' rules.
--
-- >>> prefixesToValues [("FOO", "bar"), ("SOME", "thing")] (Prefixes $ HM.fromList [("OTHER", ["FOO"])])
-- Values {unValues = fromList [("OTHER","bar")]}
prefixesToValues :: Environment -> Prefixes -> Values
prefixesToValues :: Environment -> Prefixes -> Values
prefixesToValues Environment
_ (Prefixes HashMap Text [Text]
p) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap Text [Text]
p = forall a. Monoid a => a
mempty
prefixesToValues Environment
currentEnv Prefixes
p =
  let prefixes' :: HashMap Text [Text]
prefixes' = Prefixes -> HashMap Text [Text]
unPrefixes Prefixes
p
      prefixesToValues' :: Text -> [Text] -> Environment -> Environment
prefixesToValues' Text
k [Text]
v Environment
env = Environment
env forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Environment -> Environment
setNewPrefix Text
k [Text]
v Environment
currentEnv
      res :: Environment
res = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap Text [Text]
prefixes' then Environment
currentEnv else forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey' Text -> [Text] -> Environment -> Environment
prefixesToValues' forall a. Monoid a => a
mempty HashMap Text [Text]
prefixes'
   in Environment -> Values
toValues Environment
res

-- | Replace the prefixes of the environment variables with a new prefix.
setNewPrefix ::
  -- | New prefix
  Text ->
  -- | Old prefixes
  [Text] ->
  -- | Current environment list
  Environment ->
  -- | Updated environment list
  Environment
setNewPrefix :: Text -> [Text] -> Environment -> Environment
setNewPrefix Text
newPrefix [] Environment
currentEnv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text
newPrefix forall a. Semigroup a => a -> a -> a
<>)) Environment
currentEnv
setNewPrefix Text
newPrefix [Text
""] Environment
currentEnv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text
newPrefix forall a. Semigroup a => a -> a -> a
<>)) Environment
currentEnv
setNewPrefix Text
newPrefix [Text]
oldPrefixes Environment
currentEnv =
  let varsWithoutPrefixes :: [Environment]
varsWithoutPrefixes = Environment -> Text -> Environment
removePrefix Environment
currentEnv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
oldPrefixes
      newPrefixedVars :: [Environment]
newPrefixedVars = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text
newPrefix forall a. Semigroup a => a -> a -> a
<>)) [Environment]
varsWithoutPrefixes
   in forall a. Monoid a => [a] -> a
mconcat [Environment]
newPrefixedVars

-- | Remove a prefix from the environment variables.
removePrefix :: Environment -> Text -> Environment
removePrefix :: Environment -> Text -> Environment
removePrefix Environment
currentEnv Text
oldPrefix =
  let getWithoutPrefix :: Text -> (Text, b) -> Maybe (Text, b)
getWithoutPrefix Text
old (Text
k, b
v) = Text -> Text -> Maybe Text
T.stripPrefix Text
old Text
k forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
sk -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
sk, b
v)
   in forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall {b}. Text -> (Text, b) -> Maybe (Text, b)
getWithoutPrefix Text
oldPrefix) Environment
currentEnv

-- | Create a 'Values' object from an 'Environment'.
toValues :: Environment -> Values
toValues :: Environment -> Values
toValues = HashMap Text Text -> Values
Values forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList

-- | Takes an environment variable list and a 'RichEnv' object and generates a 'Values' object.
--
-- >>> richEnvToValues RichEnv.Types.defaultRichEnv [("FOO", "bar"), ("SOME", "thing")]
-- Values {unValues = fromList []}
--
-- >>> import RichEnv.Types.Values as V
-- >>> let richEnvValue = RichEnv.Types.defaultRichEnv { values = V.fromList [("OTHER", "var")]}
-- >>> let envList = [("FOO", "bar"), ("SOME", "thing")]
-- >>> richEnvToValues richEnvValue envList
-- Values {unValues = fromList [("OTHER","var")]}
--
-- >>> import RichEnv.Types.Mappings as M
-- >>> let richEnvValue = RichEnv.Types.defaultRichEnv { mappings = M.fromList [("SOME", "FOO")]}
-- >>> let envList = [("FOO", "bar"), ("SOME", "thing"), ("SOME", "other")]
-- >>> richEnvToValues richEnvValue envList
-- Values {unValues = fromList [("SOME","bar")]}
--
-- >>> import RichEnv.Types.Prefixes as P
-- >>> let richEnvValue = RichEnv.Types.defaultRichEnv { prefixes = P.fromList [("NEW_", ["PREFIXED_"])]}
-- >>> let envList = [("PREFIXED_VAR", "content"), ("PREFIXED_VAR2", "content2")]
-- >>> richEnvToValues richEnvValue envList
-- Values {unValues = fromList [("NEW_VAR","content"),("NEW_VAR2","content2")]}
richEnvToValues :: RichEnv -> Environment -> Values
richEnvToValues :: RichEnv -> Environment -> Values
richEnvToValues RichEnv
re Environment
currentEnv =
  let vvs :: Values
vvs = RichEnv -> Values
values RichEnv
re
      vms :: Environment -> Values
vms = forall a b c. (a -> b -> c) -> b -> a -> c
flip Environment -> Mappings -> Values
mappingsToValues (RichEnv -> Mappings
mappings RichEnv
re)
      vps :: Environment -> Values
vps = forall a b c. (a -> b -> c) -> b -> a -> c
flip Environment -> Prefixes -> Values
prefixesToValues (RichEnv -> Prefixes
prefixes RichEnv
re)
   in Values
vvs forall a. Semigroup a => a -> a -> a
<> Environment -> Values
vms Environment
currentEnv forall a. Semigroup a => a -> a -> a
<> Environment -> Values
vps Environment
currentEnv