Suppose you wanted to write a type class for indexable containers. It might look something like this:
class Indexed f where
(!?) :: f a -> Int -> Maybe a
We could then go on to write instances for our favorite types:
instance Indexed [] where
!? _ = Nothing
[] :xs) !? n
(x| n == 0 = Just x
| n > 0 = xs !? (n - 1)
| otherwise = Nothing
instance Indexed Vector where
!?) = (V.!?)
(
instance Indexed IntMap where
!?) = (IntMap.!?) (
But now, we decide that we also want to be able to index Map
s as well. The issue is that we’ve already hard-coded the index type to be Int
.
Associated Type Families
One way to allow arbitrary index types is to use an associated type family:
{-# LANGUAGE TypeFamilies #-}
class Indexed f where
type Idx f
(!?) :: f a -> Idx f -> Maybe a
instance Indexed [] where
type Idx [] = Int
-- ...
instance Ord k => Indexed (Map k) where
type Idx (Map k) = k
!?) = (Map.!?) (
Say we want to write the following function:
firstElem :: Indexed f => f a -> Maybe a
= f !? (0 :: Int) firstElem f
We’d get a type error:
• Couldn't match expected type ‘Idx f’ with actual type ‘Int’
Fair enough, this function obviously won’t work for just any indexable container, only ones that are indexed by Int
s. We can resolve this by adding a constraint:
firstElem :: (Indexed f, Idx f ~ Int) => f a -> Maybe a
= f !? (0 :: Int) firstElem f
For those unfamiliar, ~
here is an operator provided by GHC that yields a constraint that the type on the left equals the type on the right. In this case, by constraining Idx f
to equal Int
, GHC can now add that to its list of known facts, so we don’t get that type error anymore. ~
is enabled by both the TypeFamilies
extension and the GADTs
extension.
Multi-parameter Type Classes
Another way we can encode this information, the type of the index, would be to add an additional parameter to the type class.
{-# LANGUAGE MultiParamTypeClasses #-}
class Indexed f idx where
(!?) :: f a -> idx -> Maybe a
instance Indexed [] Int where
-- ...
instance Indexed (Map k) k where
!?) = (Map.!?) (
We can then write firstElem
in a straightforward manner.
firstElem :: Indexed f Int => f a -> Maybe a
= f !? (0 :: Int) firstElem f
Yes! This type checks just fine.
All is good, right? Well, let’s try and use this instance.
c :: Maybe Char
= "hello" !? 3 c
Oh no! When we compile, we get errors:
• Ambiguous type variable ‘idx0’ arising from a use of ‘!?’
prevents the constraint ‘(Indexed [] idx0)’ from being solved.
Probable fix: use a type annotation to specify what ‘idx0’ should be.
• Ambiguous type variable ‘idx0’ arising from the literal ‘3’
prevents the constraint ‘(Num idx0)’ from being solved.
Probable fix: use a type annotation to specify what ‘idx0’ should be.
Now sure, if we add a type signature to the literal 3
, then the error goes away, but this is really not ideal. Ideally, we’d like the compiler to infer right away that since we’re indexing a list, the index type must be Int
. This is indeed what happens when we use an associated type family, but not here.
Functional Dependencies
The core issue here is that there’s nothing stopping someone from writing their own instance:
instance Indexed [] Integer where
...
This is a completely valid instance that doesn’t overlap with our own. Therefore, GHC can’t infer that the literal 0
must be an Int
, since it can just as well be an Integer
, or any number of types, really.
The solution is to add a functional dependency.
{-# LANGUAGE FunctionalDependencies #-}
class Indexed f idx | f -> idx where
(!?) :: f a -> idx -> Maybe a
x :: Maybe Char
= "hello" !? 3 x
What this syntax means is that the type variable f
must uniquely determine the type variable idx
. This has two effects. One, if we have an instance instance Indexed [] Int
, then we can’t go ahead and write another instance instance Indexed [] Integer
, since then f
doesn’t uniquely determine idx
. Two, GHC can now infer the type of idx
just from knowing what f
is, so our program will now type check. GHC will see we’re indexing a list, and therefore the index type must be Int
, so the type of the literal 3
here must be Int
.
Looking back, when we used a type family, we were doing the same thing, only implicitly. When we write Idx f
it’s implicit that Idx
gives back a single type when applied. In other words, f
uniquely determines Idx f
.1
Both of these methods give very similar results, but it’s good to be familiar with both of them, as they can have different ergonomics. It’s also good to be able to recognize both of these patterns in other libraries, as they’re both used throughout Hackage.