diff --git a/yesod-default/Yesod/Default/Config.hs b/yesod-default/Yesod/Default/Config.hs index 73967342..4de336ac 100644 --- a/yesod-default/Yesod/Default/Config.hs +++ b/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 diff --git a/yesod-default/yesod-default.cabal b/yesod-default/yesod-default.cabal index e449e653..80838f6c 100644 --- a/yesod-default/yesod-default.cabal +++ b/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) diff --git a/yesod/Scaffolding/Scaffolder.hs b/yesod/Scaffolding/Scaffolder.hs index 602381b7..9777d900 100644 --- a/yesod/Scaffolding/Scaffolder.hs +++ b/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 diff --git a/yesod/scaffold/Application.hs.cg b/yesod/scaffold/Application.hs.cg index deae37ec..c1710188 100644 --- a/yesod/scaffold/Application.hs.cg +++ b/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 } diff --git a/yesod/scaffold/Foundation.hs.cg b/yesod/scaffold/Foundation.hs.cg index 99c9422f..0c10fa5b 100644 --- a/yesod/scaffold/Foundation.hs.cg +++ b/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: diff --git a/yesod/scaffold/Settings.hs.cg b/yesod/scaffold/Settings.hs.cg index 8caaf294..9f57f34d 100644 --- a/yesod/scaffold/Settings.hs.cg +++ b/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 -loadExtra _ _ = return Extra +parseExtra :: DefaultEnv -> Object -> Parser Extra +parseExtra _ o = Extra <$> o .: "copyright" diff --git a/yesod/scaffold/config/settings.yml.cg b/yesod/scaffold/config/settings.yml.cg index 816a2db6..98eb297f 100644 --- a/yesod/scaffold/config/settings.yml.cg +++ b/yesod/scaffold/config/settings.yml.cg @@ -1,6 +1,7 @@ Default: &defaults host: "localhost" port: 3000 + copyright: Insert copyright statement here Development: <<: *defaults diff --git a/yesod/scaffold/main.hs.cg b/yesod/scaffold/main.hs.cg index 647e84c7..6238c204 100644 --- a/yesod/scaffold/main.hs.cg +++ b/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~ diff --git a/yesod/scaffold/templates/default-layout-wrapper.hamlet.cg b/yesod/scaffold/templates/default-layout-wrapper.hamlet.cg index c411272c..9eb5ec90 100644 --- a/yesod/scaffold/templates/default-layout-wrapper.hamlet.cg +++ b/yesod/scaffold/templates/default-layout-wrapper.hamlet.cg @@ -1,8 +1,8 @@ !!! -