I try to define a Show
instance for my heterogeneous list HList
. The code is at the bottom of this post.
#1 below works, but I wanted a Show
instance that looks more like the way a regular list shows, e.g. something like [1,"abc",True,3.1]
.
#2 attempts this, but I get stuck at the following error on show x
. I don’t want to add a Show
context to the definition of the data constructor Cons
, because not all HList
s will have only Show
-able element types.
• Could not deduce (Show a2) arising from a use of ‘show’
from the context: (Show a, Show (HList as))
...
Possible fix:
add (Show a2) to the context of the data constructor ‘Cons’
• In the first argument of ‘(:)’, namely ‘show x’
In the expression: show x : toStringList xs
#3 attempts to move the helper function toStringList
outside of the Show
instance for HList
, so I can specify the type constraint. In this case the error shifts to the recursive call toStringList xs
:
• Could not deduce (Show a0) arising from a use of ‘toStringList’
from the context: (Show a, Show (HList as))
...
• In the second argument of ‘(:)’, namely ‘toStringList xs’
In the expression: show x : toStringList xs
In an equation for ‘toStringList’:
toStringList (Cons x xs) = show x : toStringList xs
What’s missing or wrong? How do I complete either #2 or #3 to get a Show
instance for HList
constructed the way I want?
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
import Data.List (intercalate)
data HList :: [*] -> * where
Nil :: HList '[]
Cons :: a -> HList as -> HList (a ': as)
instance Show (HList '[]) where
show Nil = "[]"
-- #1: this works, but it's not what I wanted
{- instance (Show a, Show (HList as)) => Show (HList (a ': as)) where
show (Cons x xs) = show x ++ " : " ++ show xs
-}
-- #2: fails on `show x`
instance (Show a, Show (HList as)) => Show (HList (a ': as)) where
show xs@(Cons _ _) = "[" ++ (intercalate "," . toStringList $ xs) ++ "]"
where toStringList :: HList (as :: [*]) -> [String]
toStringList (Cons x xs) = show x : toStringList xs
toStringList Nil = []
-- #3: fails on `toStringList xs`
toStringList :: (Show a, Show (HList as)) => HList (a ': as) -> [String]
toStringList (Cons x Nil) = [show x]
toStringList (Cons x xs) = show x : toStringList xs