mongoDB 0.3 → 0.4

raw patch · 4 files changed

+569/−292 lines, 4 filesdep +unixPVP ok

version bump matches the API change (PVP)

Dependencies added: unix

API changes (from Hackage documentation)

Files

• Database/MongoDB.hs +198/−37
• Database/MongoDB/BSON.hs +361/−249
• Database/MongoDB/Util.hs +6/−3
• mongoDB.cabal +4/−3

@@ -23,6 +23,23 @@  -} +-- | A driver for MongoDB+--+-- This module lets you connect to MongoDB, do inserts, queries,+-- updates, etc. Also has many convience functions inspired by HDBC+-- such as more easily converting between the BsonValue types and+-- native Haskell types.+--+-- * Tutorial for this driver:+--   <http://github.com/srp/mongoDB/blob/master/tutorial.md>+--+-- * Map/Reduce example for this driver:+--   <http://github.com/srp/mongoDB/blob/master/map-reduce-example.md>+--+-- * MongoDB:+--   <http://www.mongodb.org/>+--+ module Database.MongoDB     (      -- * Connection@@ -55,6 +72,11 @@      Key, Unique,      Direction(..),      createIndex, dropIndex, dropIndexes, indexInformation,+     -- * Map-Reduce+     MapReduceOpt(..),+     mapReduce, mapReduceWScopes,+     runMapReduce, runMapReduceWScopes,+     mapReduceResults,     ) where import Control.Exception@@ -67,13 +89,12 @@ import Data.ByteString.Internal (c2w) import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.UTF8 as L8+import Data.Digest.OpenSSL.MD5 import Data.Int import Data.IORef import qualified Data.List as List-import qualified Data.Map as Map import Data.Maybe import Data.Typeable-import Data.Digest.OpenSSL.MD5 import Database.MongoDB.BSON as BSON import Database.MongoDB.Util import qualified Network@@ -86,7 +107,8 @@ -- | A list of handles to database connections data Connection = Connection {       cHandle :: IORef Handle,-      cRand :: IORef [Int]+      cRand :: IORef [Int],+      cOidGen :: ObjectIdGen     }  data ConnectOpt@@ -119,12 +141,13 @@                      fromIntegral (maxBound :: Int32)) r   nsRef <- newIORef ns   hRef <- openHandle (head servers) >>= newIORef-  let c = Connection hRef nsRef+  oidGen <- mkObjectIdGen+  let c = Connection hRef nsRef oidGen   res <- isMaster c-  if fromBson (fromLookup $ BSON.lookup "ismaster" res) == (1::Int) ||+  if fromBson (fromLookup $ List.lookup (s2L "ismaster") res) == (1::Int) ||      isJust (List.elemIndex SlaveOK opts)     then return c-    else case BSON.lookup "remote" res of+    else case List.lookup (s2L "remote") res of            Nothing -> throwConFailure "Couldn't find master to connect to"            Just server -> do              hRef' <- openHandle (splitHostPort $ fromBson server) >>= newIORef@@ -149,14 +172,14 @@ -- | Information about the databases on the server. databasesInfo :: Connection -> IO BsonDoc databasesInfo c =-    runCommand c (s2L "admin") $ toBsonDoc [("listDatabases", toBson (1::Int))]+    runCommand c (s2L "admin") $ toBsonDoc [("listDatabases",  BsonInt32 1)]  -- | Return a list of database names on the server. databaseNames :: Connection -> IO [Database] databaseNames c = do     info <- databasesInfo c-    let (BsonArray dbs) = fromLookup $ Map.lookup (s2L "databases") info-        names = mapMaybe (Map.lookup (s2L "name") . fromBson) dbs+    let (BsonArray dbs) = fromLookup $ List.lookup (s2L "databases") info+        names = mapMaybe (List.lookup (s2L "name") . fromBson) dbs     return $ List.map fromBson (names::[BsonValue])  -- | Alias for 'conClose'@@ -166,7 +189,7 @@ -- | Drop a database. dropDatabase :: Connection -> Database -> IO () dropDatabase c db = do-  _ <- runCommand c db $ toBsonDoc [("dropDatabase", toBson (1::Int))]+  _ <- runCommand c db $ toBsonDoc [("dropDatabase", BsonInt32 1)]   return ()  isMaster :: Connection -> IO BsonDoc@@ -175,7 +198,7 @@ -- | Get information about the MongoDB server we're connected to. serverInfo :: Connection -> IO BsonDoc serverInfo c =-  runCommand c (s2L "admin") $ toBsonDoc [("buildinfo", toBson (1::Int))]+  runCommand c (s2L "admin") $ toBsonDoc [("buildinfo", BsonInt32 1)]  -- | Shut down the MongoDB server. --@@ -183,13 +206,14 @@ -- Note that it will wait until all ongoing operations are complete. serverShutdown :: Connection -> IO BsonDoc serverShutdown c =-  runCommand c (s2L "admin") $ toBsonDoc [("shutdown", toBson (1::Int))]+  runCommand c (s2L "admin") $ toBsonDoc [("shutdown", BsonInt32 1)]  -- | Return a list of collections in /Database/. collectionNames :: Connection -> Database -> IO [FullCollection] collectionNames c db = do   docs <- quickFind' c (L.append db $ s2L ".system.namespaces") empty-  let names = flip List.map docs $ fromBson . fromLookup . BSON.lookup "name"+  let names = flip List.map docs $+              fromBson . fromLookup . List.lookup (s2L "name")   return $ List.filter (L.notElem $ c2w '$') names  data ColCreateOpt = CCOSize Int64  -- ^ Desired initial size for the@@ -267,7 +291,7 @@ validateCollection c col = do   let (db, col') = splitFullCol col   res <- runCommand c db $ toBsonDoc [("validate", toBson col')]-  return $ fromBson $ fromLookup $ BSON.lookup "result" res+  return $ fromBson $ fromLookup $ List.lookup (s2L "result") res  splitFullCol :: FullCollection -> (Database, Collection) splitFullCol col = (L.takeWhile (c2w '.' /=) col,@@ -287,9 +311,9 @@ runCommand c db cmd = do   mres <- findOne c (L.append db $ s2L ".$cmd") cmd   let res = fromLookup mres-  when (1 /= (fromBson $ fromLookup $ BSON.lookup "ok" res :: Int)) $+  when (BsonDouble 1.0 /= fromLookup (List.lookup (s2L "ok") res)) $        throwOpFailure $ "command \"" ++ show cmd ++ "\" failed: " ++-                      fromBson (fromLookup $ BSON.lookup "errmsg" res)+                      fromBson (fromLookup $ List.lookup (s2L "errmsg") res)   return res  -- | An Iterator over the results of a query. Use 'nextDoc' to get each@@ -437,6 +461,8 @@ type Username = String type Password = String +type JSCode = L8.ByteString+ -- | Options that control the behavior of a 'query' operation. data QueryOpt = QOTailableCursor               | QOSlaveOK@@ -461,16 +487,17 @@                         flip fmap flags $ (1 `shiftL`) . fromEnum  -- | Return the number of documents in /FullCollection/.-count :: Connection -> FullCollection -> IO Int64+count :: Connection -> FullCollection -> IO Integer count c col = countMatching c col empty  -- | Return the number of documents in /FullCollection/ matching /Selector/-countMatching :: Connection -> FullCollection -> Selector -> IO Int64+countMatching :: Connection -> FullCollection -> Selector -> IO Integer countMatching c col sel = do   let (db, col') = splitFullCol col   res <- runCommand c db $ toBsonDoc [("count", toBson col'),                                       ("query", toBson sel)]-  return $ fromBson $ fromLookup $ BSON.lookup "n" res+  let cnt = (fromBson $ fromLookup $ List.lookup (s2L "n") res :: Double)+  return $ truncate cnt  -- | Delete documents matching /Selector/ from the given /FullCollection/. delete :: Connection -> FullCollection -> Selector -> IO RequestID@@ -488,27 +515,41 @@ remove :: Connection -> FullCollection -> Selector -> IO RequestID remove = delete --- | Insert a single document into /FullCollection/.-insert :: Connection -> FullCollection -> BsonDoc -> IO RequestID+moveOidToFrontOrGen :: Connection -> BsonDoc -> IO BsonDoc+moveOidToFrontOrGen c doc =+    case List.lookup (s2L "_id") doc of+      Nothing -> do+        oid <- genObjectId $ cOidGen c+        return $ (s2L "_id", oid) : doc+      Just oid -> do+        let keyEq = (\(k1, _) (k2, _) -> k1 == k2)+            delByKey = \k -> List.deleteBy keyEq (k, undefined)+        return $ (s2L "_id", oid) : delByKey (s2L "_id") doc++-- | Insert a single document into /FullCollection/ returning the /_id/ field.+insert :: Connection -> FullCollection -> BsonDoc -> IO BsonValue insert c col doc = do+  doc' <- moveOidToFrontOrGen c doc   let body = runPut $ do                      putI32 0                      putCol col-                     putBsonDoc doc-  (reqID, msg) <- packMsg c OPInsert body+                     putBsonDoc doc'+  (_reqID, msg) <- packMsg c OPInsert body   cPut c msg-  return reqID+  return $ snd $ head doc' --- | Insert a list of documents into /FullCollection/.-insertMany :: Connection -> FullCollection -> [BsonDoc] -> IO RequestID+-- | Insert a list of documents into /FullCollection/ returing the+-- /_id/ field for each one in the same order as they were given.+insertMany :: Connection -> FullCollection -> [BsonDoc] -> IO [BsonValue] insertMany c col docs = do+  docs' <- mapM (moveOidToFrontOrGen c) docs   let body = runPut $ do                putI32 0                putCol col-               forM_ docs putBsonDoc-  (reqID, msg) <- packMsg c OPInsert body+               forM_ docs' putBsonDoc+  (_, msg) <- packMsg c OPInsert body   cPut c msg-  return reqID+  return $ List.map (snd . head) docs'  -- | Open a cursor to find documents. If you need full functionality, -- see 'query'@@ -585,7 +626,7 @@ login :: Connection -> Database -> Username -> Password -> IO BsonDoc login c db user pass = do   doc <- runCommand c db (toBsonDoc [("getnonce", toBson (1 :: Int))])-  let nonce = fromBson $ fromLookup $ BSON.lookup "nonce" doc :: String+  let nonce = fromBson $ fromLookup $ List.lookup (s2L "nonce") doc :: String       digest = md5sum $ pack $ nonce ++ user ++                        md5sum (pack (user ++ ":mongo:" ++ pass))       request = toBsonDoc [("authenticate", toBson (1 :: Int)),@@ -608,19 +649,137 @@       fdb = L.append db (s2L ".system.users")   doc <- findOne c fdb userDoc   let pwd = md5sum $ pack (user ++ ":mongo:" ++ pass)-      doc' = Map.insert (s2L "pwd") (toBson pwd) (fromMaybe userDoc doc)+      doc' = (s2L "pwd", toBson pwd) :+             List.deleteBy (\(k1,_) (k2,_) -> (k1 == k2))+                           (s2L user, undefined)+                           (fromMaybe userDoc doc)   _ <- save c fdb doc'   return doc' +data MapReduceOpt+    = MROptQuery BsonDoc      -- ^ query filter object++    -- | MRSort ???? TODO  <sort the query.  useful for optimization>++    | MROptLimit Int64        -- ^ number of objects to return from+                              -- collection++    | MROptOut L8.ByteString  -- ^ output-collection name++    | MROptKeepTemp           -- ^ If set the generated collection is+                              -- not treated as temporary, as it will+                              -- be by defualt. When /MROptOut/ is+                              -- specified, the collection is+                              -- automatically made permanent.++    | MROptFinalize JSCode    -- ^ function to apply to all the+                              -- results when finished++    | MROptScope BsonDoc      -- ^ can pass in variables that can be+                              -- access from map/reduce/finalize++    | MROptVerbose            -- ^ provide statistics on job execution+                              -- time++mrOptToTuple :: MapReduceOpt -> (String, BsonValue)+mrOptToTuple (MROptQuery q)    = ("query", BsonDoc q)+mrOptToTuple (MROptLimit l)    = ("limit", BsonInt64 l)+mrOptToTuple (MROptOut c)      = ("out", BsonString c)+mrOptToTuple MROptKeepTemp     = ("keeptemp", BsonBool True)+mrOptToTuple (MROptFinalize f) = ("finalize", BsonJSCode f)+mrOptToTuple (MROptScope s)    = ("scope", BsonDoc s)+mrOptToTuple MROptVerbose      = ("verbose", BsonBool True)++-- | Issue a map/reduce command and return the results metadata.  If+-- all you care about is the actual map/reduce results you might want+-- to use the 'mapReduce' command instead.+--+-- The results meta-document will look something like this:+--+-- > {"result": "tmp.mr.mapreduce_1268095152_14",+-- >  "timeMillis": 67,+-- >  "counts": {"input": 4,+-- >             "emit": 6,+-- >             "output": 3},+-- >  "ok": 1.0}+--+-- The /results/ field is the collection name within the same Database+-- that contain the results of the map/reduce.+runMapReduce :: Connection -> FullCollection+          -> JSCode -- ^ mapping javascript function+          -> JSCode -- ^ reducing javascript function+          -> [MapReduceOpt]+          -> IO BsonDoc+runMapReduce c fc m r opts = do+  let (db, col) = splitFullCol fc+      doc = [("mapreduce", toBson col),+             ("map", BsonJSCode m),+             ("reduce", BsonJSCode r)] ++ List.map mrOptToTuple opts+  runCommand c db $ toBsonDoc doc++-- | Issue a map/reduce command with associated scopes and return the+-- results metadata. If all you care about is the actual map/reduce+-- results you might want to use the 'mapReduce' command instead.+--+-- See 'runMapReduce' for more information about the form of the+-- result metadata.+runMapReduceWScopes :: Connection -> FullCollection+          -> JSCode -- ^ mapping javascript function+          -> BsonDoc -- ^ Scope for mapping function+          -> JSCode -- ^ reducing javascript function+          -> BsonDoc -- ^ Scope for reducing function+          -> [MapReduceOpt]+          -> IO BsonDoc+runMapReduceWScopes c fc m ms r rs opts = do+  let (db, col) = splitFullCol fc+      doc = [("mapreduce", toBson col),+             ("map", BsonJSCodeWScope m ms),+             ("reduce", BsonJSCodeWScope r rs)] ++ List.map mrOptToTuple opts+  runCommand c db $ toBsonDoc doc++-- | Given a result metadata from a 'mapReduce' command (or+-- 'mapReduceWScope'), issue the 'find' command that will produce the+-- actual map/reduce results.+mapReduceResults :: Connection -> Database -> BsonDoc -> IO Cursor+mapReduceResults c db r = do+  let col = case List.lookup (s2L "result") r of+              Just bCol -> fromBson bCol+              Nothing -> throwOpFailure "No 'result' in mapReduce response"+      fc = L.append (L.append db $ s2L ".") col+  find c fc []++-- | Run map/reduce and produce a cursor on the results.+mapReduce :: Connection -> FullCollection+          -> JSCode -- ^ mapping javascript function+          -> JSCode -- ^ reducing javascript function+          -> [MapReduceOpt]+          -> IO Cursor+mapReduce c fc m r opts =+    runMapReduce c fc m r opts >>= mapReduceResults c (fst $ splitFullCol fc)++-- | Run map/reduce with associated scopes and produce a cursor on the+-- results.+mapReduceWScopes :: Connection -> FullCollection+          -> JSCode -- ^ mapping javascript function+          -> BsonDoc -- ^ Scope for mapping function+          -> JSCode -- ^ reducing javascript function+          -> BsonDoc -- ^ Scope for mapping function+          -> [MapReduceOpt]+          -> IO Cursor+mapReduceWScopes c fc m ms r rs opts =+    runMapReduceWScopes c fc m ms r rs opts >>=+    mapReduceResults c (fst $ splitFullCol fc)+ -- | Conveniently stores the /BsonDoc/ to the /FullCollection/ -- if there is an _id present in the /BsonDoc/ then it already has -- a place in the DB, so we update it using the _id, otherwise -- we insert it-save :: Connection -> FullCollection -> BsonDoc -> IO RequestID+save :: Connection -> FullCollection -> BsonDoc -> IO BsonValue save c fc doc =-  case Map.lookup (s2L "_id") doc of+  case List.lookup (s2L "_id") doc of     Nothing -> insert c fc doc-    Just obj -> update c fc [UFUpsert] (toBsonDoc [("_id", obj)]) doc+    Just oid -> update c fc [UFUpsert] (toBsonDoc [("_id", oid)]) doc >>+                return oid  -- | Use this in the place of the query portion of a select type query -- This uses javascript and a scope supplied by a /BsonDoc/ to evaluate@@ -629,9 +788,11 @@ -- Example: -- -- > findOne conn mycoll $ whereClause "this.name == (name1 + name2)"--- >     (toBsonDoc [("name1", toBson "mar"), ("name2", toBson "tha")])-whereClause :: String -> BsonDoc -> BsonDoc-whereClause qry scope = toBsonDoc [("$where", BsonCodeWScope (s2L qry) scope)]+-- >     Just (toBsonDoc [("name1", toBson "mar"), ("name2", toBson "tha")])+whereClause :: String -> Maybe BsonDoc -> BsonDoc+whereClause qry Nothing = toBsonDoc [("$where", BsonJSCode (s2L qry))]+whereClause qry (Just scope) =+    toBsonDoc [("$where", BsonJSCodeWScope (s2L qry) scope)]  data Hdr = Hdr {       hMsgLen :: Int32,

