binary-orphans 1.0.2 → 1.0.3
raw patch · 4 files changed
+87/−7 lines, 4 filesdep ~basedep ~quickcheck-instancesPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, quickcheck-instances
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- binary-orphans.cabal +8/−6
- src/Data/Binary/Orphans.hs +68/−1
- test/Tests.hs +7/−0
CHANGELOG.md view
@@ -1,3 +1,7 @@+# 1.0.3++- Add `ByteArray` (from `Data.Array.Byte` instance)+ # 1.0.2 - Add `Solo` instance
binary-orphans.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: binary-orphans-version: 1.0.2+version: 1.0.3 synopsis: Compatibility package for binary; provides instances category: Data, Binary, Parsing, Compatibility description:@@ -25,8 +25,9 @@ || ==8.6.5 || ==8.8.4 || ==8.10.4- || ==9.0.1- || ==9.2.1+ || ==9.0.2+ || ==9.2.4+ || ==9.4.1 extra-source-files: CHANGELOG.md @@ -37,10 +38,11 @@ library default-language: Haskell2010 hs-source-dirs: src+ ghc-options: -Wall exposed-modules: Data.Binary.Orphans other-extensions: CPP build-depends:- base >=4.5 && <4.17+ base >=4.5 && <4.18 , binary >=0.5.1.0 && <0.6 || >=0.7.1.0 && <0.8 || >=0.8.3.0 && <0.8.10 , transformers >=0.3.0.0 && <0.7 @@ -50,7 +52,7 @@ if !impl(ghc >=8.0) build-depends: fail >=4.9 && <4.10- build-depends: semigroups >=0.18.5 && <0.19.2+ build-depends: semigroups >=0.18.5 && <0.20.1 if !impl(ghc >=9.2) build-depends: OneTuple >=0.3 && <0.4@@ -67,7 +69,7 @@ , binary-orphans , OneTuple >=0.3 && <0.4 , QuickCheck >=2.13.1 && <2.15- , quickcheck-instances >=0.3.21 && <0.4+ , quickcheck-instances >=0.3.28 && <0.4 , tagged >=0.8.6 && <0.8.7 , tasty >=0.10.1.2 && <1.5 , tasty-quickcheck >=0.8.3.2 && <0.11
src/Data/Binary/Orphans.hs view
@@ -1,7 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif@@ -12,7 +14,8 @@ import Data.Binary.Put import Control.Applicative (Alternative (..))-import Control.Monad (MonadPlus (..), liftM, liftM2)+import Control.Monad+ (MonadPlus (..), liftM, liftM2, replicateM) import qualified Control.Monad.Fail as Fail import Data.Bits (Bits, shiftL, shiftR, (.|.)) import Data.Complex (Complex (..))@@ -34,6 +37,15 @@ import Data.Tuple.Solo (Solo (..)) #endif +#if MIN_VERSION_base(4,17,0)+import Data.Array.Byte (ByteArray (..), MutableByteArray (..))+import GHC.Exts+ (Int (..), indexWord8Array#, newByteArray#, sizeofByteArray#,+ unsafeFreezeByteArray#, writeWord8Array#)+import GHC.ST (ST (..), runST)+import GHC.Word (Word8 (..))+#endif+ ------------------------------------------------------------------------------- -- binary-0.7.1.0 -------------------------------------------------------------------------------@@ -337,3 +349,58 @@ instance Binary a => Binary (Solo a) where put (Solo x) = put x get = fmap Solo get++#if MIN_VERSION_base(4,17,0)+instance Binary ByteArray where+ put ba = put maxI >> go 0+ where+ maxI :: Int+ maxI = sizeofByteArray ba++ go :: Int -> Put+ go i | i < maxI = put (indexByteArray ba i) >> go (i + 1)+ | otherwise = return ()++ get = do+ len <- get+ xs <- replicateM len get+ return (byteArrayFromListN len xs)++{-# INLINE sizeofByteArray #-}+sizeofByteArray :: ByteArray -> Int+sizeofByteArray (ByteArray ba) = I# (sizeofByteArray# ba)++{-# INLINE indexByteArray #-}+indexByteArray :: ByteArray -> Int -> Word8+indexByteArray (ByteArray ba) (I# i) = W8# (indexWord8Array# ba i)++{-# INLINE byteArrayFromListN #-}+byteArrayFromListN :: Int -> [Word8] -> ByteArray+byteArrayFromListN len xs = runST $ do+ mba <- newByteArray len+ go mba 0 xs+ unsafeFreezeByteArray mba+ where+ go :: MutableByteArray s -> Int -> [Word8] -> ST s ()+ go mba i ys+ | i < len = case ys of+ [] -> writeWord8Array mba i 0 >> go mba (i + 1) ys+ z:zs -> writeWord8Array mba i z >> go mba (i + 1) zs++ | otherwise = return ()++{-# INLINE newByteArray #-}+newByteArray :: Int -> ST s (MutableByteArray s)+newByteArray (I# len) = ST $ \s -> case newByteArray# len s of+ (# s', mba #) -> (# s', MutableByteArray mba #)++{-# INLINE unsafeFreezeByteArray #-}+unsafeFreezeByteArray :: MutableByteArray s -> ST s ByteArray+unsafeFreezeByteArray (MutableByteArray mba) = ST $ \s -> case unsafeFreezeByteArray# mba s of+ (# s', ba #) -> (# s', ByteArray ba #)++{-# INLINE writeWord8Array #-}+writeWord8Array :: MutableByteArray s -> Int -> Word8 -> ST s ()+writeWord8Array (MutableByteArray mba) (I# i) (W8# w) = ST $ \s -> case writeWord8Array# mba i w s of+ s' -> (# s', () #)+#endif
test/Tests.hs view
@@ -13,6 +13,10 @@ import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.QuickCheck (testProperty) +#if MIN_VERSION_base(4,17,0)+import Data.Array.Byte (ByteArray)+#endif+ main :: IO () main = defaultMain tests @@ -22,6 +26,9 @@ , testProperty "Sum Int" $ roundtrip (Proxy :: Proxy (Sum Int)) , testProperty "Min Int" $ roundtrip (Proxy :: Proxy (Min Int)) , testProperty "Solo Int" $ roundtrip (Proxy :: Proxy (Solo Int))+#if MIN_VERSION_base(4,17,0)+ , testProperty "ByteArray" $ roundtrip (Proxy :: Proxy ByteArray)+#endif ] roundtrip :: (Eq a, Show a, Binary a) => Proxy a -> a -> Property