From 7452726d40c5faf052501a3ebd0373cf387a7f35 Mon Sep 17 00:00:00 2001
From: Greg Weber <greg@gregweber.info>
Date: Wed, 6 Jul 2011 20:14:30 -0700
Subject: [PATCH 1/6] add a Settings.yaml file for dynamic settings

also command line to check for environment argument
---
 scaffold/Controller_hs.cg              |  18 +++--
 scaffold/Settings_hs.cg                | 104 ++++++++++++++++---------
 scaffold/Settings_yaml.cg              |  16 ++++
 scaffold/cabal.cg                      |   4 +-
 scaffold/mini-Controller_hs.cg         |   8 +-
 scaffold/mini-cabal.cg                 |   2 +
 scaffold/mini-sitearg_hs.cg            |   3 +-
 scaffold/sitearg_hs.cg                 |  13 ++--
 scaffold/test_hs.cg                    |  47 +++++++++--
 tests/runscaffold.sh                   |   6 ++
 tests/sample-input.txt                 |   4 +
 test.shelltest => tests/test.shelltest |   0
 12 files changed, 163 insertions(+), 62 deletions(-)
 create mode 100644 scaffold/Settings_yaml.cg
 create mode 100755 tests/runscaffold.sh
 create mode 100644 tests/sample-input.txt
 rename test.shelltest => tests/test.shelltest (100%)

diff --git a/scaffold/Controller_hs.cg b/scaffold/Controller_hs.cg
index 324816ee..f6d8c961 100644
--- a/scaffold/Controller_hs.cg
+++ b/scaffold/Controller_hs.cg
@@ -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 ())
 
diff --git a/scaffold/Settings_hs.cg b/scaffold/Settings_hs.cg
index d4d35ac0..a84c3c9d 100644
--- a/scaffold/Settings_hs.cg
+++ b/scaffold/Settings_hs.cg
@@ -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
diff --git a/scaffold/Settings_yaml.cg b/scaffold/Settings_yaml.cg
new file mode 100644
index 00000000..314b7bce
--- /dev/null
+++ b/scaffold/Settings_yaml.cg
@@ -0,0 +1,16 @@
+Default: &default
+  appRoot: http://localhost
+  appPort: 3000
+  connectionPoolLimit: 10
+
+Development:
+  <<: *defaults
+
+Test:
+  <<: *defaults
+
+Staging:
+  <<: *defaults
+
+Production:
+  <<: *defaults
diff --git a/scaffold/cabal.cg b/scaffold/cabal.cg
index 84d0e91f..fce1f917 100644
--- a/scaffold/cabal.cg
+++ b/scaffold/cabal.cg
@@ -62,6 +62,8 @@ executable         ~project~
                  , hamlet
                  , hjsmin
                  , transformers
+                 , data-object
+                 , data-object-yaml
                  , warp
                  , blaze-builder
-
+                 , cmdargs
diff --git a/scaffold/mini-Controller_hs.cg b/scaffold/mini-Controller_hs.cg
index 36999c82..c4947ee9 100644
--- a/scaffold/mini-Controller_hs.cg
+++ b/scaffold/mini-Controller_hs.cg
@@ -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 ())
 
diff --git a/scaffold/mini-cabal.cg b/scaffold/mini-cabal.cg
index 7e69d651..09793f79 100644
--- a/scaffold/mini-cabal.cg
+++ b/scaffold/mini-cabal.cg
@@ -55,6 +55,8 @@ executable         ~project~
                  , template-haskell
                  , hamlet
                  , transformers
+                 , data-object
+                 , data-object-yaml
                  , wai
                  , warp
                  , blaze-builder
