path: root/src/countdown.hs

#!/usr/bin/env stack
{- stack script --resolver lts-19.23 --install-ghc -}
{-# OPTIONS_GHC
  -Wall
  -Wno-unused-imports
  -Wno-unused-top-binds
  -Wno-name-shadowing
#-}
{-# language NoImplicitPrelude #-}
{-# language RecordWildCards #-}
{-# language FlexibleContexts #-}
{-# language TemplateHaskell #-}
{-# language ViewPatterns #-}
{-# language OverloadedStrings #-}
import Rebase.Prelude hiding (toList, on, (<+>), Max)
import qualified Rebase.Prelude as Prelude
import Control.Lens hiding ((<|))
import Data.Foldable (toList)
import Data.Ratio
import Text.Printf
import Graphics.Vty
import Data.Time.LocalTime
import Control.Monad.RWS
import Data.Time.Calendar.OrdinalDate
import qualified Data.Text as Text
import Data.Text.Format.Numbers
import Rebase.Data.Map.Strict (Map)
import qualified Rebase.Data.Map.Strict as Map

import Brick
import Brick.Types
import Data.Text (unpack)
import Control.Lens
import Control.Monad (void, forever)
import Control.Concurrent (threadDelay, forkIO)
import qualified Graphics.Vty as V
import Brick.Widgets.ProgressBar as P
import Brick.BChan
import Brick.Widgets.Center
import Brick.Widgets.Border
import Brick.Main
  ( App(..)
  , showFirstCursor
  , customMain
  , continue
  , halt
  )
import Brick.AttrMap
  ( attrMap
  )
import Brick.Types
  ( Widget
  , Next
  , EventM
  , BrickEvent(..)
  )
import Brick.Widgets.Core
  ( (<=>)
  , str
  )
import Brick.AttrMap as A
import Brick.Util (fg, bg, on, clamp)
import Brick.Widgets.Core
import Brick.Widgets.Table

import CosmicCalendar
import CosmicCalendarEvents

data CustomEvent = TimeChanged ZonedTime deriving Show

data St =
    St { _stLastBrickEvent :: Maybe (BrickEvent () CustomEvent)
       , _stClockTime      :: LocalTime
       , _stDisplayTime    :: LocalTime
       , _stNextEvent      :: Maybe UTCTime
       , _stPaused         :: Bool
       , _stShowConversion :: Bool
       }

makeLenses ''St

yearNumber :: LocalTime -> Integer
yearNumber (LocalTime t _) = y
  where
    (y, _, _) = toGregorian t

yearEnd :: LocalTime -> LocalTime
yearEnd (LocalTime d _) = LocalTime d' t'
  where
    d' = fromGregorian (y + 1) 1 1
    t' = TimeOfDay 0 0 0
    (y, _, _) = toGregorian d


dayNumOfYear :: LocalTime -> Int
dayNumOfYear = snd . toOrdinalDate . localDay

pluralize :: (Num n, Eq n) => n -> String
pluralize 1 = ""
pluralize _ = "s"

pluralizeVerb :: (Num n, Eq n) => n -> String
pluralizeVerb 1 = "s"
pluralizeVerb _ = ""

drawUI :: St -> [Widget ()]
drawUI st = [a]
  where
    a = vBox [
        -- (str $ "Last event: " <> (show $ st ^. stLastBrickEvent)),
        -- (str "\n"),
        (str "\n"),
        (countdownWidget (st ^. stShowConversion) (isSimulatedTime st) $ st ^. stDisplayTime)
      ]

showTime' :: Bool -> NominalDiffTime -> String
showTime' True 1          = printf "%-3s second" ("1" :: Text)
showTime' True t | t < 60 = printf "%.1f seconds" (realToFrac t :: Float)
showTime' _ t = showTime t

showTime :: NominalDiffTime -> String
showTime t | t < 1           = printf "%.3f seconds" (realToFrac t :: Float)
showTime t | t == 1          = "1 second"
-- showTime t | t < 10          = formatTime defaultTimeLocale "%2Es seconds" t -- BUG! Doesn't respect <width> parameter at all!
showTime t | t < 60          = printf "%.1f seconds" (realToFrac t :: Float)
showTime t | t == 60         = formatTime defaultTimeLocale "%M minute" t
showTime t | t < 60*2        = formatTime defaultTimeLocale "%M minute %Ss" t
showTime t | t < 60*10       = formatTime defaultTimeLocale "%M minutes %Ss" t
showTime t | t < 60*60       = formatTime defaultTimeLocale "%M minutes" t
showTime t | t == 60*60      = "1 hour"
showTime t | t < 60*60*2     = formatTime defaultTimeLocale "%H hour %Mm" t
showTime t | t < 60*60*24    = formatTime defaultTimeLocale "%H hours %Mm" t
showTime t | t == 60*60*24   = formatTime defaultTimeLocale "%d day" t
showTime t | t < 60*60*24*2  = formatTime defaultTimeLocale "%d day %Hh" t
showTime t | t == 60*60*24*7 = formatTime defaultTimeLocale "%d days" t
showTime t | t < 60*60*24*10 = formatTime defaultTimeLocale "%d days %Hh" t
showTime t                   = formatTime defaultTimeLocale "%d days" t
-- showTime _ t = formatTime defaultTimeLocale "%w weeks %D days" t

yearsToCosmicTime :: Integral i => i -> NominalDiffTime
yearsToCosmicTime = (/ (realToFrac ageOfUniverseInYears)) . (* lengthOfYear) . realToFrac

showCosmicYears :: Integer -> Widget n
showCosmicYears = str . showTime . yearsToCosmicTime

toCosmicTime :: NominalDiffTime -> Rational
toCosmicTime t = realToFrac ageOfUniverseInYears * (realToFrac $ t // yearLength) :: Rational
  where
    yearLength = daysPerYear * nominalDay
    x // y     = fromRational $ toRational x / toRational y :: Double

showCosmicTime :: NominalDiffTime -> String
showCosmicTime n = showLarge (fromRational $ toCosmicTime n) ++ " years"

conversionTableRowFromCosmicSeconds :: NominalDiffTime -> [Widget n]
conversionTableRowFromCosmicSeconds n = [cosmicTime, realTime]
  where
    realTime = str $ showCosmicTime n
    cosmicTime = str $ showTime n

cosmicConversion' :: Widget n
cosmicConversion' = renderTable $
  table
  [
    conversionTableRowFromCosmicSeconds $ 30 * 24 * 60 * 60,
    conversionTableRowFromCosmicSeconds $ 7 * 24 * 60 * 60,
    conversionTableRowFromCosmicSeconds $ 24 * 60 * 60,
    conversionTableRowFromCosmicSeconds $ 60 * 60,
    conversionTableRowFromCosmicSeconds $ 60,
    conversionTableRowFromCosmicSeconds $ 1
  ]

cosmicConversion :: Widget n
cosmicConversion = renderTable $
  table
  [
    [str "1 billion years"    , showCosmicYears $ 1000 * 1000 * 1000],
    [str "100 million years"  , showCosmicYears $ 100 * 1000 * 1000],
    [str "10 million years"   , showCosmicYears $ 10 * 1000 * 1000],
    [str "1 million years"    , showCosmicYears $ 1000 * 1000],
    [str "100 thousand years" , showCosmicYears $ 100 * 1000],
    [str "10 thousand years"  , showCosmicYears $ 10 * 1000],
    [str "1 thousand years"   , showCosmicYears 1000],
    [str "100 years"          , showCosmicYears 100],
    [str "10 years"           , showCosmicYears 10],
    [str "1 year"             , showCosmicYears 1]
  ]

showLarge :: Double -> String
showLarge n | n >= 10 * 1000 * 1000 * 1000 = printf "%.0f billion"  (n / (1000 * 1000 * 1000))
showLarge n | n >= 1000 * 1000 * 1000      = printf "%.1f billion"  (n / (1000 * 1000 * 1000))
showLarge n | n >= 10 * 1000 * 1000        = printf "%.0f million"  (n / (1000 * 1000))
showLarge n | n >= 1000 * 1000             = printf "%.1f million"  (n / (1000 * 1000))
showLarge n | n >= 10 * 1000               = printf "%.0f thousand" (n / 1000)
showLarge n | n >= 10                      = unpack $ commasF 0 n
showLarge n                                = printf "%.3f" n

countdownWidget :: Bool -> Bool -> LocalTime -> Widget n
countdownWidget showConversion isSimulated t =
  (border $ vBox [
    (hCenter $ hBox
     [ countdownBox
     , currentTimeBox
     , cosmicTimeBox
     ])
    ,
    str "\n"
    ,
    (borderWithLabel (str progressLabel) $
            updateAttrMap
            (A.mapAttrName yDoneAttr P.progressCompleteAttr .
             A.mapAttrName yToDoAttr P.progressIncompleteAttr) $
            progressBar Nothing (realToFrac $ yearElapsed // yearLength))
    ])
    <=>
    str "\n"
    <=>
    hCenter (hBox [
                -- TODO: accumulate all entries on today's date into one vBox
                if currentEntryIsCurrent then
                  (borderWithLabel (txt "Now on the Cosmic Calendar") currentEntry) <=>
                  (fromMaybe (str "") $ fmap (borderWithLabel (txt "Next on the Cosmic Calendar")) nextEntryShort)
                else
                  borderWithLabel (txt "Next on the Cosmic Calendar") nextEntry,
                -- vBox [ cosmicCalendarCurrent, txt "\n", cosmicCalendarNext ],
                if showConversion
                then
                  str "   " <=> borderWithLabel (str "Cosmic Conversion") (hBox [cosmicConversion, cosmicConversion'])
                else
                  str ""
    ])
  where
    -- TODO: We want to display "today" or "now" on the cosmic calendar;
    -- We want to display what happened previously on the cosmic calendar
    -- We want to say how long ago the previous happening was relative to today's date and today's place on the cosmic calendar
    -- (E.g., if it's 1AM Jan 1, then we say the big bang was 1 hour ago and 1.6 million years ago)
    -- We want to say similar for how long until the next happening
    -- We also _may_ want to say the same thing for the current happening, depending on if it's an instant or a stage
    -- If it's a stage, we want to say how long it lasts; how long since it started, and how long until it ends

    currentEntryIsCurrent = fromMaybe True $ do
      (LocalTime entryDay _) <- (`addLocalTime` yearStart t) . calBeginTime <$> getCurrentCalendarEntry theCalendar t
      let (LocalTime nowDay _) = t
      return $ entryDay == nowDay
    currentEntry = fromMaybe (str "none") $ calendarWidget False <$> getCurrentCalendarEntry theCalendar t
    nextEntry = fromMaybe (str "none") $ calendarWidget False <$> getNextCalendarEntry theCalendar t
    nextEntryShort = fmap (str "\n" <=>) (calendarWidget True <$> getNextCalendarEntry theCalendar t)

    calendarWidget short CalendarEntry{..} = box -- vBox [eventCountdown, str "\n", box]
      where
        timeUntilActive = (calBeginTime `addLocalTime` yearStart t) `diffLocalTime` t
        eventCountdown = if timeUntilActive >= 0 then
                          hBox [str $ "in " ++ showTime timeUntilActive,
                                padLeft Max $ str $ "in " ++ showCosmicTime timeUntilActive]
                        else
                          hBox [str $ showTime (-timeUntilActive) ++ " ago",
                                padLeft Max $ str $ showCosmicTime (-timeUntilActive) ++ " ago"]
        years = fromRational $ toCosmicTime calBeginTime
        box = vBox [
          if currentEntryIsCurrent && not short
          then str "\n"
          else eventCountdown <=> str "\n",
          hCenter $ txt calTitle,
          hCenter $ txt calSubtitle,
          str "\n",
          hBox [
            let cosmicSecondsAgo = nominalDiffTimeToSeconds (yearEnd cosmicCalendarT `diffLocalTime` cosmicCalendarT)
                cosmicCalendarT = calBeginTime `addLocalTime` yearStart t
            in vBox [
              str $ formatTime defaultTimeLocale "%A, %B %e%n%Y-%m-%d %r" $ cosmicCalendarT,
              -- TODO: Choose correct cosmic unit
              str $ printf "%s cosmic second%s ago" (commasF' 1 cosmicSecondsAgo) (pluralize cosmicSecondsAgo)
            ],
            padLeft Max $ vBox [
              str $ showLarge years ++ " years",
              str $ printf "%s years ago" $ showLarge $ realToFrac (ageOfUniverseInYears - floor years)
            ]
          ],
          -- str $ printf "%s years ago" (commas $ ageOfUniverseInYears - floor years),
          if not short
          then
            str "\n" <=>
            txtWrap calDescription
          else
            str ""
          ]

    strWhen b s = str $ if b then s else ""
    countdownBox =
      (borderWithLabel (str $ printf "Countdown %d" currentYear) $
        vBox $
        let secondsNow = 1 + toSeconds yearElapsed :: Int
            secondsTotal = toSeconds yearLength
        in
          (str $ printf "Day %d of %d\nSecond %s of %s\n%s seconds remain"
            dayNum
            numDays
            (commas secondsNow)
            (commas secondsTotal)
            (commas $ secondsTotal - secondsNow)
          ) : remains
        )
    remains =
        [
          strWhen (hoursLeft >= 24) $
          printf "%d day%s remain%s"
          daysLeft
          (pluralize daysLeft)
          (pluralizeVerb daysLeft),

          strWhen (hoursLeft < 24 && hoursLeft > 1) $
          printf "%s hour%s remain%s"
          (commasF 2 hoursLeft)
          (pluralize $ (floor hoursLeft :: Integer))
          (pluralizeVerb $ (floor hoursLeft :: Integer)),

          strWhen (hoursLeft <= 1 && minutesLeft > 1) $
          printf "%s minute%s remain%s"
          (commasF 2 minutesLeft)
          (pluralize $ (floor minutesLeft :: Integer))
          (pluralizeVerb $ (floor minutesLeft :: Integer)),

          strWhen (minutesLeft <= 1) $
          printf "%s second%s remain%s"
          (commasF' 1 secondsLeft)
          (pluralize secondsLeft)
          (pluralizeVerb secondsLeft)
        ]

    cosmicTimeBox =
      (borderWithLabel (str "Cosmic Time") $
       vBox [(str $ printf "%s years" (commas $ (floor cosmicYears :: Integer))),
              str "\n",
             (str $ printf "%s years ago" (commas $ (floor cosmicYearsAgo :: Integer)))
            -- , (str $ printf "%s years ago" (showLarge $ (realToFrac cosmicYearsAgo)))
            -- , (str $ printf "%s billion years ago" (commasF 9 $ cosmicYearsAgo / (1000*1000*1000)))
            -- , (str $ printf "%s million years ago" (commasF 6 $ cosmicYearsAgo / (1000*1000)))
            -- , (str $ printf "%s thousand years ago" (commasF 3 $ cosmicYearsAgo / 1000))
            -- , (str $ printf "%s days ago" (commas $ (floor $ realToFrac cosmicYearsAgo * daysPerYear :: Integer)))
            ])
    currentTimeBox = (hCenter (borderWithLabel (str $ printf "Current time%s" (if isSimulated then " (SIMULATED)" else "" :: String)) $
                               padLeftRight 3 $ (str (formatTime defaultTimeLocale "%A, %B %e%n%Y-%m-%d %r" t))))
    cosmicYears    = realToFrac ageOfUniverseInYears * (realToFrac $ (yearElapsed // yearLength)) :: Rational
    cosmicYearsAgo = realToFrac ageOfUniverseInYears * (realToFrac $ 1 - (yearElapsed // yearLength)) :: Rational
    -- cosmicYearsAgo = if yearElapsed == yearLength
    --                  then 0
    --                  else realToFrac ageOfUniverseInYears * (realToFrac $ 1 - (yearElapsed // yearLength)) :: Rational
    currentYear    = yearNumber t
    dayNum         = dayNumOfYear t
    numDays        = daysInYear t
    -- yearLength     = fromIntegral numDays * nominalDay
    yearLength     = yearEnd t `diffLocalTime` yearStart t
    yearElapsed    = t `diffLocalTime` yearStart t

    daysLeft       = numDays - dayNum
    hoursLeft      = minutesLeft / 60
    minutesLeft    = fromRational $ toRational secondsLeft / 60 :: Double
    toSeconds      = floor . nominalDiffTimeToSeconds
    secondsLeft    = nominalDiffTimeToSeconds (yearLength - yearElapsed)
    x // y         = fromRational $ toRational x / toRational y :: Double
    progressLabel  = printf "%.6F%%" (100 * (yearElapsed // yearLength))

commasF' 1 n = if (floor (n * 10) `mod` 10 :: Int) == 0 then commasF 0 n `Text.append` "  " else commasF 1 n
commasF' p n = commasF p n

commasF', commasF :: RealFrac x => Int -> x -> Text
commasF precision = prettyF cfg
  where
    cfg = PrettyCfg precision (Just ',') '.'

commas :: Integral i => i -> Text
commas = prettyI (Just ',') . fromIntegral

nextTenthOfSecond :: ZonedTime -> ZonedTime
nextTenthOfSecond (ZonedTime (LocalTime day (TimeOfDay h m s)) z) = (ZonedTime (LocalTime day (TimeOfDay h m s')) z)
  where
    s' = fromRational $ toRational (floor (s * 10) + 1 :: Integer) / 10

nextWholeSecond :: ZonedTime -> ZonedTime
nextWholeSecond (ZonedTime (LocalTime day (TimeOfDay h m s)) z) = (ZonedTime (LocalTime day (TimeOfDay h m s')) z)
  where
    s' = fromIntegral $ (floor s + 1 :: Int)

diffZonedTime :: ZonedTime -> ZonedTime -> NominalDiffTime
diffZonedTime = diffLocalTime `Prelude.on` zonedTimeToLocalTime

isNewYearsEve :: LocalTime -> Bool
isNewYearsEve t = dayNumOfYear t == daysInYear t

queueNextEvent :: MonadIO m => Bool -> BChan CustomEvent -> m ZonedTime
queueNextEvent hyper chan = liftIO $ do
  now <- getZonedTime
  void . forkIO $ do

    let getNext = if hyper then nextTenthOfSecond else nextWholeSecond
        next = getNext now
        delay = next `diffZonedTime` now
    threadDelay $ floor $ delay * 1000 * 1000
    writeBChan chan $ TimeChanged next
  return now

isSimulatedTime :: St -> Bool
isSimulatedTime st = st ^. stDisplayTime /= st ^. stClockTime

nextCalendarEntryTime :: LocalTime -> LocalTime
nextCalendarEntryTime t = fromMaybe t $ getNextCalendarEntry theCalendar t <&> (`addLocalTime` yearStart t) . calBeginTime

previousCalendarEntryTime :: LocalTime -> LocalTime
previousCalendarEntryTime t = fromMaybe t $ goBack t
  where
    goBack t = getPreviousCalendarEntry theCalendar t <&> (`addLocalTime` yearStart t) . calBeginTime

handleEvent :: BChan CustomEvent -> St -> BrickEvent () CustomEvent -> EventM () (Next St)
handleEvent chan st e =
    case e of
        VtyEvent (V.EvKey V.KEsc [])            -> halt st
        VtyEvent (V.EvKey (V.KChar 'p') [])     -> cont $ st & stPaused %~ not
        VtyEvent (V.EvKey (V.KFun 1) [])        -> cont $ st & stPaused %~ not

        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.KRight [MCtrl])     -> cont $ st & stDisplayTime %~ (addLocalTime (60))
        VtyEvent (V.EvKey V.KLeft [MCtrl])      -> cont $ st & stDisplayTime %~ (addLocalTime (-60))

        VtyEvent (V.EvKey V.KPageDown [MCtrl])  -> cont $ st & stDisplayTime %~ (addLocalTime (60 * 60))
        VtyEvent (V.EvKey V.KPageUp [MCtrl])    -> cont $ st & stDisplayTime %~ (addLocalTime (-60 * 60))
        VtyEvent (V.EvKey V.KPageDown [])       -> cont $ st & stDisplayTime %~ (addLocalTime lengthOfDay)
        VtyEvent (V.EvKey V.KPageUp [])         -> cont $ st & stDisplayTime %~ (addLocalTime (-lengthOfDay))

        VtyEvent (V.EvKey V.KHome [])           -> cont $ st & stDisplayTime .~ (st ^. stClockTime)
        VtyEvent (V.EvKey V.KHome [MShift])     -> cont $ st & stDisplayTime .~ (yearStart $ st ^. stClockTime)
        VtyEvent (V.EvKey V.KEnd [])            -> cont $ st & stDisplayTime .~ (newYearsEveLast10 $ st ^. stClockTime)
        VtyEvent (V.EvKey V.KEnd [MShift])      -> cont $ st & stDisplayTime .~ (yearEnd $ st ^. stClockTime)
        VtyEvent (V.EvKey V.KEnd [MCtrl])       -> cont $ st & stDisplayTime .~ (newYearsEveNoon $ st ^. stClockTime)

        VtyEvent (V.EvKey V.KRight [])          -> cont $ st & stDisplayTime %~ nextCalendarEntryTime
        VtyEvent (V.EvKey V.KLeft [])           -> cont $ st & stDisplayTime %~ previousCalendarEntryTime
        VtyEvent (V.EvKey (V.KChar '.') [])     -> cont $ st & stDisplayTime %~ nextCalendarEntryTime
        VtyEvent (V.EvKey (V.KChar ',') [])     -> cont $ st & stDisplayTime %~ previousCalendarEntryTime

        VtyEvent (V.EvKey (V.KChar 'c') [])     -> cont $ st & stShowConversion %~ not
        VtyEvent (V.EvKey (V.KFun 2) [])        -> cont $ st & stShowConversion %~ not

        VtyEvent _                              -> cont st
        AppEvent (TimeChanged now) -> do
          let hyper = isNewYearsEve $ st ^. stDisplayTime
          void $ queueNextEvent hyper chan
          let oldTime = st ^. stClockTime
          cont $ st & stClockTime .~ (zonedTimeToLocalTime now)
                    & stDisplayTime %~ if st ^. stPaused then id else addLocalTime $ zonedTimeToLocalTime now `diffLocalTime` oldTime
        _ -> cont st
    where
      cont s = do
        continue $ s & stLastBrickEvent .~ (Just e)

newYearsEveLast10 :: LocalTime -> LocalTime
newYearsEveLast10 = addLocalTime (-11) . yearEnd

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
       , _stDisplayTime = t
       , _stNextEvent = Nothing
       , _stPaused = False
       , _stShowConversion = False
       }

daysInYear :: LocalTime -> Int
daysInYear (toGregorian . localDay -> (y, _, _)) = if isLeapYear y then 366 else 365

theBaseAttr :: A.AttrName
theBaseAttr = A.attrName "theBase"

xDoneAttr, xToDoAttr :: A.AttrName
xDoneAttr = theBaseAttr <> A.attrName "X:done"
xToDoAttr = theBaseAttr <> A.attrName "X:remaining"

yDoneAttr, yToDoAttr :: A.AttrName
yDoneAttr = theBaseAttr <> A.attrName "Y:done"
yToDoAttr = theBaseAttr <> A.attrName "Y:remaining"

zDoneAttr, zToDoAttr :: A.AttrName
zDoneAttr = theBaseAttr <> A.attrName "Z:done"
zToDoAttr = theBaseAttr <> A.attrName "Z:remaining"

theMap :: A.AttrMap
theMap = A.attrMap V.defAttr
         [ (theBaseAttr,               bg V.brightBlack)
         , (xDoneAttr,                 V.black `on` V.white)
         , (xToDoAttr,                 V.white `on` V.black)
         , (yDoneAttr,                 V.magenta `on` V.yellow)
         , (zDoneAttr,                 V.blue `on` V.green)
         , (zToDoAttr,                 V.blue `on` V.red)
         , (P.progressIncompleteAttr,  fg V.yellow)
         ]

theApp :: BChan CustomEvent -> App St CustomEvent ()
theApp chan =
    App { appDraw = drawUI
        , appChooseCursor = showFirstCursor
        , appHandleEvent = handleEvent chan
        , appStartEvent = return
        , appAttrMap = const theMap
        }

main :: IO ()
main = do
    chan <- newBChan 10

    let buildVty = V.mkVty V.defaultConfig
    initialVty <- buildVty
    now <- queueNextEvent False chan
    void $ customMain initialVty buildVty (Just chan) (theApp chan) (initialState $ zonedTimeToLocalTime now)