@@ -30,107 +30,92 @@      BsonDoc,      BinarySubType(..),      -- * BsonDoc Operations-     empty, lookup,+     empty,      -- * Type Conversion      fromBson, toBson,      fromBsonDoc, toBsonDoc,      -- * Binary encoding/decoding      getBsonDoc, putBsonDoc,+     -- * ObjectId creation+     ObjectIdGen, mkObjectIdGen, genObjectId,     ) where import Prelude hiding (lookup) +import qualified Control.Arrow as Arrow+import Control.Exception import Control.Monad import Data.Binary import Data.Binary.Get import Data.Binary.IEEE754 import Data.Binary.Put+import Data.Bits import Data.ByteString.Char8 as C8 hiding (empty) import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.UTF8 as L8 import qualified Data.ByteString.UTF8 as S8-import Data.Convertible+import Data.Digest.OpenSSL.MD5 import Data.Int-import qualified Data.Map as Map+import Data.IORef import qualified Data.List as List+import qualified Data.Map as Map import Data.Time.Clock.POSIX import Data.Typeable import Database.MongoDB.Util+import Network.BSD+import Numeric+import System.IO.Unsafe+import System.Posix.Process  -- | BsonValue is the type that can be used as a key in a 'BsonDoc'. data BsonValue     = BsonDouble Double     | BsonString L8.ByteString-    | BsonObject BsonDoc+    | BsonDoc BsonDoc     | BsonArray [BsonValue]     | BsonUndefined     | BsonBinary BinarySubType L.ByteString-    | BsonObjectId L.ByteString+    | BsonObjectId Integer     | BsonBool !Bool     | BsonDate POSIXTime     | BsonNull     | BsonRegex L8.ByteString String+    | BsonJSCode L8.ByteString     | BsonSymbol L8.ByteString+    | BsonJSCodeWScope L8.ByteString BsonDoc     | BsonInt32 Int32     | BsonInt64 Int64-    | BsonCodeWScope L8.ByteString BsonDoc     | BsonMinKey     | BsonMaxKey     deriving (Show, Eq, Ord) -instance Typeable BsonValue where-    typeOf _ = mkTypeName "BsonValue"---- | BSON Document: this is the top-level (but recursive) type that--- all MongoDB collections work in terms of. It is a mapping between--- strings ('Data.ByteString.Lazu.UTF8.ByteString') and 'BsonValue's.--- It can be constructed either from a 'Map' (eg @'BsonDoc' myMap@) or--- from a associative list (eg @'toBsonDoc' myAL@).-type BsonDoc = Map.Map L8.ByteString BsonValue--class BsonDocOps a where-    -- | Construct a BsonDoc from an associative list-    toBsonDoc :: [(a, BsonValue)] -> BsonDoc-    -- | Unwrap BsonDoc to be a Map-    fromBsonDoc :: BsonDoc -> [(a, BsonValue)]-    -- | Return the BsonValue for given key, if any.-    lookup :: a -> BsonDoc -> Maybe BsonValue+type BsonDoc = [(L8.ByteString, BsonValue)]  -- | An empty BsonDoc empty :: BsonDoc-empty = Map.empty--instance BsonDocOps L8.ByteString where-    toBsonDoc = Map.fromList-    fromBsonDoc = Map.toList-    lookup = Map.lookup--instance BsonDocOps String where-    toBsonDoc = Map.mapKeys L8.fromString .Map.fromList-    fromBsonDoc = Map.toList . Map.mapKeys L8.toString-    lookup = Map.lookup . L8.fromString+empty = []  data DataType =-    DataMinKey     | -- -1-    DataNumber     | -- 1-    DataString     | -- 2-    DataObject	   | -- 3-    DataArray      | -- 4-    DataBinary     | -- 5-    DataUndefined  | -- 6-    DataOid        | -- 7-    DataBoolean    | -- 8-    DataDate       | -- 9-    DataNull       | -- 10-    DataRegex      | -- 11-    DataRef        | -- 12-    DataCode       | -- 13-    DataSymbol	   | -- 14-    DataCodeWScope | -- 15-    DataInt        | -- 16-    DataTimestamp  | -- 17-    DataLong       | -- 18-    DataMaxKey       -- 127+    DataMinKey       | -- -1+    DataNumber       | -- 1+    DataString       | -- 2+    DataDoc          | -- 3+    DataArray        | -- 4+    DataBinary       | -- 5+    DataUndefined    | -- 6+    DataOid          | -- 7+    DataBoolean      | -- 8+    DataDate         | -- 9+    DataNull         | -- 10+    DataRegex        | -- 11+    DataRef          | -- 12+    DataJSCode       | -- 13+    DataSymbol       | -- 14+    DataJSCodeWScope | -- 15+    DataInt          | -- 16+    DataTimestamp    | -- 17+    DataLong         | -- 18+    DataMaxKey         -- 127     deriving (Show, Read, Enum, Eq, Ord)  toDataType :: Int -> DataType@@ -138,10 +123,10 @@ toDataType 127 = DataMaxKey toDataType d = toEnum d -fromDataType :: DataType -> Int+fromDataType :: DataType -> Int8 fromDataType DataMinKey = - 1 fromDataType DataMaxKey = 127-fromDataType d = fromEnum d+fromDataType d = fromIntegral $ fromEnum d  data BinarySubType =     BSTUNDEFINED1      |@@ -157,10 +142,36 @@ toBinarySubType 0x80 = BSTUserDefined toBinarySubType d = toEnum d -fromBinarySubType :: BinarySubType -> Int+fromBinarySubType :: BinarySubType -> Int8 fromBinarySubType BSTUserDefined = 0x80-fromBinarySubType d = fromEnum d+fromBinarySubType d = fromIntegral $ fromEnum d +data ObjectIdGen = ObjectIdGen {+      oigMachine :: Integer,+      oigInc :: IORef Integer+    }++globalObjectIdInc :: IORef Integer+{-# NOINLINE globalObjectIdInc #-}+globalObjectIdInc = unsafePerformIO (newIORef 0)++mkObjectIdGen :: IO ObjectIdGen+mkObjectIdGen = do+  host <- liftM (fst . (!! 0) . readHex . List.take 6 . md5sum . C8.pack)+                getHostName+  return ObjectIdGen {oigMachine = host, oigInc = globalObjectIdInc}++genObjectId :: ObjectIdGen -> IO BsonValue+genObjectId oig = do+  now <- liftM (truncate . (realToFrac :: POSIXTime -> Double)) getPOSIXTime+  pid <- liftM fromIntegral getProcessID+  inc <- atomicModifyIORef (oigInc oig) $ \i -> ((i+1) `rem` 0x10000, i)+  return $ BsonObjectId+             ((now `shiftL` 64) .|.+              oigMachine oig `shiftL` 40 .|.+              (0xffff .&. pid) `shiftL` 24 .|.+              (inc `div` 0x100) `shiftL` 8 .|. (inc `rem` 0x100))+ getBsonDoc :: Get BsonDoc getBsonDoc = liftM snd getDoc @@ -173,34 +184,48 @@   sLen1 <- getI32   (_sLen2, s) <- getS   return (fromIntegral $ 4 + sLen1, BsonString s)-getVal DataObject = getDoc >>= \(len, obj) -> return (len, BsonObject obj)+getVal DataDoc = getDoc >>= \(len, obj) -> return (len, BsonDoc obj) getVal DataArray = do-  (len, arr) <- getRawObj-  let arr2 = Map.fold (:) [] arr -- reverse and remove key-  return (len, BsonArray arr2)+  bytes <- getI32+  arr <- getInnerArray (bytes - 4)+  getNull+  return (fromIntegral bytes, BsonArray arr) getVal DataBinary = do-  skip 4-  st   <- getI8-  len2 <- getI32-  bs   <- getLazyByteString $ fromIntegral len2-  return (4 + 1 + 4 + fromIntegral len2, BsonBinary (toBinarySubType st) bs)+  len1 <- getI32+  st <- getI8+  (len, hdrLen) <- if toBinarySubType st == BSTByteArray+                     then do+                       len2 <- getI32+                       assert (len1 - 4 == len2) $ return ()+                       return (len2, 4 + 1 + 4)+                     else return (len1, 4 + 1)+  bs <- getLazyByteString $ fromIntegral len+  return (hdrLen + fromIntegral len, BsonBinary (toBinarySubType st) bs)+ getVal DataUndefined = return (1, BsonUndefined)-getVal DataOid = liftM ((,) 12 . BsonObjectId) $ getLazyByteString 12+getVal DataOid = do+  oid1 <- getWord64be+  oid2 <- getWord32be+  let oid = (fromIntegral oid1 `shiftL` 32) .|. fromIntegral oid2+  return (12, BsonObjectId oid) getVal DataBoolean = liftM ((,) (1::Integer) . BsonBool . (/= (0::Int))) getI8 getVal DataDate = liftM ((,) 8 . BsonDate . flip (/) 1000 . realToFrac) getI64 getVal DataNull = return (1, BsonNull)-getVal DataRegex = fail "DataCode not yet supported" -- TODO+getVal DataRegex = fail "DataJSCode not yet supported" -- TODO getVal DataRef = fail "DataRef is deprecated"-getVal DataCode = fail "DataCode not yet supported" -- TODO+getVal DataJSCode = do+  sLen1 <- getI32+  (_sLen2, s) <- getS+  return (fromIntegral $ 4 + sLen1, BsonJSCode s) getVal DataSymbol = do   sLen1 <- getI32   (_sLen2, s) <- getS   return (fromIntegral $ 4 + sLen1, BsonString s)-getVal DataCodeWScope = do+getVal DataJSCodeWScope = do   sLen1 <- getI32   (_, qry) <- getS   (_, scope) <- getDoc-  return (fromIntegral sLen1, BsonCodeWScope qry scope)+  return (fromIntegral sLen1, BsonJSCodeWScope qry scope) getVal DataInt = liftM ((,) 4 . BsonInt32 . fromIntegral) getI32 getVal DataTimestamp = fail "DataTimestamp not yet supported" -- TODO @@ -208,22 +233,32 @@ getVal DataMinKey = return (0, BsonMinKey) getVal DataMaxKey = return (0, BsonMaxKey) -getInnerObj :: Int32 -> BsonDoc -> Get BsonDoc-getInnerObj 1 obj = return obj-getInnerObj bytesLeft obj = do+getInnerObj :: Int32 -> Get BsonDoc+getInnerObj 1 = return []+getInnerObj bytesLeft = do   typ <- getDataType   (keySz, key) <- getS   (valSz, val) <- getVal typ-  getInnerObj (bytesLeft - 1 - fromIntegral keySz - fromIntegral valSz) $-              Map.insert key val obj+  rest <- getInnerObj (bytesLeft - 1 - fromIntegral keySz - fromIntegral valSz)+  return $ (key, val) : rest  getRawObj :: Get (Integer, BsonDoc) getRawObj = do   bytes <- getI32-  obj <- getInnerObj (bytes - 4) empty+  obj <- getInnerObj (bytes - 4)   getNull   return (fromIntegral bytes, obj) +getInnerArray :: Int32 -> Get [BsonValue]+getInnerArray 1 = return []+getInnerArray bytesLeft = do+  typ <- getDataType+  (keySz, _key) <- getS+  (valSz, val) <- getVal typ+  rest <- getInnerArray+          (bytesLeft - 1 - fromIntegral keySz - fromIntegral valSz)+  return $ val : rest+ getDoc :: Get (Integer, BsonDoc) getDoc = getRawObj @@ -233,7 +268,7 @@ putType :: BsonValue -> Put putType BsonDouble{}   = putDataType DataNumber putType BsonString{}   = putDataType DataString-putType BsonObject{}   = putDataType DataObject+putType BsonDoc{}      = putDataType DataDoc putType BsonArray{}    = putDataType DataArray putType BsonBinary{}   = putDataType DataBinary putType BsonUndefined  = putDataType DataUndefined@@ -243,9 +278,9 @@ putType BsonNull       = putDataType DataNull putType BsonRegex{}    = putDataType DataRegex -- putType = putDataType DataRef--- putType = putDataType DataCode+putType BsonJSCode {}  = putDataType DataJSCode putType BsonSymbol{}   = putDataType DataSymbol-putType BsonCodeWScope{} = putDataType DataCodeWScope+putType BsonJSCodeWScope{} = putDataType DataJSCodeWScope putType BsonInt32 {}   = putDataType DataInt putType BsonInt64 {}   = putDataType DataLong -- putType = putDataType DataTimestamp@@ -255,7 +290,7 @@ putVal :: BsonValue -> Put putVal (BsonDouble d)   = putFloat64le d putVal (BsonString s)   = putStrSz s-putVal (BsonObject o)   = putObj o+putVal (BsonDoc o)      = putObj o putVal (BsonArray es)   = putOutterObj bs     where bs = runPut $ forM_ (List.zip [(0::Int) .. ] es) $ \(i, e) ->                putType e >> putS (L8.fromString $ show i) >> putVal e@@ -264,27 +299,28 @@                              putI32 $ fromIntegral $ L.length bs                              putLazyByteString bs putVal BsonUndefined    = putNothing-putVal (BsonObjectId o) = putLazyByteString o-putVal (BsonBool False) = putI8 (0::Int)-putVal (BsonBool True)  = putI8 (1::Int)+putVal (BsonObjectId o) = putWord64be (fromIntegral $ o `shiftR` 32) >>+                          putWord32be (fromIntegral $ o .&. 0xffffffff)+putVal (BsonBool False) = putI8 0+putVal (BsonBool True)  = putI8 1 putVal (BsonDate pt)    = putI64 $ round $ 1000 * (realToFrac pt :: Double) putVal BsonNull         = putNothing putVal (BsonRegex r opt)= do putS r                              putByteString $ pack $ List.sort opt                              putNull+putVal (BsonJSCode c)   = putStrSz c putVal (BsonSymbol s)   = putI32 (fromIntegral $ 1 + L8.length s) >> putS s-putVal (BsonInt32 i)    = putI32 i-putVal (BsonInt64 i)    = putI64 i-putVal (BsonCodeWScope q s) =+putVal (BsonJSCodeWScope q s) =   let bytes = runPut (putStrSz q >> putObj s)     in putI32 ((+4) $ fromIntegral $ L.length bytes) >> putLazyByteString bytes+putVal (BsonInt32 i)    = putI32 i+putVal (BsonInt64 i)    = putI64 i putVal BsonMinKey       = putNothing putVal BsonMaxKey       = putNothing  putObj :: BsonDoc -> Put putObj obj   = putOutterObj bs-    where bs = runPut $ forM_ (fromBsonDoc obj) $ \(k, v) ->-               putType v >> putS k >> putVal v+    where bs = runPut $ forM_ obj $ \(k, v) -> putType v >> putS k >> putVal v  putOutterObj :: L.ByteString -> Put putOutterObj bytes = do@@ -296,214 +332,290 @@ putDataType :: DataType -> Put putDataType = putI8 . fromDataType -class BsonConv a b where-    -- | Convert a BsonValue into a native Haskell type.-    fromBson :: Convertible a b => a -> b-    -- | Convert a native Haskell type into a BsonValue.-    toBson :: Convertible b a => b -> a--instance BsonConv BsonValue a where-    fromBson = convert-    toBson = convert+class BsonDocConv a where+    -- | Convert a BsonDoc into another form such as a Map or a tuple+    -- list with String keys.+    fromBsonDoc :: BsonDoc -> a+    -- | Convert a Map or a tuple list with String keys into a BsonDoc.+    toBsonDoc :: a -> BsonDoc -instance BsonConv (Maybe BsonValue) (Maybe a) where-    fromBson = convert-    toBson = convert+instance BsonDocConv [(L8.ByteString, BsonValue)] where+    fromBsonDoc = id+    toBsonDoc = id -unsupportedError :: (Typeable a, Convertible BsonValue a) =>-                    BsonValue -> ConvertResult a-unsupportedError = convError "Unsupported conversion"+instance BsonDocConv [(String, BsonValue)] where+    fromBsonDoc = List.map $ Arrow.first L8.toString+    toBsonDoc = List.map $ Arrow.first L8.fromString -instance Convertible Double BsonValue where-    safeConvert = return . BsonDouble+instance BsonDocConv (Map.Map L8.ByteString BsonValue) where+    fromBsonDoc = Map.fromList+    toBsonDoc = Map.toList -instance Convertible Float BsonValue where-    safeConvert = return . BsonDouble . realToFrac+instance BsonDocConv (Map.Map String BsonValue) where+    fromBsonDoc = Map.fromList . fromBsonDoc+    toBsonDoc = toBsonDoc . Map.toList -instance Convertible String BsonValue where-    safeConvert = return . BsonString . L8.fromString+data BsonUnsupportedConversion = BsonUnsupportedConversion+                                 deriving (Eq, Show, Read) -instance Convertible L8.ByteString BsonValue where-    safeConvert = return . BsonString+bsonUnsupportedConversion :: TyCon+bsonUnsupportedConversion =+    mkTyCon "Database.MongoDB.BSON.BsonUnsupportedConversion " -instance Convertible S8.ByteString BsonValue where-    safeConvert = return . BsonString . L.fromChunks . return+instance Typeable BsonUnsupportedConversion where+    typeOf _ = mkTyConApp bsonUnsupportedConversion [] -instance Convertible [Double] BsonValue where-    safeConvert ds = BsonArray `liftM` mapM safeConvert ds+instance Exception BsonUnsupportedConversion -instance Convertible [Float] BsonValue where-    safeConvert fs = BsonArray `liftM` mapM safeConvert fs+throwUnsupConv :: a+throwUnsupConv = throw BsonUnsupportedConversion -instance Convertible [String] BsonValue where-    safeConvert ss = BsonArray `liftM` mapM safeConvert ss+class BsonConv a where+    -- | Convert a native Haskell type into a BsonValue.+    toBson :: a -> BsonValue+    -- | Convert a BsonValue into a native Haskell type.+    fromBson :: BsonValue -> a -instance Convertible [L8.ByteString] BsonValue where-    safeConvert bs = BsonArray `liftM` mapM safeConvert bs+instance BsonConv Double where+    toBson = BsonDouble+    fromBson (BsonDouble d) = d+    fromBson _ = throwUnsupConv -instance Convertible [S8.ByteString] BsonValue where-    safeConvert bs = BsonArray `liftM` mapM safeConvert bs+instance BsonConv Float where+    toBson = BsonDouble . realToFrac+    fromBson (BsonDouble d) = realToFrac d+    fromBson _ = throwUnsupConv -instance Convertible BsonDoc BsonValue where-    safeConvert = return . BsonObject+instance BsonConv L8.ByteString where+    toBson = BsonString+    fromBson (BsonString s) = s+    fromBson _ = throwUnsupConv -instance Convertible (Map.Map String BsonValue) BsonValue where-    safeConvert = return . BsonObject . Map.mapKeys L8.fromString+instance BsonConv String where+    toBson = BsonString . L8.fromString+    fromBson (BsonString s) = L8.toString s+    fromBson _ = throwUnsupConv -instance Convertible [(L8.ByteString, BsonValue)] BsonValue where-    safeConvert = return . BsonObject . toBsonDoc+instance BsonConv S8.ByteString where+    toBson bs = BsonString $ L.fromChunks [bs]+    fromBson (BsonString s) = C8.concat $ L.toChunks s+    fromBson _ = throwUnsupConv -instance Convertible [(String, BsonValue)] BsonValue where-    safeConvert = return . BsonObject . toBsonDoc+instance  BsonConv BsonDoc where+    toBson = BsonDoc+    fromBson (BsonDoc d) = d+    fromBson _ = throwUnsupConv -instance Convertible [Bool] BsonValue where-    safeConvert bs = BsonArray `liftM` mapM safeConvert bs+instance BsonConv [(String, BsonValue)] where+    toBson = toBson . toBsonDoc+    fromBson (BsonDoc d) = fromBsonDoc d+    fromBson _ = throwUnsupConv -instance Convertible [POSIXTime] BsonValue where-    safeConvert ts = BsonArray `liftM` mapM safeConvert ts+instance BsonConv (Map.Map L8.ByteString BsonValue) where+    toBson = toBson . toBsonDoc+    fromBson (BsonDoc d) = fromBsonDoc d+    fromBson _ = throwUnsupConv -instance Convertible [Int] BsonValue where-    safeConvert is = BsonArray `liftM` mapM safeConvert is+instance BsonConv (Map.Map String BsonValue) where+    toBson = toBson . toBsonDoc+    fromBson (BsonDoc d) = fromBsonDoc d+    fromBson _ = throwUnsupConv -instance Convertible [Integer] BsonValue where-    safeConvert is = BsonArray `liftM` mapM safeConvert is+instance BsonConv POSIXTime where+    toBson = BsonDate+    fromBson (BsonDate d) = d+    fromBson _ = throwUnsupConv -instance Convertible [Int32] BsonValue where-    safeConvert is = BsonArray `liftM` mapM safeConvert is+instance BsonConv Bool where+    toBson = BsonBool+    fromBson (BsonBool b) = b+    fromBson _ = throwUnsupConv -instance Convertible [Int64] BsonValue where-    safeConvert is = BsonArray `liftM` mapM safeConvert is+instance BsonConv Int where+    toBson i | i >= fromIntegral (minBound::Int32) &&+               i <= fromIntegral (maxBound::Int32) = BsonInt32 $ fromIntegral i+             | otherwise = BsonInt64 $ fromIntegral i+    fromBson (BsonInt32 i) = fromIntegral i+    fromBson (BsonInt64 i) = fromIntegral i+    fromBson _ = throwUnsupConv -instance Convertible POSIXTime BsonValue where-    safeConvert = return . BsonDate+instance BsonConv Int8 where+    toBson i | i >= fromIntegral (minBound::Int32) &&+               i <= fromIntegral (maxBound::Int32) = BsonInt32 $ fromIntegral i+             | otherwise = BsonInt64 $ fromIntegral i+    fromBson (BsonInt32 i) = fromIntegral i+    fromBson (BsonInt64 i) = fromIntegral i+    fromBson _ = throwUnsupConv -instance Convertible Bool BsonValue where-    safeConvert = return . BsonBool+instance BsonConv Int16 where+    toBson i | i >= fromIntegral (minBound::Int32) &&+               i <= fromIntegral (maxBound::Int32) = BsonInt32 $ fromIntegral i+             | otherwise = BsonInt64 $ fromIntegral i+    fromBson (BsonInt32 i) = fromIntegral i+    fromBson (BsonInt64 i) = fromIntegral i+    fromBson _ = throwUnsupConv -instance Convertible Int BsonValue where-    safeConvert i = if i >= fromIntegral (minBound::Int32) &&-                       i <= fromIntegral (maxBound::Int32)-                    then return $ BsonInt32 $ fromIntegral i-                    else return $ BsonInt64 $ fromIntegral i+instance BsonConv Int32 where+    toBson i | i >= fromIntegral (minBound::Int32) &&+               i <= fromIntegral (maxBound::Int32) = BsonInt32 $ fromIntegral i+             | otherwise = BsonInt64 $ fromIntegral i+    fromBson (BsonInt32 i) = fromIntegral i+    fromBson (BsonInt64 i) = fromIntegral i+    fromBson _ = throwUnsupConv -instance Convertible Integer BsonValue where-    safeConvert i = if i >= fromIntegral (minBound::Int32) &&-                       i <= fromIntegral (maxBound::Int32)-                    then return $ BsonInt32 $ fromIntegral i-                    else return $ BsonInt64 $ fromIntegral i+instance BsonConv Int64 where+    toBson i | i >= fromIntegral (minBound::Int32) &&+               i <= fromIntegral (maxBound::Int32) = BsonInt32 $ fromIntegral i+             | otherwise = BsonInt64 $ fromIntegral i+    fromBson (BsonInt32 i) = fromIntegral i+    fromBson (BsonInt64 i) = fromIntegral i+    fromBson _ = throwUnsupConv -instance Convertible Int32 BsonValue where-    safeConvert = return . BsonInt32+instance BsonConv Integer where+    toBson i | i >= fromIntegral (minBound::Int32) &&+               i <= fromIntegral (maxBound::Int32) = BsonInt32 $ fromIntegral i+             | otherwise = BsonInt64 $ fromIntegral i+    fromBson (BsonInt32 i) = fromIntegral i+    fromBson (BsonInt64 i) = fromIntegral i+    fromBson _ = throwUnsupConv -instance Convertible Int64 BsonValue where-    safeConvert = return . BsonInt64+instance BsonConv Word where+    toBson i | i >= fromIntegral (minBound::Int32) &&+               i <= fromIntegral (maxBound::Int32) = BsonInt32 $ fromIntegral i+             | otherwise = BsonInt64 $ fromIntegral i+    fromBson (BsonInt32 i) = fromIntegral i+    fromBson (BsonInt64 i) = fromIntegral i+    fromBson _ = throwUnsupConv -instance (Convertible a BsonValue) =>-    Convertible (Maybe a) BsonValue where-        safeConvert Nothing = return BsonNull-        safeConvert (Just a) = safeConvert a+instance BsonConv Word8 where+    toBson i | i >= fromIntegral (minBound::Int32) &&+               i <= fromIntegral (maxBound::Int32) = BsonInt32 $ fromIntegral i+             | otherwise = BsonInt64 $ fromIntegral i+    fromBson (BsonInt32 i) = fromIntegral i+    fromBson (BsonInt64 i) = fromIntegral i+    fromBson _ = throwUnsupConv -instance Convertible BsonValue Double where-    safeConvert (BsonDouble d) = return d-    safeConvert (BsonInt32 i) = safeConvert i-    safeConvert (BsonInt64 i) = safeConvert i-    safeConvert v = unsupportedError v+instance BsonConv Word16 where+    toBson i | i >= fromIntegral (minBound::Int32) &&+               i <= fromIntegral (maxBound::Int32) = BsonInt32 $ fromIntegral i+             | otherwise = BsonInt64 $ fromIntegral i+    fromBson (BsonInt32 i) = fromIntegral i+    fromBson (BsonInt64 i) = fromIntegral i+    fromBson _ = throwUnsupConv -instance Convertible BsonValue Float where-    safeConvert (BsonDouble d) = safeConvert d-    safeConvert (BsonInt32 i) = safeConvert i-    safeConvert (BsonInt64 i) = safeConvert i-    safeConvert v = unsupportedError v+instance BsonConv Word32 where+    toBson i | i >= fromIntegral (minBound::Int32) &&+               i <= fromIntegral (maxBound::Int32) = BsonInt32 $ fromIntegral i+             | otherwise = BsonInt64 $ fromIntegral i+    fromBson (BsonInt32 i) = fromIntegral i+    fromBson (BsonInt64 i) = fromIntegral i+    fromBson _ = throwUnsupConv -instance Convertible BsonValue String where-    safeConvert (BsonString bs) = return $ L8.toString bs-    safeConvert v = unsupportedError v+instance BsonConv Word64 where+    toBson i | i >= fromIntegral (minBound::Int32) &&+               i <= fromIntegral (maxBound::Int32) = BsonInt32 $ fromIntegral i+             | otherwise = BsonInt64 $ fromIntegral i+    fromBson (BsonInt32 i) = fromIntegral i+    fromBson (BsonInt64 i) = fromIntegral i+    fromBson _ = throwUnsupConv -instance Convertible BsonValue L8.ByteString where-    safeConvert (BsonString bs) = return bs-    safeConvert v = unsupportedError v+instance BsonConv [Double] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue S8.ByteString where-    safeConvert (BsonString bs) = return $ C8.concat $ L.toChunks bs-    safeConvert v = unsupportedError v+instance BsonConv [Float] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue BsonDoc where-    safeConvert (BsonObject o) = return o-    safeConvert v = unsupportedError v+instance BsonConv [Int] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue (Map.Map String BsonValue) where-    safeConvert (BsonObject o) = return $ Map.mapKeys L8.toString o-    safeConvert v = unsupportedError v+instance BsonConv [Int8] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue [(String, BsonValue)] where-    safeConvert (BsonObject o) = return $ fromBsonDoc o-    safeConvert v = unsupportedError v+instance BsonConv [Int16] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue [(L8.ByteString, BsonValue)] where-    safeConvert (BsonObject o) = return $ fromBsonDoc o-    safeConvert v = unsupportedError v+instance BsonConv [Int32] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue [Double] where-    safeConvert (BsonArray a) = mapM safeConvert a-    safeConvert v = unsupportedError v+instance BsonConv [Int64] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue [Float] where-    safeConvert (BsonArray a) = mapM safeConvert a-    safeConvert v = unsupportedError v+instance BsonConv [Integer] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue [String] where-    safeConvert (BsonArray a) = mapM safeConvert a-    safeConvert v = unsupportedError v+instance BsonConv [Word] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue [Bool] where-    safeConvert (BsonArray a) = mapM safeConvert a-    safeConvert v = unsupportedError v+instance BsonConv [Word8] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue [POSIXTime] where-    safeConvert (BsonArray a) = mapM safeConvert a-    safeConvert v = unsupportedError v+instance BsonConv [Word16] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue [Int32] where-    safeConvert (BsonArray a) = mapM safeConvert a-    safeConvert v = unsupportedError v+instance BsonConv [Word32] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue [Int64] where-    safeConvert (BsonArray a) = mapM safeConvert a-    safeConvert v = unsupportedError v+instance BsonConv [Word64] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue Bool where-    safeConvert (BsonBool b) = return b-    safeConvert v = unsupportedError v+instance BsonConv [Bool] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue POSIXTime where-    safeConvert (BsonDate t) = return t-    safeConvert v = unsupportedError v+instance BsonConv [POSIXTime] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue Int where-    safeConvert (BsonDouble d) = safeConvert d-    safeConvert (BsonInt32 d) = safeConvert d-    safeConvert (BsonInt64 d) = safeConvert d-    safeConvert v = unsupportedError v+instance BsonConv [String] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue Integer where-    safeConvert (BsonDouble d) = safeConvert d-    safeConvert (BsonInt32 d) = safeConvert d-    safeConvert (BsonInt64 d) = safeConvert d-    safeConvert v = unsupportedError v+instance BsonConv [L8.ByteString] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue Int32 where-    safeConvert (BsonDouble d) = safeConvert d-    safeConvert (BsonInt32 d) = return d-    safeConvert (BsonInt64 d) = safeConvert d-    safeConvert v = unsupportedError v+instance BsonConv [S8.ByteString] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance Convertible BsonValue Int64 where-    safeConvert (BsonDouble d) = safeConvert d-    safeConvert (BsonInt32 d) = safeConvert d-    safeConvert (BsonInt64 d) = return d-    safeConvert v = unsupportedError v+instance BsonConv [BsonDoc] where+    toBson = BsonArray . List.map toBson+    fromBson (BsonArray ss) = List.map fromBson ss+    fromBson _ = throwUnsupConv -instance (Convertible BsonValue a) =>-    Convertible (Maybe BsonValue) (Maybe a) where-        safeConvert Nothing = return Nothing-        safeConvert (Just a) = liftM Just $ safeConvert a+instance (BsonConv a) => BsonConv (Maybe a) where+    toBson Nothing = BsonNull+    toBson (Just a) = toBson a+    fromBson BsonNull = Nothing+    fromBson a = Just $ fromBson a

@@ -25,7 +25,7 @@  module Database.MongoDB.Util     (-     putI8, putI32, putI64, putNothing, putNull, putS,+     putI8, putI16, putI32, putI64, putNothing, putNull, putS,      getI8, getI32, getI64, getC, getS, getNull, putStrSz,     ) where@@ -58,9 +58,12 @@ getNull :: Get () getNull = do {c <- getC; assert (c == '\0') $ return ()} -putI8 :: (Integral i) => i -> Put+putI8 :: Int8 -> Put putI8 = putWord8 . fromIntegral +putI16 :: Int16 -> Put+putI16 = putWord16le . fromIntegral+ putI32 :: Int32 -> Put putI32 = putWord32le . fromIntegral @@ -71,7 +74,7 @@ putNothing = putByteString $ pack ""  putNull :: Put-putNull = putI8 (0::Int)+putNull = putI8 0  putS :: L8.ByteString -> Put putS s = putLazyByteString s >> putNull

@@ -1,5 +1,5 @@ Name:                mongoDB-Version:             0.3+Version:             0.4 License:             MIT Maintainer:          Scott Parish <srp@srparish.net> Author:              Scott Parish <srp@srparish.net>@@ -7,7 +7,7 @@ homepage:            http://github.com/srp/mongoDB Category:            Database Synopsis:            A driver for MongoDB-Description:         This driver lets you connect to MongoDB, do inserts,+Description:         This module lets you connect to MongoDB, do inserts,                      queries, updates, etc. Also has many convience functions                      inspired by HDBC such as more easily converting between                      the BsonValue types and native Haskell types.@@ -21,13 +21,14 @@ 		     network, 		     random, 		     time,+		     unix, 		     utf8-string,                      nano-md5 Build-Type:          Simple Exposed-modules:     Database.MongoDB, 		     Database.MongoDB.BSON Other-modules:       Database.MongoDB.Util-ghc-options:         -Wall+ghc-options:         -Wall -O2 extensions:          FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, 		     TypeSynonymInstances cabal-version:       >= 1.4