packages feed

brick-calendar-0.2.0.0: src/Brick/Widgets/Calendar/Internal/Month.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Brick.Widgets.Calendar.Internal.Month
  (
    renderCalendar
  ) where

import Brick
import Brick.Widgets.Center

import Data.Time
import Data.Time.Calendar.Month
import Lens.Micro

import Brick.Widgets.Calendar.Internal.Core
import Brick.Widgets.Calendar.Internal.Utils

-- | Render a month calendar widget
renderCalendar :: Ord n => CalendarState n -> Widget n
renderCalendar state@CalendarState{..} =
  vBox [ renderHeader state
       , if calConfig ^. showDayLabels
         then renderDayLabels calConfig
         else emptyWidget
       , renderDays calConfig calYear calMonth calSelectedDay calendarName
       ]

-- | Render the calendar header with month/year and navigation buttons
renderHeader :: Ord n => CalendarState n -> Widget n
renderHeader CalendarState{..} =
  let monthText = getMonthLabel calConfig calYear calMonth
      prevButton = clickable (calendarName CalendarPrev) $ 
                   withAttr (attrName "calendar.nav") $ 
                   str " << "
      monthLabel = clickable (calendarName (CalendarMonth (fromIntegral calYear) calMonth)) $ 
                   txt monthText
      nextButton = clickable (calendarName CalendarNext) $ 
                   withAttr (attrName "calendar.nav") $ 
                   str " >> "
  in hLimit 20 $ hCenter $ hBox [prevButton, monthLabel, nextButton]

-- | Render the day labels (S M T W T F S)
renderDayLabels :: CalendarConfig -> Widget n
renderDayLabels config =
  let labels = getWeekDayLabels config
      -- Create evenly spaced day labels using padRight
      paddedLabels = init labels `zip` repeat (Pad 1) ++ [(last labels, Pad 0)]
      makeLabel (l, p) = padRight p $ 
                         withAttr (attrName "calendar.dayLabel") $
                         txt l
  in hBox $ map makeLabel paddedLabels

-- | Render the days of the month
renderDays :: Ord n => CalendarConfig -> Integer -> Int -> Maybe Day -> (CalendarResource -> n) -> Widget n
renderDays config year month selectedDay nameF =
  let yearMonth = YearMonth year month
      daysInMonth = periodLength yearMonth
      firstDay = getFirstDayOfMonth year month
      
      -- Get days of previous month that need to be displayed
      prevYearMonth = addMonths (-1) yearMonth
      YearMonth prevYear prevMonth = prevYearMonth
      prevMonthDays = periodLength prevYearMonth
      
      -- Calculate start day offset more elegantly using modular arithmetic
      -- This avoids nested case statements
      firstDayInt = fromEnum firstDay
      weekStartInt = fromEnum $ config ^. weekStart
      startDayNum = (firstDayInt - weekStartInt) `mod` 7
      
      -- Days from previous month to display
      prevDays = 
        if startDayNum > 0
        then map (\d -> (prevYear, prevMonth, d, True)) 
             [prevMonthDays - startDayNum + 1 .. prevMonthDays]
        else []
      
      -- Days from current month
      currentDays = map (\d -> (year, month, d, False)) [1..daysInMonth]
      
      -- Calculate extra days needed from next month
      nextYearMonth = addMonths 1 yearMonth
      YearMonth nextYear nextMonth = nextYearMonth
      
      -- Calculate days needed for a standard 6-row calendar (42 days total)
      totalDays = length prevDays + length currentDays
      daysNeeded = 42 - totalDays  -- 6 rows × 7 days
      
      -- Create next month days to fill exactly 6 rows
      nextDays = map (\d -> (nextYear, nextMonth, d, True)) [1..daysNeeded]
      
      -- All days to display
      allDays = prevDays ++ currentDays ++ nextDays
      
      -- Chunked into weeks (always 6 weeks)
      weeks = chunksOf 7 allDays
      
      -- Render a single day with appropriate padding
      renderDay (dayInfo, isLast) =
        let (y, m, d, isOutside) = dayInfo
            day = fromGregorian y m d
            isSelected = maybe False (== day) selectedDay
            
            -- Decide attribute based on whether day is outside current month
            attr = if isOutside 
                   then case config ^. outsideMonthDisplay of
                          Hide -> attrName "calendar.hidden"
                          ShowDimmed -> attrName "calendar.outsideMonth"
                          ShowNormal -> attrName "calendar.day"
                   else attrName "calendar.day"
                   
            -- Add selected attribute if day is selected
            finalAttr = if isSelected 
                        then attr <> attrName "selected"
                        else attr
                        
            -- Format day as text
            dayText = if isOutside && config ^. outsideMonthDisplay == Hide
                      then "  "  -- Two spaces for hidden days
                      else formatDayNumber config day
                      
            -- Create clickable day widget with appropriate resource identifier
            baseDayWidget = clickable (nameF (CalendarDay (fromIntegral y) m d)) $
                           hLimit 3 $ withAttr finalAttr (txt dayText)
                           
            -- Add padding except for the last item in each row
            dayWidget = if isLast
                        then baseDayWidget
                        else padRight (Pad 1) baseDayWidget
        in dayWidget
      
      -- Render a week by adding padding between days but not after the last one
      renderWeek days = 
        let daysWithIsLast = zip days (replicate 6 False ++ [True])
        in hBox $ map renderDay daysWithIsLast
      
  in vBox $ map renderWeek weeks