Add some sample test programs

test/1-event.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE ScopedTypeVariables       #-}
+
+import Control.Applicative
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Monad.State
+import Data.IORef
+
+import Duct.Event
+
+f :: StateT EventF IO String
+f = do
+    setData "x"
+    Just x <- getData
+    return x
+
+runEvent :: forall m a. (Alternative m, MonadIO m) => StateT EventF m a -> m a
+runEvent t = do
+  zombieChan <- liftIO $ atomically newTChan
+  pendingRef <- liftIO $ newIORef []
+  credit     <- liftIO $ newIORef maxBound
+  th         <- liftIO $ myThreadId
+
+  (r, _) <- runStateT t $ initEventF
+    (empty :: m a) th zombieChan pendingRef credit
+  return r
+
+main = do
+    r <- runEvent f
+    putStrLn r

test/2-waitAsync.hs

@@ -0,0 +1,5 @@
+import Duct
+import Control.Monad.IO.Class (liftIO)
+
+main = waitAsync $ do
+    liftIO $ putStrLn "hello"

test/3-async.hs

@@ -0,0 +1,20 @@
+import Control.Concurrent (threadDelay, myThreadId)
+import Control.Monad.IO.Class (liftIO)
+import System.Random (randomIO)
+import System.IO
+
+import Duct
+
+main = waitAsync $ do
+    liftIO $ hSetBuffering stdout LineBuffering
+    mainThread <- liftIO myThreadId
+    liftIO $ putStrLn $ "Main thread: " ++ show mainThread
+    x <- async (randomIO :: IO Int)
+    liftIO $ putStrLn $ show x
+
+    y <- async (randomIO :: IO Int)
+
+    liftIO $ threadDelay 1000000
+    evThread <- liftIO myThreadId
+    liftIO $ putStrLn $ "Event thread: " ++ show evThread
+    liftIO $ putStrLn $ show x

test/3-sample.hs

@@ -0,0 +1,22 @@
+import Control.Concurrent (threadDelay, myThreadId)
+import Control.Monad.IO.Class (liftIO)
+import System.Random (randomIO)
+import System.IO
+
+import Duct
+
+main = waitAsync $ threads 3 $ do
+    liftIO $ hSetBuffering stdout LineBuffering
+    mainThread <- liftIO myThreadId
+    liftIO $ putStrLn $ "Main thread: " ++ show mainThread
+    x <- sample (randomIO :: IO Int) 1000000
+    evThread <- liftIO myThreadId
+    liftIO $ putStrLn $ "X Event thread: " ++ show evThread
+    liftIO $ putStrLn $ "x = " ++ (show x)
+
+    y <- sample (randomIO :: IO Int) 1000000
+
+    -- liftIO $ threadDelay 10000000
+    evThread <- liftIO myThreadId
+    liftIO $ putStrLn $ "Y Event thread: " ++ show evThread
+    liftIO $ putStrLn $ "y = " ++ (show y)