aboutsummaryrefslogtreecommitdiff
path: root/src/Data/Array
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/Array')
-rw-r--r--src/Data/Array/Mixed.hs26
-rw-r--r--src/Data/Array/Nested/Internal.hs46
2 files changed, 60 insertions, 12 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
diff --git a/src/Data/Array/Nested/Internal.hs b/src/Data/Array/Nested/Internal.hs
index cf90240..c66bd07 100644
--- a/src/Data/Array/Nested/Internal.hs
+++ b/src/Data/Array/Nested/Internal.hs
@@ -192,25 +192,34 @@ type ListR :: Nat -> Type -> Type
data ListR n i where
ZR :: ListR 0 i
(:::) :: forall n {i}. i -> ListR n i -> ListR (n + 1) i
-deriving instance Show i => Show (ListR n i)
deriving instance Eq i => Eq (ListR n i)
deriving instance Ord i => Ord (ListR n i)
deriving instance Functor (ListR n)
deriving instance Foldable (ListR n)
infixr 3 :::
+instance Show i => Show (ListR n i) where
+ showsPrec _ = showListR shows
+
data UnconsListRRes i n1 =
forall n. (n + 1 ~ n1) => UnconsListRRes (ListR n i) i
unconsListR :: ListR n1 i -> Maybe (UnconsListRRes i n1)
unconsListR (i ::: sh') = Just (UnconsListRRes sh' i)
unconsListR ZR = Nothing
+showListR :: forall sh i. (i -> ShowS) -> ListR sh i -> ShowS
+showListR f l = go "[" l . showString "]"
+ where
+ go :: String -> ListR sh' i -> ShowS
+ go _ ZR = id
+ go prefix (x ::: xs) = showString prefix . f x . go "," xs
+
-- | An index into a rank-typed array.
type role IxR nominal representational
type IxR :: Nat -> Type -> Type
newtype IxR n i = IxR (ListR n i)
- deriving (Show, Eq, Ord)
+ deriving (Eq, Ord)
deriving newtype (Functor, Foldable)
pattern ZIR :: forall n i. () => n ~ 0 => IxR n i
@@ -228,15 +237,16 @@ infixr 3 :.:
type IIxR n = IxR n Int
+instance Show i => Show (IxR n i) where
+ showsPrec _ (IxR l) = showListR shows l
+
type role ShR nominal representational
type ShR :: Nat -> Type -> Type
newtype ShR n i = ShR (ListR n i)
- deriving (Show, Eq, Ord)
+ deriving (Eq, Ord)
deriving newtype (Functor, Foldable)
-type IShR n = ShR n Int
-
pattern ZSR :: forall n i. () => n ~ 0 => ShR n i
pattern ZSR = ShR ZR
@@ -250,17 +260,24 @@ infixr 3 :$:
{-# COMPLETE ZSR, (:$:) #-}
+type IShR n = ShR n Int
+
+instance Show i => Show (ShR n i) where
+ showsPrec _ (ShR l) = showListR shows l
+
type role ListS nominal representational
type ListS :: [Nat] -> (Nat -> Type) -> Type
data ListS sh f where
ZS :: ListS '[] f
(::$) :: forall n sh {f}. KnownNat n => f n -> ListS sh f -> ListS (n : sh) f
-deriving instance (forall n. Show (f n)) => Show (ListS sh f)
deriving instance (forall n. Eq (f n)) => Eq (ListS sh f)
deriving instance (forall n. Ord (f n)) => Ord (ListS sh f)
infixr 3 ::$
+instance (forall n. Show (f n)) => Show (ListS sh f) where
+ showsPrec _ = showListS shows
+
data UnconsListSRes f sh1 =
forall n sh. (KnownNat n, n : sh ~ sh1) => UnconsListSRes (ListS sh f) (f n)
unconsListS :: ListS sh1 f -> Maybe (UnconsListSRes f sh1)
@@ -275,6 +292,13 @@ foldListS :: Monoid m => (forall n. f n -> m) -> ListS sh f -> m
foldListS _ ZS = mempty
foldListS f (x ::$ xs) = f x <> foldListS f xs
+showListS :: forall sh f. (forall n. f n -> ShowS) -> ListS sh f -> ShowS
+showListS f l = go "[" l . showString "]"
+ where
+ go :: String -> ListS sh' f -> ShowS
+ go _ ZS = id
+ go prefix (x ::$ xs) = showString prefix . f x . go "," xs
+
-- | An index into a shape-typed array.
--
@@ -285,7 +309,7 @@ foldListS f (x ::$ xs) = f x <> foldListS f xs
type role IxS nominal representational
type IxS :: [Nat] -> Type -> Type
newtype IxS sh i = IxS (ListS sh (Const i))
- deriving (Show, Eq, Ord)
+ deriving (Eq, Ord)
pattern ZIS :: forall sh i. () => sh ~ '[] => IxS sh i
pattern ZIS = IxS ZS
@@ -302,6 +326,9 @@ infixr 3 :.$
type IIxS sh = IxS sh Int
+instance Show i => Show (IxS sh i) where
+ showsPrec _ (IxS l) = showListS (\(Const i) -> shows i) l
+
instance Functor (IxS sh) where
fmap f (IxS l) = IxS (fmapListS (Const . f . getConst) l)
@@ -313,7 +340,7 @@ instance Foldable (IxS sh) where
type role ShS nominal
type ShS :: [Nat] -> Type
newtype ShS sh = ShS (ListS sh SNat)
- deriving (Show, Eq, Ord)
+ deriving (Eq, Ord)
pattern ZSS :: forall sh. () => sh ~ '[] => ShS sh
pattern ZSS = ShS ZS
@@ -329,6 +356,9 @@ infixr 3 :$$
{-# COMPLETE ZSS, (:$$) #-}
+instance Show (ShS sh) where
+ showsPrec _ (ShS l) = showListS (shows . fromSNat) l
+
-- | Wrapper type used as a tag to attach instances on. The instances on arrays
-- of @'Primitive' a@ are more polymorphic than the direct instances for arrays