diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Revision history for wide-word +## 0.1.5.0 -- 2023-01-14 + +* Add Binary instances for Int128, Word128 and Word256. + ## 0.1.4.0 -- 2022-12-24 * Add support for building on 32 bit architectures with ghc-9.2 or later. diff --git a/src/Data/WideWord/Int128.hs b/src/Data/WideWord/Int128.hs --- a/src/Data/WideWord/Int128.hs +++ b/src/Data/WideWord/Int128.hs @@ -55,7 +55,8 @@ import Data.Primitive.Types (Prim (..), defaultSetByteArray#, defaultSetOffAddr#) -import Data.Hashable (Hashable,hashWithSalt) +import Data.Hashable (Hashable, hashWithSalt) +import Data.Binary (Binary (get, put)) import Data.WideWord.Word64 @@ -73,6 +74,11 @@ instance Hashable Int128 where hashWithSalt s (Int128 a1 a2) = s `hashWithSalt` a1 `hashWithSalt` a2 + +-- | @since 0.1.5.0 +instance Binary Int128 where + put (Int128 a1 a2) = put a1 >> put a2 + get = Int128 <$> get <*> get byteSwapInt128 :: Int128 -> Int128 byteSwapInt128 (Int128 a1 a0) = Int128 (byteSwap64 a0) (byteSwap64 a1) diff --git a/src/Data/WideWord/Word128.hs b/src/Data/WideWord/Word128.hs --- a/src/Data/WideWord/Word128.hs +++ b/src/Data/WideWord/Word128.hs @@ -55,7 +55,8 @@ import Data.Primitive.Types (Prim (..), defaultSetByteArray#, defaultSetOffAddr#) -import Data.Hashable (Hashable,hashWithSalt) +import Data.Hashable (Hashable, hashWithSalt) +import Data.Binary (Binary (get, put)) data Word128 = Word128 { word128Hi64 :: !Word64 @@ -65,6 +66,11 @@ instance Hashable Word128 where hashWithSalt s (Word128 a1 a2) = s `hashWithSalt` a1 `hashWithSalt` a2 + +-- | @since 0.1.5.0 +instance Binary Word128 where + put (Word128 a1 a2) = put a1 >> put a2 + get = Word128 <$> get <*> get byteSwapWord128 :: Word128 -> Word128 byteSwapWord128 (Word128 a1 a0) = Word128 (byteSwap64 a0) (byteSwap64 a1) diff --git a/src/Data/WideWord/Word256.hs b/src/Data/WideWord/Word256.hs --- a/src/Data/WideWord/Word256.hs +++ b/src/Data/WideWord/Word256.hs @@ -52,7 +52,8 @@ import Numeric (showHex) import Data.Primitive.Types (Prim (..), defaultSetByteArray#, defaultSetOffAddr#) -import Data.Hashable (Hashable,hashWithSalt) +import Data.Hashable (Hashable, hashWithSalt) +import Data.Binary (Binary (get, put)) {- HLINT ignore "Use guards" -} @@ -67,6 +68,11 @@ instance Hashable Word256 where hashWithSalt s (Word256 a1 a2 a3 a4) = s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 + +-- | @since 0.1.5.0 +instance Binary Word256 where + put (Word256 a1 a2 a3 a4) = put a1 >> put a2 >> put a3 >> put a4 + get = Word256 <$> get <*> get <*> get <*> get showHexWord256 :: Word256 -> String showHexWord256 (Word256 a3 a2 a1 a0) diff --git a/test/Test/Data/WideWord/Int128.hs b/test/Test/Data/WideWord/Int128.hs --- a/test/Test/Data/WideWord/Int128.hs +++ b/test/Test/Data/WideWord/Int128.hs @@ -8,6 +8,7 @@ import Control.Monad.IO.Class (liftIO) import Data.Bifunctor (first) +import qualified Data.Binary as Binary import Data.Bits ((.&.), (.|.), bit, complement, countLeadingZeros, countTrailingZeros , popCount, rotateL, rotateR, shiftL, shiftR, testBit, xor) import Data.Int (Int32) @@ -271,6 +272,12 @@ den <- H.forAll $ Gen.filter (/= 0) genInt128 let (d, m) = divMod num den (toInteger128 d, toInteger128 m) === divMod (toInteger128 num) (toInteger128 den) + +prop_roundtrip_binary :: Property +prop_roundtrip_binary = + propertyCount $ do + i128 <- H.forAll genWord128 + H.tripping i128 Binary.encode (Just . Binary.decode) prop_peek_and_poke :: Property prop_peek_and_poke = diff --git a/test/Test/Data/WideWord/Word128.hs b/test/Test/Data/WideWord/Word128.hs --- a/test/Test/Data/WideWord/Word128.hs +++ b/test/Test/Data/WideWord/Word128.hs @@ -8,6 +8,7 @@ import Control.Monad (unless) import Data.Bifunctor (first) +import qualified Data.Binary as Binary import Data.Bits ((.&.), (.|.), bit, complement, countLeadingZeros, countTrailingZeros , popCount, rotateL, rotateR, shiftL, shiftR, testBit, xor) import Data.Int (Int32) @@ -292,6 +293,12 @@ den <- H.forAll $ Gen.filter (/= 0) genWord128 let (d, m) = divMod num den (toInteger128 d, toInteger128 m) === divMod (toInteger128 num) (toInteger128 den) + +prop_roundtrip_binary :: Property +prop_roundtrip_binary = + propertyCount $ do + w128 <- H.forAll genWord128 + H.tripping w128 Binary.encode (Just . Binary.decode) prop_peek_and_poke :: Property prop_peek_and_poke = diff --git a/test/Test/Data/WideWord/Word64.hs b/test/Test/Data/WideWord/Word64.hs --- a/test/Test/Data/WideWord/Word64.hs +++ b/test/Test/Data/WideWord/Word64.hs @@ -9,6 +9,7 @@ import Control.Monad (unless) import Data.Bifunctor (first) +import qualified Data.Binary as Binary import Data.Bits ((.&.), (.|.), bit, complement, countLeadingZeros, countTrailingZeros , popCount, rotateL, rotateR, shiftL, shiftR, testBit, xor) import Data.Primitive.PrimArray @@ -271,6 +272,12 @@ den <- H.forAll $ Gen.filter (/= 0) genWord64 let (d, m) = divMod num den (toInteger64 d, toInteger64 m) === divMod (toInteger64 num) (toInteger64 den) + +prop_roundtrip_binary :: Property +prop_roundtrip_binary = + propertyCount $ do + w64 <- H.forAll genWord128 + H.tripping w64 Binary.encode (Just . Binary.decode) prop_peek_and_poke :: Property prop_peek_and_poke = diff --git a/wide-word.cabal b/wide-word.cabal --- a/wide-word.cabal +++ b/wide-word.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: wide-word -version: 0.1.4.0 +version: 0.1.5.0 synopsis: Data types for large but fixed width signed and unsigned integers description: A library to provide data types for large (ie > 64 bits) but fixed width signed @@ -42,7 +42,8 @@ other-modules: Data.WideWord.Compat build-depends: base >= 4.9 && < 4.18 - , deepseq >= 1.3 && < 1.5 + , binary >= 0.8.3.0 && < 0.9 + , deepseq >= 1.4.2.0 && < 1.5 -- Required so that GHC.IntWord64 is available on 32 bit systems , ghc-prim , primitive >= 0.6.4.0 && < 0.8 @@ -62,6 +63,7 @@ Test.Data.WideWord.Word128 build-depends: base + , binary , bytestring >= 0.10 , ghc-prim , hedgehog >= 1.0 && < 1.3