mongoDB 1.3.0 → 1.3.1

raw patch · 4 files changed

+34/−10 lines, 4 files

Files

Database/MongoDB/Internal/Util.hs +1/−1
Database/MongoDB/Query.hs +19/−6
System/IO/Pipeline.hs +13/−2
mongoDB.cabal +1/−1

Database/MongoDB/Internal/Util.hs view

@@ -97,7 +97,7 @@ updateAssocs key valu assocs = case back of [] -> (key, valu) : front; _ : back' -> front ++ (key, valu) : back' 	where (front, back) = break ((key ==) . fst) assocs -bitOr :: (Bits a) => [a] -> a+bitOr :: (Num a, Bits a) => [a] -> a -- ^ bit-or all numbers together bitOr = foldl (.|.) 0

Database/MongoDB/Query.hs view

@@ -1,6 +1,6 @@ -- | Query and update documents -{-# LANGUAGE OverloadedStrings, RecordWildCards, NamedFieldPuns, TupleSections, FlexibleContexts, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, StandaloneDeriving, TypeSynonymInstances, TypeFamilies #-}+{-# LANGUAGE OverloadedStrings, RecordWildCards, NamedFieldPuns, TupleSections, FlexibleContexts, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, StandaloneDeriving, TypeSynonymInstances, TypeFamilies, CPP #-}  module Database.MongoDB.Query ( 	-- * Monad@@ -47,8 +47,13 @@ import Data.Maybe (listToMaybe, catMaybes) import Data.Word (Word32) -import Control.Concurrent.MVar.Lifted (MVar, newMVar, addMVarFinalizer,+#if MIN_VERSION_base(4,6,0)+import Control.Concurrent.MVar.Lifted (MVar, newMVar, mkWeakMVar,                                        readMVar, modifyMVar)+#else+import Control.Concurrent.MVar.Lifted (MVar, newMVar, addMVarFinalizer,+                                         readMVar, modifyMVar)+#endif import Control.Monad.Base (MonadBase(liftBase)) import Control.Monad.Error (ErrorT, Error(..), MonadError, runErrorT,                             throwError)@@ -60,8 +65,9 @@                                     MonadTransControl(..), StM, StT,                                     defaultLiftBaseWith, defaultRestoreM) import Control.Monad.Writer (WriterT, Monoid)-import Data.Bson (Document, Field(..), Label, Value(String,Doc), Javascript,-                  at, valueAt, lookup, look, genObjectId, (=:), (=?))+import Data.Bson (Document, Field(..), Label, Val, Value(String,Doc),+                  Javascript, at, valueAt, lookup, look, genObjectId, (=:),+                  (=?)) import Data.Text (Text) import qualified Data.Text as T @@ -77,6 +83,10 @@ import Database.MongoDB.Internal.Util (MonadIO', loop, liftIOE, true1, (<.>)) import qualified Database.MongoDB.Internal.Protocol as P +#if !MIN_VERSION_base(4,6,0)+--mkWeakMVar = addMVarFinalizer+#endif+ -- * Monad  newtype Action m a = Action {unAction :: ErrorT Failure (ReaderT Context m) a}@@ -508,8 +518,11 @@ newCursor db col batchSize dBatch = do 	var <- newMVar dBatch 	let cursor = Cursor (db <.> col) batchSize var-	addMVarFinalizer var (closeCursor cursor)+	mkWeakMVar var (closeCursor cursor) 	return cursor+#if !MIN_VERSION_base(4,6,0)+  where mkWeakMVar = addMVarFinalizer+#endif  nextBatch :: (MonadIO m, MonadBaseControl IO m) => Cursor -> Action m [Document] -- ^ Return next batch of documents in query result, which will be empty if finished.@@ -694,7 +707,7 @@ -- ^ @runCommand1 foo = runCommand [foo =: 1]@ runCommand1 c = runCommand [c =: (1 :: Int)] -eval :: (MonadIO' m) => Javascript -> Action m Document+eval :: (MonadIO' m, Val v) => Javascript -> Action m v -- ^ Run code on server eval code = at "retval" <$> runCommand ["$eval" =: code]

System/IO/Pipeline.hs view

@@ -3,6 +3,7 @@ A pipeline closes itself when a read or write causes an error, so you can detect a broken pipeline by checking isClosed.  It also closes itself when garbage collected, or you can close it explicitly. -}  {-# LANGUAGE DoRec, RecordWildCards, NamedFieldPuns, ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}  module System.IO.Pipeline ( 	IOE,@@ -19,10 +20,20 @@ import GHC.Conc (ThreadStatus(..), threadStatus)  import Control.Monad.Trans (liftIO)+#if MIN_VERSION_base(4,6,0) import Control.Concurrent.MVar.Lifted (MVar, newEmptyMVar, newMVar, withMVar,-                                       putMVar, readMVar, addMVarFinalizer)+                                       putMVar, readMVar, mkWeakMVar)+#else+import Control.Concurrent.MVar.Lifted (MVar, newEmptyMVar, newMVar, withMVar,+                                         putMVar, readMVar, addMVarFinalizer)+#endif import Control.Monad.Error (ErrorT(ErrorT), runErrorT) +#if !MIN_VERSION_base(4,6,0)+mkWeakMVar :: MVar a -> IO () -> IO ()+mkWeakMVar = addMVarFinalizer+#endif+ onException :: (Monad m) => ErrorT e m a -> m () -> ErrorT e m a -- ^ If first action throws an exception then run second action then re-throw onException (ErrorT action) releaser = ErrorT $ do@@ -58,7 +69,7 @@ 	rec 		let pipe = Pipeline{..} 		listenThread <- forkIO (listen pipe)-	addMVarFinalizer vStream $ do+	mkWeakMVar vStream $ do 		killThread listenThread 		closeStream stream 	return pipe

mongoDB.cabal view

@@ -1,5 +1,5 @@ Name:           mongoDB-Version:        1.3.0+Version:        1.3.1 Synopsis:       Driver (client) for MongoDB, a free, scalable, fast, document                 DBMS Description:    This package lets you connect to MongoDB servers and