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 -- performs initialization and creates a WAI application. This is also the
-- place to put your migrate statements to have automatic database -- place to put your migrate statements to have automatic database
-- migrations handled by Yesod. -- migrations handled by Yesod.
with~sitearg~ :: (Application -> IO a) -> IO a with~sitearg~ :: AppConfig -> (Application -> IO a) -> IO a
with~sitearg~ f = Settings.withConnectionPool $ \p -> do with~sitearg~ conf f = do
Settings.withConnectionPool conf $ \p -> do
runConnectionPool (runMigration migrateAll) p runConnectionPool (runMigration migrateAll) p
let h = ~sitearg~ s p let h = ~sitearg~ conf s p
toWaiApp h >>= f toWaiApp h >>= f
where 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 :: 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 , ConnectionPool
, withConnectionPool , withConnectionPool
, runConnectionPool , runConnectionPool
, approot , staticRoot
, staticroot , staticDir
, staticdir , loadConfig
, AppEnvironment(..)
, AppConfig(..)
) where ) where
import qualified Text.Hamlet as H import qualified Text.Hamlet as H
@ -31,26 +33,67 @@ import Yesod (MonadControlIO, addWidget, addCassius, addJulius, addLucius)
import Data.Monoid (mempty, mappend) import Data.Monoid (mempty, mappend)
import System.Directory (doesFileExist) import System.Directory (doesFileExist)
import Data.Text (Text) 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 data AppEnvironment = Test
-- development and production. Yesod automatically constructs URLs for you, | Development
-- so this value must be accurate to create valid links. | Staging
-- Please note that there is no trailing slash. | Production
approot :: Text deriving (Eq, Show, Read, Enum, Bounded)
approot =
#ifdef PRODUCTION -- | dynamic per-environment configuration loaded from a YAML file
-- You probably want to change this. If your domain name was "yesod.com", -- use this to avoid the need to re-compile between staging and production environments
-- you would probably want it to be: data AppConfig = AppConfig {
-- > "http://yesod.com" appEnv :: AppEnvironment
"http://localhost:3000"
#else , appPort :: Int
"http://localhost:3000"
#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.
--
-- 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 -- | The location of static files on your system. This is a file system
-- path. The default value works properly with your scaffolded site. -- path. The default value works properly with your scaffolded site.
staticdir :: FilePath staticDir :: FilePath
staticdir = "static" staticDir = "static"
-- | The base URL for your static files. As you can see by the default -- | 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. -- value, this can simply be "static" appended to your application root.
@ -65,8 +108,9 @@ staticdir = "static"
-- have to make a corresponding change here. -- have to make a corresponding change here.
-- --
-- To see how this value is used, see urlRenderOverride in ~sitearg~.hs -- To see how this value is used, see urlRenderOverride in ~sitearg~.hs
staticroot :: Text staticRoot :: AppConfig -> Text
staticroot = approot `mappend` "/static" staticRoot conf = (appRoot conf) `mappend` "/static"
-- | The database connection string. The meaning of this string is backend- -- | The database connection string. The meaning of this string is backend-
-- specific. -- specific.
@ -78,20 +122,6 @@ connStr =
"~connstr1~" "~connstr1~"
#endif #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 -- The rest of this file contains settings which rarely need changing by a
-- user. -- user.
@ -155,8 +185,8 @@ widgetFile x = do
-- database actions using a pool, respectively. It is used internally -- database actions using a pool, respectively. It is used internally
-- by the scaffolded application, and therefore you will rarely need to use -- by the scaffolded application, and therefore you will rarely need to use
-- them yourself. -- them yourself.
withConnectionPool :: MonadControlIO m => (ConnectionPool -> m a) -> m a withConnectionPool :: MonadControlIO m => AppConfig -> (ConnectionPool -> m a) -> m a
withConnectionPool = with~upper~Pool connStr connectionCount withConnectionPool conf = with~upper~Pool connStr (connectionPoolSize conf)
runConnectionPool :: MonadControlIO m => SqlPersist m a -> ConnectionPool -> m a runConnectionPool :: MonadControlIO m => SqlPersist m a -> ConnectionPool -> m a
runConnectionPool = runSqlPool 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 , hamlet
, hjsmin , hjsmin
, transformers , transformers
, data-object
, data-object-yaml
, warp , warp
, blaze-builder , 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 -- performs initialization and creates a WAI application. This is also the
-- place to put your migrate statements to have automatic database -- place to put your migrate statements to have automatic database
-- migrations handled by Yesod. -- migrations handled by Yesod.
with~sitearg~ :: (Application -> IO a) -> IO a with~sitearg~ :: AppEnvironment -> (Application -> IO a) -> IO a
with~sitearg~ f = do with~sitearg~ appEnv f = do
let h = ~sitearg~ s let h = ~sitearg~ appEnv s
toWaiApp h >>= f toWaiApp h >>= f
where where
s = static Settings.staticdir s = static Settings.staticdir
withDevelApp :: Dynamic 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 , template-haskell
, hamlet , hamlet
, transformers , transformers
, data-object
, data-object-yaml
, wai , wai
, warp , warp
, blaze-builder , blaze-builder

View File

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

View File

@ -1,20 +1,51 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP, DeriveDataTypeable #-}
#if PRODUCTION import qualified Settings as Settings
import Controller (with~sitearg~) import Controller (with~sitearg~)
import Network.Wai.Handler.Warp (run) import Network.Wai.Handler.Warp (run)
import System.Console.CmdArgs
import Data.Char (toUpper, toLower)
#if PRODUCTION
main :: IO () main :: IO ()
main = with~sitearg~ $ run 3000 main = do
appEnv <- getAppEnv
config <- Settings.loadConfig appEnv
with~sitearg~ config $ run (Settings.appPort settings)
#else #else
import Controller (with~sitearg~)
import System.IO (hPutStrLn, stderr) import System.IO (hPutStrLn, stderr)
import Network.Wai.Middleware.Debug (debug) import Network.Wai.Middleware.Debug (debug)
import Network.Wai.Handler.Warp (run)
main :: IO () main :: IO ()
main = do main = do
let port = 3000 appEnv <- getAppEnv
hPutStrLn stderr $ "Application launched, listening on port " ++ show port config <- Settings.loadConfig appEnv
with~sitearg~ $ run port . debug hPutStrLn stderr $ "Application launched, listening on port " ++ show (Settings.appPort config)
with~sitearg~ config $ run (Settings.appPort config) . debug
#endif #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