From fb2f09171abf62ff1972f175f228eca2161404ff Mon Sep 17 00:00:00 2001
From: "Scott R. Parish" <srp@srparish.net>
Date: Mon, 8 Mar 2010 06:57:20 -0600
Subject: [PATCH] change BsonDoc representation to maintain order

Turns out that order is sometimes important for BSON documents. Case
in point, "mapreduce" has to be the first field for the map/reduce
command.

To accomidate this we'll switch from using 'Map' to using a tuple-list
(eg '[(L8.ByteString, BsonValue)]'). Luckily most code that was using
toBsonDoc doesn't need to change.

While at it, 'Convertible' is not adding much value, and was causing
ambiguities making it less usefull (was requiring explicit type hints
more then it should have). Thus we are switching to our own conversion
typeclasses.
---
 Database/MongoDB.hs      |  37 ++--
 Database/MongoDB/BSON.hs | 420 ++++++++++++++++++---------------------
 TODO                     |   7 +-
 3 files changed, 216 insertions(+), 248 deletions(-)

diff --git a/Database/MongoDB.hs b/Database/MongoDB.hs
index e613398..0096603 100644
--- a/Database/MongoDB.hs
+++ b/Database/MongoDB.hs
@@ -70,7 +70,6 @@ import qualified Data.ByteString.Lazy.UTF8 as L8
 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
@@ -121,10 +120,10 @@ newConnection servers opts = do
   hRef <- openHandle (head servers) >>= newIORef
   let c = Connection hRef nsRef
   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 +148,14 @@ conClose c = readIORef (cHandle c) >>= hClose
 -- | 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 +165,7 @@ disconnect = conClose
 -- | 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 +174,7 @@ isMaster c = runCommand c (s2L "admin") $ toBsonDoc [("ismaster", BsonInt32 1)]
 -- | 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 +182,14 @@ serverInfo c =
 -- 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 +267,7 @@ validateCollection :: Connection -> FullCollection -> IO String
 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 +287,9 @@ runCommand :: Connection -> Database -> BsonDoc -> IO BsonDoc
 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
@@ -472,7 +472,7 @@ 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
+  return $ fromBson $ fromLookup $ List.lookup (s2L "n") res
 
 -- | Delete documents matching /Selector/ from the given /FullCollection/.
 delete :: Connection -> FullCollection -> Selector -> IO RequestID
@@ -587,7 +587,7 @@ update c col flags sel obj = do
 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)),
@@ -610,7 +610,10 @@ addUser c db user pass = do
       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'
 
@@ -620,7 +623,7 @@ addUser c db user pass = do
 -- we insert it
 save :: Connection -> FullCollection -> BsonDoc -> IO RequestID
 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
 
diff --git a/Database/MongoDB/BSON.hs b/Database/MongoDB/BSON.hs
index 233808d..5010636 100644
--- a/Database/MongoDB/BSON.hs
+++ b/Database/MongoDB/BSON.hs
@@ -30,7 +30,7 @@ module Database.MongoDB.BSON
      BsonDoc,
      BinarySubType(..),
      -- * BsonDoc Operations
-     empty, lookup,
+     empty,
      -- * Type Conversion
      fromBson, toBson,
      fromBsonDoc, toBsonDoc,
@@ -40,6 +40,8 @@ module Database.MongoDB.BSON
 where
 import Prelude hiding (lookup)
 
+import qualified Control.Arrow as Arrow
+import Control.Exception
 import Control.Monad
 import Data.Binary
 import Data.Binary.Get
@@ -49,10 +51,9 @@ 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.Int
-import qualified Data.Map as Map
 import qualified Data.List as List
+import qualified Data.Map as Map
 import Data.Time.Clock.POSIX
 import Data.Typeable
 import Database.MongoDB.Util
@@ -79,37 +80,11 @@ data BsonValue
     | 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
@@ -176,9 +151,10 @@ getVal DataString = do
   return (fromIntegral $ 4 + sLen1, BsonString s)
 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
@@ -212,22 +188,32 @@ getVal DataLong = liftM ((,) 8 . BsonInt64) getI64
 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
 
@@ -288,8 +274,7 @@ 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
@@ -301,214 +286,189 @@ putOutterObj bytes = do
 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
+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 BsonDocConv [(L8.ByteString, BsonValue)] where
+    fromBsonDoc = id
+    toBsonDoc = id
+
+instance BsonDocConv [(String, BsonValue)] where
+    fromBsonDoc = List.map $ Arrow.first L8.toString
+    toBsonDoc = List.map $ Arrow.first L8.fromString
+
+instance BsonDocConv (Map.Map L8.ByteString BsonValue) where
+    fromBsonDoc = Map.fromList
+    toBsonDoc = Map.toList
+
+instance BsonDocConv (Map.Map String BsonValue) where
+    fromBsonDoc = Map.fromList . fromBsonDoc
+    toBsonDoc = toBsonDoc . Map.toList
+
+data BsonUnsupportedConversion = BsonUnsupportedConversion
+                                 deriving (Eq, Show, Read)
+
+bsonUnsupportedConversion :: TyCon
+bsonUnsupportedConversion =
+    mkTyCon "Database.MongoDB.BSON.BsonUnsupportedConversion "
+
+instance Typeable BsonUnsupportedConversion where
+    typeOf _ = mkTyConApp bsonUnsupportedConversion []
+
+instance Exception BsonUnsupportedConversion
+
+throwUnsupConv :: a
+throwUnsupConv = throw BsonUnsupportedConversion
+
+class BsonConv a where
     -- | Convert a native Haskell type into a BsonValue.
