D.P.Index.Class: Fix build failure on GHC 9.6.6

Data/PrimitiveArray/Dense.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 -- | Dense primitive arrays where the lower index is zero (or the
 -- equivalent of zero for newtypes and enumerations).
@@ -24,11 +27,11 @@ import           Control.DeepSeq
 import           Control.Exception (assert)
 import           Control.Monad (liftM, forM_, zipWithM_, when)
 import           Control.Monad.Primitive (PrimState)
-import           Data.Aeson (ToJSON,FromJSON)
-import           Data.Binary (Binary)
+import           Data.Aeson (ToJSON,FromJSON,ToJSON(..),FromJSON(..), withObject, (.:), object)
+import           Data.Binary (Binary,Binary(..))
 import           Data.Data
-import           Data.Hashable (Hashable)
-import           Data.Serialize (Serialize)
+import           Data.Hashable (Hashable,Hashable(..))
+import           Data.Serialize (Serialize,Serialize(..))
 import           Data.Typeable (Typeable)
 import           Data.Vector.Binary
 import           Data.Vector.Generic.Mutable as GM hiding (length)
@@ -43,7 +46,7 @@ import qualified Data.Vector.Unboxed as VU
 
 import           Data.PrimitiveArray.Class
 import           Data.PrimitiveArray.Index.Class
-
+import qualified Data.Serialize as Data
 
 
 data Dense v sh e = Dense { _denseLimit :: !(LimitType sh), _denseV :: !(v e) }
@@ -58,7 +61,7 @@ type Boxed sh e = Dense V.Vector sh e
 
 
 deriving instance (Eq      (LimitType sh), Eq (v e)     ) => Eq      (Dense v sh e)
-deriving instance (Generic (LimitType sh), Generic (v e)) => Generic (Dense v sh e)
+-- deriving instance (Generic (LimitType sh), Generic (v e)) => Generic (Dense v sh e)
 deriving instance (Read    (LimitType sh), Read (v e)   ) => Read    (Dense v sh e)
 deriving instance (Show    (LimitType sh), Show (v e)   ) => Show    (Dense v sh e)
 deriving instance (Functor v)                             => Functor (Dense v sh)
@@ -67,15 +70,34 @@ deriving instance Typeable (Dense v sh e)
 
 deriving instance (Data (v e), Data (LimitType sh), Data e, Data sh, Typeable sh, Typeable e, Typeable v) => Data (Dense v sh e)
 
