packages feed

brick-calendar-0.2.0.0: programs/DualCalendarDemo.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Brick
import Brick.Widgets.Border
import qualified Brick.Widgets.Center as C
import Brick.Widgets.Calendar
import qualified Graphics.Vty as V
import Data.Time
import System.IO
import Lens.Micro.Platform

data AppName = 
    Calendar1 CalendarResource   -- ^ Resources for first calendar
  | Calendar2 CalendarResource   -- ^ Resources for second calendar
  deriving (Show, Eq, Ord)

data ActiveCalendar = ActiveCalendar1 | ActiveCalendar2
  deriving (Eq)

-- | Application state with two calendars
data AppState = AppState
    { calendar1 :: CalendarState AppName  -- ^ Left calendar
    , calendar2 :: CalendarState AppName  -- ^ Right calendar
    , activeCalendar :: ActiveCalendar    -- ^ Currently active calendar
    }

calendar1L :: Lens' AppState (CalendarState AppName)
calendar1L = lens calendar1 (\s a -> s { calendar1 = a })

calendar2L :: Lens' AppState (CalendarState AppName)
calendar2L = lens calendar2 (\s a -> s { calendar2 = a })

activeCalendarL :: Lens' AppState ActiveCalendar
activeCalendarL = lens activeCalendar (\s a -> s { activeCalendar = a })

-- | Initialize a calendar state for the first (left) calendar
mkCalendar1 :: Day -> CalendarState AppName
mkCalendar1 day = 
  let (year, month, _) = toGregorian day
      config = defaultCalendarConfig
                { _showDayLabels = True
                , _dayLabelStyle = DistinctInitials
                , _outsideMonthDisplay = ShowDimmed
                , _weekStart = Monday
                }
  in CalendarState year month (Just day) config Calendar1

-- | Initialize a calendar state for the second (right) calendar
mkCalendar2 :: Day -> CalendarState AppName
mkCalendar2 day = 
  let (year, month, _) = toGregorian day
      config = defaultCalendarConfig
                { _showDayLabels = True
                , _dayLabelStyle = DoubleChar
                , _outsideMonthDisplay = ShowNormal
                , _weekStart = Sunday
                }
  in CalendarState year month (Just day) config Calendar2

-- | Main app definition
app :: App AppState e AppName
app = App
    { appDraw = drawUI
    , appChooseCursor = showFirstCursor
    , appHandleEvent = handleEvent
    , appStartEvent = return ()
    , appAttrMap = const defaultCalendarAttrMap
    }

-- | Draw the UI with both calendars side-by-side
drawUI :: AppState -> [Widget AppName]
drawUI s = 
  let 
      -- Apply highlight to the active calendar
      cal1Border = if activeCalendar s == ActiveCalendar1 
                   then withAttr (attrName "active") . border 
                   else withAttr (attrName "inactive") . border
      
      cal2Border = if activeCalendar s == ActiveCalendar2 
                   then withAttr (attrName "active") . border 
                   else withAttr (attrName "inactive") . border
      
      cal1Widget = cal1Border $ padAll 1 $ renderCalendar (calendar1 s)
      cal2Widget = cal2Border $ padAll 1 $ renderCalendar (calendar2 s)
      
      -- The main layout
      mainLayout = vBox 
                   [ C.hCenter $ str "Tab to switch focus"
                   , hBorder
                   ,C.hCenter $ hBox [C.center cal1Widget, vBorder, C.center cal2Widget]
                   ]
  in [C.center mainLayout]

-- | Handle events for both calendars
handleEvent :: BrickEvent AppName e -> EventM AppName AppState ()
handleEvent (VtyEvent (V.EvKey V.KEsc [])) = halt
handleEvent (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt

-- Tab key switches focus between calendars
handleEvent (VtyEvent (V.EvKey (V.KChar '\t') [])) = do
  modify $ \s -> s { activeCalendar = if activeCalendar s == ActiveCalendar1 then ActiveCalendar2 else ActiveCalendar1 }

-- Handle calendar events for the active calendar
handleEvent e = do
  active <- use activeCalendarL
  case active of
    ActiveCalendar1 -> zoom calendar1L $ handleCalendarEvent e
    ActiveCalendar2 -> zoom calendar2L $ handleCalendarEvent e

-- | Main function
main :: IO ()
main = do
    -- Ensure unicode support
    hSetEncoding stdout utf8
    
    -- Get today's date and one month later for the two calendars
    today <- utctDay <$> getCurrentTime
    let nextMonth = addGregorianMonthsClip 1 today
    
    -- Create initial state with two calendars
    let initialState = AppState 
                      { calendar1 = mkCalendar1 today
                      , calendar2 = mkCalendar2 nextMonth
                      , activeCalendar = ActiveCalendar1  -- First calendar is active initially
                      }
    
    -- Run the app
    finalState <- defaultMain app initialState
    
    -- Print the selected dates when the app exits
    putStrLn "Calendar 1 selected date: " 
    case calSelectedDay $ calendar1 finalState of
        Just day -> putStrLn $ showGregorian day
        Nothing -> putStrLn "No date selected"
        
    putStrLn "Calendar 2 selected date: "
    case calSelectedDay $ calendar2 finalState of
        Just day -> putStrLn $ showGregorian day
        Nothing -> putStrLn "No date selected"