default-show-instances flag

6 files changed, 90 insertions, 11 deletions

diff --git a/src/Data/Array/Nested/Mixed.hs b/src/Data/Array/Nested/Mixed.hs
index efbcf19..679e73b 100644
--- a/src/Data/Array/Nested/Mixed.hs
+++ b/src/Data/Array/Nested/Mixed.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DeriveGeneric #-}
@@ -139,27 +140,39 @@ data family Mixed sh a
 -- sizes of the elements of an empty array, which is information that should
 -- ostensibly not exist; the full array is still empty.
 
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+#define ANDSHOW , Show
+#else
+#define ANDSHOW
+#endif
+
 data instance Mixed sh (Primitive a) = M_Primitive !(IShX sh) !(XArray sh a)
-  deriving (Eq, Ord, Generic)
+  deriving (Eq, Ord, Generic ANDSHOW)
 
 -- [PRIMITIVE ELEMENT TYPES LIST]
-newtype instance Mixed sh Bool = M_Bool (Mixed sh (Primitive Bool)) deriving (Eq, Ord, Generic)
-newtype instance Mixed sh Int = M_Int (Mixed sh (Primitive Int)) deriving (Eq, Ord, Generic)
-newtype instance Mixed sh Int64 = M_Int64 (Mixed sh (Primitive Int64)) deriving (Eq, Ord, Generic)
-newtype instance Mixed sh Int32 = M_Int32 (Mixed sh (Primitive Int32)) deriving (Eq, Ord, Generic)
-newtype instance Mixed sh CInt = M_CInt (Mixed sh (Primitive CInt)) deriving (Eq, Ord, Generic)
-newtype instance Mixed sh Float = M_Float (Mixed sh (Primitive Float)) deriving (Eq, Ord, Generic)
-newtype instance Mixed sh Double = M_Double (Mixed sh (Primitive Double)) deriving (Eq, Ord, Generic)
-newtype instance Mixed sh () = M_Nil (Mixed sh (Primitive ())) deriving (Eq, Ord, Generic)  -- no content, orthotope optimises this (via Vector)
+newtype instance Mixed sh Bool = M_Bool (Mixed sh (Primitive Bool)) deriving (Eq, Ord, Generic ANDSHOW)
+newtype instance Mixed sh Int = M_Int (Mixed sh (Primitive Int)) deriving (Eq, Ord, Generic ANDSHOW)
+newtype instance Mixed sh Int64 = M_Int64 (Mixed sh (Primitive Int64)) deriving (Eq, Ord, Generic ANDSHOW)
+newtype instance Mixed sh Int32 = M_Int32 (Mixed sh (Primitive Int32)) deriving (Eq, Ord, Generic ANDSHOW)
+newtype instance Mixed sh CInt = M_CInt (Mixed sh (Primitive CInt)) deriving (Eq, Ord, Generic ANDSHOW)
+newtype instance Mixed sh Float = M_Float (Mixed sh (Primitive Float)) deriving (Eq, Ord, Generic ANDSHOW)
+newtype instance Mixed sh Double = M_Double (Mixed sh (Primitive Double)) deriving (Eq, Ord, Generic ANDSHOW)
+newtype instance Mixed sh () = M_Nil (Mixed sh (Primitive ())) deriving (Eq, Ord, Generic ANDSHOW)  -- no content, orthotope optimises this (via Vector)
 -- etc.
 
 data instance Mixed sh (a, b) = M_Tup2 !(Mixed sh a) !(Mixed sh b) deriving (Generic)
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+deriving instance (Show (Mixed sh a), Show (Mixed sh b)) => Show (Mixed sh (a, b))
+#endif
 -- etc., larger tuples (perhaps use generics to allow arbitrary product types)
 
 deriving instance (Eq (Mixed sh a), Eq (Mixed sh b)) => Eq (Mixed sh (a, b))
 deriving instance (Ord (Mixed sh a), Ord (Mixed sh b)) => Ord (Mixed sh (a, b))
 
 data instance Mixed sh1 (Mixed sh2 a) = M_Nest !(IShX sh1) !(Mixed (sh1 ++ sh2) a) deriving (Generic)
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+deriving instance (Show (Mixed (sh1 ++ sh2) a)) => Show (Mixed sh1 (Mixed sh2 a))
+#endif
 
 deriving instance Eq (Mixed (sh1 ++ sh2) a) => Eq (Mixed sh1 (Mixed sh2 a))
 deriving instance Ord (Mixed (sh1 ++ sh2) a) => Ord (Mixed sh1 (Mixed sh2 a))
