add a Settings.yaml file for dynamic settings

also command line to check for environment argument
This commit is contained in:
Greg Weber 2011-07-06 20:14:30 -07:00
parent 98a20a8a00
commit 7452726d40
12 changed files with 163 additions and 62 deletions

View File

@ -35,14 +35,22 @@ getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)
-- 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~ :: (Application -> IO a) -> IO a
with~sitearg~ f = Settings.withConnectionPool $ \p -> do
with~sitearg~ :: AppConfig -> (Application -> IO a) -> IO a
with~sitearg~ conf f = do
Settings.withConnectionPool conf $ \p -> do
runConnectionPool (runMigration migrateAll) p
let h = ~sitearg~ s p
let h = ~sitearg~ conf s p
toWaiApp h >>= f
where
s = static Settings.staticdir
s = static Settings.staticDir
with~sitearg~LoadConfig :: Settings.AppEnvironment -> (Application -> IO a) -> IO a
with~sitearg~LoadConfig env f = do
conf <- Settings.loadConfig Settings.Development
withFoobar conf f
withDevelApp :: Dynamic
withDevelApp = toDyn (with~sitearg~ :: (Application -> IO ()) -> IO ())
withDevelApp = do
toDyn ((with~sitearg~LoadConfig Settings.Development):: (Application -> IO ()) -> IO ())

View File

@ -16,9 +16,11 @@ module Settings
, ConnectionPool
, withConnectionPool
, runConnectionPool
, approot
, staticroot
, staticdir
, staticRoot
, staticDir
, loadConfig
, AppEnvironment(..)
, AppConfig(..)
) where
import qualified Text.Hamlet as H
@ -31,26 +33,67 @@ import Yesod (MonadControlIO, addWidget, addCassius, addJulius, addLucius)
import Data.Monoid (mempty, mappend)
import System.Directory (doesFileExist)
import Data.Text (Text)
import Data.Object
import Data.Object.Yaml
import Control.Monad (join)
-- | The base URL for your application. This will usually be different for
-- development and production. Yesod automatically constructs URLs for you,
-- so this value must be accurate to create valid links.
-- Please note that there is no trailing slash.
approot :: Text
approot =
#ifdef PRODUCTION
-- You probably want to change this. If your domain name was "yesod.com",
-- you would probably want it to be:
-- > "http://yesod.com"
"http://localhost:3000"
#else
"http://localhost:3000"
#endif
data AppEnvironment = Test
| Development
| Staging
| Production
deriving (Eq, Show, Read, Enum, Bounded)
-- | dynamic per-environment configuration loaded from a YAML file
-- use this to avoid the need to re-compile between staging and production environments
data AppConfig = AppConfig {
appEnv :: AppEnvironment
, 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.
, connectionPoolSize :: Int
-- | The base URL for your application. This will usually be different for
-- development and production. Yesod automatically constructs URLs for you,
-- so this value must be accurate to create valid links.
-- Please note that there is no trailing slash.
--
-- You probably want to change this! If your domain name was "yesod.com",
-- you would probably want it to be:
-- > "http://yesod.com"
, appRoot :: Text
}
loadConfig :: AppEnvironment -> IO AppConfig
loadConfig env = do
allSettings <- (join $ decodeFile ("Settings.yaml" :: String)) >>= fromMapping
settings <- lookupMapping (show env) allSettings
appPortS <- lookupScalar "appPort" settings
appRootS <- lookupScalar "appRoot" settings
connectionPoolSizeS <- lookupScalar "connectionPoolSize" settings
return $ AppConfig {
appEnv = env
, appPort = read $ appPortS
, appRoot = read $ appRootS
, connectionPoolSize = read $ connectionPoolSizeS
}
-- Static setting below. Changing these requires a recompile
-- | The location of static files on your system. This is a file system
-- path. The default value works properly with your scaffolded site.
staticdir :: FilePath
staticdir = "static"
staticDir :: FilePath
staticDir = "static"
-- | The base URL for your static files. As you can see by the default
-- value, this can simply be "static" appended to your application root.
@ -65,8 +108,9 @@ staticdir = "static"
-- have to make a corresponding change here.
--
-- To see how this value is used, see urlRenderOverride in ~sitearg~.hs
staticroot :: Text
staticroot = approot `mappend` "/static"
staticRoot :: AppConfig -> Text
staticRoot conf = (appRoot conf) `mappend` "/static"
-- | The database connection string. The meaning of this string is backend-
-- specific.
@ -78,20 +122,6 @@ connStr =
"~connstr1~"
#endif
-- | 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.
--
-- Also, 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.
connectionCount :: Int
connectionCount = 10
-- The rest of this file contains settings which rarely need changing by a
-- user.
@ -155,8 +185,8 @@ widgetFile x = do
-- database actions using a pool, respectively. It is used internally
-- by the scaffolded application, and therefore you will rarely need to use
-- them yourself.
withConnectionPool :: MonadControlIO m => (ConnectionPool -> m a) -> m a
withConnectionPool = with~upper~Pool connStr connectionCount
withConnectionPool :: MonadControlIO m => AppConfig -> (ConnectionPool -> m a) -> m a
withConnectionPool conf = with~upper~Pool connStr (connectionPoolSize conf)
runConnectionPool :: MonadControlIO m => SqlPersist m a -> ConnectionPool -> m a
runConnectionPool = runSqlPool

16
scaffold/Settings_yaml.cg Normal file
View File

@ -0,0 +1,16 @@
Default: &default
appRoot: http://localhost
appPort: 3000
connectionPoolLimit: 10
Development:
<<: *defaults
Test:
<<: *defaults
Staging:
<<: *defaults
Production:
<<: *defaults

View File

