tick the second hand at the right time

1 files changed, 20 insertions, 6 deletions

diff --git a/countdown.hs b/countdown.hs
index 0960a85..5068989 100755
--- a/countdown.hs
+++ b/countdown.hs
@@ -57,6 +57,7 @@ data CustomEvent = TimeChanged UTCTime deriving Show
 data St =
     St { _stLastBrickEvent :: Maybe (BrickEvent () CustomEvent)
        , _stCurrentTime :: UTCTime
+       , _stNextEvent :: Maybe UTCTime
        }
 
 makeLenses ''St
@@ -72,15 +73,19 @@ appEvent :: St -> BrickEvent () CustomEvent -> EventM () (Next St)
 appEvent st e =
     case e of
         VtyEvent (V.EvKey V.KEsc []) -> halt st
-        VtyEvent _ -> continue $ st & stLastBrickEvent .~ (Just e)
-        AppEvent (TimeChanged t) -> continue $ st & stCurrentTime .~ t
-                                                  & stLastBrickEvent .~ (Just e)
-        _ -> continue st
+        VtyEvent _ -> cont st
+        AppEvent (TimeChanged t) -> cont $ st & stCurrentTime .~ t
+        _ -> cont st
+    where
+      cont s = do
+        now <- liftIO getCurrentTime
+        continue $ s & stLastBrickEvent .~ (Just e)
 
 initialState :: UTCTime -> St
 initialState t =
     St { _stLastBrickEvent = Nothing
        , _stCurrentTime = t
+       , _stNextEvent = Nothing
        }
 
 theApp :: App St CustomEvent ()
@@ -92,15 +97,24 @@ theApp =
         , appAttrMap = const $ attrMap V.defAttr []
         }
 
+zone :: TimeZone
+zone = unsafePerformIO getCurrentTimeZone
+
 main :: IO ()
 main = do
-    now <- getCurrentTime
     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
-        threadDelay 1000000
 
     let buildVty = V.mkVty V.defaultConfig
     initialVty <- buildVty
+    now <- getCurrentTime
     void $ customMain initialVty buildVty (Just chan) theApp (initialState now)