I have a list of heterogeneous types (or at least that's what I have in mind):
data Nul
data Bits b otherBits where
BitsLst :: b -> otherBits -> Bits b otherBits
NoMoreBits :: Bits b Nul
Now, given an input type b
, I want to go through all the slabs of Bits
with type b
and summarize them, ignoring other slabs with type b' /= b
:
class Monoid r => EncodeBit b r | b -> r where
encodeBit :: b -> r
class AbstractFoldable aMulti r where
manyFold :: r -> aMulti -> r
instance (EncodeBit b r, AbstractFoldable otherBits r) =>
AbstractFoldable (Bits b otherBits ) r where
manyFold r0 (BitsLst bi other) = manyFold (r0 `mappend` (encodeBit bi)) other
manyFold b0 NoMoreBits = b0
instance AbstractFoldable otherBits r =>
AbstractFoldable (Bits nb otherBits ) r where
manyFold r0 (BitsLst _ other) = manyFold r0 other
manyFold b0 NoMoreBits = b0
But the compiler wants none of it. And with good reason, since both instance declarations have the same head. Question: what is the correct way of folding over Bits
with an arbitrary type?
Note: the above example is compiled with
{-# LANGUAGE MultiParamTypeClasses,
FunctionalDependencies,
GADTs,
DataKinds,
FlexibleInstances,
FlexibleContexts
#-}
Answering your comment:
You can filter the heterogeneous list by type if you add a
Typeable
constraint tob
.The main idea is we will use
Data.Typeable
'scast :: (Typeable a, Typeable b) => a -> Maybe b
to determine if each item in the list is of a certain type. This will require aTypeable
constraint for each item in the list. Instead of building a new list type with this constraint built in, we will make the ability to check ifAll
types in a list meet some constraint.Our goal is to make the following program output
[True,False]
, filtering a heterogeneous list to only itsBool
elements. I will endevour to place the language extensions and imports with the first snippet they are needed forHList
here is a fairly standard definition of a heterogeneous list in haskell usingDataKinds
We want to write
ofType
with a signature like "ifAll
things in a heterogeneous list areTypeable
, get a list of those things of a specificTypeable
type.To do this, we need to develop the notion of
All
things in a list of types satisfying some constraint. We will store the dictionaries for satisfied constraints in aGADT
that either captures both the head constraint dictionary and constraints forAll
of the the tail or proves that the list is empty. A type list satisfies a constraint forAll
it's items if we can capture the dictionaries for it.DList
really is a list of dictionaries.DCons
captures the dictionary for the constraint applied to the head item (ctx h
) and all the dictionaries for the remainder of the list (All ctx t
). We can't get the dictionaries for the tail directly from the constructor, but we can write a function that extracts them from the dictionary forAll ctx t
.An empty list of types trivially satisfies any constraint applied to all of its items
If the head of a list satisfies a constraint and all of the tail does too, then everything in the list satisfies the constraint.
We can now write
ofType
, which requiresforall
s for scoping type variables withScopedTypeVariables
.We are zipping the
HList
together with its dictionaries withmaybeToList . cast
and concatenating the results. We can make that explicit withRankNTypes
.†constraints