diff --git a/scaffold/mini-sitearg_hs.cg b/scaffold/mini-sitearg_hs.cg
index 2d94cc5d..aee7f6d1 100644
--- a/scaffold/mini-sitearg_hs.cg
+++ b/scaffold/mini-sitearg_hs.cg
@@ -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
diff --git a/scaffold/sitearg_hs.cg b/scaffold/sitearg_hs.cg
index a80a3acb..a39a6f71 100644
--- a/scaffold/sitearg_hs.cg
+++ b/scaffold/sitearg_hs.cg
@@ -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'
diff --git a/scaffold/test_hs.cg b/scaffold/test_hs.cg
index 35527958..a3028000 100644
--- a/scaffold/test_hs.cg
+++ b/scaffold/test_hs.cg
@@ -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
diff --git a/tests/runscaffold.sh b/tests/runscaffold.sh
new file mode 100755
index 00000000..0c81955f
--- /dev/null
+++ b/tests/runscaffold.sh
@@ -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
diff --git a/tests/sample-input.txt b/tests/sample-input.txt
new file mode 100644
index 00000000..6b02a6e9
--- /dev/null
+++ b/tests/sample-input.txt
@@ -0,0 +1,4 @@
+Michael
+foobar
+Foobar
+s
diff --git a/test.shelltest b/tests/test.shelltest
similarity index 100%
rename from test.shelltest
rename to tests/test.shelltest

From 942590a9e3a1726d7020ae3eea8ca83379ca8937 Mon Sep 17 00:00:00 2001
From: Greg Weber <greg@gregweber.info>
Date: Sun, 10 Jul 2011 08:12:28 -0700
Subject: [PATCH 2/6] fix option parsing & settings

---
 scaffold.hs               |  1 +
 scaffold/Settings_hs.cg   |  4 ++--
 scaffold/Settings_yaml.cg |  4 ++--
 scaffold/test_hs.cg       | 46 ++++++++++++++++++++++-----------------
 tests/runscaffold.sh      |  4 +---
 5 files changed, 32 insertions(+), 27 deletions(-)

diff --git a/scaffold.hs b/scaffold.hs
index 49f68ea2..8e647aaa 100644
--- a/scaffold.hs
+++ b/scaffold.hs
@@ -100,6 +100,7 @@ scaffold = do
     mkDir "static/css"
     mkDir "config"
 
+    writeFile' ("config/Settings.yaml") $(codegen "Settings_yaml")
     writeFile' ("config/" ++ project ++ ".hs") $(codegen "test_hs")
     writeFile' (project ++ ".cabal") $ if backendS == "m" then $(codegen "mini-cabal") else $(codegen "cabal")
     writeFile' ".ghci" $(codegen "dotghci")
diff --git a/scaffold/Settings_hs.cg b/scaffold/Settings_hs.cg
index a84c3c9d..e5624603 100644
--- a/scaffold/Settings_hs.cg
+++ b/scaffold/Settings_hs.cg
@@ -76,7 +76,7 @@ data AppConfig = AppConfig {
 
 loadConfig :: AppEnvironment -> IO AppConfig
 loadConfig env = do
-    allSettings <- (join $ decodeFile ("Settings.yaml" :: String)) >>= fromMapping
+    allSettings <- (join $ decodeFile ("config/Settings.yaml" :: String)) >>= fromMapping
     settings <- lookupMapping (show env) allSettings
     appPortS <- lookupScalar "appPort" settings
     appRootS <- lookupScalar "appRoot" settings
@@ -84,7 +84,7 @@ loadConfig env = do
     return $ AppConfig {
       appEnv = env
     , appPort = read $ appPortS
-    , appRoot = read $ appRootS
+    , appRoot = read $ (show appRootS)
     , connectionPoolSize = read $ connectionPoolSizeS
     }
 
diff --git a/scaffold/Settings_yaml.cg b/scaffold/Settings_yaml.cg
index 314b7bce..38053042 100644
--- a/scaffold/Settings_yaml.cg
+++ b/scaffold/Settings_yaml.cg
@@ -1,7 +1,7 @@
-Default: &default
+Default: &defaults
   appRoot: http://localhost
   appPort: 3000
-  connectionPoolLimit: 10
+  connectionPoolSize: 10
 
 Development:
   <<: *defaults
diff --git a/scaffold/test_hs.cg b/scaffold/test_hs.cg
index a3028000..072be746 100644
--- a/scaffold/test_hs.cg
+++ b/scaffold/test_hs.cg
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP, DeriveDataTypeable #-}
 import qualified Settings as Settings
+import Settings (AppConfig(..))
 import Controller (with~sitearg~)
 import Network.Wai.Handler.Warp (run)
 import System.Console.CmdArgs
@@ -8,44 +9,49 @@ import Data.Char (toUpper, toLower)
 #if PRODUCTION
 main :: IO ()
 main = do
-    appEnv <- getAppEnv
+    args <- cmdArgs argConfig
+    appEnv <- getAppEnv args
     config <- Settings.loadConfig appEnv
-    with~sitearg~ config $ run (Settings.appPort settings)
+    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)
-
 main :: IO ()
 main = do
