mongoDB scaffolding

yesod/scaffold.hs

@@ -92,12 +92,12 @@ scaffold = do
     puts $(codegenDir "input" "database")
     
     backendC <- prompt $ flip elem $ map (return . toLower . head . show) backends
-    let (backend, importDB) =
+    let (backend, importGenericDB, dbMonad, importDB, mkPersistSettings) =
             case backendC of
-                "s" -> (Sqlite, "import Database.Persist.Sqlite\n")
-                "p" -> (Postgresql, "import Database.Persist.Postgresql\n")
-                "m" -> (MongoDB, "import Database.Persist.MongoDB\nimport Control.Applicative (Applicative)\n")
-                "t" -> (Tiny, "")
+                "s" -> (Sqlite,     "GenericSql", "SqlPersist", "import Database.Persist.Sqlite\n", "sqlSettings")
+                "p" -> (Postgresql, "GenericSql", "SqlPersist", "import Database.Persist.Postgresql\n", "sqlSettings")
+                "m" -> (MongoDB,    "MongoDB", "Action", "import Database.Persist.MongoDB\nimport Control.Applicative (Applicative)\n", "MkPersistSettings { mpsBackend = ConT ''Action }")
+                "t" -> (Tiny, "","","","")
                 _ -> error $ "Invalid backend: " ++ backendC
         uncapitalize s = toLower (head s) : tail s
         backendLower = uncapitalize $ show backend 
@@ -115,7 +115,7 @@ scaffold = do
           Postgresql -> ", concat, append, snoc, pack"
           _          -> ""
 
-        packages = if backend == MongoDB then "          , mongoDB\n         , bson\n" else ""
+        packages = if backend == MongoDB then ", mongoDB\n               , bson\n" else ""
 
     let fst3 (x, _, _) = x
     year <- show . fst3 . toGregorian . utctDay <$> getCurrentTime

yesod/scaffold/Controller.hs.cg

@@ -13,7 +13,7 @@ import Settings
 import Yesod.Static
 import Yesod.Auth
 import Yesod.Logger (makeLogger, flushLogger, Logger)
-import Database.Persist.GenericSql
+import Database.Persist.~importGenericDB~
 import Data.ByteString (ByteString)
 import Data.Dynamic (Dynamic, toDyn)
 

yesod/scaffold/Model.hs.cg

@@ -3,10 +3,12 @@ module Model where
 
 import Yesod
 import Data.Text (Text)
+import Database.Persist.~importGenericDB~
+import Language.Haskell.TH.Syntax
 
 -- You can define all of your database entities in the entities file.
 -- You can find more information on persistent and how to declare entities
 -- at:
 -- http://www.yesodweb.com/book/persistent/
-share [mkPersist sqlSettings, mkMigrate "migrateAll"] $(persistFile "config/models")
+share [mkPersist ~mkPersistSettings~, mkMigrate "migrateAll"] $(persistFile "config/models")
 

yesod/scaffold/mongoDBConnPool.cg

@@ -1,13 +1,13 @@
-runConnectionPool :: MonadControlIO m => MongoPersist m a -> ConnectionPool -> Database -> m a
-runConnectionPool = runMongoDBConn safe Master
+runConnectionPool :: MonadControlIO m => Action m a -> ConnectionPool -> m a
+runConnectionPool = runMongoDBConn (ConfirmWrites [u"j" =: True])
 
-withConnectionPool :: (MonadControlIO m, Applicative m) => AppConfig -> (ConnectionPool -> Database -> m b) -> m b
+withConnectionPool :: (MonadControlIO m, Applicative m) => AppConfig -> (ConnectionPool -> m b) -> m b
 withConnectionPool conf f = do
     (database,host) <- liftIO $ loadConnParams (appEnv conf)
-    withMongoDBPool (Database $ u database) host (connectionPoolSize conf) f
+    withMongoDBPool (u database) host (connectionPoolSize conf) f
   where
     -- | The database connection parameters.
-  --  loadConnParams :: AppEnvironment -> IO Text
+    --  loadConnParams :: AppEnvironment -> IO (Database, HostName)
     loadConnParams env = do
         allSettings <- (join $ YAML.decodeFile ("config/mongoDB.yml" :: String)) >>= fromMapping
         settings <- lookupMapping (show env) allSettings

yesod/scaffold/sitearg.hs.cg

@@ -25,7 +25,7 @@ import Yesod.Logger (Logger, logLazyText)
 import qualified Settings
 import System.Directory
 import qualified Data.ByteString.Lazy as L
-import Database.Persist.GenericSql
+import Database.Persist.~importGenericDB~
 import Settings (hamletFile, cassiusFile, luciusFile, juliusFile, widgetFile)
 import Model
 import Data.Maybe (isJust)
@@ -128,7 +128,7 @@ instance Yesod ~sitearg~ where
 
 -- How to run database actions.
 instance YesodPersist ~sitearg~ where
-    type YesodPersistBackend ~sitearg~ = SqlPersist
+    type YesodPersistBackend ~sitearg~ = ~dbMonad~
     runDB f = liftIOHandler
             $ fmap connPool getYesod >>= Settings.runConnectionPool f