-    toBson :: Convertible b a => b -> a
+    toBson :: a -> BsonValue
+    -- | Convert a BsonValue into a native Haskell type.
+    fromBson :: BsonValue -> a
 
-instance BsonConv BsonValue a where
-    fromBson = convert
-    toBson = convert
+instance BsonConv Double where
+    toBson = BsonDouble
+    fromBson (BsonDouble d) = d
+    fromBson _ = throwUnsupConv
 
-instance BsonConv (Maybe BsonValue) (Maybe a) where
-    fromBson = convert
-    toBson = convert
+instance BsonConv Float where
+    toBson = BsonDouble . realToFrac
+    fromBson (BsonDouble d) = realToFrac d
+    fromBson _ = throwUnsupConv
 
-unsupportedError :: (Typeable a, Convertible BsonValue a) =>
-                    BsonValue -> ConvertResult a
-unsupportedError = convError "Unsupported conversion"
+instance BsonConv L8.ByteString where
+    toBson = BsonString
+    fromBson (BsonString s) = s
+    fromBson _ = throwUnsupConv
 
-instance Convertible Double BsonValue where
-    safeConvert = return . BsonDouble
+instance BsonConv String where
+    toBson = BsonString . L8.fromString
+    fromBson (BsonString s) = L8.toString s
+    fromBson _ = throwUnsupConv
 
-instance Convertible Float BsonValue where
-    safeConvert = return . BsonDouble . realToFrac
+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 where
-    safeConvert = return . BsonString . L8.fromString
+instance  BsonConv BsonDoc where
+    toBson = BsonDoc
+    fromBson (BsonDoc d) = d
+    fromBson _ = throwUnsupConv
 
-instance Convertible L8.ByteString BsonValue where
-    safeConvert = return . BsonString
+instance BsonConv [(String, BsonValue)] where
+    toBson = toBson . toBsonDoc
+    fromBson (BsonDoc d) = fromBsonDoc d
+    fromBson _ = throwUnsupConv
 
-instance Convertible S8.ByteString BsonValue where
-    safeConvert = return . BsonString . L.fromChunks . return
+instance BsonConv (Map.Map L8.ByteString BsonValue) where
+    toBson = toBson . toBsonDoc
+    fromBson (BsonDoc d) = fromBsonDoc d
+    fromBson _ = throwUnsupConv
 
-instance Convertible [Double] BsonValue where
-    safeConvert ds = BsonArray `liftM` mapM safeConvert ds
+instance BsonConv (Map.Map String BsonValue) where
+    toBson = toBson . toBsonDoc
+    fromBson (BsonDoc d) = fromBsonDoc d
+    fromBson _ = throwUnsupConv
 
-instance Convertible [Float] BsonValue where
-    safeConvert fs = BsonArray `liftM` mapM safeConvert fs
+instance BsonConv POSIXTime where
+    toBson = BsonDate
+    fromBson (BsonDate d) = d
+    fromBson _ = throwUnsupConv
 
-instance Convertible [String] BsonValue where
-    safeConvert ss = BsonArray `liftM` mapM safeConvert ss
+instance BsonConv Bool where
+    toBson = BsonBool
+    fromBson (BsonBool b) = b
+    fromBson _ = throwUnsupConv
 
