From 49f2da73ee3fbddd6eb180a2d718b4f236a0f1ec Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 14 Dec 2011 08:26:44 +0200 Subject: [PATCH] Deprecate Yesod.Config; more configurable config in yesod-default --- yesod-core/Yesod/Config.hs | 1 + yesod-core/yesod-core.cabal | 2 +- yesod-default/Yesod/Default/Config.hs | 186 ++++++++++++++++++++++++-- yesod-default/Yesod/Default/Main.hs | 15 ++- yesod-default/yesod-default.cabal | 6 +- yesod/scaffold/Application.hs.cg | 2 +- yesod/scaffold/Foundation.hs.cg | 4 +- yesod/scaffold/Settings.hs.cg | 2 +- yesod/scaffold/project.cabal.cg | 4 +- yesod/scaffold/tiny/Application.hs.cg | 2 +- yesod/scaffold/tiny/Foundation.hs.cg | 4 +- yesod/scaffold/tiny/Settings.hs.cg | 2 +- yesod/scaffold/tiny/project.cabal.cg | 2 +- yesod/yesod.cabal | 2 +- 14 files changed, 199 insertions(+), 35 deletions(-) diff --git a/yesod-core/Yesod/Config.hs b/yesod-core/Yesod/Config.hs index 750893fe..e7bd4a11 100644 --- a/yesod-core/Yesod/Config.hs +++ b/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 diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index e03a95b7..723b5e71 100644 --- a/yesod-core/yesod-core.cabal +++ b/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 diff --git a/yesod-default/Yesod/Default/Config.hs b/yesod-default/Yesod/Default/Config.hs index 742967bb..4eef26b5 100644 --- a/yesod-default/Yesod/Default/Config.hs +++ b/yesod-default/Yesod/Default/Config.hs @@ -1,19 +1,27 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} module Yesod.Default.Config - ( DefaultEnv(..) - , ArgConfig(..) - , defaultArgConfig + ( DefaultEnv (..) , 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 = fromArgsWith defaultArgConfig +fromArgs :: IO (AppConfig DefaultEnv ()) +fromArgs = fromArgsExtra (const $ const $ return ()) -fromArgsWith :: (Read e, Show e) => ArgConfig -> IO (AppConfig e) -fromArgsWith argConfig = do +-- | Same as 'fromArgs', but allows you to specify how to parse the 'appExtra' +-- 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 = loadConfig Development +loadDevelopmentConfig :: IO (AppConfig DefaultEnv ()) +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 diff --git a/yesod-default/Yesod/Default/Main.hs b/yesod-default/Yesod/Default/Main.hs index 22d4bbcd..b4013077 100644 --- a/yesod-default/Yesod/Default/Main.hs +++ b/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) - => IO (AppConfig e) -- ^ A means to load your development @'AppConfig'@ - -> (AppConfig e -> Logger -> (Application -> IO ()) -> IO ()) -- ^ Your @withMySite@ function +defaultDevelAppWith :: (Show env, Read env) + => IO (AppConfig env extra) -- ^ A means to load your development @'AppConfig'@ + -> (AppConfig env extra -> Logger -> (Application -> IO ()) -> IO ()) -- ^ Your @withMySite@ function -> ((Int, Application) -> IO ()) -> IO () defaultDevelAppWith load withSite f = do conf <- load diff --git a/yesod-default/yesod-default.cabal b/yesod-default/yesod-default.cabal index 90370c50..d0956de2 100644 --- a/yesod-default/yesod-default.cabal +++ b/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 diff --git a/yesod/scaffold/Application.hs.cg b/yesod/scaffold/Application.hs.cg index 5914c84c..a371a13e 100644 --- a/yesod/scaffold/Application.hs.cg +++ b/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 diff --git a/yesod/scaffold/Foundation.hs.cg b/yesod/scaffold/Foundation.hs.cg index a6ff5173..5ab6f4f5 100644 --- a/yesod/scaffold/Foundation.hs.cg +++ b/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. diff --git a/yesod/scaffold/Settings.hs.cg b/yesod/scaffold/Settings.hs.cg index ad7edac5..00e19213 100644 --- a/yesod/scaffold/Settings.hs.cg +++ b/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|] diff --git a/yesod/scaffold/project.cabal.cg b/yesod/scaffold/project.cabal.cg index 1b16d206..27eb73a4 100644 --- a/yesod/scaffold/project.cabal.cg +++ b/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 diff --git a/yesod/scaffold/tiny/Application.hs.cg b/yesod/scaffold/tiny/Application.hs.cg index 47ce7469..21911c76 100644 --- a/yesod/scaffold/tiny/Application.hs.cg +++ b/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 diff --git a/yesod/scaffold/tiny/Foundation.hs.cg b/yesod/scaffold/tiny/Foundation.hs.cg index 868d8fcd..17326b0b 100644 --- a/yesod/scaffold/tiny/Foundation.hs.cg +++ b/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. } diff --git a/yesod/scaffold/tiny/Settings.hs.cg b/yesod/scaffold/tiny/Settings.hs.cg index 5deb3cc7..8d21e88f 100644 --- a/yesod/scaffold/tiny/Settings.hs.cg +++ b/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 diff --git a/yesod/scaffold/tiny/project.cabal.cg b/yesod/scaffold/tiny/project.cabal.cg index ab1855c0..057f367e 100644 --- a/yesod/scaffold/tiny/project.cabal.cg +++ b/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 diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index 390457d1..1eda612a 100644 --- a/yesod/yesod.cabal +++ b/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