packages feed

protobuf 0.2.0.1 → 0.2.0.2

raw patch · 5 files changed

+38/−16 lines, 5 files

Files

CHANGELOG view
@@ -1,3 +1,6 @@+0.2.0.2:+  - Export {get,put}Varint* from Data.ProtocolBuffers.Internal+ 0.2.0.1:   - Dropped ghc-prim dependency, what we need is now exported from base   - Added this CHANGELOG
protobuf.cabal view
@@ -1,5 +1,5 @@ name:                protobuf-version:             0.2.0.1+version:             0.2.0.2 synopsis:            Google Protocol Buffers via GHC.Generics description:   Google Protocol Buffers via GHC.Generics.
src/Data/ProtocolBuffers/Internal.hs view
@@ -9,6 +9,8 @@   , zzEncode64   , zzDecode32   , zzDecode64+  , getVarintPrefixedBS, getVarInt+  , putVarintPrefixedBS, putVarSInt, putVarUInt   , Field(..)   , Value(..)   , Always(..)
src/Data/ProtocolBuffers/Wire.hs view
@@ -18,6 +18,7 @@   , getVarintPrefixedBS   , putVarSInt   , putVarUInt+  , putVarintPrefixedBS   , zzEncode32   , zzEncode64   , zzDecode32@@ -61,6 +62,9 @@ getVarintPrefixedBS :: Get ByteString getVarintPrefixedBS = getBytes =<< getVarInt +putVarintPrefixedBS :: ByteString -> Put+putVarintPrefixedBS bs = putVarUInt (B.length bs) >> putByteString bs+ getWireField :: Get WireField getWireField = do   wireTag <- getVarInt@@ -77,7 +81,7 @@ putWireField :: WireField -> Put putWireField (VarintField    t val) = putWireTag t 0 >> putVarUInt val putWireField (Fixed64Field   t val) = putWireTag t 1 >> putWord64le val-putWireField (DelimitedField t val) = putWireTag t 2 >> putVarUInt (B.length val) >> putByteString val+putWireField (DelimitedField t val) = putWireTag t 2 >> putVarintPrefixedBS val putWireField (StartField     t    ) = putWireTag t 3 putWireField (EndField       t    ) = putWireTag t 4 putWireField (Fixed32Field   t val) = putWireTag t 5 >> putWord32le val@@ -96,7 +100,7 @@       then go (n+7) (val .|. (fromIntegral (b .&. 0x7F) `shiftL` n))       else return $! val .|. (fromIntegral b `shiftL` n) --- This can be used on any Integral type and is needed for signed types; unsigned can use putVarUInt below.+-- | This can be used on any Integral type and is needed for signed types; unsigned can use putVarUInt below. -- This has been changed to handle only up to 64 bit integral values (to match documentation). {-# INLINE putVarSInt #-} putVarSInt :: (Integral a, Bits a) => a -> Put@@ -113,7 +117,7 @@     EQ -> putWord8 0     GT -> putVarUInt bIn --- This should be used on unsigned Integral types only (not checked)+-- | This should be used on unsigned Integral types only (not checked) {-# INLINE putVarUInt #-} putVarUInt :: (Integral a, Bits a) => a -> Put putVarUInt i
tests/Main.hs view
@@ -33,7 +33,7 @@ import Data.Hex import Data.Int import Data.Monoid-import Data.Serialize (runGet, runPut)+import Data.Serialize (Get, Putter, runGet, runPut) import Data.Proxy import Data.Text (Text) import Data.Typeable@@ -59,6 +59,7 @@   --, testGroup "Tags Out of Range" tagsOutOfRangeTests   , testProperty "Generic message coding" prop_generic   , testProperty "Generic length prefixed message coding" prop_generic_length_prefixed+  , testProperty "Varint prefixed bytestring" prop_varint_prefixed_bytestring   , testCase "Google Reference Test1" test1   , testCase "Google Reference Test2" test2   , testCase "Google Reference Test3" test3@@ -198,26 +199,38 @@     Right val' -> return $ val == val'     Left err   -> fail err -prop_generic :: (Arbitrary WireField) => Gen Prop+prop_generic :: (Arbitrary WireField) => Gen Property prop_generic = do   msg <- HashMap.fromListWith (++) . fmap (\ c -> (wireFieldTag c, [c])) <$> listOf1 arbitrary-  prop_roundtrip msg+  prop_roundtrip_msg msg -prop_generic_length_prefixed :: (Arbitrary WireField) => Gen Prop+prop_generic_length_prefixed :: (Arbitrary WireField) => Gen Property prop_generic_length_prefixed = do   msg <- HashMap.fromListWith (++) . fmap (\ c -> (wireFieldTag c, [c])) <$> listOf1 arbitrary   let bs = runPut $ encodeLengthPrefixedMessage (msg :: HashMap Tag [WireField])   case runGet decodeLengthPrefixedMessage bs of-    Right msg' -> unProperty $ counterexample "foo" $ msg == msg'+    Right msg' -> return $ counterexample "foo" $ msg == msg'     Left err   -> fail err -prop_roundtrip :: (Eq a, Encode a, Decode a) => a -> Gen Prop-prop_roundtrip msg = do+prop_roundtrip_msg :: (Eq a, Encode a, Decode a) => a -> Gen Property+prop_roundtrip_msg msg = do   let bs = runPut $ encodeMessage msg   case runGet decodeMessage bs of-    Right msg' -> unProperty $ property $ msg == msg'-    Left err   -> unProperty $ property $ False -- TODO Find how to create a failure with `err`+    Right msg' -> return . property $ msg == msg'+    Left err   -> fail err +prop_varint_prefixed_bytestring :: Gen Property+prop_varint_prefixed_bytestring = do+  bs <- B.pack <$> arbitrary+  prop_roundtrip_value getVarintPrefixedBS putVarintPrefixedBS bs++prop_roundtrip_value :: (Eq a, Show a) => Get a -> Putter a -> a -> Gen Property+prop_roundtrip_value get put val = do+  let bs = runPut (put val)+  case runGet get bs of+    Right val' -> return $ val === val'+    Left err   -> fail err+ prop_encode_fail :: Encode a => a -> Gen Prop prop_encode_fail msg = unProperty $ ioProperty $ do   res <- try . evaluate . runPut $ encodeMessage msg@@ -264,7 +277,7 @@ prop_req :: forall a . (Arbitrary (Value a), Eq a, EncodeWire a, DecodeWire a, Typeable a) => Proxy a -> Property prop_req _ = label ("prop_req :: " ++ show (typeOf (undefined :: a))) $ do   val <- Just <$> arbitrary-  prop_req_reify (val :: Maybe (Value a)) prop_roundtrip+  prop_req_reify (val :: Maybe (Value a)) prop_roundtrip_msg  prop_repeated_reify :: forall a r . [a] -> (forall n . KnownNat n => RepeatedValue n a -> Gen r) -> Gen r prop_repeated_reify a f = prop_reify_valid_tag g where@@ -274,7 +287,7 @@ prop_repeated :: forall a . (Arbitrary a, Eq a, EncodeWire a, DecodeWire a, Typeable a) => Proxy a -> Property prop_repeated _ = label ("prop_repeated :: " ++ show (typeOf (undefined :: a))) $ do   val <- arbitrary-  prop_repeated_reify (val :: [a]) prop_roundtrip+  prop_repeated_reify (val :: [a]) prop_roundtrip_msg  prop_opt_reify :: forall a r . Maybe a -> (forall n . KnownNat n => OptionalValue n a -> Gen r) -> Gen r prop_opt_reify a f = prop_reify_valid_tag g where@@ -284,7 +297,7 @@ prop_opt :: forall a . (Arbitrary a, Eq a, EncodeWire a, DecodeWire a, Typeable a) => Proxy a -> Property prop_opt _ = label ("prop_opt :: " ++ show (typeOf (undefined :: a))) $ do   val <- arbitrary-  prop_opt_reify (val :: Maybe a) prop_roundtrip+  prop_opt_reify (val :: Maybe a) prop_roundtrip_msg  -- implement the examples from https://developers.google.com/protocol-buffers/docs/encoding testSpecific :: (Eq a, Show a, Encode a, Decode a) => a -> B.ByteString -> IO ()