Use Data.Yaml.Config module to decrease code duplication
This commit is contained in:
Michael Snoyman
parent
93039dfc7c
commit
4d6448b0dd
@ -17,3 +17,4 @@ packages:
|
||||
# Needed for LTS 2
|
||||
extra-deps:
|
||||
- wai-app-static-3.1.4.1
|
||||
- yaml-0.8.17
|
||||
|
||||
@ -1,3 +1,7 @@
|
||||
## 1.4.3
|
||||
|
||||
* Switch to `Data.Yaml.Config`
|
||||
|
||||
## 1.4.2
|
||||
|
||||
* Do not parse string environment variables into numbers/booleans [#1061](https://github.com/yesodweb/yesod/issues/1061)
|
||||
|
||||
@ -2,40 +2,40 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
-- | Some next-gen helper functions for the scaffolding's configuration system.
|
||||
module Yesod.Default.Config2
|
||||
( MergedValue (..)
|
||||
, applyCurrentEnv
|
||||
, getCurrentEnv
|
||||
, applyEnvValue
|
||||
, loadAppSettings
|
||||
, loadAppSettingsArgs
|
||||
, configSettingsYml
|
||||
( -- * Locally defined
|
||||
configSettingsYml
|
||||
, getDevSettings
|
||||
, develMainHelper
|
||||
, makeYesodLogger
|
||||
-- * Re-exports from Data.Yaml.Config
|
||||
, applyCurrentEnv
|
||||
, getCurrentEnv
|
||||
, applyEnvValue
|
||||
, loadYamlSettings
|
||||
, loadYamlSettingsArgs
|
||||
, EnvUsage
|
||||
, ignoreEnv
|
||||
, useEnv
|
||||
, requireEnv
|
||||
, useCustomEnv
|
||||
, requireCustomEnv
|
||||
-- * For backwards compatibility
|
||||
, MergedValue (..)
|
||||
, loadAppSettings
|
||||
, loadAppSettingsArgs
|
||||
) where
|
||||
|
||||
|
||||
import Data.Yaml.Config
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 710
|
||||
import Control.Applicative ((<$>))
|
||||
import Data.Monoid
|
||||
#endif
|
||||
import Data.Semigroup
|
||||
import Data.List.NonEmpty (nonEmpty)
|
||||
import Data.Aeson
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import Data.Text (Text, pack)
|
||||
import System.Environment (getEnvironment, getArgs)
|
||||
import Control.Arrow ((***))
|
||||
import Control.Monad (forM)
|
||||
import Control.Exception (throwIO)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import qualified Data.Yaml as Y
|
||||
import System.Environment (getEnvironment)
|
||||
import Network.Wai (Application)
|
||||
import Network.Wai.Handler.Warp
|
||||
import Safe (readMay)
|
||||
@ -46,7 +46,6 @@ import System.Directory (doesFileExist)
|
||||
import Network.Wai.Logger (clockDateCacher)
|
||||
import Yesod.Core.Types (Logger (Logger))
|
||||
import System.Log.FastLogger (LoggerSet)
|
||||
import qualified Data.Text as T
|
||||
|
||||
#ifndef mingw32_HOST_OS
|
||||
import System.Posix.Signals (installHandler, sigINT, Handler(Catch))
|
||||
@ -62,60 +61,6 @@ mergeValues :: Value -> Value -> Value
|
||||
mergeValues (Object x) (Object y) = Object $ H.unionWith mergeValues x y
|
||||
mergeValues x _ = x
|
||||
|
||||
applyEnvValue :: Bool -- ^ require an environment variable to be present?
|
||||
-> H.HashMap Text Text -> Value -> Value
|
||||
applyEnvValue requireEnv' env =
|
||||
goV
|
||||
where
|
||||
goV (Object o) = Object $ goV <$> o
|
||||
goV (Array a) = Array (goV <$> a)
|
||||
goV (String t1) = fromMaybe (String t1) $ do
|
||||
t2 <- T.stripPrefix "_env:" t1
|
||||
let (name, t3) = T.break (== ':') t2
|
||||
mdef = fmap parseValue $ T.stripPrefix ":" t3
|
||||
Just $ case H.lookup name env of
|
||||
Just val ->
|
||||
-- If the default value parses as a String, we treat the
|
||||
-- environment variable as a raw value and do not parse it.
|
||||
-- This means that things like numeric passwords just work.
|
||||
-- However, for originally numerical or boolean values (e.g.,
|
||||
-- port numbers), we still perform a normal YAML parse.
|
||||
--
|
||||
-- For details, see:
|
||||
-- https://github.com/yesodweb/yesod/issues/1061
|
||||
case mdef of
|
||||
Just (String _) -> String val
|
||||
_ -> parseValue val
|
||||
Nothing ->
|
||||
case mdef of
|
||||
Just val | not requireEnv' -> val
|
||||
_ -> Null
|
||||
goV v = v
|
||||
|
||||
parseValue val = fromMaybe (String val) $ Y.decode $ encodeUtf8 val
|
||||
|
||||
getCurrentEnv :: IO (H.HashMap Text Text)
|
||||
getCurrentEnv = fmap (H.fromList . map (pack *** pack)) getEnvironment
|
||||
|
||||
applyCurrentEnv :: Bool -- ^ require an environment variable to be present?
|
||||
-> Value -> IO Value
|
||||
applyCurrentEnv requireEnv' orig = flip (applyEnvValue requireEnv') orig <$> getCurrentEnv
|
||||
|
||||
data EnvUsage = IgnoreEnv
|
||||
| UseEnv
|
||||
| RequireEnv
|
||||
| UseCustomEnv (H.HashMap Text Text)
|
||||
| RequireCustomEnv (H.HashMap Text Text)
|
||||
|
||||
ignoreEnv, useEnv, requireEnv :: EnvUsage
|
||||
ignoreEnv = IgnoreEnv
|
||||
useEnv = UseEnv
|
||||
requireEnv = RequireEnv
|
||||
|
||||
useCustomEnv, requireCustomEnv :: H.HashMap Text Text -> EnvUsage
|
||||
useCustomEnv = UseCustomEnv
|
||||
requireCustomEnv = RequireCustomEnv
|
||||
|
||||
-- | Load the settings from the following three sources:
|
||||
--
|
||||
-- * Run time config files
|
||||
@ -129,30 +74,8 @@ loadAppSettings
|
||||
-> [Value] -- ^ any other values to use, usually from compile time config. overridden by files
|
||||
-> EnvUsage
|
||||
-> IO settings
|
||||
loadAppSettings runTimeFiles compileValues envUsage = do
|
||||
runValues <- forM runTimeFiles $ \fp -> do
|
||||
eres <- Y.decodeFileEither fp
|
||||
case eres of
|
||||
Left e -> do
|
||||
putStrLn $ "loadAppSettings: Could not parse file as YAML: " ++ fp
|
||||
throwIO e
|
||||
Right value -> return value
|
||||
|
||||
value' <-
|
||||
case nonEmpty $ map MergedValue $ runValues ++ compileValues of
|
||||
Nothing -> error "loadAppSettings: No configuration provided"
|
||||
Just ne -> return $ getMergedValue $ sconcat ne
|
||||
value <-
|
||||
case envUsage of
|
||||
IgnoreEnv -> return $ applyEnvValue False mempty value'
|
||||
UseEnv -> applyCurrentEnv False value'
|
||||
RequireEnv -> applyCurrentEnv True value'
|
||||
UseCustomEnv env -> return $ applyEnvValue False env value'
|
||||
RequireCustomEnv env -> return $ applyEnvValue True env value'
|
||||
|
||||
case fromJSON value of
|
||||
Error s -> error $ "Could not convert to AppSettings: " ++ s
|
||||
Success settings -> return settings
|
||||
loadAppSettings = loadYamlSettings
|
||||
{-# DEPRECATED loadAppSettings "Use loadYamlSettings" #-}
|
||||
|
||||
-- | Same as @loadAppSettings@, but get the list of runtime config files from
|
||||
-- the command line arguments.
|
||||
@ -161,9 +84,8 @@ loadAppSettingsArgs
|
||||
=> [Value] -- ^ any other values to use, usually from compile time config. overridden by files
|
||||
-> EnvUsage -- ^ use environment variables
|
||||
-> IO settings
|
||||
loadAppSettingsArgs values env = do
|
||||
args <- getArgs
|
||||
loadAppSettings args values env
|
||||
loadAppSettingsArgs = loadYamlSettingsArgs
|
||||
{-# DEPRECATED loadAppSettingsArgs "Use loadYamlSettingsArgs" #-}
|
||||
|
||||
-- | Location of the default config file.
|
||||
configSettingsYml :: FilePath
|
||||
@ -200,6 +122,8 @@ develMainHelper getSettingsApp = do
|
||||
terminateDevel :: IO ()
|
||||
terminateDevel = exitSuccess
|
||||
|
||||
-- | Create a 'Logger' value (from yesod-core) out of a 'LoggerSet' (from
|
||||
-- fast-logger).
|
||||
makeYesodLogger :: LoggerSet -> IO Logger
|
||||
makeYesodLogger loggerSet' = do
|
||||
(getter, _) <- clockDateCacher
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
name: yesod
|
||||
version: 1.4.2.1
|
||||
version: 1.4.3
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Michael Snoyman <michael@snoyman.com>
|
||||
@ -33,7 +33,7 @@ library
|
||||
, safe
|
||||
, data-default
|
||||
, unordered-containers
|
||||
, yaml
|
||||
, yaml >= 0.8.17
|
||||
, text
|
||||
, directory
|
||||
, template-haskell
|
||||
|
||||
Loading…
Reference in New Issue
Block a user