@@ -1,48 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−import Control.Applicative
3−import Control.Concurrent (threadDelay, myThreadId)
4−import Control.Monad.IO.Class (liftIO, MonadIO)
5−import System.Random (randomIO)
6−import System.IO
7−import Control.Monad (forever, mzero)
8−import Control.Monad.Trans.Control (MonadBaseControl)
9−import Data.IORef
10−import Control.Monad.Catch (MonadThrow)
11−
12−import Asyncly
13−
14−main = wait_ $ threads 0 $ do
15− liftIO $ hSetBuffering stdout LineBuffering
16− mainThread <- liftIO myThreadId
17− liftIO $ putStrLn $ "Main thread: " ++ show mainThread
18−
19− x <- sample (randomIO :: IO Int) 1000000
20− {-
21− evThread <- liftIO myThreadId
22− liftIO $ putStrLn $ "\nX Event thread: " ++ show evThread
23− liftIO $ putStrLn $ "x = " ++ (show x)
24− -}
25−
26− y <- sample (randomIO :: IO Int) 1000000
27−
28− -- liftIO $ threadDelay 10000000
29− evThread <- liftIO myThreadId
30− --liftIO $ putStrLn $ "\nY Event thread: " ++ show evThread
31− liftIO $ putStrLn $ "(x,y) = " ++ (show (x,y))
32−
33−sample :: (Eq a, MonadIO m, MonadBaseControl IO m, MonadThrow m)
34− => IO a -> Int -> AsyncT m a
35−sample action interval = do
36− v <- liftIO action
37− prev <- liftIO $ newIORef v
38− async (return v) <|> loop action prev
39− where loop act prev = loop'
40− where loop' = do
41− liftIO $ threadDelay interval
42− v' <- liftIO $ readIORef prev
43− v <- liftIO act
44− if v /= v' then do
45− liftIO (writeIORef prev v)
46− async (return v) <|> loop'
47− else do
48− loop'