A bunch of scaffolding changes

yesod-default/Yesod/Default/Config.hs

@@ -55,13 +55,13 @@ fromArgs = fromArgsExtra (const $ const $ return ())
 
 -- | Same as 'fromArgs', but allows you to specify how to parse the 'appExtra'
 -- record.
-fromArgsExtra :: (DefaultEnv -> Value -> IO extra)
+fromArgsExtra :: (DefaultEnv -> Object -> Parser extra)
               -> IO (AppConfig DefaultEnv extra)
 fromArgsExtra = fromArgsWith defaultArgConfig
 
 fromArgsWith :: (Read env, Show env)
              => ArgConfig
-             -> (env -> Value -> IO extra)
+             -> (env -> Object -> Parser extra)
              -> IO (AppConfig env extra)
 fromArgsWith argConfig getExtra = do
     args   <- cmdArgs argConfig
@@ -72,7 +72,7 @@ fromArgsWith argConfig getExtra = do
             [] -> error $ "Invalid environment: " ++ environment args
 
     let cs = (configSettings env)
-                { csLoadExtra = getExtra
+                { csParseExtra = getExtra
                 }
     config <- loadConfig cs
 
@@ -103,7 +103,7 @@ data ConfigSettings environment extra = ConfigSettings
     -- environment. Usually, you will use 'DefaultEnv' for this type.
        csEnv :: environment
     -- | Load any extra data, to be used by the application.
-    , csLoadExtra :: environment -> Value -> IO extra
+    , csParseExtra :: environment -> Object -> Parser extra
     -- | Return the path to the YAML config file.
     , csFile :: environment -> IO FilePath
     -- | Get the sub-object (if relevant) from the given YAML source which
@@ -115,7 +115,7 @@ data ConfigSettings environment extra = ConfigSettings
 configSettings :: Show env => env -> ConfigSettings env ()
 configSettings env0 = ConfigSettings
     { csEnv = env0
-    , csLoadExtra = \_ _ -> return ()
+    , csParseExtra = \_ _ -> return ()
     , csFile = \_ -> return "config/settings.yml"
     , csGetObject = \env v -> do
         envs <-
@@ -161,7 +161,7 @@ configSettings env0 = ConfigSettings
 --
 loadConfig :: ConfigSettings environment extra
            -> IO (AppConfig environment extra)
-loadConfig (ConfigSettings env loadExtra getFile getObject) = do
+loadConfig (ConfigSettings env parseExtra getFile getObject) = do
     fp <- getFile env
     mtopObj <- decodeFile fp
     topObj <- maybe (fail "Invalid YAML file") return mtopObj
@@ -173,14 +173,14 @@ loadConfig (ConfigSettings env loadExtra getFile getObject) = do
 
     let mssl     = lookupScalar "ssl"     m
     let mhost    = lookupScalar "host"    m
-    let mport    = lookupScalar "port"    m
+    mport <- parseMonad (\x -> x .: "port") m
     let mapproot = lookupScalar "approot" m
 
-    extra <- loadExtra env obj
+    extra <- parseMonad (parseExtra env) m
 
     -- set some default arguments
     let ssl = maybe False toBool mssl
-    port' <- safeRead "port" $ fromMaybe (if ssl then "443" else "80") mport
+    let port' = fromMaybe (if ssl then 443 else 80) mport
 
     approot <- case (mhost, mapproot) of
         (_        , Just ar) -> return ar
@@ -212,14 +212,6 @@ loadConfig (ConfigSettings env loadExtra getFile getObject) = do
         addPort False 80  = ""
         addPort _     p   = T.pack $ ':' : show p
 
--- | Returns 'fail' if read fails
-safeRead :: Monad m => String -> Text -> m Int
-safeRead name' t = case reads s of
-    (i, _):_ -> return i
-    []       -> fail $ concat ["Invalid value for ", name', ": ", s]
-  where
-    s = T.unpack t
-
 -- | Loads the configuration block in the passed file named by the
 --   passed environment, yeilds to the passed function as a mapping.
 --
@@ -228,12 +220,12 @@ safeRead name' t = case reads s of
 withYamlEnvironment :: Show e
                     => FilePath -- ^ the yaml file
                     -> e        -- ^ the environment you want to load
-                    -> (Value -> IO a) -- ^ what to do with the mapping
+                    -> (Value -> Parser a) -- ^ what to do with the mapping
                     -> IO a
 withYamlEnvironment fp env f = do
     mval <- decodeFile fp
     case mval of
         Nothing -> fail $ "Invalid YAML file: " ++ show fp
         Just (Object obj)
-            | Just v <- M.lookup (T.pack $ show env) obj -> f v
+            | Just v <- M.lookup (T.pack $ show env) obj -> parseMonad f v
         _ -> fail $ "Could not find environment: " ++ show env

yesod-default/yesod-default.cabal

@@ -30,7 +30,7 @@ library
                    , shakespeare-css       >= 0.10.5 && < 0.11
                    , shakespeare-js        >= 0.10.4 && < 0.11
                    , template-haskell
-                   , yaml                  >= 0.5      && < 0.6
+                   , yaml                  >= 0.5.1.1  && < 0.6
                    , unordered-containers
 
     if !os(windows)

yesod/Scaffolding/Scaffolder.hs

@@ -84,7 +84,7 @@ scaffold = do
     let runMigration  =
           case backend of
             MongoDB -> ""
-            _ -> "\n        Database.Persist.Base.runPool dbconf (runMigration migrateAll) p"
+            _ -> "\n        Database.Persist.Store.runPool dbconf (runMigration migrateAll) p"
 
     let importMigration =
           case backend of

yesod/scaffold/Application.hs.cg

@@ -37,7 +37,7 @@ with~sitearg~ :: AppConfig DefaultEnv Extra -> Logger -> (Application -> IO ())
 with~sitearg~ conf logger f = do
     s <- staticSite
     dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf)
-            $ either error return . Database.Persist.Store.loadConfig
+              Database.Persist.Store.loadConfig
     Database.Persist.Store.withPool (dbconf :: Settings.PersistConfig) $ \p -> do~runMigration~
         let h = ~sitearg~ conf logger s p
         defaultRunner (f . logWare) h
@@ -54,6 +54,6 @@ withDevelAppPort =
     toDyn $ defaultDevelAppWith loader  with~sitearg~
   where
     loader = loadConfig (configSettings Development)
-        { csLoadExtra = loadExtra
+        { csParseExtra = parseExtra
         }
 

yesod/scaffold/Foundation.hs.cg

@@ -31,7 +31,7 @@ import qualified Settings
 import qualified Data.ByteString.Lazy as L
 import qualified Database.Persist.Store
 import Database.Persist.~importGenericDB~
-import Settings (widgetFile, Extra)
+import Settings (widgetFile, Extra (..))
 import Model
 import Text.Jasmine (minifym)
 import Web.ClientSession (getKey)
@@ -88,6 +88,7 @@ instance Yesod ~sitearg~ where
     encryptKey _ = fmap Just $ getKey "config/client_session_key.aes"
 
     defaultLayout widget = do
+        y <- getYesod
         mmsg <- getMessage
 
         -- We break up the default layout into two components:

yesod/scaffold/Settings.hs.cg

@@ -9,7 +9,7 @@ module Settings
     , staticRoot
     , staticDir
     , Extra (..)
-    , loadExtra
+    , parseExtra
     ) where
 
 import Prelude
@@ -20,6 +20,7 @@ import Yesod.Default.Config
 import qualified Yesod.Default.Util
 import Data.Text (Text)
 import Data.Yaml
+import Control.Applicative
 
 -- | Which Persistent backend this site is using.
 type PersistConfig = ~configPersist~
@@ -59,7 +60,9 @@ widgetFile = Yesod.Default.Util.widgetFileNoReload
 #endif
 
 data Extra = Extra
+    { extraCopyright :: Text
+    }
 
-loadExtra :: DefaultEnv -> Value -> IO Extra
+parseExtra :: DefaultEnv -> Object -> Parser Extra
-loadExtra _ _ = return Extra
+parseExtra _ o = Extra <$> o .: "copyright"
 

yesod/scaffold/config/settings.yml.cg

@@ -1,6 +1,7 @@
 Default: &defaults
   host: "localhost"
   port: 3000
+  copyright: Insert copyright statement here
 
 Development:
   <<: *defaults

yesod/scaffold/main.hs.cg

@@ -1,8 +1,8 @@
 import Prelude              (IO)
 import Yesod.Default.Config (fromArgsExtra)
 import Yesod.Default.Main   (defaultMain)
-import Settings             (loadExtra)
+import Settings             (parseExtra)
 import Application          (with~sitearg~)
 
 main :: IO ()
-main = defaultMain (fromArgsExtra loadExtra) with~sitearg~
+main = defaultMain (fromArgsExtra parseExtra) with~sitearg~

yesod/scaffold/templates/default-layout-wrapper.hamlet.cg

@@ -1,8 +1,8 @@
 !!!
 <html>
-    <head
+    <head>
         <title>#{pageTitle pc}
         ^{pageHead pc}
-    <body
+    <body>
         ^{pageBody pc}
 

yesod/scaffold/templates/default-layout.hamlet.cg

@@ -1,4 +1,6 @@
 $maybe msg <- mmsg
     <div #message>#{msg}
 ^{widget}
+<footer>
+    #{extraCopyright $ appExtra $ settings y}
 

yesod/scaffold/tiny/Application.hs.cg

@@ -5,7 +5,7 @@ module Application
     ) where
 
 import Import
-import Settings (loadExtra)
+import Settings (parseExtra)
 import Settings.StaticFiles (staticSite)
 import Yesod.Default.Config
 import Yesod.Default.Main (defaultDevelAppWith, defaultRunner)
@@ -38,6 +38,6 @@ withDevelAppPort =
     toDyn $ defaultDevelAppWith loader with~sitearg~
   where
     loader = loadConfig (configSettings Development)
-        { csLoadExtra = loadExtra
+        { csParseExtra = parseExtra
         }
 

yesod/scaffold/tiny/Foundation.hs.cg

@@ -19,7 +19,7 @@ import Yesod.Static (Static, base64md5, StaticRoute(..))
 import Settings.StaticFiles
 import Yesod.Logger (Logger, logMsg, formatLogText)
 import qualified Settings
-import Settings (Extra, widgetFile)
+import Settings (Extra (..), widgetFile)
 import Control.Monad.IO.Class (liftIO)
 import Web.ClientSession (getKey)
 import Text.Hamlet (hamletFile)
@@ -67,6 +67,7 @@ instance Yesod ~sitearg~ where
     encryptKey _ = fmap Just $ getKey "config/client_session_key.aes"
 
     defaultLayout widget = do
+        y <- getYesod
         mmsg <- getMessage
 
         -- We break up the default layout into two components:

yesod/scaffold/tiny/Settings.hs.cg

@@ -8,7 +8,7 @@ module Settings
     , staticRoot
     , staticDir
     , Extra (..)
-    , loadExtra
+    , parseExtra
     ) where
 
 import Prelude
@@ -18,6 +18,7 @@ import Yesod.Default.Config
 import qualified Yesod.Default.Util
 import Data.Text (Text)
 import Data.Yaml
+import Control.Applicative
 
 -- | The location of static files on your system. This is a file system
 -- path. The default value works properly with your scaffolded site.
@@ -48,6 +49,9 @@ widgetFile = Yesod.Default.Util.widgetFileNoReload
 #endif
 
 data Extra = Extra
+    { extraCopyright :: Text
+    }
+
+parseExtra :: DefaultEnv -> Object -> Parser Extra
+parseExtra _ o = Extra <$> o .: "copyright"
 
-loadExtra :: DefaultEnv -> Value -> IO Extra
-loadExtra _ _ = return Extra