add a Settings.yaml file for dynamic settings
also command line to check for environment argument
This commit is contained in:
parent
98a20a8a00
commit
7452726d40
@ -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 ())
|
||||
|
||||
|
||||
@ -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
16
scaffold/Settings_yaml.cg
Normal file
@ -0,0 +1,16 @@
|
||||
Default: &default
|
||||
appRoot: http://localhost
|
||||
appPort: 3000
|
||||
connectionPoolLimit: 10
|
||||
|
||||
Development:
|
||||
<<: *defaults
|
||||
|
||||
Test:
|
||||
<<: *defaults
|
||||
|
||||
Staging:
|
||||
<<: *defaults
|
||||
|
||||
Production:
|
||||
<<: *defaults
|
||||
@ -62,6 +62,8 @@ executable ~project~
|
||||
, hamlet
|
||||
, hjsmin
|
||||
, transformers
|
||||
, data-object
|
||||
, data-object-yaml
|
||||
, warp
|
||||
, blaze-builder
|
||||
|
||||
, cmdargs
|
||||
|
||||
@ -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 ())
|
||||
|
||||
|
||||
@ -55,6 +55,8 @@ executable ~project~
|
||||
, template-haskell
|
||||
, hamlet
|
||||
, transformers
|
||||
, data-object
|
||||
, data-object-yaml
|
||||
, wai
|
||||
, warp
|
||||
, blaze-builder
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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'
|
||||
|
||||
@ -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
6
tests/runscaffold.sh
Executable 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
4
tests/sample-input.txt
Normal file
@ -0,0 +1,4 @@
|
||||
Michael
|
||||
foobar
|
||||
Foobar
|
||||
s
|
||||
Loading…
Reference in New Issue
Block a user