Deprecate Yesod.Config; more configurable config in yesod-default

yesod-core/Yesod/Config.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Yesod.Config
+    {-# DEPRECATED "This code has been moved to yesod-default. This module will be removed in the next major version bump." #-}
     ( AppConfig(..)
     , loadConfig
     , withYamlEnvironment

yesod-core/yesod-core.cabal

@@ -1,5 +1,5 @@
 name:            yesod-core
-version:         0.9.3.6
+version:         0.9.4
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>

yesod-default/Yesod/Default/Config.hs

@@ -1,19 +1,27 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Yesod.Default.Config
-    ( DefaultEnv(..)
+    ( DefaultEnv (..)
-    , ArgConfig(..)
-    , defaultArgConfig
     , fromArgs
-    , fromArgsWith
+    , fromArgsExtra
     , loadDevelopmentConfig
 
     -- reexport
-    , module Yesod.Config
+    , AppConfig (..)
+    , ConfigSettings (..)
+    , configSettings
+    , loadConfig
+    , withYamlEnvironment
     ) where
 
-import Yesod.Config
 import Data.Char (toUpper, toLower)
 import System.Console.CmdArgs hiding (args)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Control.Monad (join)
+import Data.Object
+import Data.Object.Yaml
+import Data.Maybe (fromMaybe)
 
 -- | A yesod-provided @'AppEnv'@, allows for Development, Testing, and
 --   Production environments
@@ -32,7 +40,8 @@ data ArgConfig = ArgConfig
 defaultArgConfig :: ArgConfig
 defaultArgConfig =
     ArgConfig
-        { environment = "development"
+        { environment = def
+            &= argPos 0
             &= help ("application environment, one of: " ++ environments)
             &= typ   "ENVIRONMENT"
         , port = def
@@ -48,11 +57,20 @@ defaultArgConfig =
 
 -- | Load an @'AppConfig'@ using the @'DefaultEnv'@ environments from
 --   commandline arguments.
-fromArgs :: IO (AppConfig DefaultEnv)
+fromArgs :: IO (AppConfig DefaultEnv ())
-fromArgs = fromArgsWith defaultArgConfig
+fromArgs = fromArgsExtra (const $ const $ return ())
 
-fromArgsWith :: (Read e, Show e) => ArgConfig -> IO (AppConfig e)
+-- | Same as 'fromArgs', but allows you to specify how to parse the 'appExtra'
-fromArgsWith argConfig = do
+-- record.
+fromArgsExtra :: (DefaultEnv -> TextObject -> IO extra)
+              -> IO (AppConfig DefaultEnv extra)
+fromArgsExtra = fromArgsWith defaultArgConfig
+
+fromArgsWith :: (Read env, Show env)
+             => ArgConfig
+             -> (env -> TextObject -> IO extra)
+             -> IO (AppConfig env extra)
+fromArgsWith argConfig getExtra = do
     args   <- cmdArgs argConfig
 
     env <-
@@ -60,7 +78,10 @@ fromArgsWith argConfig = do
             (e, _):_ -> return e
             [] -> error $ "Invalid environment: " ++ environment args
 
-    config <- loadConfig env
+    let cs = (configSettings env)
+                { csLoadExtra = getExtra
+                }
+    config <- loadConfig cs
 
     return $ if port args /= 0
                 then config { appPort = port args }
@@ -71,5 +92,142 @@ fromArgsWith argConfig = do
         capitalize (x:xs) = toUpper x : map toLower xs
 
 -- | Load your development config (when using @'DefaultEnv'@)
-loadDevelopmentConfig :: IO (AppConfig DefaultEnv)
+loadDevelopmentConfig :: IO (AppConfig DefaultEnv ())
-loadDevelopmentConfig = loadConfig Development
+loadDevelopmentConfig = loadConfig $ configSettings Development
+
+-- | Dynamic per-environment configuration which can be loaded at
+--   run-time negating the need to recompile between environments.
+data AppConfig environment extra = AppConfig
+    { appEnv   :: environment
+    , appPort  :: Int
+    , appRoot  :: Text
+    , appExtra :: extra
+    } deriving (Show)
+
+data ConfigSettings environment extra = ConfigSettings
+    {
+    -- | An arbitrary value, used below, to indicate the current running
+    -- environment. Usually, you will use 'DefaultEnv' for this type.
+       csEnv :: environment
+    -- | Load any extra data, to be used by the application.
+    , csLoadExtra :: environment -> TextObject -> IO extra
+    -- | Return the path to the YAML config file.
+    , csFile :: environment -> IO FilePath
+    -- | Get the sub-object (if relevant) from the given YAML source which
+    -- contains the specific settings for the current environment.
+    , csGetObject :: environment -> TextObject -> IO TextObject
+    }
+
+-- | Default config settings.
+configSettings :: Show env => env -> ConfigSettings env ()
+configSettings env0 = ConfigSettings
+    { csEnv = env0
+    , csLoadExtra = \_ _ -> return ()
+    , csFile = \_ -> return "config/settings.yml"
+    , csGetObject = \env obj -> do
+        envs <- fromMapping obj
+        let senv = show env
+            tenv = T.pack senv
+        maybe
+            (error $ "Could not find environment: " ++ senv)
+            return
+            (lookup tenv envs)
+    }
+
+-- | Load an @'AppConfig'@.
+--
+--   Some examples:
+--
+--   > -- typical local development
+--   > Development:
+--   >   host: localhost
+--   >   port: 3000
+--   >
+--   >   -- ssl: will default false
+--   >   -- approot: will default to "http://localhost:3000"
+--
+--   > -- typical outward-facing production box
+--   > Production:
+--   >   host: www.example.com
+--   >
+--   >   -- ssl: will default false
+--   >   -- port: will default 80
+--   >   -- approot: will default "http://www.example.com"
+--
+--   > -- maybe you're reverse proxying connections to the running app
+--   > -- on some other port
+--   > Production:
+--   >   port: 8080
+--   >   approot: "http://example.com"
+--   >
+--   > -- approot is specified so that the non-80 port is not appended
+--   > -- automatically.
+--
+loadConfig :: ConfigSettings environment extra
+           -> IO (AppConfig environment extra)
+loadConfig (ConfigSettings env loadExtra getFile getObject) = do
+    fp <- getFile env
+    topObj <- join $ decodeFile fp
+    obj <- getObject env topObj
+
+    m <- maybe (fail "Expected map") return $ fromMapping obj
+    let mssl     = lookupScalar "ssl"     m
+    let mhost    = lookupScalar "host"    m
+    let mport    = lookupScalar "port"    m
+    let mapproot = lookupScalar "approot" m
+
+    extra <- loadExtra env obj
+
+    -- set some default arguments
+    let ssl = maybe False toBool mssl
+    port' <- safeRead "port" $ fromMaybe (if ssl then "443" else "80") mport
+
+    approot <- case (mhost, mapproot) of
+        (_        , Just ar) -> return ar
+        (Just host, _      ) -> return $ T.concat
+            [ if ssl then "https://" else "http://"
+            , host
+            , addPort ssl port'
+            ]
+        _ -> fail "You must supply either a host or approot"
+
+    return $ AppConfig
+        { appEnv   = env
+        , appPort  = port'
+        , appRoot  = approot
+        , appExtra = extra
+        }
+
+    where
+        toBool :: Text -> Bool
+        toBool = (`elem` ["true", "TRUE", "yes", "YES", "Y", "1"])
+
+        addPort :: Bool -> Int -> Text
+        addPort True  443 = ""
+        addPort False 80  = ""
+        addPort _     p   = T.pack $ ':' : show p
+
+-- | Returns 'fail' if read fails
+safeRead :: Monad m => String -> Text -> m Int
+safeRead name' t = case reads s of
+    (i, _):_ -> return i
+    []       -> fail $ concat ["Invalid value for ", name', ": ", s]
+  where
+    s = T.unpack t
+
+-- | Loads the configuration block in the passed file named by the
+--   passed environment, yeilds to the passed function as a mapping.
+--
+--   Errors in the case of a bad load or if your function returns
+--   @Nothing@.
+withYamlEnvironment :: Show e
+                    => FilePath -- ^ the yaml file
+                    -> e        -- ^ the environment you want to load
+                    -> (TextObject -> IO a) -- ^ what to do with the mapping
+                    -> IO a
+withYamlEnvironment fp env f = do
+    obj <- join $ decodeFile fp
+    envs <- fromMapping obj
+    conf <- maybe (fail $ "Could not find environment: " ++ show env) return
+          $ lookup (T.pack $ show env) envs
+    f conf

yesod-default/Yesod/Default/Main.hs

@@ -7,7 +7,7 @@ module Yesod.Default.Main
     , defaultDevelAppWith
     ) where
 
-import Yesod.Core
+import Yesod.Core hiding (AppConfig (..))
 import Yesod.Default.Config
 import Yesod.Logger (Logger, makeLogger, logString, logLazyText, flushLogger)
 import Network.Wai (Application)
@@ -39,7 +39,10 @@ import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
 --   > main :: IO ()
 --   > main = defaultMain (fromArgsWith customArgConfig) withMySite
 --
-defaultMain :: (Show e, Read e) => IO (AppConfig e) -> (AppConfig e -> Logger -> (Application -> IO ()) -> IO ()) -> IO ()
+defaultMain :: (Show env, Read env)
+            => IO (AppConfig env extra)
+            -> (AppConfig env extra -> Logger -> (Application -> IO ()) -> IO ())
+            -> IO ()
 defaultMain load withSite = do
     config <- load
     logger <- makeLogger
@@ -85,7 +88,7 @@ defaultRunner f h = do
 --   > withDevelAppPort :: Dynamic
 --   > withDevelAppPort = toDyn $ defaultDevelApp withMySite
 --
-defaultDevelApp :: (AppConfig DefaultEnv -> Logger -> (Application -> IO ()) -> IO ())
+defaultDevelApp :: (AppConfig DefaultEnv () -> Logger -> (Application -> IO ()) -> IO ())
                 -> ((Int, Application) -> IO ())
                 -> IO ()
 defaultDevelApp = defaultDevelAppWith loadDevelopmentConfig
@@ -96,9 +99,9 @@ defaultDevelApp = defaultDevelAppWith loadDevelopmentConfig
 --   > withDevelAppPort :: Dynamic
 --   > withDevelAppPort = toDyn $ (defaultDevelAppWith customLoadAppConfig) withMySite
 --
-defaultDevelAppWith :: (Show e, Read e)
+defaultDevelAppWith :: (Show env, Read env)
-                    => IO (AppConfig e) -- ^ A means to load your development @'AppConfig'@
+                    => IO (AppConfig env extra) -- ^ A means to load your development @'AppConfig'@
-                    -> (AppConfig e -> Logger -> (Application -> IO ()) -> IO ()) -- ^ Your @withMySite@ function
+                    -> (AppConfig env extra -> Logger -> (Application -> IO ()) -> IO ()) -- ^ Your @withMySite@ function
                     -> ((Int, Application) -> IO ()) -> IO ()
 defaultDevelAppWith load withSite f = do
         conf   <- load

yesod-default/yesod-default.cabal

@@ -1,5 +1,5 @@
 name:            yesod-default
-version:         0.4.1
+version:         0.5.0
 license:         BSD3
 license-file:    LICENSE
 author:          Patrick Brisbin
@@ -18,7 +18,7 @@ library
         cpp-options: -DWINDOWS
 
     build-depends:   base                  >= 4     && < 5
-                   , yesod-core            >= 0.9   && < 0.10
+                   , yesod-core            >= 0.9.4 && < 0.10
                    , cmdargs               >= 0.8
                    , warp                  >= 0.4   && < 0.5
                    , wai                   >= 0.4   && < 0.5
@@ -30,6 +30,8 @@ library
                    , shakespeare-css       >= 0.10  && < 0.11
                    , shakespeare-js        >= 0.10  && < 0.11
                    , template-haskell
+                   , data-object           >= 0.3      && < 0.4
+                   , data-object-yaml      >= 0.3      && < 0.4
 
     if !os(windows)
          build-depends: unix

yesod/scaffold/Application.hs.cg

@@ -27,7 +27,7 @@ mkYesodDispatch "~sitearg~" resources~sitearg~
 -- performs initialization and creates a WAI application. This is also the
 -- place to put your migrate statements to have automatic database
 -- migrations handled by Yesod.
-with~sitearg~ :: AppConfig DefaultEnv -> Logger -> (Application -> IO ()) -> IO ()
+with~sitearg~ :: AppConfig DefaultEnv () -> Logger -> (Application -> IO ()) -> IO ()
 with~sitearg~ conf logger f = do
 #ifdef PRODUCTION
     s <- static Settings.staticDir

yesod/scaffold/Foundation.hs.cg

@@ -16,7 +16,7 @@ module Foundation
     ) where
 
 import Prelude
-import Yesod hiding (Form)
+import Yesod hiding (Form, AppConfig (..), withYamlEnvironment)
 import Yesod.Static (Static, base64md5, StaticRoute(..))
 import Settings.StaticFiles
 import Yesod.Auth
@@ -44,7 +44,7 @@ import qualified Data.Text.Lazy.Encoding
 -- starts running, such as database connections. Every handler will have
 -- access to the data present here.
 data ~sitearg~ = ~sitearg~
-    { settings :: AppConfig DefaultEnv
+    { settings :: AppConfig DefaultEnv ()
     , getLogger :: Logger
     , getStatic :: Static -- ^ Settings for static file serving.
     , connPool :: Database.Persist.Base.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool.

yesod/scaffold/Settings.hs.cg

@@ -41,7 +41,7 @@ staticDir = "static"
 -- have to make a corresponding change here.
 --
 -- To see how this value is used, see urlRenderOverride in Foundation.hs
-staticRoot :: AppConfig DefaultEnv ->  Text
+staticRoot :: AppConfig DefaultEnv x ->  Text
 staticRoot conf = [~qq~st|#{appRoot conf}/static|]
 
 

yesod/scaffold/project.cabal.cg

@@ -77,9 +77,9 @@ executable         ~project~
                  , yesod-core                    >= 0.9.3      && < 0.10
                  , yesod-auth                    >= 0.7.3      && < 0.8
                  , yesod-static                  >= 0.3.1      && < 0.4
-                 , yesod-default                 >= 0.4        && < 0.5
+                 , yesod-default                 >= 0.5        && < 0.6
                  , yesod-form                    >= 0.3.4      && < 0.4
-                 , mime-mail                     >= 0.3.0.3    && < 0.4
+                 , mime-mail                     >= 0.3.0.3    && < 0.5
                  , clientsession                 >= 0.7.3      && < 0.8
                  , bytestring                    >= 0.9        && < 0.10
                  , text                          >= 0.11       && < 0.12

yesod/scaffold/tiny/Application.hs.cg

@@ -26,7 +26,7 @@ mkYesodDispatch "~sitearg~" resources~sitearg~
 -- performs initialization and creates a WAI application. This is also the
 -- place to put your migrate statements to have automatic database
 -- migrations handled by Yesod.
-with~sitearg~ :: AppConfig DefaultEnv -> Logger -> (Application -> IO ()) -> IO ()
+with~sitearg~ :: AppConfig DefaultEnv () -> Logger -> (Application -> IO ()) -> IO ()
 with~sitearg~ conf logger f = do
 #ifdef PRODUCTION
     s <- static Settings.staticDir

yesod/scaffold/tiny/Foundation.hs.cg

@@ -13,7 +13,7 @@ module Foundation
     ) where
 
 import Prelude
-import Yesod.Core
+import Yesod.Core hiding (AppConfig (..))
 import Yesod.Default.Config
 import Yesod.Default.Util (addStaticContentExternal)
 import Yesod.Static (Static, base64md5, StaticRoute(..))
@@ -31,7 +31,7 @@ import Text.Hamlet (hamletFile)
 -- starts running, such as database connections. Every handler will have
 -- access to the data present here.
 data ~sitearg~ = ~sitearg~
-    { settings :: AppConfig DefaultEnv
+    { settings :: AppConfig DefaultEnv ()
     , getLogger :: Logger
     , getStatic :: Static -- ^ Settings for static file serving.
     }

yesod/scaffold/tiny/Settings.hs.cg

@@ -34,7 +34,7 @@ staticDir = "static"
 -- have to make a corresponding change here.
 --
 -- To see how this value is used, see urlRenderOverride in ~project~.hs
-staticRoot :: AppConfig DefaultEnv ->  Text
+staticRoot :: AppConfig DefaultEnv a ->  Text
 staticRoot conf = [~qq~st|#{appRoot conf}/static|]
 
 widgetFile :: String -> Q Exp

yesod/scaffold/tiny/project.cabal.cg

@@ -67,7 +67,7 @@ executable         ~project~
     build-depends: base                          >= 4          && < 5
                  , yesod-core                    >= 0.9.3      && < 0.10
                  , yesod-static                  >= 0.3.1      && < 0.4
-                 , yesod-default                 >= 0.4        && < 0.5
+                 , yesod-default                 >= 0.5        && < 0.6
                  , clientsession                 >= 0.7.3      && < 0.8
                  , bytestring                    >= 0.9        && < 0.10
                  , text                          >= 0.11       && < 0.12

yesod/yesod.cabal

@@ -1,5 +1,5 @@
 name:            yesod
-version:         0.9.3.4
+version:         0.9.4
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>