@@ -203,10 +216,12 @@ showsMixedArray fromlistPrefix replicatePrefix d arr =
       _ ->
        showString fromlistPrefix . showString " " . shows (mtoListLinear arr)
 
+#ifndef OXAR_DEFAULT_SHOW_INSTANCES
 instance (Show a, Elt a) => Show (Mixed sh a) where
   showsPrec d arr =
     let sh = show (shxToList (mshape arr))
     in showsMixedArray ("mfromListLinear " ++ sh) ("mreplicate " ++ sh) d arr
+#endif
 
 instance Elt a => NFData (Mixed sh a) where
   rnf = mrnf
diff --git a/src/Data/Array/Nested/Mixed/Shape.hs b/src/Data/Array/Nested/Mixed/Shape.hs
index 5f4775c..d934873 100644
--- a/src/Data/Array/Nested/Mixed/Shape.hs
+++ b/src/Data/Array/Nested/Mixed/Shape.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -59,8 +60,12 @@ deriving instance (forall n. Eq (f n)) => Eq (ListX sh f)
 deriving instance (forall n. Ord (f n)) => Ord (ListX sh f)
 infixr 3 ::%
 
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+deriving instance (forall n. Show (f n)) => Show (ListX sh f)
+#else
 instance (forall n. Show (f n)) => Show (ListX sh f) where
   showsPrec _ = listxShow shows
+#endif
 
 instance (forall n. NFData (f n)) => NFData (ListX sh f) where
   rnf ZX = ()
@@ -188,8 +193,12 @@ infixr 3 :.%
 
 type IIxX sh = IxX sh Int
 
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+deriving instance Show i => Show (IxX sh i)
+#else
 instance Show i => Show (IxX sh i) where
-  showsPrec _ (IxX l) = listxShow (\(Const i) -> shows i) l
+  showsPrec _ (IxX l) = listxShow (shows . getConst) l
+#endif
 
 instance Functor (IxX sh) where
   fmap f (IxX l) = IxX (listxFmap (Const . f . getConst) l)
@@ -326,8 +335,12 @@ infixr 3 :$%
 
 type IShX sh = ShX sh Int
 
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+deriving instance Show i => Show (ShX sh i)
+#else
 instance Show i => Show (ShX sh i) where
   showsPrec _ (ShX l) = listxShow (fromSMayNat shows (shows . fromSNat)) l
+#endif
 
 instance Functor (ShX sh) where
   fmap f (ShX l) = ShX (listxFmap (fromSMayNat (SUnknown . f) SKnown) l)