-    appEnv <- getAppEnv
+    args <- cmdArgs argConfig
+    appEnv <- getAppEnv args
     config <- Settings.loadConfig appEnv
-    hPutStrLn stderr $ "Application launched, listening on port " ++ show (Settings.appPort config)
-    with~sitearg~ config $ run (Settings.appPort config) . debug
+    let c = if (port args) /= 0 then config {appPort = (port args) } else config
+    do hPutStrLn stderr $ "Application launched, listening on port " ++ show (appPort c)
+       with~sitearg~ c $ run (appPort c) . debug
 #endif
 
-data ArgConfig = ArgConfig {environment :: String}
+data ArgConfig = ArgConfig {environment :: String, port :: Int}
                  deriving (Show, Data, Typeable)
 
-config = ArgConfig{ environment = def
-  &= help "application environment, one of:" ++ (foldl1 (++) environments)
+argConfig = ArgConfig{ environment = def 
+  &= help ("application environment, one of: " ++ (foldl1 (\a b -> a ++ ", " ++ b) environments))
   &= typ "ENVIRONMENT"
-#if PRODUCTION
-  &= opt "production"
-#else
-  &= opt "development"
-#endif
+  ,port = def &= typ "PORT"
 }
 
 environments :: [String]
-environments = map show ([minBound..maxBound] :: [Settings.AppEnvironment])
-
+environments = map ((map toLower) . show) ([minBound..maxBound] :: [Settings.AppEnvironment])
 
 -- | retrieve the -e environment option
-getAppEnv :: IO Settings.AppEnvironment
-getAppEnv = do
-    cfg <- cmdArgs config
-    return $ read $ capitalize $ environment cfg
+getAppEnv :: ArgConfig ->  IO Settings.AppEnvironment
+getAppEnv cfg = do
+    let e = if (environment cfg) /= "" then (environment cfg)
+            else
+#if PRODUCTION
+                  "production"
+#else
+                  "development"
+#endif
+    return $ read $ capitalize e
   where
     capitalize [] = []
     capitalize (x:xs) = toUpper x : map toLower xs
diff --git a/tests/runscaffold.sh b/tests/runscaffold.sh
index 0c81955f..261dc7eb 100755
--- a/tests/runscaffold.sh
+++ b/tests/runscaffold.sh
@@ -1,6 +1,4 @@
 #!/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
+  rm -rf foobar && runghc scaffold.hs init < tests/sample-input.txt && cd foobar && cabal install && cabal install -fdevel && cd ..

From 0e36cd0e06fd8991370b5f2eb08e35b9e1d58ddb Mon Sep 17 00:00:00 2001
From: Greg Weber <greg@gregweber.info>
Date: Sun, 10 Jul 2011 08:42:09 -0700
Subject: [PATCH 3/6] more documentation

---
 scaffold/Settings_hs.cg | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/scaffold/Settings_hs.cg b/scaffold/Settings_hs.cg
index e5624603..ba44a3aa 100644
--- a/scaffold/Settings_hs.cg
+++ b/scaffold/Settings_hs.cg
@@ -43,8 +43,13 @@ data AppEnvironment = Test
                     | 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
+-- | 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
 
@@ -72,7 +77,7 @@ data AppConfig = AppConfig {
     -- you would probably want it to be:
     -- > "http://yesod.com"
   , appRoot :: Text
-}
+} deriving (Show)
 
 loadConfig :: AppEnvironment -> IO AppConfig
 loadConfig env = do

From 642a9bfde29e138ea7386fe8f486a8cd6769bdde Mon Sep 17 00:00:00 2001
From: Greg Weber <greg@gregweber.info>
Date: Sun, 10 Jul 2011 08:49:01 -0700
Subject: [PATCH 4/6] show env in launching string

---
 scaffold/test_hs.cg | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/scaffold/test_hs.cg b/scaffold/test_hs.cg
index 072be746..2e54d119 100644
--- a/scaffold/test_hs.cg
+++ b/scaffold/test_hs.cg
@@ -25,7 +25,7 @@ main = do
     appEnv <- getAppEnv args
     config <- Settings.loadConfig appEnv
     let c = if (port args) /= 0 then config {appPort = (port args) } else config
