Vergara_Tech/mongodb
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

change BsonDoc representation to maintain order

Browse source 
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.
This commit is contained in:
Scott R. Parish 2010-03-08 06:57:20 -06:00
parent 7587f435a2
commit fb2f09171a
3 changed files with 216 additions and 248 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
Database/MongoDB.hs
View file

@ -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

420
Database/MongoDB/BSON.hs
View file

@ -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

7
TODO
View file

@ -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