make BsonDoc a 'type' rather then 'newtype'

All the wraping/unwraping for the newtype was really cumbersome and
protection isn't really needed here.

Database/MongoDB.hs

@@ -377,7 +377,7 @@ delete c col sel = do
                      putI32 0
                      putCol col
                      putI32 0
-                     put sel
+                     putBsonDoc sel
   (reqID, msg) <- packMsg c OP_DELETE body
   L.hPut (cHandle c) msg
   return reqID
@@ -392,7 +392,7 @@ insert c col doc = do
   let body = runPut $ do
                      putI32 0
                      putCol col
-                     put doc
+                     putBsonDoc doc
   (reqID, msg) <- packMsg c OP_INSERT body
   L.hPut (cHandle c) msg
   return reqID
@@ -403,7 +403,7 @@ insertMany c col docs = do
   let body = runPut $ do
                putI32 0
                putCol col
-               forM_ docs put
+               forM_ docs putBsonDoc
   (reqID, msg) <- packMsg c OP_INSERT body
   L.hPut (cHandle c) msg
   return reqID
@@ -444,10 +444,11 @@ query c col opts nskip ret sel fsel = do
                putCol col
                putI32 nskip
                putI32 ret
-               put sel
+               putBsonDoc sel
                case fsel of
                     [] -> putNothing
-                    _ -> put $ toBsonDoc $ List.zip fsel $ repeat $ BsonInt32 1
+                    _ -> putBsonDoc $ toBsonDoc $ List.zip fsel $
+                         repeat $ BsonInt32 1
   (reqID, msg) <- packMsg c OP_QUERY body
   L.hPut h msg
 
@@ -476,8 +477,8 @@ update c col flags sel obj = do
                putI32 0
                putCol col
                putI32 $ fromUpdateFlags flags
-               put sel
+               putBsonDoc sel
-               put obj
+               putBsonDoc obj
   (reqID, msg) <- packMsg c OP_UPDATE body
   L.hPut (cHandle c) msg
   return reqID
@@ -566,7 +567,7 @@ allDocs' cur = do
 
 getFirstDoc :: L.ByteString -> (BsonDoc, L.ByteString)
 getFirstDoc docBytes = flip runGet docBytes $ do
-                         doc <- get
+                         doc <- getBsonDoc
                          docBytes' <- getRemainingLazyByteString
                          return (doc, docBytes')
 

Database/MongoDB/BSON.hs

@@ -27,13 +27,15 @@ module Database.MongoDB.BSON
     (
      -- * Types
      BsonValue(..),
-     BsonDoc(..),
+     BsonDoc,
-     toBsonDoc,
      BinarySubType(..),
      -- * BsonDoc Operations
      empty, lookup,
-     -- * Conversion
+     -- * Type Conversion
-     fromBson, toBson
+     fromBson, toBson,
+     fromBsonDoc, toBsonDoc,
+     -- * Binary encoding/decoding
+     getBsonDoc, putBsonDoc,
     )
 where
 import Prelude hiding (lookup)
@@ -83,35 +85,29 @@ instance Typeable BsonValue where
 -- 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@).
-newtype BsonDoc = BsonDoc {
+type BsonDoc = Map.Map L8.ByteString BsonValue
-      bdFromBsonDoc :: Map.Map L8.ByteString BsonValue
-    }
-    deriving (Eq, Ord, Show)
-
-instance Typeable BsonDoc where
-    typeOf _ = mkTypeName "BsonDoc"
 
 class BsonDocOps a where
     -- | Construct a BsonDoc from an associative list
     toBsonDoc :: [(a, BsonValue)] -> BsonDoc
     -- | Unwrap BsonDoc to be a Map
-    fromBsonDoc :: BsonDoc -> Map.Map a BsonValue
+    fromBsonDoc :: BsonDoc -> [(a, BsonValue)]
     -- | Return the BsonValue for given key, if any.
     lookup :: a -> BsonDoc -> Maybe BsonValue
 
 -- | An empty BsonDoc
 empty :: BsonDoc
-empty = BsonDoc Map.empty
+empty = Map.empty
 
 instance BsonDocOps L8.ByteString where
-    toBsonDoc = BsonDoc . Map.fromList
+    toBsonDoc = Map.fromList
-    fromBsonDoc = bdFromBsonDoc
+    fromBsonDoc = Map.toList
-    lookup k = Map.lookup k . fromBsonDoc
+    lookup k = Map.lookup k
 
 instance BsonDocOps String where
-    toBsonDoc = BsonDoc . Map.mapKeys L8.fromString .Map.fromList
+    toBsonDoc = Map.mapKeys L8.fromString .Map.fromList
-    fromBsonDoc = Map.mapKeys L8.toString . bdFromBsonDoc
+    fromBsonDoc = Map.toList . Map.mapKeys L8.toString
-    lookup k = Map.lookup (L8.fromString k) . fromBsonDoc
+    lookup k = Map.lookup (L8.fromString k)
 
 data DataType =
     Data_min_key        | -- -1
