Hi Haskell Cafe,<br><br>I'm interested in writing some events and event handlers in Haskell. I already have a Loop data structure, and I intend to use it for this purpose:<br><br>-- Create event<br>tEvent <- newLoop (return ())<br>
<br>-- Register event handlers<br>tHandler1 <- newLoop (putStrLn "Handler1")<br>tHandler2 <- newLoop (putStrLn "Handler2")<br>splice tEvent tHandler1<br>splice tEvent tHandler2<br><br>-- Fire event<br>
action <- doLoop tEvent<br>action<br><br>doLoop :: Monad m => TVar (Loop (m ())) -> STM (m ())<br>doLoop tLoop = do<br> aLoop <- readAsList tLoop<br> 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't work because the event provides one argument and the handler takes one argument:<br><br>-- Create event<br>tEvent <- newLoop (\x -> return ())<br><br>-- Register event handlers<br>
tHandler1 <- newLoop (\x -> putStrLn ("Handler1" ++ show x))<br>tHandler2 <- newLoop (\x -> putStrLn ("Handler2" ++ show x))<br>splice tEvent tHandler1<br>splice tEvent tHandler2<br><br>-- Fire event<br>
action <- 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. A loop is a circular link list.<br>data Loop a<br> = ItemLink<br> { item :: a<br> , prev :: TVar (Loop a)<br> , next :: TVar (Loop a)<br> }<br><br>-- Create a new empty transactional loop.<br>
newLoop :: a -> STM (TVar (Loop a))<br>newLoop item = do<br> tLoop <- newTVar undefined<br> writeTVar tLoop (ItemLink item tLoop tLoop)<br> return tLoop<br><br>-- Splice two transactional loops. 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. No change occurs if the two links are identical.<br>splice :: TVar (Loop a) -> TVar (Loop a) -> STM ()<br>splice tLink0 tLink1 = do<br>
aLink0 <- readTVar tLink0<br> aLink1 <- readTVar tLink1<br> let tLink0Prev = prev aLink0<br> let tLink1Prev = prev aLink1<br> writeTVar tLink0 aLink0 { prev = tLink1Prev }<br> writeTVar tLink1 aLink1 { prev = tLink0Prev }<br>
aLink0Prev <- readTVar tLink0Prev<br> aLink1Prev <- readTVar tLink1Prev<br> writeTVar tLink0Prev aLink0Prev { next = tLink1 }<br> writeTVar tLink1Prev aLink1Prev { next = tLink0 }<br> return ()<br> <br>-- Unlink a single link from a transactional loop.<br>
unlink :: TVar (Loop a) -> STM ()<br>unlink tLink = do<br> (ItemLink item tLinkPrev tLinkNext) <- readTVar tLink<br> aLinkPrev <- readTVar tLinkPrev<br> writeTVar tLinkPrev aLinkPrev { next = tLinkNext }<br>
aLinkNext <- readTVar tLinkNext<br> writeTVar tLinkNext aLinkNext { prev = tLinkPrev }<br> writeTVar tLink (ItemLink item tLink tLink)<br> return ()<br><br>-- Read the length of the loop.<br>readLength :: TVar (Loop a) -> STM Int<br>
readLength tLink = do<br> list <- readAsList tLink<br> return $ length list<br><br>readLinks :: TVar (Loop a) -> STM [TVar (Loop a)]<br>readLinks tLink = readLinksUntil tLink tLink<br><br>readLinksUntil :: TVar (Loop a) -> TVar (Loop a) -> STM [TVar (Loop a)]<br>
readLinksUntil tLink tLinkEnd = do<br> (ItemLink _ tLinkPrev tLinkNext) <- readTVar tLink<br> return []<br> if tLinkNext == tLinkEnd<br> then return [tLink]<br> else do<br> tail <- readLinksUntil tLinkNext tLinkEnd<br>
return $ tLink:tail<br><br>-- Read the elements of the loop as a list starting from tLink.<br>readAsList :: TVar (Loop a) -> 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) -> TVar (Loop a) -> STM [a]<br>readAsListUntil tLink tLinkEnd = do<br> (ItemLink item tLinkPrev tLinkNext) <- readTVar tLink<br>
if tLinkNext == tLinkEnd<br> then return [item]<br> else do<br> tail <- readAsListUntil tLinkNext tLinkEnd<br> return $ item:tail<br><br>-- Create a new loop from a list.<br>newFromList :: [a] -> STM (TVar (Loop a))<br>
newFromList [item] = newLoop item<br>newFromList (item:items) = do<br> tLink <- newLoop item<br> tLinkRest <- newFromList items<br> splice tLink tLinkRest<br> return tLink<br><br>doLoop :: Monad m => TVar (Loop (m ())) -> STM (m ())<br>
doLoop tLoop = do<br> aLoop <- readAsList tLoop<br> return $ sequence_ aLoop<br><br><br>