Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 166 lines (118 sloc) 5.52 kb
70ce5e3 @jaspervdj Add two blogposts
authored
1 ---
2 title: Type-safe events
3 description: Type-safe event-based programming in Haskell
095722b @jaspervdj Clean up tag usage a bit
authored
4 tags: haskell
70ce5e3 @jaspervdj Add two blogposts
authored
5 ---
6
7 This is some code I wrote a while ago. It is (mostly) based upon [Data Types a
8 la Carte], a great pearl by [Wouter Swierstra]. It uses some ideas discussed in
9 this paper to create a type-safe, extensible event-based framework in Haskell.
10
11 [Data Types a la Carte]: http://www.cs.ru.nl/~wouters/Talks/DutchHug2011.pdf
12 [Wouter Swierstra]: http://www.cs.ru.nl/~wouters/
13
14 This blogpost is written in Literate Haskell, meaning you should be able to
15 download and run it. It also means we're going to have some (relatively common)
16 language extentions and imports:
17
18 > {-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving,
19 > MultiParamTypeClasses, OverlappingInstances, TypeOperators #-}
20
21 > import Control.Applicative (Applicative)
22 > import Control.Monad.Reader (ReaderT, ask, runReaderT)
23 > import Control.Monad.Trans (MonadIO, liftIO)
24
25 An extensible sum type
26 ======================
27
28 The first job is to write an extensible sum type, which will be how we represent
29 events. Think of it as an extended
30
31 > data SumType = A | B | C
32
33 where we can add more constructors in different files, so it's somewhat more
34 flexible. The `Contains` a typeclass means that a value of type `s` optionally
35 contains a value of type `a`. We can `wrap` and `unwrap` this type:
36
37 > class Contains a s where
38 > wrap :: a -> s
39 > unwrap :: s -> Maybe a
40
41 Our main instance is a sum type combining two other types:
42
43 > data a :+: b = L a | R b
44 > deriving (Show)
45 > infixr 5 :+:
46
47 Later, we will chain this sum type to a list like:
48
49 > type SomeNumber = Int :+: Float :+: Double :+: Integer
50
51 We need instances of `Contains` so we can wrap and unwrap these lists:
52
53 > instance Contains a (a :+: b) where
54 > wrap = L
55 > unwrap (L x) = Just x
56 > unwrap _ = Nothing
57
58 > instance Contains b (a :+: b) where
59 > wrap = R
60 > unwrap (R x) = Just x
61 > unwrap _ = Nothing
62
63 > instance Contains a s => Contains a (b :+: s) where
64 > wrap = R . wrap
65 > unwrap (R x) = unwrap x
66 > unwrap _ = Nothing
67
68 An event-aware monad
69 ====================
70
71 Now, let's go back to our extensible, event-based framework. We'll assume all
72 clients of the framework can be implemented as a monad. We can abstract over
73 this monad, creating a typeclass for monads which can respond to an event of
74 type `e`:
75
76 > class (Functor m, Monad m) => MonadResponds e m where
77 > fire :: e -> m ()
78
79 As you probably guessed, the `fire` method fires an event. We implement an
80 instance which is a `ReaderT`. This way, the underlying monad can access a
81 function which triggers an event:
82
83 > newtype RespondsT e m a = RespondsT
84 > { unRespondsT :: ReaderT (e -> RespondsT e m ()) m a
85 > } deriving (Applicative, Functor, Monad, MonadIO)
86
87 > runRespondsT :: RespondsT e m a -> (e -> RespondsT e m ()) -> m a
88 > runRespondsT (RespondsT r) e = runReaderT r e
89
90 By using this trigger, our `RespondsT` becomes an instance of `MonadResponds`.
91
92 > instance (Contains e s, Functor m, Monad m) =>
93 > MonadResponds e (RespondsT s m) where
94 > fire x = RespondsT $ ask >>= unRespondsT . ($ wrap x)
95
96 Now, all we need in order to write clients is some more syntactic sugar:
97
98 > client :: (Monad m, Contains e s) => (e -> m ()) -> s -> m ()
99 > client f = maybe (return ()) f . unwrap
100
101 A logging client
102 ================
103
104 Let's start out by implementing a very simple logger as client for the
105 framework:
106
107 > data Log = Warn String | Info String
108
109 > logger :: (MonadIO m, Contains Log s) => s -> m ()
110 > logger = client $ \event -> liftIO $ putStrLn $ case event of
111 > Warn s -> "[Warn]: " ++ s
112 > Info s -> "[Info]: " ++ s
113
114 A ping client
115 =============
116
117 The logging client received events using `client`... let's see how we can
118 actually send events by writing an artificial ping-pong protocol. This client
119 uses features from the logger, so we can really compose clients by just listing
120 the required instances in the type signature (as is commonly done with monad
121 transformers), which is a pretty cool thing.
122
123 > data Ping = Ping Int | Pong Int
124
125 > ping :: (Contains Log s, Contains Ping s,
126 > MonadResponds Log m, MonadResponds Ping m)
127 > => s -> m ()
128 > ping = client $ \event -> case event of
129 > Ping x -> fire (Pong x)
130 > Pong x -> fire (Info $ "Received pong with token " ++ show x)
131
132 Actually running it
133 ===================
134
135 If you've followed this blogpost until now, you probably want to see how we can,
136 in the end, combine a number of clients and run them.
137
138 To this end, we'll write a small utility function which combines a number of
139 handlers (our clients) by sequentially applying them to the same event).
140
141 > combine :: Monad m => [e -> m ()] -> e -> m ()
142 > combine handlers event = mapM_ ($ event) handlers
143
144 Now, let's use this to compose our clients. At this point, we're required to fix
145 the type for our client:
146
147 > type Features = Log :+: Ping
148
149 > testClient :: Features -> RespondsT Features IO ()
150 > testClient = combine [logger, ping]
151
152 And then we can write a program which uses these features:
153
154 > test :: RespondsT Features IO ()
155 > test = do
156 > fire $ Warn "Starting the engines!"
157 > fire $ Ping 100
158 > fire $ Info "Engines has been started."
159 > fire $ Ping 200
160
161 > main :: IO ()
162 > main = runRespondsT test testClient
163
164 I hope you've enjoyed this blogpost -- all criticism is welcome. If someone
165 feels like turning this into a proper library, you're also welcome.
Something went wrong with that request. Please try again.