Type-safe events



Published on October 16, 2011 under the tag Type-safe event-based programming in HaskellPublished on October 16, 2011 under the tag haskell

This is some code I wrote a while ago. It is (mostly) based upon Data Types a la Carte, a great pearl by Wouter Swierstra. It uses some ideas discussed in this paper to create a type-safe, extensible event-based framework in Haskell.

This blogpost is written in Literate Haskell, meaning you should be able to download and run it. It also means we’re going to have some (relatively common) language extentions and imports:

{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, OverlappingInstances, TypeOperators #-}

import Control.Applicative ( Applicative ) import Control.Monad.Reader ( ReaderT , ask, runReaderT) , ask, runReaderT) import Control.Monad.Trans ( MonadIO , liftIO) , liftIO)

An extensible sum type

The first job is to write an extensible sum type, which will be how we represent events. Think of it as an extended

data SumType = A | B | C

where we can add more constructors in different files, so it’s somewhat more flexible. The Contains a typeclass means that a value of type s optionally contains a value of type a . We can wrap and unwrap this type:

class Contains a s where a s wrap :: a -> s unwrap :: s -> Maybe a

Our main instance is a sum type combining two other types:

data a :+: b = L a | R b deriving ( Show ) infixr 5 :+:

Later, we will chain this sum type to a list like:

type SomeNumber = Int :+: Float :+: Double :+: Integer

We need instances of Contains so we can wrap and unwrap these lists:

instance Contains a (a :+: b) where a (ab) = L wrap L x) = Just x unwrap (x) = Nothing unwrap _

instance Contains b (a :+: b) where b (ab) = R wrap R x) = Just x unwrap (x) = Nothing unwrap _

instance Contains a s => Contains a (b :+: s) where a sa (bs) = R . wrap wrapwrap R x) = unwrap x unwrap (x)unwrap x = Nothing unwrap _

An event-aware monad

Now, let’s go back to our extensible, event-based framework. We’ll assume all clients of the framework can be implemented as a monad. We can abstract over this monad, creating a typeclass for monads which can respond to an event of type e :

class ( Functor m, Monad m) => MonadResponds e m where m,m)e m fire :: e -> m () m ()

As you probably guessed, the fire method fires an event. We implement an instance which is a ReaderT . This way, the underlying monad can access a function which triggers an event:

newtype RespondsT e m a = RespondsT e m a { unRespondsT :: ReaderT (e -> RespondsT e m ()) m a (ee m ()) m a } deriving ( Applicative , Functor , Monad , MonadIO )

runRespondsT :: RespondsT e m a -> (e -> RespondsT e m ()) -> m a e m a(ee m ())m a RespondsT r) e = runReaderT r e runRespondsT (r) erunReaderT r e

By using this trigger, our RespondsT becomes an instance of MonadResponds .

instance ( Contains e s, Functor m, Monad m) => e s,m,m) MonadResponds e ( RespondsT s m) where e (s m) = RespondsT $ ask >>= unRespondsT . ( $ wrap x) fire xaskunRespondsTwrap x)

Now, all we need in order to write clients is some more syntactic sugar:

client :: ( Monad m, Contains e s) => (e -> m ()) -> s -> m () m,e s)(em ())m () = maybe ( return ()) f . unwrap client f()) funwrap

A logging client

Let’s start out by implementing a very simple logger as client for the framework:

data Log = Warn String | Info String

logger :: ( MonadIO m, Contains Log s) => s -> m () m,s)m () = client $ \event -> liftIO $ putStrLn $ case event of loggerclient\eventliftIOevent Warn s -> "[Warn]: " ++ s Info s -> "[Info]: " ++ s

A ping client

The logging client received events using client … let’s see how we can actually send events by writing an artificial ping-pong protocol. This client uses features from the logger, so we can really compose clients by just listing the required instances in the type signature (as is commonly done with monad transformers), which is a pretty cool thing.

data Ping = Ping Int | Pong Int

ping :: ( Contains Log s, Contains Ping s, s,s, MonadResponds Log m, MonadResponds Ping m) m,m) => s -> m () m () = client $ \event -> case event of pingclient\eventevent Ping x -> fire ( Pong x) fire (x) Pong x -> fire ( Info $ "Received pong with token " ++ show x) fire (x)

Actually running it

If you’ve followed this blogpost until now, you probably want to see how we can, in the end, combine a number of clients and run them.

To this end, we’ll write a small utility function which combines a number of handlers (our clients) by sequentially applying them to the same event).

combine :: Monad m => [e -> m ()] -> e -> m () [em ()]m () = mapM_ ( $ event) handlers combine handlers eventevent) handlers

Now, let’s use this to compose our clients. At this point, we’re required to fix the type for our client:

type Features = Log :+: Ping

testClient :: Features -> RespondsT Features IO () () = combine [logger, ping] testClientcombine [logger, ping]

And then we can write a program which uses these features:

test :: RespondsT Features IO () () = do test $ Warn "Starting the engines!" fire $ Ping 100 fire $ Info "Engines has been started." fire $ Ping 200 fire

main :: IO () () = runRespondsT test testClient mainrunRespondsT test testClient

I hope you’ve enjoyed this blogpost – all criticism is welcome. If someone feels like turning this into a proper library, you’re also welcome.