Support GHC 9.8 and GHC 9.10

.ci/apply_settings.sh

@@ -0,0 +1,8 @@
+#!/bin/bash
+
+if [[ "$check_haddock" != @(True|False) ]]; then
+  echo "check_haddock: Expected True or False, got \"$check_haddock\"" >&2
+  exit 1
+fi
+sed <.ci/cabal.project.local.in >cabal.project.local "
+    s/__CHECK_HADDOCK__/$check_haddock/"

.ci/build_docs.sh

@@ -1,21 +1,8 @@
 #!/bin/bash
 set -xeou pipefail
 
-# Build dependencies first, so they don't end up in logs
-cabal v2-build \
-  --constraint=clash-prelude==$clash_version \
-  --enable-documentation \
-  --allow-newer=circuit-notation:ghc \
-  clash-protocols
-
-# circuit-notation currently _compiles on 8.10, but isn't usable. The only
-# other GHC version it supports is 8.6.5, but this GHC bundles a Haddock that
-# cannot generate documentation for clash-prelude. Hence, we build docs with
-# 8.10 and relax circuit-notation's ghc bounds
 cabal v2-haddock \
   --constraint=clash-prelude==$clash_version \
-  --enable-documentation \
-  --allow-newer=circuit-notation:ghc \
   clash-protocols \
   |& tee haddock_log
 

.ci/cabal.project.local.in

@@ -0,0 +1,6 @@
+package *
+  documentation: __CHECK_HADDOCK__
+
+package clash-protocols
+  documentation: False
+  ghc-options: -Werror

.ci/test_cabal.sh

@@ -1,7 +1,6 @@
 #!/bin/bash
 set -xeou pipefail
 
-cabal v2-build all --constraint=clash-prelude==$clash_version  -fci
 cabal v2-run unittests --constraint=clash-prelude==$clash_version -fci --enable-tests
 cabal v2-run doctests --constraint=clash-prelude==$clash_version -fci --enable-tests
 cabal v2-sdist clash-protocols

.github/workflows/ci.yml

@@ -47,23 +47,32 @@ jobs:
           .ci/test_stack.sh
 
   cabal:
-    name: Cabal tests - ghc ${{ matrix.ghc }} / clash ${{ matrix.clash }}
+    name: Cabal tests - ghc ${{ matrix.ghc }} / clash ${{ matrix.clash }} / doc ${{ matrix.check_haddock }}
     runs-on: ${{ matrix.os }}
     strategy:
       fail-fast: false
       matrix:
         os: [ubuntu-latest]
         clash:
-          - "1.8.1"
+          - "1.8.2"
         cabal:
           - "3.10"
         ghc:
           - "9.0.2"
           - "9.2.8"
           - "9.4.8"
-          - "9.6.4"
+          - "9.8.4"
+          - "9.10.1"
+        include:
+          - check_haddock: "False"
+          - ghc: "9.6.4"
+            check_haddock: "True"
+            os: "ubuntu-latest"
+            clash: "1.8.2"
+            cabal: "3.10"
 
     env:
+      check_haddock: ${{ matrix.check_haddock }}
       clash_version: ${{ matrix.clash }}
 
     steps:
@@ -79,7 +88,7 @@ jobs:
 
       - name: Use CI specific settings
         run: |
-          cp .ci/cabal.project.local .
+          .ci/apply_settings.sh
 
       - name: Setup CI
         run: |
@@ -105,6 +114,7 @@ jobs:
           .ci/test_cabal.sh
 
       - name: Documentation
+        if: ${{ matrix.check_haddock == 'True' }}
         run: |
           .ci/build_docs.sh
 

cabal.project

@@ -14,7 +14,7 @@ package clash-prelude
 source-repository-package
   type: git
   location: https://github.com/cchalmers/circuit-notation.git
-  tag: 19b386c4aa3ff690758ae089c7754303f3500cc9
+  tag: 564769c52aa05b90f81bbc898b7af7087d96613d
 
 package clash-protocols-base
   -- Reduces compile times by ~20%

clash-protocols-base/clash-protocols-base.cabal

@@ -104,7 +104,7 @@ library
     , circuit-notation
     , deepseq
     , extra
-    , ghc >= 8.7 && < 9.7
+    , ghc >= 8.7 && < 9.11
     , hashable
     , tagged
     , template-haskell

clash-protocols/clash-protocols.cabal

@@ -120,7 +120,6 @@ library
     , data-default ^>= 0.7.1.1
     , deepseq
     , extra
-    , ghc >= 8.7 && < 9.7
     , hashable
     , hedgehog >= 1.0.2
     , lifted-async

clash-protocols/src/Protocols/Avalon/Stream.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -140,7 +141,8 @@ Manager can only send 'AvalonStreamM2S' when '_ready' was true
 @readyLatency@ clock cycles ago.
 -}
 newtype AvalonStreamS2M (readyLatency :: Nat) = AvalonStreamS2M {_ready :: Bool}
-  deriving (Generic, C.NFDataX, C.ShowX, Eq, NFData, Show, Bundle)
+  deriving stock (Generic, Show, Eq)
+  deriving anyclass (C.NFDataX, C.ShowX, NFData, Bundle)
 
 -- | Type for Avalon Stream protocol.
 data AvalonStream (dom :: Domain) (conf :: AvalonStreamConfig) (dataType :: Type)

clash-protocols/src/Protocols/Axi4/ReadAddress.hs

@@ -189,7 +189,8 @@ data
 -- | See Table A2-5 "Read address channel signals"
 newtype S2M_ReadAddress = S2M_ReadAddress
   {_arready :: Bool}
-  deriving (Show, Generic, C.NFDataX)
+  deriving stock (Show, Generic)
+  deriving anyclass (C.NFDataX)
 
 {- | Shorthand for a "well-behaved" read address config,
 so that we don't need to write out a bunch of type constraints later.

clash-protocols/src/Protocols/Axi4/ReadData.hs

@@ -111,7 +111,8 @@ data
 
 -- | See Table A2-6 "Read data channel signals"
 newtype M2S_ReadData = M2S_ReadData {_rready :: Bool}
-  deriving (Show, Generic, C.NFDataX)
+  deriving stock (Show, Generic)
+  deriving anyclass (C.NFDataX)
 
 {- | Shorthand for a "well-behaved" read data config,
 so that we don't need to write out a bunch of type constraints later.

clash-protocols/src/Protocols/Axi4/Stream.hs

@@ -103,7 +103,8 @@ Manager may not decide whether or not to send 'Nothing' based on
 the '_tready' signal.
 -}
 newtype Axi4StreamS2M = Axi4StreamS2M {_tready :: Bool}
-  deriving (Generic, C.NFDataX, C.ShowX, Eq, NFData, Show, Bundle)
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (C.NFDataX, C.ShowX, NFData, Bundle)
 
 -- | Type for AXI4 Stream protocol.
 data Axi4Stream (dom :: Domain) (conf :: Axi4StreamConfig) (userType :: Type)

clash-protocols/src/Protocols/Axi4/WriteAddress.hs

@@ -186,7 +186,8 @@ data
 
 -- | See Table A2-2 "Write address channel signals"
 newtype S2M_WriteAddress = S2M_WriteAddress {_awready :: Bool}
-  deriving (Show, Generic, C.NFDataX)
+  deriving stock (Show, Generic)
+  deriving anyclass (C.NFDataX)
 
 {- | Shorthand for a "well-behaved" write address config,
 so that we don't need to write out a bunch of type constraints later.

clash-protocols/src/Protocols/Axi4/WriteData.hs

@@ -105,7 +105,8 @@ data
 
 -- | See Table A2-3 "Write data channel signals"
 newtype S2M_WriteData = S2M_WriteData {_wready :: Bool}
-  deriving (Show, Generic, C.NFDataX)
+  deriving stock (Show, Generic)
+  deriving anyclass (C.NFDataX)
 
 {- | Shorthand for a "well-behaved" write data config,
 so that we don't need to write out a bunch of type constraints later.

clash-protocols/src/Protocols/Axi4/WriteResponse.hs

@@ -90,7 +90,8 @@ data
 
 -- | See Table A2-4 "Write response channel signals"
 newtype M2S_WriteResponse = M2S_WriteResponse {_bready :: Bool}
-  deriving (Show, Generic, C.NFDataX)
+  deriving stock (Show, Generic)
+  deriving anyclass (C.NFDataX)
 
 {- | Shorthand for a "well-behaved" write response config,
 so that we don't need to write out a bunch of type constraints later.

clash-protocols/src/Protocols/Df.hs

@@ -114,9 +114,13 @@ import Prelude hiding (
 import qualified Data.Bifunctor as B
 import Data.Bool (bool)
 import qualified Data.Coerce as Coerce
+#if MIN_VERSION_base(4,19,0)
+import qualified Data.Functor as Functor (unzip)
+#else
+import qualified Data.List.NonEmpty as Functor (unzip)
+#endif
 import Data.Kind (Type)
 import Data.List ((\\))
-import qualified Data.List.NonEmpty
 import qualified Data.Maybe as Maybe
 import Data.Proxy
 import qualified Prelude as P
@@ -862,7 +866,7 @@ roundrobinCollect Parallel =
     nacks = C.repeat (Ack False)
     acks = Maybe.fromMaybe nacks ((\i -> C.replace i ack nacks) <$> iM)
     dat1 = Maybe.fromMaybe NoData dat0
-    (iM, dat0) = Data.List.NonEmpty.unzip dats1
+    (iM, dat0) = Functor.unzip dats1
     dats1 = C.fold @(n C.- 1) (<|>) (C.zipWith goDat C.indicesI dats0)
 
     goDat i dat

clash-protocols/src/Protocols/Internal.hs

@@ -6,9 +6,7 @@
 {-# LANGUAGE TypeFamilyDependencies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fconstraint-solver-iterations=20 #-}
-#if !MIN_VERSION_clash_prelude(1, 8, 2)
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-#endif
 
 -- TODO: Hide internal documentation
 -- {-# OPTIONS_HADDOCK hide #-}
@@ -59,7 +57,7 @@
 
 -- | Protocol-agnostic acknowledgement
 newtype Ack = Ack Bool
   deriving (Generic, C.NFDataX, Show, C.Bundle, Eq, Ord)
 
 -- | Acknowledge. Used in circuit-notation plugin to drive ignore components.
 instance Default Ack where

clash-protocols/src/Protocols/PacketStream/Hedgehog.hs

@@ -216,7 +216,12 @@ depacketizerModel toMetaOut ps = L.concat dataWidthPackets
       _ -> fwdF
 
     hdr = bitCoerce $ Vec.unsafeFromList @headerBytes $ _data <$> hdrF
-    metaOut = toMetaOut hdr (_meta $ L.head hdrF)
+    metaIn = case hdrF of
+      [] ->
+        -- There are @headerBytes@ packets in this list, and (1 <= headerBytes)
+        error "depacketizerModel: absurd"
+      (hdrF0 : _) -> _meta hdrF0
+    metaOut = toMetaOut hdr metaIn
 
   bytePackets :: [[PacketStreamM2S 1 metaIn]]
   bytePackets =
@@ -257,10 +262,14 @@ depacketizeToDfModel ::
 depacketizeToDfModel toOut ps = L.map parseHdr bytePackets
  where
   parseHdr :: [PacketStreamM2S 1 metaIn] -> a
-  parseHdr hdrF =
+  parseHdr [] =
+    -- There are at least @headerBytes@ packets in this list, and
+    -- (1 <= headerBytes)
+    error "depacketizeToDfModel: absurd"
+  parseHdr hdrF@(hdrF0 : _) =
     toOut
       (bitCoerce $ Vec.unsafeFromList $ L.map _data hdrF)
-      (_meta $ L.head hdrF)
+      (_meta hdrF0)
 
   bytePackets :: [[PacketStreamM2S 1 metaIn]]
   bytePackets =
@@ -313,9 +322,13 @@ packetizerModel ::
 packetizerModel toMetaOut toHeader ps = L.concatMap (upConvert . prependHdr) bytePackets
  where
   prependHdr :: [PacketStreamM2S 1 metaIn] -> [PacketStreamM2S 1 metaOut]
-  prependHdr fragments = hdr L.++ L.map (\f -> f{_meta = metaOut}) fragments
+  prependHdr [] =
+    -- 'chunkBy' filters empty lists, so all elements of bytePackets are
+    -- guaranteed to be non-null
+    error "packetizerModel: Unreachable code"
+  prependHdr fragments@(h : _) =
+    hdr L.++ L.map (\f -> f{_meta = metaOut}) fragments
    where
-    h = L.head fragments
     metaOut = toMetaOut (_meta h)
     hdr = L.map go (toList $ bitCoerce (toHeader (_meta h)))
     go byte = PacketStreamM2S (singleton byte) Nothing metaOut (_abort h)

clash-protocols/src/Protocols/Wishbone.hs

@@ -171,7 +171,8 @@ instance (C.ShowX dat) => Show (WishboneS2M dat) where
   increase throughput by reducing handshake-overhead
 -}
 newtype CycleTypeIdentifier = CycleTypeIdentifier (C.BitVector 3)
-  deriving (NFData, C.Generic, C.NFDataX, Show, C.ShowX, Eq, C.BitPack)
+  deriving stock (Eq, Show, C.Generic)
+  deriving anyclass (NFData, C.NFDataX, C.ShowX, C.BitPack)
 
 pattern
   Classic

clash-protocols/tests/Tests/Protocols/PacketStream/Padding.hs

@@ -33,7 +33,12 @@ stripPaddingModel packets = L.concatMap go (chunkByPacket packets)
   go packet
     | packetBytes == expectedSize = packet
     | packetBytes > expectedSize =
-        x L.++ [(L.head padding){_last = Just 0, _abort = any _abort padding}]
+        case padding of
+          [] ->
+            -- There are (packetBytes - expectedSize) bytes, so more than 0
+            error "stripPaddingModel: absurd"
+          (padding0 : _) ->
+            x L.++ [padding0{_last = Just 0, _abort = any _abort padding}]
     | otherwise = a L.++ [b{_abort = True}]
    where
     (a, b) = case L.unsnoc packet of

clash-protocols/tests/Tests/Protocols/PacketStream/Routing.hs

@@ -62,10 +62,13 @@ makePropPacketArbiter SNat SNat mode =
     pure $ L.map (\pkt -> pkt{_meta = j}) pkts
 
   partitionPackets packets =
-    L.sortOn (_meta . L.head . L.head)
+    L.sortOn getMeta
       $ L.groupBy (\a b -> _meta a == _meta b)
       <$> chunkByPacket packets
 
+  getMeta ((pkt : _) : _) = _meta pkt
+  getMeta _ = error "makePropPacketArbiter: empty partition"
+
 {- |
 Generic test function for the packet dispatcher, testing for all data widths,
 dispatch functions, and some meta types.

stack.yaml

@@ -6,6 +6,6 @@ packages:
 
 extra-deps:
 - git: https://github.com/cchalmers/circuit-notation.git
-  commit: 19b386c4aa3ff690758ae089c7754303f3500cc9
+  commit: 564769c52aa05b90f81bbc898b7af7087d96613d
 - clash-prelude-1.8.1
 - clash-prelude-hedgehog-1.8.1