haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

mongoDB scaffolding

Browse Source
This commit is contained in:
Greg Weber 2011-08-12 00:10:50 -07:00
parent 725de4605a
commit 606a0b070b
5 changed files with 17 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
yesod/scaffold.hs
View File

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

2
yesod/scaffold/Controller.hs.cg
View File

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

4
yesod/scaffold/Model.hs.cg
View File

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

10
yesod/scaffold/mongoDBConnPool.cg
View File

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

4
yesod/scaffold/sitearg.hs.cg
View File

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