haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Move bulk of Settings/Main out of -core

Browse Source 
Trim settings to only the AppConfig def and an AppEnv typeclass, rename
to Config but leave in -core
This commit is contained in:
patrick brisbin 2011-09-19 15:12:19 -04:00
parent f41029fd4c
commit cfb6e1e24a
4 changed files with 19 additions and 134 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
yesod/Yesod/Settings.hs → yesod-core/Yesod/Config.hs
View File

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

2
yesod-core/Yesod/Core.hs
View File

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

4
yesod-core/yesod-core.cabal
View File

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

107
yesod/Yesod/Main.hs
View File

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