bson 0.1.7 → 0.2.0

raw patch · 5 files changed

+125/−180 lines, 5 filesdep +textdep −HUnitdep −QuickCheckdep −bsondep ~basenew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: text

Dependencies removed: HUnit, QuickCheck, bson, compact-string-fix, file-location, hspec

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/Bson.hs +53/−38
• Data/Bson/Binary.hs +38/−26
• Data/UString.hs +0/−36
• bson.cabal +34/−51
• test/main.hs +0/−29

@@ -1,14 +1,17 @@-{- | A BSON document is a JSON-like object with a standard binary encoding defined at bsonspec.org. This implements version 1.0 of that spec.--Use the GHC language extension /OverloadedStrings/ to automatically convert String literals to UString (UTF8) -}+-- | A BSON document is a JSON-like object with a standard binary encoding+-- defined at bsonspec.org. This implements version 1.0 of that spec.+--+-- Use the GHC language extension /OverloadedStrings/ to automatically convert+-- String literals to Text -{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, DeriveDataTypeable, RankNTypes, OverlappingInstances, IncoherentInstances, ScopedTypeVariables, ForeignFunctionInterface, BangPatterns, CPP #-}+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}+{-# LANGUAGE DeriveDataTypeable, RankNTypes, OverlappingInstances #-}+{-# LANGUAGE IncoherentInstances, ScopedTypeVariables #-}+{-# LANGUAGE ForeignFunctionInterface, BangPatterns, CPP #-}  module Data.Bson (-	-- * UTF-8 String-	module Data.UString, 	-- * Document-	Document, look, lookup, valueAt, at, include, exclude, merge,+	Document, (!?), look, lookup, valueAt, at, include, exclude, merge, 	-- * Field 	Field(..), (=:), (=?), 	Label,@@ -27,28 +30,34 @@  import Prelude hiding (lookup) import Control.Applicative ((<$>), (<*>))-import Data.Typeable hiding (cast)-import Data.Int-import Data.Word-import Data.UString (UString, u, unpack)  -- plus Show and IsString instances+import Control.Monad (foldM)+import Data.Bits (shift, (.|.))+import Data.Int (Int32, Int64)+import Data.IORef (IORef, newIORef, atomicModifyIORef)+import Data.List (find, findIndex)+import Data.Maybe (maybeToList, mapMaybe) import Data.Time.Clock (UTCTime)-import Data.Time.Clock.POSIX+import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime,+                              utcTimeToPOSIXSeconds, getPOSIXTime) import Data.Time.Format ()  -- for Show and Read instances of UTCTime-import Data.List (find, findIndex)-import Data.Bits (shift, (.|.))-import qualified Data.ByteString as BS (ByteString, unpack, take)-import qualified Data.ByteString.Char8 as BSC (pack)-import qualified Crypto.Hash.MD5 as MD5 (hash)+import Data.Typeable hiding (cast)+import Data.Word (Word8, Word16, Word32, Word64) import Numeric (readHex, showHex)-import Network.BSD (getHostName) import System.IO.Unsafe (unsafePerformIO)-import Data.IORef-import Data.Maybe (maybeToList, mapMaybe)-import Control.Monad.Identity+import Text.Read (Read(..))++import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as SC import qualified Text.ParserCombinators.ReadP as R import qualified Text.ParserCombinators.ReadPrec as R (lift, readS_to_Prec)-import Text.Read (Read(..)) +import Control.Monad.Identity (runIdentity)+import Network.BSD (getHostName)+import Data.Text (Text)++import qualified Data.Text as T+import qualified Crypto.Hash.MD5 as MD5+ getProcessID :: IO Int -- ^ Get the current process id. getProcessID = c_getpid@@ -71,6 +80,12 @@ type Document = [Field] -- ^ A BSON document is a list of 'Field's +-- | Recursively lookup a nested field in a Document.+(!?) :: Val a => Document -> Label -> Maybe a+doc !? label = foldM (flip lookup) doc (init chunks) >>= lookup (last chunks)+  where+    chunks = T.split (== '.') label+ look :: (Monad m) => Label -> Document -> m Value -- ^ Value of field in document, or fail (Nothing) if field not found look k doc = maybe notFound (return . value) (find ((k ==) . label) doc) where@@ -120,9 +135,9 @@ k =? ma = maybeToList (fmap (k =:) ma)  instance Show Field where-	showsPrec d (k := v) = showParen (d > 0) $ showString (' ' : unpack k) . showString ": " . showsPrec 1 v+	showsPrec d (k := v) = showParen (d > 0) $ showString (' ' : T.unpack k) . showString ": " . showsPrec 1 v -type Label = UString+type Label = Text -- ^ The name of a BSON field  -- * Value@@ -130,7 +145,7 @@ -- | A BSON value is one of the following types of values data Value = 	Float Double |-	String UString |+	String Text | 	Doc Document | 	Array [Value] | 	Bin Binary |@@ -214,16 +229,16 @@ 	cast' (Int64 x) = Just (fromIntegral x) 	cast' _ = Nothing -instance Val UString where+instance Val Text where 	val = String 	cast' (String x) = Just x 	cast' (Sym (Symbol x)) = Just x 	cast' _ = Nothing  instance Val String where-	val = String . u-	cast' (String x) = Just (unpack x)-	cast' (Sym (Symbol x)) = Just (unpack x)+	val = String . T.pack+	cast' (String x) = Just $ T.unpack x+	cast' (Sym (Symbol x)) = Just $ T.unpack x 	cast' _ = Nothing  instance Val Document where@@ -363,29 +378,29 @@  -- ** Binary types -newtype Binary = Binary BS.ByteString  deriving (Typeable, Show, Read, Eq)+newtype Binary = Binary S.ByteString  deriving (Typeable, Show, Read, Eq) -newtype Function = Function BS.ByteString  deriving (Typeable, Show, Read, Eq)+newtype Function = Function S.ByteString  deriving (Typeable, Show, Read, Eq) -newtype UUID = UUID BS.ByteString  deriving (Typeable, Show, Read, Eq)+newtype UUID = UUID S.ByteString  deriving (Typeable, Show, Read, Eq) -newtype MD5 = MD5 BS.ByteString  deriving (Typeable, Show, Read, Eq)+newtype MD5 = MD5 S.ByteString  deriving (Typeable, Show, Read, Eq) -newtype UserDefined = UserDefined BS.ByteString  deriving (Typeable, Show, Read, Eq)+newtype UserDefined = UserDefined S.ByteString  deriving (Typeable, Show, Read, Eq)  -- ** Regex -data Regex = Regex UString UString  deriving (Typeable, Show, Read, Eq)+data Regex = Regex Text Text  deriving (Typeable, Show, Read, Eq) -- ^ The first string is the regex pattern, the second is the regex options string. Options are identified by characters, which must be listed in alphabetical order. Valid options are *i* for case insensitive matching, *m* for multiline matching, *x* for verbose mode, *l* to make \\w, \\W, etc. locale dependent, *s* for dotall mode (\".\" matches everything), and *u* to make \\w, \\W, etc. match unicode.  -- ** Javascript -data Javascript = Javascript Document UString deriving (Typeable, Show, Eq)+data Javascript = Javascript Document Text deriving (Typeable, Show, Eq) -- ^ Javascript code with possibly empty environment mapping variables to values that the code may reference  -- ** Symbol -newtype Symbol = Symbol UString  deriving (Typeable, Show, Read, Eq)+newtype Symbol = Symbol Text  deriving (Typeable, Show, Read, Eq)  -- ** MongoStamp @@ -422,7 +437,7 @@ 	return $ Oid time (composite machineId pid inc)  where 	machineId :: Word24-	machineId = unsafePerformIO (makeWord24 . BS.unpack . BS.take 3 . MD5.hash . BSC.pack <$> getHostName)+	machineId = unsafePerformIO (makeWord24 . S.unpack . S.take 3 . MD5.hash . SC.pack <$> getHostName)  	{-# NOINLINE machineId #-}  	counter :: IORef Word24  	counter = unsafePerformIO (newIORef 0)

@@ -9,20 +9,32 @@ ) where  import Prelude hiding (length, concat)-import Data.Bson-import Data.Int-import Data.Word-import Data.Binary.Put-import Data.Binary.Get-import Data.Binary.IEEE754-import Data.ByteString.Char8 (ByteString, pack, length, concat)-import qualified Data.ByteString.Lazy.Char8 as L (ByteString, toChunks, length)-import qualified Data.CompactString.UTF8 as U-import Data.Time.Clock (UTCTime)-import Data.Time.Clock.POSIX import Control.Applicative ((<$>), (<*>)) import Control.Monad (when)+import Data.Binary.Get (Get, runGet, getWord8, getWord32be, getWord64be,+                        getWord32le, getWord64le, getLazyByteStringNul,+                        getLazyByteString, getByteString, isEmpty)+import Data.Binary.Put (Put, runPut, putWord8, putWord32le, putWord64le,+                        putWord32be, putWord64be, putLazyByteString,+                        putByteString)+import Data.Binary.IEEE754 (getFloat64le, putFloat64le)+import Data.ByteString (ByteString)+import Data.Int (Int32, Int64)+import Data.Time.Clock (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)+import Data.Word (Word8) +import qualified Data.ByteString.Char8 as SC+import qualified Data.ByteString.Lazy.Char8 as LC++import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE++import Data.Bson (Document, Value(..), ObjectId(..), MongoStamp(..), Symbol(..),+                  Javascript(..), UserDefined(..), Regex(..), MinMaxKey(..),+                  Binary(..), UUID(..), Field(..), MD5(..), Function(..))+ putField :: Field -> Put -- ^ Write binary representation of element putField (k := v) = case v of@@ -107,30 +119,30 @@ getInt64 :: Get Int64 getInt64 = fromIntegral <$> getWord64le -putCString :: UString -> Put+putCString :: Text -> Put putCString x = do-	putByteString (U.toByteString x)+	putByteString $ TE.encodeUtf8 x 	putWord8 0 -getCString :: Get UString-getCString = U.fromByteString_ . concat . L.toChunks <$> getLazyByteStringNul+getCString :: Get Text+getCString = TE.decodeUtf8 . SC.concat . LC.toChunks <$> getLazyByteStringNul -putString :: UString -> Put-putString x = let b = U.toByteString x in do-	putInt32 $ toEnum (length b + 1)+putString :: Text -> Put+putString x = let b = TE.encodeUtf8 x in do+	putInt32 $ toEnum (SC.length b + 1) 	putByteString b 	putWord8 0 -getString :: Get UString+getString :: Get Text getString = do 	len <- subtract 1 <$> getInt32 	b <- getByteString (fromIntegral len) 	getWord8-	return (U.fromByteString_ b)+	return $ TE.decodeUtf8 b  putDocument :: Document -> Put putDocument es = let b = runPut (mapM_ putField es) in do-	putInt32 $ (toEnum . fromEnum) (L.length b + 5)  -- include length and null terminator+	putInt32 $ (toEnum . fromEnum) (LC.length b + 5)  -- include length and null terminator 	putLazyByteString b 	putWord8 0 @@ -147,7 +159,7 @@  putArray :: [Value] -> Put putArray vs = putDocument (zipWith f [0..] vs)-	where f i v = (U.pack $! show i) := v+	where f i v = (T.pack $! show i) := v  getArray :: Get [Value] getArray = map value <$> getDocument@@ -155,7 +167,7 @@ type Subtype = Word8  putBinary :: Subtype -> ByteString -> Put-putBinary t x = let len = toEnum (length x) in do+putBinary t x = let len = toEnum (SC.length x) in do 	putInt32 len 	putTag t 	putByteString x@@ -207,12 +219,12 @@ -- stored as milliseconds since Unix epoch getUTC = posixSecondsToUTCTime . (/ 1000) . fromIntegral <$> getInt64 -putClosure :: UString -> Document -> Put+putClosure :: Text -> Document -> Put putClosure x y = let b = runPut (putString x >> putDocument y) in do-	putInt32 $ (toEnum . fromEnum) (L.length b + 4)  -- including this length field+	putInt32 $ (toEnum . fromEnum) (LC.length b + 4)  -- including this length field 	putLazyByteString b -getClosure :: Get (UString, Document)+getClosure :: Get (Text, Document) getClosure = do 	getInt32 	x <- getString