-instance Convertible [L8.ByteString] BsonValue where
-    safeConvert bs = BsonArray `liftM` mapM safeConvert bs
+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 [S8.ByteString] BsonValue where
-    safeConvert bs = BsonArray `liftM` mapM safeConvert bs
+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 BsonDoc BsonValue where
-    safeConvert = return . BsonDoc
+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 (Map.Map String BsonValue) BsonValue where
-    safeConvert = return . BsonDoc . Map.mapKeys L8.fromString
+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 [(L8.ByteString, BsonValue)] BsonValue where
-    safeConvert = return . BsonDoc . toBsonDoc
+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 [(String, BsonValue)] BsonValue where
-    safeConvert = return . BsonDoc . toBsonDoc
+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 [Bool] BsonValue where
-    safeConvert bs = BsonArray `liftM` mapM safeConvert bs
+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 [POSIXTime] BsonValue where
-    safeConvert ts = BsonArray `liftM` mapM safeConvert ts
+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 [Int] BsonValue where
-    safeConvert is = BsonArray `liftM` mapM safeConvert is
+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 [Integer] BsonValue where
-    safeConvert is = BsonArray `liftM` mapM safeConvert is
+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 [Int32] BsonValue where
-    safeConvert is = BsonArray `liftM` mapM safeConvert is
-
-instance Convertible [Int64] BsonValue where
-    safeConvert is = BsonArray `liftM` mapM safeConvert is
-
-instance Convertible POSIXTime BsonValue where
-    safeConvert = return . BsonDate
-
-instance Convertible Bool BsonValue where
-    safeConvert = return . BsonBool
-
-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 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 Convertible Int32 BsonValue where
-    safeConvert = return . BsonInt32
-
-instance Convertible Int64 BsonValue where
-    safeConvert = return . BsonInt64
-
-instance (Convertible a BsonValue) =>
-    Convertible (Maybe a) BsonValue where
-        safeConvert Nothing = return BsonNull
-        safeConvert (Just a) = safeConvert a
-
-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 Convertible BsonValue Float where
-    safeConvert (BsonDouble d) = safeConvert d
-    safeConvert (BsonInt32 i) = safeConvert i
-    safeConvert (BsonInt64 i) = safeConvert i
-    safeConvert v = unsupportedError v
-
-instance Convertible BsonValue String where
-    safeConvert (BsonString bs) = return $ L8.toString bs
-    safeConvert v = unsupportedError v
-
-instance Convertible BsonValue L8.ByteString where
-    safeConvert (BsonString bs) = return bs
-    safeConvert v = unsupportedError v
-
-instance Convertible BsonValue S8.ByteString where
-    safeConvert (BsonString bs) = return $ C8.concat $ L.toChunks bs
-    safeConvert v = unsupportedError v
-
-instance Convertible BsonValue BsonDoc where
-    safeConvert (BsonDoc o) = return o
-    safeConvert v = unsupportedError v
-
-instance Convertible BsonValue (Map.Map String BsonValue) where
-    safeConvert (BsonDoc o) = return $ Map.mapKeys L8.toString o
-    safeConvert v = unsupportedError v
-
-instance Convertible BsonValue [(String, BsonValue)] where
-    safeConvert (BsonDoc o) = return $ fromBsonDoc o
-    safeConvert v = unsupportedError v
-
-instance Convertible BsonValue [(L8.ByteString, BsonValue)] where
-    safeConvert (BsonDoc o) = return $ fromBsonDoc o
-    safeConvert v = unsupportedError v
-
-instance Convertible BsonValue [Double] where
-    safeConvert (BsonArray a) = mapM safeConvert a
-    safeConvert v = unsupportedError v
-
-instance Convertible BsonValue [Float] where
-    safeConvert (BsonArray a) = mapM safeConvert a
-    safeConvert v = unsupportedError v
-
-instance Convertible BsonValue [String] where
-    safeConvert (BsonArray a) = mapM safeConvert a
-    safeConvert v = unsupportedError v
-
-instance Convertible BsonValue [Bool] where
-    safeConvert (BsonArray a) = mapM safeConvert a
-    safeConvert v = unsupportedError v
-
-instance Convertible BsonValue [POSIXTime] where
-    safeConvert (BsonArray a) = mapM safeConvert a
-    safeConvert v = unsupportedError v
-
-instance Convertible BsonValue [Int32] where
-    safeConvert (BsonArray a) = mapM safeConvert a
-    safeConvert v = unsupportedError v
-
-instance Convertible BsonValue [Int64] where
-    safeConvert (BsonArray a) = mapM safeConvert a
-    safeConvert v = unsupportedError v
-
-instance Convertible BsonValue Bool where
-    safeConvert (BsonBool b) = return b
-    safeConvert v = unsupportedError v
-
-instance Convertible BsonValue POSIXTime where
-    safeConvert (BsonDate t) = return t
-    safeConvert v = unsupportedError v
-
-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 Convertible BsonValue Integer where
-    safeConvert (BsonDouble d) = safeConvert d
-    safeConvert (BsonInt32 d) = safeConvert d
-    safeConvert (BsonInt64 d) = safeConvert d
-    safeConvert v = unsupportedError v
-
-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 Convertible BsonValue Int64 where
-    safeConvert (BsonDouble d) = safeConvert d
-    safeConvert (BsonInt32 d) = safeConvert d
-    safeConvert (BsonInt64 d) = return d
-    safeConvert v = unsupportedError v
-
-instance (Convertible BsonValue a) =>
-    Convertible (Maybe BsonValue) (Maybe a) where
-        safeConvert Nothing = return Nothing
-        safeConvert (Just a) = liftM Just $ safeConvert a
+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
diff --git a/TODO b/TODO
index 706aefe..983125c 100644
--- a/TODO
+++ b/TODO
@@ -48,7 +48,6 @@ MongoDB
     * close
     * group
     * distinct
-    * map reduce
   - cursor object
     * hasMore
 
@@ -98,3 +97,9 @@ deep "lookup" function (other deep Map functions?)
 how to make bytestrings less painful
 custom Show/Read instance that looks more like json
 make sure NULLs aren't in created table names
+
+update tutorial to match new python one
+
++ custom types (see python examples)
++ support array conversions again
++ better type conversion errors