Use Data.Yaml.Config module to decrease code duplication

stack.yaml

@@ -17,3 +17,4 @@ packages:
 # Needed for LTS 2
 extra-deps:
 - wai-app-static-3.1.4.1
+- yaml-0.8.17

yesod/ChangeLog.md

@@ -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)

yesod/Yesod/Default/Config2.hs

@@ -2,40 +2,40 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- | Some next-gen helper functions for the scaffolding's configuration system.
 module Yesod.Default.Config2
-    ( MergedValue (..)
+    ( -- * Locally defined
-    , applyCurrentEnv
+      configSettingsYml
-    , getCurrentEnv
-    , applyEnvValue
-    , loadAppSettings
-    , loadAppSettingsArgs
-    , 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)
-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 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
+loadAppSettings = loadYamlSettings
-    runValues <- forM runTimeFiles $ \fp -> do
+{-# DEPRECATED loadAppSettings "Use loadYamlSettings" #-}
-        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
 
 -- | 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
+loadAppSettingsArgs = loadYamlSettingsArgs
-    args <- getArgs
+{-# DEPRECATED loadAppSettingsArgs "Use loadYamlSettingsArgs" #-}
-    loadAppSettings args values env
 
 -- | 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

yesod/yesod.cabal

@@ -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