diff --git a/Database/Persist/MongoDB.hs b/Database/Persist/MongoDB.hs --- a/Database/Persist/MongoDB.hs +++ b/Database/Persist/MongoDB.hs @@ -1,3 +1,13 @@ +-- | Use persistent-mongodb the same way you would use other persistent +-- libraries and refer to the general persistent documentation. +-- There are some new MongoDB specific filters under the filters section. +-- These help extend your query into a nested document. +-- +-- However, at some point you will find the normal Persistent APIs lacking. +-- and want lower level-level MongoDB access. +-- There are functions available to make working with the raw driver +-- easier: they are under the Entity conversion section. +-- You should still use the same connection pool that you are using for Persistent. {-# LANGUAGE CPP, PackageImports, OverloadedStrings, ScopedTypeVariables #-} {-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-} @@ -9,8 +19,19 @@ {-# LANGUAGE GADTs #-} module Database.Persist.MongoDB ( + -- * Entity conversion + entityToFields + , toInsertFields + , docToEntityEither + , docToEntityThrow + + -- * MongoDB specific Filters + -- $filters + , (->.), (~>.), (?->.), (?~>.) + , nestEq, multiEq + -- * using connections - withMongoDBConn + , withMongoDBConn , withMongoDBPool , createMongoDBPool , runMongoDBPool @@ -19,28 +40,28 @@ , Connection , MongoConf (..) , MongoBackend + -- ** using raw MongoDB pipes + , PipePool + , createMongoDBPipePool + , runMongoDBPipePool + -- * Key conversion helpers , keyToOid , oidToKey - -- * Entity conversion - , entityToFields - , toInsertFields - , docToEntityEither - , docToEntityThrow + -- * network type , HostName , PortID + -- * MongoDB driver types , DB.Action , DB.AccessMode(..) , DB.master , DB.slaveOk , (DB.=:) + -- * Database.Persist , module Database.Persist - -- * Mongo Filters - , (~>.) ,(?~>.), (->.), (?->.) - , nestEq, multiEq ) where import Database.Persist @@ -107,9 +128,12 @@ Database -> HostName -> PortID -> Maybe MongoAuth -> NominalDiffTime -> (ConnectionPool -> m b) -> m b withMongoDBConn dbname hostname port mauth connectionIdleTime = withMongoDBPool dbname hostname port mauth 1 1 connectionIdleTime +createPipe :: HostName -> PortID -> IO DB.Pipe +createPipe hostname port = DB.runIOE $ DB.connect (DB.Host hostname port) + createConnection :: Database -> HostName -> PortID -> Maybe MongoAuth -> IO Connection createConnection dbname hostname port mAuth = do - pipe <- DB.runIOE $ DB.connect (DB.Host hostname port) + pipe <- createPipe hostname port _ <- case mAuth of Just (MongoAuth user pass) -> DB.access pipe DB.UnconfirmedWrites dbname (DB.auth user pass) Nothing -> return undefined @@ -129,18 +153,46 @@ connectionIdleTime stripeSize +type PipePool = Pool.Pool DB.Pipe + +-- | A pool of plain MongoDB pipes. +-- The database parameter has not yet been applied yet. +-- This is useful for switching between databases (on the same host and port) +-- Unlike the normal pool, no authentication is available +createMongoDBPipePool :: (Trans.MonadIO m, Applicative m) => HostName -> PortID + -> Int -- ^ pool size (number of stripes) + -> Int -- ^ stripe size (number of connections per stripe) + -> NominalDiffTime -- ^ time a connection is left idle before closing + -> m PipePool +createMongoDBPipePool hostname port connectionPoolSize stripeSize connectionIdleTime = do + Trans.liftIO $ Pool.createPool + (createPipe hostname port) + (\pipe -> DB.close pipe) + connectionPoolSize + connectionIdleTime + stripeSize + withMongoDBPool :: (Trans.MonadIO m, Applicative m) => Database -> HostName -> PortID -> Maybe MongoAuth -> Int -> Int -> NominalDiffTime -> (ConnectionPool -> m b) -> m b withMongoDBPool dbname hostname port mauth poolStripes stripeConnections connectionIdleTime connectionReader = do pool <- createMongoDBPool dbname hostname port mauth poolStripes stripeConnections connectionIdleTime connectionReader pool +-- | run a pool created with 'createMongoDBPipePool' +runMongoDBPipePool :: (Trans.MonadIO m, MonadBaseControl IO m) => DB.AccessMode -> Database -> DB.Action m a -> PipePool -> m a +runMongoDBPipePool accessMode db action pool = + Pool.withResource pool $ \pipe -> do + res <- DB.access pipe accessMode db action + either (Trans.liftIO . throwIO . PersistMongoDBError . T.pack . show) return res + runMongoDBPool :: (Trans.MonadIO m, MonadBaseControl IO m) => DB.AccessMode -> DB.Action m a -> ConnectionPool -> m a runMongoDBPool accessMode action pool = Pool.withResource pool $ \(Connection pipe db) -> do res <- DB.access pipe accessMode db action either (Trans.liftIO . throwIO . PersistMongoDBError . T.pack . show) return res + +-- | use default 'AccessMode' runMongoDBPoolDef :: (Trans.MonadIO m, MonadBaseControl IO m) => DB.Action m a -> ConnectionPool -> m a runMongoDBPoolDef = runMongoDBPool (DB.ConfirmWrites ["j" DB.=: True]) @@ -615,7 +667,7 @@ loadConfig (Object o) = do db <- o .: "database" host <- o .:? "host" .!= "127.0.0.1" - port <- o .:? "port" .!= (PortNumber 27017) + port <- o .:? "port" .!= DB.defaultPort poolStripes <- o .:? "poolstripes" .!= 1 stripeConnections <- o .: "connections" (NoOrphanNominalDiffTime connectionIdleTime) <- o .:? "connectionIdleTime" .!= 20 @@ -659,6 +711,18 @@ -} loadConfig _ = mzero + +-- --------------------------- +-- * MongoDB specific Filters + +-- $filters +-- +-- You can find example usage for all of Persistent in our test cases: +-- https://github.com/yesodweb/persistent/blob/master/persistent-test/EmbedTest.hs#L144 +-- +-- These filters create a query that reaches deeper into a document with +-- nested fields. + type instance BackendSpecificFilter MongoBackend v = MongoFilter v data NestedField val nes = forall nes1. PersistEntity nes1 => EntityField val nes1 `MidFlds` NestedField nes1 nes @@ -675,18 +739,26 @@ mulFldKey :: EntityField val [typ] , mulFldVal :: Either typ [typ] } -(~>.) :: forall val nes nes1. PersistEntity nes1 => EntityField val nes1 -> NestedField nes1 nes -> NestedField val nes -(~>.) = MidFlds -(?~>.) :: forall val nes nes1. PersistEntity nes1 => EntityField val (Maybe nes1) -> NestedField nes1 nes -> NestedField val nes -(?~>.) = MidFldsNullable - +-- | Point to a nested field to query. Used for the final level of nesting with `nestEq` or other operators. (->.) :: forall val nes nes1. PersistEntity nes1 => EntityField val nes1 -> EntityField nes1 nes -> NestedField val nes (->.) = LastFld +-- | Same as (->.), but Works against a Maybe type (?->.) :: forall val nes nes1. PersistEntity nes1 => EntityField val (Maybe nes1) -> EntityField nes1 nes -> NestedField val nes (?->.) = LastFldNullable +-- | Point to a nested field to query. +-- This level of nesting is not the final level. +-- Use (->.) to point to the final level is +(~>.) :: forall val nes nes1. PersistEntity nes1 => EntityField val nes1 -> NestedField nes1 nes -> NestedField val nes +(~>.) = MidFlds + +-- | Same as (~>.), but Works against a Maybe type +(?~>.) :: forall val nes nes1. PersistEntity nes1 => EntityField val (Maybe nes1) -> NestedField nes1 nes -> NestedField val nes +(?~>.) = MidFldsNullable + + infixr 5 ~>. infixr 5 ?~>. infixr 6 ->. @@ -694,7 +766,8 @@ infixr 4 `nestEq` --- | use with drill-down operaters ~>, etc +-- | The normal Persistent equality test (==.) is not generic enough. +-- Instead use this with the drill-down operaters (->.) or (?->.) nestEq :: forall v typ. (PersistField typ, PersistEntityBackend v ~ MongoBackend) => NestedField v typ -> typ -> Filter v nf `nestEq` v = BackendFilter $ NestedFilter {nestedField = nf, fieldValue = (Left v)} diff --git a/persistent-mongoDB.cabal b/persistent-mongoDB.cabal --- a/persistent-mongoDB.cabal +++ b/persistent-mongoDB.cabal @@ -1,5 +1,5 @@ name: persistent-mongoDB -version: 1.1.2 +version: 1.1.3 license: MIT license-file: LICENSE author: Greg Weber