Support GHC-9.4, add ByteArray instance

phadej · phadej · commit 012bcb585314 · 2022-08-11T18:02:42.000+03:00
diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml
@@ -8,9 +8,9 @@
 #
 # For more information, see https://github.com/haskell-CI/haskell-ci
 #
-# version: 0.13.20211030
+# version: 0.15.20220808
 #
-# REGENDATA ("0.13.20211030",["github","cabal.project"])
+# REGENDATA ("0.15.20220808",["github","cabal.project"])
 #
 name: Haskell-CI
 on:
@@ -23,22 +23,29 @@ on:
 jobs:
   linux:
     name: Haskell-CI - Linux - ${{ matrix.compiler }}
-    runs-on: ubuntu-18.04
+    runs-on: ubuntu-20.04
+    timeout-minutes:
+      60
     container:
       image: buildpack-deps:bionic
     continue-on-error: ${{ matrix.allow-failure }}
     strategy:
       matrix:
         include:
-          - compiler: ghc-9.2.1
+          - compiler: ghc-9.4.1
             compilerKind: ghc
-            compilerVersion: 9.2.1
+            compilerVersion: 9.4.1
             setup-method: ghcup
             allow-failure: false
-          - compiler: ghc-9.0.1
+          - compiler: ghc-9.2.4
             compilerKind: ghc
-            compilerVersion: 9.0.1
-            setup-method: hvr-ppa
+            compilerVersion: 9.2.4
+            setup-method: ghcup
+            allow-failure: false
+          - compiler: ghc-9.0.2
+            compilerKind: ghc
+            compilerVersion: 9.0.2
+            setup-method: ghcup
             allow-failure: false
           - compiler: ghc-8.10.4
             compilerKind: ghc
@@ -98,18 +105,18 @@ jobs:
           apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
           if [ "${{ matrix.setup-method }}" = ghcup ]; then
             mkdir -p "$HOME/.ghcup/bin"
-            curl -sL https://downloads.haskell.org/ghcup/0.1.17.3/x86_64-linux-ghcup-0.1.17.3 > "$HOME/.ghcup/bin/ghcup"
+            curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup"
             chmod a+x "$HOME/.ghcup/bin/ghcup"
-            "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER"
-            "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
+            "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
+            "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
           else
             apt-add-repository -y 'ppa:hvr/ghc'
             apt-get update
             apt-get install -y "$HCNAME"
             mkdir -p "$HOME/.ghcup/bin"
-            curl -sL https://downloads.haskell.org/ghcup/0.1.17.3/x86_64-linux-ghcup-0.1.17.3 > "$HOME/.ghcup/bin/ghcup"
+            curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup"
             chmod a+x "$HOME/.ghcup/bin/ghcup"
-            "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
+            "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
           fi
         env:
           HCKIND: ${{ matrix.compilerKind }}
@@ -169,6 +176,10 @@ jobs:
           repository hackage.haskell.org
             url: http://hackage.haskell.org/
           EOF
+          cat >> $CABAL_CONFIG <<EOF
+          program-default-options
+            ghc-options: $GHCJOBS +RTS -M3G -RTS
+          EOF
           cat $CABAL_CONFIG
       - name: versions
         run: |
@@ -248,7 +259,7 @@ jobs:
           ${CABAL} -vnormal check
       - name: haddock
         run: |
-          $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
+          $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
       - name: unconstrained build
         run: |
           rm -f cabal.project.local
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,3 +1,7 @@
+# 1.0.3
+
+- Add `ByteArray` (from `Data.Array.Byte` instance)
+
 # 1.0.2
 
 - Add `Solo` instance
diff --git a/binary-orphans.cabal b/binary-orphans.cabal
@@ -1,7 +1,6 @@
 cabal-version:      1.12
 name:               binary-orphans
-version:            1.0.2
-x-revision:         1
+version:            1.0.3
 synopsis:           Compatibility package for binary; provides instances
 category:           Data, Binary, Parsing, Compatibility
 description:
@@ -26,8 +25,9 @@ tested-with:
    || ==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
 
@@ -38,10 +38,11 @@ source-repository head
 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
 
@@ -68,7 +69,7 @@ test-suite binary-orphans-test
     , 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
diff --git a/src/Data/Binary/Orphans.hs b/src/Data/Binary/Orphans.hs
@@ -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
 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 (..))
 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 (Identity a) where
 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
diff --git a/test/Tests.hs b/test/Tests.hs
@@ -13,6 +13,10 @@ import Test.QuickCheck.Instances ()
 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 @@ tests = testGroup "Roundtrip"
   , 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

-Original file line number
+Diff line change
@@ @@ -1,3 +1,7 @@ @@
 +# 1.0.3
++
 +- Add `ByteArray` (from `Data.Array.Byte` instance)
++
 # 1.0.2
 - Add `Solo` instance