1 files changed, 46 insertions, 0 deletions

diff --git a/rtq.hs b/rtq.hs
new file mode 100644
index 0000000..a47491a
--- /dev/null
+++ b/rtq.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE KindSignatures #-}
+
+import BasePrelude hiding ((.))
+import RealTimeQueue
+import Control.Monad.IO.Class
+import Control.Monad.State
+import System.Clock
+
+data LoopState = LoopState {
+      _queue :: Queue String
+}
+
+main :: IO ()
+main = void $ runStateT main' (LoopState createQueue)
+
+main' :: StateT LoopState IO ()
+main' = do
+    queueAction $ scheduleEventIO (TimeSpec 1 0, "hello world")
+    queueAction $ scheduleEventIO (TimeSpec 2 0, "hello world")
+    queueAction $ scheduleEventIO (TimeSpec 3 0, "hello world")
+    queueAction $ scheduleEventIO (TimeSpec 4 0, "hello world")
+    mainLoop
+
+queueAction :: forall (m :: * -> *). MonadState LoopState m => (Queue String -> m (Queue String)) -> m ()
+queueAction act = do
+    q <- gets _queue
+    act q >>= modify . const . LoopState
+
+tickTime :: TimeSpec
+tickTime = TimeSpec 0 15000
+
+threadDelay' :: TimeSpec -> IO ()
+threadDelay' = threadDelay . fromIntegral . timeSpecAsNanoSecs
+
+runner :: TimeSpec -> String -> StateT LoopState IO ()
+runner delay str = liftIO $ do
+                        threadDelay' delay
+                        putStrLn str
+
+mainLoop :: StateT LoopState IO ()
+mainLoop = do
+  queueAction $ runScheduledIO tickTime runner
+  liftIO $ threadDelay' tickTime
+  mainLoop