From a2c5888e411a667dc410bc59546e81e7b72e44a7 Mon Sep 17 00:00:00 2001
From: "Scott R. Parish" <sparish@peak6.com>
Date: Wed, 13 Jan 2010 07:14:31 -0600
Subject: [PATCH] expose query options

---
 Database/MongoDB.hs | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

diff --git a/Database/MongoDB.hs b/Database/MongoDB.hs
index 9cb2032..bde9f13 100644
--- a/Database/MongoDB.hs
+++ b/Database/MongoDB.hs
@@ -12,6 +12,7 @@ import Control.Monad
 import Data.Binary
 import Data.Binary.Get
 import Data.Binary.Put
+import Data.Bits
 import Data.ByteString.Char8
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.UTF8 as L8
@@ -80,6 +81,18 @@ type RequestID = Int32
 type NumToSkip = Int32
 type NumToReturn = Int32
 
+data QueryOpts = QO_TailableCursor
+               | QO_SlaveOK
+               | QO_OpLogReplay
+               | QO_NoCursorTimeout
+               deriving (Show)
+
+fromQueryOpts [opts] = List.foldl (.|.) 0 $ fmap toVal opts
+    where toVal QO_TailableCursor = 2
+          toVal QO_SlaveOK = 4
+          toVal QO_OpLogReplay = 8
+          toVal QO_NoCursorTimeout = 16
+
 delete :: Connection -> Collection -> Selector -> IO RequestID
 delete c col sel = do
   let body = runPut $ do
@@ -113,9 +126,9 @@ insertMany c col docs = do
   L.hPut (cHandle c) msg
   return reqID
 
-query :: Connection -> Collection -> NumToSkip -> NumToReturn -> Selector ->
-         Maybe FieldSelector -> IO [BSONObject]
-query c col skip ret sel fsel = do
+query :: Connection -> Collection -> [QueryOpts] -> NumToSkip -> NumToReturn ->
+         Selector -> Maybe FieldSelector -> IO [BSONObject]
+query c col opts skip ret sel fsel = do
   let body = runPut $ do
                putI32 0 -- TODO opts
                putCol col