diff --git a/scaffold/Controller.hs.cg b/scaffold/Controller.hs.cg index f6d8c961..ff405232 100644 --- a/scaffold/Controller.hs.cg +++ b/scaffold/Controller.hs.cg @@ -46,10 +46,10 @@ with~sitearg~ conf f = do with~sitearg~LoadConfig :: Settings.AppEnvironment -> (Application -> IO a) -> IO a with~sitearg~LoadConfig env f = do - conf <- Settings.loadConfig Settings.Development + conf <- Settings.loadConfig env withFoobar conf f - +-- for yesod devel withDevelApp :: Dynamic withDevelApp = do toDyn ((with~sitearg~LoadConfig Settings.Development):: (Application -> IO ()) -> IO ()) diff --git a/scaffold/Handler/Root.hs.cg b/scaffold/Handler/Root.hs.cg index 418fde85..0ef7738d 100644 --- a/scaffold/Handler/Root.hs.cg +++ b/scaffold/Handler/Root.hs.cg @@ -2,6 +2,7 @@ module Handler.Root where import ~sitearg~ +import Data.Text -- This is a handler function for the GET request method on the RootR -- resource pattern. All of your resource patterns are defined in @@ -17,4 +18,3 @@ getRootR = do h2id <- lift newIdent setTitle "~project~ homepage" addWidget $(widgetFile "homepage") - diff --git a/scaffold/config/Settings.hs.cg b/scaffold/config/Settings.hs.cg index 5641eeed..956b0c5f 100644 --- a/scaffold/config/Settings.hs.cg +++ b/scaffold/config/Settings.hs.cg @@ -31,7 +31,8 @@ import Language.Haskell.TH.Syntax import Yesod (liftIO, MonadControlIO, addWidget, addCassius, addJulius, addLucius) import Data.Monoid (mempty, mappend) import System.Directory (doesFileExist) -import Data.Text (Text) +import Prelude hiding (concat) +import Data.Text (Text, snoc, append, pack, concat) import Data.Object import qualified Data.Object.Yaml as YAML import Control.Monad (join) diff --git a/scaffold/config/routes.cg b/scaffold/config/routes.cg index 88b05c1c..7a0bb067 100644 --- a/scaffold/config/routes.cg +++ b/scaffold/config/routes.cg @@ -5,4 +5,3 @@ /robots.txt RobotsR GET / RootR GET - diff --git a/scaffold/mini/Controller.hs.cg b/scaffold/mini/Controller.hs.cg index c4947ee9..c895acd0 100644 --- a/scaffold/mini/Controller.hs.cg +++ b/scaffold/mini/Controller.hs.cg @@ -34,13 +34,19 @@ 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~ :: AppEnvironment -> (Application -> IO a) -> IO a -with~sitearg~ appEnv f = do - let h = ~sitearg~ appEnv s +with~sitearg~ :: AppConfig -> (Application -> IO a) -> IO a +with~sitearg~ conf f = do + let h = ~sitearg~ conf s 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 env + withFoobar conf f withDevelApp :: Dynamic -withDevelApp = toDyn (with~sitearg~ Development :: (Application -> IO ()) -> IO ()) +withDevelApp = do + toDyn ((with~sitearg~LoadConfig Settings.Development):: (Application -> IO ()) -> IO ()) diff --git a/scaffold/mini/Handler/Root.hs.cg b/scaffold/mini/Handler/Root.hs.cg index cf292a14..53b7a397 100644 --- a/scaffold/mini/Handler/Root.hs.cg +++ b/scaffold/mini/Handler/Root.hs.cg @@ -5,7 +5,7 @@ import ~sitearg~ -- This is a handler function for the GET request method on the RootR -- resource pattern. All of your resource patterns are defined in --- ~sitearg~.hs; look for the line beginning with mkYesodData. +-- config/routes -- -- The majority of the code you will write in Yesod lives in these handler -- functions. You can spread them across multiple files if you are so diff --git a/scaffold/mini/cabal.cg b/scaffold/mini/cabal.cg index 09793f79..4f570c2d 100644 --- a/scaffold/mini/cabal.cg +++ b/scaffold/mini/cabal.cg @@ -60,5 +60,8 @@ executable ~project~ , wai , warp , blaze-builder + , cmdargs + , data-object + , data-object-yaml ghc-options: -Wall -threaded diff --git a/scaffold/mini/config/Settings.hs.cg b/scaffold/mini/config/Settings.hs.cg index b48fe2e5..10d4ef28 100644 --- a/scaffold/mini/config/Settings.hs.cg +++ b/scaffold/mini/config/Settings.hs.cg @@ -12,9 +12,11 @@ module Settings , juliusFile , luciusFile , widgetFile - , approot - , staticroot - , staticdir + , staticRoot + , staticDir + , loadConfig + , AppEnvironment(..) + , AppConfig(..) ) where import qualified Text.Hamlet as H @@ -26,25 +28,55 @@ import Yesod.Widget (addWidget, addCassius, addJulius, addLucius) import Data.Monoid (mempty, mappend) import System.Directory (doesFileExist) import Data.Text (Text) +import Data.Object +import qualified Data.Object.Yaml as 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. -approot :: Text -#ifdef PRODUCTION --- You probably want to change this. If your domain name was "yesod.com", --- you would probably want it to be: --- > approot = "http://www.yesod.com" --- Please note that there is no trailing slash. -approot = "http://localhost:3000" -#else -approot = "http://localhost:3000" -#endif +data AppEnvironment = Test + | Development + | Staging + | Production + deriving (Eq, Show, Read, Enum, Bounded) + +-- | Dynamic per-environment configuration loaded from the YAML file Settings.yaml. +-- Use dynamic settings to avoid the need to re-compile the application (between staging and production environments). +-- +-- By convention these settings should be overwritten by any command line arguments. +-- See config/~sitearg~.hs for command line arguments +-- Command line arguments provide some convenience but are also required for hosting situations where a setting is read from the environment (appPort on Heroku). +-- +data AppConfig = AppConfig { + appEnv :: AppEnvironment + + , appPort :: 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 +} deriving (Show) + +loadConfig :: AppEnvironment -> IO AppConfig +loadConfig env = do + allSettings <- (join $ YAML.decodeFile ("config/settings.yml" :: String)) >>= fromMapping + settings <- lookupMapping (show env) allSettings + appPortS <- lookupScalar "appPort" settings + appRootS <- lookupScalar "appRoot" settings + return $ AppConfig { + appEnv = env + , appPort = read $ appPortS + , appRoot = read $ (show appRootS) + } -- | 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. @@ -59,8 +91,8 @@ staticdir = "static" -- have to make a corresponding change here. -- -- To see how this value is used, see urlRenderOverride in ~project~.hs -staticroot :: Text -staticroot = approot `mappend` "/static" +staticRoot :: AppConfig -> Text +staticRoot conf = (appRoot conf) `mappend` "/static" -- The rest of this file contains settings which rarely need changing by a -- user. diff --git a/scaffold/mini/sitearg.hs.cg b/scaffold/mini/sitearg.hs.cg index aee7f6d1..758d4d65 100644 --- a/scaffold/mini/sitearg.hs.cg +++ b/scaffold/mini/sitearg.hs.cg @@ -30,7 +30,7 @@ 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~ - { appEnv :: Settings.AppEnvironment + { settings :: Settings.AppConfig , getStatic :: Static -- ^ Settings for static file serving. } @@ -66,7 +66,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 @@ -77,8 +77,8 @@ instance Yesod ~sitearg~ where -- 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 + urlRenderOverride y (StaticR s) = + Just $ uncurry (joinPath y (Settings.staticRoot $ settings y)) $ renderRoute s urlRenderOverride _ _ = Nothing -- This function creates static content files in the static folder @@ -87,7 +87,7 @@ instance Yesod ~sitearg~ where -- users receiving stale content. addStaticContent ext' _ content = do let fn = base64md5 content ++ '.' : T.unpack ext' - let statictmp = Settings.staticdir ++ "/tmp/" + let statictmp = Settings.staticDir ++ "/tmp/" liftIO $ createDirectoryIfMissing True statictmp let fn' = statictmp ++ fn exists <- liftIO $ doesFileExist fn' diff --git a/scaffold/pconn1.cg b/scaffold/pconn1.cg index ea8ef468..370aa79d 100644 --- a/scaffold/pconn1.cg +++ b/scaffold/pconn1.cg @@ -1,5 +1,5 @@ - user <- lookupScalar "user" - password <- lookupScalar "user" - host <- lookupScalar "host" - port <- lookupScalar "port" - return $ "user=" ++ user ++ "password=" ++ password ++ "host=" ++ host ++ "port=" ++ port ++ "dbname= ++ database" + connPart <- fmap concat $ (flip mapM) ["user", "password", "host", "port"] $ \key -> do + value <- lookupScalar key settings + return $ append (snoc (pack key) '=') (snoc value ' ') + return $ append connPart (append " dbname= " database) + diff --git a/scaffold/project.hs.cg b/scaffold/project.hs.cg index f27521f1..55f9374b 100644 --- a/scaffold/project.hs.cg +++ b/scaffold/project.hs.cg @@ -7,24 +7,20 @@ import System.Console.CmdArgs import Data.Char (toUpper, toLower) #if PRODUCTION -main :: IO () -main = do - args <- cmdArgs argConfig - appEnv <- getAppEnv args - config <- Settings.loadConfig appEnv - let c = if (port args) /= 0 then config {appPort = (port args) } else config - with~sitearg~ c $ run (appPort c) - #else - import System.IO (hPutStrLn, stderr) import Network.Wai.Middleware.Debug (debug) +#endif + main :: IO () main = do args <- cmdArgs argConfig appEnv <- getAppEnv args config <- Settings.loadConfig appEnv let c = if (port args) /= 0 then config {appPort = (port args) } else config +#if PRODUCTION + with~sitearg~ c $ run (appPort c) +#else hPutStrLn stderr $ (show appEnv) ++ " application launched, listening on port " ++ show (appPort c) with~sitearg~ c $ run (appPort c) . debug #endif diff --git a/tests/mini-input.txt b/tests/mini-input.txt new file mode 100644 index 00000000..079224e8 --- /dev/null +++ b/tests/mini-input.txt @@ -0,0 +1,4 @@ +Michael +foobar +Foobar +m diff --git a/tests/postgresql-input.txt b/tests/postgresql-input.txt new file mode 100644 index 00000000..ad38e160 --- /dev/null +++ b/tests/postgresql-input.txt @@ -0,0 +1,4 @@ +Michael +foobar +Foobar +p diff --git a/tests/runscaffold.sh b/tests/runscaffold.sh index 261dc7eb..6ec79864 100755 --- a/tests/runscaffold.sh +++ b/tests/runscaffold.sh @@ -1,4 +1,3 @@ -#!/bin/sh +#!/bin/bash -x -cabal clean && cabal install && - rm -rf foobar && runghc scaffold.hs init < tests/sample-input.txt && cd foobar && cabal install && cabal install -fdevel && cd .. + rm -rf foobar && runghc scaffold.hs init && cd foobar && cabal install && cabal install -fdevel && cd .. diff --git a/tests/sample-input.txt b/tests/sqlite-input.txt similarity index 100% rename from tests/sample-input.txt rename to tests/sqlite-input.txt