use what appears to be more standard naming, eg BsonValue instead of BSValue
This commit is contained in:
Scott R. Parish
parent
7f777c8fb4
commit
4cfd4e7fa3
2 changed files with 101 additions and 101 deletions
|
|
@ -130,8 +130,8 @@ toOpcode 2007 = OP_KILL_CURSORS
|
|||
toOpcode n = throw $ MongoDBInternalError $ "Got unexpected Opcode: " ++ show n
|
||||
|
||||
type Collection = String
|
||||
type Selector = BSONObject
|
||||
type FieldSelector = BSONObject
|
||||
type Selector = BsonDoc
|
||||
type FieldSelector = BsonDoc
|
||||
type RequestID = Int32
|
||||
type NumToSkip = Int32
|
||||
type NumToReturn = Int32
|
||||
|
|
@ -171,7 +171,7 @@ delete c col sel = do
|
|||
remove :: Connection -> Collection -> Selector -> IO RequestID
|
||||
remove = delete
|
||||
|
||||
insert :: Connection -> Collection -> BSONObject -> IO RequestID
|
||||
insert :: Connection -> Collection -> BsonDoc -> IO RequestID
|
||||
insert c col doc = do
|
||||
let body = runPut $ do
|
||||
putI32 0
|
||||
|
|
@ -181,7 +181,7 @@ insert c col doc = do
|
|||
L.hPut (cHandle c) msg
|
||||
return reqID
|
||||
|
||||
insertMany :: Connection -> Collection -> [BSONObject] -> IO RequestID
|
||||
insertMany :: Connection -> Collection -> [BsonDoc] -> IO RequestID
|
||||
insertMany c col docs = do
|
||||
let body = runPut $ do
|
||||
putI32 0
|
||||
|
|
@ -198,11 +198,11 @@ find c col sel = query c col [] 0 0 sel Nothing
|
|||
|
||||
{- | Perform a query and return the result as a lazy list. Be sure to
|
||||
understand the comments about using the lazy list given for 'allDocs'. -}
|
||||
quickFind :: Connection -> Collection -> Selector -> IO [BSONObject]
|
||||
quickFind :: Connection -> Collection -> Selector -> IO [BsonDoc]
|
||||
quickFind c col sel = find c col sel >>= allDocs
|
||||
|
||||
{- | Perform a query and return the result as a strict list. -}
|
||||
quickFind' :: Connection -> Collection -> Selector -> IO [BSONObject]
|
||||
quickFind' :: Connection -> Collection -> Selector -> IO [BsonDoc]
|
||||
quickFind' c col sel = find c col sel >>= allDocs'
|
||||
|
||||
query :: Connection -> Collection -> [QueryOpt] -> NumToSkip -> NumToReturn ->
|
||||
|
|
@ -240,7 +240,7 @@ query c col opts nskip ret sel fsel = do
|
|||
}
|
||||
|
||||
update :: Connection -> Collection ->
|
||||
[UpdateFlag] -> Selector -> BSONObject -> IO RequestID
|
||||
[UpdateFlag] -> Selector -> BsonDoc -> IO RequestID
|
||||
update c col flags sel obj = do
|
||||
let body = runPut $ do
|
||||
putI32 0
|
||||
|
|
@ -290,7 +290,7 @@ getReply h = do
|
|||
|
||||
{- | Return one document or Nothing if there are no more.
|
||||
Automatically closes the curosr when last document is read -}
|
||||
nextDoc :: Cursor -> IO (Maybe BSONObject)
|
||||
nextDoc :: Cursor -> IO (Maybe BsonDoc)
|
||||
nextDoc cur = do
|
||||
closed <- readIORef $ curClosed cur
|
||||
case closed of
|
||||
|
|
@ -319,7 +319,7 @@ If you don't consume to the end of the list, you must manually close
|
|||
the cursor or you will leak the cursor, which may also leak on the
|
||||
database side.
|
||||
-}
|
||||
allDocs :: Cursor -> IO [BSONObject]
|
||||
allDocs :: Cursor -> IO [BsonDoc]
|
||||
allDocs cur = unsafeInterleaveIO $ do
|
||||
doc <- nextDoc cur
|
||||
case doc of
|
||||
|
|
@ -329,20 +329,20 @@ allDocs cur = unsafeInterleaveIO $ do
|
|||
{- | Returns a strict list of all (of the rest) of the documents in
|
||||
the cursor. This means that all of the documents will immediately be
|
||||
read out of the database and loaded into memory. -}
|
||||
allDocs' :: Cursor -> IO [BSONObject]
|
||||
allDocs' :: Cursor -> IO [BsonDoc]
|
||||
allDocs' cur = do
|
||||
doc <- nextDoc cur
|
||||
case doc of
|
||||
Nothing -> return []
|
||||
Just d -> allDocs' cur >>= return . (d :)
|
||||
|
||||
getFirstDoc :: L.ByteString -> (BSONObject, L.ByteString)
|
||||
getFirstDoc :: L.ByteString -> (BsonDoc, L.ByteString)
|
||||
getFirstDoc docBytes = flip runGet docBytes $ do
|
||||
doc <- get
|
||||
docBytes' <- getRemainingLazyByteString
|
||||
return (doc, docBytes')
|
||||
|
||||
getMore :: Cursor -> IO (Maybe BSONObject)
|
||||
getMore :: Cursor -> IO (Maybe BsonDoc)
|
||||
getMore cur = do
|
||||
let h = cHandle $ curCon cur
|
||||
|
||||
|
|
|
|||
|
|
@ -25,9 +25,9 @@ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
|||
|
||||
module Database.MongoDB.BSON
|
||||
(
|
||||
BSValue(..),
|
||||
BSONObject(..),
|
||||
toBSONObject,
|
||||
BsonValue(..),
|
||||
BsonDoc(..),
|
||||
toBsonDoc,
|
||||
BinarySubType(..)
|
||||
)
|
||||
where
|
||||
|
|
@ -45,32 +45,32 @@ import qualified Data.List as List
|
|||
import Data.Time.Clock.POSIX
|
||||
import Database.MongoDB.Util
|
||||
|
||||
data BSValue
|
||||
= BSDouble Double
|
||||
| BSString L8.ByteString
|
||||
| BSObject BSONObject
|
||||
| BSArray [BSValue]
|
||||
| BSUndefined
|
||||
| BSBinary BinarySubType L.ByteString
|
||||
| BSObjectId L.ByteString
|
||||
| BSBool !Bool
|
||||
| BSDate POSIXTime
|
||||
| BSNull
|
||||
| BSRegex L8.ByteString String
|
||||
| BSSymbol L8.ByteString
|
||||
| BSInt32 Int32
|
||||
| BSInt64 Int64
|
||||
| BSMinKey
|
||||
| BSMaxKey
|
||||
data BsonValue
|
||||
= BsonDouble Double
|
||||
| BsonString L8.ByteString
|
||||
| BsonObject BsonDoc
|
||||
| BsonArray [BsonValue]
|
||||
| BsonUndefined
|
||||
| BsonBinary BinarySubType L.ByteString
|
||||
| BsonObjectId L.ByteString
|
||||
| BsonBool !Bool
|
||||
| BsonDate POSIXTime
|
||||
| BsonNull
|
||||
| BsonRegex L8.ByteString String
|
||||
| BsonSymbol L8.ByteString
|
||||
| BsonInt32 Int32
|
||||
| BsonInt64 Int64
|
||||
| BsonMinKey
|
||||
| BsonMaxKey
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
newtype BSONObject = BSONObject {
|
||||
fromBSONObject :: Map.Map L8.ByteString BSValue
|
||||
newtype BsonDoc = BsonDoc {
|
||||
fromBsonDoc :: Map.Map L8.ByteString BsonValue
|
||||
}
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
toBSONObject :: [(L8.ByteString, BSValue)] -> BSONObject
|
||||
toBSONObject = BSONObject . Map.fromList
|
||||
toBsonDoc :: [(L8.ByteString, BsonValue)] -> BsonDoc
|
||||
toBsonDoc = BsonDoc . Map.fromList
|
||||
|
||||
data DataType =
|
||||
Data_min_key | -- -1
|
||||
|
|
@ -124,51 +124,51 @@ fromBinarySubType :: BinarySubType -> Int
|
|||
fromBinarySubType BSTUserDefined = 0x80
|
||||
fromBinarySubType d = fromEnum d
|
||||
|
||||
instance Binary BSONObject where
|
||||
get = liftM snd getObj
|
||||
instance Binary BsonDoc where
|
||||
get = liftM snd getDoc
|
||||
put = putObj
|
||||
|
||||
getVal :: DataType -> Get (Integer, BSValue)
|
||||
getVal Data_number = getFloat64le >>= return . (,) 8 . BSDouble
|
||||
getVal :: DataType -> Get (Integer, BsonValue)
|
||||
getVal Data_number = getFloat64le >>= return . (,) 8 . BsonDouble
|
||||
getVal Data_string = do
|
||||
sLen1 <- getI32
|
||||
(_sLen2, s) <- getS
|
||||
return (fromIntegral $ 4 + sLen1, BSString s)
|
||||
getVal Data_object = getObj >>= \(len, obj) -> return (len, BSObject obj)
|
||||
return (fromIntegral $ 4 + sLen1, BsonString s)
|
||||
getVal Data_object = getDoc >>= \(len, obj) -> return (len, BsonObject obj)
|
||||
getVal Data_array = do
|
||||
(len, arr) <- getRawObj
|
||||
let arr2 = Map.fold (:) [] arr -- reverse and remove key
|
||||
return (len, BSArray arr2)
|
||||
return (len, BsonArray arr2)
|
||||
getVal Data_binary = do
|
||||
skip 4
|
||||
st <- getI8
|
||||
len2 <- getI32
|
||||
bs <- getLazyByteString $ fromIntegral len2
|
||||
return (4 + 1 + 4 + fromIntegral len2, BSBinary (toBinarySubType st) bs)
|
||||
getVal Data_undefined = return (1, BSUndefined)
|
||||
getVal Data_oid = getLazyByteString 12 >>= return . (,) 12 . BSObjectId
|
||||
return (4 + 1 + 4 + fromIntegral len2, BsonBinary (toBinarySubType st) bs)
|
||||
getVal Data_undefined = return (1, BsonUndefined)
|
||||
getVal Data_oid = getLazyByteString 12 >>= return . (,) 12 . BsonObjectId
|
||||
getVal Data_boolean =
|
||||
getI8 >>= return . (,) (1::Integer) . BSBool . (/= (0::Int))
|
||||
getI8 >>= return . (,) (1::Integer) . BsonBool . (/= (0::Int))
|
||||
getVal Data_date =
|
||||
getI64 >>= return . (,) 8 . BSDate . flip (/) 1000 . realToFrac
|
||||
getVal Data_null = return (1, BSNull)
|
||||
getI64 >>= return . (,) 8 . BsonDate . flip (/) 1000 . realToFrac
|
||||
getVal Data_null = return (1, BsonNull)
|
||||
getVal Data_regex = fail "Data_code not yet supported" -- TODO
|
||||
getVal Data_ref = fail "Data_ref is deprecated"
|
||||
getVal Data_code = fail "Data_code not yet supported" -- TODO
|
||||
getVal Data_symbol = do
|
||||
sLen1 <- getI32
|
||||
(_sLen2, s) <- getS
|
||||
return (fromIntegral $ 4 + sLen1, BSString s)
|
||||
return (fromIntegral $ 4 + sLen1, BsonString s)
|
||||
getVal Data_code_w_scope = fail "Data_code_w_scope not yet supported" -- TODO
|
||||
getVal Data_int = getI32 >>= return . (,) 4 . BSInt32 . fromIntegral
|
||||
getVal Data_int = getI32 >>= return . (,) 4 . BsonInt32 . fromIntegral
|
||||
getVal Data_timestamp = fail "Data_timestamp not yet supported" -- TODO
|
||||
|
||||
getVal Data_long = getI64 >>= return . (,) 8 . BSInt64
|
||||
getVal Data_min_key = return (0, BSMinKey)
|
||||
getVal Data_max_key = return (0, BSMaxKey)
|
||||
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 BSValue)
|
||||
-> Get (Map.Map L8.ByteString BSValue)
|
||||
getInnerObj :: Int32 -> Get (Map.Map L8.ByteString BsonValue)
|
||||
-> Get (Map.Map L8.ByteString BsonValue)
|
||||
getInnerObj 1 obj = obj
|
||||
getInnerObj bytesLeft obj = do
|
||||
typ <- getDataType
|
||||
|
|
@ -177,70 +177,70 @@ getInnerObj bytesLeft obj = do
|
|||
getInnerObj (bytesLeft - 1 - fromIntegral keySz - fromIntegral valSz) $
|
||||
liftM (Map.insert key val) obj
|
||||
|
||||
getRawObj :: Get (Integer, Map.Map L8.ByteString BSValue)
|
||||
getRawObj :: Get (Integer, Map.Map L8.ByteString BsonValue)
|
||||
getRawObj = do
|
||||
bytes <- getI32
|
||||
obj <- getInnerObj (bytes - 4) $ return Map.empty
|
||||
getNull
|
||||
return (fromIntegral bytes, obj)
|
||||
|
||||
getObj :: Get (Integer, BSONObject)
|
||||
getObj = getRawObj >>= \(len, obj) -> return (len, BSONObject obj)
|
||||
getDoc :: Get (Integer, BsonDoc)
|
||||
getDoc = getRawObj >>= \(len, obj) -> return (len, BsonDoc obj)
|
||||
|
||||
getDataType :: Get DataType
|
||||
getDataType = liftM toDataType getI8
|
||||
|
||||
putType :: BSValue -> Put
|
||||
putType BSDouble{} = putDataType Data_number
|
||||
putType BSString{} = putDataType Data_string
|
||||
putType BSObject{} = putDataType Data_object
|
||||
putType BSArray{} = putDataType Data_array
|
||||
putType BSBinary{} = putDataType Data_binary
|
||||
putType BSUndefined = putDataType Data_undefined
|
||||
putType BSObjectId{} = putDataType Data_oid
|
||||
putType BSBool{} = putDataType Data_boolean
|
||||
putType BSDate{} = putDataType Data_date
|
||||
putType BSNull = putDataType Data_null
|
||||
putType BSRegex{} = putDataType Data_regex
|
||||
putType :: BsonValue -> Put
|
||||
putType BsonDouble{} = putDataType Data_number
|
||||
putType BsonString{} = putDataType Data_string
|
||||
putType BsonObject{} = putDataType Data_object
|
||||
putType BsonArray{} = putDataType Data_array
|
||||
putType BsonBinary{} = putDataType Data_binary
|
||||
putType BsonUndefined = putDataType Data_undefined
|
||||
putType BsonObjectId{} = putDataType Data_oid
|
||||
putType BsonBool{} = putDataType Data_boolean
|
||||
putType BsonDate{} = putDataType Data_date
|
||||
putType BsonNull = putDataType Data_null
|
||||
putType BsonRegex{} = putDataType Data_regex
|
||||
-- putType = putDataType Data_ref
|
||||
-- putType = putDataType Data_code
|
||||
putType BSSymbol{} = putDataType Data_symbol
|
||||
putType BsonSymbol{} = putDataType Data_symbol
|
||||
-- putType = putDataType Data_code_w_scope
|
||||
putType BSInt32 {} = putDataType Data_int
|
||||
putType BSInt64 {} = putDataType Data_long
|
||||
putType BsonInt32 {} = putDataType Data_int
|
||||
putType BsonInt64 {} = putDataType Data_long
|
||||
-- putType = putDataType Data_timestamp
|
||||
putType BSMinKey = putDataType Data_min_key
|
||||
putType BSMaxKey = putDataType Data_max_key
|
||||
putType BsonMinKey = putDataType Data_min_key
|
||||
putType BsonMaxKey = putDataType Data_max_key
|
||||
|
||||
putVal :: BSValue -> Put
|
||||
putVal (BSDouble d) = putFloat64le d
|
||||
putVal (BSString s) = putI32 (fromIntegral $ 1 + L8.length s) >> putS s
|
||||
putVal (BSObject o) = putObj o
|
||||
putVal (BSArray es) = putOutterObj bs
|
||||
putVal :: BsonValue -> Put
|
||||
putVal (BsonDouble d) = putFloat64le d
|
||||
putVal (BsonString s) = putI32 (fromIntegral $ 1 + L8.length s) >> putS s
|
||||
putVal (BsonObject 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
|
||||
putVal (BSBinary t bs)= do putI32 $ fromIntegral $ 4 + L.length bs
|
||||
putI8 $ fromBinarySubType t
|
||||
putI32 $ fromIntegral $ L.length bs
|
||||
putLazyByteString bs
|
||||
putVal BSUndefined = putNothing
|
||||
putVal (BSObjectId o) = putLazyByteString o
|
||||
putVal (BSBool False) = putI8 (0::Int)
|
||||
putVal (BSBool True) = putI8 (1::Int)
|
||||
putVal (BSDate pt) = putI64 $ round $ 1000 * (realToFrac pt :: Double)
|
||||
putVal BSNull = putNothing
|
||||
putVal (BSRegex r opt)= do putS r
|
||||
putByteString $ pack $ List.sort opt
|
||||
putNull
|
||||
putVal (BSSymbol s) = putI32 (fromIntegral $ 1 + L8.length s) >> putS s
|
||||
putVal (BSInt32 i) = putI32 i
|
||||
putVal (BSInt64 i) = putI64 i
|
||||
putVal BSMinKey = putNothing
|
||||
putVal BSMaxKey = putNothing
|
||||
putVal (BsonBinary t bs)= do putI32 $ fromIntegral $ 4 + L.length bs
|
||||
putI8 $ fromBinarySubType t
|
||||
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 (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 (BsonSymbol s) = putI32 (fromIntegral $ 1 + L8.length s) >> putS s
|
||||
putVal (BsonInt32 i) = putI32 i
|
||||
putVal (BsonInt64 i) = putI64 i
|
||||
putVal BsonMinKey = putNothing
|
||||
putVal BsonMaxKey = putNothing
|
||||
|
||||
putObj :: BSONObject -> Put
|
||||
putObj :: BsonDoc -> Put
|
||||
putObj obj = putOutterObj bs
|
||||
where bs = runPut $ forM_ (Map.toList (fromBSONObject obj)) $ \(k, v) ->
|
||||
where bs = runPut $ forM_ (Map.toList (fromBsonDoc obj)) $ \(k, v) ->
|
||||
putType v >> putS k >> putVal v
|
||||
|
||||
putOutterObj :: L.ByteString -> Put
|
||||
|
|
|
|||
Loading…
Reference in a new issue