@@ -483,8 +496,12 @@ infixr 3 :!%
 
 {-# COMPLETE ZKX, (:!%) #-}
 
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+deriving instance Show (StaticShX sh)
+#else
 instance Show (StaticShX sh) where
   showsPrec _ (StaticShX l) = listxShow (fromSMayNat shows (shows . fromSNat)) l
+#endif
 
 instance NFData (StaticShX sh) where
   rnf (StaticShX ZX) = ()
diff --git a/src/Data/Array/Nested/Ranked/Base.hs b/src/Data/Array/Nested/Ranked/Base.hs
index f827187..ce7025d 100644
--- a/src/Data/Array/Nested/Ranked/Base.hs
+++ b/src/Data/Array/Nested/Ranked/Base.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -21,7 +22,6 @@ import Control.DeepSeq (NFData(..))
 import Control.Monad.ST
 import Data.Bifunctor (first)
 import Data.Coerce (coerce)
-import Data.Foldable (toList)
 import Data.Kind (Type)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Proxy
@@ -30,6 +30,10 @@ import GHC.Float qualified (expm1, log1mexp, log1p, log1pexp)
 import GHC.Generics (Generic)
 import GHC.TypeLits
 
+#ifndef OXAR_DEFAULT_SHOW_INSTANCES
+import Data.Foldable (toList)
+#endif
+
 import Data.Array.Mixed.Lemmas
 import Data.Array.Mixed.Types
 import Data.Array.XArray (XArray(..))
@@ -50,13 +54,18 @@ import Data.Array.Strided.Arith
 -- 'Ranked' is a newtype around a 'Mixed' of 'Nothing's.
 type Ranked :: Nat -> Type -> Type
 newtype Ranked n a = Ranked (Mixed (Replicate n Nothing) a)
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+deriving instance Show (Mixed (Replicate n Nothing) a) => Show (Ranked n a)
+#endif
 deriving instance Eq (Mixed (Replicate n Nothing) a) => Eq (Ranked n a)
 deriving instance Ord (Mixed (Replicate n Nothing) a) => Ord (Ranked n a)
 
+#ifndef OXAR_DEFAULT_SHOW_INSTANCES
 instance (Show a, Elt a) => Show (Ranked n a) where
   showsPrec d arr@(Ranked marr) =
     let sh = show (toList (rshape arr))
     in showsMixedArray ("rfromListLinear " ++ sh) ("rreplicate " ++ sh) d marr
+#endif
 
 instance Elt a => NFData (Ranked n a) where
   rnf (Ranked arr) = rnf arr
@@ -64,6 +73,9 @@ instance Elt a => NFData (Ranked n a) where
 -- just unwrap the newtype and defer to the general instance for nested arrays
 newtype instance Mixed sh (Ranked n a) = M_Ranked (Mixed sh (Mixed (Replicate n Nothing) a))
   deriving (Generic)
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+deriving instance Show (Mixed sh (Mixed (Replicate n Nothing) a)) => Show (Mixed sh (Ranked n a))
+#endif
 
 deriving instance Eq (Mixed sh (Mixed (Replicate n Nothing) a)) => Eq (Mixed sh (Ranked n a))
 
diff --git a/src/Data/Array/Nested/Ranked/Shape.hs b/src/Data/Array/Nested/Ranked/Shape.hs
index 1c0b9eb..c18f9ee 100644
--- a/src/Data/Array/Nested/Ranked/Shape.hs
+++ b/src/Data/Array/Nested/Ranked/Shape.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveFunctor #-}
@@ -54,8 +55,12 @@ deriving instance Functor (ListR n)
 deriving instance Foldable (ListR n)
 infixr 3 :::
 
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+deriving instance Show i => Show (ListR n i)
+#else
 instance Show i => Show (ListR n i) where
   showsPrec _ = listrShow shows
+#endif
 
 instance NFData i => NFData (ListR n i) where
   rnf ZR = ()
@@ -189,8 +194,12 @@ infixr 3 :.:
 
 type IIxR n = IxR n Int
 
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+deriving instance Show i => Show (IxR n i)
+#else
 instance Show i => Show (IxR n i) where
   showsPrec _ (IxR l) = listrShow shows l
+#endif
 
 instance NFData i => NFData (IxR sh i)
 
@@ -260,8 +269,12 @@ infixr 3 :$:
 
 type IShR n = ShR n Int
 
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+deriving instance Show i => Show (ShR n i)
+#else
 instance Show i => Show (ShR n i) where
   showsPrec _ (ShR l) = listrShow shows l
+#endif
 
 instance NFData i => NFData (ShR sh i)
 
diff --git a/src/Data/Array/Nested/Shaped/Base.hs b/src/Data/Array/Nested/Shaped/Base.hs
index 74c231d..8f41455 100644
--- a/src/Data/Array/Nested/Shaped/Base.hs
+++ b/src/Data/Array/Nested/Shaped/Base.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -49,13 +50,18 @@ import Data.Array.Strided.Arith
 -- 'Shaped' is a newtype around a 'Mixed' of 'Just's.
 type Shaped :: [Nat] -> Type -> Type
 newtype Shaped sh a = Shaped (Mixed (MapJust sh) a)
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+deriving instance Show (Mixed (MapJust sh) a) => Show (Shaped sh a)
+#endif
 deriving instance Eq (Mixed (MapJust sh) a) => Eq (Shaped sh a)
 deriving instance Ord (Mixed (MapJust sh) a) => Ord (Shaped sh a)
 
+#ifndef OXAR_DEFAULT_SHOW_INSTANCES
 instance (Show a, Elt a) => Show (Shaped n a) where
   showsPrec d arr@(Shaped marr) =
     let sh = show (shsToList (sshape arr))
     in showsMixedArray ("sfromListLinear " ++ sh) ("sreplicate " ++ sh) d marr
+#endif
 
 instance Elt a => NFData (Shaped sh a) where
   rnf (Shaped arr) = rnf arr
@@ -63,6 +69,9 @@ instance Elt a => NFData (Shaped sh a) where
 -- just unwrap the newtype and defer to the general instance for nested arrays
 newtype instance Mixed sh (Shaped sh' a) = M_Shaped (Mixed sh (Mixed (MapJust sh') a))
   deriving (Generic)
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+deriving instance Show (Mixed sh (Mixed (MapJust sh') a)) => Show (Mixed sh (Shaped sh' a))
+#endif
 
 deriving instance Eq (Mixed sh (Mixed (MapJust sh') a)) => Eq (Mixed sh (Shaped sh' a))
 
diff --git a/src/Data/Array/Nested/Shaped/Shape.hs b/src/Data/Array/Nested/Shaped/Shape.hs
index 092465f..59a7d61 100644
--- a/src/Data/Array/Nested/Shaped/Shape.hs
+++ b/src/Data/Array/Nested/Shaped/Shape.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveFunctor #-}
@@ -58,8 +59,12 @@ deriving instance (forall n. Eq (f n)) => Eq (ListS sh f)
 deriving instance (forall n. Ord (f n)) => Ord (ListS sh f)
 infixr 3 ::$
 
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+deriving instance (forall n. Show (f n)) => Show (ListS sh f)
+#else
 instance (forall n. Show (f n)) => Show (ListS sh f) where
   showsPrec _ = listsShow shows
+#endif
 
 instance (forall m. NFData (f m)) => NFData (ListS n f) where
   rnf ZS = ()
@@ -201,8 +206,12 @@ infixr 3 :.$
 
 type IIxS sh = IxS sh Int
 
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+deriving instance Show i => Show (IxS sh i)
+#else
 instance Show i => Show (IxS sh i) where
   showsPrec _ (IxS l) = listsShow (\(Const i) -> shows i) l
+#endif
 
 instance Functor (IxS sh) where
   fmap f (IxS l) = IxS (listsFmap (Const . f . getConst) l)
@@ -280,8 +289,12 @@ infixr 3 :$$
 
 {-# COMPLETE ZSS, (:$$) #-}
 
+#ifdef OXAR_DEFAULT_SHOW_INSTANCES
+deriving instance Show (ShS sh)
+#else
 instance Show (ShS sh) where
   showsPrec _ (ShS l) = listsShow (shows . fromSNat) l
+#endif
 
 instance NFData (ShS sh) where
   rnf (ShS ZS) = ()