Custom Show instances for list-like output

1 files changed, 22 insertions, 4 deletions

diff --git a/src/Data/Array/Mixed.hs b/src/Data/Array/Mixed.hs
index 33d9f56..03b411c 100644
--- a/src/Data/Array/Mixed.hs
+++ b/src/Data/Array/Mixed.hs
@@ -97,11 +97,13 @@ type ListX :: [Maybe Nat] -> (Maybe Nat -> Type) -> Type
 data ListX sh f where
   ZX :: ListX '[] f
   (::%) :: f n -> ListX sh f -> ListX (n : sh) f
-deriving instance (forall n. Show (f n)) => Show (ListX sh f)
 deriving instance (forall n. Eq (f n)) => Eq (ListX sh f)
 deriving instance (forall n. Ord (f n)) => Ord (ListX sh f)
 infixr 3 ::%
 
+instance (forall n. Show (f n)) => Show (ListX sh f) where
+  showsPrec _ = showListX shows
+
 data UnconsListXRes f sh1 =
   forall n sh. (n : sh ~ sh1) => UnconsListXRes (ListX sh f) (f n)
 unconsListX :: ListX sh1 f -> Maybe (UnconsListXRes f sh1)
@@ -116,11 +118,18 @@ foldListX :: Monoid m => (forall n. f n -> m) -> ListX sh f -> m
 foldListX _ ZX = mempty
 foldListX f (x ::% xs) = f x <> foldListX f xs
 
+showListX :: forall sh f. (forall n. f n -> ShowS) -> ListX sh f -> ShowS
+showListX f l = go "[" l . showString "]"
+  where
+    go :: String -> ListX sh' f -> ShowS
+    go _ ZX = id
+    go prefix (x ::% xs) = showString prefix . f x . go "," xs
+
 
 type role IxX nominal representational
 type IxX :: [Maybe Nat] -> Type -> Type
 newtype IxX sh i = IxX (ListX sh (Const i))
-  deriving (Show, Eq, Ord)
+  deriving (Eq, Ord)
 
 pattern ZIX :: forall sh i. () => sh ~ '[] => IxX sh i
 pattern ZIX = IxX ZX
@@ -137,6 +146,9 @@ infixr 3 :.%
 
 type IIxX sh = IxX sh Int
 
+instance Show i => Show (IxX sh i) where
+  showsPrec _ (IxX l) = showListX (\(Const i) -> shows i) l
+
 instance Functor (IxX sh) where
   fmap f (IxX l) = IxX (fmapListX (Const . f . getConst) l)
 
@@ -161,7 +173,7 @@ fromSMayNat' = fromSMayNat id fromSNat'
 type role ShX nominal representational
 type ShX :: [Maybe Nat] -> Type -> Type
 newtype ShX sh i = ShX (ListX sh (SMayNat i SNat))
-  deriving (Show, Eq, Ord)
+  deriving (Eq, Ord)
 
 pattern ZSX :: forall sh i. () => sh ~ '[] => ShX sh i
 pattern ZSX = ShX ZX
@@ -178,6 +190,9 @@ infixr 3 :$%
 
 type IShX sh = ShX sh Int
 
+instance Show i => Show (ShX sh i) where
+  showsPrec _ (ShX l) = showListX (fromSMayNat shows (shows . fromSNat)) l
+
 instance Functor (ShX sh) where
   fmap f (ShX l) = ShX (fmapListX (fromSMayNat (SUnknown . f) SKnown) l)
 
@@ -189,7 +204,7 @@ lengthShX (_ :$% sh) = 1 + lengthShX sh
 -- | The part of a shape that is statically known.
 type StaticShX :: [Maybe Nat] -> Type
 newtype StaticShX sh = StaticShX (ListX sh (SMayNat () SNat))
-  deriving (Show, Eq, Ord)
+  deriving (Eq, Ord)
 
 pattern ZKX :: forall sh. () => sh ~ '[] => StaticShX sh
 pattern ZKX = StaticShX ZX
@@ -204,6 +219,9 @@ infixr 3 :!%
 
 {-# COMPLETE ZKX, (:!%) #-}
 
+instance Show (StaticShX sh) where
+  showsPrec _ (StaticShX l) = showListX (fromSMayNat shows (shows . fromSNat)) l
+
 
 type family Rank sh where
   Rank '[] = 0