-instance (Binary    (LimitType sh), Binary    (v e), Generic (LimitType sh), Generic (v e)) => Binary    (Dense v sh e)
-instance (Serialize (LimitType sh), Serialize (v e), Generic (LimitType sh), Generic (v e)) => Serialize (Dense v sh e)
-instance (ToJSON    (LimitType sh), ToJSON    (v e), Generic (LimitType sh), Generic (v e)) => ToJSON    (Dense v sh e)
-instance (FromJSON  (LimitType sh), FromJSON  (v e), Generic (LimitType sh), Generic (v e)) => FromJSON  (Dense v sh e)
-instance (Hashable  (LimitType sh), Hashable  (v e), Generic (LimitType sh), Generic (v e)) => Hashable  (Dense v sh e)
-
-instance (NFData (LimitType sh), NFData (v e)) ⇒ NFData (Dense v sh e) where
-  rnf (Dense h xs) = rnf h `seq` rnf xs
-  {-# Inline rnf #-}
+deriving instance (Generic (LimitType sh), Generic (v e), Generic e, VG.Vector v e) => Generic (Dense v sh e)
+-- Binary instance for Dense using GHC.Generics
+instance (Binary (LimitType sh), Binary e, VG.Vector v e, Generic (Dense v sh e)) => Binary (Dense v sh e) where
+  put (Dense limit v) = Data.Binary.put limit >> Data.Binary.put (VG.toList v)
+  get = Dense <$> Data.Binary.get <*> (VG.fromList <$> Data.Binary.get)
+
+-- Serialize instance for Dense
+instance (Serialize (LimitType sh), Serialize e, VG.Vector v e) => Serialize (Dense v sh e) where
+  put (Dense limit v) = Data.Serialize.put limit >> Data.Serialize.put (VG.toList v)
+  get = Dense <$> Data.Serialize.get <*> (VG.fromList <$> Data.Serialize.get)
+
+-- ToJSON instance for Dense
+instance (ToJSON (LimitType sh), ToJSON e, VG.Vector v e) => ToJSON (Dense v sh e) where
+  toJSON (Dense limit v) = object [("limit", toJSON limit), ("vector", toJSON (VG.toList v))]
+
+-- FromJSON instance for Dense
+instance (FromJSON (LimitType sh), FromJSON e, VG.Vector v e) => FromJSON (Dense v sh e) where
+  parseJSON = withObject "Dense" $ \o -> Dense
+    <$> o .: "limit"
+    <*> (VG.fromList <$> o .: "vector")
+
+-- Hashable instance for Dense
+instance (Hashable (LimitType sh), Hashable e, VG.Vector v e, Eq (v e)) => Hashable (Dense v sh e) where
+  hashWithSalt salt (Dense limit v) = salt `hashWithSalt` limit `hashWithSalt` VG.toList v 
+
+-- NFData instance for Dense
+instance (NFData (LimitType sh), NFData e, VG.Vector v e) => NFData (Dense v sh e) where
+  rnf (Dense limit v) = rnf limit `seq` VG.foldl' (\_ x -> rnf x) () v
 
 
 

Data/PrimitiveArray/Index/BitSet0.hs

@@ -76,6 +76,18 @@ instance Index (BitSet t) where
   showBound (LtBitSet b) = ["LtBitSet " ++ show b]
   showIndex (BitSet b) = ["BitSet " ++ show b]
 
+deriving instance Show    (LimitType (BitSet t))
+deriving instance Read    (LimitType (BitSet t))
+deriving instance Eq      (LimitType (BitSet t))
+deriving instance Generic (LimitType (BitSet t))
+instance Binary      (LimitType (BitSet t))
+instance Serialize   (LimitType (BitSet t))
+instance ToJSON      (LimitType (BitSet t))
+instance ToJSONKey   (LimitType (BitSet t))
+instance FromJSON    (LimitType (BitSet t))
+instance FromJSONKey (LimitType (BitSet t))
+instance Hashable    (LimitType (BitSet t))
+
 instance SetPredSucc (BitSet t) where
   setSucc l h s
     | cs > ch                        = Nothing

Data/PrimitiveArray/Index/BitSet1.hs

@@ -81,7 +81,10 @@ instance Index (BitSet1 bnd ioc) where
   showBound = error "implement me"
   showIndex = error "implement me"
 
-deriving instance Show (LimitType (BitSet1 bnd ioc))
+deriving instance Show    (LimitType (BitSet1 bnd ioc))
+deriving instance Read    (LimitType (BitSet1 bnd ioc))
+deriving instance Eq      (LimitType (BitSet1 bnd ioc))
+deriving instance Generic (LimitType (BitSet1 bnd ioc))
 
 instance IndexStream z ⇒ IndexStream (z:.BitSet1 i I) where
   streamUp   (ls:..LtNumBits1 l) (hs:..LtNumBits1 h) = SM.flatten (streamUpMk   l h) (streamUpStep   l h) $ streamUp   ls hs

Data/PrimitiveArray/Index/BitSetClasses.hs

@@ -76,6 +76,16 @@ instance Index (Boundary i t) where
   showBound (LtBoundary b) = ["LtBoundary " ++ show b]
   showIndex (Boundary b) = ["Boundary " ++ show b]
 
+deriving instance Eq      (LimitType (Boundary i t))
+deriving instance Generic (LimitType (Boundary i t))
+deriving instance Read    (LimitType (Boundary i t))
+deriving instance Show    (LimitType (Boundary i t))
+instance Binary    (LimitType (Boundary i t))
+instance Serialize (LimitType (Boundary i t))
+instance ToJSON    (LimitType (Boundary i t))
+instance FromJSON  (LimitType (Boundary i t))
+instance Hashable  (LimitType (Boundary i t))
+
 instance IndexStream z ⇒ IndexStream (z:.Boundary k I) where
   streamUp   (ls:..LtBoundary l) (hs:..LtBoundary h) = SM.flatten (streamUpBndMk   l h) (streamUpBndStep   l h) $ streamUp   ls hs
   streamDown (ls:..LtBoundary l) (hs:..LtBoundary h) = SM.flatten (streamDownBndMk l h) (streamDownBndStep l h) $ streamDown ls hs

Data/PrimitiveArray/Index/Class.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE InstanceSigs #-}
 
 module Data.PrimitiveArray.Index.Class where
 
@@ -16,16 +17,14 @@ import           Data.Typeable
 import           Data.Vector.Fusion.Stream.Monadic (Stream)
 import           Data.Vector.Unboxed.Deriving
 import           Data.Vector.Unboxed (Unbox(..))
-import           GHC.Base (quotRemInt)
+import           GHC.Base (quotRemInt, when)
 import           GHC.Generics
 import           GHC.TypeNats
 import qualified Data.Vector.Fusion.Stream.Monadic as SM
 import           Test.QuickCheck
 import           Text.Printf
 import           Data.Type.Equality
 
-
-
 infixl 3 :.
 
 -- | Strict pairs -- as in @repa@.
@@ -233,6 +232,15 @@ deriving instance Show     (LimitType Z)
 deriving instance Data     (LimitType Z)
 deriving instance Typeable (LimitType Z)
 deriving instance Bounded  (LimitType Z)
+instance Binary    (LimitType Z)
+instance Serialize (LimitType Z)
+instance ToJSON    (LimitType Z)
+instance FromJSON  (LimitType Z)
+instance Hashable  (LimitType Z)
+instance NFData (LimitType Z) where
+  rnf ZZ = ()
+  {-# Inline rnf #-}
+
 
 instance (Index zs, Index z) => Index (zs:.z) where
   data LimitType (zs:.z) = !(LimitType zs) :.. !(LimitType z)
@@ -266,6 +274,11 @@ deriving instance
   , Data z , Data (LimitType z) , Typeable z
   ) => Data    (LimitType (zs:.z))
 deriving instance (Bounded (LimitType zs), Bounded (LimitType z)) => Bounded (LimitType (zs:.z))
+instance (Generic (LimitType zs), Generic (LimitType z), Binary (LimitType zs), Binary (LimitType z)) => Binary (LimitType (zs:.z))
+instance (Generic (LimitType zs), Generic (LimitType z), Serialize (LimitType zs), Serialize (LimitType z)) => Serialize (LimitType (zs:.z))
+instance (Generic (LimitType zs), Generic (LimitType z), ToJSON (LimitType zs), ToJSON (LimitType z)) => ToJSON (LimitType (zs:.z))
+instance (Generic (LimitType zs), Generic (LimitType z), FromJSON (LimitType zs), FromJSON (LimitType z)) => FromJSON (LimitType (zs:.z))
+instance (Generic (LimitType zs), Generic (LimitType z), Hashable (LimitType zs), Hashable (LimitType z)) => Hashable (LimitType (zs:.z))
 
 --instance (Index zs, Index z) => Index (zs:>z) where
 --  type LimitType (zs:>z) = LimitType zs:>LimitType z
@@ -342,3 +355,8 @@ instance (SparseBucket i, SparseBucket is) => SparseBucket (is:.i) where
   {-# Inline manhattanMax #-}
   manhattanMax (zz:..z) = manhattanMax zz + manhattanMax z
 
+
+-- Catch-all serialization and deep evaluation instances for LimitType.
+instance (NFData z, Generic (LimitType z)) => NFData (LimitType z) where
+  rnf = rnf
+  {-# Inline rnf #-}

Data/PrimitiveArray/Index/Int.hs

@@ -4,6 +4,13 @@ module Data.PrimitiveArray.Index.Int where
 import qualified Data.Vector.Fusion.Stream.Monadic as SM
 
 import           Data.PrimitiveArray.Index.Class
+import           Data.Aeson
+import           Data.Binary
+import           Data.Data
+import           Data.Hashable (Hashable)
+import           Data.Proxy
+import           Data.Serialize
+import           GHC.Generics
 
 
 
@@ -27,6 +34,13 @@ instance Index Int where
   showIndex i = ["Int " ++ show i]
 
 deriving instance Show (LimitType Int)
+deriving instance Generic (LimitType Int)
+deriving instance Eq (LimitType Int)
+instance Binary    (LimitType Int)
+instance Serialize (LimitType Int)
+instance ToJSON    (LimitType Int)
+instance FromJSON  (LimitType Int)
+instance Hashable  (LimitType Int)
 
 instance IndexStream z => IndexStream (z:.Int) where
   streamUp (ls:.. LtInt l) (hs:.. LtInt h) = SM.flatten mk step $ streamUp ls hs

Data/PrimitiveArray/Index/PhantomInt.hs

@@ -72,6 +72,11 @@ deriving instance Show    (LimitType (PInt t p))
 deriving instance Read    (LimitType (PInt t p))
 deriving instance Eq      (LimitType (PInt t p))
 deriving instance Generic (LimitType (PInt t p))
+instance Binary    (LimitType (PInt t p))
+instance Serialize (LimitType (PInt t p))
+instance ToJSON    (LimitType (PInt t p))
+instance FromJSON  (LimitType (PInt t p))
+instance Hashable  (LimitType (PInt t p))
 
 instance IndexStream z => IndexStream (z:.PInt I p) where
   streamUp   (ls:..LtPInt l) (hs:..LtPInt h) = flatten (streamUpMk   l h) (streamUpStep   l h) $ streamUp ls hs

Data/PrimitiveArray/Index/Point.hs

@@ -90,6 +90,12 @@ deriving instance Eq      (LimitType (PointL t))
 deriving instance Generic (LimitType (PointL t))
 deriving instance Read    (LimitType (PointL t))
 deriving instance Show    (LimitType (PointL t))
+instance Binary    (LimitType (PointL t))
+instance Serialize (LimitType (PointL t))
+instance ToJSON    (LimitType (PointL t))
+instance FromJSON  (LimitType (PointL t))
+instance Hashable  (LimitType (PointL t))
+
 
 instance IndexStream z => IndexStream (z:.PointL I) where
   streamUp   (ls:..LtPointL lf) (hs:..LtPointL ht) = SM.flatten (streamUpMk   lf) (streamUpStep   PointL ht) $ streamUp ls hs

Data/PrimitiveArray/Index/Subword.hs

@@ -103,6 +103,11 @@ deriving instance Eq      (LimitType (Subword t))
 deriving instance Generic (LimitType (Subword t))
 deriving instance Read    (LimitType (Subword t))
 deriving instance Show    (LimitType (Subword t))
+instance Binary    (LimitType (Subword t))
+instance Serialize (LimitType (Subword t))
+instance ToJSON    (LimitType (Subword t))
+instance FromJSON  (LimitType (Subword t))
+instance Hashable  (LimitType (Subword t))
 
 -- | @Subword I@ (inside)