-- | 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 = ((String, String) -> IO ()) -> [(String, String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((String -> String -> IO ()) -> (String, String) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IO ()
setEnv) ([(String, String)] -> IO ())
-> (Values -> [(String, String)]) -> Values -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> [(String, String)]
fromEnvironment (Environment -> [(String, String)])
-> (Values -> Environment) -> Values -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text Text -> Environment
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap Text Text -> Environment)
-> (Values -> HashMap Text Text) -> Values -> Environment
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 = HashMap Text Text -> Environment
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap Text Text -> Environment)
-> (Values -> HashMap Text Text) -> Values -> Environment
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) | HashMap Text Text -> Bool
forall a. HashMap Text a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap Text Text
m = Values
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 = Text -> Environment -> Maybe Text
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 = HashMap k v -> HashMap k v
forall a. a -> a
id
      setMappingValue k
k (Just v
v) = k -> v -> HashMap k v -> HashMap k 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 = k -> Maybe Text -> HashMap k Text -> HashMap k Text
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 (HashMap Text Text -> Values) -> HashMap Text Text -> Values
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> HashMap Text Text -> HashMap Text Text)
-> HashMap Text Text -> HashMap Text Text -> HashMap Text Text
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey' Text -> Text -> HashMap Text Text -> HashMap Text Text
forall {k}.
Hashable k =>
k -> Text -> HashMap k Text -> HashMap k Text
mappingsToValues' HashMap Text Text
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) | HashMap Text [Text] -> Bool
forall a. HashMap Text a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap Text [Text]
p = Values
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 Environment -> Environment -> Environment
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Environment -> Environment
setNewPrefix Text
k [Text]
v Environment
currentEnv
      res :: Environment
res = if HashMap Text [Text] -> Bool
forall a. HashMap Text a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap Text [Text]
prefixes' then Environment
currentEnv else (Text -> [Text] -> Environment -> Environment)
-> Environment -> HashMap Text [Text] -> Environment
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey' Text -> [Text] -> Environment -> Environment
prefixesToValues' Environment
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 = ((Text, Text) -> (Text, Text)) -> Environment -> Environment
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Text) -> (Text, Text) -> (Text, Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text
newPrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)) Environment
currentEnv
setNewPrefix Text
newPrefix [Text
""] Environment
currentEnv = ((Text, Text) -> (Text, Text)) -> Environment -> Environment
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Text) -> (Text, Text) -> (Text, Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text
newPrefix Text -> Text -> Text
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 (Text -> Environment) -> [Text] -> [Environment]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
oldPrefixes
      newPrefixedVars :: [Environment]
newPrefixedVars = ((Environment -> Environment) -> [Environment] -> [Environment]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Environment -> Environment) -> [Environment] -> [Environment])
-> (((Text, Text) -> (Text, Text)) -> Environment -> Environment)
-> ((Text, Text) -> (Text, Text))
-> [Environment]
-> [Environment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> (Text, Text)) -> Environment -> Environment
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ((Text -> Text) -> (Text, Text) -> (Text, Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text
newPrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)) [Environment]
varsWithoutPrefixes
   in [Environment] -> Environment
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 Maybe Text -> (Text -> Maybe (Text, b)) -> Maybe (Text, b)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
sk -> (Text, b) -> Maybe (Text, b)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
sk, b
v)
   in ((Text, Text) -> Maybe (Text, Text)) -> Environment -> Environment
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> (Text, Text) -> Maybe (Text, Text)
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 (HashMap Text Text -> Values)
-> (Environment -> HashMap Text Text) -> Environment -> Values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> HashMap Text Text
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 = (Environment -> Mappings -> Values)
-> Mappings -> Environment -> Values
forall a b c. (a -> b -> c) -> b -> a -> c
flip Environment -> Mappings -> Values
mappingsToValues (RichEnv -> Mappings
mappings RichEnv
re)
      vps :: Environment -> Values
vps = (Environment -> Prefixes -> Values)
-> Prefixes -> Environment -> Values
forall a b c. (a -> b -> c) -> b -> a -> c
flip Environment -> Prefixes -> Values
prefixesToValues (RichEnv -> Prefixes
prefixes RichEnv
re)
   in Values
vvs Values -> Values -> Values
forall a. Semigroup a => a -> a -> a
<> Environment -> Values
vms Environment
currentEnv Values -> Values -> Values
forall a. Semigroup a => a -> a -> a
<> Environment -> Values
vps Environment
currentEnv