binary 0.7.2.3 → 0.7.3.0
raw patch · 4 files changed
+82/−6 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- binary.cabal +1/−1
- src/Data/Binary/Class.hs +36/−3
- tests/Arbitrary.hs +23/−0
- tests/QC.hs +22/−2
binary.cabal view
@@ -1,5 +1,5 @@ name: binary-version: 0.7.2.3+version: 0.7.3.0 license: BSD3 license-file: LICENSE author: Lennart Kolmodin <kolmodin@gmail.com>
src/Data/Binary/Class.hs view
@@ -5,6 +5,11 @@ #ifdef GENERICS {-# LANGUAGE DefaultSignatures #-} #endif++#if MIN_VERSION_base(4,8,0)+#define HAS_NATURAL+#endif+ ----------------------------------------------------------------------------- -- | -- Module : Data.Binary.Class@@ -61,6 +66,9 @@ import GHC.Generics #endif +#ifdef HAS_NATURAL+import Numeric.Natural+#endif -- -- This isn't available in older Hugs or older GHC --@@ -165,7 +173,7 @@ put i = put (fromIntegral i :: Word32) get = liftM fromIntegral (get :: Get Word32) --- Int64s are written as a 4 bytes in big endian format+-- Int64s are written as a 8 bytes in big endian format instance Binary Int64 where put i = put (fromIntegral i :: Word64) get = liftM fromIntegral (get :: Get Word64)@@ -225,16 +233,41 @@ -- -- Fold and unfold an Integer to and from a list of its bytes ---unroll :: Integer -> [Word8]+unroll :: (Integral a, Num a, Bits a) => a -> [Word8] unroll = unfoldr step where step 0 = Nothing step i = Just (fromIntegral i, i `shiftR` 8) -roll :: [Word8] -> Integer+roll :: (Integral a, Num a, Bits a) => [Word8] -> a roll = foldr unstep 0 where unstep b a = a `shiftL` 8 .|. fromIntegral b++#ifdef HAS_NATURAL+-- Fixed-size type for a subset of Natural+type NaturalWord = Word64++instance Binary Natural where+ {-# INLINE put #-}+ put n | n <= hi = do+ putWord8 0+ put (fromIntegral n :: NaturalWord) -- fast path+ where+ hi = fromIntegral (maxBound :: NaturalWord) :: Natural++ put n = do+ putWord8 1+ put (unroll (abs n)) -- unroll the bytes++ {-# INLINE get #-}+ get = do+ tag <- get :: Get Word8+ case tag of+ 0 -> liftM fromIntegral (get :: Get NaturalWord)+ _ -> do bytes <- get+ return $! roll bytes+#endif {-
tests/Arbitrary.hs view
@@ -1,5 +1,10 @@+{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +#if MIN_VERSION_base(4,8,0)+#define HAS_NATURAL+#endif+ module Arbitrary where import Test.QuickCheck@@ -7,6 +12,10 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L +#ifdef HAS_NATURAL+import Numeric.Natural+#endif+ instance Arbitrary L.ByteString where arbitrary = fmap L.fromChunks arbitrary @@ -52,3 +61,17 @@ (a,b,c,d,e) <- arbitrary (f,g,h,i,j) <- arbitrary return (a,b,c,d,e,f,g,h,i,j)+++#ifdef HAS_NATURAL+-- | Generates a natural number. The number must be positive+-- and its maximum value depends on the size parameter.+arbitrarySizedNatural :: Gen Natural+arbitrarySizedNatural =+ sized $ \n0 ->+ let n = toInteger n0 in+ inBounds fromInteger (choose (0, n*n))++inBounds :: Integral a => (Integer -> a) -> Gen Integer -> Gen a+inBounds fi g = fmap fi (g `suchThat` (\x -> toInteger (fi x) == x))+#endif
tests/QC.hs view
@@ -1,6 +1,10 @@-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP, ScopedTypeVariables #-} module Main ( main ) where +#if MIN_VERSION_base(4,8,0)+#define HAS_NATURAL+#endif+ import Control.Applicative import Control.Exception as C (SomeException, catch, evaluate)@@ -17,7 +21,11 @@ import Test.QuickCheck import qualified Action (tests)-import Arbitrary ()+import Arbitrary (+#ifdef HAS_NATURAL+ arbitrarySizedNatural+#endif+ ) import Data.Binary import Data.Binary.Get import Data.Binary.Put@@ -349,6 +357,15 @@ ------------------------------------------------------------------------ +#ifdef HAS_NATURAL+-- | Until the QuickCheck library implements instance Arbitrary Natural,+-- we need this test.+prop_test_Natural :: Property+prop_test_Natural = forAll arbitrarySizedNatural test+#endif++------------------------------------------------------------------------+ type T a = a -> Property type B a = a -> Bool @@ -426,6 +443,9 @@ , ("Word", p (test :: T Word )) , ("Int", p (test :: T Int )) , ("Integer", p (test :: T Integer ))+#ifdef HAS_NATURAL+ , ("Natural", (prop_test_Natural :: Property ))+#endif , ("Float", p (test :: T Float )) , ("Double", p (test :: T Double ))