-- | 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 = mapM_ (uncurry setEnv) . fromEnvironment . HM.toList . 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 = HM.toList . 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 _ (Mappings m) | null m = mempty mappingsToValues currentEnv m = let mappings' = unMappings m value from = lookup from currentEnv setMappingValue _ Nothing = id setMappingValue k (Just v) = HM.insert k v mappingsToValues' k v = setMappingValue k (value v) in Values $ HM.foldrWithKey' mappingsToValues' mempty 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 _ (Prefixes p) | null p = mempty prefixesToValues currentEnv p = let prefixes' = unPrefixes p prefixesToValues' k v env = env <> setNewPrefix k v currentEnv res = if null prefixes' then currentEnv else HM.foldrWithKey' prefixesToValues' mempty prefixes' in toValues 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 newPrefix [] currentEnv = fmap (first (newPrefix <>)) currentEnv setNewPrefix newPrefix [""] currentEnv = fmap (first (newPrefix <>)) currentEnv setNewPrefix newPrefix oldPrefixes currentEnv = let varsWithoutPrefixes = removePrefix currentEnv <$> oldPrefixes newPrefixedVars = (fmap . fmap) (first (newPrefix <>)) varsWithoutPrefixes in mconcat newPrefixedVars -- | Remove a prefix from the environment variables. removePrefix :: Environment -> Text -> Environment removePrefix currentEnv oldPrefix = let getWithoutPrefix old (k, v) = T.stripPrefix old k >>= \sk -> pure (sk, v) in mapMaybe (getWithoutPrefix oldPrefix) currentEnv -- | Create a 'Values' object from an 'Environment'. toValues :: Environment -> Values toValues = Values . 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 re currentEnv = let vvs = values re vms = flip mappingsToValues (mappings re) vps = flip prefixesToValues (prefixes re) in vvs <> vms currentEnv <> vps currentEnv