@@ -164,9 +160,11 @@ fromBinarySubType :: BinarySubType -> Int
 fromBinarySubType BSTUserDefined = 0x80
 fromBinarySubType d = fromEnum d
 
-instance Binary BsonDoc where
+getBsonDoc :: Get BsonDoc
-    get = liftM snd getDoc
+getBsonDoc = liftM snd getDoc
-    put = putObj
+
+putBsonDoc :: BsonDoc -> Put
+putBsonDoc = putObj
 
 getVal :: DataType -> Get (Integer, BsonValue)
 getVal Data_number = getFloat64le >>= return . (,) 8 . BsonDouble
@@ -207,25 +205,24 @@ getVal Data_long = getI64 >>= return . (,) 8 . BsonInt64
 getVal Data_min_key = return (0, BsonMinKey)
 getVal Data_max_key = return (0, BsonMaxKey)
 
-getInnerObj :: Int32 -> Get (Map.Map L8.ByteString BsonValue)
+getInnerObj :: Int32 -> BsonDoc -> Get BsonDoc
-            -> Get (Map.Map L8.ByteString BsonValue)
+getInnerObj 1 obj = return obj
-getInnerObj 1 obj = obj
 getInnerObj bytesLeft obj = do
   typ <- getDataType
   (keySz, key) <- getS
   (valSz, val) <- getVal typ
   getInnerObj (bytesLeft - 1 - fromIntegral keySz - fromIntegral valSz) $
-              liftM (Map.insert key val) obj
+              (Map.insert key val) obj
 
-getRawObj :: Get (Integer, Map.Map L8.ByteString BsonValue)
+getRawObj :: Get (Integer, BsonDoc)
 getRawObj = do
   bytes <- getI32
-  obj <- getInnerObj (bytes - 4) $ return Map.empty
+  obj <- getInnerObj (bytes - 4) empty
   getNull
   return (fromIntegral bytes, obj)
 
 getDoc :: Get (Integer, BsonDoc)
-getDoc = getRawObj >>= \(len, obj) ->  return (len, BsonDoc obj)
+getDoc = getRawObj
 
 getDataType :: Get DataType
 getDataType = liftM toDataType getI8
@@ -280,7 +277,7 @@ putVal BsonMaxKey       = putNothing
 
 putObj :: BsonDoc -> Put
 putObj obj   = putOutterObj bs
-    where bs = runPut $ forM_ (Map.toList (fromBsonDoc obj)) $ \(k, v) ->
+    where bs = runPut $ forM_ (fromBsonDoc obj) $ \(k, v) ->
                putType v >> putS k >> putVal v
 
 putOutterObj :: L.ByteString -> Put
@@ -344,17 +341,14 @@ instance Convertible [S8.ByteString] BsonValue where
 instance Convertible BsonDoc BsonValue where
     safeConvert = return . BsonObject
 
-instance Convertible [(String, BsonValue)] BsonValue where
+instance Convertible (Map.Map String BsonValue) BsonValue where
-    safeConvert = return . BsonObject . toBsonDoc
+    safeConvert = return . BsonObject . Map.mapKeys L8.fromString
 
 instance Convertible [(L8.ByteString, BsonValue)] BsonValue where
     safeConvert = return . BsonObject . toBsonDoc
 
-instance Convertible (Map.Map String BsonValue) BsonValue where
+instance Convertible [(String, BsonValue)] BsonValue where
-    safeConvert = return . BsonObject . BsonDoc . Map.mapKeys L8.fromString
+    safeConvert = return . BsonObject . toBsonDoc
-
-instance Convertible (Map.Map L8.ByteString BsonValue) BsonValue where
-    safeConvert = return . BsonObject . BsonDoc
 
 instance Convertible [Bool] BsonValue where
     safeConvert bs = BsonArray `liftM` mapM safeConvert bs
@@ -431,20 +425,16 @@ instance Convertible BsonValue BsonDoc where
     safeConvert (BsonObject o) = return o
     safeConvert v = unsupportedError v
 
-instance Convertible BsonValue (Map.Map L8.ByteString BsonValue) where
-    safeConvert (BsonObject o) = return $ fromBsonDoc $ o
-    safeConvert v = unsupportedError v
-
 instance Convertible BsonValue (Map.Map String BsonValue) where
-    safeConvert (BsonObject o) = return $ fromBsonDoc $ o
+    safeConvert (BsonObject o) = return $ Map.mapKeys L8.toString o
     safeConvert v = unsupportedError v
 
 instance Convertible BsonValue [(String, BsonValue)] where
-    safeConvert (BsonObject o) = return $ Map.toList $ fromBsonDoc o
+    safeConvert (BsonObject o) = return $ fromBsonDoc o
     safeConvert v = unsupportedError v
 
 instance Convertible BsonValue [(L8.ByteString, BsonValue)] where
-    safeConvert (BsonObject o) = return $ Map.toList $ fromBsonDoc o
+    safeConvert (BsonObject o) = return $ fromBsonDoc o
     safeConvert v = unsupportedError v
 
 instance Convertible BsonValue [Double] where