access to chan from within event handler

1 files changed, 21 insertions, 18 deletions

diff --git a/countdown.hs b/countdown.hs
index 5068989..2e4114e 100755
--- a/countdown.hs
+++ b/countdown.hs
@@ -69,16 +69,22 @@ drawUI st = [a]
             <=>
             (str $ "Time now is: " <> (show $ st^.stCurrentTime))
 
-appEvent :: St -> BrickEvent () CustomEvent -> EventM () (Next St)
-appEvent st e =
+queueNextEvent :: MonadIO m => BChan CustomEvent -> UTCTime -> m ()
+queueNextEvent chan now = liftIO . void . forkIO $ do
+  threadDelay $ microsecondsUntilNextSecond now
+  getCurrentTime >>= writeBChan chan . TimeChanged
+
+appEvent :: BChan CustomEvent -> St -> BrickEvent () CustomEvent -> EventM () (Next St)
+appEvent chan st e =
     case e of
         VtyEvent (V.EvKey V.KEsc []) -> halt st
         VtyEvent _ -> cont st
-        AppEvent (TimeChanged t) -> cont $ st & stCurrentTime .~ t
+        AppEvent (TimeChanged now) -> do
+          queueNextEvent chan now
+          cont $ st & stCurrentTime .~ now
         _ -> cont st
     where
       cont s = do
-        now <- liftIO getCurrentTime
         continue $ s & stLastBrickEvent .~ (Just e)
 
 initialState :: UTCTime -> St
@@ -88,11 +94,11 @@ initialState t =
        , _stNextEvent = Nothing
        }
 
-theApp :: App St CustomEvent ()
-theApp =
+theApp :: BChan CustomEvent -> App St CustomEvent ()
+theApp chan =
     App { appDraw = drawUI
         , appChooseCursor = showFirstCursor
-        , appHandleEvent = appEvent
+        , appHandleEvent = appEvent chan
         , appStartEvent = return
         , appAttrMap = const $ attrMap V.defAttr []
         }
@@ -100,21 +106,18 @@ theApp =
 zone :: TimeZone
 zone = unsafePerformIO getCurrentTimeZone
 
+microsecondsUntilNextSecond :: Integral a => UTCTime -> a
+microsecondsUntilNextSecond now = (1000 * 1000 * remainingInCurrentSecond) `div'` 1
+  where
+    todSecNow = todSec $ localTimeOfDay $ utcToLocalTime zone now
+    remainingInCurrentSecond = 1 - (todSecNow `mod'` 1)
+
 main :: IO ()
 main = do
     chan <- newBChan 10
 
-    void $ forkIO $ forever $ do
-        now <- getCurrentTime
-        let localNow = utcToLocalTime zone now
-            todNow = localTimeOfDay localNow
-            todSecNow = todSec todNow
-            remainingInCurrentSecond = 1 - (todSecNow `mod'` 1)
-            delay = (1000000 * remainingInCurrentSecond) `div'` 1
-        threadDelay $ delay
-        getCurrentTime >>= writeBChan chan . TimeChanged
-
     let buildVty = V.mkVty V.defaultConfig
     initialVty <- buildVty
     now <- getCurrentTime
-    void $ customMain initialVty buildVty (Just chan) theApp (initialState now)
+    queueNextEvent chan now
+    void $ customMain initialVty buildVty (Just chan) (theApp chan) (initialState now)