From 933f0086d2621544c27aca5f1f1fa0216c5a73a0 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sat, 24 Sep 2011 21:51:44 +0300 Subject: [PATCH] Scaffolding uses PersistConfig --- yesod-core/Yesod/Config.hs | 114 ++++++------------------------- yesod/Scaffolding/Scaffolder.hs | 27 ++++++-- yesod/scaffold/Application.hs.cg | 6 +- yesod/scaffold/Foundation.hs.cg | 5 +- yesod/scaffold/Settings.hs.cg | 16 ++--- 5 files changed, 57 insertions(+), 111 deletions(-) diff --git a/yesod-core/Yesod/Config.hs b/yesod-core/Yesod/Config.hs index 51216e59..750893fe 100644 --- a/yesod-core/Yesod/Config.hs +++ b/yesod-core/Yesod/Config.hs @@ -1,15 +1,11 @@ +{-# LANGUAGE OverloadedStrings #-} module Yesod.Config ( AppConfig(..) - , PostgresConf(..) - , SqliteConf(..) - , MongoConf(..) , loadConfig - , loadPostgresql - , loadSqlite - , loadMongo + , withYamlEnvironment ) where -import Control.Monad (join, forM) +import Control.Monad (join) import Data.Maybe (fromMaybe) import Data.Object import Data.Object.Yaml @@ -25,28 +21,6 @@ data AppConfig e = AppConfig , appRoot :: Text } deriving (Show) --- separate types means more code here, but it's easier to use in the --- scaffold - --- | Information required to connect to a postgres database -data PostgresConf = PostgresConf - { pgConnStr :: Text - , pgPoolSize :: Int - } - --- | Information required to connect to a sqlite database -data SqliteConf = SqliteConf - { sqlDatabase :: Text - , sqlPoolSize :: Int - } - --- | Information required to connect to a mongo database -data MongoConf = MongoConf - { mgDatabase :: String - , mgHost :: String - , mgPoolSize :: Int - } - -- | Load an @'AppConfig'@ from @config\/settings.yml@. -- -- Some examples: @@ -77,7 +51,8 @@ data MongoConf = MongoConf -- > -- automatically. -- loadConfig :: Show e => e -> IO (AppConfig e) -loadConfig env = withYamlEnvironment "config/settings.yml" env $ \e -> do +loadConfig env = withYamlEnvironment "config/settings.yml" env $ \e' -> do + e <- maybe (fail "Expected map") return $ fromMapping e' let mssl = lookupScalar "ssl" e let mhost = lookupScalar "host" e let mport = lookupScalar "port" e @@ -89,94 +64,49 @@ loadConfig env = withYamlEnvironment "config/settings.yml" env $ \e -> do approot <- case (mhost, mapproot) of (_ , Just ar) -> return ar - (Just host, _ ) -> return $ (if ssl then "https://" else "http://") ++ host ++ (addPort ssl port) + (Just host, _ ) -> return $ T.concat + [ if ssl then "https://" else "http://" + , host + , addPort ssl port + ] _ -> fail "You must supply either a host or approot" return $ AppConfig { appEnv = env , appPort = port - , appRoot = T.pack approot + , appRoot = approot } where - toBool :: String -> Bool + toBool :: Text -> Bool toBool = (`elem` ["true", "TRUE", "yes", "YES", "Y", "1"]) - addPort :: Bool -> Int -> String + addPort :: Bool -> Int -> Text addPort True 443 = "" addPort False 80 = "" - addPort _ p = ":" ++ show p - --- | Load a @'PostgresConf'@ from @config\/postgresql.yml@. --- --- > Production: --- > user: jsmith --- > password: secret --- > host: localhost --- > port: 5432 --- > database: some_db --- > poolsize: 100 --- -loadPostgresql :: Show e => e -> IO PostgresConf -loadPostgresql env = withYamlEnvironment "config/postgresql.yml" env $ \e -> do - db <- lookupScalar "database" e - pool <- safeRead "poolsize" =<< lookupScalar "poolsize" e - - -- TODO: default host/port? - connparts <- forM ["user", "password", "host", "port"] $ \k -> do - v <- lookupScalar k e - return $ k ++ "=" ++ v ++ " " - - conn <- return $ concat connparts - - return $ PostgresConf (T.pack $ conn ++ " dbname=" ++ db) pool - --- | Load a @'SqliteConf'@ from @config\/sqlite.yml@. --- --- > Production: --- > database: foo.s3db --- > poolsize: 100 --- -loadSqlite :: Show e => e -> IO SqliteConf -loadSqlite env = withYamlEnvironment "config/sqlite.yml" env $ \e -> do - db <- lookupScalar "database" e - pool <- safeRead "poolsize" =<< lookupScalar "poolsize" e - - return $ SqliteConf (T.pack db) pool - --- | Load a @'MongoConf'@ from @config\/mongoDB.yml@. --- --- > Production: --- > database: some_db --- > host: localhost --- > poolsize: 100 --- -loadMongo :: Show e => e -> IO MongoConf -loadMongo env = withYamlEnvironment "config/mongoDB.yml" env $ \e -> do - db <- lookupScalar "database" e - host <- lookupScalar "host" e - pool <- safeRead "poolsize" =<< lookupScalar "poolsize" e - - return $ MongoConf db host pool + addPort _ p = T.pack $ ':' : show p -- | Loads the configuration block in the passed file named by the -- passed environment, yeilds to the passed function as a mapping. -- -- Errors in the case of a bad load or if your function returns -- @Nothing@. -withYamlEnvironment :: (IsYamlScalar v, Show e) +withYamlEnvironment :: Show e => FilePath -- ^ the yaml file -> e -- ^ the environment you want to load - -> ([(String, Object String v)] -> IO a) -- ^ what to do with the mapping + -> (TextObject -> IO a) -- ^ what to do with the mapping -> IO a withYamlEnvironment fp env f = do obj <- join $ decodeFile fp envs <- fromMapping obj - conf <- lookupMapping (show env) envs + conf <- maybe (fail $ "Could not find environment: " ++ show env) return + $ lookup (T.pack $ show env) envs f conf -- | Returns 'fail' if read fails -safeRead :: Monad m => String -> String -> m Int -safeRead name s = case reads s of +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 diff --git a/yesod/Scaffolding/Scaffolder.hs b/yesod/Scaffolding/Scaffolder.hs index 5acaf438..120ec18b 100644 --- a/yesod/Scaffolding/Scaffolder.hs +++ b/yesod/Scaffolding/Scaffolder.hs @@ -66,9 +66,9 @@ scaffold = do backendC <- prompt $ flip elem $ map (return . toLower . head . show) backends let (backend, importGenericDB, dbMonad, importPersist, mkPersistSettings) = case backendC of - "s" -> (Sqlite, "GenericSql", "SqlPersist", "Sqlite\n", "sqlSettings") - "p" -> (Postgresql, "GenericSql", "SqlPersist", "Postgresql\n", "sqlSettings") - "m" -> (MongoDB, "MongoDB", "Action", "MongoDB\nimport Control.Applicative (Applicative)\n", "MkPersistSettings { mpsBackend = ConT ''Action }") + "s" -> (Sqlite, "GenericSql", "SqlPersist", "Sqlite", "sqlSettings") + "p" -> (Postgresql, "GenericSql", "SqlPersist", "Postgresql", "sqlSettings") + "m" -> (MongoDB, "MongoDB", "Action", "MongoDB", "MkPersistSettings { mpsBackend = ConT ''Action }") "t" -> (Tiny, "","","",undefined) _ -> error $ "Invalid backend: " ++ backendC (modelImports) = case backend of @@ -84,7 +84,26 @@ scaffold = do let runMigration = case backend of MongoDB -> "" - _ -> "\n runConnectionPool (runMigration migrateAll) p" + _ -> "\n Database.Persist.Base.runPool dbconf (runMigration migrateAll) p" + + let importMigration = + case backend of + MongoDB -> "" + _ -> "\nimport Database.Persist.GenericSql (runMigration)" + + let dbConfigFile = + case backend of + MongoDB -> "mongoDB" + Sqlite -> "sqlite" + Postgresql -> "postgres" + Tiny -> error "Accessing dbConfigFile for Tiny" + + let configPersist = + case backend of + MongoDB -> "MongoConf" + Sqlite -> "SqliteConf" + Postgresql -> "PostgresConf" + Tiny -> error "Accessing configPersist for Tiny" putStrLn "That's it! I'm creating your files now..." diff --git a/yesod/scaffold/Application.hs.cg b/yesod/scaffold/Application.hs.cg index ff12c582..46758e1d 100644 --- a/yesod/scaffold/Application.hs.cg +++ b/yesod/scaffold/Application.hs.cg @@ -15,9 +15,9 @@ import Yesod.Auth import Yesod.Default.Config import Yesod.Default.Main import Yesod.Logger (Logger) -import Database.Persist.~importGenericDB~ import Data.ByteString (ByteString) import Data.Dynamic (Dynamic, toDyn) +import qualified Database.Persist.Base~importMigration~ -- Import all relevant handler modules here. import Handler.Root @@ -46,7 +46,9 @@ with~sitearg~ conf logger f = do #else s <- staticDevel Settings.staticDir #endif - Settings.withConnectionPool conf $ \p -> do~runMigration~ + dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf) + $ either error return . Database.Persist.Base.loadConfig + Database.Persist.Base.withPool (dbconf :: Settings.PersistConfig) $ \p -> do~runMigration~ let h = ~sitearg~ conf logger s p defaultRunner f h diff --git a/yesod/scaffold/Foundation.hs.cg b/yesod/scaffold/Foundation.hs.cg index c8814801..4e1d736b 100644 --- a/yesod/scaffold/Foundation.hs.cg +++ b/yesod/scaffold/Foundation.hs.cg @@ -27,6 +27,7 @@ import Yesod.Default.Util (addStaticContentExternal) import Yesod.Logger (Logger, logLazyText) import qualified Settings import qualified Data.ByteString.Lazy as L +import qualified Database.Persist.Base import Database.Persist.~importGenericDB~ import Settings (widgetFile) import Model @@ -47,7 +48,7 @@ data ~sitearg~ = ~sitearg~ { settings :: AppConfig DefaultEnv , getLogger :: Logger , getStatic :: Static -- ^ Settings for static file serving. - , connPool :: Settings.ConnectionPool -- ^ Database connection pool. + , connPool :: Database.Persist.Base.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool. } -- Set up i18n messages. See the message folder. @@ -121,7 +122,7 @@ instance Yesod ~sitearg~ where instance YesodPersist ~sitearg~ where type YesodPersistBackend ~sitearg~ = ~dbMonad~ runDB f = liftIOHandler - $ fmap connPool getYesod >>= Settings.runConnectionPool f + $ fmap connPool getYesod >>= Database.Persist.Base.runPool (undefined :: Settings.PersistConfig) f instance YesodAuth ~sitearg~ where type AuthId ~sitearg~ = UserId diff --git a/yesod/scaffold/Settings.hs.cg b/yesod/scaffold/Settings.hs.cg index 5a7a4f70..6ab29b6f 100644 --- a/yesod/scaffold/Settings.hs.cg +++ b/yesod/scaffold/Settings.hs.cg @@ -8,21 +8,21 @@ -- declared in the Foundation.hs file. module Settings ( widgetFile - , ConnectionPool - , withConnectionPool - , runConnectionPool + , PersistConfig , staticRoot , staticDir ) where import Text.Shakespeare.Text (st) import Language.Haskell.TH.Syntax -import Database.Persist.~importPersist~ -import Yesod (liftIO, MonadControlIO) +import Database.Persist.~importPersist~ (~configPersist~) import Yesod.Default.Config import qualified Yesod.Default.Util import Data.Text (Text) +-- | Which Persistent backend this site is using. +type PersistConfig = ~configPersist~ + -- Static setting below. Changing these requires a recompile -- | The location of static files on your system. This is a file system @@ -50,12 +50,6 @@ staticRoot conf = [st|#{appRoot conf}/static|] -- 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. They are used internally --- by the scaffolded application, and therefore you will rarely need to use --- them yourself. -~withConnectionPool~ - widgetFile :: String -> Q Exp #if PRODUCTION widgetFile = Yesod.Default.Util.widgetFileProduction