switch away from UTCTime

1 files changed, 51 insertions, 36 deletions

diff --git a/countdown.hs b/countdown.hs
index 08ca2e2..4d43224 100755
--- a/countdown.hs
+++ b/countdown.hs
@@ -74,37 +74,39 @@ lengthOfDay = 24 * 60 * 60
 ageOfUniverse :: NominalDiffTime
 ageOfUniverse = fromIntegral ageOfUniverseInYears * lengthOfYear
 
-data CustomEvent = TimeChanged UTCTime deriving Show
+data CustomEvent = TimeChanged ZonedTime deriving Show
 
 data St =
     St { _stLastBrickEvent :: Maybe (BrickEvent () CustomEvent)
-       , _stClockTime      :: UTCTime
-       , _stDisplayTime    :: UTCTime
+       , _stClockTime      :: LocalTime
+       , _stDisplayTime    :: LocalTime
        , _stNextEvent      :: Maybe UTCTime
        }
 
 makeLenses ''St
 
-yearNumber :: ZonedTime -> Integer
-yearNumber (ZonedTime t _) = y
+yearNumber :: LocalTime -> Integer
+yearNumber (LocalTime t _) = y
   where
-    (y, _, _) = toGregorian . localDay $ t
+    (y, _, _) = toGregorian t
 
