module System.Etc.Internal.Resolver.Env (resolveEnv, resolveEnvPure) where
import Protolude
import System.Environment (getEnvironment)
import Control.Arrow ((***))
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified System.Etc.Internal.Spec.Types as Spec
import System.Etc.Internal.Types
resolveEnvVarSource
:: (Text -> Maybe Text)
-> Spec.ConfigSources cmd
-> Maybe ConfigSource
resolveEnvVarSource lookupEnv specSources =
let
toEnvSource varname envValue =
envValue
& JSON.String
& Env varname
in do
varname <- Spec.envVar specSources
toEnvSource varname <$> lookupEnv varname
buildEnvVarResolver :: (Text -> Maybe Text) -> Spec.ConfigSpec cmd -> Maybe ConfigValue
buildEnvVarResolver lookupEnv spec =
let
resolverReducer
:: Text
-> Spec.ConfigValue cmd
-> Maybe ConfigValue
-> Maybe ConfigValue
resolverReducer specKey specValue mConfig =
case specValue of
Spec.ConfigValue _ sources ->
let
updateConfig = do
envSource <- resolveEnvVarSource lookupEnv sources
writeInSubConfig specKey (ConfigValue $ Set.singleton envSource) <$> mConfig
in
updateConfig <|> mConfig
Spec.SubConfig specConfigMap ->
let
mSubConfig =
specConfigMap
& HashMap.foldrWithKey
resolverReducer
(Just emptySubConfig)
& filterMaybe isEmptySubConfig
updateConfig =
writeInSubConfig specKey <$> mSubConfig <*> mConfig
in
updateConfig <|> mConfig
in
Spec.specConfigValues spec
& HashMap.foldrWithKey
resolverReducer
(Just emptySubConfig)
& filterMaybe isEmptySubConfig
resolveEnvPure
:: Spec.ConfigSpec cmd
-> [(Text, Text)]
-> Config
resolveEnvPure spec envMap0 =
let
envMap =
HashMap.fromList envMap0
lookupEnv key =
HashMap.lookup key envMap
in
maybe (Config emptySubConfig)
Config
(buildEnvVarResolver lookupEnv spec)
resolveEnv
:: Spec.ConfigSpec cmd
-> IO Config
resolveEnv spec =
let
getEnvironmentTxt =
map (Text.pack *** Text.pack)
<$> getEnvironment
in
resolveEnvPure spec
<$> getEnvironmentTxt