@@ -1,36 +0,0 @@--- | UTF-8 String--{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}-{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}--module Data.UString (-	UString, u,-	module Data.CompactString.UTF8,-	module Data.CompactString-) where--import Data.CompactString ()  -- Show and IsString instances-import Data.CompactString.UTF8-import qualified Data.CompactString as S-import qualified Data.CompactString.Encodings as E-import Text.Read (Read(..))-import Data.Typeable-import Control.Applicative ((<$>))--deriving instance Typeable1 S.CompactString--deriving instance Typeable E.UTF8--instance Read CompactString where-	readPrec = pack <$> readPrec--type UString = CompactString--- ^ UTF-8 String--u :: String -> UString-u = pack---{- Authors: Tony Hannan <tony@10gen.com>-   Copyright 2010 10gen Inc.-   Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at: http://www.apache.org/licenses/LICENSE-2.0. Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. -}

@@ -1,56 +1,39 @@-Name: bson-Version: 0.1.7-Synopsis: BSON documents are JSON-like objects with a standard binary encoding-Description: A BSON Document is an untyped (dynamically type-checked) record. I.e. it is a list of name-value pairs, where a Value is a single sum type with constructors for basic types (Bool, Int, Float, String, and Time), compound types (List, and (embedded) Document), and special types (Binary, Javascript, ObjectId, RegEx, and a few others).-	.-	A BSON Document is serialized to a standard binary encoding defined at <http://bsonspec.org>. This implements version 1 of that spec.+Name:          bson+Version:       0.2.0+Synopsis:      BSON documents are JSON-like objects with a standard binary+               encoding.+Description:   A BSON Document is an untyped (dynamically type-checked) record.+               I.e. it is a list of name-value pairs, where a Value is a single+               sum type with constructors for basic types (Bool, Int, Float,+               String, and Time), compound types (List, and (embedded) Document),+               and special types (Binary, Javascript, ObjectId, RegEx, and a few+               others). -Category: Data-Homepage: http://github.com/TonyGen/bson-haskell-Author: Tony Hannan-Maintainer: Tony Hannan <tonyhannan@gmail.com>-Copyright: Copyright (c) 2010-2012 10gen Inc.-License: OtherLicense-License-file: LICENSE-cabal-version: >= 1.8-build-type: Simple+	           A BSON Document is serialized to a standard binary encoding+               defined at <http://bsonspec.org>. This implements version 1 of+               that spec.+Category:      Data+Homepage:      http://github.com/selectel/bson-haskell+Author:        Tony Hannan+Maintainer:    Fedor Gogolev <knsd@knsd.net>+Copyright:     Copyright (c) 2010-2012 10gen Inc.+License:       OtherLicense+License-file:  LICENSE+Cabal-version: >= 1.8+Build-type:    Simple  Library-    Build-Depends: base < 5,-                   time,-                   bytestring,-                   network,-                   cryptohash,-                   binary,-                   data-binary-ieee754,-                   compact-string-fix,-                   mtl >= 2--    Exposed-modules: Data.UString,-                     Data.Bson,-                     Data.Bson.Binary--    ghc-prof-options: -auto-all--test-suite test-    type:          exitcode-stdio-1.0-    main-is:       main.hs-    hs-source-dirs: test, .--    build-depends:   HUnit-                   , hspec >= 0.6.1 && < 0.7-                   , file-location >= 0.4 && < 0.5-                   , base >= 4 && < 5-                   , bson-                   , QuickCheck == 2.4.*+  Build-depends:      base < 5+                    , time+                    , bytestring+                    , binary+                    , cryptohash+                    , data-binary-ieee754+                    , mtl >= 2+                    , network+                    , text == 0.11.* -                   , mtl >= 2-                   , network-                   , cryptohash-                   , bytestring-                   , time-                   , data-binary-ieee754-                   , compact-string-fix-                   , file-location+  Exposed-modules:  Data.Bson,+                    Data.Bson.Binary -    cpp-options:   -DTEST+  GHC-prof-options: -auto-all

@@ -1,29 +0,0 @@--- import Test.HUnit hiding (Test)-import Test.Hspec.Monadic (Specs, describe, it, hspecX)-import Test.Hspec.HUnit()-import Test.Hspec.QuickCheck(prop)-import Test.QuickCheck-import Data.Bson-import FileLocation (debug)--main :: IO ()-main = hspecX specs--instance Arbitrary ObjectId where-  arbitrary = do-      t <- arbitrary-      p <- arbitrary-      m <- arbitrary-      i <- arbitrary-      return $ Oid t $ composite m p i--specs :: Specs-specs = do-  describe "ObjectId" $ do-    prop "read <-> show" $ \objId ->-      (debug . read . show . debug) objId == (objId :: ObjectId)--  describe "roundTo" $ do-    prop "round" $ \d ->-      let r =  roundTo (1 / 10) (d :: Double)-      in  r == roundTo (1 / 10) r