-yearStart :: ZonedTime -> ZonedTime
-yearStart (ZonedTime t z) = (ZonedTime t' z)
+yearStart :: LocalTime -> LocalTime
+yearStart (LocalTime d _) = LocalTime d' t'
   where
-    t' = LocalTime (fromGregorian y 1 1) (TimeOfDay 0 0 0)
-    (y, _, _) = toGregorian . localDay $ t
+    d' = fromGregorian y 1 1
+    t' = TimeOfDay 0 0 0
+    (y, _, _) = toGregorian d
 
-yearEnd :: ZonedTime -> ZonedTime
-yearEnd (ZonedTime t z) = (ZonedTime t' z)
+yearEnd :: LocalTime -> LocalTime
+yearEnd (LocalTime d _) = LocalTime d' t'
   where
-    t' = LocalTime (fromGregorian (y + 1) 1 1) (TimeOfDay 0 0 0)
-    (y, _, _) = toGregorian . localDay $ t
+    d' = fromGregorian (y + 1) 1 1
+    t' = TimeOfDay 0 0 0
+    (y, _, _) = toGregorian d
 
 
-dayNumOfYear :: ZonedTime -> Int
-dayNumOfYear t = snd $ toOrdinalDate $ localDay $ zonedTimeToLocalTime t
+dayNumOfYear :: LocalTime -> Int
+dayNumOfYear = snd . toOrdinalDate . localDay
 
 pluralize :: Integral i => i -> String
 pluralize 1 = ""
@@ -121,11 +123,11 @@ drawUI st = [a]
         -- <=>
         (str "\n")
         <=>
-        (countdownWidget (isSimulatedTime st) $ utcToZonedTime zone $ st ^. stDisplayTime)
+        (countdownWidget (isSimulatedTime st) $ st ^. stDisplayTime)
 
 printRemain unit quantity = printf "%d %s%s remain%s"
 
-countdownWidget :: Bool -> ZonedTime -> Widget n
+countdownWidget :: Bool -> LocalTime -> Widget n
 countdownWidget isSimulated t =
   (hCenter (borderWithLabel (str $ printf "Current time%s" (if isSimulated then " (SIMULATED)" else "")) $
             padLeftRight 3 $ (str (formatTime defaultTimeLocale "%A, %B %e%n%Y-%m-%d %r" t))))
@@ -179,7 +181,7 @@ countdownWidget isSimulated t =
     numDays        = daysInYear t
     yearLength     = fromIntegral numDays * nominalDay
     -- yearLength  = (zonedTimeToLocalTime $ yearEnd t) `diffLocalTime` (zonedTimeToLocalTime $ yearStart t)
-    yearElapsed    = (zonedTimeToLocalTime t) `diffLocalTime` (zonedTimeToLocalTime $ yearStart t)
+    yearElapsed    = t `diffLocalTime` (yearStart t)
 
     daysLeft       = numDays - dayNum
     hoursLeft      = minutesLeft / 60
@@ -208,10 +210,10 @@ nextWholeSecond (UTCTime day dayTime) = (UTCTime day dayTime')
 threadDelayUntil :: UTCTime -> UTCTime -> IO ()
 threadDelayUntil now t = threadDelay $ microsecondsUntil now t
 
-queueNextEvent :: MonadIO m => BChan CustomEvent -> UTCTime -> m ()
-queueNextEvent chan now = liftIO . void . forkIO $ do
+queueNextEvent :: MonadIO m => BChan CustomEvent -> ZonedTime -> m ()
+queueNextEvent chan (zonedTimeToUTC -> now) = liftIO . void . forkIO $ do
   threadDelayUntil now (nextWholeSecond now)
-  getCurrentTime >>= writeBChan chan . TimeChanged
+  getZonedTime >>= writeBChan chan . TimeChanged
 
 isSimulatedTime :: St -> Bool
 isSimulatedTime st = st ^. stDisplayTime /= st ^. stClockTime
@@ -220,26 +222,39 @@ handleEvent :: BChan CustomEvent -> St -> BrickEvent () CustomEvent -> EventM ()
 handleEvent chan st e =
     case e of
         VtyEvent (V.EvKey V.KEsc [])         -> halt st
-        VtyEvent (V.EvKey V.KPageUp [])      -> cont $ st & stDisplayTime %~ (addUTCTime lengthOfDay)
-        VtyEvent (V.EvKey V.KPageDown [])    -> cont $ st & stDisplayTime %~ (addUTCTime (-lengthOfDay))
-        VtyEvent (V.EvKey V.KUp [])          -> cont $ st & stDisplayTime %~ (addUTCTime (60 * 60))
-        VtyEvent (V.EvKey V.KDown [])        -> cont $ st & stDisplayTime %~ (addUTCTime (-60 * 60))
-        VtyEvent (V.EvKey V.KRight [])       -> cont $ st & stDisplayTime %~ (addUTCTime (60))
-        VtyEvent (V.EvKey V.KLeft [])        -> cont $ st & stDisplayTime %~ (addUTCTime (-60))
-        VtyEvent (V.EvKey V.KRight [MShift]) -> cont $ st & stDisplayTime %~ (addUTCTime (1))
-        VtyEvent (V.EvKey V.KLeft [MShift])  -> cont $ st & stDisplayTime %~ (addUTCTime (-1))
+        VtyEvent (V.EvKey V.KPageUp [])      -> cont $ st & stDisplayTime %~ (addLocalTime lengthOfDay)
+        VtyEvent (V.EvKey V.KPageDown [])    -> cont $ st & stDisplayTime %~ (addLocalTime (-lengthOfDay))
+        VtyEvent (V.EvKey V.KUp [])          -> cont $ st & stDisplayTime %~ (addLocalTime (60 * 60))
+        VtyEvent (V.EvKey V.KDown [])        -> cont $ st & stDisplayTime %~ (addLocalTime (-60 * 60))
+        VtyEvent (V.EvKey V.KRight [])       -> cont $ st & stDisplayTime %~ (addLocalTime (60))
+        VtyEvent (V.EvKey V.KLeft [])        -> cont $ st & stDisplayTime %~ (addLocalTime (-60))
+        VtyEvent (V.EvKey V.KRight [MShift]) -> cont $ st & stDisplayTime %~ (addLocalTime (1))
+        VtyEvent (V.EvKey V.KLeft [MShift])  -> cont $ st & stDisplayTime %~ (addLocalTime (-1))
         VtyEvent (V.EvKey V.KHome [])        -> cont $ st & stDisplayTime .~ (st ^. stClockTime)
+        VtyEvent (V.EvKey V.KHome [MShift])  -> cont $ st & stDisplayTime .~ (newYearsEveNoon $ st ^. stClockTime)
+        VtyEvent (V.EvKey V.KHome [MCtrl])   -> cont $ st & stDisplayTime .~ (newYearsEveLast10 $ st ^. stClockTime)
         VtyEvent _                           -> cont st
         AppEvent (TimeChanged now) -> do
           queueNextEvent chan now
           let oldTime = st ^. stClockTime
-          cont $ st & stClockTime .~ now & stDisplayTime %~ (addUTCTime (now `diffUTCTime` oldTime))
+          cont $ st & stClockTime .~ (zonedTimeToLocalTime now) & stDisplayTime %~ (addLocalTime ((zonedTimeToLocalTime now) `diffLocalTime` oldTime))
         _ -> cont st
     where
       cont s = do
         continue $ s & stLastBrickEvent .~ (Just e)
 
-initialState :: UTCTime -> St
+newYearsEveLast10 :: LocalTime -> LocalTime
+newYearsEveLast10 t = addLocalTime (12 * 60 * 60 - 10) $ newYearsEveNoon t
+
+newYearsEveNoon :: LocalTime -> LocalTime
+newYearsEveNoon (LocalTime d (TimeOfDay _ _ s)) = LocalTime d' t
+  where
+    (y, _) = toOrdinalDate d
+    d' = fromOrdinalDate y 366
+    t = TimeOfDay 12 0 s'
+    s' = s `mod'` 1 -- keep the fractional part so we still tick the display on the same schedule
+
+initialState :: LocalTime -> St
 initialState t =
     St { _stLastBrickEvent = Nothing
        , _stClockTime = t
@@ -247,8 +262,8 @@ initialState t =
        , _stNextEvent = Nothing
        }
 
-daysInYear :: ZonedTime -> Int
-daysInYear (toGregorian . localDay . zonedTimeToLocalTime -> (y, _, _)) = if isLeapYear y then 366 else 365
+daysInYear :: LocalTime -> Int
+daysInYear (toGregorian . localDay -> (y, _, _)) = if isLeapYear y then 366 else 365
 
 theBaseAttr :: A.AttrName
 theBaseAttr = A.attrName "theBase"
@@ -294,6 +309,6 @@ main = do
 
     let buildVty = V.mkVty V.defaultConfig
     initialVty <- buildVty
-    now <- getCurrentTime
+    now <- getZonedTime
     queueNextEvent chan now
-    void $ customMain initialVty buildVty (Just chan) (theApp chan) (initialState now)
+    void $ customMain initialVty buildVty (Just chan) (theApp chan) (initialState $ zonedTimeToLocalTime now)