Hi Haskell Cafe,<br><br>I&#39;m interested in writing some events and event handlers in Haskell.&nbsp; I already have a Loop data structure, and I intend to use it for this purpose:<br><br>-- Create event<br>tEvent &lt;- newLoop (return ())<br>
<br>-- Register event handlers<br>tHandler1 &lt;- newLoop (putStrLn &quot;Handler1&quot;)<br>tHandler2 &lt;- newLoop (putStrLn &quot;Handler2&quot;)<br>splice tEvent tHandler1<br>splice tEvent tHandler2<br><br>-- Fire event<br>
action &lt;- doLoop tEvent<br>action<br><br>doLoop :: Monad m =&gt; TVar (Loop (m ())) -&gt; STM (m ())<br>doLoop tLoop = do<br>&nbsp;&nbsp; aLoop &lt;- readAsList tLoop<br>&nbsp;&nbsp; return $ sequence_ aLoop<br><br>My question is: Is it possible to write a generic doLoop that works over arbitrary functions?<br>
<br>For instance the following code wouldn&#39;t work because the event provides one argument and the handler takes one argument:<br><br>-- Create event<br>tEvent &lt;- newLoop (\x -&gt; return ())<br><br>-- Register event handlers<br>
tHandler1 &lt;- newLoop (\x -&gt; putStrLn (&quot;Handler1&quot; ++ show x))<br>tHandler2 &lt;- newLoop (\x -&gt; putStrLn (&quot;Handler2&quot; ++ show x))<br>splice tEvent tHandler1<br>splice tEvent tHandler2<br><br>-- Fire event<br>
action &lt;- doLoop tEvent<br>action 123<br><br><br>Thanks,<br><br>-John<br><br>Full source code for Loop type:<br><br>module Fx.STM.Loop where<br><br>import Control.Monad<br>import Fx.STM.Util<br>import GHC.Conc<br>import System.IO.Unsafe<br>
<br>-- Transactional loop.&nbsp; A loop is a circular link list.<br>data Loop a<br>&nbsp;&nbsp; = ItemLink<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; { item :: a<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; , prev :: TVar (Loop a)<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; , next :: TVar (Loop a)<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; }<br><br>-- Create a new empty transactional loop.<br>
newLoop :: a -&gt; STM (TVar (Loop a))<br>newLoop item = do<br>&nbsp;&nbsp; tLoop &lt;- newTVar undefined<br>&nbsp;&nbsp; writeTVar tLoop (ItemLink item tLoop tLoop)<br>&nbsp;&nbsp; return tLoop<br><br>-- Splice two transactional loops.&nbsp; This will join two loops if they were<br>
-- originally separate, or split a single loop if the links were originally<br>-- part of the same loop.&nbsp; No change occurs if the two links are identical.<br>splice :: TVar (Loop a) -&gt; TVar (Loop a) -&gt; STM ()<br>splice tLink0 tLink1 = do<br>
&nbsp;&nbsp; aLink0 &lt;- readTVar tLink0<br>&nbsp;&nbsp; aLink1 &lt;- readTVar tLink1<br>&nbsp;&nbsp; let tLink0Prev = prev aLink0<br>&nbsp;&nbsp; let tLink1Prev = prev aLink1<br>&nbsp;&nbsp; writeTVar tLink0 aLink0 { prev = tLink1Prev }<br>&nbsp;&nbsp; writeTVar tLink1 aLink1 { prev = tLink0Prev }<br>
&nbsp;&nbsp; aLink0Prev &lt;- readTVar tLink0Prev<br>&nbsp;&nbsp; aLink1Prev &lt;- readTVar tLink1Prev<br>&nbsp;&nbsp; writeTVar tLink0Prev aLink0Prev { next = tLink1 }<br>&nbsp;&nbsp; writeTVar tLink1Prev aLink1Prev { next = tLink0 }<br>&nbsp;&nbsp; return ()<br>&nbsp;<br>-- Unlink a single link from a transactional loop.<br>
unlink :: TVar (Loop a) -&gt; STM ()<br>unlink tLink = do<br>&nbsp;&nbsp; (ItemLink item tLinkPrev tLinkNext) &lt;- readTVar tLink<br>&nbsp;&nbsp; aLinkPrev &lt;- readTVar tLinkPrev<br>&nbsp;&nbsp; writeTVar tLinkPrev aLinkPrev { next = tLinkNext }<br>
&nbsp;&nbsp; aLinkNext &lt;- readTVar tLinkNext<br>&nbsp;&nbsp; writeTVar tLinkNext aLinkNext { prev = tLinkPrev }<br>&nbsp;&nbsp; writeTVar tLink (ItemLink item tLink tLink)<br>&nbsp;&nbsp; return ()<br><br>-- Read the length of the loop.<br>readLength :: TVar (Loop a) -&gt; STM Int<br>
readLength tLink = do<br>&nbsp;&nbsp; list &lt;- readAsList tLink<br>&nbsp;&nbsp; return $ length list<br><br>readLinks :: TVar (Loop a) -&gt; STM [TVar (Loop a)]<br>readLinks tLink = readLinksUntil tLink tLink<br><br>readLinksUntil :: TVar (Loop a) -&gt; TVar (Loop a) -&gt; STM [TVar (Loop a)]<br>
readLinksUntil tLink tLinkEnd = do<br>&nbsp;&nbsp; (ItemLink _ tLinkPrev tLinkNext) &lt;- readTVar tLink<br>&nbsp;&nbsp; return []<br>&nbsp;&nbsp; if tLinkNext == tLinkEnd<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; then return [tLink]<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; else do<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; tail &lt;- readLinksUntil tLinkNext tLinkEnd<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; return $ tLink:tail<br><br>-- Read the elements of the loop as a list starting from tLink.<br>readAsList :: TVar (Loop a) -&gt; STM [a]<br>readAsList tLink = readAsListUntil tLink tLink<br><br>-- Read the elements of the loop as a list starting from tLink<br>
-- and terminating non-inclusively at tLinkEnd.<br>readAsListUntil :: TVar (Loop a) -&gt; TVar (Loop a) -&gt; STM [a]<br>readAsListUntil tLink tLinkEnd = do<br>&nbsp;&nbsp; (ItemLink item tLinkPrev tLinkNext) &lt;- readTVar tLink<br>
&nbsp;&nbsp; if tLinkNext == tLinkEnd<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; then return [item]<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; else do<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; tail &lt;- readAsListUntil tLinkNext tLinkEnd<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; return $ item:tail<br><br>-- Create a new loop from a list.<br>newFromList :: [a] -&gt; STM (TVar (Loop a))<br>
newFromList [item] = newLoop item<br>newFromList (item:items) = do<br>&nbsp;&nbsp; tLink &lt;- newLoop item<br>&nbsp;&nbsp; tLinkRest &lt;- newFromList items<br>&nbsp;&nbsp; splice tLink tLinkRest<br>&nbsp;&nbsp; return tLink<br><br>doLoop :: Monad m =&gt; TVar (Loop (m ())) -&gt; STM (m ())<br>
doLoop tLoop = do<br>&nbsp;&nbsp; aLoop &lt;- readAsList tLoop<br>&nbsp;&nbsp; return $ sequence_ aLoop<br><br><br>