Type Classes

We have seen that types are sets values that bear similarities. Similarly, type classes are sets of types that bear similarities. In particular, every type in a particular class defines a common set of members with particular type signatures.

Defining Type Classes

Consider the Eq type class from the Prelude. There are two parts to the definition. First, a list of members and type signatures that must be implemented by any type a to be added to the Eq type class. Second, a list of default implementations for members that are not provided explicitly.

class Eq a where
  -- type signatures for required members
  (==) :: a -> a -> Bool
  (/=) :: a -> a -> Bool

  -- default implementations (if not explicitly defined)
  x == y = not (x /= y)
  x /= y = not (x == y)

In this class, notice how (==) and (/=) are defined mutually recursively. As long as one of the operations is defined for a particular type (overriding the default definition), the definition of the other "comes for free."

In addition to the definition itself, there are two additional components that are described informally, in comments or in the documentation. First, because of the default implementations, the minimal complete definition is either (==) or (/=); no need to provide both.

The second additional component is a set of (unchecked) laws that each implementation is assumed to satisfy. For each type a in Eq, the law is:

forall x :: a, y :: a. (x == y) == not (x /= y)

Notice that this law is respected by the default implementations, but can be broken by an explicit instance definition.

Defining Type Class Instances

Adding a type T to a class C requires an instance declaration that implements the members of C, with types specialized to T.

As a simple example, consider a hard-coded integer list type:

data IntList
    = Nil
    | Cons Int IntList

We can add IntList to the Eq class as follows:

instance Eq IntList where
 -- (==) :: IntList -> IntList -> IntList
    Nil       == Nil        = True
    Cons x xs == Cons y ys  = x == y && xs == ys
    _         == _          = False

This function first checks that the data constructors match and, if so, then recursively checks that the corresponding components are equal. Notice that the call to (==) in x == y refers to the implementation (provided by Haskell) for Ints and the call to (==) in xs == ys refers to the implementation in the IntList instance (that is, the function currently being defined recursively).

We have seen how deriving clauses can be used to automatically generate instance declarations for certain classes. If we had defined IntList with the clause deriving (Eq), the implementation above — checking that the "boxes" are tagged with the same data constructors, and then checking pairwise value equality among each of the data values inside the boxes — is essentially what will get generated automatically. In situations where the default implementation is not what we want, we can manually declare the instance.

There can be at most one instance declaration for a given type and class. This design decision restricts some potentially useful programming patterns in exchange for automatically knowing where to find the implementation of any call to a type class member based on the types of its arguments.

Try adding a second Eq IntList instance declaration (either explicitly or by adding a deriving (Eq) clause).

Consider a polymorphic list definition.

data List a
    = Nil
    | Cons a (List a)

instance Eq a => Eq (List a) where
 -- (==) :: List a -> List a -> List a
    Nil       == Nil        = True
    Cons x xs == Cons y ys  = x == y && xs == ys
    _         == _          = False

Note that our instance declaration requires a type class constraint, to ensure that the underlying type a is also part of Eq. The call to (==) in xs == ys refers to the implementation from the Eq a instance. This implementation can also be automatically derived via deriving (Eq).

Show

class Show a where
  show :: a 
  ...

> :t show

Automatically derived Show instance for List a:

> Cons 1 (Cons 2 (Cons 3 Nil))
Cons 1 (Cons 2 (Cons 3 Nil))

We can make them look more like built-in lists.

instance Show a => Show (List a) where
 -- show             :: List a -> String
    show Nil         =  "[]"
    show (Cons x xs) =  "(" ++ show x ++ " : " ++ show xs ++ ")"

> Cons 1 (Cons 2 (Cons 3 Nil))
(1 : (2 : (3 : [])))

Read

class Read a where
  read :: String -> a
  ...

The read function is used to parse Strings into values of some type.

Notice how the type variable a is referred to only in the output. Therefore, we can tell that the function will crash (rather than return an error via Maybe) when the there is no meaningful a value to return for the given input String. Furthermore, Haskell needs information from the context in which read is called to figure out which instance declaration to use.

> read "1"
*** Exception: Prelude.read: no parse
*List> read "1" :: Int
1
*List> read "1" :: Integer
1
*List> read "1" :: Float
1.0
*List> read "1" :: Bool
*** Exception: Prelude.read: no parse

In reality, if you dig into the Prelude you'll see that Read is actually defined with a member

  readsPrec :: Int -> String -> [(a, String)]

and read is a library function (outside of the Read class) defined in terms of the Read members. This is a minor detail that we need not worry about for now. We will see readsPrec again when we program some parsers in detail later on.

Num

> :info Num
> :info Int
> :info Floating
> :info Integral

Int andInteger have a common typeclass called Integral.

Ord

> :info Ord

Every type T in Ord must first be a member of Eq. Eq is a superclass of Ord; Ord is a subclass of Eq.

Enum

> :info Enum

> [1..10]
> [1,2..10]
> [False .. True]
> [True .. False]

Bounded

> :info Bounded

> minBound :: Int
> maxBound :: Int
> minBound :: Integer

> :t minBound
> minBound + 0
> (minBound :: Int) + (minBound :: 1)
> (minBound :: Int) + 1
> (minBound :: Int) + 2
> minBound + (2 :: Int)

Foldable

Recall the foldr function from before:

foldr :: {- forall a b. -} (a -> b -> b) -> b -> [a] -> b
foldr f acc []      =  acc
foldr f acc (x:xs)  =  f x (foldr f acc xs)

Let's warm up with some handy function tricks from last time:

sum  = foldr (+) 0
prod = foldr (*) 1
cat  = foldr (++) []

len = foldr (\_ acc -> 1 + acc) 0
len = foldr (\_ -> (1+)) 0         -- not necessarily better
len = foldr (+) 0 . map (const 1)  -- same here, and two passes

Trees

Lots of other data structures can be folded over, too.

class Foldable t where
    foldr :: (a -> b -> b) -> b -> t a -> b
    foldl :: (b -> a -> b) -> b -> t a -> b 
    ...

Notice how the Foldable type t is used in the type t a above; it is a type that takes a type (in particular a) an argument. This is a different kind of type than those ranged over by a and b, which are not applied to any type arguments. Yep, there are different kinds of types...

Back to Foldable... Minimum complete definition is foldr. Foldable has other members, which we will talk about (much) later.

Example:

data BinaryTree a
    = Empty
    | Node a (BinaryTree a) (BinaryTree a)
    deriving (Show)

instance Foldable BinaryTree where
 -- foldr :: (a -> b -> b) -> b -> BinaryTree a -> b
    foldr f acc Empty = acc
    foldr f acc (Node x left right) =
      foldr f (f x (foldr f acc right)) left

Common Helper Functions

> :t concat :: [[a]] -> [a]
> :t concat

> :t elem :: Eq a => (a -> [a] -> Bool)
> :t elem

Source Files