persistent-mongoDB 1.3.3.1 → 1.4.1

raw patch · 2 files changed

+125/−32 lines, 2 filesdep ~mongoDBPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: mongoDB

API changes (from Hackage documentation)

Files

• Database/Persist/MongoDB.hs +123/−30
• persistent-mongoDB.cabal +2/−2

@@ -39,7 +39,7 @@      -- * MongoDB specific Filters     -- $filters-    , nestEq, multiEq, nestBsonEq, multiBsonEq+    , nestEq, anyEq, multiEq, nestBsonEq, multiBsonEq     , (=~.), (?=~.), MongoRegex     , (->.), (~>.), (?&->.), (?&~>.), (&->.), (&~>.)     -- non-operator forms of filters@@ -59,6 +59,7 @@      -- * using connections     , withConnection+    , withMongoPool     , withMongoDBConn     , withMongoDBPool     , createMongoDBPool@@ -138,12 +139,24 @@ import Data.Typeable import Control.Monad.Trans.Resource (MonadThrow (..)) import Control.Monad.Trans.Control (MonadBaseControl)++#if MIN_VERSION_base(4,6,0) import System.Environment (lookupEnv)+#else+import System.Environment (getEnvironment)+#endif  #ifdef DEBUG import FileLocation (debug) #endif +#if !MIN_VERSION_base(4,6,0)+lookupEnv :: String -> IO (Maybe String)+lookupEnv key = do+    env <- getEnvironment+    return $ lookup key env+#endif+ recordTypeFromKey :: KeyBackend MongoBackend v -> v recordTypeFromKey _ = error "recordTypeFromKey" @@ -238,15 +251,40 @@                 -> (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)+mkPipe :: DB.Host -> IO DB.Pipe+mkPipe = DB.runIOE . DB.connect -createConnection :: Database -> HostName -> PortID -> Maybe MongoAuth -> IO Connection-createConnection dbname hostname port mAuth = do-    pipe <- createPipe hostname port+createReplicatSet :: (DB.ReplicaSetName, [DB.Host]) -> Database -> Maybe MongoAuth -> IO Connection+createReplicatSet rsSeed dbname mAuth = do+    pipe <- DB.runIOE $ DB.openReplicaSet rsSeed >>= DB.primary+    testAccess pipe dbname mAuth+    return $ Connection pipe dbname++createRsPool :: (Trans.MonadIO m, Applicative m) => Database -> ReplicaSetConfig+              -> Maybe MongoAuth+              -> Int -- ^ pool size (number of stripes)+              -> Int -- ^ stripe size (number of connections per stripe)+              -> NominalDiffTime -- ^ time a connection is left idle before closing+              -> m ConnectionPool+createRsPool dbname (ReplicaSetConfig rsName rsHosts) mAuth connectionPoolSize stripeSize connectionIdleTime = do+    Trans.liftIO $ Pool.createPool+                          (createReplicatSet (rsName, rsHosts) dbname mAuth)+                          (\(Connection pipe _) -> DB.close pipe)+                          connectionPoolSize+                          connectionIdleTime+                          stripeSize++testAccess :: DB.Pipe -> Database -> Maybe MongoAuth -> IO ()+testAccess pipe dbname mAuth = do     _ <- case mAuth of       Just (MongoAuth user pass) -> DB.access pipe DB.UnconfirmedWrites dbname (DB.auth user pass)       Nothing -> return undefined+    return ()++createConnection :: Database -> HostName -> PortID -> Maybe MongoAuth -> IO Connection+createConnection dbname hostname port mAuth = do+    pipe <- mkPipe $ DB.Host hostname port+    testAccess pipe dbname mAuth     return $ Connection pipe dbname  createMongoDBPool :: (Trans.MonadIO m, Applicative m) => Database -> HostName -> PortID@@ -263,6 +301,20 @@                           connectionIdleTime                           stripeSize ++createMongoPool :: (Trans.MonadIO m, Applicative m) => MongoConf -> m ConnectionPool+createMongoPool c@MongoConf{mgReplicaSetConfig = Just (ReplicaSetConfig rsName hosts)} =+      createRsPool+         (mgDatabase c)+         (ReplicaSetConfig rsName ((DB.Host (T.unpack $ mgHost c) (mgPort c)):hosts))+         (mgAuth c)+         (mgPoolStripes c) (mgStripeConnections c) (mgConnectionIdleTime c)+createMongoPool c@MongoConf{mgReplicaSetConfig = Nothing} =+      createMongoDBPool+         (mgDatabase c) (T.unpack (mgHost c)) (mgPort c)+         (mgAuth c)+         (mgPoolStripes c) (mgStripeConnections c) (mgConnectionIdleTime c)+ type PipePool = Pool.Pool DB.Pipe  -- | A pool of plain MongoDB pipes.@@ -274,14 +326,17 @@                   -> 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+createMongoDBPipePool hostname port connectionPoolSize stripeSize connectionIdleTime =   Trans.liftIO $ Pool.createPool-                          (createPipe hostname port)-                          (\pipe -> DB.close pipe)+                          (mkPipe $ DB.Host hostname port)+                          DB.close                           connectionPoolSize                           connectionIdleTime                           stripeSize +withMongoPool :: (Trans.MonadIO m, Applicative m) => MongoConf -> (ConnectionPool -> m b) -> m b+withMongoPool conf connectionReader = createMongoPool conf >>= connectionReader+ 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@@ -834,6 +889,9 @@     , mgPoolStripes :: Int     , mgStripeConnections :: Int     , mgConnectionIdleTime :: NominalDiffTime+    -- | YAML fields for this are @rsName@ and @rsSecondaries@+    -- mgHost is assumed to be the primary+    , mgReplicaSetConfig :: Maybe ReplicaSetConfig     } deriving Show  defaultHost :: Text@@ -856,29 +914,32 @@   , mgPoolStripes = defaultPoolStripes   , mgStripeConnections = defaultStripeConnections   , mgConnectionIdleTime = defaultConnectionIdleTime+  , mgReplicaSetConfig = Nothing   } +data ReplicaSetConfig = ReplicaSetConfig DB.ReplicaSetName [DB.Host]+    deriving Show++ instance PersistConfig MongoConf where     type PersistConfigBackend MongoConf = DB.Action     type PersistConfigPool MongoConf = ConnectionPool -    createPoolConfig c =-      createMongoDBPool -         (mgDatabase c) (T.unpack (mgHost c)) (mgPort c)-         (mgAuth c)-         (mgPoolStripes c) (mgStripeConnections c) (mgConnectionIdleTime c)+    createPoolConfig = createMongoPool      runPool c = runMongoDBPool (mgAccessMode c)     loadConfig (Object o) = do-        db                 <- o .:  "database"-        host               <- o .:? "host" .!= defaultHost-        (NoOrphanPortID port) <- o .:? "port" .!= (NoOrphanPortID DB.defaultPort)-        poolStripes        <- o .:? "poolstripes" .!= defaultPoolStripes-        stripeConnections  <- o .:? "connections" .!= defaultStripeConnections-        (NoOrphanNominalDiffTime connectionIdleTime) <- o .:? "connectionIdleTime" .!= (NoOrphanNominalDiffTime defaultConnectionIdleTime)+        db                  <- o .:  "database"+        host                <- o .:? "host" .!= defaultHost+        NoOrphanPortID port <- o .:? "port" .!= NoOrphanPortID DB.defaultPort+        poolStripes         <- o .:? "poolstripes" .!= defaultPoolStripes+        stripeConnections   <- o .:? "connections" .!= defaultStripeConnections+        NoOrphanNominalDiffTime connectionIdleTime <- o .:? "connectionIdleTime" .!= NoOrphanNominalDiffTime defaultConnectionIdleTime         mUser              <- o .:? "user"         mPass              <- o .:? "password"         accessString       <- o .:? "accessMode" .!= confirmWrites+        mRsName            <- o .:? "rsName"+        rsSecondaires      <- o .:? "rsSecondaries" .!= []          mPoolSize         <- o .:? "poolsize"         case mPoolSize of@@ -888,22 +949,27 @@         accessMode <- case accessString of              "ReadStaleOk"       -> return DB.ReadStaleOk              "UnconfirmedWrites" -> return DB.UnconfirmedWrites-             confirmWrites       -> return defaultAccessMode+             "ConfirmWrites"     -> return defaultAccessMode              badAccess -> fail $ "unknown accessMode: " ++ T.unpack badAccess -        return $ MongoConf {+        let rs = case (mRsName, rsSecondaires) of+                     (Nothing, []) -> Nothing+                     (Nothing, _) -> error "found rsSecondaries key. Also expected but did not find a rsName key"+                     (Just rsName, hosts) -> Just $ ReplicaSetConfig rsName $ fmap DB.readHostPort hosts++        return MongoConf {             mgDatabase = db           , mgHost = host           , mgPort = port           , mgAuth =-              (case (mUser, mPass) of+              case (mUser, mPass) of                 (Just user, Just pass) -> Just (MongoAuth user pass)                 _ -> Nothing-              )           , mgPoolStripes = poolStripes           , mgStripeConnections = stripeConnections           , mgAccessMode = accessMode           , mgConnectionIdleTime = connectionIdleTime+          , mgReplicaSetConfig = rs           }       where         confirmWrites = "ConfirmWrites"@@ -1019,12 +1085,18 @@ infixr 6 ->.  infixr 4 `nestEq`+infixr 4 `anyEq` infixr 4 `multiEq` infixr 4 `nestBsonEq` infixr 4 `multiBsonEq`+infixr 4 `anyBsonEq` --- | The normal Persistent equality test (==.) is not generic enough.--- Instead use this with the drill-down operaters (->.) or (?->.)+-- | The normal Persistent equality test '==.' is not generic enough.+-- Instead use this with the drill-down arrow operaters such as '->.'+--+-- using this as the only query filter is similar to the following in the mongoDB shell+--+-- > db.Collection.find({"object.field": item}) nestEq :: forall record typ.        ( PersistField typ        , PersistEntityBackend record ~ MongoBackend@@ -1044,22 +1116,43 @@                     , nestedValue = MongoFilterOperator val                     } --- | use to see if an embedded list contains an item multiEq :: forall record typ.         ( PersistField typ         , PersistEntityBackend record ~ MongoBackend         ) => EntityField record [typ] -> typ -> Filter record-fld `multiEq` val = BackendFilter $ MultiKeyFilter+multiEq = anyEq+{-# DEPRECATED multiEq "Please use anyEq instead" #-}++-- | Like nestEq, but for an embedded list.+-- Checks to see if the list contains an item.+--+-- In Haskell we need different equality functions for embedded fields that are lists or non-lists to keep things type-safe.+--+-- using this as the only query filter is similar to the following in the mongoDB shell+--+-- > db.Collection.find({arrayField: arrayItem})+anyEq :: forall record typ.+        ( PersistField typ+        , PersistEntityBackend record ~ MongoBackend+        ) => EntityField record [typ] -> typ -> Filter record+fld `anyEq` val = BackendFilter $ MultiKeyFilter                       { multiField = fld                       , multiValue = PersistOperator (Left val) Eq                       } --- | same as `multiEq`, but give a BSON Value multiBsonEq :: forall record typ.         ( PersistField typ         , PersistEntityBackend record ~ MongoBackend         ) => EntityField record [typ] -> DB.Value -> Filter record-fld `multiBsonEq` val = BackendFilter $ MultiKeyFilter+multiBsonEq = anyBsonEq+{-# DEPRECATED multiBsonEq "Please use anyBsonEq instead" #-}++-- | same as `anyEq`, but give a BSON Value+anyBsonEq :: forall record typ.+        ( PersistField typ+        , PersistEntityBackend record ~ MongoBackend+        ) => EntityField record [typ] -> DB.Value -> Filter record+fld `anyBsonEq` val = BackendFilter $ MultiKeyFilter                       { multiField = fld                       , multiValue = MongoFilterOperator val                       }

@@ -1,5 +1,5 @@ name:            persistent-mongoDB-version:         1.3.3.1+version:         1.4.1 license:         MIT license-file:    LICENSE author:          Greg Weber <greg@gregweber.info>@@ -26,7 +26,7 @@                    , bytestring         >= 0.9                    , conduit            >= 0.5.3                    , resourcet          >= 0.3-                   , mongoDB            >= 1.4.1   && < 1.5+                   , mongoDB            >= 1.4.1   && < 1.6                    , bson               >= 0.2     && < 0.3                    , network            >= 2.2.1.7                    , cereal             >= 0.3.0.0