use what appears to be more standard naming, eg BsonValue instead of BSValue

This commit is contained in:
Scott R. Parish 2010-01-17 11:41:24 -06:00
parent 7f777c8fb4
commit 4cfd4e7fa3
2 changed files with 101 additions and 101 deletions

View file

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

View file

@ -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
putVal (BsonBinary 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
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 (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 (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