-    do hPutStrLn stderr $ "Application launched, listening on port " ++ show (appPort c)
+    do hPutStrLn stderr $ (show appEnv) ++ " application launched, listening on port " ++ show (appPort c)
        with~sitearg~ c $ run (appPort c) . debug
 #endif
 

From 193b74b9aa64fad66a7501e318c2aa331f66f11d Mon Sep 17 00:00:00 2001
From: Greg Weber <greg@gregweber.info>
Date: Mon, 11 Jul 2011 10:20:27 -0700
Subject: [PATCH 5/6] make database settings configurable

---
 development.md                                |  5 ++
 scaffold.hs                                   | 17 +++---
 scaffold/Settings_hs.cg                       | 54 ++++++++++---------
 scaffold/cabal.cg                             |  2 +-
 scaffold/pconn1.cg                            |  6 ++-
 scaffold/pconn2.cg                            |  1 -
 scaffold/postgresql_yml.cg                    | 21 ++++++++
 .../{Settings_yaml.cg => settings_yml.cg}     |  0
 scaffold/sqlite_yml.cg                        | 17 ++++++
 scaffold/test_hs.cg                           |  4 +-
 tests/{test.shelltest => scaffold.shelltest}  |  0
 11 files changed, 92 insertions(+), 35 deletions(-)
 create mode 100644 development.md
 delete mode 100644 scaffold/pconn2.cg
 create mode 100644 scaffold/postgresql_yml.cg
 rename scaffold/{Settings_yaml.cg => settings_yml.cg} (100%)
 create mode 100644 scaffold/sqlite_yml.cg
 rename tests/{test.shelltest => scaffold.shelltest} (100%)

diff --git a/development.md b/development.md
new file mode 100644
index 00000000..c9b5b7b8
--- /dev/null
+++ b/development.md
@@ -0,0 +1,5 @@
+# Scaffolding
+
+## Test suite
+
+  shelltest test/scaffold.shelltest
diff --git a/scaffold.hs b/scaffold.hs
index 8e647aaa..fead50e9 100644
--- a/scaffold.hs
+++ b/scaffold.hs
@@ -73,12 +73,11 @@ scaffold = do
     puts $(codegen "database")
     backendS <- prompt $ flip elem ["s", "p", "m"]
     let pconn1 = $(codegen "pconn1")
-    let pconn2 = $(codegen "pconn2")
-    let (lower, upper, connstr1, connstr2, importDB) =
+    let (backendLower, upper, connstr, importDB) =
             case backendS of
-                "s" -> ("sqlite", "Sqlite", "debug.db3", "production.db3", "import Database.Persist.Sqlite\n")
-                "p" -> ("postgresql", "Postgresql", pconn1, pconn2, "import Database.Persist.Postgresql\n")
-                "m" -> ("FIXME lower", "FIXME upper", "FIXME connstr1", "FIXME connstr2", "")
+                "s" -> ("sqlite", "Sqlite", "    return database", "import Database.Persist.Sqlite\n")
+                "p" -> ("postgresql", "Postgresql", pconn1, "import Database.Persist.Postgresql\n")
+                "m" -> ("FIXME lower", "FIXME upper", "FIXME connstr1", "")
                 _ -> error $ "Invalid backend: " ++ backendS
 
     putStrLn "That's it! I'm creating your files now..."
@@ -100,7 +99,13 @@ scaffold = do
     mkDir "static/css"
     mkDir "config"
 
-    writeFile' ("config/Settings.yaml") $(codegen "Settings_yaml")
+    case backendS of
+        "s" -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen ("sqlite_yml"))
+        "p" -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen ("postgresql_yml"))
+        "m" -> return ()
+        _ -> error $ "Invalid backend: " ++ backendS
+
+    writeFile' ("config/settings.yml") $(codegen "settings_yml")
     writeFile' ("config/" ++ project ++ ".hs") $(codegen "test_hs")
     writeFile' (project ++ ".cabal") $ if backendS == "m" then $(codegen "mini-cabal") else $(codegen "cabal")
     writeFile' ".ghci" $(codegen "dotghci")
diff --git a/scaffold/Settings_hs.cg b/scaffold/Settings_hs.cg
index ba44a3aa..5641eeed 100644
--- a/scaffold/Settings_hs.cg
+++ b/scaffold/Settings_hs.cg
@@ -12,7 +12,6 @@ module Settings
     , juliusFile
     , luciusFile
     , widgetFile
