-
Notifications
You must be signed in to change notification settings - Fork 1
/
2013-01-27-automata.tex.html
467 lines (453 loc) · 53.7 KB
/
2013-01-27-automata.tex.html
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
<title>Qnikst blog - Dynamic event handling model using Arrows</title>
<!-- Bootstrap -->
<link href="../css/bootstrap.min.css" rel="stylesheet" media="screen">
<link href="../css/additional.css" rel="stylesheet" media="screen">
<style>
body {
padding-top: 60px; /* 60px to make the container go all the way to the bottom of the topbar */
}
</style>
<script src="http://code.jquery.com/jquery-latest.js"></script>
<script src="../js/bootstrap.min.js"></script>
</head>
<body>
<div class="navbar navbar-fixed-top navbar-inverse">
<div class="navbar-inner">
<a class="brand" href="../">Qnikst blog</a>
<ul class="nav ">
<li class="active"><a href="../">Home</a></li>
<li><a href="../posts.html">Blog</a></li>
<li><a href="../projects.html">Projects</a></li>
<li><a href="../contact.html">Contacts</a></li>
<li><a href="../rss.xml">RSS</a></li>
</ul>
</div>
</div>
<div class="container">
<div class="page-header">
<h1>Dynamic event handling model using Arrows <br /><small><strong>January 27, 2013</strong></small></h1>
</div>
<p>This post describes simple approach to dynamic event handling that gives a way to write complex event handlers with feedback in a natural way. This approach is interesting as a first step to create a complex FRP system, but it is sufficient for simple tasks.</p>
<h1 class="unnumbered">Preface</h1>
<p>About a half year ago I had the following task: I should run a list of event listeners on a wire and on each handled event listeners may change their behaviour (i.e. start listening for another event, produce new event listeners or send requests on the wire). It sounds like a FRP task and once you are familar with FRP this post may be not so interesting to you, except you may try to help me to generalize all the logic.</p>
<p>I tried to use monadic approach, however I had too much problems because monads can bind and run opaque functions while all these computation had to carry additional information. So I ended up with the functional approach: each function returns a command and the next function with help of some special runner changes it’s state based on this information but as a result I faced some problems: functions were bloated, they should be written in reversed order, all additional variables should be passed explicitly from function to function and those function can’t be composed as they had types constraints. It was a hell.. Few days ago I have read the great <a href="http://ertes.de/new/tutorials/arrows.html">arrows tutorial</a> by Ertugrul Söylemez and realized that the construction I had was an arrow and after some thinking I’ve found a nice solution.</p>
<h1>The problem</h1>
<p>This post is a literate haskell post so you can copy and run it in ghci. So at first we will add some imports:</p>
<p>We need this for defining new arrow instance.</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> <span class="ot">{-# LANGUAGE Arrows #-}</span>
<span class="ot">></span> <span class="kw">import</span> Prelude <span class="kw">hiding</span> ((.), id)
<span class="ot">></span> <span class="kw">import</span> Control.Arrow
<span class="ot">></span> <span class="kw">import</span> Control.Category</code></pre>
<p>The following imports are used to define External world.</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> <span class="kw">import</span> Control.Applicative
<span class="ot">></span> <span class="kw">import</span> Control.Monad
<span class="ot">></span> <span class="kw">import</span> Control.Concurrent.STM
<span class="ot">></span> <span class="kw">import</span> Control.Concurrent
<span class="ot">></span> <span class="kw">import</span> Control.Exception
<span class="ot">></span> <span class="kw">import</span> Data.Monoid</code></pre>
<p>Let’s assume that we have an External interface, this means some asynchonous interface to external system that have a simple API:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> <span class="kw">data</span> <span class="dt">External</span> a b <span class="fu">=</span> <span class="dt">External</span>
<span class="ot">></span> {<span class="ot"> input ::</span> a <span class="ot">-></span> <span class="dt">IO</span> () <span class="co">-- ^ write to a wire</span>
<span class="ot">></span> ,<span class="ot"> output ::</span> <span class="dt">IO</span> b <span class="co">-- ^ read from a wire</span>
<span class="ot">></span> }</code></pre>
<p>This interface has the following properties:</p>
<ul>
<li><p>we may write requests and interface will asynchonously answer</p></li>
<li><p>interface may generate events on it’s own.</p></li>
</ul>
<p>We want to be able to write event handlers that will catch events that are needed, request a wire and get responses. So we want to be able to</p>
<ol>
<li><p>catch events that we need</p></li>
<li><p>request a wire</p></li>
<li><p>carry a local variables</p></li>
<li><p>have if-branches</p></li>
<li><p>have a possibility to write all above in a natural way</p></li>
</ol>
<p>It means that we want to be able to write a handlers like:</p>
<pre><code>desiredHandler = do
e <- catchEvent -- 1
let val = ... -- 3
resp <- request req -- 2
if f resp
then monadic1ThatUsesVal
else monadic2ThatUsesVal</code></pre>
<p>In the main part of this article we will ignore 1 and it will be shown later that we don’t loose generality. So now we assume that we match any event. Also we will use just one event handler instead of multiple handlers and as it was said above we doesn’t loose any generality.</p>
<p>Without items 4 and 5, we may just use a function (F:: (c -> Either (b,F) d) that returns either a next step or a result. There are a several problems with this aproach all of which lead to the point that these functions do not form a monad. That’s because monad is a sequential computation that can lift opaque function into it while we should have a computation that can access it’s state. The solution is to write a category and arrow instances for our datatype.</p>
<p>In the second section of this post we will set up our world and write our datatype, in In the section 3 we will write a request-reply functionality for the wire and set up instances we need. In the section 4 we will take a look at events and write helpers. Section 5 describes how to run multiple handlers in parrallel and some words about parallelization.</p>
<h1>External world</h1>
<p>At first we need to write an External instance that we will use in our program. We will use 2 STM channels one for requests another for responses and events:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> initialize ::</span> <span class="dt">IO</span> (<span class="dt">External</span> a b, (<span class="dt">TChan</span> a, <span class="dt">TChan</span> b))
<span class="ot">></span> initialize <span class="fu">=</span> <span class="kw">do</span>
<span class="ot">></span> i <span class="ot"><-</span> newTChanIO
<span class="ot">></span> o <span class="ot"><-</span> newTChanIO
<span class="ot">></span> return (<span class="dt">External</span> { input <span class="fu">=</span> atomically <span class="fu">.</span> (writeTChan i)
<span class="ot">></span> , output <span class="fu">=</span> atomically <span class="fu">.</span> readTChan <span class="fu">$</span> o}, (i, o))</code></pre>
<p>At this moment we again doesn’t loose any generality as we always can write such a wrapper for any type of IO communication. (TODO examples?).</p>
<p>To emulate external system responses we will use a generator: a function that generates request for response given to it:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> <span class="kw">type</span> <span class="dt">Generator</span> a b <span class="fu">=</span> <span class="dt">TChan</span> a <span class="ot">-></span> <span class="dt">TChan</span> b <span class="ot">-></span> <span class="dt">IO</span> ()
<span class="ot">></span>
<span class="ot">> idGenerator ::</span> <span class="dt">Generator</span> a a
<span class="ot">></span> idGenerator <span class="fu">=</span> fGenerator id
<span class="ot">> fGenerator ::</span> (a <span class="ot">-></span> b) <span class="ot">-></span> <span class="dt">Generator</span> a b
<span class="ot">></span> fGenerator f ic oc <span class="fu">=</span> forever <span class="fu">.</span> atomically <span class="fu">$</span> readTChan ic <span class="fu">>>=</span> writeTChan oc <span class="fu">.</span> f</code></pre>
<p>Now we can provide an environment function for our experiments, note that because our logic is bus driven we need to pass first value for initialization.</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> experiment' f g i (e, c<span class="fu">@</span>(in_,out_)) <span class="fu">=</span>
<span class="ot">></span> bracket (forkIO <span class="fu">$</span> atomically (writeTChan in_ i) <span class="fu">>></span> uncurry g c)
<span class="ot">></span> killThread
<span class="ot">></span> (const <span class="fu">$</span> f e)
<span class="ot">></span> experiment f g i <span class="fu">=</span> initialize <span class="fu">>>=</span> experiment' f g i</code></pre>
<h2>Request-Reply</h2>
<p>Now we can construct our datatypes.</p>
<p>We need to define finite automata that can either finish it’s computation or return its next state. Let’s write type for it:</p>
<ol>
<li><p>it will be a newtype (let’s name Auto 2) that has some step function</p>
<p>newtype Auto2 <..> = Auto2 stepAuto :: <..></p></li>
<li><p>as it’s an automaton it should get an input value of type ’a’ and return either a new value ’b’ or a new computation:</p>
<p>newtype Auto2 <..> a b = Auto2 stepAuto :: a -> Either <..> b</p></li>
<li><p>we need to pass information about external bus through all computations, so we can request it on any level. Note that we types of request and response do not change during computation:</p>
<p>newtype Auto2 i o a b = Auto2 stepAuto :: a -> Either (o, <..>) b</p></li>
<li><p>final note is that if we return a request and an automaton that we need to run than it’s type is bound by request/responce types: Auto i o i b.</p></li>
</ol>
<p>So finally we get:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> <span class="kw">newtype</span> <span class="dt">Auto2</span> i o a b <span class="fu">=</span> <span class="dt">Auto2</span> {<span class="ot"> stepAuto ::</span> a <span class="ot">-></span> <span class="dt">Either</span> (o, <span class="dt">Auto2</span> i o i b) b}</code></pre>
<p>As our datatype is a computation and not a function we need to write explicit runner for it.</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> runner ::</span> (<span class="dt">Show</span> i, <span class="dt">Show</span> o, <span class="dt">Show</span> b) <span class="ot">=></span> <span class="dt">External</span> o i <span class="ot">-></span> <span class="dt">Auto2</span> i o i b <span class="ot">-></span> <span class="dt">IO</span> b
<span class="ot">></span> runner ext auto <span class="fu">=</span> <span class="kw">do</span>
<span class="ot">></span> x <span class="ot"><-</span> output ext
<span class="ot">></span> putStr <span class="fu">$</span> <span class="st">"received: "</span> <span class="fu">++</span> show x
<span class="ot">></span> <span class="kw">let</span> ret <span class="fu">=</span> stepAuto auto x
<span class="ot">></span> <span class="kw">case</span> ret <span class="kw">of</span>
<span class="ot">></span> <span class="dt">Left</span> (req, next) <span class="ot">-></span> <span class="kw">do</span>
<span class="ot">></span> putStrLn <span class="fu">$</span> <span class="st">" requesting: "</span> <span class="fu">++</span> show req
<span class="ot">></span> input ext req
<span class="ot">></span> runner ext next
<span class="ot">></span> <span class="dt">Right</span> ok <span class="ot">-></span> putStrLn (<span class="st">" result: "</span> <span class="fu">++</span> show ok) <span class="fu">>></span> return ok
<span class="ot">></span> run f g <span class="fu">=</span> runner g f</code></pre>
<p>This is a very basic function that receives new signals from wire, and feeds them in into our computation and then either continues or finishes.</p>
<p>Let’s demonstate how it work:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> upTo ::</span> <span class="dt">Int</span> <span class="ot">-></span> (<span class="dt">Int</span> <span class="ot">-></span> <span class="dt">Int</span>) <span class="ot">-></span> <span class="dt">Auto2</span> <span class="dt">Int</span> <span class="dt">Int</span> <span class="dt">Int</span> <span class="dt">Int</span>
<span class="ot">></span> upTo n f <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \x <span class="ot">-></span> <span class="kw">if</span> x <span class="fu">>=</span> n
<span class="ot">></span> <span class="kw">then</span> <span class="dt">Right</span> <span class="fu">$</span> f x
<span class="ot">></span> <span class="kw">else</span> <span class="dt">Left</span> ((x<span class="fu">+</span><span class="dv">1</span>), upTo n f)</code></pre>
<p>This function will request recursively a new value while it is less than first param. Here is an output:</p>
<pre><code>*Main> experiment (run (upTo 2 (*2))) (idGenerator) 0
received: 0 requesting: 1
received: 1 requesting: 2
received: 2 result: 4
4</code></pre>
<p>So far so good but I’d like not to write requests explicitly rather to use some ’request’ function:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> request ::</span> o <span class="ot">-></span> <span class="dt">Auto2</span> i o a i
<span class="ot">></span> request req <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \_ <span class="ot">-></span> <span class="dt">Left</span> (req, <span class="dt">Auto2</span> <span class="fu">$</span> \y <span class="ot">-></span> <span class="dt">Right</span> y)</code></pre>
<pre><code>*Main> run (run (request 5)) idGenerator 0
input: 0 requesting: 5
input: 5 result: 5
5</code></pre>
<p>One thing is bad: we need an input to request a state and that input will be ignored. It seems that it’s not a problem and will never hit user however I have no strong explanation.</p>
<p>Now we need a way to compose such computations. That’s not a problem because these computations form a Category so we just need to write an instance of this typeclass:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> <span class="kw">instance</span> <span class="dt">Category</span> (<span class="dt">Auto2</span> i o) <span class="kw">where</span>
<span class="ot">></span> id <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \x <span class="ot">-></span> <span class="dt">Right</span> x
<span class="ot">></span> auto2 <span class="fu">.</span> auto1 <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \x <span class="ot">-></span>
<span class="ot">></span> <span class="kw">let</span> out1 <span class="fu">=</span> stepAuto auto1 x
<span class="ot">></span> <span class="kw">in</span> <span class="kw">case</span> out1 <span class="kw">of</span>
<span class="ot">></span> <span class="dt">Right</span> b <span class="ot">-></span> stepAuto auto2 b
<span class="ot">></span> <span class="dt">Left</span> (o,auto1') <span class="ot">-></span> <span class="dt">Left</span> (o, (auto2 <span class="fu">.</span> auto1'))</code></pre>
<p><code>id</code> just returns a result and has no side effects. Composition <code>(.)</code> will run internal computation and if succeeded it will start the outer one, otherwise it will continue to run new inner automaton until it succeeds. Sidenote: there was a different composition behavior in Ertugrul‘s article, composition there nests one arrow inside another.</p>
<p>At this point we do not gain many advantages as we have only composition of automata, and will have problems once we leave the types pipeline.</p>
<p>Now we’ll define an arrow instance so we will be able to lift opaque functions on the Automaton level and create side channels to carry values alongside with computation (instead of let bindings in monad form that are visible downside the binding):</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> <span class="kw">instance</span> <span class="dt">Arrow</span> (<span class="dt">Auto2</span> i o) <span class="kw">where</span>
<span class="ot">></span> arr f <span class="fu">=</span> <span class="dt">Auto2</span> (\x <span class="ot">-></span> <span class="dt">Right</span> (f x))
<span class="ot">></span> first (<span class="dt">Auto2</span> f) <span class="fu">=</span> <span class="dt">Auto2</span> (\(x, y) <span class="ot">-></span> zrec (\z <span class="ot">-></span> (z,y)) (f x))</code></pre>
<p><code>arr</code> just lifts pure function to Automaton level, and <code>first</code> runs recursive automaton and stores result in the first channel, leaving second unchanged. Now we have a straightforward way of saving results alongside computation.</p>
<p>We define helper function that will recourse over automation and apply a function to the final result:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> zrec g (<span class="dt">Right</span> x) <span class="fu">=</span> <span class="dt">Right</span> <span class="fu">$</span> g x
<span class="ot">></span> zrec g (<span class="dt">Left</span> (o, <span class="dt">Auto2</span> f)) <span class="fu">=</span> <span class="dt">Left</span> (o, <span class="dt">Auto2</span> <span class="fu">$</span> \x <span class="ot">-></span> zrec g (f x))</code></pre>
<p>Small demonstration:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> test1 <span class="fu">=</span> request <span class="dv">5</span> <span class="fu">>>></span>
<span class="ot">></span> arr (\x <span class="ot">-></span> (x,x)) <span class="fu">>>></span>
<span class="ot">></span> first (request <span class="dv">6</span>) <span class="fu">>>></span>
<span class="ot">></span> arr (\(x,y) <span class="ot">-></span> x<span class="fu">+</span>y)</code></pre>
<pre><code>*Main> experiment (runr (test1)) (idGenerator 0)
input: 0 requesting: 5
input: 5 requesting: 6
input: 6 result: 11
11</code></pre>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> test2 <span class="fu">=</span> arr (\x <span class="ot">-></span> ((),x)) <span class="fu">>>></span>
<span class="ot">></span> first (request <span class="dv">4</span>) <span class="fu">>>></span>
<span class="ot">></span> arr (\(x,y) <span class="ot">-></span> <span class="kw">if</span> y<span class="fu">></span><span class="dv">5</span> <span class="kw">then</span> x<span class="fu">+</span>y <span class="kw">else</span> x<span class="fu">-</span>y)</code></pre>
<pre><code>*Main> experiment (run test2) idGenerator 6
input: 6 requesting: 4
input: 4 result: 10
10
*Main> experiment (run test2) idGenerator 4
input: 4 requesting: 4
input: 4 result: 0
0</code></pre>
<p>As was said earlier <code>request</code> is not a problem as we can feed it with our internal value.</p>
<p>At this moment we are able to carry intermediate values and now we need to define a way to use "if" condition. Using an arrow gives us only a channels abstraction, so we need to use a "conditional" value in channels and Either is a good candidate for it. We will not reinvent a wheel and just use an instance that we have already created:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> <span class="kw">instance</span> <span class="dt">ArrowChoice</span> (<span class="dt">Auto2</span> i o) <span class="kw">where</span>
<span class="ot">></span> <span class="co">-- left :: a b c -> a (Either b d) (Either c d)</span>
<span class="ot">></span> left (<span class="dt">Auto2</span> f) <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \x <span class="ot">-></span>
<span class="ot">></span> <span class="kw">case</span> x <span class="kw">of</span>
<span class="ot">></span> <span class="dt">Left</span> b <span class="ot">-></span> zrec <span class="dt">Left</span> (f b)
<span class="ot">></span> <span class="dt">Right</span> d <span class="ot">-></span> <span class="dt">Right</span> (<span class="dt">Right</span> d)</code></pre>
<p>Here <code>left</code> takes <code>Either a b</code> value, and if it‘s <code>Left</code> then it runs a recursive computation and stores result in <code>Left</code>. Otherwise <code>Right d</code> is returned.</p>
<p>Now we have a way to split channel into left and right parts.</p>
<p>Small demonstration:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> test3 ::</span> <span class="dt">Auto2</span> <span class="dt">Int</span> <span class="dt">Int</span> <span class="dt">Int</span> <span class="dt">Int</span>
<span class="ot">></span> test3 <span class="fu">=</span> arr (\y <span class="ot">-></span> <span class="kw">if</span> y <span class="fu">></span> <span class="dv">5</span> <span class="kw">then</span> <span class="dt">Left</span> y <span class="kw">else</span> <span class="dt">Right</span> y) <span class="fu">>>></span>
<span class="ot">></span> left (request <span class="dv">3</span>) <span class="fu">>>></span>
<span class="ot">></span> right (request <span class="dv">7</span>) <span class="fu">>>></span>
<span class="ot">></span> arr (\x <span class="ot">-></span> <span class="kw">case</span> x <span class="kw">of</span>
<span class="ot">></span> <span class="dt">Left</span> x <span class="ot">-></span> x
<span class="ot">></span> <span class="dt">Right</span> y <span class="ot">-></span> y)</code></pre>
<pre><code>*Main> experiment (run test3) idGenerator 1
input: 1 requesting: 7
input: 7 result: 7
7
*Main> experiment (run test3) idGenerator 6
input: 6 requesting: 3
input: 3 result: 3
3</code></pre>
<p>The only problem that it’s not very easy to write in such style, that’s where arrow notation can help:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> test4 <span class="fu">=</span> proc x <span class="ot">-></span> <span class="kw">do</span>
<span class="ot">></span> <span class="kw">if</span> x <span class="fu">></span> <span class="dv">5</span>
<span class="ot">></span> <span class="kw">then</span> request <span class="dv">0</span> <span class="fu">-<</span> ()
<span class="ot">></span> <span class="kw">else</span> request <span class="dv">10</span> <span class="fu">-<</span> ()</code></pre>
<pre><code>*Main> run (runner (test4)) idGenerator 6
input: 6 requesting: 0
input: 0 result: 0
0
*Main> run (runner (test4)) idGenerator 1
input: 1 requesting: 10
input: 10 result: 10
10</code></pre>
<p>Thats all and that’s really awesome: no more explicit function carrying, explicit RW-bus communication that is implicilty coupled with all control flow.</p>
<h1>Event handling</h1>
<p>Now let’s generalize our approach. First we need to be able to catch only events we are interested in. We may take a couple of approaches:</p>
<ol>
<li><p>additional data method</p></li>
<li><p>api extension</p></li>
</ol>
<h2>Additional method</h2>
<p>We can rewrite our automaton type to</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> <span class="kw">data</span> <span class="dt">Auto3</span> i o a b <span class="fu">=</span> <span class="dt">Auto3</span> {
<span class="ot">> checkAuto ::</span> i <span class="ot">-></span> <span class="dt">Bool</span>
<span class="ot">></span> ,<span class="ot"> runAuto ::</span> i <span class="ot">-></span> <span class="dt">Either</span> (o, <span class="dt">Auto3</span> i o i b) b
<span class="ot">></span> }</code></pre>
<p>In this approach we do not need to run computation to check if its input matches a predicate. But it will lead us to some amount of rewriting, so we will not do it unless it’s really needed.</p>
<h3>Event API</h3>
<p>To describe a list of event we will write a list generator:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> listGenerator ::</span> [b] <span class="ot">-></span> <span class="dt">Generator</span> a b
<span class="ot">></span> listGenerator ls ic oc <span class="fu">=</span> mapM_ (atomically <span class="fu">.</span> (writeTChan oc)) ls</code></pre>
<p>The idea for this approach is to add a predicate that will try to convert an input into the input we need, possibly validating it. (Really we can just use a predicate and then convert a value into another one)</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> <span class="kw">type</span> <span class="dt">ConvPred</span> i j <span class="fu">=</span> (i <span class="ot">-></span> <span class="dt">Maybe</span> j)
<span class="ot">> idConv ::</span> (a <span class="ot">-></span> <span class="dt">Bool</span>) <span class="ot">-></span> <span class="dt">ConvPred</span> a a
<span class="ot">></span> idConv p <span class="fu">=</span> \i <span class="ot">-></span> <span class="kw">if</span> (p i) <span class="kw">then</span> <span class="dt">Just</span> i <span class="kw">else</span> <span class="dt">Nothing</span></code></pre>
<p>In order to use an API exension we should restrict our output datatype to the type that supports 0 (<code>zero</code>) a value that means nothing in this type. We need it because if value doesn’t math predicate we should perform a "noop" and wait for next value, keeping automation unchanged, so we will introduce a type class:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> <span class="kw">class</span> <span class="dt">Zero</span> a <span class="kw">where</span><span class="ot"> zero ::</span> a
<span class="ot">></span> <span class="kw">instance</span> <span class="dt">Zero</span> (<span class="dt">Maybe</span> a) <span class="kw">where</span> zero <span class="fu">=</span> <span class="dt">Nothing</span>
<span class="ot">></span> <span class="kw">instance</span> <span class="dt">Zero</span> [a] <span class="kw">where</span> zero <span class="fu">=</span> []</code></pre>
<p>We are not using <code>Monoid</code> because we do not require <code>mappend</code> operation.</p>
<p>Now we can define an event listening arrow, the only problem is that we should feed our arrow with a value to make it run:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> event ::</span> (<span class="dt">Zero</span> o) <span class="ot">=></span> <span class="dt">Auto2</span> i o i i <span class="ot">-></span> <span class="dt">Auto2</span> i o i i
<span class="ot">></span> event a <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \_ <span class="ot">-></span> <span class="dt">Left</span> (zero, a)</code></pre>
<p>First version of matcher:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> matchE ::</span> (<span class="dt">Zero</span> o) <span class="ot">=></span> (<span class="dt">ConvPred</span> i a) <span class="ot">-></span> <span class="dt">Auto2</span> i o a b <span class="ot">-></span> <span class="dt">Auto2</span> i o i b
<span class="ot">></span> matchE p a<span class="fu">@</span>(<span class="dt">Auto2</span> f) <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \x <span class="ot">-></span>
<span class="ot">></span> <span class="kw">case</span> p x <span class="kw">of</span>
<span class="ot">></span> <span class="dt">Nothing</span> <span class="ot">-></span> <span class="dt">Left</span> (zero, matchE p a)
<span class="ot">></span> <span class="dt">Just</span> y <span class="ot">-></span> zrec id (f y)</code></pre>
<p>Correct version of matcher</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> match ::</span> (<span class="dt">Zero</span> o) <span class="ot">=></span> (<span class="dt">ConvPred</span> i b) <span class="ot">-></span> <span class="dt">Auto2</span> i o i b
<span class="ot">></span> match p <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> maybe (<span class="dt">Left</span> (zero, match p)) <span class="dt">Right</span> <span class="fu">.</span> p</code></pre>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> test6 <span class="fu">=</span> experiment (run <span class="fu">$</span> match (idConv (<span class="fu">></span><span class="dv">5</span>)) <span class="fu">>>></span> id)
<span class="ot">></span> (listGenerator [<span class="dv">1</span><span class="fu">..</span><span class="dv">10</span>]) (<span class="dt">Just</span> <span class="dv">4</span>)</code></pre>
<pre><code>*Main> test6
received: 1 requesting: Nothing
received: 2 requesting: Nothing
received: 3 requesting: Nothing
received: 4 requesting: Nothing
received: 5 requesting: Nothing
received: 6 result: 6
6</code></pre>
<p>Now we will write some helpers. The easiest one is matchAny:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> matchAny ::</span> (<span class="dt">Zero</span> o) <span class="ot">=></span> [<span class="dt">ConvPred</span> i a] <span class="ot">-></span> <span class="dt">Auto2</span> i o a b <span class="ot">-></span> <span class="dt">Auto2</span> i o i b
<span class="ot">></span> matchAny ps a <span class="fu">=</span> matchE (\i <span class="ot">-></span> foldl (\o p <span class="ot">-></span> o <span class="fu"><|></span> p i) <span class="dt">Nothing</span> ps) a</code></pre>
<p>Review the algebra of Predicates:</p>
<p>We can intoduce a binary operation ’OR’ that splits channels into 2 parts:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> pOr ::</span> <span class="dt">ConvPred</span> i a <span class="ot">-></span> <span class="dt">ConvPred</span> i b <span class="ot">-></span> <span class="dt">ConvPred</span> i (<span class="dt">Either</span> a b)
<span class="ot">></span> pOr p1 p2 <span class="fu">=</span> \i <span class="ot">-></span> <span class="dt">Left</span> <span class="fu"><$></span> p1 i <span class="fu"><|></span> <span class="dt">Right</span> <span class="fu"><$></span> p2 i </code></pre>
<p>pOr is composable:</p>
<pre><code>*Main> :t (idConv (<3)) `pOr` (idConv (>5)) `pOr` (idConv (==42))
<..> :: ConvPred Int (Either (Either Int Int) Int)</code></pre>
<p>But it’s impossible to write a pAnd function as we should somehow carry all catched variables, so that’s what an arrow for.</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> pAnd ::</span> <span class="dt">ConvPred</span> i a <span class="ot">-></span> <span class="dt">ConvPred</span> i b <span class="ot">-></span> <span class="dt">ConvPred</span> i (a,b)
<span class="ot">></span> pAnd <span class="fu">=</span> undefined <span class="co">-- impossible</span></code></pre>
<p>We can write an automaton instance for matchOr:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> matchOr ::</span> (<span class="dt">Zero</span> o) <span class="ot">=></span> <span class="dt">ConvPred</span> i a <span class="ot">-></span> <span class="dt">ConvPred</span> i b <span class="ot">-></span> <span class="dt">Auto2</span> i o i (<span class="dt">Either</span> a b)
<span class="ot">></span> matchOr p1 p2 <span class="fu">=</span> match (p1 <span class="ot">`pOr`</span> p2)</code></pre>
<pre><code>test7 = experiment (run $ matchOr (idConv (>5)) (idConv (>3)) >>> id)
(listGenerator [6..10]) (Just 4)</code></pre>
<p>Now we can write a matchAnd function:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> <span class="co">{-</span>
<span class="co">> merge :: Either a a -> a</span>
<span class="co">> merge (Left a) = a</span>
<span class="co">> merge (Right a) = a</span>
<span class="co">> </span>
<span class="co">> --matchAnd :: (Zero o) => ConvPred i a -> ConvPred i b -> Auto2 i o i (a,b)</span>
<span class="co">> matchAnd p1 p2 = </span>
<span class="co">> matchOr p1 p2 >>> </span>
<span class="co">> left (arr (\a -> (a,())) >>> second (event $ match p2 >>> id)) >>></span>
<span class="co">> right (arr (\b -> ((),b)) >>> first (event $ match p1 >>> id)) >>></span>
<span class="co">> arr merge</span>
<span class="co">> -}</span>
<span class="ot">></span>
<span class="ot">> both ::</span>(<span class="dt">Monoid</span> o) <span class="ot">=></span> <span class="dt">Auto2</span> i o i a <span class="ot">-></span> <span class="dt">Auto2</span> i o i b <span class="ot">-></span> <span class="dt">Auto2</span> i o i (a,b)
<span class="ot">></span> both (<span class="dt">Auto2</span> f1) (<span class="dt">Auto2</span> f2) <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \x <span class="ot">-></span>
<span class="ot">></span> <span class="kw">case</span> (f1 x, f2 x) <span class="kw">of</span>
<span class="ot">></span> (<span class="dt">Right</span> a, <span class="dt">Right</span> b) <span class="ot">-></span> <span class="dt">Right</span> (a, b)
<span class="ot">></span> (<span class="dt">Left</span> (v1, a1'), <span class="dt">Left</span> (v2,a2')) <span class="ot">-></span> <span class="dt">Left</span> (v1 <span class="ot">`mappend`</span> v2, both a1' a2')
<span class="ot">></span> (<span class="dt">Right</span> a, <span class="dt">Left</span> (v, a2')) <span class="ot">-></span> <span class="dt">Left</span> (v, arr (\x <span class="ot">-></span> (a,x)) <span class="fu">>>></span> second a2')
<span class="ot">></span> (<span class="dt">Left</span> (v, a1'), <span class="dt">Right</span> b) <span class="ot">-></span> <span class="dt">Left</span> (v, arr (\x <span class="ot">-></span> (x,b)) <span class="fu">>>></span> first a1')</code></pre>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> test8 <span class="fu">=</span> experiment (run <span class="fu">$</span> both (match (idConv odd)) (match <span class="fu">$</span> idConv (<span class="fu">></span><span class="dv">3</span>)))
<span class="ot">></span> (listGenerator [<span class="dv">1</span><span class="fu">..</span><span class="dv">10</span>]) ([<span class="dv">4</span>])</code></pre>
<p>Now both are composable:</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> test9 <span class="fu">=</span> experiment (run <span class="fu">$</span> (match <span class="fu">$</span> idConv odd) <span class="ot">`both`</span>
<span class="ot">></span> (match <span class="fu">$</span> idConv (<span class="fu">></span><span class="dv">3</span>)) <span class="ot">`both`</span>
<span class="ot">></span> (match <span class="fu">$</span> idConv even))
<span class="ot">></span> (listGenerator [<span class="dv">1</span><span class="fu">..</span><span class="dv">10</span>]) ([<span class="dv">4</span>])</code></pre>
<p>A few highlevel examples that will wrap all internal automaton</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> filterI ::</span>(<span class="dt">Zero</span> o) <span class="ot">=></span> (i <span class="ot">-></span> <span class="dt">Bool</span>) <span class="ot">-></span> <span class="dt">Auto2</span> i o i b <span class="ot">-></span> <span class="dt">Auto2</span> i o i b
<span class="ot">></span> filterI p a<span class="fu">@</span>(<span class="dt">Auto2</span> f) <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \i <span class="ot">-></span>
<span class="ot">></span> <span class="kw">if</span> p i
<span class="ot">></span> <span class="kw">then</span> <span class="kw">case</span> f i <span class="kw">of</span>
<span class="ot">></span> <span class="dt">Left</span> (v, a') <span class="ot">-></span> <span class="dt">Left</span> (v, filterI p a')
<span class="ot">></span> <span class="dt">Right</span> b <span class="ot">-></span> <span class="dt">Right</span> b
<span class="ot">></span> <span class="kw">else</span> <span class="dt">Left</span> (zero,filterI p a)</code></pre>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> test10 <span class="fu">=</span> experiment (run <span class="fu">$</span> filterI (<span class="fu">></span><span class="dv">5</span>) <span class="fu">$</span> both (match (idConv odd)) (match <span class="fu">$</span> idConv (<span class="fu">></span><span class="dv">3</span>)))
<span class="ot">></span> (listGenerator [<span class="dv">1</span><span class="fu">..</span><span class="dv">10</span>]) ([<span class="dv">4</span>])</code></pre>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> mapI ::</span> (i <span class="ot">-></span> a) <span class="ot">-></span> <span class="dt">Auto2</span> a o a b <span class="ot">-></span> <span class="dt">Auto2</span> i o i b
<span class="ot">></span> mapI g (<span class="dt">Auto2</span> f) <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \i <span class="ot">-></span>
<span class="ot">></span> <span class="kw">case</span> f (g i) <span class="kw">of</span>
<span class="ot">></span> <span class="dt">Left</span> (v, a') <span class="ot">-></span> <span class="dt">Left</span> (v, mapI g a')
<span class="ot">></span> <span class="dt">Right</span> b <span class="ot">-></span> <span class="dt">Right</span> b</code></pre>
<h1>Multiple event listeners</h1>
<p>Now let’s look at the last part of the problem: we need to carry a list of handlers, and a way create new ones at runtime. We can address this problem in a number of ways.</p>
<p>At first we can use a list of runners, each working with one event handler, every runner will read from broadcasting TChan and will write to common channel. This variant will require no code change, however it requires to run each runner in a separate thread.</p>
<p>Another variant that we will take a look at is upgrading our runner to support multiple runners. Now we need another output datatype that will carry API for runner and now runners returns (). One may want to add additional API functions e.g. to delete listener or to give listener some name.</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> <span class="kw">data</span> <span class="dt">ROutput</span> i o a <span class="fu">=</span> <span class="dt">Output</span> a
<span class="ot">></span> <span class="fu">|</span> <span class="dt">NewListener</span> (<span class="dt">Auto4</span> i o i ()) (<span class="dt">ROutput</span> i o a)
<span class="ot">></span> <span class="kw">instance</span> (<span class="dt">Show</span> a) <span class="ot">=></span> <span class="dt">Show</span> (<span class="dt">ROutput</span> i o a) <span class="kw">where</span>
<span class="ot">></span> show (<span class="dt">Output</span> a) <span class="fu">=</span> show a
<span class="ot">></span> show (<span class="dt">NewListener</span> _ i) <span class="fu">=</span> <span class="st">"<listener:"</span> <span class="fu">++</span> show i <span class="fu">++</span> <span class="st">">"</span></code></pre>
<p>Our datatype will look like <code>Auto2</code> except it will use <code>ROutput</code> to carry information</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> <span class="kw">newtype</span> <span class="dt">Auto4</span> i o a b <span class="fu">=</span> <span class="dt">Auto4</span> {<span class="ot"> stepAuto4 ::</span> a <span class="ot">-></span> <span class="dt">Either</span> (<span class="dt">ROutput</span> i o o, <span class="dt">Auto4</span> i o i b) (<span class="dt">ROutput</span> i o b)}
<span class="ot">></span>
<span class="ot">></span> <span class="kw">instance</span> (<span class="dt">Show</span> b) <span class="ot">=></span> <span class="dt">Show</span> (<span class="dt">Auto4</span> i o a b) <span class="kw">where</span>
<span class="ot">></span> show x <span class="fu">=</span> <span class="st">"<auto>"</span></code></pre>
<p>Category instance is not the same as previous because it should carry information about listeners that should be added from the internal computation</p>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> buildUpdate ::</span> <span class="dt">ROutput</span> i o a <span class="ot">-></span> (a, <span class="dt">ROutput</span> i o b <span class="ot">-></span> <span class="dt">ROutput</span> i o b)
<span class="ot">></span> buildUpdate (<span class="dt">Output</span> a) <span class="fu">=</span> (a, id)
<span class="ot">></span> buildUpdate (<span class="dt">NewListener</span> a r) <span class="fu">=</span> <span class="kw">let</span> (x,f) <span class="fu">=</span> buildUpdate r <span class="kw">in</span> (x,<span class="dt">NewListener</span> a <span class="fu">.</span> f)
<span class="ot">></span>
<span class="ot">></span> zrec2 g (<span class="dt">Right</span> x) <span class="fu">=</span> <span class="dt">Right</span> <span class="fu">$</span> g x
<span class="ot">></span> zrec2 g (<span class="dt">Left</span> (o, <span class="dt">Auto4</span> f)) <span class="fu">=</span> <span class="dt">Left</span> (o, <span class="dt">Auto4</span> <span class="fu">$</span> \x <span class="ot">-></span> zrec2 g (f x))
<span class="ot">></span>
<span class="ot">></span> <span class="kw">instance</span> <span class="dt">Category</span> (<span class="dt">Auto4</span> i o) <span class="kw">where</span>
<span class="ot">></span> id <span class="fu">=</span> <span class="dt">Auto4</span> <span class="fu">$</span> \x <span class="ot">-></span> <span class="dt">Right</span> (<span class="dt">Output</span> x)
<span class="ot">></span> a2<span class="fu">@</span>(<span class="dt">Auto4</span> f2) <span class="fu">.</span> (<span class="dt">Auto4</span> f1) <span class="fu">=</span> <span class="dt">Auto4</span> <span class="fu">$</span> \x <span class="ot">-></span>
<span class="ot">></span> <span class="kw">let</span> out1 <span class="fu">=</span> f1 x
<span class="ot">></span> <span class="kw">in</span> <span class="kw">case</span> out1 <span class="kw">of</span>
<span class="ot">></span> <span class="dt">Right</span> b <span class="ot">-></span> <span class="kw">let</span> (y, g) <span class="fu">=</span> buildUpdate b
<span class="ot">></span> <span class="kw">in</span> zrec2 g (f2 y)
<span class="ot">></span> <span class="dt">Left</span> (o, auto1') <span class="ot">-></span> <span class="dt">Left</span> (o, (a2 <span class="fu">.</span> auto1'))</code></pre>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> addListener a <span class="fu">=</span> <span class="dt">Auto4</span> <span class="fu">$</span> \x <span class="ot">-></span> <span class="dt">Right</span> <span class="fu">$</span> <span class="dt">NewListener</span> a (<span class="dt">Output</span> x)</code></pre>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> <span class="kw">instance</span> <span class="dt">Arrow</span> (<span class="dt">Auto4</span> i o) <span class="kw">where</span>
<span class="ot">></span> arr f <span class="fu">=</span> <span class="dt">Auto4</span> (\x <span class="ot">-></span> <span class="dt">Right</span> (<span class="dt">Output</span> <span class="fu">$</span> f x))
<span class="ot">></span> first (<span class="dt">Auto4</span> f) <span class="fu">=</span> <span class="dt">Auto4</span> <span class="fu">$</span> \(x, y) <span class="ot">-></span>
<span class="ot">></span> zrec2 (\z <span class="ot">-></span> <span class="kw">let</span> (z',g) <span class="fu">=</span> buildUpdate z <span class="kw">in</span> g (<span class="dt">Output</span> (z',y))) (f x)</code></pre>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">></span> <span class="co">{- TBD</span>
<span class="ot">></span><span class="co"> instance ArrowChoice (Auto4 i o) where</span>
<span class="ot">></span><span class="co"> -- left :: a b c -> a (Either b d) (Either c d)</span>
<span class="ot">></span><span class="co"> left (Auto4 f) = Auto4 $ \x -> </span>
<span class="ot">></span><span class="co"> case x of</span>
<span class="ot">></span><span class="co"> Left b -> zrec2 (\z -> let (z',g) = buildUpdate z in Left $ g z' ) (f b)</span>
<span class="ot">></span><span class="co"> --(\z -> let (z',g) = buildUpdate z in g (Output $ Left z)) (f b)</span>
<span class="ot">></span><span class="co"> Right d -> Right $ Output (Right d)</span>
<span class="ot">></span><span class="co"> -}</span></code></pre>
<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">> extractListeners ::</span> <span class="dt">ROutput</span> i o a <span class="ot">-></span> ([<span class="dt">Auto4</span> i o i ()], a)
<span class="ot">></span> extractListeners <span class="fu">=</span> go []
<span class="ot">></span> <span class="kw">where</span> go acc (<span class="dt">Output</span> x) <span class="fu">=</span> (acc, x)
<span class="ot">></span> go acc (<span class="dt">NewListener</span> l x) <span class="fu">=</span> go (l<span class="fu">:</span>acc) x
<span class="ot">></span>
<span class="ot">></span>
<span class="ot">> runner2 ::</span> (<span class="dt">Show</span> i, <span class="dt">Monoid</span> o) <span class="ot">=></span> <span class="dt">External</span> o i <span class="ot">-></span> [<span class="dt">Auto4</span> i o i ()] <span class="ot">-></span> <span class="dt">IO</span> ()
<span class="ot">></span> runner2 ext autos <span class="fu">=</span> <span class="kw">do</span>
<span class="ot">></span> x <span class="ot"><-</span> output ext
<span class="ot">></span> putStr <span class="fu">$</span> <span class="st">"received: "</span> <span class="fu">++</span> show x
<span class="ot">></span> <span class="co">{--- we will take a took at this line --}</span>
<span class="ot">></span> <span class="kw">let</span> rets <span class="fu">=</span> map (flip stepAuto4 x) autos <span class="co">-- we run all autos </span>
<span class="ot">></span> (l, r)<span class="fu">=</span> unzip <span class="fu">$</span> map results rets
<span class="ot">></span> mapM_ (input ext) r
<span class="ot">></span> runner2 ext (concat l)
<span class="ot">></span> <span class="kw">where</span>
<span class="ot">></span> <span class="co">-- results :: Either (ROutput i o o, Auto4 i o i ()) (ROutput i o ()) -> ([Auto4 i o i ()],o)</span>
<span class="ot">></span> results (<span class="dt">Left</span> (req,next)) <span class="fu">=</span> <span class="kw">let</span> (ls, x) <span class="fu">=</span> extractListeners req
<span class="ot">></span> <span class="kw">in</span> (next<span class="fu">:</span>ls,x)
<span class="ot">></span> results (<span class="dt">Right</span> req) <span class="fu">=</span> <span class="kw">let</span> (ls, _) <span class="fu">=</span> extractListeners req
<span class="ot">></span> <span class="kw">in</span> (ls, mempty)
<span class="ot">></span> run2 f g <span class="fu">=</span> runner g f</code></pre>
<p>Now we use multiple handlers, the only problem is that we can’t start next step untils previous is done, and all handlers are run in sequence.</p>
<p>However we can use parallel execution of handlers either explicitly by <code>forkIO</code> / <code>async</code> or by working if we will send requests previously created workers via STM channel or by implicit parallelization using <code>parMap rseq</code>.</p>
<p>If one handler can run very long time then you can hide it behind a wrapper. Here is an idea (however it’s not work yet):</p>
<ol>
<li><p>create a wrapper that should return <code>TChan</code> and <code>TMVar</code> for response and fork automaton runner</p></li>
<li><p>on each query try to get result from <code>TMVar</code> if it’s there - return take it and proceed as usual, otherwise put request into channel</p></li>
<li><p>in automaton runner - run automaton as usual but when new value is requested try to take the next value from channel, if it’s there - process it otherwise put automaton into result box.</p></li>
</ol>
<hr />
<div id="sociallinks" class="pull-left">
<strong>Share on:</strong>
<a href="https://twitter.com/home?status=http://qnikst.github.io/drafts/2013-01-27-automata.tex.html" target="_blank" class="social" title="twit it">t</a>
<a href="http://www.facebook.com/sharer/sharer.php?u=http://qnikst.github.io/drafts/2013-01-27-automata.tex.html" target="_blank" class="social" title="share on facebook">F</a>
<a href="https://plus.google.com/share?url=http://qnikst.github.io/drafts/2013-01-27-automata.tex.html" target="_blank" class="social" title="share on g+">g</a>
</div>
<div class="pull-right">
<em>Alexander Vershilov</em>
none
</div>
<br class="clearfix" />
<hr />
<div id="disqus_thread"></div>
<script type="text/javascript">
/* * * CONFIGURATION VARIABLES: EDIT BEFORE PASTING INTO YOUR WEBPAGE * * */
var disqus_shortname = 'qnikst'; // required: replace example with your forum shortname
(function() {
var dsq = document.createElement('script'); dsq.type = 'text/javascript'; dsq.async = true;
dsq.src = 'http://' + disqus_shortname + '.disqus.com/embed.js';
(document.getElementsByTagName('head')[0] || document.getElementsByTagName('body')[0]).appendChild(dsq);
})();
</script>
<noscript>Please enable JavaScript to view the <a href="http://disqus.com/?ref_noscript">comments powered by Disqus.</a></noscript>
<a href="http://disqus.com" class="dsq-brlink">comments powered by <span class="logo-disqus">Disqus</span></a>
<footer>
Site generated using <a href="http://jaspervdj.be/hakyll">Hakyll</a> using <a href="http://johnmacfarlane.net/pandoc/">pandoc</a>
</footer>
</div>
<script type="text/javascript">
// <noscript> я очень хочу вас посчитать, напишите комментарий хотя бы, пожааалуйста </noscript>
var _gaq = _gaq || [];
_gaq.push(['_setAccount', 'UA-38941774-1']);
_gaq.push(['_trackPageview']);
(function() {
var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true;
ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';
var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
})();
</script>
</body>
</html>