datepicker

 1{-# LANGUAGE CPP #-}
 2
 3module Main where
 4
 5import CmdLine (cmdOpts, optDuration, optFormat, optNoTime, optLogical, optsPeriod)
 6import Control.Exception (throwIO)
 7import Data.Time.LocalTime
 8  ( LocalTime (LocalTime),
 9    ZonedTime (ZonedTime),
10    getCurrentTimeZone,
11    getZonedTime,
12    localDay,
13    zonedTimeToLocalTime,
14  )
15import Graphics.Vty qualified as V
16import Graphics.Vty.Input.Events qualified as E
17import Graphics.Vty.Platform.Unix (mkVtyWithSettings)
18import Graphics.Vty.Platform.Unix.Settings qualified as VU
19import Options.Applicative (execParser)
20import System.Posix.IO (OpenMode (ReadWrite), defaultFileFlags, openFd)
21import UI qualified
22import UI.Month qualified as M
23import UI.Time qualified as T
24import Util (format)
25
26isTerm :: E.Event -> Bool
27isTerm (E.EvKey key _) =
28  key == E.KEsc || key == E.KChar 'q'
29isTerm _ = False
30
31-- Make sure we read and write to /dev/tty instead of relying on stdin/stdout.
32-- This allows using datepicker within pipes where stdin/stdout is redirected.
33unixSettings :: IO VU.UnixSettings
34unixSettings = do
35#if MIN_VERSION_unix(2,8,0)
36  ttyFd <- openFd "/dev/tty" ReadWrite defaultFileFlags
37#else
38  ttyFd <- openFd "/dev/tty" ReadWrite Nothing defaultFileFlags
39#endif
40
41  -- Can't build upon defaultSettings here as it flushes standard input and
42  -- if standard input is a pipe it may not necessarily be flushable.
43  mb <- VU.currentTerminalName
44  case mb of
45    Nothing -> throwIO VU.MissingTermEnvVar
46    Just t -> do
47      return $
48        VU.UnixSettings
49          { VU.settingVmin = 1,
50            VU.settingVtime = 100,
51            VU.settingInputFd = ttyFd,
52            VU.settingOutputFd = ttyFd,
53            VU.settingTermName = t
54          }
55
56main :: IO ()
57main = do
58  args <- execParser cmdOpts
59  let outFmt = optFormat args
60
61  vty <- unixSettings >>= mkVtyWithSettings V.defaultConfig
62  localTime <- zonedTimeToLocalTime <$> getZonedTime
63
64  let today = localDay localTime
65      range = optsPeriod (optDuration args) today
66      mview = M.mkMonthView range today (optLogical args)
67  lt@(LocalTime date _) <- UI.showView mview isTerm vty
68
69  timeZone <- getCurrentTimeZone
70  let mkZonedTime local = ZonedTime local timeZone
71
72  if optNoTime args
73    then V.shutdown vty >> putStrLn (format outFmt $ mkZonedTime lt)
74    else do
75      (LocalTime _ nowTime) <- zonedTimeToLocalTime <$> getZonedTime
76      (LocalTime _ time) <- UI.showView (T.mkTimeView nowTime lt) isTerm vty
77
78      let res = LocalTime date time
79      V.shutdown vty >> putStrLn (format outFmt $ mkZonedTime res)