diff --git a/binary.cabal b/binary.cabal --- a/binary.cabal +++ b/binary.cabal @@ -1,5 +1,5 @@ name: binary -version: 0.8.0.1 +version: 0.8.1.0 license: BSD3 license-file: LICENSE author: Lennart Kolmodin diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,12 @@ binary ====== +binary-0.8.1.0 +-------------- + +- Add binary instance for `Data.ByteString.Short`. +- Add get/put functions for all Int sizes to `Data.Binary.Builder`, `Data.Binary.Get` and `Data.Binary.Put`. + binary-0.8.0.1 -------------- diff --git a/src/Data/Binary/Builder.hs b/src/Data/Binary/Builder.hs --- a/src/Data/Binary/Builder.hs +++ b/src/Data/Binary/Builder.hs @@ -7,7 +7,7 @@ -- Module : Data.Binary.Builder -- Copyright : Lennart Kolmodin, Ross Paterson -- License : BSD3-style (see LICENSE) --- +-- -- Maintainer : Lennart Kolmodin -- Stability : experimental -- Portability : portable to Hugs and GHC @@ -28,6 +28,9 @@ , append , fromByteString -- :: S.ByteString -> Builder , fromLazyByteString -- :: L.ByteString -> Builder +#if MIN_VERSION_bytestring(0,10,4) + , fromShortByteString -- :: T.ByteString -> Builder +#endif -- * Flushing the buffer state , flush @@ -37,17 +40,27 @@ , putWord16be -- :: Word16 -> Builder , putWord32be -- :: Word32 -> Builder , putWord64be -- :: Word64 -> Builder + , putInt16be -- :: Int16 -> Builder + , putInt32be -- :: Int32 -> Builder + , putInt64be -- :: Int64 -> Builder -- ** Little-endian writes , putWord16le -- :: Word16 -> Builder , putWord32le -- :: Word32 -> Builder , putWord64le -- :: Word64 -> Builder + , putInt16le -- :: Int16 -> Builder + , putInt32le -- :: Int32 -> Builder + , putInt64le -- :: Int64 -> Builder -- ** Host-endian, unaligned writes , putWordhost -- :: Word -> Builder , putWord16host -- :: Word16 -> Builder , putWord32host -- :: Word32 -> Builder , putWord64host -- :: Word64 -> Builder + , putInthost -- :: Int -> Builder + , putInt16host -- :: Int16 -> Builder + , putInt32host -- :: Int32 -> Builder + , putInt64host -- :: Int64 -> Builder -- ** Unicode , putCharUtf8 diff --git a/src/Data/Binary/Builder/Base.hs b/src/Data/Binary/Builder/Base.hs --- a/src/Data/Binary/Builder/Base.hs +++ b/src/Data/Binary/Builder/Base.hs @@ -33,7 +33,9 @@ , append , fromByteString -- :: S.ByteString -> Builder , fromLazyByteString -- :: L.ByteString -> Builder - +#if MIN_VERSION_bytestring(0,10,4) + , fromShortByteString -- :: T.ByteString -> Builder +#endif -- * Flushing the buffer state , flush @@ -42,17 +44,27 @@ , putWord16be -- :: Word16 -> Builder , putWord32be -- :: Word32 -> Builder , putWord64be -- :: Word64 -> Builder + , putInt16be -- :: Int16 -> Builder + , putInt32be -- :: Int32 -> Builder + , putInt64be -- :: Int64 -> Builder -- ** Little-endian writes , putWord16le -- :: Word16 -> Builder , putWord32le -- :: Word32 -> Builder , putWord64le -- :: Word64 -> Builder + , putInt16le -- :: Int16 -> Builder + , putInt32le -- :: Int32 -> Builder + , putInt64le -- :: Int64 -> Builder -- ** Host-endian, unaligned writes , putWordhost -- :: Word -> Builder , putWord16host -- :: Word16 -> Builder , putWord32host -- :: Word32 -> Builder , putWord64host -- :: Word64 -> Builder + , putInthost -- :: Int -> Builder + , putInt16host -- :: Int16 -> Builder + , putInt32host -- :: Int32 -> Builder + , putInt64host -- :: Int64 -> Builder -- ** Unicode , putCharUtf8 @@ -64,6 +76,10 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L +#if MIN_VERSION_bytestring(0,10,4) +import qualified Data.ByteString.Short as T +import qualified Data.ByteString.Short.Internal as T +#endif #if MIN_VERSION_base(4,9,0) import Data.Semigroup #else @@ -170,6 +186,17 @@ fromLazyByteString bss = flush `append` mapBuilder (bss `L.append`) {-# INLINE fromLazyByteString #-} +#if MIN_VERSION_bytestring(0,10,4) +-- | /O(n)./ A builder taking 'T.ShortByteString' and copy it to a Builder, +-- satisfying +-- +-- * @'toLazyByteString' ('fromShortByteString' bs) = 'L.fromChunks' ['T.fromShort' bs] +fromShortByteString :: T.ShortByteString -> Builder +fromShortByteString sbs = writeN (T.length sbs) $ \ptr -> + T.copyToPtr sbs 0 ptr (T.length sbs) +{-# INLINE fromShortByteString #-} +#endif + ------------------------------------------------------------------------ -- Our internal buffer type @@ -376,9 +403,42 @@ #endif {-# INLINE putWord64le #-} + + -- on a little endian machine: -- putWord64le w64 = writeN 8 (\p -> poke (castPtr p) w64) + +-- | Write a Int16 in big endian format +putInt16be :: Int16 -> Builder +putInt16be = putWord16be . fromIntegral +{-# INLINE putInt16be #-} + +-- | Write a Int16 in little endian format +putInt16le :: Int16 -> Builder +putInt16le = putWord16le . fromIntegral +{-# INLINE putInt16le #-} + +-- | Write a Int32 in big endian format +putInt32be :: Int32 -> Builder +putInt32be = putWord32be . fromIntegral +{-# INLINE putInt32be #-} + +-- | Write a Int32 in little endian format +putInt32le :: Int32 -> Builder +putInt32le = putWord32le . fromIntegral +{-# INLINE putInt32le #-} + +-- | Write a Int64 in big endian format +putInt64be :: Int64 -> Builder +putInt64be = putWord64be . fromIntegral + +-- | Write a Int64 in little endian format +putInt64le :: Int64 -> Builder +putInt64le = putWord64le . fromIntegral + + + ------------------------------------------------------------------------ -- Unaligned, word size ops @@ -414,6 +474,40 @@ putWord64host w = writeN (sizeOf (undefined :: Word64)) (\p -> poke (castPtr p) w) {-# INLINE putWord64host #-} + +-- | /O(1)./ A Builder taking a single native machine word. The word is +-- written in host order, host endian form, for the machine you're on. +-- On a 64 bit machine the Int is an 8 byte value, on a 32 bit machine, +-- 4 bytes. Values written this way are not portable to +-- different endian or word sized machines, without conversion. +-- +putInthost :: Int -> Builder +putInthost w = + writeN (sizeOf (undefined :: Int)) (\p -> poke (castPtr p) w) +{-# INLINE putInthost #-} + +-- | Write a Int16 in native host order and host endianness. +-- 2 bytes will be written, unaligned. +putInt16host :: Int16 -> Builder +putInt16host w16 = + writeN (sizeOf (undefined :: Int16)) (\p -> poke (castPtr p) w16) +{-# INLINE putInt16host #-} + +-- | Write a Int32 in native host order and host endianness. +-- 4 bytes will be written, unaligned. +putInt32host :: Int32 -> Builder +putInt32host w32 = + writeN (sizeOf (undefined :: Int32)) (\p -> poke (castPtr p) w32) +{-# INLINE putInt32host #-} + +-- | Write a Int64 in native host order. +-- On a 32 bit machine we write two host order Int32s, in big endian form. +-- 8 bytes will be written, unaligned. +putInt64host :: Int64 -> Builder +putInt64host w = + writeN (sizeOf (undefined :: Int64)) (\p -> poke (castPtr p) w) +{-# INLINE putInt64host #-} + ------------------------------------------------------------------------ -- Unicode diff --git a/src/Data/Binary/Class.hs b/src/Data/Binary/Class.hs --- a/src/Data/Binary/Class.hs +++ b/src/Data/Binary/Class.hs @@ -73,6 +73,9 @@ -- And needed for the instances: import qualified Data.ByteString as B +#if MIN_VERSION_bytestring(0,10,4) +import qualified Data.ByteString.Short as BS +#endif import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.IntMap as IntMap @@ -206,35 +209,35 @@ -- Int8s are written as a single byte. instance Binary Int8 where - put i = put (fromIntegral i :: Word8) - get = liftM fromIntegral (get :: Get Word8) + put = putInt8 + get = getInt8 -- Int16s are written as a 2 bytes in big endian format instance Binary Int16 where - put i = put (fromIntegral i :: Word16) - get = liftM fromIntegral (get :: Get Word16) + put = putInt16be + get = getInt16be -- Int32s are written as a 4 bytes in big endian format instance Binary Int32 where - put i = put (fromIntegral i :: Word32) - get = liftM fromIntegral (get :: Get Word32) + put = putInt32be + get = getInt32be -- 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) + put = putInt64be + get = getInt64be ------------------------------------------------------------------------ -- Words are are written as Word64s, that is, 8 bytes in big endian format instance Binary Word where - put i = put (fromIntegral i :: Word64) - get = liftM fromIntegral (get :: Get Word64) + put = putWord64be . fromIntegral + get = liftM fromIntegral getWord64be -- Ints are are written as Int64s, that is, 8 bytes in big endian format instance Binary Int where - put i = put (fromIntegral i :: Int64) - get = liftM fromIntegral (get :: Get Int64) + put = putInt64be . fromIntegral + get = liftM fromIntegral getInt64be ------------------------------------------------------------------------ -- @@ -552,6 +555,14 @@ put bs = do put (fromIntegral (L.length bs) :: Int) putLazyByteString bs get = get >>= getLazyByteString + + +#if MIN_VERSION_bytestring(0,10,4) +instance Binary BS.ShortByteString where + put bs = do put (BS.length bs) + putShortByteString bs + get = get >>= fmap BS.toShort . getByteString +#endif ------------------------------------------------------------------------ -- Maps and Sets diff --git a/src/Data/Binary/Get.hs b/src/Data/Binary/Get.hs --- a/src/Data/Binary/Get.hs +++ b/src/Data/Binary/Get.hs @@ -169,7 +169,7 @@ , getLazyByteStringNul , getRemainingLazyByteString - -- ** Decoding words + -- ** Decoding Words , getWord8 -- *** Big-endian decoding @@ -188,11 +188,33 @@ , getWord32host , getWord64host + -- ** Decoding Ints + , getInt8 + + -- *** Big-endian decoding + , getInt16be + , getInt32be + , getInt64be + + -- *** Little-endian decoding + , getInt16le + , getInt32le + , getInt64le + + -- *** Host-endian, unaligned decoding + , getInthost + , getInt16host + , getInt32host + , getInt64host + -- * Deprecated functions , runGetState -- DEPRECATED , remaining -- DEPRECATED , getBytes -- DEPRECATED ) where +#if ! MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif import Foreign import qualified Data.ByteString as B @@ -410,6 +432,12 @@ getWord8 = readN 1 B.unsafeHead {-# INLINE[2] getWord8 #-} +-- | Read an Int8 from the monad state +getInt8 :: Get Int8 +getInt8 = fromIntegral <$> getWord8 +{-# INLINE getInt8 #-} + + -- force GHC to inline getWordXX {-# RULES "getWord8/readN" getWord8 = readN 1 B.unsafeHead @@ -502,6 +530,39 @@ {-# INLINE[2] getWord64le #-} {-# INLINE word64le #-} + +-- | Read an Int16 in big endian format +getInt16be :: Get Int16 +getInt16be = fromIntegral <$> getWord16be +{-# INLINE getInt16be #-} + +-- | Read an Int32 in big endian format +getInt32be :: Get Int32 +getInt32be = fromIntegral <$> getWord32be +{-# INLINE getInt32be #-} + +-- | Read an Int64 in big endian format +getInt64be :: Get Int64 +getInt64be = fromIntegral <$> getWord64be +{-# INLINE getInt64be #-} + + +-- | Read an Int16 in little endian format +getInt16le :: Get Int16 +getInt16le = fromIntegral <$> getWord16le +{-# INLINE getInt16le #-} + +-- | Read an Int32 in little endian format +getInt32le :: Get Int32 +getInt32le = fromIntegral <$> getWord32le +{-# INLINE getInt32le #-} + +-- | Read an Int64 in little endian format +getInt64le :: Get Int64 +getInt64le = fromIntegral <$> getWord64le +{-# INLINE getInt64le #-} + + ------------------------------------------------------------------------ -- Host-endian reads @@ -526,6 +587,28 @@ getWord64host :: Get Word64 getWord64host = getPtr (sizeOf (undefined :: Word64)) {-# INLINE getWord64host #-} + +-- | /O(1)./ Read a single native machine word in native host +-- order. It works in the same way as 'getWordhost'. +getInthost :: Get Int +getInthost = getPtr (sizeOf (undefined :: Int)) +{-# INLINE getInthost #-} + +-- | /O(1)./ Read a 2 byte Int16 in native host order and host endianness. +getInt16host :: Get Int16 +getInt16host = getPtr (sizeOf (undefined :: Int16)) +{-# INLINE getInt16host #-} + +-- | /O(1)./ Read an Int32 in native host order and host endianness. +getInt32host :: Get Int32 +getInt32host = getPtr (sizeOf (undefined :: Int32)) +{-# INLINE getInt32host #-} + +-- | /O(1)./ Read an Int64 in native host order and host endianess. +getInt64host :: Get Int64 +getInt64host = getPtr (sizeOf (undefined :: Int64)) +{-# INLINE getInt64host #-} + ------------------------------------------------------------------------ -- Unchecked shifts diff --git a/src/Data/Binary/Put.hs b/src/Data/Binary/Put.hs --- a/src/Data/Binary/Put.hs +++ b/src/Data/Binary/Put.hs @@ -32,24 +32,38 @@ -- * Primitives , putWord8 + , putInt8 , putByteString , putLazyByteString +#if MIN_VERSION_bytestring(0,10,4) + , putShortByteString +#endif -- * Big-endian primitives , putWord16be , putWord32be , putWord64be + , putInt16be + , putInt32be + , putInt64be -- * Little-endian primitives , putWord16le , putWord32le , putWord64le + , putInt16le + , putInt32le + , putInt64le -- * Host-endian, unaligned writes , putWordhost -- :: Word -> Put , putWord16host -- :: Word16 -> Put , putWord32host -- :: Word32 -> Put , putWord64host -- :: Word64 -> Put + , putInthost -- :: Int -> Put + , putInt16host -- :: Int16 -> Put + , putInt32host -- :: Int32 -> Put + , putInt64host -- :: Int64 -> Put ) where @@ -57,9 +71,13 @@ import Data.Binary.Builder (Builder, toLazyByteString) import qualified Data.Binary.Builder as B +import Data.Int import Data.Word import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L +#if MIN_VERSION_bytestring(0,10,4) +import Data.ByteString.Short +#endif import Control.Applicative import Prelude -- Silence AMP warning. @@ -148,6 +166,11 @@ putWord8 = tell . B.singleton {-# INLINE putWord8 #-} +-- | Efficiently write a signed byte into the output buffer +putInt8 :: Int8 -> Put +putInt8 = tell . B.singleton . fromIntegral +{-# INLINE putInt8 #-} + -- | An efficient primitive to write a strict ByteString into the output buffer. -- It flushes the current buffer, and writes the argument into a new chunk. putByteString :: S.ByteString -> Put @@ -160,6 +183,13 @@ putLazyByteString = tell . B.fromLazyByteString {-# INLINE putLazyByteString #-} +#if MIN_VERSION_bytestring(0,10,4) +-- | Write 'ShortByteString' to the buffer +putShortByteString :: ShortByteString -> Put +putShortByteString = tell . B.fromShortByteString +{-# INLINE putShortByteString #-} +#endif + -- | Write a Word16 in big endian format putWord16be :: Word16 -> Put putWord16be = tell . B.putWord16be @@ -190,6 +220,37 @@ putWord64le = tell . B.putWord64le {-# INLINE putWord64le #-} +-- | Write an Int16 in big endian format +putInt16be :: Int16 -> Put +putInt16be = tell . B.putInt16be +{-# INLINE putInt16be #-} + +-- | Write an Int16 in little endian format +putInt16le :: Int16 -> Put +putInt16le = tell . B.putInt16le +{-# INLINE putInt16le #-} + +-- | Write an Int32 in big endian format +putInt32be :: Int32 -> Put +putInt32be = tell . B.putInt32be +{-# INLINE putInt32be #-} + +-- | Write an Int32 in little endian format +putInt32le :: Int32 -> Put +putInt32le = tell . B.putInt32le +{-# INLINE putInt32le #-} + +-- | Write an Int64 in big endian format +putInt64be :: Int64 -> Put +putInt64be = tell . B.putInt64be +{-# INLINE putInt64be #-} + +-- | Write an Int64 in little endian format +putInt64le :: Int64 -> Put +putInt64le = tell . B.putInt64le +{-# INLINE putInt64le #-} + + ------------------------------------------------------------------------ -- | /O(1)./ Write a single native machine word. The word is @@ -220,3 +281,32 @@ putWord64host :: Word64 -> Put putWord64host = tell . B.putWord64host {-# INLINE putWord64host #-} + +-- | /O(1)./ Write a single native machine word. The word is +-- written in host order, host endian form, for the machine you're on. +-- On a 64 bit machine the Int is an 8 byte value, on a 32 bit machine, +-- 4 bytes. Values written this way are not portable to +-- different endian or word sized machines, without conversion. +-- +putInthost :: Int -> Put +putInthost = tell . B.putInthost +{-# INLINE putInthost #-} + +-- | /O(1)./ Write an Int16 in native host order and host endianness. +-- For portability issues see @putInthost@. +putInt16host :: Int16 -> Put +putInt16host = tell . B.putInt16host +{-# INLINE putInt16host #-} + +-- | /O(1)./ Write an Int32 in native host order and host endianness. +-- For portability issues see @putInthost@. +putInt32host :: Int32 -> Put +putInt32host = tell . B.putInt32host +{-# INLINE putInt32host #-} + +-- | /O(1)./ Write an Int64 in native host order +-- On a 32 bit machine we write two host order Int32s, in big endian form. +-- For portability issues see @putInthost@. +putInt64host :: Int64 -> Put +putInt64host = tell . B.putInt64host +{-# INLINE putInt64host #-} diff --git a/tests/Arbitrary.hs b/tests/Arbitrary.hs --- a/tests/Arbitrary.hs +++ b/tests/Arbitrary.hs @@ -7,12 +7,20 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L +#if MIN_VERSION_bytestring(0,10,4) +import qualified Data.ByteString.Short as S +#endif instance Arbitrary L.ByteString where arbitrary = fmap L.fromChunks arbitrary instance Arbitrary B.ByteString where arbitrary = B.pack `fmap` arbitrary + +#if MIN_VERSION_bytestring(0,10,4) +instance Arbitrary S.ShortByteString where + arbitrary = S.toShort `fmap` arbitrary +#endif instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e, Arbitrary f) => diff --git a/tests/QC.hs b/tests/QC.hs --- a/tests/QC.hs +++ b/tests/QC.hs @@ -20,6 +20,9 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Internal as L +#if MIN_VERSION_bytestring(0,10,4) +import Data.ByteString.Short (ShortByteString) +#endif import Data.Int import Data.Ratio import System.IO.Unsafe @@ -63,7 +66,12 @@ (\(_e :: SomeException) -> return True) -- low level ones: +-- +-- Words +prop_Word8 :: Word8 -> Property +prop_Word8 = roundTripWith putWord8 getWord8 + prop_Word16be :: Word16 -> Property prop_Word16be = roundTripWith putWord16be getWord16be @@ -94,7 +102,42 @@ prop_Wordhost :: Word -> Property prop_Wordhost = roundTripWith putWordhost getWordhost +-- Ints +prop_Int8 :: Int8 -> Property +prop_Int8 = roundTripWith putInt8 getInt8 + +prop_Int16be :: Int16 -> Property +prop_Int16be = roundTripWith putInt16be getInt16be + +prop_Int16le :: Int16 -> Property +prop_Int16le = roundTripWith putInt16le getInt16le + +prop_Int16host :: Int16 -> Property +prop_Int16host = roundTripWith putInt16host getInt16host + +prop_Int32be :: Int32 -> Property +prop_Int32be = roundTripWith putInt32be getInt32be + +prop_Int32le :: Int32 -> Property +prop_Int32le = roundTripWith putInt32le getInt32le + +prop_Int32host :: Int32 -> Property +prop_Int32host = roundTripWith putInt32host getInt32host + +prop_Int64be :: Int64 -> Property +prop_Int64be = roundTripWith putInt64be getInt64be + +prop_Int64le :: Int64 -> Property +prop_Int64le = roundTripWith putInt64le getInt64le + +prop_Int64host :: Int64 -> Property +prop_Int64host = roundTripWith putInt64host getInt64host + +prop_Inthost :: Int -> Property +prop_Inthost = roundTripWith putInthost getInthost + + -- done, partial and fail -- | Test partial results. @@ -466,7 +509,8 @@ Action.tests , testGroup "Primitives" - [ testProperty "Word16be" (p prop_Word16be) + [ testProperty "Word8" (p prop_Word8) + , testProperty "Word16be" (p prop_Word16be) , testProperty "Word16le" (p prop_Word16le) , testProperty "Word16host" (p prop_Word16host) , testProperty "Word32be" (p prop_Word32be) @@ -476,6 +520,18 @@ , testProperty "Word64le" (p prop_Word64le) , testProperty "Word64host" (p prop_Word64host) , testProperty "Wordhost" (p prop_Wordhost) + -- Int + , testProperty "Int8" (p prop_Int8) + , testProperty "Int16be" (p prop_Int16be) + , testProperty "Int16le" (p prop_Int16le) + , testProperty "Int16host" (p prop_Int16host) + , testProperty "Int32be" (p prop_Int32be) + , testProperty "Int32le" (p prop_Int32le) + , testProperty "Int32host" (p prop_Int32host) + , testProperty "Int64be" (p prop_Int64be) + , testProperty "Int64le" (p prop_Int64le) + , testProperty "Int64host" (p prop_Int64host) + , testProperty "Inthost" (p prop_Inthost) ] , testGroup "String utils" @@ -559,6 +615,9 @@ , ("B.ByteString", p (test :: T B.ByteString )) , ("L.ByteString", p (test :: T L.ByteString )) +#if MIN_VERSION_bytestring(0,10,4) + , ("ShortByteString", p (test :: T ShortByteString )) +#endif ] , testGroup "Invariants" $ map (uncurry testProperty) @@ -566,6 +625,10 @@ , ("[B.ByteString] invariant", p (prop_invariant :: B [B.ByteString] )) , ("L.ByteString invariant", p (prop_invariant :: B L.ByteString )) , ("[L.ByteString] invariant", p (prop_invariant :: B [L.ByteString] )) +#if MIN_VERSION_bytestring(0,10,4) + , ("ShortByteString invariant", p (prop_invariant :: B ShortByteString )) + , ("[ShortByteString] invariant", p (prop_invariant :: B [ShortByteString] )) +#endif ] #ifdef HAS_FIXED_CONSTRUCTOR , testGroup "Fixed"