packages feed

brick-calendar 0.1.0.0 → 0.2.0.0

raw patch · 10 files changed

+312/−96 lines, 10 filesnew-component:exe:dual-calendar-demoPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Brick.Widgets.Calendar: [calendarName] :: CalendarState n -> CalendarResource -> n
+ Brick.Widgets.Calendar: handleCalendarEvent :: BrickEvent n e -> EventM n (CalendarState n) ()
- Brick.Widgets.Calendar: CalendarState :: Integer -> Int -> Maybe Day -> CalendarConfig -> CalendarState
+ Brick.Widgets.Calendar: CalendarState :: Integer -> Int -> Maybe Day -> CalendarConfig -> (CalendarResource -> n) -> CalendarState n
- Brick.Widgets.Calendar: [calConfig] :: CalendarState -> CalendarConfig
+ Brick.Widgets.Calendar: [calConfig] :: CalendarState n -> CalendarConfig
- Brick.Widgets.Calendar: [calMonth] :: CalendarState -> Int
+ Brick.Widgets.Calendar: [calMonth] :: CalendarState n -> Int
- Brick.Widgets.Calendar: [calSelectedDay] :: CalendarState -> Maybe Day
+ Brick.Widgets.Calendar: [calSelectedDay] :: CalendarState n -> Maybe Day
- Brick.Widgets.Calendar: [calYear] :: CalendarState -> Integer
+ Brick.Widgets.Calendar: [calYear] :: CalendarState n -> Integer
- Brick.Widgets.Calendar: data CalendarState
+ Brick.Widgets.Calendar: data CalendarState n
- Brick.Widgets.Calendar: moveDown :: CalendarState -> CalendarState
+ Brick.Widgets.Calendar: moveDown :: CalendarState n -> CalendarState n
- Brick.Widgets.Calendar: moveLeft :: CalendarState -> CalendarState
+ Brick.Widgets.Calendar: moveLeft :: CalendarState n -> CalendarState n
- Brick.Widgets.Calendar: moveRight :: CalendarState -> CalendarState
+ Brick.Widgets.Calendar: moveRight :: CalendarState n -> CalendarState n
- Brick.Widgets.Calendar: moveUp :: CalendarState -> CalendarState
+ Brick.Widgets.Calendar: moveUp :: CalendarState n -> CalendarState n
- Brick.Widgets.Calendar: renderCalendar :: CalendarState -> Widget CalendarResource
+ Brick.Widgets.Calendar: renderCalendar :: Ord n => CalendarState n -> Widget n
- Brick.Widgets.Calendar: setMonthAfter :: CalendarState -> CalendarState
+ Brick.Widgets.Calendar: setMonthAfter :: CalendarState n -> CalendarState n
- Brick.Widgets.Calendar: setMonthBefore :: CalendarState -> CalendarState
+ Brick.Widgets.Calendar: setMonthBefore :: CalendarState n -> CalendarState n
- Brick.Widgets.Calendar: setYearAfter :: CalendarState -> CalendarState
+ Brick.Widgets.Calendar: setYearAfter :: CalendarState n -> CalendarState n
- Brick.Widgets.Calendar: setYearBefore :: CalendarState -> CalendarState
+ Brick.Widgets.Calendar: setYearBefore :: CalendarState n -> CalendarState n

Files