@ -62,6 +62,8 @@ executable ~project~
, hamlet
, hjsmin
, transformers
, data-object
, data-object-yaml
, warp
, blaze-builder
, cmdargs

View File

@ -34,13 +34,13 @@ getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)
-- 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~ :: (Application -> IO a) -> IO a
with~sitearg~ f = do
let h = ~sitearg~ s
with~sitearg~ :: AppEnvironment -> (Application -> IO a) -> IO a
with~sitearg~ appEnv f = do
let h = ~sitearg~ appEnv s
toWaiApp h >>= f
where
s = static Settings.staticdir
withDevelApp :: Dynamic
withDevelApp = toDyn (with~sitearg~ :: (Application -> IO ()) -> IO ())
withDevelApp = toDyn (with~sitearg~ Development :: (Application -> IO ()) -> IO ())

View File

@ -55,6 +55,8 @@ executable ~project~
, template-haskell
, hamlet
, transformers
, data-object
, data-object-yaml
, wai
, warp
, blaze-builder

View File

@ -30,7 +30,8 @@ import qualified Data.Text as T
-- starts running, such as database connections. Every handler will have
-- access to the data present here.
data ~sitearg~ = ~sitearg~
{ getStatic :: Static -- ^ Settings for static file serving.
{ appEnv :: Settings.AppEnvironment
, getStatic :: Static -- ^ Settings for static file serving.
}
-- | A useful synonym; most of the handler functions in your application

View File

@ -40,7 +40,8 @@ import qualified Data.Text as T
-- starts running, such as database connections. Every handler will have
-- access to the data present here.
data ~sitearg~ = ~sitearg~
{ getStatic :: Static -- ^ Settings for static file serving.
{ settings :: Settings.AppConfig
, getStatic :: Static -- ^ Settings for static file serving.
, connPool :: Settings.ConnectionPool -- ^ Database connection pool.
}
@ -76,7 +77,7 @@ mkYesodData "~sitearg~" $(parseRoutesFile "config/routes")
-- Please see the documentation for the Yesod typeclass. There are a number
-- of settings which can be configured by overriding methods here.
instance Yesod ~sitearg~ where
approot _ = Settings.approot
approot = Settings.appRoot . settings
defaultLayout widget = do
mmsg <- getMessage
@ -86,9 +87,9 @@ instance Yesod ~sitearg~ where
hamletToRepHtml $(Settings.hamletFile "default-layout")
-- This is done to provide an optimization for serving static files from
-- a separate domain. Please see the staticroot setting in Settings.hs
urlRenderOverride a (StaticR s) =
Just $ uncurry (joinPath a Settings.staticroot) $ renderRoute s
-- a separate domain. Please see the staticRoot setting in Settings.hs
urlRenderOverride y (StaticR s) =
Just $ uncurry (joinPath y (Settings.staticRoot $ settings y)) $ renderRoute s
urlRenderOverride _ _ = Nothing
-- The page to be redirected to when authentication is required.
@ -106,7 +107,7 @@ instance Yesod ~sitearg~ where
Left _ -> content
Right y -> y
else content
let statictmp = Settings.staticdir ++ "/tmp/"
let statictmp = Settings.staticDir ++ "/tmp/"
liftIO $ createDirectoryIfMissing True statictmp
let fn' = statictmp ++ fn
exists <- liftIO $ doesFileExist fn'

View File

@ -1,20 +1,51 @@
{-# LANGUAGE CPP #-}
#if PRODUCTION
{-# LANGUAGE CPP, DeriveDataTypeable #-}
import qualified Settings as Settings
import Controller (with~sitearg~)
import Network.Wai.Handler.Warp (run)
import System.Console.CmdArgs
import Data.Char (toUpper, toLower)
#if PRODUCTION
main :: IO ()
main = with~sitearg~ $ run 3000
main = do
appEnv <- getAppEnv
config <- Settings.loadConfig appEnv
with~sitearg~ config $ run (Settings.appPort settings)
#else
import Controller (with~sitearg~)
import System.IO (hPutStrLn, stderr)
import Network.Wai.Middleware.Debug (debug)
import Network.Wai.Handler.Warp (run)
main :: IO ()
main = do
let port = 3000
hPutStrLn stderr $ "Application launched, listening on port " ++ show port
with~sitearg~ $ run port . debug
appEnv <- getAppEnv
config <- Settings.loadConfig appEnv
hPutStrLn stderr $ "Application launched, listening on port " ++ show (Settings.appPort config)
with~sitearg~ config $ run (Settings.appPort config) . debug
#endif
data ArgConfig = ArgConfig {environment :: String}
deriving (Show, Data, Typeable)
config = ArgConfig{ environment = def
&= help "application environment, one of:" ++ (foldl1 (++) environments)
&= typ "ENVIRONMENT"
#if PRODUCTION
&= opt "production"
#else
&= opt "development"
#endif
}
environments :: [String]
environments = map show ([minBound..maxBound] :: [Settings.AppEnvironment])
-- | retrieve the -e environment option
getAppEnv :: IO Settings.AppEnvironment
getAppEnv = do
cfg <- cmdArgs config
return $ read $ capitalize $ environment cfg
where
capitalize [] = []
capitalize (x:xs) = toUpper x : map toLower xs

6
tests/runscaffold.sh Executable file
View File

@ -0,0 +1,6 @@
#!/bin/sh
cd .. &&
cabal clean && cabal install &&
rm -rf foobar && runghc scaffold.hs init < sample-input.txt && cd foobar && cabal install && cabal install -fdevel && cd .. &&
cd tests

4
tests/sample-input.txt Normal file
View File

@ -0,0 +1,4 @@
Michael
foobar
Foobar
s