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 +54/−0
- brick-calendar.cabal +18/−2
- programs/CalendarDemo.hs +13/−35
- programs/DualCalendarDemo.hs +141/−0
- programs/SimpleDemo.hs +19/−27
- src/Brick/Widgets/Calendar.hs +4/−1
- src/Brick/Widgets/Calendar/Internal/Actions.hs +45/−11
- src/Brick/Widgets/Calendar/Internal/Core.hs +7/−8
- src/Brick/Widgets/Calendar/Internal/Month.hs +10/−11
- test/Main.hs +1/−1
+ README.md view
@@ -0,0 +1,54 @@+# Brick Calendar++++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