bson 0.0.1 → 0.0.2

raw patch · 4 files changed

+28/−28 lines, 4 filesdep ~base

Dependency ranges changed: base

Files

• Data/Bson.hs +18/−18
• Data/Bson/Binary.hs +8/−8
• Data/UString.hs +1/−1
• bson.cabal +1/−1

@@ -8,12 +8,12 @@ 	UString, 	-- * Document 	Document, look, lookup, valueAt, at, include, exclude, merge,-	-- ** Element-	Element(..), (=:), (=?),+	-- * Field+	Field(..), (=:), (=?), 	Label, 	-- * Value 	Value(..), Val(..), fval, cast, typed,-	-- * Special Bson types+	-- * Special Bson value types 	Binary(..), Function(..), UUID(..), MD5(..), UserDefined(..), 	Regex(..), Javascript(..), Symbol(..), MongoStamp(..), MinMaxKey(..), 	-- ** ObjectId@@ -47,8 +47,8 @@  -- * Document -type Document = [Element]--- ^ A BSON document is a sequence of 'Element's+type Document = [Field]+-- ^ A BSON document is a sequence of 'Field's  look :: (Monad m) => Label -> Document -> m Value -- ^ Value of field in document, or fail (Nothing) if field not found@@ -56,7 +56,7 @@ 	notFound = fail $ "expected " ++ show k ++ " in " ++ show doc  lookup :: (Val v, Monad m) => Label -> Document -> m v--- ^ Lookup field in document and cast to expected type. Fail (Nothing) if field not found or value not of expected type.+-- ^ Lookup value of field in document and cast to expected type. Fail (Nothing) if field not found or value not of expected type. lookup k doc = cast =<< look k doc  valueAt :: Label -> Document -> Value@@ -69,40 +69,40 @@ 	err = error $ "expected (" ++ show k ++ " :: " ++ show (typeOf (undefined :: v)) ++ ") in " ++ show doc  include :: [Label] -> Document -> Document--- ^ Only include elements of document in key list+-- ^ Only include fields of document in label list include keys doc = mapMaybe (\k -> find ((k ==) . label) doc) keys  exclude :: [Label] -> Document -> Document--- ^ Exclude elements from document in key list+-- ^ Exclude fields from document in label list exclude keys doc = filter (\(k := _) -> notElem k keys) doc  merge :: Document -> Document -> Document--- ^ Merge documents with preference given to first one when both have the same label. I.e. for every (k := v) in first argument, if k exists in second argument then replace its value with v, otherwise add (k := v) to second argument+-- ^ Merge documents with preference given to first one when both have the same label. I.e. for every (k := v) in first argument, if k exists in second argument then replace its value with v, otherwise add (k := v) to second argument. merge es doc = foldl f doc es where 	f doc (k := v) = case findIndex ((k ==) . label) doc of 		Nothing -> doc ++ [k := v] 		Just i -> let (x, _ : y) = splitAt i doc in x ++ [k := v] ++ y --- * Element+-- * Field  infix 0 :=, =:, =? -data Element = (:=) {label :: Label, value :: Value}  deriving (Typeable, Eq)--- ^ A BSON element is a named value, where the name is a string and the value is a BSON 'Value'+data Field = (:=) {label :: Label, value :: Value}  deriving (Typeable, Eq)+-- ^ A BSON field is a named value, where the name (label) is a string and the value is a BSON 'Value' -(=:) :: (Val v) => Label -> v -> Element--- ^ Element with given label and typed value+(=:) :: (Val v) => Label -> v -> Field+-- ^ Field with given label and typed value k =: v = k := val v -(=?) :: (Val a) => Label -> Maybe a -> [Element]--- ^ If Just then return one element list with given label, otherwise return empty list+(=?) :: (Val a) => Label -> Maybe a -> Document+-- ^ If Just value then return one field document, otherwise return empty document k =? ma = maybeToList (fmap (k =:) ma) -instance Show Element where+instance Show Field where 	showsPrec d (k := v) = showParen (d > 0) $ showString (' ' : unpack k) . showString ": " . showsPrec 1 v  type Label = UString--- ^ The name of a BSON element/field+-- ^ The name of a BSON field  -- * Value 

@@ -23,9 +23,9 @@ import Control.Applicative ((<$>), (<*>)) import Control.Monad (when) -putElement :: Element -> Put+putField :: Field -> Put -- ^ Write binary representation of element-putElement (k := v) = case v of+putField (k := v) = case v of 	Float x -> putTL 0x01 >> putDouble x 	String x -> putTL 0x02 >> putString x 	Doc x -> putTL 0x03 >> putDocument x@@ -53,9 +53,9 @@  where 	putTL t = putTag t >> putLabel k -getElement :: Get Element+getField :: Get Field -- ^ Read binary representation of Element-getElement = do+getField = do 	t <- getTag 	k <- getLabel 	v <- case t of@@ -129,7 +129,7 @@ 	return (U.fromByteString_ b)  putDocument :: Document -> Put-putDocument es = let b = runPut (mapM_ putElement es) in do+putDocument es = let b = runPut (mapM_ putField es) in do 	putInt32 $ (toEnum . fromEnum) (L.length b + 5)  -- include length and null terminator 	putLazyByteString b 	putWord8 0@@ -139,11 +139,11 @@ 	len <- subtract 5 <$> getInt32 	b <- getLazyByteString (fromIntegral len) 	getWord8-	return (runGet getElements b)+	return (runGet getFields b)  where-	getElements = isEmpty >>= \done -> if done+	getFields = isEmpty >>= \done -> if done 		then return []-		else (:) <$> getElement <*> getElements+		else (:) <$> getField <*> getFields  putArray :: [Value] -> Put putArray vs = putDocument (zipWith f [0..] vs)

@@ -1,6 +1,6 @@ -- | UTF-8 String -{-# LANGUAGE TypeSynonymInstances, StandaloneDeriving #-}+{-# LANGUAGE TypeSynonymInstances, StandaloneDeriving, DeriveDataTypeable #-}  module Data.UString ( 	UString, u,

@@ -1,5 +1,5 @@ Name: bson-Version: 0.0.1+Version: 0.0.2 Synopsis: BSON documents are JSON-like objects with a standard binary encoding Description: BSON (short for Binary JSON) is a binary-encoded serialization of JSON-like documents. 	.