First Class Instances

In this post I'm going to implement first class instances for typeclasses. Yes, it's already been done, but I find that particular approach problematic for two reasons:

Every alternative instance has to deal with the Proxy type. This isn't so much of a problem for classes with simple functions (like show), but the extra casts get annoying pretty quickly when you have to deal with more complicated functions, such as >>=.
The solution doesn't generalize that well. You have to create a new ProxyN newtype for every type kind (i.e. Proxy for kind *, Proxy1 for kind * -> *). The PolyKinds extension doesn't seem to be enough to alleviate the issue.

I'm going to propose a different solution based on implicit parameters.

Named Typeclass Instances

First of all, I'm going to be making use of these imports and extensions:

{-# LANGUAGE
    ConstraintKinds,
    FlexibleContexts,
    FlexibleInstances,
    NoImplicitPrelude,
    PolyKinds,
    RankNTypes,
    RebindableSyntax,
    TypeFamilies,
    UndecidableInstances
  #-}

import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Prelude (IO, flip, id, undefined)
import Unsafe.Coerce (unsafeCoerce)

import qualified Control.Monad
import qualified Prelude

No ImplicitParams? I want to be able to specify a "default" type class instance. Unfortunately, the existing implicit parameters extension can't do that, so I'm going to rip something out of the guts of the (awesome) implicit-params package.

(We don't need the named implicit parameters, so I've renamed and streamlined a few things.)

class Class a where
    inst :: a

with :: c -> (Class c => a) -> a
with = flip unsafeCoerce

We can now sanely make use of the technique described in Scrap Your Type Classes. First, we'll define the records:

-- Type class instances are represented with records.
newtype Pointed' t = Pointed' { _return :: forall a. a -> t a }
newtype Functor' t = Functor' { _map :: forall a b. (a -> b) -> t a -> t b }

With ConstraintKinds, we can create some synonyms for bringing instances into scope:

type Pointed t = Class (Pointed' t)
type Functor t = Class (Functor' t)

In particular, we can use constraint synonyms for expressing hierarchies:

newtype Applicative' t = Applicative' { _apply :: forall a b. t (a -> b) -> t a -> t b }

type Applicative t = (Pointed t, Functor t, Class (Applicative' t))

Default instances can be specified with Class instances:

instance Class (Pointed' IO) where
    inst = Pointed' {
        _return = Prelude.return
    }

instance Class (Functor' IO) where
    inst = Functor' {
        _map = Prelude.fmap
    }

instance Class (Applicative' IO) where
    inst = Applicative' {
        _apply = Control.Monad.ap
    }

Alternate instances can be specified with plain old values:

-- An (idiotic) alternate instance.
dumbPointed :: Pointed' IO
dumbPointed = Pointed' {
    _return = \x -> undefined
}

Finally, we define the actual class functions:

return :: Pointed t => a -> t a
return = _return inst

map :: Functor t => (a -> b) -> t a -> t b
map = _map inst

(<*>) :: Applicative t => t (a -> b) -> t a -> t b
(<*>) = _apply inst

Usage is straightforward:

(<$>) :: Functor t => (a -> b) -> t a -> t b
(<$>) = map

sequence :: Applicative t => [t a] -> t [a]
sequence [] = return []
sequence (x:xs) = (:) <$> x <*> sequence xs

dumbReturn :: a -> IO a
dumbReturn x = with dumbPointed (return x)

ghci> return 3
3
ghci> dumbReturn 3
*** Exception: Prelude.undefined

Default Implementations

I've demonstrated how to mimic the basics, but we can go further.

Let's look at monads. Monads have two possible definitions: join and bind. Ideally, the Monad typeclass would include definitions for both:

class Applicative t => Monad t where
    bind :: (a -> t b) -> t a -> t b
    bind f x = join (map f x)

    join :: t (t a)
    join = bind id

I've provided default definitions for both functions, so the client code only has to implement one function. However, there's nothing stopping someone from implementing neither of them.

instance Monad FooBar

Obviously, we would get an infinite loop if we tried to use this instance. With our new approach, we can avoid this:

(As a side note, GHC 7.7+ has a MINIMAL pragma, which solves this problem. But that's currently unreleased...)

type Monad t = (Applicative t, Class (Monad' t))

data Monad' t = Monad' {
    _bind :: forall a b. (a -> t b) -> t a -> t b,
    _join :: forall a. t (t a) -> t a
}

monadFromBind :: Applicative t => (forall a b. (a -> t b) -> t a -> t b) -> Monad' t
monadFromBind bind' = Monad' {
    _bind = bind',
    _join = bind' id
}

monadFromJoin :: Applicative t => (forall a. t (t a) -> t a) -> Monad' t
monadFromJoin join' = Monad' {
    _bind = \f x -> join' (map f x),
    _join = join'
}

bind :: Monad t => (a -> t b) -> t a -> t b
bind = _bind inst

join :: Monad t => t (t a) -> t a
join = _join inst

By turning typeclass instances into simple values, we've given ourselves more control over how instances are constructed. Perhaps this can be taken further to ensure that instances satisfy certain laws.

Do Notation

While we're at it, let's reclaim do notation (with RebindableSyntax, of course):

(>>=) :: Monad t => t a -> (a -> t b) -> t b
(>>=) = flip bind

Multiparameter Typeclasses, Functional Dependencies, and Associated Types

Multiparameter typeclasses come free - just add another parameter to your instance record. On the other hand, functional dependencies are impossible to express directly. We can approximate them using TypeFamilies:

type MonadRef m = (Monad m, Class (MonadRef' m))

type family Ref m :: * -> *

data MonadRef' m = MonadRef' {
    _newRef :: a -> m (Ref m a),
    _readRef :: Ref m a -> m a,
    _writeRef :: Ref m a -> a -> m ()
}

type instance Ref IO = IORef

instance Class (MonadRef IO) where
    inst = MonadRef' {
        _newRef = newIORef,
        _readRef = readIORef,
        _writeRef = writeIORef
    }

newRef :: MonadRef m => a -> m (Ref m a)
newRef = _newRef inst

readRef :: MonadRef m => Ref m a -> m a
readRef = _readRef inst

writeRef :: MonadRef m => Ref m a -> a -> m ()
writeRef = _writeRef inst

Quantified Contexts

With our new method of declaring type classes, we now have the ability to express quantified contexts! First, we'll define a new type Q (for quantify):

-- c is the class we're implementing
-- t is the type being quantified
newtype Q c t = Q { unQ :: forall a. c (t a) }

Q allows us to declare things like this:

type Empty' t = Empty' { _empty :: t }

instance Class (Q Empty' []) where
    inst = Q (Empty' { _empty = [] })

empty :: Class (Semigroup' t) => t
empty = _empty inst

empty2 :: Class (Q Semigroup' t) => (t a, t b)
empty2 = (_empty (unQ inst), _empty (unQ inst))

Think of c like a continuation. By stacking Qs, we can achieve an arbitrary level of quantification:

higherEmpty :: Class (Q (Q Semigroup') t) => (t a b, t b a)
higherEmpty = (_empty (unQ (unQ inst)), _empty (unQ (unQ inst)))

Typing unQ inst everywhere is a chore. We can alleviate this problem by declaring another instance for Class:

instance Class (Q c t) => Class (c (t a)) where
    inst = unQ inst

Now it's possible to use empty directly, instead of nested calls to unQ:

empty2 :: Class (Q Semigroup' t) => (t a, t b)
empty2 = (empty, empty)

higherEmpty :: Class (Q (Q Semigroup') t) => (t a b, t b a)
higherEmpty = (empty, empty)

Just watch out for overlapping instances.

Conclusion

I think there's more to explore. In particular, I'm concerned about the safety of this method. Am I breaking the the system in a bad way? Another thing to consider is whether or not all the boilerplate can be automated with metaprogramming. Guess I finally have a reason to learn Template Haskell :)

Giant Flying Lambdas!