diff --git a/Database/MongoDB/BSON.hs b/Database/MongoDB/BSON.hs index 73e9396..a734ff8 100644 --- a/Database/MongoDB/BSON.hs +++ b/Database/MongoDB/BSON.hs @@ -18,6 +18,7 @@ import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as LC import qualified Data.ByteString.Lazy.UTF8 as L8 import Data.Int +import qualified Data.Map as Map import qualified Data.List as List import Data.Time.Clock.POSIX import Database.MongoDB.Util @@ -41,11 +42,11 @@ data BSValue | BSMaxKey deriving (Show, Eq, Ord) -newtype BSONObject = BSONObject { fromBSONObject :: [(L8.ByteString, BSValue)] } +newtype BSONObject = BSONObject { fromBSONObject :: Map.Map L8.ByteString BSValue } deriving (Eq, Ord, Show) toBSONObject :: [(L8.ByteString, BSValue)] -> BSONObject -toBSONObject = BSONObject +toBSONObject = BSONObject . Map.fromList data DataType = Data_min_key | -- -1 @@ -112,7 +113,7 @@ getVal Data_string = do getVal Data_object = getObj >>= \(len, obj) -> return (len, BSObject obj) getVal Data_array = do (len, arr) <- getRawObj - let arr2 = List.foldl (\acc (k,v) -> v : acc) [] arr -- reverse and remove key + let arr2 = Map.fold (:) [] arr -- reverse and remove key return (len, BSArray arr2) getVal Data_binary = do skip 4 @@ -135,15 +136,15 @@ getInnerObj bytesLeft obj = do (keySz, key) <- getS (valSz, val) <- getVal typ getInnerObj (bytesLeft - 1 - fromIntegral keySz - fromIntegral valSz) $ - liftM ((key, val) :) obj + liftM (Map.insert key val) obj getRawObj = do bytes <- getI32 - obj <- getInnerObj (bytes - 4) $ return [] + obj <- getInnerObj (bytes - 4) $ return Map.empty getNull return (fromIntegral bytes, obj) -getObj = getRawObj >>= \(len, obj) -> return (len, toBSONObject obj) +getObj = getRawObj >>= \(len, obj) -> return (len, BSONObject obj) getDataType = liftM toDataType getI8 @@ -195,7 +196,7 @@ putVal BSMinKey = flush putVal BSMaxKey = flush putObj obj = putOutterObj bs - where bs = runPut $ forM_ (fromBSONObject obj) $ \(k, v) -> + where bs = runPut $ forM_ (Map.toList (fromBSONObject obj)) $ \(k, v) -> putType v >> putS k >> putVal v putOutterObj bytes = do diff --git a/TODO b/TODO index 7a120d7..d82ad05 100644 --- a/TODO +++ b/TODO @@ -3,5 +3,5 @@ TODO BSON ---- -+ more efficient dictionary type (also ordered?) + support something like toSql (convert a haskell type to bson) ++ reject keys that start with "$" or "." diff --git a/mongoDB.cabal b/mongoDB.cabal index e05fecb..8f37dc6 100644 --- a/mongoDB.cabal +++ b/mongoDB.cabal @@ -4,6 +4,7 @@ License: MIT Build-Depends: base, binary, bytestring, + containers, data-binary-ieee754, time, utf8-string