diff --git a/binary.cabal b/binary.cabal --- a/binary.cabal +++ b/binary.cabal @@ -1,3 +1,5 @@ +cabal-version: 3.0 + -- To run tests and binaries you'll need to rename the name of the library -- and all the local dependencies on it. If not, cabal is unable to come up -- with a build plan. @@ -7,8 +9,8 @@ -- sed -i 's/\(binary\),/\1-cabal-is-broken,/' binary.cabal name: binary -version: 0.8.8.0 -license: BSD3 +version: 0.8.9.0 +license: BSD-3-Clause license-file: LICENSE author: Lennart Kolmodin maintainer: Lennart Kolmodin, Don Stewart @@ -25,7 +27,6 @@ category: Data, Parsing stability: provisional build-type: Simple -cabal-version: >= 1.8 tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC ==8.2.2, GHC == 8.4.4, GHC == 8.6.5 extra-source-files: README.md changelog.md docs/hcar/binary-Lb.tex tools/derive/*.hs @@ -59,6 +60,7 @@ if impl(ghc >= 8.0) ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances + default-language: Haskell2010 test-suite qc type: exitcode-stdio-1.0 @@ -83,6 +85,7 @@ if impl(ghc <= 7.6) -- prior to ghc-7.4 generics lived in ghc-prim build-depends: ghc-prim + default-language: Haskell2010 test-suite read-write-file @@ -104,6 +107,7 @@ if impl(ghc <= 7.6) -- prior to ghc-7.4 generics lived in ghc-prim build-depends: ghc-prim + default-language: Haskell2010 benchmark bench @@ -124,6 +128,7 @@ if impl(ghc <= 7.6) -- prior to ghc-7.4 generics lived in ghc-prim build-depends: ghc-prim + default-language: Haskell2010 benchmark get @@ -145,6 +150,7 @@ if impl(ghc <= 7.6) -- prior to ghc-7.4 generics lived in ghc-prim build-depends: ghc-prim + default-language: Haskell2010 benchmark put @@ -163,6 +169,7 @@ if impl(ghc <= 7.6) -- prior to ghc-7.4 generics lived in ghc-prim build-depends: ghc-prim + default-language: Haskell2010 benchmark generics-bench type: exitcode-stdio-1.0 @@ -192,6 +199,7 @@ if impl(ghc <= 7.6) -- prior to ghc-7.4 generics lived in ghc-prim build-depends: ghc-prim + default-language: Haskell2010 benchmark builder type: exitcode-stdio-1.0 @@ -210,3 +218,4 @@ if impl(ghc <= 7.6) -- prior to ghc-7.4 generics lived in ghc-prim build-depends: ghc-prim + default-language: Haskell2010 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,12 @@ binary ====== +binary-0.8.9.0 +-------------- + +- Compatibility with GHC 9.2 +- Drop instances for deprecated `Data.Semigroup.Option` + binary-0.8.8.0 -------------- 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 @@ -9,6 +9,10 @@ {-# LANGUAGE PolyKinds #-} #endif +#if MIN_VERSION_base(4,16,0) +#define HAS_TYPELITS_CHAR +#endif + #if MIN_VERSION_base(4,8,0) #define HAS_NATURAL #define HAS_VOID @@ -106,6 +110,10 @@ import qualified Data.Fixed as Fixed +#if __GLASGOW_HASKELL__ >= 901 +import GHC.Exts (Levity(Lifted,Unlifted)) +#endif + -- -- This isn't available in older Hugs or older GHC -- @@ -812,10 +820,12 @@ get = fmap Semigroup.Last get put = put . Semigroup.getLast +#if __GLASGOW_HASKELL__ < 901 -- | @since 0.8.4.0 instance Binary a => Binary (Semigroup.Option a) where get = fmap Semigroup.Option get put = put . Semigroup.getOption +#endif -- | @since 0.8.4.0 instance Binary m => Binary (Semigroup.WrappedMonoid m) where @@ -879,8 +889,13 @@ put (VecRep a b) = putWord8 0 >> put a >> put b put (TupleRep reps) = putWord8 1 >> put reps put (SumRep reps) = putWord8 2 >> put reps +#if __GLASGOW_HASKELL__ >= 901 + put (BoxedRep Lifted) = putWord8 3 + put (BoxedRep Unlifted) = putWord8 4 +#else put LiftedRep = putWord8 3 put UnliftedRep = putWord8 4 +#endif put IntRep = putWord8 5 put WordRep = putWord8 6 put Int64Rep = putWord8 7 @@ -905,8 +920,13 @@ 0 -> VecRep <$> get <*> get 1 -> TupleRep <$> get 2 -> SumRep <$> get +#if __GLASGOW_HASKELL__ >= 901 + 3 -> pure (BoxedRep Lifted) + 4 -> pure (BoxedRep Unlifted) +#else 3 -> pure LiftedRep 4 -> pure UnliftedRep +#endif 5 -> pure IntRep 6 -> pure WordRep 7 -> pure Int64Rep @@ -960,11 +980,17 @@ instance Binary TypeLitSort where put TypeLitSymbol = putWord8 0 put TypeLitNat = putWord8 1 +#ifdef HAS_TYPELITS_CHAR + put TypeLitChar = putWord8 2 +#endif get = do tag <- getWord8 case tag of 0 -> pure TypeLitSymbol 1 -> pure TypeLitNat +#ifdef HAS_TYPELITS_CHAR + 2 -> pure TypeLitChar +#endif _ -> fail "GHCi.TH.Binary.putTypeLitSort: invalid tag" putTypeRep :: TypeRep a -> Put @@ -1044,4 +1070,3 @@ put (SomeTypeRep rep) = putTypeRep rep get = getSomeTypeRep #endif - 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 @@ -231,12 +231,6 @@ import Data.Binary.Get.Internal hiding ( Decoder(..), runGetIncremental ) import qualified Data.Binary.Get.Internal as I -#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__) --- needed for (# unboxing #) with magic hash -import GHC.Base -import GHC.Word -#endif - -- needed for casting words to float/double import Data.Binary.FloatCast (wordToFloat, wordToDouble) @@ -463,7 +457,7 @@ word16be :: B.ByteString -> Word16 word16be = \s -> - (fromIntegral (s `B.unsafeIndex` 0) `shiftl_w16` 8) .|. + (fromIntegral (s `B.unsafeIndex` 0) `unsafeShiftL` 8) .|. (fromIntegral (s `B.unsafeIndex` 1)) {-# INLINE[2] getWord16be #-} {-# INLINE word16be #-} @@ -474,7 +468,7 @@ word16le :: B.ByteString -> Word16 word16le = \s -> - (fromIntegral (s `B.unsafeIndex` 1) `shiftl_w16` 8) .|. + (fromIntegral (s `B.unsafeIndex` 1) `unsafeShiftL` 8) .|. (fromIntegral (s `B.unsafeIndex` 0) ) {-# INLINE[2] getWord16le #-} {-# INLINE word16le #-} @@ -485,9 +479,9 @@ word32be :: B.ByteString -> Word32 word32be = \s -> - (fromIntegral (s `B.unsafeIndex` 0) `shiftl_w32` 24) .|. - (fromIntegral (s `B.unsafeIndex` 1) `shiftl_w32` 16) .|. - (fromIntegral (s `B.unsafeIndex` 2) `shiftl_w32` 8) .|. + (fromIntegral (s `B.unsafeIndex` 0) `unsafeShiftL` 24) .|. + (fromIntegral (s `B.unsafeIndex` 1) `unsafeShiftL` 16) .|. + (fromIntegral (s `B.unsafeIndex` 2) `unsafeShiftL` 8) .|. (fromIntegral (s `B.unsafeIndex` 3) ) {-# INLINE[2] getWord32be #-} {-# INLINE word32be #-} @@ -498,9 +492,9 @@ word32le :: B.ByteString -> Word32 word32le = \s -> - (fromIntegral (s `B.unsafeIndex` 3) `shiftl_w32` 24) .|. - (fromIntegral (s `B.unsafeIndex` 2) `shiftl_w32` 16) .|. - (fromIntegral (s `B.unsafeIndex` 1) `shiftl_w32` 8) .|. + (fromIntegral (s `B.unsafeIndex` 3) `unsafeShiftL` 24) .|. + (fromIntegral (s `B.unsafeIndex` 2) `unsafeShiftL` 16) .|. + (fromIntegral (s `B.unsafeIndex` 1) `unsafeShiftL` 8) .|. (fromIntegral (s `B.unsafeIndex` 0) ) {-# INLINE[2] getWord32le #-} {-# INLINE word32le #-} @@ -511,13 +505,13 @@ word64be :: B.ByteString -> Word64 word64be = \s -> - (fromIntegral (s `B.unsafeIndex` 0) `shiftl_w64` 56) .|. - (fromIntegral (s `B.unsafeIndex` 1) `shiftl_w64` 48) .|. - (fromIntegral (s `B.unsafeIndex` 2) `shiftl_w64` 40) .|. - (fromIntegral (s `B.unsafeIndex` 3) `shiftl_w64` 32) .|. - (fromIntegral (s `B.unsafeIndex` 4) `shiftl_w64` 24) .|. - (fromIntegral (s `B.unsafeIndex` 5) `shiftl_w64` 16) .|. - (fromIntegral (s `B.unsafeIndex` 6) `shiftl_w64` 8) .|. + (fromIntegral (s `B.unsafeIndex` 0) `unsafeShiftL` 56) .|. + (fromIntegral (s `B.unsafeIndex` 1) `unsafeShiftL` 48) .|. + (fromIntegral (s `B.unsafeIndex` 2) `unsafeShiftL` 40) .|. + (fromIntegral (s `B.unsafeIndex` 3) `unsafeShiftL` 32) .|. + (fromIntegral (s `B.unsafeIndex` 4) `unsafeShiftL` 24) .|. + (fromIntegral (s `B.unsafeIndex` 5) `unsafeShiftL` 16) .|. + (fromIntegral (s `B.unsafeIndex` 6) `unsafeShiftL` 8) .|. (fromIntegral (s `B.unsafeIndex` 7) ) {-# INLINE[2] getWord64be #-} {-# INLINE word64be #-} @@ -528,13 +522,13 @@ word64le :: B.ByteString -> Word64 word64le = \s -> - (fromIntegral (s `B.unsafeIndex` 7) `shiftl_w64` 56) .|. - (fromIntegral (s `B.unsafeIndex` 6) `shiftl_w64` 48) .|. - (fromIntegral (s `B.unsafeIndex` 5) `shiftl_w64` 40) .|. - (fromIntegral (s `B.unsafeIndex` 4) `shiftl_w64` 32) .|. - (fromIntegral (s `B.unsafeIndex` 3) `shiftl_w64` 24) .|. - (fromIntegral (s `B.unsafeIndex` 2) `shiftl_w64` 16) .|. - (fromIntegral (s `B.unsafeIndex` 1) `shiftl_w64` 8) .|. + (fromIntegral (s `B.unsafeIndex` 7) `unsafeShiftL` 56) .|. + (fromIntegral (s `B.unsafeIndex` 6) `unsafeShiftL` 48) .|. + (fromIntegral (s `B.unsafeIndex` 5) `unsafeShiftL` 40) .|. + (fromIntegral (s `B.unsafeIndex` 4) `unsafeShiftL` 32) .|. + (fromIntegral (s `B.unsafeIndex` 3) `unsafeShiftL` 24) .|. + (fromIntegral (s `B.unsafeIndex` 2) `unsafeShiftL` 16) .|. + (fromIntegral (s `B.unsafeIndex` 1) `unsafeShiftL` 8) .|. (fromIntegral (s `B.unsafeIndex` 0) ) {-# INLINE[2] getWord64le #-} {-# INLINE word64le #-} @@ -651,27 +645,3 @@ getDoublehost :: Get Double getDoublehost = wordToDouble <$> getWord64host {-# INLINE getDoublehost #-} - ------------------------------------------------------------------------- --- Unchecked shifts - -shiftl_w16 :: Word16 -> Int -> Word16 -shiftl_w32 :: Word32 -> Int -> Word32 -shiftl_w64 :: Word64 -> Int -> Word64 - -#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__) -shiftl_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftL#` i) -shiftl_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftL#` i) - -#if WORD_SIZE_IN_BITS < 64 -shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL64#` i) - -#else -shiftl_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftL#` i) -#endif - -#else -shiftl_w16 = shiftL -shiftl_w32 = shiftL -shiftl_w64 = shiftL -#endif