Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

add new page

  • Loading branch information...
commit 4af9a9c5ce94c51c4021651efe6326df4d672e45 1 parent 73b0dd8
@qnikst authored
View
414 drafts/2013-01-27-automata.tex.html
@@ -32,28 +32,28 @@
</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>Preface</h1>
+<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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> <span class="ot">{-# LANGUAGE Arrows #-}</span>
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Prelude</span> <span class="kw">hiding</span> ((<span class="fu">.</span>), <span class="fu">id</span>)
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Control.Arrow</span>
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Control.Category</span></code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> <span class="ot">{-# LANGUAGE Arrows #-}</span>
+<span class="ot">&gt;</span> <span class="kw">import</span> Prelude <span class="kw">hiding</span> ((.), id)
+<span class="ot">&gt;</span> <span class="kw">import</span> Control.Arrow
+<span class="ot">&gt;</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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Control.Applicative</span>
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Control.Monad</span>
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Control.Concurrent.STM</span>
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Control.Concurrent</span>
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Control.Exception</span>
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Data.Monoid</span></code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> <span class="kw">import</span> Control.Applicative
+<span class="ot">&gt;</span> <span class="kw">import</span> Control.Monad
+<span class="ot">&gt;</span> <span class="kw">import</span> Control.Concurrent.STM
+<span class="ot">&gt;</span> <span class="kw">import</span> Control.Concurrent
+<span class="ot">&gt;</span> <span class="kw">import</span> Control.Exception
+<span class="ot">&gt;</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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> <span class="kw">data</span> <span class="dt">External</span> a b <span class="fu">=</span> <span class="dt">External</span>
-<span class="fu">&gt;</span> {<span class="ot"> input ::</span> a <span class="ot">-&gt;</span> <span class="dt">IO</span> () <span class="co">-- ^ write to a wire</span>
-<span class="fu">&gt;</span> ,<span class="ot"> output ::</span> <span class="dt">IO</span> b <span class="co">-- ^ read from a wire</span>
-<span class="fu">&gt;</span> }</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</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">&gt;</span> {<span class="ot"> input ::</span> a <span class="ot">-&gt;</span> <span class="dt">IO</span> () <span class="co">-- ^ write to a wire</span>
+<span class="ot">&gt;</span> ,<span class="ot"> output ::</span> <span class="dt">IO</span> b <span class="co">-- ^ read from a wire</span>
+<span class="ot">&gt;</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>
@@ -80,26 +80,26 @@
<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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><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="fu">&gt;</span> initialize <span class="fu">=</span> <span class="kw">do</span>
-<span class="fu">&gt;</span> i <span class="ot">&lt;-</span> newTChanIO
-<span class="fu">&gt;</span> o <span class="ot">&lt;-</span> newTChanIO
-<span class="fu">&gt;</span> <span class="fu">return</span> (<span class="dt">External</span> { input <span class="fu">=</span> atomically <span class="fu">.</span> (writeTChan i)
-<span class="fu">&gt;</span> , output <span class="fu">=</span> atomically <span class="fu">.</span> readTChan <span class="fu">$</span> o}, (i, o))</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; 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">&gt;</span> initialize <span class="fu">=</span> <span class="kw">do</span>
+<span class="ot">&gt;</span> i <span class="ot">&lt;-</span> newTChanIO
+<span class="ot">&gt;</span> o <span class="ot">&lt;-</span> newTChanIO
+<span class="ot">&gt;</span> <span class="fu">return</span> (<span class="dt">External</span> { input <span class="fu">=</span> atomically <span class="fu">.</span> (writeTChan i)
+<span class="ot">&gt;</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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</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">-&gt;</span> <span class="dt">TChan</span> b <span class="ot">-&gt;</span> <span class="dt">IO</span> ()
-<span class="fu">&gt;</span>
-<span class="fu">&gt;</span><span class="ot"> idGenerator ::</span> <span class="dt">Generator</span> a a
-<span class="fu">&gt;</span> idGenerator <span class="fu">=</span> fGenerator <span class="fu">id</span>
-<span class="fu">&gt;</span><span class="ot"> fGenerator ::</span> (a <span class="ot">-&gt;</span> b) <span class="ot">-&gt;</span> <span class="dt">Generator</span> a b
-<span class="fu">&gt;</span> fGenerator f ic oc <span class="fu">=</span> forever <span class="fu">.</span> atomically <span class="fu">$</span> readTChan ic <span class="fu">&gt;&gt;=</span> writeTChan oc <span class="fu">.</span> f</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</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">-&gt;</span> <span class="dt">TChan</span> b <span class="ot">-&gt;</span> <span class="dt">IO</span> ()
+<span class="ot">&gt;</span>
+<span class="ot">&gt; idGenerator ::</span> <span class="dt">Generator</span> a a
+<span class="ot">&gt;</span> idGenerator <span class="fu">=</span> fGenerator <span class="fu">id</span>
+<span class="ot">&gt; fGenerator ::</span> (a <span class="ot">-&gt;</span> b) <span class="ot">-&gt;</span> <span class="dt">Generator</span> a b
+<span class="ot">&gt;</span> fGenerator f ic oc <span class="fu">=</span> forever <span class="fu">.</span> atomically <span class="fu">$</span> readTChan ic <span class="fu">&gt;&gt;=</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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> experiment' f g i (e, c<span class="fu">@</span>(in_,out_)) <span class="fu">=</span>
-<span class="fu">&gt;</span> bracket (forkIO <span class="fu">$</span> atomically (writeTChan in_ i) <span class="fu">&gt;&gt;</span> <span class="fu">uncurry</span> g c)
-<span class="fu">&gt;</span> killThread
-<span class="fu">&gt;</span> (<span class="fu">const</span> <span class="fu">$</span> f e)
-<span class="fu">&gt;</span> experiment f g i <span class="fu">=</span> initialize <span class="fu">&gt;&gt;=</span> experiment' f g i</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> experiment' f g i (e, c<span class="fu">@</span>(in_,out_)) <span class="fu">=</span>
+<span class="ot">&gt;</span> bracket (forkIO <span class="fu">$</span> atomically (writeTChan in_ i) <span class="fu">&gt;&gt;</span> <span class="fu">uncurry</span> g c)
+<span class="ot">&gt;</span> killThread
+<span class="ot">&gt;</span> (<span class="fu">const</span> <span class="fu">$</span> f e)
+<span class="ot">&gt;</span> experiment f g i <span class="fu">=</span> initialize <span class="fu">&gt;&gt;=</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>
@@ -113,26 +113,26 @@
<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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</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">-&gt;</span> <span class="dt">Either</span> (o, <span class="dt">Auto2</span> i o i b) b}</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</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">-&gt;</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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> runner ::</span> (<span class="kw">Show</span> i, <span class="kw">Show</span> o, <span class="kw">Show</span> b) <span class="ot">=&gt;</span> <span class="dt">External</span> o i <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i b <span class="ot">-&gt;</span> <span class="dt">IO</span> b
-<span class="fu">&gt;</span> runner ext auto <span class="fu">=</span> <span class="kw">do</span>
-<span class="fu">&gt;</span> x <span class="ot">&lt;-</span> output ext
-<span class="fu">&gt;</span> <span class="fu">putStr</span> <span class="fu">$</span> <span class="st">&quot;received: &quot;</span> <span class="fu">++</span> <span class="fu">show</span> x
-<span class="fu">&gt;</span> <span class="kw">let</span> ret <span class="fu">=</span> stepAuto auto x
-<span class="fu">&gt;</span> <span class="kw">case</span> ret <span class="kw">of</span>
-<span class="fu">&gt;</span> <span class="kw">Left</span> (req, next) <span class="ot">-&gt;</span> <span class="kw">do</span>
-<span class="fu">&gt;</span> <span class="fu">putStrLn</span> <span class="fu">$</span> <span class="st">&quot; requesting: &quot;</span> <span class="fu">++</span> <span class="fu">show</span> req
-<span class="fu">&gt;</span> input ext req
-<span class="fu">&gt;</span> runner ext next
-<span class="fu">&gt;</span> <span class="kw">Right</span> ok <span class="ot">-&gt;</span> <span class="fu">putStrLn</span> (<span class="st">&quot; result: &quot;</span> <span class="fu">++</span> <span class="fu">show</span> ok) <span class="fu">&gt;&gt;</span> <span class="fu">return</span> ok
-<span class="fu">&gt;</span> run f g <span class="fu">=</span> runner g f</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; runner ::</span> (<span class="kw">Show</span> i, <span class="kw">Show</span> o, <span class="kw">Show</span> b) <span class="ot">=&gt;</span> <span class="dt">External</span> o i <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i b <span class="ot">-&gt;</span> <span class="dt">IO</span> b
+<span class="ot">&gt;</span> runner ext auto <span class="fu">=</span> <span class="kw">do</span>
+<span class="ot">&gt;</span> x <span class="ot">&lt;-</span> output ext
+<span class="ot">&gt;</span> <span class="fu">putStr</span> <span class="fu">$</span> <span class="st">&quot;received: &quot;</span> <span class="fu">++</span> <span class="fu">show</span> x
+<span class="ot">&gt;</span> <span class="kw">let</span> ret <span class="fu">=</span> stepAuto auto x
+<span class="ot">&gt;</span> <span class="kw">case</span> ret <span class="kw">of</span>
+<span class="ot">&gt;</span> <span class="kw">Left</span> (req, next) <span class="ot">-&gt;</span> <span class="kw">do</span>
+<span class="ot">&gt;</span> <span class="fu">putStrLn</span> <span class="fu">$</span> <span class="st">&quot; requesting: &quot;</span> <span class="fu">++</span> <span class="fu">show</span> req
+<span class="ot">&gt;</span> input ext req
+<span class="ot">&gt;</span> runner ext next
+<span class="ot">&gt;</span> <span class="kw">Right</span> ok <span class="ot">-&gt;</span> <span class="fu">putStrLn</span> (<span class="st">&quot; result: &quot;</span> <span class="fu">++</span> <span class="fu">show</span> ok) <span class="fu">&gt;&gt;</span> <span class="fu">return</span> ok
+<span class="ot">&gt;</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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> upTo ::</span> <span class="dt">Int</span> <span class="ot">-&gt;</span> (<span class="dt">Int</span> <span class="ot">-&gt;</span> <span class="dt">Int</span>) <span class="ot">-&gt;</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="fu">&gt;</span> upTo n f <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \x <span class="ot">-&gt;</span> <span class="kw">if</span> x <span class="fu">&gt;=</span> n
-<span class="fu">&gt;</span> <span class="kw">then</span> <span class="kw">Right</span> <span class="fu">$</span> f x
-<span class="fu">&gt;</span> <span class="kw">else</span> <span class="kw">Left</span> ((x<span class="dv">+1</span>), upTo n f)</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; upTo ::</span> <span class="dt">Int</span> <span class="ot">-&gt;</span> (<span class="dt">Int</span> <span class="ot">-&gt;</span> <span class="dt">Int</span>) <span class="ot">-&gt;</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">&gt;</span> upTo n f <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \x <span class="ot">-&gt;</span> <span class="kw">if</span> x <span class="fu">&gt;=</span> n
+<span class="ot">&gt;</span> <span class="kw">then</span> <span class="kw">Right</span> <span class="fu">$</span> f x
+<span class="ot">&gt;</span> <span class="kw">else</span> <span class="kw">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&gt; experiment (run (upTo 2 (*2))) (idGenerator) 0
received: 0 requesting: 1
@@ -140,44 +140,44 @@
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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> request ::</span> o <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o a i
-<span class="fu">&gt;</span> request req <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \_ <span class="ot">-&gt;</span> <span class="kw">Left</span> (req, <span class="dt">Auto2</span> <span class="fu">$</span> \y <span class="ot">-&gt;</span> <span class="kw">Right</span> y)</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; request ::</span> o <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o a i
+<span class="ot">&gt;</span> request req <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \_ <span class="ot">-&gt;</span> <span class="kw">Left</span> (req, <span class="dt">Auto2</span> <span class="fu">$</span> \y <span class="ot">-&gt;</span> <span class="kw">Right</span> y)</code></pre>
<pre><code>*Main&gt; 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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</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="fu">&gt;</span> <span class="fu">id</span> <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \x <span class="ot">-&gt;</span> <span class="kw">Right</span> x
-<span class="fu">&gt;</span> auto2 <span class="fu">.</span> auto1 <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \x <span class="ot">-&gt;</span>
-<span class="fu">&gt;</span> <span class="kw">let</span> out1 <span class="fu">=</span> stepAuto auto1 x
-<span class="fu">&gt;</span> <span class="kw">in</span> <span class="kw">case</span> out1 <span class="kw">of</span>
-<span class="fu">&gt;</span> <span class="kw">Right</span> b <span class="ot">-&gt;</span> stepAuto auto2 b
-<span class="fu">&gt;</span> <span class="kw">Left</span> (o,auto1') <span class="ot">-&gt;</span> <span class="kw">Left</span> (o, (auto2 <span class="fu">.</span> auto1'))</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</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">&gt;</span> <span class="fu">id</span> <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \x <span class="ot">-&gt;</span> <span class="kw">Right</span> x
+<span class="ot">&gt;</span> auto2 <span class="fu">.</span> auto1 <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \x <span class="ot">-&gt;</span>
+<span class="ot">&gt;</span> <span class="kw">let</span> out1 <span class="fu">=</span> stepAuto auto1 x
+<span class="ot">&gt;</span> <span class="kw">in</span> <span class="kw">case</span> out1 <span class="kw">of</span>
+<span class="ot">&gt;</span> <span class="kw">Right</span> b <span class="ot">-&gt;</span> stepAuto auto2 b
+<span class="ot">&gt;</span> <span class="kw">Left</span> (o,auto1') <span class="ot">-&gt;</span> <span class="kw">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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</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="fu">&gt;</span> arr f <span class="fu">=</span> <span class="dt">Auto2</span> (\x <span class="ot">-&gt;</span> <span class="kw">Right</span> (f x))
-<span class="fu">&gt;</span> first (<span class="dt">Auto2</span> f) <span class="fu">=</span> <span class="dt">Auto2</span> (\(x, y) <span class="ot">-&gt;</span> zrec (\z <span class="ot">-&gt;</span> (z,y)) (f x))</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</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">&gt;</span> arr f <span class="fu">=</span> <span class="dt">Auto2</span> (\x <span class="ot">-&gt;</span> <span class="kw">Right</span> (f x))
+<span class="ot">&gt;</span> first (<span class="dt">Auto2</span> f) <span class="fu">=</span> <span class="dt">Auto2</span> (\(x, y) <span class="ot">-&gt;</span> zrec (\z <span class="ot">-&gt;</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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> zrec g (<span class="kw">Right</span> x) <span class="fu">=</span> <span class="kw">Right</span> <span class="fu">$</span> g x
-<span class="fu">&gt;</span> zrec g (<span class="kw">Left</span> (o, <span class="dt">Auto2</span> f)) <span class="fu">=</span> <span class="kw">Left</span> (o, <span class="dt">Auto2</span> <span class="fu">$</span> \x <span class="ot">-&gt;</span> zrec g (f x))</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> zrec g (<span class="kw">Right</span> x) <span class="fu">=</span> <span class="kw">Right</span> <span class="fu">$</span> g x
+<span class="ot">&gt;</span> zrec g (<span class="kw">Left</span> (o, <span class="dt">Auto2</span> f)) <span class="fu">=</span> <span class="kw">Left</span> (o, <span class="dt">Auto2</span> <span class="fu">$</span> \x <span class="ot">-&gt;</span> zrec g (f x))</code></pre>
<p>Small demonstration:</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> test1 <span class="fu">=</span> request <span class="dv">5</span> <span class="fu">&gt;&gt;&gt;</span>
-<span class="fu">&gt;</span> arr (\x <span class="ot">-&gt;</span> (x,x)) <span class="fu">&gt;&gt;&gt;</span>
-<span class="fu">&gt;</span> first (request <span class="dv">6</span>) <span class="fu">&gt;&gt;&gt;</span>
-<span class="fu">&gt;</span> arr (\(x,y) <span class="ot">-&gt;</span> x<span class="fu">+</span>y)</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> test1 <span class="fu">=</span> request <span class="dv">5</span> <span class="fu">&gt;&gt;&gt;</span>
+<span class="ot">&gt;</span> arr (\x <span class="ot">-&gt;</span> (x,x)) <span class="fu">&gt;&gt;&gt;</span>
+<span class="ot">&gt;</span> first (request <span class="dv">6</span>) <span class="fu">&gt;&gt;&gt;</span>
+<span class="ot">&gt;</span> arr (\(x,y) <span class="ot">-&gt;</span> x<span class="fu">+</span>y)</code></pre>
<pre><code>*Main&gt; experiment (runr (test1)) (idGenerator 0)
input: 0 requesting: 5
input: 5 requesting: 6
input: 6 result: 11
11</code></pre>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> test2 <span class="fu">=</span> arr (\x <span class="ot">-&gt;</span> ((),x)) <span class="fu">&gt;&gt;&gt;</span>
-<span class="fu">&gt;</span> first (request <span class="dv">4</span>) <span class="fu">&gt;&gt;&gt;</span>
-<span class="fu">&gt;</span> arr (\(x,y) <span class="ot">-&gt;</span> <span class="kw">if</span> y<span class="fu">&gt;</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 class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> test2 <span class="fu">=</span> arr (\x <span class="ot">-&gt;</span> ((),x)) <span class="fu">&gt;&gt;&gt;</span>
+<span class="ot">&gt;</span> first (request <span class="dv">4</span>) <span class="fu">&gt;&gt;&gt;</span>
+<span class="ot">&gt;</span> arr (\(x,y) <span class="ot">-&gt;</span> <span class="kw">if</span> y<span class="fu">&gt;</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&gt; experiment (run test2) idGenerator 6
input: 6 requesting: 4
input: 4 result: 10
@@ -189,22 +189,22 @@
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 &quot;if&quot; condition. Using an arrow gives us only a channels abstraction, so we need to use a &quot;conditional&quot; 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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</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="fu">&gt;</span> <span class="co">-- left :: a b c -&gt; a (Either b d) (Either c d)</span>
-<span class="fu">&gt;</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">-&gt;</span>
-<span class="fu">&gt;</span> <span class="kw">case</span> x <span class="kw">of</span>
-<span class="fu">&gt;</span> <span class="kw">Left</span> b <span class="ot">-&gt;</span> zrec <span class="kw">Left</span> (f b)
-<span class="fu">&gt;</span> <span class="kw">Right</span> d <span class="ot">-&gt;</span> <span class="kw">Right</span> (<span class="kw">Right</span> d)</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</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">&gt;</span> <span class="co">-- left :: a b c -&gt; a (Either b d) (Either c d)</span>
+<span class="ot">&gt;</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">-&gt;</span>
+<span class="ot">&gt;</span> <span class="kw">case</span> x <span class="kw">of</span>
+<span class="ot">&gt;</span> <span class="kw">Left</span> b <span class="ot">-&gt;</span> zrec <span class="kw">Left</span> (f b)
+<span class="ot">&gt;</span> <span class="kw">Right</span> d <span class="ot">-&gt;</span> <span class="kw">Right</span> (<span class="kw">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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><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="fu">&gt;</span> test3 <span class="fu">=</span> arr (\y <span class="ot">-&gt;</span> <span class="kw">if</span> y <span class="fu">&gt;</span> <span class="dv">5</span> <span class="kw">then</span> <span class="kw">Left</span> y <span class="kw">else</span> <span class="kw">Right</span> y) <span class="fu">&gt;&gt;&gt;</span>
-<span class="fu">&gt;</span> left (request <span class="dv">3</span>) <span class="fu">&gt;&gt;&gt;</span>
-<span class="fu">&gt;</span> right (request <span class="dv">7</span>) <span class="fu">&gt;&gt;&gt;</span>
-<span class="fu">&gt;</span> arr (\x <span class="ot">-&gt;</span> <span class="kw">case</span> x <span class="kw">of</span>
-<span class="fu">&gt;</span> <span class="kw">Left</span> x <span class="ot">-&gt;</span> x
-<span class="fu">&gt;</span> <span class="kw">Right</span> y <span class="ot">-&gt;</span> y)</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; 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">&gt;</span> test3 <span class="fu">=</span> arr (\y <span class="ot">-&gt;</span> <span class="kw">if</span> y <span class="fu">&gt;</span> <span class="dv">5</span> <span class="kw">then</span> <span class="kw">Left</span> y <span class="kw">else</span> <span class="kw">Right</span> y) <span class="fu">&gt;&gt;&gt;</span>
+<span class="ot">&gt;</span> left (request <span class="dv">3</span>) <span class="fu">&gt;&gt;&gt;</span>
+<span class="ot">&gt;</span> right (request <span class="dv">7</span>) <span class="fu">&gt;&gt;&gt;</span>
+<span class="ot">&gt;</span> arr (\x <span class="ot">-&gt;</span> <span class="kw">case</span> x <span class="kw">of</span>
+<span class="ot">&gt;</span> <span class="kw">Left</span> x <span class="ot">-&gt;</span> x
+<span class="ot">&gt;</span> <span class="kw">Right</span> y <span class="ot">-&gt;</span> y)</code></pre>
<pre><code>*Main&gt; experiment (run test3) idGenerator 1
input: 1 requesting: 7
input: 7 result: 7
@@ -215,10 +215,10 @@
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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> test4 <span class="fu">=</span> proc x <span class="ot">-&gt;</span> <span class="kw">do</span>
-<span class="fu">&gt;</span> <span class="kw">if</span> x <span class="fu">&gt;</span> <span class="dv">5</span>
-<span class="fu">&gt;</span> <span class="kw">then</span> request <span class="dv">0</span> <span class="fu">-&lt;</span> ()
-<span class="fu">&gt;</span> <span class="kw">else</span> request <span class="dv">10</span> <span class="fu">-&lt;</span> ()</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> test4 <span class="fu">=</span> proc x <span class="ot">-&gt;</span> <span class="kw">do</span>
+<span class="ot">&gt;</span> <span class="kw">if</span> x <span class="fu">&gt;</span> <span class="dv">5</span>
+<span class="ot">&gt;</span> <span class="kw">then</span> request <span class="dv">0</span> <span class="fu">-&lt;</span> ()
+<span class="ot">&gt;</span> <span class="kw">else</span> request <span class="dv">10</span> <span class="fu">-&lt;</span> ()</code></pre>
<pre><code>*Main&gt; run (runner (test4)) idGenerator 6
input: 6 requesting: 0
input: 0 result: 0
@@ -237,38 +237,38 @@
</ol>
<h2>Additional method</h2>
<p>We can rewrite our automaton type to</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</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="fu">&gt;</span><span class="ot"> checkAuto ::</span> i <span class="ot">-&gt;</span> <span class="dt">Bool</span>
-<span class="fu">&gt;</span> ,<span class="ot"> runAuto ::</span> i <span class="ot">-&gt;</span> <span class="dt">Either</span> (o, <span class="dt">Auto3</span> i o i b) b
-<span class="fu">&gt;</span> }</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</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">&gt; checkAuto ::</span> i <span class="ot">-&gt;</span> <span class="dt">Bool</span>
+<span class="ot">&gt;</span> ,<span class="ot"> runAuto ::</span> i <span class="ot">-&gt;</span> <span class="dt">Either</span> (o, <span class="dt">Auto3</span> i o i b) b
+<span class="ot">&gt;</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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> listGenerator ::</span> [b] <span class="ot">-&gt;</span> <span class="dt">Generator</span> a b
-<span class="fu">&gt;</span> listGenerator ls ic oc <span class="fu">=</span> <span class="fu">mapM_</span> (atomically <span class="fu">.</span> (writeTChan oc)) ls</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; listGenerator ::</span> [b] <span class="ot">-&gt;</span> <span class="dt">Generator</span> a b
+<span class="ot">&gt;</span> listGenerator ls ic oc <span class="fu">=</span> <span class="fu">mapM_</span> (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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> <span class="kw">type</span> <span class="dt">ConvPred</span> i j <span class="fu">=</span> (i <span class="ot">-&gt;</span> <span class="dt">Maybe</span> j)
-<span class="fu">&gt;</span><span class="ot"> idConv ::</span> (a <span class="ot">-&gt;</span> <span class="dt">Bool</span>) <span class="ot">-&gt;</span> <span class="dt">ConvPred</span> a a
-<span class="fu">&gt;</span> idConv p <span class="fu">=</span> \i <span class="ot">-&gt;</span> <span class="kw">if</span> (p i) <span class="kw">then</span> <span class="kw">Just</span> i <span class="kw">else</span> <span class="kw">Nothing</span></code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> <span class="kw">type</span> <span class="dt">ConvPred</span> i j <span class="fu">=</span> (i <span class="ot">-&gt;</span> <span class="dt">Maybe</span> j)
+<span class="ot">&gt; idConv ::</span> (a <span class="ot">-&gt;</span> <span class="dt">Bool</span>) <span class="ot">-&gt;</span> <span class="dt">ConvPred</span> a a
+<span class="ot">&gt;</span> idConv p <span class="fu">=</span> \i <span class="ot">-&gt;</span> <span class="kw">if</span> (p i) <span class="kw">then</span> <span class="kw">Just</span> i <span class="kw">else</span> <span class="kw">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 &quot;noop&quot; and wait for next value, keeping automation unchanged, so we will introduce a type class:</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</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="fu">&gt;</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="kw">Nothing</span>
-<span class="fu">&gt;</span> <span class="kw">instance</span> <span class="dt">Zero</span> [a] <span class="kw">where</span> zero <span class="fu">=</span> []</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</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">&gt;</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="kw">Nothing</span>
+<span class="ot">&gt;</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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> event ::</span> (<span class="dt">Zero</span> o) <span class="ot">=&gt;</span> <span class="dt">Auto2</span> i o i i <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i i
-<span class="fu">&gt;</span> event a <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \_ <span class="ot">-&gt;</span> <span class="kw">Left</span> (zero, a)</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; event ::</span> (<span class="dt">Zero</span> o) <span class="ot">=&gt;</span> <span class="dt">Auto2</span> i o i i <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i i
+<span class="ot">&gt;</span> event a <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> \_ <span class="ot">-&gt;</span> <span class="kw">Left</span> (zero, a)</code></pre>
<p>First version of matcher:</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> matchE ::</span> (<span class="dt">Zero</span> o) <span class="ot">=&gt;</span> (<span class="dt">ConvPred</span> i a) <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o a b <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i b
-<span class="fu">&gt;</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">-&gt;</span>
-<span class="fu">&gt;</span> <span class="kw">case</span> p x <span class="kw">of</span>
-<span class="fu">&gt;</span> <span class="kw">Nothing</span> <span class="ot">-&gt;</span> <span class="kw">Left</span> (zero, matchE p a)
-<span class="fu">&gt;</span> <span class="kw">Just</span> y <span class="ot">-&gt;</span> zrec <span class="fu">id</span> (f y)</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; matchE ::</span> (<span class="dt">Zero</span> o) <span class="ot">=&gt;</span> (<span class="dt">ConvPred</span> i a) <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o a b <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i b
+<span class="ot">&gt;</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">-&gt;</span>
+<span class="ot">&gt;</span> <span class="kw">case</span> p x <span class="kw">of</span>
+<span class="ot">&gt;</span> <span class="kw">Nothing</span> <span class="ot">-&gt;</span> <span class="kw">Left</span> (zero, matchE p a)
+<span class="ot">&gt;</span> <span class="kw">Just</span> y <span class="ot">-&gt;</span> zrec <span class="fu">id</span> (f y)</code></pre>
<p>Correct version of matcher</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> match ::</span> (<span class="dt">Zero</span> o) <span class="ot">=&gt;</span> (<span class="dt">ConvPred</span> i b) <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i b
-<span class="fu">&gt;</span> match p <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> <span class="fu">maybe</span> (<span class="kw">Left</span> (zero, match p)) <span class="kw">Right</span> <span class="fu">.</span> p</code></pre>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> test6 <span class="fu">=</span> experiment (run <span class="fu">$</span> match (idConv (<span class="fu">&gt;</span><span class="dv">5</span>)) <span class="fu">&gt;&gt;&gt;</span> <span class="fu">id</span>)
-<span class="fu">&gt;</span> (listGenerator [<span class="dv">1</span><span class="fu">..</span><span class="dv">10</span>]) (<span class="kw">Just</span> <span class="dv">4</span>)</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; match ::</span> (<span class="dt">Zero</span> o) <span class="ot">=&gt;</span> (<span class="dt">ConvPred</span> i b) <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i b
+<span class="ot">&gt;</span> match p <span class="fu">=</span> <span class="dt">Auto2</span> <span class="fu">$</span> <span class="fu">maybe</span> (<span class="kw">Left</span> (zero, match p)) <span class="kw">Right</span> <span class="fu">.</span> p</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> test6 <span class="fu">=</span> experiment (run <span class="fu">$</span> match (idConv (<span class="fu">&gt;</span><span class="dv">5</span>)) <span class="fu">&gt;&gt;&gt;</span> <span class="fu">id</span>)
+<span class="ot">&gt;</span> (listGenerator [<span class="dv">1</span><span class="fu">..</span><span class="dv">10</span>]) (<span class="kw">Just</span> <span class="dv">4</span>)</code></pre>
<pre><code>*Main&gt; test6
received: 1 requesting: Nothing
received: 2 requesting: Nothing
@@ -278,25 +278,25 @@
received: 6 result: 6
6</code></pre>
<p>Now we will write some helpers. The easiest one is matchAny:</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> matchAny ::</span> (<span class="dt">Zero</span> o) <span class="ot">=&gt;</span> [<span class="dt">ConvPred</span> i a] <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o a b <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i b
-<span class="fu">&gt;</span> matchAny ps a <span class="fu">=</span> matchE (\i <span class="ot">-&gt;</span> <span class="fu">foldl</span> (\o p <span class="ot">-&gt;</span> o <span class="fu">&lt;|&gt;</span> p i) <span class="kw">Nothing</span> ps) a</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; matchAny ::</span> (<span class="dt">Zero</span> o) <span class="ot">=&gt;</span> [<span class="dt">ConvPred</span> i a] <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o a b <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i b
+<span class="ot">&gt;</span> matchAny ps a <span class="fu">=</span> matchE (\i <span class="ot">-&gt;</span> <span class="fu">foldl</span> (\o p <span class="ot">-&gt;</span> o <span class="fu">&lt;|&gt;</span> p i) <span class="kw">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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> pOr ::</span> <span class="dt">ConvPred</span> i a <span class="ot">-&gt;</span> <span class="dt">ConvPred</span> i b <span class="ot">-&gt;</span> <span class="dt">ConvPred</span> i (<span class="dt">Either</span> a b)
-<span class="fu">&gt;</span> pOr p1 p2 <span class="fu">=</span> \i <span class="ot">-&gt;</span> <span class="kw">Left</span> <span class="fu">&lt;$&gt;</span> p1 i <span class="fu">&lt;|&gt;</span> <span class="kw">Right</span> <span class="fu">&lt;$&gt;</span> p2 i </code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; pOr ::</span> <span class="dt">ConvPred</span> i a <span class="ot">-&gt;</span> <span class="dt">ConvPred</span> i b <span class="ot">-&gt;</span> <span class="dt">ConvPred</span> i (<span class="dt">Either</span> a b)
+<span class="ot">&gt;</span> pOr p1 p2 <span class="fu">=</span> \i <span class="ot">-&gt;</span> <span class="kw">Left</span> <span class="fu">&lt;$&gt;</span> p1 i <span class="fu">&lt;|&gt;</span> <span class="kw">Right</span> <span class="fu">&lt;$&gt;</span> p2 i </code></pre>
<p>pOr is composable:</p>
<pre><code>*Main&gt; :t (idConv (&lt;3)) `pOr` (idConv (&gt;5)) `pOr` (idConv (==42))
&lt;..&gt; :: 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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> pAnd ::</span> <span class="dt">ConvPred</span> i a <span class="ot">-&gt;</span> <span class="dt">ConvPred</span> i b <span class="ot">-&gt;</span> <span class="dt">ConvPred</span> i (a,b)
-<span class="fu">&gt;</span> pAnd <span class="fu">=</span> <span class="fu">undefined</span> <span class="co">-- impossible</span></code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; pAnd ::</span> <span class="dt">ConvPred</span> i a <span class="ot">-&gt;</span> <span class="dt">ConvPred</span> i b <span class="ot">-&gt;</span> <span class="dt">ConvPred</span> i (a,b)
+<span class="ot">&gt;</span> pAnd <span class="fu">=</span> <span class="fu">undefined</span> <span class="co">-- impossible</span></code></pre>
<p>We can write an automaton instance for matchOr:</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> matchOr ::</span> (<span class="dt">Zero</span> o) <span class="ot">=&gt;</span> <span class="dt">ConvPred</span> i a <span class="ot">-&gt;</span> <span class="dt">ConvPred</span> i b <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i (<span class="dt">Either</span> a b)
-<span class="fu">&gt;</span> matchOr p1 p2 <span class="fu">=</span> match (p1 <span class="ot">`pOr`</span> p2)</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; matchOr ::</span> (<span class="dt">Zero</span> o) <span class="ot">=&gt;</span> <span class="dt">ConvPred</span> i a <span class="ot">-&gt;</span> <span class="dt">ConvPred</span> i b <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i (<span class="dt">Either</span> a b)
+<span class="ot">&gt;</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 (&gt;5)) (idConv (&gt;3)) &gt;&gt;&gt; id)
(listGenerator [6..10]) (Just 4)</code></pre>
<p>Now we can write a matchAnd function:</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> <span class="co">{-</span>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> <span class="co">{-</span>
<span class="co">&gt; merge :: Either a a -&gt; a</span>
<span class="co">&gt; merge (Left a) = a</span>
<span class="co">&gt; merge (Right a) = a</span>
@@ -308,102 +308,102 @@
<span class="co">&gt; right (arr (\b -&gt; ((),b)) &gt;&gt;&gt; first (event $ match p1 &gt;&gt;&gt; id)) &gt;&gt;&gt;</span>
<span class="co">&gt; arr merge</span>
<span class="co">&gt; -}</span>
-<span class="fu">&gt;</span>
-<span class="fu">&gt;</span><span class="ot"> both ::</span>(<span class="dt">Monoid</span> o) <span class="ot">=&gt;</span> <span class="dt">Auto2</span> i o i a <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i b <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i (a,b)
-<span class="fu">&gt;</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">-&gt;</span>
-<span class="fu">&gt;</span> <span class="kw">case</span> (f1 x, f2 x) <span class="kw">of</span>
-<span class="fu">&gt;</span> (<span class="kw">Right</span> a, <span class="kw">Right</span> b) <span class="ot">-&gt;</span> <span class="kw">Right</span> (a, b)
-<span class="fu">&gt;</span> (<span class="kw">Left</span> (v1, a1'), <span class="kw">Left</span> (v2,a2')) <span class="ot">-&gt;</span> <span class="kw">Left</span> (v1 <span class="ot">`mappend`</span> v2, both a1' a2')
-<span class="fu">&gt;</span> (<span class="kw">Right</span> a, <span class="kw">Left</span> (v, a2')) <span class="ot">-&gt;</span> <span class="kw">Left</span> (v, arr (\x <span class="ot">-&gt;</span> (a,x)) <span class="fu">&gt;&gt;&gt;</span> second a2')
-<span class="fu">&gt;</span> (<span class="kw">Left</span> (v, a1'), <span class="kw">Right</span> b) <span class="ot">-&gt;</span> <span class="kw">Left</span> (v, arr (\x <span class="ot">-&gt;</span> (x,b)) <span class="fu">&gt;&gt;&gt;</span> first a1')</code></pre>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> test8 <span class="fu">=</span> experiment (run <span class="fu">$</span> both (match (idConv <span class="fu">odd</span>)) (match <span class="fu">$</span> idConv (<span class="fu">&gt;</span><span class="dv">3</span>)))
-<span class="fu">&gt;</span> (listGenerator [<span class="dv">1</span><span class="fu">..</span><span class="dv">10</span>]) ([<span class="dv">4</span>])</code></pre>
+<span class="ot">&gt;</span>
+<span class="ot">&gt; both ::</span>(<span class="dt">Monoid</span> o) <span class="ot">=&gt;</span> <span class="dt">Auto2</span> i o i a <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i b <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i (a,b)
+<span class="ot">&gt;</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">-&gt;</span>
+<span class="ot">&gt;</span> <span class="kw">case</span> (f1 x, f2 x) <span class="kw">of</span>
+<span class="ot">&gt;</span> (<span class="kw">Right</span> a, <span class="kw">Right</span> b) <span class="ot">-&gt;</span> <span class="kw">Right</span> (a, b)
+<span class="ot">&gt;</span> (<span class="kw">Left</span> (v1, a1'), <span class="kw">Left</span> (v2,a2')) <span class="ot">-&gt;</span> <span class="kw">Left</span> (v1 <span class="ot">`mappend`</span> v2, both a1' a2')
+<span class="ot">&gt;</span> (<span class="kw">Right</span> a, <span class="kw">Left</span> (v, a2')) <span class="ot">-&gt;</span> <span class="kw">Left</span> (v, arr (\x <span class="ot">-&gt;</span> (a,x)) <span class="fu">&gt;&gt;&gt;</span> second a2')
+<span class="ot">&gt;</span> (<span class="kw">Left</span> (v, a1'), <span class="kw">Right</span> b) <span class="ot">-&gt;</span> <span class="kw">Left</span> (v, arr (\x <span class="ot">-&gt;</span> (x,b)) <span class="fu">&gt;&gt;&gt;</span> first a1')</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> test8 <span class="fu">=</span> experiment (run <span class="fu">$</span> both (match (idConv <span class="fu">odd</span>)) (match <span class="fu">$</span> idConv (<span class="fu">&gt;</span><span class="dv">3</span>)))
+<span class="ot">&gt;</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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> test9 <span class="fu">=</span> experiment (run <span class="fu">$</span> (match <span class="fu">$</span> idConv <span class="fu">odd</span>) <span class="ot">`both`</span>
-<span class="fu">&gt;</span> (match <span class="fu">$</span> idConv (<span class="fu">&gt;</span><span class="dv">3</span>)) <span class="ot">`both`</span>
-<span class="fu">&gt;</span> (match <span class="fu">$</span> idConv <span class="fu">even</span>))
-<span class="fu">&gt;</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">&gt;</span> test9 <span class="fu">=</span> experiment (run <span class="fu">$</span> (match <span class="fu">$</span> idConv <span class="fu">odd</span>) <span class="ot">`both`</span>
+<span class="ot">&gt;</span> (match <span class="fu">$</span> idConv (<span class="fu">&gt;</span><span class="dv">3</span>)) <span class="ot">`both`</span>
+<span class="ot">&gt;</span> (match <span class="fu">$</span> idConv <span class="fu">even</span>))
+<span class="ot">&gt;</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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> filterI ::</span>(<span class="dt">Zero</span> o) <span class="ot">=&gt;</span> (i <span class="ot">-&gt;</span> <span class="dt">Bool</span>) <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i b <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i b
-<span class="fu">&gt;</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">-&gt;</span>
-<span class="fu">&gt;</span> <span class="kw">if</span> p i
-<span class="fu">&gt;</span> <span class="kw">then</span> <span class="kw">case</span> f i <span class="kw">of</span>
-<span class="fu">&gt;</span> <span class="kw">Left</span> (v, a') <span class="ot">-&gt;</span> <span class="kw">Left</span> (v, filterI p a')
-<span class="fu">&gt;</span> <span class="kw">Right</span> b <span class="ot">-&gt;</span> <span class="kw">Right</span> b
-<span class="fu">&gt;</span> <span class="kw">else</span> <span class="kw">Left</span> (zero,filterI p a)</code></pre>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> test10 <span class="fu">=</span> experiment (run <span class="fu">$</span> filterI (<span class="fu">&gt;</span><span class="dv">5</span>) <span class="fu">$</span> both (match (idConv <span class="fu">odd</span>)) (match <span class="fu">$</span> idConv (<span class="fu">&gt;</span><span class="dv">3</span>)))
-<span class="fu">&gt;</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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> mapI ::</span> (i <span class="ot">-&gt;</span> a) <span class="ot">-&gt;</span> <span class="dt">Auto2</span> a o a b <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i b
-<span class="fu">&gt;</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">-&gt;</span>
-<span class="fu">&gt;</span> <span class="kw">case</span> f (g i) <span class="kw">of</span>
-<span class="fu">&gt;</span> <span class="kw">Left</span> (v, a') <span class="ot">-&gt;</span> <span class="kw">Left</span> (v, mapI g a')
-<span class="fu">&gt;</span> <span class="kw">Right</span> b <span class="ot">-&gt;</span> <span class="kw">Right</span> b</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; filterI ::</span>(<span class="dt">Zero</span> o) <span class="ot">=&gt;</span> (i <span class="ot">-&gt;</span> <span class="dt">Bool</span>) <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i b <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i b
+<span class="ot">&gt;</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">-&gt;</span>
+<span class="ot">&gt;</span> <span class="kw">if</span> p i
+<span class="ot">&gt;</span> <span class="kw">then</span> <span class="kw">case</span> f i <span class="kw">of</span>
+<span class="ot">&gt;</span> <span class="kw">Left</span> (v, a') <span class="ot">-&gt;</span> <span class="kw">Left</span> (v, filterI p a')
+<span class="ot">&gt;</span> <span class="kw">Right</span> b <span class="ot">-&gt;</span> <span class="kw">Right</span> b
+<span class="ot">&gt;</span> <span class="kw">else</span> <span class="kw">Left</span> (zero,filterI p a)</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> test10 <span class="fu">=</span> experiment (run <span class="fu">$</span> filterI (<span class="fu">&gt;</span><span class="dv">5</span>) <span class="fu">$</span> both (match (idConv <span class="fu">odd</span>)) (match <span class="fu">$</span> idConv (<span class="fu">&gt;</span><span class="dv">3</span>)))
+<span class="ot">&gt;</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">&gt; mapI ::</span> (i <span class="ot">-&gt;</span> a) <span class="ot">-&gt;</span> <span class="dt">Auto2</span> a o a b <span class="ot">-&gt;</span> <span class="dt">Auto2</span> i o i b
+<span class="ot">&gt;</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">-&gt;</span>
+<span class="ot">&gt;</span> <span class="kw">case</span> f (g i) <span class="kw">of</span>
+<span class="ot">&gt;</span> <span class="kw">Left</span> (v, a') <span class="ot">-&gt;</span> <span class="kw">Left</span> (v, mapI g a')
+<span class="ot">&gt;</span> <span class="kw">Right</span> b <span class="ot">-&gt;</span> <span class="kw">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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</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="fu">&gt;</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="fu">&gt;</span> <span class="kw">instance</span> (<span class="kw">Show</span> a) <span class="ot">=&gt;</span> <span class="kw">Show</span> (<span class="dt">ROutput</span> i o a) <span class="kw">where</span>
-<span class="fu">&gt;</span> <span class="fu">show</span> (<span class="dt">Output</span> a) <span class="fu">=</span> <span class="fu">show</span> a
-<span class="fu">&gt;</span> <span class="fu">show</span> (<span class="dt">NewListener</span> _ i) <span class="fu">=</span> <span class="st">&quot;&lt;listener:&quot;</span> <span class="fu">++</span> <span class="fu">show</span> i <span class="fu">++</span> <span class="st">&quot;&gt;&quot;</span></code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</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">&gt;</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">&gt;</span> <span class="kw">instance</span> (<span class="kw">Show</span> a) <span class="ot">=&gt;</span> <span class="kw">Show</span> (<span class="dt">ROutput</span> i o a) <span class="kw">where</span>
+<span class="ot">&gt;</span> <span class="fu">show</span> (<span class="dt">Output</span> a) <span class="fu">=</span> <span class="fu">show</span> a
+<span class="ot">&gt;</span> <span class="fu">show</span> (<span class="dt">NewListener</span> _ i) <span class="fu">=</span> <span class="st">&quot;&lt;listener:&quot;</span> <span class="fu">++</span> <span class="fu">show</span> i <span class="fu">++</span> <span class="st">&quot;&gt;&quot;</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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</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">-&gt;</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="fu">&gt;</span>
-<span class="fu">&gt;</span> <span class="kw">instance</span> (<span class="kw">Show</span> b) <span class="ot">=&gt;</span> <span class="kw">Show</span> (<span class="dt">Auto4</span> i o a b) <span class="kw">where</span>
-<span class="fu">&gt;</span> <span class="fu">show</span> x <span class="fu">=</span> <span class="st">&quot;&lt;auto&gt;&quot;</span></code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</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">-&gt;</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">&gt;</span>
+<span class="ot">&gt;</span> <span class="kw">instance</span> (<span class="kw">Show</span> b) <span class="ot">=&gt;</span> <span class="kw">Show</span> (<span class="dt">Auto4</span> i o a b) <span class="kw">where</span>
+<span class="ot">&gt;</span> <span class="fu">show</span> x <span class="fu">=</span> <span class="st">&quot;&lt;auto&gt;&quot;</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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> buildUpdate ::</span> <span class="dt">ROutput</span> i o a <span class="ot">-&gt;</span> (a, <span class="dt">ROutput</span> i o b <span class="ot">-&gt;</span> <span class="dt">ROutput</span> i o b)
-<span class="fu">&gt;</span> buildUpdate (<span class="dt">Output</span> a) <span class="fu">=</span> (a, <span class="fu">id</span>)
-<span class="fu">&gt;</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="fu">&gt;</span>
-<span class="fu">&gt;</span> zrec2 g (<span class="kw">Right</span> x) <span class="fu">=</span> <span class="kw">Right</span> <span class="fu">$</span> g x
-<span class="fu">&gt;</span> zrec2 g (<span class="kw">Left</span> (o, <span class="dt">Auto4</span> f)) <span class="fu">=</span> <span class="kw">Left</span> (o, <span class="dt">Auto4</span> <span class="fu">$</span> \x <span class="ot">-&gt;</span> zrec2 g (f x))
-<span class="fu">&gt;</span>
-<span class="fu">&gt;</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="fu">&gt;</span> <span class="fu">id</span> <span class="fu">=</span> <span class="dt">Auto4</span> <span class="fu">$</span> \x <span class="ot">-&gt;</span> <span class="kw">Right</span> (<span class="dt">Output</span> x)
-<span class="fu">&gt;</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">-&gt;</span>
-<span class="fu">&gt;</span> <span class="kw">let</span> out1 <span class="fu">=</span> f1 x
-<span class="fu">&gt;</span> <span class="kw">in</span> <span class="kw">case</span> out1 <span class="kw">of</span>
-<span class="fu">&gt;</span> <span class="kw">Right</span> b <span class="ot">-&gt;</span> <span class="kw">let</span> (y, g) <span class="fu">=</span> buildUpdate b
-<span class="fu">&gt;</span> <span class="kw">in</span> zrec2 g (f2 y)
-<span class="fu">&gt;</span> <span class="kw">Left</span> (o, auto1') <span class="ot">-&gt;</span> <span class="kw">Left</span> (o, (a2 <span class="fu">.</span> auto1'))</code></pre>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> addListener a <span class="fu">=</span> <span class="dt">Auto4</span> <span class="fu">$</span> \x <span class="ot">-&gt;</span> <span class="kw">Right</span> <span class="fu">$</span> <span class="dt">NewListener</span> a (<span class="dt">Output</span> x)</code></pre>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</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="fu">&gt;</span> arr f <span class="fu">=</span> <span class="dt">Auto4</span> (\x <span class="ot">-&gt;</span> <span class="kw">Right</span> (<span class="dt">Output</span> <span class="fu">$</span> f x))
-<span class="fu">&gt;</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">-&gt;</span>
-<span class="fu">&gt;</span> zrec2 (\z <span class="ot">-&gt;</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 haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> <span class="co">{- TBD</span>
-<span class="co">&gt; instance ArrowChoice (Auto4 i o) where</span>
-<span class="co">&gt; -- left :: a b c -&gt; a (Either b d) (Either c d)</span>
-<span class="co">&gt; left (Auto4 f) = Auto4 $ \x -&gt; </span>
-<span class="co">&gt; case x of</span>
-<span class="co">&gt; Left b -&gt; zrec2 (\z -&gt; let (z',g) = buildUpdate z in Left $ g z' ) (f b)</span>
-<span class="co">&gt; --(\z -&gt; let (z',g) = buildUpdate z in g (Output $ Left z)) (f b)</span>
-<span class="co">&gt; Right d -&gt; Right $ Output (Right d)</span>
-<span class="co">&gt; -}</span></code></pre>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> extractListeners ::</span> <span class="dt">ROutput</span> i o a <span class="ot">-&gt;</span> ([<span class="dt">Auto4</span> i o i ()], a)
-<span class="fu">&gt;</span> extractListeners <span class="fu">=</span> go []
-<span class="fu">&gt;</span> <span class="kw">where</span> go acc (<span class="dt">Output</span> x) <span class="fu">=</span> (acc, x)
-<span class="fu">&gt;</span> go acc (<span class="dt">NewListener</span> l x) <span class="fu">=</span> go (l<span class="fu">:</span>acc) x
-<span class="fu">&gt;</span>
-<span class="fu">&gt;</span>
-<span class="fu">&gt;</span><span class="ot"> runner2 ::</span> (<span class="kw">Show</span> i, <span class="dt">Monoid</span> o) <span class="ot">=&gt;</span> <span class="dt">External</span> o i <span class="ot">-&gt;</span> [<span class="dt">Auto4</span> i o i ()] <span class="ot">-&gt;</span> <span class="dt">IO</span> ()
-<span class="fu">&gt;</span> runner2 ext autos <span class="fu">=</span> <span class="kw">do</span>
-<span class="fu">&gt;</span> x <span class="ot">&lt;-</span> output ext
-<span class="fu">&gt;</span> <span class="fu">putStr</span> <span class="fu">$</span> <span class="st">&quot;received: &quot;</span> <span class="fu">++</span> <span class="fu">show</span> x
-<span class="fu">&gt;</span> <span class="co">{--- we will take a took at this line --}</span>
-<span class="fu">&gt;</span> <span class="kw">let</span> rets <span class="fu">=</span> <span class="fu">map</span> (<span class="fu">flip</span> stepAuto4 x) autos <span class="co">-- we run all autos </span>
-<span class="fu">&gt;</span> (l, r)<span class="fu">=</span> <span class="fu">unzip</span> <span class="fu">$</span> <span class="fu">map</span> results rets
-<span class="fu">&gt;</span> <span class="fu">mapM_</span> (input ext) r
-<span class="fu">&gt;</span> runner2 ext (<span class="fu">concat</span> l)
-<span class="fu">&gt;</span> <span class="kw">where</span>
-<span class="fu">&gt;</span> <span class="co">-- results :: Either (ROutput i o o, Auto4 i o i ()) (ROutput i o ()) -&gt; ([Auto4 i o i ()],o)</span>
-<span class="fu">&gt;</span> results (<span class="kw">Left</span> (req,next)) <span class="fu">=</span> <span class="kw">let</span> (ls, x) <span class="fu">=</span> extractListeners req
-<span class="fu">&gt;</span> <span class="kw">in</span> (next<span class="fu">:</span>ls,x)
-<span class="fu">&gt;</span> results (<span class="kw">Right</span> req) <span class="fu">=</span> <span class="kw">let</span> (ls, _) <span class="fu">=</span> extractListeners req
-<span class="fu">&gt;</span> <span class="kw">in</span> (ls, mempty)
-<span class="fu">&gt;</span> run2 f g <span class="fu">=</span> runner g f</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; buildUpdate ::</span> <span class="dt">ROutput</span> i o a <span class="ot">-&gt;</span> (a, <span class="dt">ROutput</span> i o b <span class="ot">-&gt;</span> <span class="dt">ROutput</span> i o b)
+<span class="ot">&gt;</span> buildUpdate (<span class="dt">Output</span> a) <span class="fu">=</span> (a, <span class="fu">id</span>)
+<span class="ot">&gt;</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">&gt;</span>
+<span class="ot">&gt;</span> zrec2 g (<span class="kw">Right</span> x) <span class="fu">=</span> <span class="kw">Right</span> <span class="fu">$</span> g x
+<span class="ot">&gt;</span> zrec2 g (<span class="kw">Left</span> (o, <span class="dt">Auto4</span> f)) <span class="fu">=</span> <span class="kw">Left</span> (o, <span class="dt">Auto4</span> <span class="fu">$</span> \x <span class="ot">-&gt;</span> zrec2 g (f x))
+<span class="ot">&gt;</span>
+<span class="ot">&gt;</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">&gt;</span> <span class="fu">id</span> <span class="fu">=</span> <span class="dt">Auto4</span> <span class="fu">$</span> \x <span class="ot">-&gt;</span> <span class="kw">Right</span> (<span class="dt">Output</span> x)
+<span class="ot">&gt;</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">-&gt;</span>
+<span class="ot">&gt;</span> <span class="kw">let</span> out1 <span class="fu">=</span> f1 x
+<span class="ot">&gt;</span> <span class="kw">in</span> <span class="kw">case</span> out1 <span class="kw">of</span>
+<span class="ot">&gt;</span> <span class="kw">Right</span> b <span class="ot">-&gt;</span> <span class="kw">let</span> (y, g) <span class="fu">=</span> buildUpdate b
+<span class="ot">&gt;</span> <span class="kw">in</span> zrec2 g (f2 y)
+<span class="ot">&gt;</span> <span class="kw">Left</span> (o, auto1') <span class="ot">-&gt;</span> <span class="kw">Left</span> (o, (a2 <span class="fu">.</span> auto1'))</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> addListener a <span class="fu">=</span> <span class="dt">Auto4</span> <span class="fu">$</span> \x <span class="ot">-&gt;</span> <span class="kw">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">&gt;</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">&gt;</span> arr f <span class="fu">=</span> <span class="dt">Auto4</span> (\x <span class="ot">-&gt;</span> <span class="kw">Right</span> (<span class="dt">Output</span> <span class="fu">$</span> f x))
+<span class="ot">&gt;</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">-&gt;</span>
+<span class="ot">&gt;</span> zrec2 (\z <span class="ot">-&gt;</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">&gt;</span> <span class="co">{- TBD</span>
+<span class="ot">&gt;</span><span class="co"> instance ArrowChoice (Auto4 i o) where</span>
+<span class="ot">&gt;</span><span class="co"> -- left :: a b c -&gt; a (Either b d) (Either c d)</span>
+<span class="ot">&gt;</span><span class="co"> left (Auto4 f) = Auto4 $ \x -&gt; </span>
+<span class="ot">&gt;</span><span class="co"> case x of</span>
+<span class="ot">&gt;</span><span class="co"> Left b -&gt; zrec2 (\z -&gt; let (z',g) = buildUpdate z in Left $ g z' ) (f b)</span>
+<span class="ot">&gt;</span><span class="co"> --(\z -&gt; let (z',g) = buildUpdate z in g (Output $ Left z)) (f b)</span>
+<span class="ot">&gt;</span><span class="co"> Right d -&gt; Right $ Output (Right d)</span>
+<span class="ot">&gt;</span><span class="co"> -}</span></code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; extractListeners ::</span> <span class="dt">ROutput</span> i o a <span class="ot">-&gt;</span> ([<span class="dt">Auto4</span> i o i ()], a)
+<span class="ot">&gt;</span> extractListeners <span class="fu">=</span> go []
+<span class="ot">&gt;</span> <span class="kw">where</span> go acc (<span class="dt">Output</span> x) <span class="fu">=</span> (acc, x)
+<span class="ot">&gt;</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">&gt;</span>
+<span class="ot">&gt;</span>
+<span class="ot">&gt; runner2 ::</span> (<span class="kw">Show</span> i, <span class="dt">Monoid</span> o) <span class="ot">=&gt;</span> <span class="dt">External</span> o i <span class="ot">-&gt;</span> [<span class="dt">Auto4</span> i o i ()] <span class="ot">-&gt;</span> <span class="dt">IO</span> ()
+<span class="ot">&gt;</span> runner2 ext autos <span class="fu">=</span> <span class="kw">do</span>
+<span class="ot">&gt;</span> x <span class="ot">&lt;-</span> output ext
+<span class="ot">&gt;</span> <span class="fu">putStr</span> <span class="fu">$</span> <span class="st">&quot;received: &quot;</span> <span class="fu">++</span> <span class="fu">show</span> x
+<span class="ot">&gt;</span> <span class="co">{--- we will take a took at this line --}</span>
+<span class="ot">&gt;</span> <span class="kw">let</span> rets <span class="fu">=</span> <span class="fu">map</span> (<span class="fu">flip</span> stepAuto4 x) autos <span class="co">-- we run all autos </span>
+<span class="ot">&gt;</span> (l, r)<span class="fu">=</span> <span class="fu">unzip</span> <span class="fu">$</span> <span class="fu">map</span> results rets
+<span class="ot">&gt;</span> <span class="fu">mapM_</span> (input ext) r
+<span class="ot">&gt;</span> runner2 ext (<span class="fu">concat</span> l)
+<span class="ot">&gt;</span> <span class="kw">where</span>
+<span class="ot">&gt;</span> <span class="co">-- results :: Either (ROutput i o o, Auto4 i o i ()) (ROutput i o ()) -&gt; ([Auto4 i o i ()],o)</span>
+<span class="ot">&gt;</span> results (<span class="kw">Left</span> (req,next)) <span class="fu">=</span> <span class="kw">let</span> (ls, x) <span class="fu">=</span> extractListeners req
+<span class="ot">&gt;</span> <span class="kw">in</span> (next<span class="fu">:</span>ls,x)
+<span class="ot">&gt;</span> results (<span class="kw">Right</span> req) <span class="fu">=</span> <span class="kw">let</span> (ls, _) <span class="fu">=</span> extractListeners req
+<span class="ot">&gt;</span> <span class="kw">in</span> (ls, mempty)
+<span class="ot">&gt;</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>
View
10 index.html
@@ -30,6 +30,10 @@
Recent posts
<ul>
<li>
+ <a href="./posts/2013-04-07-announcing-binary-conduit.html">Anouncing binary conduit</a>
+ - <em>April 7, 2013</em> - by <em>Alexander Vershilov</em>
+</li>
+<li>
<a href="./posts/2013-03-31-gentoo-haskell.html">Немного о gentoo-haskell</a>
- <em>March 31, 2013</em> - by <em>Alexander Vershilov</em>
</li>
@@ -65,14 +69,10 @@
<a href="./posts/2013-01-01-playing-with-trees-one.html">Playing with trees: prefix map</a>
- <em>January 1, 2013</em> - by <em>Alexander Vershilov</em>
</li>
-<li>
- <a href="./posts/2012-01-30-cabal-dev.html">cabal-dev</a>
- - <em>January 30, 2010</em> - by <em>Alexander Vershilov</em>
-</li>
</ul>
-<p>Browse: <a href="./tags/cgroups.html">cgroups (1)</a>, <a href="./tags/gentoo.html">gentoo (1)</a>, <a href="./tags/hakyll.html">hakyll (1)</a>, <a href="./tags/haskell.html">haskell (5)</a>, <a href="./tags/latex.html">latex (1)</a>, <a href="./tags/linux.html">linux (1)</a>, <a href="./tags/pam.html">pam (1)</a>, <a href="./tags/phys.html">phys (1)</a>, <a href="./tags/resourcet.html">resourcet (1)</a>, <a href="./tags/univ.html">univ (1)</a>, <a href="./tags/web.html">web (1)</a></p>
+<p>Browse: <a href="./tags/cgroups.html">cgroups (1)</a>, <a href="./tags/gentoo.html">gentoo (1)</a>, <a href="./tags/hakyll.html">hakyll (1)</a>, <a href="./tags/haskell.html">haskell (6)</a>, <a href="./tags/latex.html">latex (1)</a>, <a href="./tags/linux.html">linux (1)</a>, <a href="./tags/pam.html">pam (1)</a>, <a href="./tags/phys.html">phys (1)</a>, <a href="./tags/projects.html">projects (1)</a>, <a href="./tags/resourcet.html">resourcet (1)</a>, <a href="./tags/univ.html">univ (1)</a>, <a href="./tags/web.html">web (1)</a></p>
<footer>
Site generated using <a href="http://jaspervdj.be/hakyll">Hakyll</a> using <a href="http://johnmacfarlane.net/pandoc/">pandoc</a>
View
12 posts.html
@@ -30,6 +30,10 @@
<h1>All posts</h1>
<ul>
<li>
+ <a href="./posts/2013-04-07-announcing-binary-conduit.html">Anouncing binary conduit</a>
+ - <em>April 7, 2013</em> - by <em>Alexander Vershilov</em>
+</li>
+<li>
<a href="./posts/2013-03-31-gentoo-haskell.html">Немного о gentoo-haskell</a>
- <em>March 31, 2013</em> - by <em>Alexander Vershilov</em>
</li>
@@ -66,13 +70,13 @@
- <em>January 1, 2013</em> - by <em>Alexander Vershilov</em>
</li>
<li>
- <a href="./posts/2012-01-30-cabal-dev.html">cabal-dev</a>
- - <em>January 30, 2010</em> - by <em>Alexander Vershilov</em>
-</li>
-<li>
<a href="./posts/2010-05-09-java-runtime-exec.html">java//Runtime exec</a>
- <em>May 9, 2010</em> - by <em>Alexander Vershilov</em>
</li>
+<li>
+ <a href="./posts/2012-01-30-cabal-dev.html">cabal-dev</a>
+ - <em>January 30, 2010</em> - by <em>Alexander Vershilov</em>
+</li>
</ul>
View
164 posts/2013-01-01-playing-with-trees-one.html
@@ -32,95 +32,95 @@
</div>
<p>We introduce a binary tree like data structure with next structure.</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> <span class="ot">{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}</span>
-<span class="fu">&gt;</span>
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Prelude</span> <span class="kw">hiding</span> (<span class="fu">head</span>, <span class="fu">length</span>, <span class="fu">drop</span>, <span class="fu">take</span>, <span class="fu">lookup</span>, <span class="fu">null</span>)
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Data.Function</span>
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Data.ByteString.Char8</span> <span class="kw">hiding</span> (empty)
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Test.QuickCheck</span>
-<span class="fu">&gt;</span>
-<span class="fu">&gt;</span> <span class="co">-- [Node (current value) l v r eq]</span>
-<span class="fu">&gt;</span> <span class="co">-- | | | +------------------------------------+</span>
-<span class="fu">&gt;</span> <span class="co">-- +---------------------+ | +------------------+ |</span>
-<span class="fu">&gt;</span> <span class="co">-- | | | |</span>
-<span class="fu">&gt;</span> <span class="co">-- + | + |</span>
-<span class="fu">&gt;</span> <span class="co">-- element less value or nothing elements that elements that</span>
-<span class="fu">&gt;</span> <span class="co">-- than current if it intermideate are more then have &lt;current value&gt;</span>
-<span class="fu">&gt;</span> <span class="co">-- node current as prefix</span>
-<span class="fu">&gt;</span> <span class="co">-- </span></code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> <span class="ot">{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}</span>
+<span class="ot">&gt;</span>
+<span class="ot">&gt;</span> <span class="kw">import</span> Prelude <span class="kw">hiding</span> (head, length, drop, take, lookup, null)
+<span class="ot">&gt;</span> <span class="kw">import</span> Data.Function
+<span class="ot">&gt;</span> <span class="kw">import</span> Data.ByteString.Char8 <span class="kw">hiding</span> (empty)
+<span class="ot">&gt;</span> <span class="kw">import</span> Test.QuickCheck
+<span class="ot">&gt;</span>
+<span class="ot">&gt;</span> <span class="co">-- [Node (current value) l v r eq]</span>
+<span class="ot">&gt;</span> <span class="co">-- | | | +------------------------------------+</span>
+<span class="ot">&gt;</span> <span class="co">-- +---------------------+ | +------------------+ |</span>
+<span class="ot">&gt;</span> <span class="co">-- | | | |</span>
+<span class="ot">&gt;</span> <span class="co">-- + | + |</span>
+<span class="ot">&gt;</span> <span class="co">-- element less value or nothing elements that elements that</span>
+<span class="ot">&gt;</span> <span class="co">-- than current if it intermideate are more then have &lt;current value&gt;</span>
+<span class="ot">&gt;</span> <span class="co">-- node current as prefix</span>
+<span class="ot">&gt;</span> <span class="co">-- </span></code></pre>
<p>Top level item represent empty value and can have a value.</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> <span class="kw">type</span> <span class="dt">PrefixMap</span> a <span class="fu">=</span> (<span class="dt">Maybe</span> a, <span class="dt">PMap</span> a)</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> <span class="kw">type</span> <span class="dt">PrefixMap</span> a <span class="fu">=</span> (<span class="dt">Maybe</span> a, <span class="dt">PMap</span> a)</code></pre>
<p>Inner tree is either an empty value or node, that has left/right children and maybe can have a value and next element</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> <span class="kw">data</span> <span class="dt">PMap</span> a <span class="fu">=</span> <span class="dt">E</span>
-<span class="fu">&gt;</span> <span class="fu">|</span> <span class="dt">N</span> <span class="dt">ByteString</span> (<span class="dt">PMap</span> a) (<span class="dt">Maybe</span> a) (<span class="dt">PMap</span> a) (<span class="dt">PMap</span> a)
-<span class="fu">&gt;</span> <span class="co">{- current less value more eq -}</span>
-<span class="fu">&gt;</span> <span class="kw">deriving</span> (<span class="kw">Show</span>)</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> <span class="kw">data</span> <span class="dt">PMap</span> a <span class="fu">=</span> <span class="dt">E</span>
+<span class="ot">&gt;</span> <span class="fu">|</span> <span class="dt">N</span> <span class="dt">ByteString</span> (<span class="dt">PMap</span> a) (<span class="dt">Maybe</span> a) (<span class="dt">PMap</span> a) (<span class="dt">PMap</span> a)
+<span class="ot">&gt;</span> <span class="co">{- current less value more eq -}</span>
+<span class="ot">&gt;</span> <span class="kw">deriving</span> (<span class="kw">Show</span>)</code></pre>
<p>Having PrefixMap as a additional layer we can assume, that we have a non-null prefix on each level.</p>
<p>Introduce simple builders</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> empty ::</span> <span class="dt">PrefixMap</span> a
-<span class="fu">&gt;</span> empty <span class="fu">=</span> (<span class="kw">Nothing</span>, <span class="dt">E</span>)
-<span class="fu">&gt;</span>
-<span class="fu">&gt;</span><span class="ot"> node ::</span> <span class="dt">ByteString</span> <span class="ot">-&gt;</span> a <span class="ot">-&gt;</span> <span class="dt">PrefixMap</span> a
-<span class="fu">&gt;</span> node b a <span class="fu">|</span> <span class="fu">null</span> b <span class="fu">=</span> (<span class="kw">Just</span> a, <span class="dt">E</span>)
-<span class="fu">&gt;</span> <span class="fu">|</span> <span class="fu">otherwise</span> <span class="fu">=</span> (<span class="kw">Nothing</span>, <span class="dt">N</span> b <span class="dt">E</span> (<span class="kw">Just</span> a) <span class="dt">E</span> <span class="dt">E</span>)</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; empty ::</span> <span class="dt">PrefixMap</span> a
+<span class="ot">&gt;</span> empty <span class="fu">=</span> (<span class="kw">Nothing</span>, <span class="dt">E</span>)
+<span class="ot">&gt;</span>
+<span class="ot">&gt; node ::</span> <span class="dt">ByteString</span> <span class="ot">-&gt;</span> a <span class="ot">-&gt;</span> <span class="dt">PrefixMap</span> a
+<span class="ot">&gt;</span> node b a <span class="fu">|</span> <span class="fu">null</span> b <span class="fu">=</span> (<span class="kw">Just</span> a, <span class="dt">E</span>)
+<span class="ot">&gt;</span> <span class="fu">|</span> <span class="fu">otherwise</span> <span class="fu">=</span> (<span class="kw">Nothing</span>, <span class="dt">N</span> b <span class="dt">E</span> (<span class="kw">Just</span> a) <span class="dt">E</span> <span class="dt">E</span>)</code></pre>
<p>Now inserting elements it’s a bit tricky and may be simplified in the way of removing not needed insances</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> insert ::</span> <span class="dt">ByteString</span> <span class="ot">-&gt;</span> a <span class="ot">-&gt;</span> <span class="dt">PrefixMap</span> a <span class="ot">-&gt;</span> <span class="dt">PrefixMap</span> a
-<span class="fu">&gt;</span> insert b a (v,n) <span class="fu">|</span> <span class="fu">null</span> b <span class="fu">=</span> (<span class="kw">Just</span> a, n)
-<span class="fu">&gt;</span> <span class="fu">|</span> <span class="fu">otherwise</span> <span class="fu">=</span> (v, inner b a n)</code></pre>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> inner ::</span> <span class="dt">ByteString</span> <span class="ot">-&gt;</span> a <span class="ot">-&gt;</span> <span class="dt">PMap</span> a <span class="ot">-&gt;</span> <span class="dt">PMap</span> a
-<span class="fu">&gt;</span> inner b a <span class="dt">E</span> <span class="fu">=</span> <span class="dt">N</span> b <span class="dt">E</span> (<span class="kw">Just</span> a) <span class="dt">E</span> <span class="dt">E</span>
-<span class="fu">&gt;</span> inner b a n<span class="fu">@</span>(<span class="dt">N</span> b' l v r e) <span class="fu">|</span> <span class="fu">null</span> b <span class="fu">=</span> n
-<span class="fu">&gt;</span> <span class="fu">|</span> <span class="fu">otherwise</span> <span class="fu">=</span>
-<span class="fu">&gt;</span> <span class="kw">case</span> comparing <span class="fu">head</span> b b' <span class="kw">of</span>
-<span class="fu">&gt;</span> <span class="kw">LT</span> <span class="ot">-&gt;</span> <span class="dt">N</span> b' (inner b a l) v r e <span class="co">-- value less then current</span>
-<span class="fu">&gt;</span> <span class="kw">GT</span> <span class="ot">-&gt;</span> <span class="dt">N</span> b' l v (inner b a r) e <span class="co">-- value more then current</span>
-<span class="fu">&gt;</span> <span class="kw">EQ</span> <span class="ot">-&gt;</span> <span class="kw">let</span> x <span class="fu">=</span> commonPart b b' <span class="co">-- value has common part</span>
-<span class="fu">&gt;</span> c <span class="fu">=</span> <span class="fu">take</span> x b
-<span class="fu">&gt;</span> c'<span class="fu">=</span> <span class="fu">take</span> x b'
-<span class="fu">&gt;</span> n' <span class="fu">=</span> <span class="dt">N</span> (<span class="fu">drop</span> x b') <span class="dt">E</span> v <span class="dt">E</span> e
-<span class="fu">&gt;</span> <span class="kw">in</span> <span class="kw">if</span> on (<span class="fu">==</span>) <span class="fu">length</span> c b' <span class="co">-- b' isPrefix of b</span>
-<span class="fu">&gt;</span> <span class="kw">then</span>
-<span class="fu">&gt;</span> <span class="kw">if</span> on (<span class="fu">==</span>) <span class="fu">length</span> c b <span class="co">-- b' == b </span>
-<span class="fu">&gt;</span> <span class="kw">then</span> <span class="dt">N</span> c l (<span class="kw">Just</span> <span class="fu">$!</span> a <span class="ot">`fq`</span> v) r e
-<span class="fu">&gt;</span> <span class="kw">else</span> <span class="dt">N</span> c l v r (inner (<span class="fu">drop</span> x b) a e) <span class="co">-- [b &lt; b']</span>
-<span class="fu">&gt;</span> <span class="kw">else</span> <span class="co">-- [ c &lt; b ]</span>
-<span class="fu">&gt;</span> <span class="kw">if</span> on (<span class="fu">==</span>) <span class="fu">length</span> c b
-<span class="fu">&gt;</span> <span class="kw">then</span> <span class="dt">N</span> c' l (<span class="kw">Just</span> a) r n'
-<span class="fu">&gt;</span> <span class="kw">else</span> <span class="dt">N</span> c l <span class="kw">Nothing</span> r (inner (<span class="fu">drop</span> x b) a n')
-<span class="fu">&gt;</span> <span class="kw">where</span>
-<span class="fu">&gt;</span> fq a _ <span class="fu">=</span> a</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; insert ::</span> <span class="dt">ByteString</span> <span class="ot">-&gt;</span> a <span class="ot">-&gt;</span> <span class="dt">PrefixMap</span> a <span class="ot">-&gt;</span> <span class="dt">PrefixMap</span> a
+<span class="ot">&gt;</span> insert b a (v,n) <span class="fu">|</span> <span class="fu">null</span> b <span class="fu">=</span> (<span class="kw">Just</span> a, n)
+<span class="ot">&gt;</span> <span class="fu">|</span> <span class="fu">otherwise</span> <span class="fu">=</span> (v, inner b a n)</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; inner ::</span> <span class="dt">ByteString</span> <span class="ot">-&gt;</span> a <span class="ot">-&gt;</span> <span class="dt">PMap</span> a <span class="ot">-&gt;</span> <span class="dt">PMap</span> a
+<span class="ot">&gt;</span> inner b a <span class="dt">E</span> <span class="fu">=</span> <span class="dt">N</span> b <span class="dt">E</span> (<span class="kw">Just</span> a) <span class="dt">E</span> <span class="dt">E</span>
+<span class="ot">&gt;</span> inner b a n<span class="fu">@</span>(<span class="dt">N</span> b' l v r e) <span class="fu">|</span> <span class="fu">null</span> b <span class="fu">=</span> n
+<span class="ot">&gt;</span> <span class="fu">|</span> <span class="fu">otherwise</span> <span class="fu">=</span>
+<span class="ot">&gt;</span> <span class="kw">case</span> comparing <span class="fu">head</span> b b' <span class="kw">of</span>
+<span class="ot">&gt;</span> <span class="kw">LT</span> <span class="ot">-&gt;</span> <span class="dt">N</span> b' (inner b a l) v r e <span class="co">-- value less then current</span>
+<span class="ot">&gt;</span> <span class="kw">GT</span> <span class="ot">-&gt;</span> <span class="dt">N</span> b' l v (inner b a r) e <span class="co">-- value more then current</span>
+<span class="ot">&gt;</span> <span class="kw">EQ</span> <span class="ot">-&gt;</span> <span class="kw">let</span> x <span class="fu">=</span> commonPart b b' <span class="co">-- value has common part</span>
+<span class="ot">&gt;</span> c <span class="fu">=</span> <span class="fu">take</span> x b
+<span class="ot">&gt;</span> c'<span class="fu">=</span> <span class="fu">take</span> x b'
+<span class="ot">&gt;</span> n' <span class="fu">=</span> <span class="dt">N</span> (<span class="fu">drop</span> x b') <span class="dt">E</span> v <span class="dt">E</span> e
+<span class="ot">&gt;</span> <span class="kw">in</span> <span class="kw">if</span> on (<span class="fu">==</span>) <span class="fu">length</span> c b' <span class="co">-- b' isPrefix of b</span>
+<span class="ot">&gt;</span> <span class="kw">then</span>
+<span class="ot">&gt;</span> <span class="kw">if</span> on (<span class="fu">==</span>) <span class="fu">length</span> c b <span class="co">-- b' == b </span>
+<span class="ot">&gt;</span> <span class="kw">then</span> <span class="dt">N</span> c l (<span class="kw">Just</span> <span class="fu">$!</span> a <span class="ot">`fq`</span> v) r e
+<span class="ot">&gt;</span> <span class="kw">else</span> <span class="dt">N</span> c l v r (inner (<span class="fu">drop</span> x b) a e) <span class="co">-- [b &lt; b']</span>
+<span class="ot">&gt;</span> <span class="kw">else</span> <span class="co">-- [ c &lt; b ]</span>
+<span class="ot">&gt;</span> <span class="kw">if</span> on (<span class="fu">==</span>) <span class="fu">length</span> c b
+<span class="ot">&gt;</span> <span class="kw">then</span> <span class="dt">N</span> c' l (<span class="kw">Just</span> a) r n'
+<span class="ot">&gt;</span> <span class="kw">else</span> <span class="dt">N</span> c l <span class="kw">Nothing</span> r (inner (<span class="fu">drop</span> x b) a n')
+<span class="ot">&gt;</span> <span class="kw">where</span>
+<span class="ot">&gt;</span> fq a _ <span class="fu">=</span> a</code></pre>
<p>lookup function</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> lookup ::</span> <span class="dt">ByteString</span> <span class="ot">-&gt;</span> <span class="dt">PrefixMap</span> a <span class="ot">-&gt;</span> <span class="dt">Maybe</span> a
-<span class="fu">&gt;</span> <span class="fu">lookup</span> b (v, n) <span class="fu">|</span> <span class="fu">null</span> b <span class="fu">=</span> v
-<span class="fu">&gt;</span> <span class="fu">|</span> <span class="fu">otherwise</span> <span class="fu">=</span> lookinner b n</code></pre>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> lookinner ::</span> <span class="dt">ByteString</span> <span class="ot">-&gt;</span> <span class="dt">PMap</span> a <span class="ot">-&gt;</span> <span class="dt">Maybe</span> a
-<span class="fu">&gt;</span> lookinner b <span class="dt">E</span> <span class="fu">=</span> <span class="kw">Nothing</span>
-<span class="fu">&gt;</span> lookinner b (<span class="dt">N</span> b' l v r e) <span class="fu">=</span>
-<span class="fu">&gt;</span> <span class="kw">case</span> comparing <span class="fu">head</span> b b' <span class="kw">of</span>
-<span class="fu">&gt;</span> <span class="kw">LT</span> <span class="ot">-&gt;</span> lookinner b l
-<span class="fu">&gt;</span> <span class="kw">GT</span> <span class="ot">-&gt;</span> lookinner b r
-<span class="fu">&gt;</span> <span class="kw">EQ</span> <span class="ot">-&gt;</span> <span class="kw">let</span> x <span class="fu">=</span> commonPart b b'
-<span class="fu">&gt;</span> <span class="kw">in</span> <span class="kw">if</span> x <span class="fu">==</span> <span class="fu">length</span> b'
-<span class="fu">&gt;</span> <span class="kw">then</span> <span class="kw">if</span> x <span class="fu">==</span> <span class="fu">length</span> b <span class="kw">then</span> v <span class="kw">else</span> lookinner (<span class="fu">drop</span> x b) e
-<span class="fu">&gt;</span> <span class="kw">else</span> <span class="kw">Nothing</span></code></pre>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> commonPart ::</span> <span class="dt">ByteString</span> <span class="ot">-&gt;</span> <span class="dt">ByteString</span> <span class="ot">-&gt;</span> <span class="dt">Int</span>
-<span class="fu">&gt;</span> commonPart a b <span class="fu">=</span> go <span class="dv">0</span>
-<span class="fu">&gt;</span> <span class="kw">where</span>
-<span class="fu">&gt;</span><span class="ot"> go ::</span> <span class="dt">Int</span> <span class="ot">-&gt;</span> <span class="dt">Int</span>
-<span class="fu">&gt;</span> go x <span class="fu">|</span> x <span class="fu">==</span> y <span class="fu">=</span> x
-<span class="fu">&gt;</span> <span class="fu">|</span> on (<span class="fu">==</span>) (findex x) a b <span class="fu">=</span> go (x<span class="dv">+1</span>)
-<span class="fu">&gt;</span> <span class="fu">|</span> <span class="fu">otherwise</span> <span class="fu">=</span> x
-<span class="fu">&gt;</span> y <span class="fu">=</span> on <span class="fu">min</span> <span class="fu">length</span> a b
-<span class="fu">&gt;</span> findex <span class="fu">=</span> <span class="fu">flip</span> <span class="fu">index</span>
-<span class="fu">&gt;</span> <span class="ot">{-# INLINE findex #-}</span>
-<span class="fu">&gt;</span>
-<span class="fu">&gt;</span> comparing <span class="fu">=</span> on <span class="fu">compare</span></code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; lookup ::</span> <span class="dt">ByteString</span> <span class="ot">-&gt;</span> <span class="dt">PrefixMap</span> a <span class="ot">-&gt;</span> <span class="dt">Maybe</span> a
+<span class="ot">&gt;</span> <span class="fu">lookup</span> b (v, n) <span class="fu">|</span> <span class="fu">null</span> b <span class="fu">=</span> v
+<span class="ot">&gt;</span> <span class="fu">|</span> <span class="fu">otherwise</span> <span class="fu">=</span> lookinner b n</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; lookinner ::</span> <span class="dt">ByteString</span> <span class="ot">-&gt;</span> <span class="dt">PMap</span> a <span class="ot">-&gt;</span> <span class="dt">Maybe</span> a
+<span class="ot">&gt;</span> lookinner b <span class="dt">E</span> <span class="fu">=</span> <span class="kw">Nothing</span>
+<span class="ot">&gt;</span> lookinner b (<span class="dt">N</span> b' l v r e) <span class="fu">=</span>
+<span class="ot">&gt;</span> <span class="kw">case</span> comparing <span class="fu">head</span> b b' <span class="kw">of</span>
+<span class="ot">&gt;</span> <span class="kw">LT</span> <span class="ot">-&gt;</span> lookinner b l
+<span class="ot">&gt;</span> <span class="kw">GT</span> <span class="ot">-&gt;</span> lookinner b r
+<span class="ot">&gt;</span> <span class="kw">EQ</span> <span class="ot">-&gt;</span> <span class="kw">let</span> x <span class="fu">=</span> commonPart b b'
+<span class="ot">&gt;</span> <span class="kw">in</span> <span class="kw">if</span> x <span class="fu">==</span> <span class="fu">length</span> b'
+<span class="ot">&gt;</span> <span class="kw">then</span> <span class="kw">if</span> x <span class="fu">==</span> <span class="fu">length</span> b <span class="kw">then</span> v <span class="kw">else</span> lookinner (<span class="fu">drop</span> x b) e
+<span class="ot">&gt;</span> <span class="kw">else</span> <span class="kw">Nothing</span></code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; commonPart ::</span> <span class="dt">ByteString</span> <span class="ot">-&gt;</span> <span class="dt">ByteString</span> <span class="ot">-&gt;</span> <span class="dt">Int</span>
+<span class="ot">&gt;</span> commonPart a b <span class="fu">=</span> go <span class="dv">0</span>
+<span class="ot">&gt;</span> <span class="kw">where</span>
+<span class="ot">&gt; go ::</span> <span class="dt">Int</span> <span class="ot">-&gt;</span> <span class="dt">Int</span>
+<span class="ot">&gt;</span> go x <span class="fu">|</span> x <span class="fu">==</span> y <span class="fu">=</span> x
+<span class="ot">&gt;</span> <span class="fu">|</span> on (<span class="fu">==</span>) (findex x) a b <span class="fu">=</span> go (x<span class="fu">+</span><span class="dv">1</span>)
+<span class="ot">&gt;</span> <span class="fu">|</span> <span class="fu">otherwise</span> <span class="fu">=</span> x
+<span class="ot">&gt;</span> y <span class="fu">=</span> on <span class="fu">min</span> <span class="fu">length</span> a b
+<span class="ot">&gt;</span> findex <span class="fu">=</span> <span class="fu">flip</span> <span class="fu">index</span>
+<span class="ot">&gt;</span> <span class="ot">{-# INLINE findex #-}</span>
+<span class="ot">&gt;</span>
+<span class="ot">&gt;</span> comparing <span class="fu">=</span> on <span class="fu">compare</span></code></pre>
<p>Check if we are right</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> prop_InsertList (<span class="ot">ls::</span>[<span class="dt">String</span>]) <span class="fu">=</span>
-<span class="fu">&gt;</span> <span class="kw">let</span> x <span class="fu">=</span> Prelude.foldl (\o x <span class="ot">-&gt;</span> insert (<span class="fu">pack</span> x) (<span class="fu">pack</span> x) o) empty ls
-<span class="fu">&gt;</span> <span class="kw">in</span> Prelude.all (\l <span class="ot">-&gt;</span> (l<span class="fu">==</span><span class="st">&quot;&quot;</span>) <span class="fu">||</span> <span class="fu">pack</span> l <span class="ot">`lookup`</span> x <span class="fu">==</span> <span class="kw">Just</span> (<span class="fu">pack</span> l)) ls
-<span class="fu">&gt;</span>
-<span class="fu">&gt;</span> main <span class="fu">=</span> quickCheck prop_InsertList</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> prop_InsertList (<span class="ot">ls::</span>[<span class="dt">String</span>]) <span class="fu">=</span>
+<span class="ot">&gt;</span> <span class="kw">let</span> x <span class="fu">=</span> Prelude.foldl (\o x <span class="ot">-&gt;</span> insert (<span class="fu">pack</span> x) (<span class="fu">pack</span> x) o) empty ls
+<span class="ot">&gt;</span> <span class="kw">in</span> Prelude.all (\l <span class="ot">-&gt;</span> (l<span class="fu">==</span><span class="st">&quot;&quot;</span>) <span class="fu">||</span> <span class="fu">pack</span> l <span class="ot">`lookup`</span> x <span class="fu">==</span> <span class="kw">Just</span> (<span class="fu">pack</span> l)) ls
+<span class="ot">&gt;</span>
+<span class="ot">&gt;</span> main <span class="fu">=</span> quickCheck prop_InsertList</code></pre>
<p>What interesting is what properties to we have, ideally we can rewrite code thinking of a N c l v r e as a Tree (M v e)</p>
<p>Caveats:</p>
<ul>
View
178 posts/2013-01-20-automata.html
@@ -35,36 +35,36 @@
<p>I tried to use monadic approach, however I had too much problems because monads can bind and run opaque functions while all theese computation had to carry additional information, so I end up with function approach: each function returns a command and next function and special runner change it’s state based on this information but I ended with some problems: functions were bloated, function should be written from the end to begining, all additional variables should be passed explicitly through the functions, function can’t be composed as they had types constraints. It was a hell.. A day ago I have read the great arrows totorial http://ertes.de/new/tutorials/arrows.html by Ertugrul Söylemez, and realized that it was an arrow, after some thinking I’ve found a nice solution.</p>
<p>This is a literate haskell post so you can just copy it and compile.</p>
<p>We will need it at the very end to show arrow notation</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> <span class="ot">{-# LANGUAGE Arrows #-}</span></code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> <span class="ot">{-# LANGUAGE Arrows #-}</span></code></pre>
<p>We need this for defining new arrow instance.</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Prelude</span> <span class="kw">hiding</span> ((<span class="fu">.</span>), <span class="fu">id</span>)
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Control.Arrow</span>
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Control.Category</span></code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> <span class="kw">import</span> Prelude <span class="kw">hiding</span> ((.), id)
+<span class="ot">&gt;</span> <span class="kw">import</span> Control.Arrow
+<span class="ot">&gt;</span> <span class="kw">import</span> Control.Category</code></pre>
<p>We need this for describing outer world</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Control.Monad</span>
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Control.Concurrent.STM</span>
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Control.Concurrent</span>
-<span class="fu">&gt;</span> <span class="kw">import</span> <span class="dt">Control.Exception</span></code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt;</span> <span class="kw">import</span> Control.Monad
+<span class="ot">&gt;</span> <span class="kw">import</span> Control.Concurrent.STM
+<span class="ot">&gt;</span> <span class="kw">import</span> Control.Concurrent
+<span class="ot">&gt;</span> <span class="kw">import</span> Control.Exception</code></pre>
<p>Let’s prepare to solve our problem. At first we need to define an outer world bus i.e. an computation that can recieve requests, and sends responce. We define 2 channels for this purpose: input - requests, output - responce. This will not break generalization as you always can insert a channel based proxy between your computation and real-world bus.</p>
<p>So our realworld wrapper will look like:</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span><span class="ot"> run ::</span> <span class="dt">FIO</span> a b c <span class="ot">-&gt;</span> <span class="dt">Generator</span> b c <span class="ot">-&gt;</span> b <span class="ot">-&gt;</span> <span class="dt">IO</span> a
-<span class="fu">&gt;</span> run f g i <span class="fu">=</span>
-<span class="fu">&gt;</span> bracket (<span class="kw">do</span> in_ <span class="ot">&lt;-</span> newTChanIO
-<span class="fu">&gt;</span> out_ <span class="ot">&lt;-</span> newTChanIO
-<span class="fu">&gt;</span> t <span class="ot">&lt;-</span> forkIO <span class="fu">$</span> g in_ out_
-<span class="fu">&gt;</span> atomically <span class="fu">$</span> writeTChan in_ i
-<span class="fu">&gt;</span> <span class="fu">return</span> (t,in_,out_))
-<span class="fu">&gt;</span> (\(t, _, _) <span class="ot">-&gt;</span> killThread t)
-<span class="fu">&gt;</span> (\(_, i, o) <span class="ot">-&gt;</span> f i o)</code></pre>
+<pre class="sourceCode literate literatehaskell"><code class="sourceCode literatehaskell"><span class="ot">&gt; run ::</span> <span class="dt">FIO</span> a b c <span class="ot">-&gt;</span> <span class="dt">Generator</span> b c <span class="ot">-&gt;</span> b <span class="ot">-&gt;</span> <span class="dt">IO</span> a
+<span class="ot">&gt;</span> run f g i <span class="fu">=</span>
+<span class="ot">&gt;</span> bracket (<span class="kw">do</span> in_ <span class="ot">&lt;-</span> newTChanIO
+<span class="ot">&gt;</span> out_ <span class="ot">&lt;-</span> newTChanIO
+<span class="ot">&gt;</span> t <span class="ot">&lt;-</span> forkIO <span class="fu">$</span> g in_ out_
+<span class="ot">&gt;</span> atomically <span class="fu">$</span> writeTChan in_ i
+<span class="ot">&gt;</span> <span class="fu">return</span> (t,in_,out_))
+<span class="ot">&gt;</span> (\(t, _, _) <span class="ot">-&gt;</span> killThread t)
+<span class="ot">&gt;</span> (\(_, i, o) <span class="ot">-&gt;</span> f i o)</code></pre>
<p>, where FIO and Generator are helper types:</p>
-<pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="fu">&gt;</span> <span class="kw">type</span> <span class="dt">FIO</span> a b c <span class="fu">=</span> <span class="dt">TChan</span> b <span class="ot">-&gt;</span> <span class="dt