diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +# 1.0.5 + +- Support GHC-8.6.5..GHC-9.10.1 + # 1.0.4.1 - Support OneTuple-0.4 diff --git a/binary-orphans.cabal b/binary-orphans.cabal --- a/binary-orphans.cabal +++ b/binary-orphans.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: binary-orphans -version: 1.0.4.1 +version: 1.0.5 synopsis: Compatibility package for binary; provides instances category: Data, Binary, Parsing, Compatibility description: @@ -15,26 +15,21 @@ license: BSD3 license-file: LICENSE tested-with: - GHC ==7.4.2 - || ==7.6.3 - || ==7.8.4 - || ==7.10.3 - || ==8.0.2 - || ==8.2.2 - || ==8.4.4 - || ==8.6.5 + GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 - || ==9.2.7 - || ==9.4.4 - || ==9.6.1 + || ==9.2.8 + || ==9.4.8 + || ==9.6.5 + || ==9.8.2 + || ==9.10.1 extra-source-files: CHANGELOG.md source-repository head type: git - location: git://github.com/phadej/binary-orphans.git + location: https://github.com/phadej/binary-orphans.git library default-language: Haskell2010 @@ -43,20 +38,11 @@ exposed-modules: Data.Binary.Orphans other-extensions: CPP build-depends: - 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 - - if !impl(ghc >=7.10) - build-depends: nats >=1.1.2 && <1.2 - build-depends: void >=0.7.3 && <0.8 - - if !impl(ghc >=8.0) - build-depends: fail >=4.9 && <4.10 - build-depends: semigroups >=0.18.5 && <0.20.1 + base >=4.12.0.0 && <4.21 + , binary >=0.8.6.0 && <0.8.10 if !impl(ghc >=9.2) - build-depends: OneTuple >=0.3 && <0.5 + build-depends: OneTuple >=0.4.2 && <0.5 if impl(ghc >=8.0 && <9.4) build-depends: data-array-byte >=0.1.0.1 && <0.2 @@ -72,19 +58,11 @@ , binary , binary-orphans , OneTuple >=0.3 && <0.5 - , QuickCheck >=2.13.1 && <2.15 + , QuickCheck >=2.13.1 && <2.16 , quickcheck-instances >=0.3.28 && <0.4 - , tagged >=0.8.6 && <0.8.7 - , tasty >=0.10.1.2 && <1.5 + , tagged >=0.8.6 && <0.9 + , tasty >=0.10.1.2 && <1.6 , tasty-quickcheck >=0.8.3.2 && <0.11 - - if !impl(ghc >=8.0) - build-depends: semigroups - - if !impl(ghc >=7.10) - build-depends: - nats - , void if impl(ghc >=8.0 && <9.4) build-depends: data-array-byte diff --git a/src/Data/Binary/Orphans.hs b/src/Data/Binary/Orphans.hs --- a/src/Data/Binary/Orphans.hs +++ b/src/Data/Binary/Orphans.hs @@ -4,32 +4,13 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnboxedTuples #-} -#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} -#endif -{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-imports #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Data.Binary.Orphans () where import Data.Binary -import Data.Binary.Put -import Control.Applicative (Alternative (..)) -import Control.Monad - (MonadPlus (..), liftM, liftM2, replicateM) -import qualified Control.Monad.Fail as Fail -import Data.Bits (Bits, shiftL, shiftR, (.|.)) -import Data.Complex (Complex (..)) -import qualified Data.Fixed as Fixed -import Data.Functor.Identity (Identity (..)) -import Data.List (foldl', unfoldr) -import qualified Data.List.NonEmpty as NE -import qualified Data.Monoid as Monoid -import Data.Semigroup ((<>)) -import qualified Data.Semigroup as Semigroup -import Data.Version (Version (..)) -import Data.Void (Void, absurd) -import GHC.Fingerprint (Fingerprint (..)) -import Numeric.Natural (Natural) +import Control.Monad (replicateM) #if MIN_VERSION_base(4,18,0) import Data.Tuple (Solo (MkSolo)) @@ -37,320 +18,17 @@ import Data.Tuple (Solo (Solo)) #define MkSolo Solo #else -#if MIN_VERSION_OneTuple(0,4,0) import Data.Tuple.Solo (Solo (MkSolo)) -#else -import Data.Tuple.Solo (Solo (Solo)) -#define MkSolo Solo #endif -#endif -#if MIN_VERSION_base(4,9,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 -------------------------------------------------------------------------------- - -#if !(MIN_VERSION_binary(0,7,1)) - -------------------------------------------------------------------------------- --- Add MonadPlus instance for Get. - --- Not implementable, as far as I can see - -#endif - -------------------------------------------------------------------------------- --- binary-0.7.3.0 -------------------------------------------------------------------------------- - -#if !(MIN_VERSION_binary(0,7,3) ) - -------------------------------------------------------------------------------- --- Add Binary instance for Natural (only with base > 4.8). - -#ifndef MIN_VERSION_nats -#define MIN_VERSION_nats(x,y,z) 0 -#endif - -#if !(MIN_VERSION_nats(1,1,0)) --- Fixed-size type for a subset of Natural -type NaturalWord = Word64 - --- | /Since: 0.7.3.0/ -instance Binary Natural where - {-# INLINE put #-} - put n | n <= hi = - putWord8 0 - >> put (fromIntegral n :: NaturalWord) -- fast path - where - hi = fromIntegral (maxBound :: NaturalWord) :: Natural - - put n = - 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 - - --- --- Fold and unfold an Integer to and from a list of its bytes --- -unroll :: (Integral a, Bits a) => a -> [Word8] -unroll = unfoldr step - where - step 0 = Nothing - step i = Just (fromIntegral i, i `shiftR` 8) - -roll :: (Integral a, Bits a) => [Word8] -> a -roll = foldl' unstep 0 . reverse - where - unstep a b = a `shiftL` 8 .|. fromIntegral b -#endif - -#endif - -------------------------------------------------------------------------------- --- binary-0.7.6.0 -------------------------------------------------------------------------------- - -#if !MIN_VERSION_binary(0,7,6) - -------------------------------------------------------------------------------- --- Added binary instance for GHC.Fingerprint (from GHC >= 7.4). - -instance Binary Fingerprint where - put (Fingerprint x1 x2) = put x1 <> put x2 - get = do - x1 <- get - x2 <- get - return $! Fingerprint x1 x2 - -#endif - -------------------------------------------------------------------------------- --- binary-0.8.0.0 -------------------------------------------------------------------------------- - -#if !(MIN_VERSION_binary(0,8,0)) - -------------------------------------------------------------------------------- --- Added binary instance for Version from Data.Version. - -instance Binary Version where - put (Version br tags) = put br <> put tags - get = liftM2 Version get get - -------------------------------------------------------------------------------- --- Added binary instance for Void from GHC 7.10.1. - -instance Binary Void where - put = absurd - get = fail "get @Void" - -------------------------------------------------------------------------------- --- Added binary instance for (Data.Fixed a) from GHC 7.8.1. - -#if MIN_VERSION_base(4,7,0) -instance Binary (Fixed.Fixed a) where - put (Fixed.MkFixed a) = put a - get = Fixed.MkFixed `fmap` get -#else -instance Fixed.HasResolution a => Binary (Fixed.Fixed a) where - -- Using undefined :: Maybe a as a proxy, as Data.Proxy is introduced only in base-4.7 - put x = put (truncate (x * fromInteger (Fixed.resolution (undefined :: Maybe a))) :: Integer) - get = (\x -> fromInteger x / fromInteger (Fixed.resolution (undefined :: Maybe a))) `fmap` get -#endif - -#endif - -------------------------------------------------------------------------------- --- Added semigroup instance for Data.Binary.Builder from GHC 8.0. - --- in semigroups - -------------------------------------------------------------------------------- --- binary-0.8.2.0 -------------------------------------------------------------------------------- - - -------------------------------------------------------------------------------- --- When using GHC >= 8, Data.Binary.Get.Get implements MonadFail and delegates its fail to MonadFail.fail. - -#if !(MIN_VERSION_binary(0,8,2)) || !(MIN_VERSION_base(4,9,0)) -instance Fail.MonadFail Get where - -- this is ok, as if old base: Prelude.fail is Monad's fail - fail = Prelude.fail -#endif - -------------------------------------------------------------------------------- --- binary-0.8.3 -------------------------------------------------------------------------------- - -------------------------------------------------------------------------------- --- Add Monoid and Semigroup instance for Put. - -#if !(MIN_VERSION_binary(0,8,3)) || !(MIN_VERSION_base(4,9,0)) -instance Semigroup.Semigroup Put where - (<>) = (>>) -#endif - -#if !(MIN_VERSION_binary(0,8,3)) -instance Monoid.Monoid Put where - mempty = return () - mappend = (<>) - -#endif - -------------------------------------------------------------------------------- --- Add Binary instance for Complex a. - -#if !(MIN_VERSION_binary(0,8,3)) - -instance Binary a => Binary (Complex a) where - {-# INLINE put #-} - put (r :+ i) = put (r, i) - {-# INLINE get #-} - get = fmap (\(r,i) -> r :+ i) get - -#endif - -------------------------------------------------------------------------------- --- binary-0.8.4 -------------------------------------------------------------------------------- - -------------------------------------------------------------------------------- --- Add Binary instances for datatypes in Data.Monoid/Data.Semigroup --- https://github.com/kolmodin/binary/pull/114 - -#if !MIN_VERSION_binary(0,8,4) - -instance Binary a => Binary (Monoid.Dual a) where - get = fmap Monoid.Dual get - put = put . Monoid.getDual - -instance Binary Monoid.All where - get = fmap Monoid.All get - put = put . Monoid.getAll - -instance Binary Monoid.Any where - get = fmap Monoid.Any get - put = put . Monoid.getAny - -instance Binary a => Binary (Monoid.Sum a) where - get = fmap Monoid.Sum get - put = put . Monoid.getSum - -instance Binary a => Binary (Monoid.Product a) where - get = fmap Monoid.Product get - put = put . Monoid.getProduct - -instance Binary a => Binary (Monoid.First a) where - get = fmap Monoid.First get - put = put . Monoid.getFirst - -instance Binary a => Binary (Monoid.Last a) where - get = fmap Monoid.Last get - put = put . Monoid.getLast - -#if MIN_VERSION_base(4,8,0) -instance Binary (f a) => Binary (Monoid.Alt f a) where - get = fmap Monoid.Alt get - put = put . Monoid.getAlt -#endif - -#endif - ------------------------------------------------------------------------- --- Data.Semigroup datatypes - -#if !MIN_VERSION_binary(0,8,4) || !MIN_VERSION_base(4,9,0) - -instance Binary a => Binary (Semigroup.Min a) where - get = fmap Semigroup.Min get - put = put . Semigroup.getMin - -instance Binary a => Binary (Semigroup.Max a) where - get = fmap Semigroup.Max get - put = put . Semigroup.getMax - -instance Binary a => Binary (Semigroup.First a) where - get = fmap Semigroup.First get - put = put . Semigroup.getFirst - -instance Binary a => Binary (Semigroup.Last a) where - get = fmap Semigroup.Last get - put = put . Semigroup.getLast - -instance Binary a => Binary (Semigroup.Option a) where - get = fmap Semigroup.Option get - put = put . Semigroup.getOption - -instance Binary m => Binary (Semigroup.WrappedMonoid m) where - get = fmap Semigroup.WrapMonoid get - put = put . Semigroup.unwrapMonoid - -instance (Binary a, Binary b) => Binary (Semigroup.Arg a b) where - get = liftM2 Semigroup.Arg get get - put (Semigroup.Arg a b) = put a <> put b - -instance Binary a => Binary (NE.NonEmpty a) where - get = do - x <- get - case x of - [] -> fail "empty NonEmpty" - (x:xs) -> return (x NE.:| xs) - put = put . NE.toList - -#endif - -------------------------------------------------------------------------------- --- binary-0.8.5.0 -------------------------------------------------------------------------------- - -#if !(MIN_VERSION_binary(8,6,0)) - -------------------------------------------------------------------------------- --- Typeable TypeReps --- Add Binary instances for Typeable TypeReps --- https://github.com/kolmodin/binary/pull/131 - --- TODO - -#endif - -------------------------------------------------------------------------------- --- binary-0.8.6.0 -------------------------------------------------------------------------------- - -#if !(MIN_VERSION_binary(8,6,0)) - -------------------------------------------------------------------------------- --- Add binary instance for Data.Functor.Identity from base, --- https://github.com/kolmodin/binary/pull/146 - -#if !MIN_VERSION_base(4,8,0) -instance Binary a => Binary (Identity a) where - put (Identity x) = put x - get = fmap Identity get -#endif - -#endif - -------------------------------------------------------------------------------- -- future-binary ------------------------------------------------------------------------------- @@ -359,7 +37,6 @@ put (MkSolo x) = put x get = fmap MkSolo get -#if MIN_VERSION_base(4,9,0) -- | @since 1.0.3 instance Binary ByteArray where put ba = put maxI >> go 0 @@ -413,4 +90,3 @@ 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 diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE CPP #-} module Main (main) where +import Data.Array.Byte (ByteArray) import Data.Binary (Binary, decode, encode) import Data.Binary.Orphans () import Data.Monoid (Sum) -import Data.Proxy +import Data.Proxy (Proxy (..)) import Data.Semigroup (Min (..)) import Data.Tuple.Solo (Solo (..)) import Numeric.Natural (Natural) @@ -13,10 +13,6 @@ import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.QuickCheck (testProperty) -#if MIN_VERSION_base(4,9,0) -import Data.Array.Byte (ByteArray) -#endif - main :: IO () main = defaultMain tests @@ -26,9 +22,7 @@ , 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,9,0) , testProperty "ByteArray" $ roundtrip (Proxy :: Proxy ByteArray) -#endif ] roundtrip :: (Eq a, Show a, Binary a) => Proxy a -> a -> Property