datepicker

 1module DatePicker.UI (View (..), showView) where
 2
 3import Control.Monad (when)
 4import Data.Maybe (fromMaybe, isJust)
 5import Data.Time.LocalTime (LocalTime)
 6import DatePicker.Util (horizCenter, vertCenter)
 7import Graphics.Vty qualified as V
 8import Graphics.Vty.Image qualified as I
 9import Graphics.Vty.Input.Events qualified as E
10import System.Exit (exitFailure)
11
12class View a where
13  draw :: a -> I.Image
14  process :: a -> E.Event -> Either (Maybe a) LocalTime
15
16showView :: (View a) => a -> (E.Event -> Bool) -> V.Vty -> IO LocalTime
17showView v isTermEvent t = showView' v t True
18  where
19    showView' view vty redraw = do
20      let out = V.outputIface vty
21      region <- V.displayBounds out
22
23      when redraw $ do
24        let (w, h) = (V.regionWidth region, V.regionHeight region)
25            img = horizCenter w $ vertCenter h $ draw view
26            pic = V.picForImage img
27        if I.imageWidth img > w || I.imageHeight img > h
28          then V.shutdown vty >> putStrLn "Terminal is too small" >> exitFailure
29          else V.update vty pic
30
31      e <- V.nextEvent vty
32      if isTermEvent e
33        then V.shutdown vty >> exitFailure
34        else case process view e of
35          Right output -> pure output
36          Left mv -> showView' (fromMaybe view mv) vty (isJust mv)