EnvUsage for better control

This commit is contained in:
Michael Snoyman 2014-11-20 01:05:17 +02:00
parent 35511d2466
commit 79db398a54

View File

@ -12,6 +12,7 @@ module Yesod.Default.Config2
, getDevSettings , getDevSettings
, develMainHelper , develMainHelper
, makeYesodLogger , makeYesodLogger
, EnvUsage (..)
) where ) where
import Data.Monoid import Data.Monoid
@ -53,8 +54,9 @@ mergeValues (Object x) (Object y) = Object $ H.unionWith mergeValues x y
mergeValues (Object x) y | H.null x = y mergeValues (Object x) y | H.null x = y
mergeValues x _ = x mergeValues x _ = x
applyEnv :: H.HashMap Text Text -> Value -> Value applyEnv :: Bool -- ^ require an environment variable to be present?
applyEnv env = -> H.HashMap Text Text -> Value -> Value
applyEnv requireEnv env =
goV goV
where where
goV (Object o) = Object $ goV <$> o goV (Object o) = Object $ goV <$> o
@ -66,8 +68,8 @@ applyEnv env =
Just val -> parseValue val Just val -> parseValue val
Nothing -> Nothing ->
case T.stripPrefix ":" t3 of case T.stripPrefix ":" t3 of
Just val -> parseValue val Just val | not requireEnv -> parseValue val
Nothing -> Null _ -> Null
goV v = v goV v = v
parseValue val = fromMaybe (String val) $ Y.decode $ encodeUtf8 val parseValue val = fromMaybe (String val) $ Y.decode $ encodeUtf8 val
@ -75,8 +77,11 @@ applyEnv env =
getCurrentEnv :: IO (H.HashMap Text Text) getCurrentEnv :: IO (H.HashMap Text Text)
getCurrentEnv = fmap (H.fromList . map (pack *** pack)) getEnvironment getCurrentEnv = fmap (H.fromList . map (pack *** pack)) getEnvironment
applyCurrentEnv :: Value -> IO Value applyCurrentEnv :: Bool -- ^ require an environment variable to be present?
applyCurrentEnv orig = flip applyEnv orig <$> getCurrentEnv -> Value -> IO Value
applyCurrentEnv requireEnv orig = flip (applyEnv requireEnv) orig <$> getCurrentEnv
data EnvUsage = IgnoreEnv | UseEnv | RequireEnv
-- | Load the settings from the following three sources: -- | Load the settings from the following three sources:
-- --
@ -89,9 +94,9 @@ loadAppSettings
:: FromJSON settings :: FromJSON settings
=> [FilePath] -- ^ run time config files to use, earlier files have precedence => [FilePath] -- ^ run time config files to use, earlier files have precedence
-> [Value] -- ^ any other values to use, usually from compile time config. overridden by files -> [Value] -- ^ any other values to use, usually from compile time config. overridden by files
-> Bool -- ^ use environment variables -> EnvUsage
-> IO settings -> IO settings
loadAppSettings runTimeFiles compileValues useEnv = do loadAppSettings runTimeFiles compileValues envUsage = do
runValues <- forM runTimeFiles $ \fp -> do runValues <- forM runTimeFiles $ \fp -> do
eres <- Y.decodeFileEither fp eres <- Y.decodeFileEither fp
case eres of case eres of
@ -104,9 +109,10 @@ loadAppSettings runTimeFiles compileValues useEnv = do
$ map MergedValue $ map MergedValue
$ runValues ++ compileValues $ runValues ++ compileValues
value <- value <-
if useEnv case envUsage of
then applyCurrentEnv value' IgnoreEnv -> return $ applyEnv False mempty value'
else return $ applyEnv mempty value' UseEnv -> applyCurrentEnv False value'
RequireEnv -> applyCurrentEnv True value'
case fromJSON value of case fromJSON value of
Error s -> error $ "Could not convert to AppSettings: " ++ s Error s -> error $ "Could not convert to AppSettings: " ++ s
@ -117,7 +123,7 @@ loadAppSettings runTimeFiles compileValues useEnv = do
loadAppSettingsArgs loadAppSettingsArgs
:: FromJSON settings :: FromJSON settings
=> [Value] -- ^ any other values to use, usually from compile time config. overridden by files => [Value] -- ^ any other values to use, usually from compile time config. overridden by files
-> Bool -- ^ use environment variables -> EnvUsage -- ^ use environment variables
-> IO settings -> IO settings
loadAppSettingsArgs values env = do loadAppSettingsArgs values env = do
args <- getArgs args <- getArgs