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.
This commit is contained in:
Scott R. Parish
parent
7587f435a2
commit
fb2f09171a
3 changed files with 216 additions and 248 deletions
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
7
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
|
||||
|
|
|
|||
Loading…
Reference in a new issue