<div dir="ltr">The paper "Programming with Arrows" of John Hughes gives some exercises to do [1].<div>I'm trying to solve it and would like to receive a feedback if I'm doing it right or not before reading the rest of the paper.</div>
<div>I didn't find the answers in the internet (if someone could point me to it, please do so).</div><div><br></div><div>Exercise 2 (section 2.5) is asking to create a Stream Processor that can map more than one output per input (e.g. 3 outcomes for a single consume of the stream).</div>
<div><br></div><div>The paper says that implementing "first" will be tricky, and it really is. I've came up to the solution listed below, <b>is it right?</b></div><div><b><br></b></div><div><b><br></b></div>
<div><div><font face="courier new, monospace">module SP where</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">import Prelude hiding (id, (.))</font></div><div>
<font face="courier new, monospace">import Control.Category</font></div><div><font face="courier new, monospace">import Control.Arrow</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">data SP a b = Put b (SP a b) | Get (a -> SP a b)</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">runSP :: SP a b -> [a] -> [b]</font></div><div><font face="courier new, monospace">runSP (Put b s) as = b:runSP s as</font></div>
<div><font face="courier new, monospace">runSP (Get k) (a:as) = runSP (k a) as</font></div><div><font face="courier new, monospace">runSP (Get k) [] = []</font></div><div><font face="courier new, monospace"><br></font></div>
<div><font face="courier new, monospace">compose :: SP b c -> SP a b -> SP a c</font></div><div><font face="courier new, monospace">compose (Put a s) g = Put a (compose s g)</font></div><div><font face="courier new, monospace">compose (Get k) (Put a s) = compose (k a) s</font></div>
<div><font face="courier new, monospace">compose f (Get k) = Get (\a -> compose f (k a))</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">instance Category SP where</font></div>
<div><font face="courier new, monospace"> id = arr id</font></div><div><font face="courier new, monospace"> (.) = compose</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">instance Arrow SP where</font></div>
<div><font face="courier new, monospace"> arr f = Get (\a -> Put (f a) (arr f))</font></div><div><font face="courier new, monospace"> first (Put a s) = Get (\(a', c) -> Put (a, c) (delayed (a', c) s))</font></div>
<div><font face="courier new, monospace"> first (Get k) = Get (\(a, c) -> firstWithValue (k a) c)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">delayed :: (a, c) -> SP a b -> SP (a, c) (b, c)</font></div>
<div><font face="courier new, monospace">delayed (a, c) (Put b s) = Put (b, c) (delayed (a, c) s)</font></div><div><font face="courier new, monospace">delayed (a, c) (Get k) = firstWithValue (k a) c</font></div><div><font face="courier new, monospace"><br>
</font></div><div><font face="courier new, monospace">firstWithValue :: SP a b -> c -> SP (a, c) (b, c)</font></div><div><font face="courier new, monospace">firstWithValue (Put a s) c = Put (a, c) (firstWithValue s c)</font></div>
<div><font face="courier new, monospace">firstWithValue (Get k) _ = Get (\(a, c) -> firstWithValue (k a) c)</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">input :: [(String, String)]</font></div>
<div><font face="courier new, monospace">input = [("a1", "a2"), ("b1", "b2"), ("c1", "c2"), ("d1", "d2")]</font></div><div><font face="courier new, monospace"><br>
</font></div><div><font face="courier new, monospace">myArrow :: SP (String, String) (String, String)</font></div><div><font face="courier new, monospace">myArrow = (delay "db1" >>> delay "da1") *** (delay "db2" >>> delay "da2")</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">delay :: a -> SP a a</font></div><div><font face="courier new, monospace">delay b = Put b (arr id)</font></div><div><font face="courier new, monospace"><br>
</font></div><div><font face="courier new, monospace">main :: IO ()</font></div><div><font face="courier new, monospace">main = let output = runSP myArrow input in mapM_ f output</font></div><div><font face="courier new, monospace"> where f (a, b) = putStrLn $ "(" ++ show a ++ ", " ++ show b ++ ")"</font></div>
</div><div><b><br></b></div><div><br></div><div>The output of "main" is:</div><div><br></div><div><br></div><div><div><font face="courier new, monospace">*SP> main</font></div><div><font face="courier new, monospace">("da1", "da2")</font></div>
<div><font face="courier new, monospace">("da1", "db2")</font></div><div><font face="courier new, monospace">("da1", "a2")</font></div><div><font face="courier new, monospace">("db1", "a2")</font></div>
<div><font face="courier new, monospace">("a1", "a2")</font></div><div><font face="courier new, monospace">("b1", "b2")</font></div><div><font face="courier new, monospace">("c1", "c2")</font></div>
<div><font face="courier new, monospace">("d1", "d2")</font></div></div><div><br></div><div><br></div><div>[1] <a href="http://www.cse.chalmers.se/~rjmh/afp-arrows.pdf">http://www.cse.chalmers.se/~rjmh/afp-arrows.pdf</a><br>
</div></div>