fix clock

Now we use the queued time as the time to display (regardless of the
clock time when it triggers).

This helps prevent dropping seconds from the display when time warp is
used.

1 files changed, 17 insertions, 15 deletions

diff --git a/countdown.hs b/countdown.hs
index b53a3a4..a7d1377 100755
--- a/countdown.hs
+++ b/countdown.hs
@@ -12,6 +12,7 @@
 {-# language TemplateHaskell #-}
 {-# language ViewPatterns #-}
 import Rebase.Prelude hiding (toList, on, (<+>))
+import qualified Rebase.Prelude as Prelude
 import Control.Lens hiding ((<|))
 import Data.Foldable (toList)
 import Data.Ratio
@@ -266,21 +267,23 @@ commasF precision = prettyF cfg
 commas :: Integral i => i -> Text
 commas = prettyI (Just ',') . fromIntegral
 
-microsecondsUntil :: Integral i => UTCTime -> UTCTime -> i
-microsecondsUntil now later = floor $ nominalDiffTimeToSeconds $ (later `diffUTCTime` now) * 1000 * 1000
-
-nextWholeSecond :: UTCTime -> UTCTime
-nextWholeSecond (UTCTime day dayTime) = (UTCTime day dayTime')
+nextWholeSecond :: ZonedTime -> ZonedTime
+nextWholeSecond (ZonedTime (LocalTime day (TimeOfDay h m s)) z) = (ZonedTime (LocalTime day (TimeOfDay h m s')) z)
   where
-    dayTime' = secondsToDiffTime $ floor dayTime + 1
+    s' = fromIntegral $ (floor s + 1 :: Int)
 
-threadDelayUntil :: UTCTime -> UTCTime -> IO ()
-threadDelayUntil now t = threadDelay $ microsecondsUntil now t
+diffZonedTime :: ZonedTime -> ZonedTime -> NominalDiffTime
+diffZonedTime = diffLocalTime `Prelude.on` zonedTimeToLocalTime
 
-queueNextEvent :: MonadIO m => BChan CustomEvent -> ZonedTime -> m ()
-queueNextEvent chan (zonedTimeToUTC -> now) = liftIO . void . forkIO $ do
-  threadDelayUntil now (nextWholeSecond now)
-  getZonedTime >>= writeBChan chan . TimeChanged
+queueNextEvent :: MonadIO m => BChan CustomEvent -> m ZonedTime
+queueNextEvent chan = liftIO $ do
+  now <- getZonedTime
+  void . forkIO $ do
+    let next = nextWholeSecond now
+    let delay = next `diffZonedTime` now
+    threadDelay $ floor $ delay * 1000 * 1000
+    writeBChan chan $ TimeChanged next
+  return now
 
 isSimulatedTime :: St -> Bool
 isSimulatedTime st = st ^. stDisplayTime /= st ^. stClockTime
@@ -307,7 +310,7 @@ handleEvent chan st e =
         VtyEvent (V.EvKey (V.KChar 'p') [])  -> cont $ st & stPaused %~ not
         VtyEvent _                           -> cont st
         AppEvent (TimeChanged now) -> do
-          queueNextEvent chan now
+          void $ queueNextEvent chan
           let oldTime = st ^. stClockTime
           cont $ st & stClockTime .~ (zonedTimeToLocalTime now)
                     & stDisplayTime %~ if st ^. stPaused then id else (addLocalTime ((zonedTimeToLocalTime now) `diffLocalTime` oldTime))
@@ -383,6 +386,5 @@ main = do
 
     let buildVty = V.mkVty V.defaultConfig
     initialVty <- buildVty
-    now <- getZonedTime
-    queueNextEvent chan now
+    now <- queueNextEvent chan
     void $ customMain initialVty buildVty (Just chan) (theApp chan) (initialState $ zonedTimeToLocalTime now)