-    , connStr
     , ConnectionPool
     , withConnectionPool
     , runConnectionPool
@@ -29,12 +28,12 @@ import qualified Text.Julius as H
 import qualified Text.Lucius as H
 import Language.Haskell.TH.Syntax
 ~importDB~
-import Yesod (MonadControlIO, addWidget, addCassius, addJulius, addLucius)
+import Yesod (liftIO, 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 qualified Data.Object.Yaml as YAML
 import Control.Monad (join)
 
 data AppEnvironment = Test
@@ -81,7 +80,7 @@ data AppConfig = AppConfig {
 
 loadConfig :: AppEnvironment -> IO AppConfig
 loadConfig env = do
-    allSettings <- (join $ decodeFile ("config/Settings.yaml" :: String)) >>= fromMapping
+    allSettings <- (join $ YAML.decodeFile ("config/settings.yml" :: String)) >>= fromMapping
     settings <- lookupMapping (show env) allSettings
     appPortS <- lookupScalar "appPort" settings
     appRootS <- lookupScalar "appRoot" settings
@@ -117,19 +116,36 @@ staticRoot :: AppConfig ->  Text
 staticRoot conf = (appRoot conf) `mappend` "/static"
 
 
--- | The database connection string. The meaning of this string is backend-
--- specific.
-connStr :: Text
-connStr =
-#ifdef PRODUCTION
-  "~connstr2~"
-#else
-  "~connstr1~"
-#endif
-
 -- The rest of this file contains settings which rarely need changing by a
 -- user.
 
+-- The next functions are for allocating a connection pool and running
+-- database actions using a pool, respectively. It is used internally
+-- by the scaffolded application, and therefore you will rarely need to use
+-- them yourself.
+runConnectionPool :: MonadControlIO m => SqlPersist m a -> ConnectionPool -> m a
+runConnectionPool = runSqlPool
+
+-- | The database connection string. The meaning of this string is backend-
+-- specific.
+loadConnStr :: AppEnvironment -> IO Text
+loadConnStr env = do
+    allSettings <- (join $ YAML.decodeFile ("config/~backendLower~.yml" :: String)) >>= fromMapping
+    settings <- lookupMapping (show env) allSettings
+    database <- lookupScalar "database" settings
+~connstr~
+
+withConnectionPool :: MonadControlIO m => AppConfig -> (ConnectionPool -> m a) -> m a
+withConnectionPool conf f = do
+    cs <- liftIO $ loadConnStr (appEnv conf)
+    with~upper~Pool cs (connectionPoolSize conf) f
+
+-- Example of making a dynamic configuration static
+-- use /return $(mkConnStr Production)/ instead of loadConnStr
+-- mkConnStr :: AppEnvironment -> Q Exp
+-- mkConnStr env = qRunIO (loadConnStr env) >>= return . LitE . StringL
+
+
 -- The following three functions are used for calling HTML, CSS and
 -- Javascript templates from your Haskell code. During development,
 -- the "Debug" versions of these functions are used so that changes to
@@ -185,13 +201,3 @@ widgetFile x = do
     unlessExists tofn f = do
         e <- qRunIO $ doesFileExist $ tofn x
         if e then f x else [|mempty|]
-
--- The next two functions are for allocating a connection pool and running
--- 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 => 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
diff --git a/scaffold/cabal.cg b/scaffold/cabal.cg
index fce1f917..b58eaf07 100644
--- a/scaffold/cabal.cg
+++ b/scaffold/cabal.cg
@@ -57,7 +57,7 @@ executable         ~project~
                  , text
                  , persistent
                  , persistent-template
-                 , persistent-~lower~ >= 0.5 && < 0.6
+                 , persistent-~backendLower~ >= 0.5 && < 0.6
                  , template-haskell
                  , hamlet
                  , hjsmin
diff --git a/scaffold/pconn1.cg b/scaffold/pconn1.cg
index 2fbf5964..ea8ef468 100644
--- a/scaffold/pconn1.cg
+++ b/scaffold/pconn1.cg
@@ -1 +1,5 @@
-user=~project~ password=~project~ host=localhost port=5432 dbname=~project~_debug
+    user <- lookupScalar "user"
+    password <- lookupScalar "user"
+    host <- lookupScalar "host"
+    port <- lookupScalar "port"
+    return $ "user=" ++ user ++ "password=" ++ password ++ "host=" ++ host ++ "port=" ++ port ++ "dbname= ++ database"
diff --git a/scaffold/pconn2.cg b/scaffold/pconn2.cg
deleted file mode 100644
index 5dbfefe0..00000000
--- a/scaffold/pconn2.cg
+++ /dev/null
@@ -1 +0,0 @@
-user=~project~ password=~project~ host=localhost port=5432 dbname=~project~_production
diff --git a/scaffold/postgresql_yml.cg b/scaffold/postgresql_yml.cg
new file mode 100644
index 00000000..a9f18e51
--- /dev/null
+++ b/scaffold/postgresql_yml.cg
@@ -0,0 +1,21 @@
+Default: &defaults
+  adapter: postgres
+  user: ~project~
+  password: ~project~
+  host: localhost
+  port: 5432
+  database: ~project~
+
+Development:
+  <<: *defaults
+
+Test:
+  database: ~project~_test
+  <<: *defaults
+
+Staging:
+  <<: *defaults
+
+Production:
+  database: ~project~_production
+  <<: *defaults
diff --git a/scaffold/Settings_yaml.cg b/scaffold/settings_yml.cg
similarity index 100%
rename from scaffold/Settings_yaml.cg
rename to scaffold/settings_yml.cg
diff --git a/scaffold/sqlite_yml.cg b/scaffold/sqlite_yml.cg
new file mode 100644
index 00000000..1919d640
--- /dev/null
+++ b/scaffold/sqlite_yml.cg
@@ -0,0 +1,17 @@
+Default: &defaults
+  adapter: sqlite
+  database: ~project~.sqlite3
+
+Development:
+  <<: *defaults
+
+Test:
+  database: ~project~_test.sqlite3
+  <<: *defaults
+
+Staging:
+  <<: *defaults
+
+Production:
+  database: ~project~_production.sqlite3
+  <<: *defaults
diff --git a/scaffold/test_hs.cg b/scaffold/test_hs.cg
index 2e54d119..f27521f1 100644
--- a/scaffold/test_hs.cg
+++ b/scaffold/test_hs.cg
@@ -25,8 +25,8 @@ main = do
     appEnv <- getAppEnv args
     config <- Settings.loadConfig appEnv
     let c = if (port args) /= 0 then config {appPort = (port args) } else config
-    do hPutStrLn stderr $ (show appEnv) ++ " application launched, listening on port " ++ show (appPort c)
-       with~sitearg~ c $ run (appPort c) . debug
+    hPutStrLn stderr $ (show appEnv) ++ " application launched, listening on port " ++ show (appPort c)
+    with~sitearg~ c $ run (appPort c) . debug
 #endif
 
 data ArgConfig = ArgConfig {environment :: String, port :: Int}
diff --git a/tests/test.shelltest b/tests/scaffold.shelltest
similarity index 100%
rename from tests/test.shelltest
rename to tests/scaffold.shelltest

From 9075a3a808607c7198b741975ed560361fb71209 Mon Sep 17 00:00:00 2001
From: Greg Weber <greg@gregweber.info>
Date: Mon, 11 Jul 2011 11:30:55 -0700
Subject: [PATCH 6/6] remove adapter

---
 scaffold/postgresql_yml.cg | 1 -
 scaffold/sqlite_yml.cg     | 1 -
 2 files changed, 2 deletions(-)

diff --git a/scaffold/postgresql_yml.cg b/scaffold/postgresql_yml.cg
index a9f18e51..28926dab 100644
--- a/scaffold/postgresql_yml.cg
+++ b/scaffold/postgresql_yml.cg
@@ -1,5 +1,4 @@
 Default: &defaults
-  adapter: postgres
   user: ~project~
   password: ~project~
   host: localhost
diff --git a/scaffold/sqlite_yml.cg b/scaffold/sqlite_yml.cg
index 1919d640..ec25b88e 100644
--- a/scaffold/sqlite_yml.cg
+++ b/scaffold/sqlite_yml.cg
@@ -1,5 +1,4 @@
 Default: &defaults
-  adapter: sqlite
   database: ~project~.sqlite3
 
 Development: