Compatibility with GHC 9.6

9 files changed, 45 insertions, 3 deletions

diff --git a/ox-arrays.cabal b/ox-arrays.cabal
index 65af5f5..bdbb34e 100644
--- a/ox-arrays.cabal
+++ b/ox-arrays.cabal
@@ -81,6 +81,10 @@ library
     Data.Array.XArray
     Data.Bag
 
+  if impl(ghc < 9.8)
+    exposed-modules:
+      GHC.TypeLits.Orphans
+
   if flag(trace-wrappers)
     exposed-modules:
       Data.Array.Nested.Trace
diff --git a/release-hints.txt b/release-hints.txt
index d300da0..2623caa 100644
--- a/release-hints.txt
+++ b/release-hints.txt
@@ -1,3 +1,5 @@
 - Temporarily enable -Wredundant-constraints
   - Has too many false-positives to enable normally, but sometimes catches actual redundant constraints
 - Don't forget to rerun gentrace.sh
+- Test with GHC 9.6, it's rather picky around type-level nats
+  - Whenever we drop support for GHC 9.6, search for "9,8" and remove all the conditionals, as well as the GHC.TypeLits.Orphans module
diff --git a/src/Data/Array/Nested/Convert.hs b/src/Data/Array/Nested/Convert.hs
index 07777d5..a260dc0 100644
--- a/src/Data/Array/Nested/Convert.hs
+++ b/src/Data/Array/Nested/Convert.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
@@ -5,7 +6,9 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+#if MIN_VERSION_GLASGOW_HASKELL(9,8,0,0)
 {-# LANGUAGE TypeAbstractions #-}
+#endif
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}
diff --git a/src/Data/Array/Nested/Mixed/Shape.hs b/src/Data/Array/Nested/Mixed/Shape.hs
index ffa3613..8777739 100644
--- a/src/Data/Array/Nested/Mixed/Shape.hs
+++ b/src/Data/Array/Nested/Mixed/Shape.hs
@@ -37,6 +37,9 @@ import GHC.Generics (Generic)
 import GHC.IsList (IsList)
 import GHC.IsList qualified as IsList
 import GHC.TypeLits
+#if !MIN_VERSION_GLASGOW_HASKELL(9,8,0,0)
+import GHC.TypeLits.Orphans ()
+#endif
 
 import Data.Array.Nested.Types
 
diff --git a/src/Data/Array/Nested/Permutation.hs b/src/Data/Array/Nested/Permutation.hs
index 1eb7be1..1a0fd22 100644
--- a/src/Data/Array/Nested/Permutation.hs
+++ b/src/Data/Array/Nested/Permutation.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
@@ -209,7 +210,7 @@ ssxPermute :: Perm is -> StaticShX sh -> StaticShX (Permute is sh)
 ssxPermute = coerce (listxPermute @(SMayNat () SNat))
 
 ssxIndex :: Proxy is -> Proxy shT -> SNat i -> StaticShX sh -> SMayNat () SNat (Index i sh)
-ssxIndex p1 p2 = coerce (listxIndex @(SMayNat () SNat) p1 p2)
+ssxIndex p1 p2 i = coerce (listxIndex @(SMayNat () SNat) p1 p2 i)
 
 ssxPermutePrefix :: Perm is -> StaticShX sh -> StaticShX (PermutePrefix is sh)
 ssxPermutePrefix = coerce (listxPermutePrefix @(SMayNat () SNat))
@@ -274,7 +275,13 @@ lemRankPermute p (_ `PCons` is) | Refl <- lemRankPermute p is = Refl
 lemRankDropLen :: forall is sh. (Rank is <= Rank sh)
                => StaticShX sh -> Perm is -> Rank (DropLen is sh) :~: Rank sh - Rank is
 lemRankDropLen ZKX PNil = Refl
-lemRankDropLen (_ :!% sh) (_ `PCons` is) | Refl <- lemRankDropLen sh is = Refl
+lemRankDropLen (_ :!% sh) (_ `PCons` is)
+  | Refl <- lemRankDropLen sh is
+#if MIN_VERSION_GLASGOW_HASKELL(9,8,0,0)
+  = Refl
+#else
+  = unsafeCoerceRefl
+#endif
 lemRankDropLen (_ :!% _) PNil = Refl
 
 lemIndexSucc :: Proxy i -> Proxy a -> Proxy l
diff --git a/src/Data/Array/XArray.hs b/src/Data/Array/XArray.hs
index bf47622..92d9e13 100644
--- a/src/Data/Array/XArray.hs
+++ b/src/Data/Array/XArray.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -30,6 +31,9 @@ import Data.Vector.Storable qualified as VS
 import Foreign.Storable (Storable)
 import GHC.Generics (Generic)
 import GHC.TypeLits
+#if !MIN_VERSION_GLASGOW_HASKELL(9,8,0,0)
+import Unsafe.Coerce (unsafeCoerce)
+#endif
 
 import Data.Array.Nested.Lemmas
 import Data.Array.Nested.Mixed.Shape
@@ -217,7 +221,11 @@ transpose ssh perm (XArray arr)
   , Refl <- lemRankApp (ssxPermute perm (ssxTakeLen perm ssh)) (ssxDropLen perm ssh)
   , Refl <- lemRankPermute (Proxy @(TakeLen is sh)) perm
   , Refl <- lemRankDropLen ssh perm
+#if MIN_VERSION_GLASGOW_HASKELL(9,8,0,0)
   = XArray (S.transpose (permToList' perm) arr)
+#else
+  = XArray (unsafeCoerce (S.transpose (permToList' perm) arr))
+#endif
 
 -- | The list argument gives indices into the original dimension list.
 --
diff --git a/src/GHC/TypeLits/Orphans.hs b/src/GHC/TypeLits/Orphans.hs
new file mode 100644
index 0000000..42f7293
--- /dev/null
+++ b/src/GHC/TypeLits/Orphans.hs
@@ -0,0 +1,13 @@
+-- | Compatibility module adding some additional instances not yet defined in
+-- base-4.18 with GHC 9.6.
+{-# OPTIONS -Wno-orphans #-}
+module GHC.TypeLits.Orphans where
+
+import GHC.TypeLits
+
+
+instance Eq (SNat n) where
+  _ == _ = True
+
+instance Ord (SNat n) where
+  compare _ _ = EQ
diff --git a/test/Gen.hs b/test/Gen.hs
index 044de14..e665af6 100644
--- a/test/Gen.hs
+++ b/test/Gen.hs
@@ -4,7 +4,6 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeAbstractions #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}
diff --git a/test/Tests/C.hs b/test/Tests/C.hs
index 9567393..11c2ef1 100644
--- a/test/Tests/C.hs
+++ b/test/Tests/C.hs
@@ -1,9 +1,12 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+#if MIN_VERSION_GLASGOW_HASKELL(9,8,0,0)
 {-# LANGUAGE TypeAbstractions #-}
+#endif
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 -- {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}