Edit: My opinion on type classes has mellowed since I wrote this post, but I still keep it around as a critique against the excesses of type classes.
What I'm about to propose is that all Haskell type class programming can (and should) be implemented purely at the value level using a simple and ordinary code transformation.
The trick is simple and I will begin by transforming the
Monad type-class. Given any class:
class Monad m where
return :: a -> m a
(>>=) :: m a -> (a -> m b) -> m b
You can delete the class and replace it with a corresponding data type:
{-# LANGUAGE Rank2Types #-}
-- MonadI = Monad "I"nstance
data MonadI m = MonadI {
_return :: forall a . a -> m a,
_bind :: forall a b . m a -> (a -> m b) -> m b }
Then, given any instance for that class:
instance Monad Maybe where
return = Just
m >>= f = case m of
Nothing -> Nothing
Just x -> f x
... delete that instance and replace it with a value of our data type containing the method definitions:
monad'Maybe :: MonadI Maybe
monad'Maybe = MonadI {
_return = Just,
_bind = \m f -> case m of
Nothing -> Nothing
Just x -> f x }
This value-level representation of a class instance has several important benefits.
No class constraints
Now class constraints transform into ordinary parameters:
-- Before
sequence :: (Monad m) => [m a] -> m [a]
-- After
sequence' :: MonadI m -> [m a] -> m [a]
sequence' i x = case x of
[] -> return []
m:ms -> m >>= \x ->
sequence' i ms >>= \xs ->
return (x:xs)
where
return = _return i
(>>=) = _bind i
sequence' monad'Maybe [Just 3, Just 4]
= Just [3, 4]
This means that we can now skip type-level programming and implement everything within lambda calculus at the value level. Things that previously required elaborate extensions now only require ordinary Haskell functions.
No more extension hell
Let's say I wanted to implement an isomorphism type class using traditional type classes:
class Isomorphism a b where
fw :: a -> b
bw :: b -> a
The first problem is that I'd need to turn on
MultiParamTypeClasses to write a class like this.
Now I try to write this instance:
instance Isomorphism ((), a) a where
fw = snd
bw = (,) ()
Oops! Now I need
FlexibleInstances for the
() in the type. That extension's not as controversial, though.
But what if I then do this:
instance (Isomorphism a b, Isomorphism b c)
=> Isomorphism a c where
fw = fw . fw
bw = bw . bw
This is completely unresolvable, even using
UndecidableInstances. GHC will just barf and terminate after several rounds of recursion.
On the other hand, had I written it like:
data Isomorphism a b = Isomorphism {
fw :: a -> b,
bw :: b -> a }
... then I can trivially combine isomorphisms:
combine :: Isomorphism b c -> Isomorphism a b -> Isomorphism a c
combine (Isomorphism fw1 bw1) (Isomorphism fw2 bw2)
= Isomorphism (fw1 . fw2) (bw2 . bw1)
Haskell is better at value-level programming
The astute reader will notice that the last definition suggests a category. Let's go all the way and rewrite the
Category class at the value level and use it:
data CategoryI cat = CategoryI {
_compose :: forall a b c . cat b c -> cat a b -> cat a c,
_id :: forall a . cat a a }
category'Function :: CategoryI (->)
category'Function = CategoryI {
_compose = \f g x -> f (g x),
_id = \x -> x }
category'Isomorphism :: CategoryI Isomorphism
category'Isomorphism = CategoryI {
_compose = let (.) = _compose category'Function
in \(Isomorphism fw1 bw1)
(Isomorphism fw2 bw2) ->
Isomorphism (fw1 . fw2) (bw1 . bw2),
_id = let id = _id category'Function
in Isomorphism id id }
Now we can just combine isomorphisms using ordinary composition:
iso1 :: Isomorphism ((a, b), c) (a, (b, c))
iso1 = Isomorphism {
_fw = \((a, b), c) = (a, (b, c)),
_bw = \(a, (b, c)) = ((a, b), c) }
iso2 :: Isomorphism ((), a) a
_fw = \((), a) = a,
_bw = \a -> ((), a) }
(.) = _compose category'Function
iso1 . iso2 :: Isomorphism (((), b), c) (b, c)
... instead of attempting a bunch of type-class hackery that doesn't work. More importantly, we can now use our more featureful value-level programming tools to do what was incredibly difficult to do at the type level.
Class maintenance
One big issue in Haskell is maintaining class APIs. However, when we implement classes at the value level, this problem completely disappears.
For example, let's say that I realize in retrospect that my
Monad class needed to be split into two classes, one named
Pointed to hold
return and one named
Monad that has
Pointed as a superclass. If people use my
Monad class extensively, then I'd have to break all their
Monad instances if I split it into two separate classes because now they would have to spin off all of their
return implementations into separate instances for
Pointed.
Now, had I implemented it as a data type, it wouldn't even matter. I'd just write:
data PointedI m = PointedI { _pure :: forall a . a -> m a }
-- Pointed is a super-class of Monad
pointed'Super'Monad :: MonadI m -> PointedI m
pointed'Super'Monad i = PointedI (_return i}
Similarly, I can translate:
class (Pointed m) => Monad m where ...
... into:
monad'Pointed'Bind ::
PointedI m -> (m a -> (a -> m b) -> m b) -> MonadI m
monad'Pointed'Bind i b = MonadI (_pure i) b
Now users can automatically derive
Pointed instances from their old
Monad instances, or they can choose to write a
Pointed instance and then build a
Monad instance on top of it.
Backwards compatibility
Similarly, let's say that I forgot to make
Functor a superclass of
Monad. What's incredibly painful for the Haskell community to solve at the type-level is utterly straightforward to fix after-the-fact at the value level:
data FunctorI f = FunctorI {
_fmap :: forall a b . (a -> b) -> f a -> f b }
functor'Monad :: MonadI m -> FunctorI m
functor'Monad i = FunctorI { _fmap = \f x -> x >>= return . f }
where
(.) = _compose category'Function
(>>=) = _bind i
return = _return i
No more newtypes
Don't you hate having to wrap things using newtypes to get the correct class instance? Well, now that's unnecessary:
data MonoidI m = MonoidI {
_mempty :: m,
_mappend :: m -> m -> m }
monoidSum :: MonoidI Int
monoidSum = MonoidI {
_mempty = 0,
_mappend = (+) }
monoidProduct :: MonoidI Int
monoidProduct = MonoidI {
_mempty = 1,
_mappend = (*) }
mconcat :: MonoidI a -> [a] -> a
mconcat i = foldr (_mappend i) (_mempty i)
sum = mconcat monoidSum
product = mconcat monoidProduct
Now we're actually writing in a true functional style where
sum and
product are true functions of the instance, rather than fake functions of a class constraint using awkward newtypes.
Value-level programming is safer
Type classes are used most often for operator overloading. The dark side to this that your overloaded function will type-check on anything that is an instance of that class, including things you may not have intended it to type-check on.
For example, let's say I'm trying to write the following code using the ever-so-permissive
Binary class:
main = encodeFile "test.dat" (2, 3)
... but it's 3:00 in the morning and I make a mistake and instead type:
main = encodeFile "test.dat" (2, [3])
This type-checks and silently fails! However, had I explicitly passed the instance I wished to use, this would have raised a compile-time error:
binPair :: BinaryI a -> BinaryI b -> BinaryI (a, b)
binInt :: BinaryI Int
-- Won't compile!
main = encodeFile (binPair binInt binInt) "test.dat" (2, [3])
You might say, "Well, I don't want to have to annotate the type I'm using. I want it done automatically." However, this is the exact same argument made for forgiving languages like Perl or PHP were people advocate that in ambiguous situations the language or library should attempt to silently guess what you intended to do in instead of complaining loudly. This is exactly the antithesis of a strongly typed language!
Also, in the above case you would have had to annotate it anyway, because
Binary wouldn't have been able to infer the specific type of the numeric literals!
main = encodeFile "test.dat" (2 :: Int, 3, :: Int)
Or what if I wanted to implement two different ways to encode a list, one which was the naive encoding and one which used more efficient arrays for certain types:
-- Naive version
instance Binary a => Binary [a] where ...
-- Efficient array version
instance Binary [Int] where ...
Oops!
OverlappingInstances! I'd have to wrap one of them in a newtype, which take just as much effort to do as just passing the value instance:
binList :: BinaryI a -> BinaryI [a]
binInt :: BinaryI Int
main = encodeFile (binList binInt) "listInt.dat" [1..10]
If I was really clever, I could even write implement both instances using the same
binList function and then have it select whether to encode a list or array based on the sub-instance passed to it! That's not even possible using type-classes.
No type annotations
Here's another example of an incredibly awkward use of typeclasses:
class Storable a where
...
sizeOf :: a -> Int
Anybody who has ever had to use this knows how awkward it is when you don't have a value of type
a to provide it, which is common. You have to do this:
sizeOf (undefined :: a)
That's just horrible, especially when the solution with value-level instances is so simple in comparison:
data StorableI a = Storable {
...
_sizeOf :: Int }
storable'CInt = StorableI {
...
_sizeOf = 4 }
Now we'd just call:
_sizeOf storable'CInt
... instead of using
undefined as a hack.
In fact, with value-level instances, type annotations are never ever necessary. Instead of:
readInt :: String -> Int
readInt = read
... or:
read "4" :: Int
... we'd just use:
read read'Int "4"
In other words, the value-level instance is all the information the function needs, and it's guaranteed to be sound and catch incorrect instance errors at compile-time.
Powerful Approach
I wanted to demonstrate that this is a really industrial-strength replacement to type classes, so I took the
mtl's
StateT,
ReaderT, and
Identity and implemented them entirely in value-level instances. The code is provided in the Appendix of this post. This implementation allows you to straightforwardly translate:
test :: (MonadState a m, MonadReader a m) => m ()
test = ask >>= put
... into
test :: MonadStateI a m -> MonadReaderI a m -> m ()
test = \is ir -> let (>>=) = _bind (_monad'Super'MonadState is)
in (_ask ir) >>= (_put is)
You can then instantiate
test at the value level using any monad instances that implement the
State and
Reader capabilities and it generates the correct type and implementation:
example1 :: ReaderT a (StateT a Identity) ()
example1 = test
(monadState'ReaderT $ monadState'StateT $ monad'Identity)
(monadReader'ReaderT $ monad'StateT $ monad'Identity)
example2 :: StateT a (ReaderT a Identity) ()
example2 = test
(monadState'StateT $ monad'ReaderT $ monad'Identity)
(monadReader'StateT $ monadReader'ReaderT $ monad'Identity)
run1 = runIdentity $ runStateT (runReaderT example1 'A') 'B'
run2 = runIdentity $ runReaderT (runStateT example2 'B') 'A'
-- Both output ((), 'A')
Despite the incredible verbosity, it achieves two amazing things:
- It's implemented with only a single extension: Rank2Types. No UndecidableInstances required.
- No type signatures or type annotations are necessary. You can delete every single type signature in the file, which is completely self-contained, and the compiler infers every single type correctly. Try it!
More tricks
This is just scratching the surface. This post doesn't even really cover all the things that are only possible with value-level instances like:
- Generate lenses for instances (example: Lens (Binary [Int]) (Binary Int))
- Instances parametrized by run-time values
- Infinite families of instances (i.e. Stream (MyClassI m))
In other words, what I'm trying to say is that value-level instances are right now above us in the
"power spectrum" of Haskell programming and you don't really get a feel for how incredibly useful they are until you actually start using them.
Simplicity
Another feature about value-level instances is the conceptual simplicity and elegance. Before there is a type-class checker and a type-checker. Now there is just a type-checker. You don't really appreciate how great this is until you try it and start getting amazingly clear compiler errors. Programming without type-classes is very intuitive! Really, the hardest part about it is simply naming things!
Also, the fact that it's implementable purely using ordinary functional programming is a very big win. If anything, it would make the GHC compiler writer's jobs much easier by not requiring them to entertain any of the half-baked type-class extensions that people propose. This approach allows you to completely remove type-classes from the language. I'm just putting that out there.
Flaws
On that note, that brings me to the last section, where I will frankly discuss all the huge problems with it. The four biggest problems are:
- No ecosystem for it. To make effective use of it, you'd need new versions of most Haskell libraries.
- No do syntactic sugar. This one hurts.
- Verbosity. Every instance has to be named and passed around.
- Inertia. Programmers used to overloading will be reluctant to start specifying the instance they want.
The first issue is a huge problem and can only be solved if the community agrees this is actually a good idea. I'm only one person and that's about all my opinion counts for. All I can do is mention that more recent data types are already moving in this direction, with
Lens (from
data-lens) being the best example. Just imagine how impossible it would have been to implement
Lens as a class:
class Lens a b where
get :: a -> b
set :: b -> a -> a
It fails horrendously, for the exact same reason the
Isomorphism class crashes and burns. When implemented as a data type, it works completely flawlessly at the expense of extra verbosity. So if you liked
Lens, chances are you'll like value-level instances in general.
The second issue of syntactic sugar can be solved by something like
RebindableSyntax and having
do notation use whatever
(>>=) is in scope. You would then specify which
MonadI instance you use for each
do block:
let (>>=) = _bind m
in do ...
... or you pass the
MonadI instance as a parameter to the
do block.
This is not ideal, unfortunately and ties into the third issue of verbosity. All I can say is that the only way you can understand that the verbosity is "worth it" is if you try it out and see how much more powerful and easier it is than type-class programming. Also, value-level instances admit the exact same tricks to clean up code as normal parameter passing. For example, you can use
Reader (MonadI m) to avoid explicitly passing a monad instance around.
However, this still doesn't solve the problem of just coming up with names for the instances, which is uncomfortable until you get used to it and come up with a systematic nomenclature. This is a case where a more powerful name-spacing system would really help.
The last problem is the most insidious one, in my opinion, which is that we as Haskell programmers have been conditioned to believe that it is correct and normal to have operators change behavior silently when passed different arguments, which completely subverts type-safety. I'm going to conclude by saying that this is absolutely wrong and that the most important reason that you should adopt value-level instances is precisely because they are the type-safe approach to ad-hoc polymorphism.
Appendix
The following code implements
StateT,
ReaderT,
Identity,
MonadState, and
MonadReader from the
mtl, along with some example functions. The code is completely self-contained and can be loaded directly into
ghci. Every function is annotated with a comment showing how the
mtl implements the exact same class or instance so you have plenty of examples for how you would translate the type-class approach into the value-level instance approach.
{-# LANGUAGE Rank2Types #-}
newtype StateT s m a = StateT { runStateT :: s -> m (a, s) }
newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }
newtype Identity a = Identity { runIdentity :: a }
{- class Monad m where
return :: a -> m a
(>>=) :: m a -> (a -> m b) -> m b -}
data MonadI m = MonadI {
_return :: forall a . a -> m a,
_bind :: forall a b . m a -> (a -> m b) -> m b }
{- class MonadTrans t where
lift :: Monad m => m a -> t m a -}
data MonadTransI t = MonadTransI {
_lift :: forall a m . MonadI m -> m a -> t m a }
{- class Monad m => MonadState s m | m -> s where
get :: m s
put :: s -> m ()
state :: (s -> (a, s)) -> m a -}
data MonadStateI s m = MonadStateI {
-- This next line is the secret sauce
_monad'Super'MonadState :: MonadI m,
_put :: s -> m (),
_get :: m s,
_state :: forall a . (s -> (a, s)) -> m a }
{- class Monad m => Monadreader r m | m -> r where
ask :: m r
local :: (r -> r) -> m a -> m a
reader :: (r -> a) -> m a -}
data MonadReaderI r m = MonadReaderI {
_monad'Super'MonadReader :: MonadI m,
_ask :: m r,
_local :: forall a . (r -> r) -> m a -> m a,
_reader :: forall a . (r -> a) -> m a }
{- get :: (Monad m) => StateT s m s
get = StateT $ \s -> return (s, s) -}
get :: MonadI m -> StateT s m s
get i = StateT $ \s -> (_return i) (s, s)
{- put :: (Monad m) => s -> StateT s m ()
put s = StateT $ \_ -> return ((), s) -}
put :: MonadI m -> s -> StateT s m ()
put i s = StateT $ \_ -> (_return i) ((), s)
{- state :: (Monad m) => (s -> (a, s)) -> StateT s m a
state f = StateT (return . f) -}
state :: MonadI m -> (s -> (a, s)) -> StateT s m a
state i f = StateT ((_return i) . f)
{- ask :: (Monad m) => ReaderT r m r
ask = ReaderT return -}
ask :: MonadI m -> ReaderT r m r
ask i = ReaderT (_return i)
{- local :: (Monad m) =>
(r -> r) -> ReaderT r m a -> ReaderT r m a
local f m = ReaderT $ runReaderT m . f -}
local :: MonadI m -> (r -> r) -> ReaderT r m a -> ReaderT r m a
local _ f m = ReaderT $ runReaderT m . f
{- reader :: (Monad m) => (r -> a) -> ReaderT r m a
reader f = ReaderT (return . f) -}
reader :: MonadI m -> (r -> a) -> ReaderT r m a
reader i f = ReaderT ((_return i) . f)
{- instance Monad (Identity) where
return = Identity
m >>= k = k $ runIdentity m -}
monad'Identity :: MonadI Identity
monad'Identity = MonadI {
_return = Identity,
_bind = \m k -> k $ runIdentity m }
{- instance (Monad m) => Monad (StateT s m) where
return a = state $ \s -> (a, s)
m >>= k = StateT $ \s -> do
(a, s') <- runStateT m s
runStateT (k a) s' -}
monad'StateT :: MonadI m -> MonadI (StateT s m)
monad'StateT i =
let (>>=) = _bind i
in MonadI {
_return = \a -> state i $ \s -> (a, s),
_bind = \m k -> StateT $ \s ->
runStateT m s >>= \(a, s') ->
runStateT (k a) s' }
{- instance (Monad m) => Monad (ReaderT s m) where
return = lift . return
m >>= k = ReaderT $ \r -> do
a <- runReaderT m r
runReaderT (k a) r -}
monad'ReaderT :: MonadI m -> MonadI (ReaderT s m )
monad'ReaderT i =
let return = _return i
(>>=) = _bind i
lift = _lift monadTrans'ReaderT i
in MonadI {
_return = lift . (_return i),
_bind = \m k -> ReaderT $ \r ->
runReaderT m r >>= \a ->
runReaderT (k a) r }
{- instance MonadTrans StateT where
lift m = StateT $ \s -> do
a <- m
return (a, s) -}
monadTrans'StateT :: MonadTransI (StateT s)
monadTrans'StateT = MonadTransI {
_lift = \i m ->
let return = _return i
(>>=) = _bind i
in StateT $ \s ->
m >>= \a ->
return (a, s) }
{- instance MonadTrans ReaderT where
lift m = ReaderT (const m) -}
monadTrans'ReaderT :: MonadTransI (ReaderT r)
monadTrans'ReaderT = MonadTransI {
_lift = \_ m -> ReaderT (const m) }
{- instance (Monad m) => MonadState s (StateT s m) where
get = get -- from Control.Monad.Trans.State
put = put
state = state -}
monadState'StateT :: MonadI m -> MonadStateI s (StateT s m)
monadState'StateT i = MonadStateI {
_monad'Super'MonadState = monad'StateT i,
_get = get i,
_put = put i,
_state = state i }
{- instance (MonadState s m) => MonadState s (ReaderT r m) where
get = lift get
put = lift . put
state = lift . state -}
monadState'ReaderT ::
MonadStateI s m -> MonadStateI s (ReaderT r m)
monadState'ReaderT i =
let monad'm = _monad'Super'MonadState i
lift = _lift monadTrans'ReaderT monad'm
in MonadStateI {
_monad'Super'MonadState = monad'ReaderT monad'm,
_get = lift $ _get i,
_put = lift . _put i,
_state = lift . _state i }
{- instance Monad m => MonadReader r (ReaderT r m) where
ask = ask
local = local
reader = reader -}
monadReader'ReaderT :: MonadI m -> MonadReaderI r (ReaderT r m )
monadReader'ReaderT i = MonadReaderI {
_monad'Super'MonadReader = monad'ReaderT i,
_ask = ask i,
_local = local i,
_reader = reader i }
{- instance (MonadReader r m) => MonadReader r (StateT s m) where
ask = lift ask
local = \f m -> StateT $ local f . runStateT m
reader = lift . reader -}
monadReader'StateT ::
MonadReaderI r m -> MonadReaderI r (StateT s m)
monadReader'StateT i =
let monad'm = _monad'Super'MonadReader i
lift = _lift monadTrans'StateT monad'm
in MonadReaderI {
_monad'Super'MonadReader = monad'StateT monad'm,
_ask = lift $ _ask i,
_local = \f m -> StateT $ (_local i f) . runStateT m,
_reader = lift . (_reader i) }
{- test :: (MonadState a m, MonadReader a m) => m ()
test = ask >>= put -}
test :: MonadStateI a m -> MonadReaderI a m -> m ()
test = \is ir -> let (>>=) = _bind (_monad'Super'MonadState is)
in (_ask ir) >>= (_put is)
example1 :: ReaderT a (StateT a Identity) ()
example1 = test
(monadState'ReaderT $ monadState'StateT $ monad'Identity)
(monadReader'ReaderT $ monad'StateT $ monad'Identity)
example2 :: StateT a (ReaderT a Identity) ()
example2 = test
(monadState'StateT $ monad'ReaderT $ monad'Identity)
(monadReader'StateT $ monadReader'ReaderT $ monad'Identity)
run1, run2 :: ((), Char)
run1 = runIdentity $ runStateT (runReaderT example1 'A') 'B'
run2 = runIdentity $ runReaderT (runStateT example2 'B') 'A'