persistent-mongoDB 1.1.2 → 1.1.3
raw patch · 2 files changed
+91/−18 lines, 2 files
Files
- Database/Persist/MongoDB.hs +90/−17
- persistent-mongoDB.cabal +1/−1
Database/Persist/MongoDB.hs view
@@ -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)}
persistent-mongoDB.cabal view
@@ -1,5 +1,5 @@ name: persistent-mongoDB-version: 1.1.2+version: 1.1.3 license: MIT license-file: LICENSE author: Greg Weber <greg@gregweber.info>