+ README.md view
@@ -0,0 +1,54 @@+# Brick Calendar++![A screenshot of the brick calendar widget](./docs/image.png)++A calendar widget for [Brick](https://github.com/jtdaugherty/brick) terminal user interfaces.++## Features++- Configurable first day of week (Sunday, Monday, etc.)+- Configurable day-of-week label+  - Single char (S, M, T, W, T, F, S)+  - Double char (Su, Mo, Tu, We, Th, Fr, Sa)+  - Distinct initials (Su, M, T, W, Th, F, S)+  - Hidden+- Option to show/hide/dim days outside the current month+- Easy integration with existing Brick applications++## Installation++```+cabal install brick-calendar+```++## Usage++```haskell+-- Define a resource name type+data AppName = CalName CalendarResource+  deriving (Show, Eq, Ord)++-- Create a calendar state from a date+mkCalendarState :: Day -> CalendarState AppName+mkCalendarState day = +  let (year, month, _) = toGregorian day+      config = defaultCalendarConfig+                { _weekStart = Monday+                , _dayLabelStyle = DistinctInitials+                , _showDayLabels = True+                , _outsideMonthDisplay = ShowDimmed+                }+  in CalendarState year month (Just day) config CalName++-- Render the calendar+drawUI :: AppState -> [Widget AppName]+drawUI s = [center $ border $ padAll 1 $ renderCalendar (calendar s)]++-- Handle calendar navigation events+handleEvent :: BrickEvent AppName e -> EventM AppName AppState ()+handleEvent (VtyEvent (V.EvKey V.KEsc [])) = halt+handleEvent e = +  zoom calendarL $ handleCalendarEvent e+```++See `programs/SimpleDemo.hs` for a complete working example.
brick-calendar.cabal view
@@ -1,8 +1,10 @@ cabal-version:      3.0 name:               brick-calendar-version:            0.1.0.0+version:            0.2.0.0 synopsis:           Calendar widget for the Brick TUI library-description:        A library providing a month calendar widget for Brick-based terminal user interfaces+description:        +  A library providing a calendar widget for <https://hackage.haskell.org/package/brick Brick>-based terminal user interfaces.+  See <https://github.com/ldgrp/brick-calendar/tree/main/README.md the README file> and <https://github.com/ldgrp/brick-calendar/tree/main/programs demo programs>. homepage:           https://github.com/ldgrp/brick-calendar bug-reports:        https://github.com/ldgrp/brick-calendar/issues license:            MIT@@ -11,6 +13,7 @@ maintainer:         leo@ldgrp.me category:           User Interfaces, Console, TUI build-type:         Simple+extra-doc-files:    README.md  source-repository head   type:     git@@ -66,6 +69,19 @@   build-depends:       base >= 4.11 && < 5                       ,brick-calendar                       ,brick >= 2.8.3 && < 2.9+                      ,microlens-platform >= 0.4.4 && < 0.5+                      ,time >= 1.12.2 && < 1.13+                      ,vty >= 6.4 && < 6.5+  default-language:    Haskell2010+  ghc-options:         -Wall -threaded++executable dual-calendar-demo+  hs-source-dirs:      programs+  main-is:             DualCalendarDemo.hs+  build-depends:       base >= 4.11 && < 5+                      ,brick-calendar+                      ,brick >= 2.8.3 && < 2.9+                      ,microlens-platform >= 0.4.4 && < 0.5                       ,time >= 1.12.2 && < 1.13                       ,vty >= 6.4 && < 6.5   default-language:    Haskell2010
programs/CalendarDemo.hs view
@@ -3,32 +3,30 @@ module Main where  import Brick-import Brick.Widgets.Core import Brick.Widgets.Border import qualified Brick.Widgets.Center as C import Brick.Widgets.Calendar-import qualified Brick.AttrMap as A import qualified Graphics.Vty as V import Data.Time-import Control.Monad import System.IO import Lens.Micro.Platform  -- | Data type to identify our widgets-data Name = Calendar1+data AppName = Calendar1+    | Calendar1Resource CalendarResource     deriving (Eq, Ord, Show)  -- | App state newtype AppState = AppState-    { calendar :: CalendarState+    { calendar :: CalendarState AppName     }  -- | Lens for the calendar field of AppState-calendarL :: Lens' AppState CalendarState+calendarL :: Lens' AppState (CalendarState AppName) calendarL = lens calendar (\s c -> s { calendar = c })  -- | Main app definition-app :: App AppState e CalendarResource+app :: App AppState e AppName app = App     { appDraw = drawUI     , appChooseCursor = showFirstCursor@@ -42,18 +40,18 @@ initialState = do     today <- utctDay <$> getCurrentTime     let (year, month, _) = toGregorian today-    let calConfig = defaultCalendarConfig+    let config = defaultCalendarConfig                     { _showDayLabels = True                     , _dayLabelStyle = DistinctInitials                     , _outsideMonthDisplay = ShowDimmed                     , _weekStart = Sunday                     }     return AppState-        { calendar = CalendarState year month (Just today) calConfig+        { calendar = CalendarState year month (Just today) config Calendar1Resource         }  -- | Draw the UI-drawUI :: AppState -> [Widget CalendarResource]+drawUI :: AppState -> [Widget AppName] drawUI s = [C.center ((border (padAll 1 ui) <=> config) <+> hLimit 40 help)]   where     config = vBox@@ -81,7 +79,7 @@         ]  -- | Display the current configuration-displayConfig :: CalendarState -> Widget n+displayConfig :: CalendarState AppName -> Widget n displayConfig s =     let config = calConfig s         weekStartText = show (config ^. weekStart)@@ -94,9 +92,7 @@                          Hide -> "Hide"                          ShowDimmed -> "Show dimmed"                          ShowNormal -> "Show normal"-        selectedText = case calSelectedDay s of-                         Nothing -> "None"-                         Just day -> showGregorian day+        selectedText = maybe "None" showGregorian (calSelectedDay s)     in withAttr (attrName "config") $        vBox [ str $ "Week starts on: " ++ weekStartText             , str $ "Day label style: " ++ labelStyleText@@ -106,7 +102,7 @@             ]  -- | Handle events-handleEvent :: BrickEvent CalendarResource e -> EventM CalendarResource AppState ()+handleEvent :: BrickEvent AppName e -> EventM AppName AppState () handleEvent (VtyEvent (V.EvKey V.KEsc [])) = halt handleEvent (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt handleEvent (VtyEvent (V.EvKey V.KEnter [])) = halt@@ -151,26 +147,8 @@                          _ -> error "Not implemented"         modify $ \s -> s { calConfig = config & weekStart .~ newStart } --- Handle calendar keyboard events-handleEvent (VtyEvent (V.EvKey V.KUp [])) = calendarL %= moveUp-handleEvent (VtyEvent (V.EvKey V.KDown [])) = calendarL %= moveDown-handleEvent (VtyEvent (V.EvKey V.KLeft [])) = calendarL %= moveLeft-handleEvent (VtyEvent (V.EvKey V.KRight [])) = calendarL %= moveRight-handleEvent (VtyEvent (V.EvKey (V.KChar '[') [])) = calendarL %= setMonthBefore-handleEvent (VtyEvent (V.EvKey (V.KChar ']') [])) = calendarL %= setMonthAfter-handleEvent (VtyEvent (V.EvKey (V.KChar '{') [])) = calendarL %= setYearBefore-handleEvent (VtyEvent (V.EvKey (V.KChar '}') [])) = calendarL %= setYearAfter---- Handle vim-like navigation-handleEvent (VtyEvent (V.EvKey (V.KChar 'h') [])) = calendarL %= moveLeft-handleEvent (VtyEvent (V.EvKey (V.KChar 'j') [])) = calendarL %= moveDown-handleEvent (VtyEvent (V.EvKey (V.KChar 'k') [])) = calendarL %= moveUp-handleEvent (VtyEvent (V.EvKey (V.KChar 'l') [])) = calendarL %= moveRight-handleEvent (VtyEvent (V.EvKey (V.KChar 'H') [])) = calendarL %= setMonthBefore-handleEvent (VtyEvent (V.EvKey (V.KChar 'L') [])) = calendarL %= setMonthAfter-handleEvent (VtyEvent (V.EvKey (V.KChar 'J') [])) = calendarL %= setYearBefore-handleEvent (VtyEvent (V.EvKey (V.KChar 'K') [])) = calendarL %= setYearAfter-handleEvent _ = return ()+-- Use the default calendar event handler for navigation+handleEvent e = zoom calendarL $ handleCalendarEvent e  -- | Main function main :: IO ()
+ programs/DualCalendarDemo.hs view
@@ -0,0 +1,141 @@+{-# 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" 
programs/SimpleDemo.hs view
@@ -6,19 +6,24 @@ import Brick.Widgets.Border import qualified Brick.Widgets.Center as C import Brick.Widgets.Calendar-import qualified Brick.AttrMap as A import qualified Graphics.Vty as V import Data.Time-import Control.Monad import System.IO+import Lens.Micro.Platform --- App state with calendar+data AppName = CalName CalendarResource+  deriving (Show, Eq, Ord)++calendarL :: Lens' AppState (CalendarState AppName)+calendarL = lens calendar (\s a -> s { calendar = a })++-- | App state with calendar newtype AppState = AppState-    { calendar :: CalendarState+    { calendar :: CalendarState AppName     }  -- Initialize the app state-mkCalendarState :: Day -> CalendarState+mkCalendarState :: Day -> CalendarState AppName mkCalendarState day =    let (year, month, _) = toGregorian day       config = defaultCalendarConfig@@ -27,10 +32,10 @@                 , _outsideMonthDisplay = ShowDimmed                 , _weekStart = Sunday                 }-  in CalendarState year month (Just day) config+  in CalendarState year month (Just day) config CalName  -- Main app definition-app :: App AppState e CalendarResource+app :: App AppState e AppName app = App     { appDraw = drawUI     , appChooseCursor = showFirstCursor@@ -40,30 +45,17 @@     }  -- Draw the UI-drawUI :: AppState -> [Widget CalendarResource]+drawUI :: AppState -> [Widget AppName] drawUI s = [C.center $ border $ padAll 1 $ renderCalendar (calendar s)] --- Handle events-handleEvent :: BrickEvent CalendarResource e -> EventM CalendarResource AppState ()+-- | Handle events+handleEvent :: BrickEvent AppName e -> EventM AppName AppState () handleEvent (VtyEvent (V.EvKey V.KEsc [])) = halt handleEvent (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt-handleEvent (VtyEvent (V.EvKey V.KUp [])) = -    modify $ \s -> s { calendar = moveUp (calendar s) }-handleEvent (VtyEvent (V.EvKey V.KDown [])) = -    modify $ \s -> s { calendar = moveDown (calendar s) }-handleEvent (VtyEvent (V.EvKey V.KLeft [])) = -    modify $ \s -> s { calendar = moveLeft (calendar s) }-handleEvent (VtyEvent (V.EvKey V.KRight [])) = -    modify $ \s -> s { calendar = moveRight (calendar s) }-handleEvent (VtyEvent (V.EvKey (V.KChar '[') [])) = -    modify $ \s -> s { calendar = setMonthBefore (calendar s) }-handleEvent (VtyEvent (V.EvKey (V.KChar ']') [])) = -    modify $ \s -> s { calendar = setMonthAfter (calendar s) }-handleEvent (VtyEvent (V.EvKey (V.KChar '{') [])) = -    modify $ \s -> s { calendar = setYearBefore (calendar s) }-handleEvent (VtyEvent (V.EvKey (V.KChar '}') [])) = -    modify $ \s -> s { calendar = setYearAfter (calendar s) }-handleEvent _ = return ()++-- Use the built-in calendar event handler for navigation+handleEvent e = do+  zoom calendarL $ handleCalendarEvent e  -- Main function main :: IO ()
src/Brick/Widgets/Calendar.hs view
@@ -35,7 +35,10 @@   , setYearBefore   , setYearAfter -  -- * Configuration+    -- * Pre-built event handler+  , handleCalendarEvent++    -- * Configuration   , CalendarConfig(..)   , DayLabelStyle(..)   , OutsideMonthDisplay(..)
src/Brick/Widgets/Calendar/Internal/Actions.hs view
@@ -1,5 +1,8 @@+{-# LANGUAGE LambdaCase #-}+ module Brick.Widgets.Calendar.Internal.Actions-  ( moveUp+  ( -- * Navigation actions+    moveUp   , moveDown   , moveLeft   , moveRight@@ -7,46 +10,51 @@   , setMonthAfter   , setYearBefore   , setYearAfter+    -- * Event handler for common calendar navigation+    -- You can also use the individual actions above to create your own custom event handler+  , handleCalendarEvent   ) where  import Data.Time import Data.Time.Calendar.Month+import Brick ( modify, EventM, BrickEvent(..) )+import qualified Graphics.Vty as V  import Brick.Widgets.Calendar.Internal.Core -moveUp :: CalendarState -> CalendarState+moveUp :: CalendarState n -> CalendarState n moveUp =   navigateSelection (addDays (-7)) -moveDown :: CalendarState -> CalendarState+moveDown :: CalendarState n -> CalendarState n moveDown =   navigateSelection (addDays 7) -moveLeft :: CalendarState -> CalendarState+moveLeft :: CalendarState n -> CalendarState n moveLeft =   navigateSelection (addDays (-1)) -moveRight :: CalendarState -> CalendarState+moveRight :: CalendarState n -> CalendarState n moveRight =   navigateSelection (addDays 1) -setMonthBefore :: CalendarState -> CalendarState+setMonthBefore :: CalendarState n -> CalendarState n setMonthBefore =   navigateMonth (addMonths (-1)) -setMonthAfter :: CalendarState -> CalendarState+setMonthAfter :: CalendarState n -> CalendarState n setMonthAfter =   navigateMonth (addMonths 1) -setYearBefore :: CalendarState -> CalendarState+setYearBefore :: CalendarState n -> CalendarState n setYearBefore =   navigateMonth (addMonths (-12)) -setYearAfter :: CalendarState -> CalendarState+setYearAfter :: CalendarState n -> CalendarState n setYearAfter =   navigateMonth (addMonths 12) -navigateSelection :: (Day -> Day) -> CalendarState -> CalendarState+navigateSelection :: (Day -> Day) -> CalendarState n -> CalendarState n navigateSelection dayTransform s =   case calSelectedDay s of     Nothing -> @@ -61,7 +69,7 @@          -- Otherwise just update the selected day          else s { calSelectedDay = Just newDay } -navigateMonth :: (Month -> Month) -> CalendarState -> CalendarState+navigateMonth :: (Month -> Month) -> CalendarState n -> CalendarState n navigateMonth monthTransform s =    let currentYM = YearMonth (calYear s) (calMonth s)       newYM = monthTransform currentYM@@ -77,3 +85,29 @@           in Just $ fromGregorian newYear newMonth adjustedDay              in s { calYear = newYear, calMonth = newMonth, calSelectedDay = newDay }++handleCalendarEvent :: BrickEvent n e -> EventM n (CalendarState n) ()+handleCalendarEvent = \case+  -- Navigate between days+  VtyEvent (V.EvKey V.KUp [])      -> modify moveUp+  VtyEvent (V.EvKey V.KDown [])    -> modify moveDown+  VtyEvent (V.EvKey V.KLeft [])    -> modify moveLeft+  VtyEvent (V.EvKey V.KRight [])   -> modify moveRight+  VtyEvent (V.EvKey (V.KChar 'h') []) -> modify moveLeft+  VtyEvent (V.EvKey (V.KChar 'l') []) -> modify moveRight+  VtyEvent (V.EvKey (V.KChar 'j') []) -> modify moveDown+  VtyEvent (V.EvKey (V.KChar 'k') []) -> modify moveUp+  +  -- Navigate between months+  VtyEvent (V.EvKey (V.KChar '[') []) -> modify setMonthBefore+  VtyEvent (V.EvKey (V.KChar ']') []) -> modify setMonthAfter+  VtyEvent (V.EvKey (V.KChar 'H') []) -> modify setMonthBefore+  VtyEvent (V.EvKey (V.KChar 'L') []) -> modify setMonthAfter+  +  -- Navigate between years+  VtyEvent (V.EvKey (V.KChar '{') []) -> modify setYearBefore+  VtyEvent (V.EvKey (V.KChar '}') []) -> modify setYearAfter+  VtyEvent (V.EvKey (V.KChar 'J') []) -> modify setYearBefore+  VtyEvent (V.EvKey (V.KChar 'K') []) -> modify setYearAfter++  _ -> return ()
src/Brick/Widgets/Calendar/Internal/Core.hs view
@@ -76,13 +76,12 @@   deriving (Show, Eq, Ord)  -- | The state of the calendar widget. Make this part of your application state.-data CalendarState = CalendarState-  { calYear :: Integer       -- ^ Current year-  , calMonth :: Int          -- ^ Current month (1-12)-  , calSelectedDay :: Maybe Day  -- ^ Currently selected day, if any-  , calConfig :: CalendarConfig  -- ^ Calendar configuration-  } deriving (Show, Eq)--+data CalendarState n = CalendarState+  { calYear :: Integer                     -- ^ Current year+  , calMonth :: Int                        -- ^ Current month (1-12)+  , calSelectedDay :: Maybe Day            -- ^ Currently selected day, if any+  , calConfig :: CalendarConfig            -- ^ Calendar configuration+  , calendarName :: CalendarResource -> n  -- ^ Constructor for wrapping calendar resources in the application's resource name type+  }  makeLenses ''CalendarConfig 
src/Brick/Widgets/Calendar/Internal/Month.hs view
@@ -17,31 +17,31 @@ import Brick.Widgets.Calendar.Internal.Utils  -- | Render a month calendar widget-renderCalendar :: CalendarState -> Widget CalendarResource+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+       , renderDays calConfig calYear calMonth calSelectedDay calendarName        ]  -- | Render the calendar header with month/year and navigation buttons-renderHeader :: CalendarState -> Widget CalendarResource+renderHeader :: Ord n => CalendarState n -> Widget n renderHeader CalendarState{..} =   let monthText = getMonthLabel calConfig calYear calMonth-      prevButton = clickable CalendarPrev $ +      prevButton = clickable (calendarName CalendarPrev) $                     withAttr (attrName "calendar.nav") $                     str " << "-      monthLabel = clickable (CalendarMonth (fromIntegral calYear) calMonth) $ +      monthLabel = clickable (calendarName (CalendarMonth (fromIntegral calYear) calMonth)) $                     txt monthText-      nextButton = clickable CalendarNext $ +      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 CalendarResource+renderDayLabels :: CalendarConfig -> Widget n renderDayLabels config =   let labels = getWeekDayLabels config       -- Create evenly spaced day labels using padRight@@ -52,8 +52,8 @@   in hBox $ map makeLabel paddedLabels  -- | Render the days of the month-renderDays :: CalendarConfig -> Integer -> Int -> Maybe Day -> Widget CalendarResource-renderDays config year month selectedDay =+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@@ -84,7 +84,6 @@       YearMonth nextYear nextMonth = nextYearMonth              -- Calculate days needed for a standard 6-row calendar (42 days total)-      -- Direct calculation without intermediate variables       totalDays = length prevDays + length currentDays       daysNeeded = 42 - totalDays  -- 6 rows × 7 days       @@ -122,7 +121,7 @@                       else formatDayNumber config day                                    -- Create clickable day widget with appropriate resource identifier-            baseDayWidget = clickable (CalendarDay (fromIntegral y) m d) $+            baseDayWidget = clickable (nameF (CalendarDay (fromIntegral y) m d)) $                            hLimit 3 $ withAttr finalAttr (txt dayText)                                         -- Add padding except for the last item in each row
test/Main.hs view
@@ -8,7 +8,7 @@ main = hspec $ do   describe "Calendar Navigation" $ do     let standardState year month day = -          CalendarState year month (Just $ fromGregorian year month day) defaultCalendarConfig+          CalendarState year month (Just $ fromGregorian year month day) defaultCalendarConfig id          describe "Directional Movement" $ do       it "correctly moves selection up" $ do