From cfb6e1e24a6eb5f8ebafc6d1c1c038b3278ce98f Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Mon, 19 Sep 2011 15:12:19 -0400 Subject: [PATCH] Move bulk of Settings/Main out of -core Trim settings to only the AppConfig def and an AppEnv typeclass, rename to Config but leave in -core --- .../Settings.hs => yesod-core/Yesod/Config.hs | 40 +++---- yesod-core/Yesod/Core.hs | 2 + yesod-core/yesod-core.cabal | 4 + yesod/Yesod/Main.hs | 107 ------------------ 4 files changed, 19 insertions(+), 134 deletions(-) rename yesod/Yesod/Settings.hs => yesod-core/Yesod/Config.hs (70%) delete mode 100644 yesod/Yesod/Main.hs diff --git a/yesod/Yesod/Settings.hs b/yesod-core/Yesod/Config.hs similarity index 70% rename from yesod/Yesod/Settings.hs rename to yesod-core/Yesod/Config.hs index 148b081a..2fccc1e6 100644 --- a/yesod/Yesod/Settings.hs +++ b/yesod-core/Yesod/Config.hs @@ -1,7 +1,7 @@ {-# OPTIONS -fno-warn-missing-signatures #-} {-# LANGUAGE QuasiQuotes #-} -module Yesod.Settings - ( AppEnvironment(..) +module Yesod.Config + ( AppEnv(..) , AppConfig(..) , loadConfig , loadPostgresqlConnStr @@ -17,30 +17,16 @@ import Text.Shakespeare.Text (st) import qualified Data.Object.Yaml as YAML import qualified Data.Text as T -data AppEnvironment = Development - | Test - | Staging - | Production - deriving (Eq, Show, Read, Enum, Bounded) +class AppEnv e where + displayPort :: e -> Bool -- | Dynamic per-environment configuration which can be loaded at -- run-time negating the need to recompile between environments. -data AppConfig = AppConfig - { appEnv :: AppEnvironment +data AppConfig e = AppConfig + { appEnv :: e , appPort :: Int - -- | Your application will keep a connection pool and take - -- connections from there as necessary instead of continually - -- creating new connections. This value gives the maximum number - -- of connections to be open at a given time. If your application - -- requests a connection when all connections are in use, that - -- request will fail. Try to choose a number that will work well - -- with the system resources available to you while providing - -- enough connections for your expected load. - -- - -- Connections are returned to the pool as quickly as possible by - -- Yesod to avoid resource exhaustion. A connection is only - -- considered in use while within a call to runDB. + -- TODO: put this in db configs , connectionPoolSize :: Int -- | The base URL for your application. This will usually be @@ -56,9 +42,10 @@ data AppConfig = AppConfig , appRoot :: Text } deriving (Show) + -- | Load an @'AppConfig'@ from a YAML-formatted file located at -- @config\/settings.yml@. -loadConfig :: AppEnvironment -> IO AppConfig +loadConfig :: AppEnv e => e -> IO (AppConfig e) loadConfig env = do allSettings <- (join $ YAML.decodeFile ("config/settings.yml" :: String)) >>= fromMapping settings <- lookupMapping (show env) allSettings @@ -75,13 +62,12 @@ loadConfig env = do where addPort :: Int -> String - addPort p = case env of - Production -> "" - _ -> ":" ++ show p + addPort p = if displayPort env + then ":" ++ show p else "" -- | Load Postgresql settings from a YAML-formatted file located at -- @config\/postgresql.yml@. -loadPostgresqlConnStr :: AppEnvironment -> IO Text +loadPostgresqlConnStr :: Show e => e -> IO Text loadPostgresqlConnStr env = do allSettings <- (join $ YAML.decodeFile ("config/postgresql.yml" :: String)) >>= fromMapping settings <- lookupMapping (show env) allSettings @@ -94,7 +80,7 @@ loadPostgresqlConnStr env = do -- | Load Sqlite settings from a YAML-formatted file located at -- @config\/sqlite.yml@. -loadSqliteConnStr :: AppEnvironment -> IO Text +loadSqliteConnStr :: Show e => e -> IO Text loadSqliteConnStr env = do allSettings <- (join $ YAML.decodeFile ("config/sqlite.yml" :: String)) >>= fromMapping settings <- lookupMapping (show env) allSettings diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs index 9f137991..2e395856 100644 --- a/yesod-core/Yesod/Core.hs +++ b/yesod-core/Yesod/Core.hs @@ -33,6 +33,7 @@ module Yesod.Core , module Yesod.Request , module Yesod.Widget , module Yesod.Message + , module Yesod.Config ) where import Yesod.Internal.Core @@ -42,6 +43,7 @@ import Yesod.Handler import Yesod.Request import Yesod.Widget import Yesod.Message +import Yesod.Config import Language.Haskell.TH.Syntax import Data.Text (Text) diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 1b520dc4..a499a2d3 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -38,6 +38,7 @@ library , shakespeare >= 0.10 && < 0.11 , shakespeare-js >= 0.10 && < 0.11 , shakespeare-css >= 0.10 && < 0.11 + , shakespeare-text >= 0.10 && < 0.11 , blaze-builder >= 0.2.1 && < 0.4 , transformers >= 0.2 && < 0.3 , clientsession >= 0.7.2 && < 0.8 @@ -54,6 +55,8 @@ library , case-insensitive >= 0.2 && < 0.4 , parsec >= 2 && < 3.2 , directory >= 1 && < 1.2 + , data-object >= 0.3 && < 0.4 + , data-object-yaml >= 0.3 && < 0.4 -- for logger. Probably logger should be a separate package , strict-concurrency >= 0.2.4 && < 0.2.5 @@ -65,6 +68,7 @@ library Yesod.Request Yesod.Widget Yesod.Message + Yesod.Config other-modules: Yesod.Internal Yesod.Internal.Core Yesod.Internal.Session diff --git a/yesod/Yesod/Main.hs b/yesod/Yesod/Main.hs deleted file mode 100644 index 98b13de4..00000000 --- a/yesod/Yesod/Main.hs +++ /dev/null @@ -1,107 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -module Yesod.Main - ( defaultMain - , fromArgs - , fromArgsWith - , defaultDevelApp - , defaultDevelAppWith - ) where - -import Yesod.Logger (Logger, makeLogger, logString, logLazyText, flushLogger) -import Yesod.Settings (AppEnvironment(..), AppConfig(..), loadConfig) -import Network.Wai (Application) -import Network.Wai.Handler.Warp (run) -import Network.Wai.Middleware.Debug (debugHandle) -import System.Console.CmdArgs hiding (args) -import Data.Char (toUpper, toLower) - -data ArgConfig = ArgConfig - { environment :: String - , port :: Int - } deriving (Show, Data, Typeable) - --- | Load an @'AppConfig'@ using the provided function, then start your --- app via Warp on the configured port. --- --- > -- main.hs --- > import Application (withMySite) --- > import Yesod.Main (defaultMain, fromArgs) --- > --- > main :: IO () --- > main = defaultMain fromArgs withMySite --- -defaultMain :: IO AppConfig -> (AppConfig -> Logger -> (Application -> IO ()) -> IO ()) -> IO () -defaultMain load withSite = do - config <- load - logger <- makeLogger - withSite config logger $ run (appPort config) - --- | Call the @'Yesod.Settings.loadConfig'@ function for the environment --- passed on the commandline (or the default, \"development\") and --- override the port if passed. -fromArgs :: IO AppConfig -fromArgs = fromArgsWith loadConfig - --- | Same, but allows one to provide their own custom @'loadConfig'@ -fromArgsWith :: (AppEnvironment -> IO AppConfig) -> IO AppConfig -fromArgsWith load = do - args <- cmdArgs argConfig - - let env = read - $ capitalize - $ if environment args /= "" - then environment args - else "development" - - config <- load env - - return $ if port args /= 0 - then config { appPort = port args } - else config - - where - argConfig :: ArgConfig - argConfig = ArgConfig - { environment = def - &= help ("application environment, one of: " ++ (foldl1 (\a b -> a ++ ", " ++ b) environments)) - &= typ "ENVIRONMENT" - , port = def - &= help "the port to listen on" - &= typ "PORT" - } - - environments :: [String] - environments = map ((map toLower) . show) ([minBound..maxBound] :: [AppEnvironment]) - - capitalize [] = [] - capitalize (x:xs) = toUpper x : map toLower xs - --- | A default argument for use with yesod devel with debug logging --- enabled. Uses @'Yesod.Settings.loadConfig'@ for the @'Development'@ --- environment. --- --- > -- Application.hs --- > --- > withDevelAppPort :: Dynamic --- > withDevelAppPort = toDyn $ defaultDevelApp withMySite --- -defaultDevelApp :: (AppConfig -> Logger -> (Application -> IO ()) -> IO ()) - -> ((Int, Application) -> IO ()) - -> IO () -defaultDevelApp = defaultDevelAppWith loadConfig - --- | Same, but allows one to provide their own cust @'loadConfig'@ -defaultDevelAppWith :: (AppEnvironment -> IO AppConfig) - -> (AppConfig -> Logger -> (Application -> IO ()) -> IO ()) - -> ((Int, Application) -> IO ()) - -> IO () -defaultDevelAppWith load withSite f = do - conf <- load Development - logger <- makeLogger - let p = appPort conf - logString logger $ "Devel application launched, listening on port " ++ show p - withSite conf logger $ \app -> f (p, debugHandle (logHandle logger) app) - flushLogger logger - - where - logHandle logger msg = logLazyText logger msg >> flushLogger logger