A tiny eDSL, not unlike ErrorMessage for TypeErrors to pretty print types,
especially uninhabited types.
This Example will render this table:
+-------+-----+------------+
| col 1|col 2| col 3|
+-------+-----+------------+
| 2423| 451| 21234|
| 242322| 42| n/a|
| 0| 4351| 623562|
| 4351| n/a| n/a|
| 0| 4351| 623562|
+-------+-----+------------+
From this code:
module Main (main) where
import Data.Type.Pretty
import GHC.TypeLits
import Data.Kind
import Data.Proxy
main :: IO ()
main = putStrLn $ showPretty (Proxy :: Proxy TestTable)
type TestTable =
'MyTable '[MyCol "col 1" 7, MyCol "col 2" 5, MyCol "col 3" 12]
'[ MyRow '[2423 ,451 ,21234]
, MyRow '[242322 ,42]
, MyRow '[0 ,4351 ,623562]
, MyRow '[4351]
, MyRow '[0 ,4351 ,623562]
]
data MyTable = MyTable [Type] [Type]
data MyCol :: Symbol -> Nat -> Type
data MyRow :: [Nat] -> Type
type instance ToPretty ('MyTable cols rows) =
PrettyManyIn (PutStr "+") (RowSepLine cols)
<$$> PrettyManyIn (PutStr "|") (TableHeading cols)
<$$> PrettyManyIn (PutStr "+") (RowSepLine cols)
<$$> PrettyHigh (TableRows cols rows)
<$$> PrettyManyIn (PutStr "+") (RowSepLine cols)
type family TableHeading (cols :: [Type]) :: [PrettyType]
type instance TableHeading '[] = '[]
type instance TableHeading (MyCol title width ': r) =
PutStrW width title ': TableHeading r
type family
RowSepLine (cols :: [Type]) :: [PrettyType] where
RowSepLine '[] = '[]
RowSepLine (MyCol title width ': r) =
PrettyOften width (PutStr "-") ': RowSepLine r
type family
TableRows (cols :: [Type]) (rows :: [Type]) :: [PrettyType] where
TableRows cols '[] = '[]
TableRows cols (MyRow cells ': rest ) =
PrettyManyIn (PutStr "|") (TableCells cols cells) ': TableRows cols rest
type family
TableCells (cols :: [Type]) (cells :: [Nat]) :: [PrettyType] where
TableCells '[] cells = '[]
TableCells (MyCol title width ': cols) (value ': cells) =
PutNatW width value ': TableCells cols cells
TableCells (MyCol title width ': cols) '[] =
PutStrW width "n/a" ': TableCells cols '[]