{-# LANGUAGE OverloadedStrings #-}

-- | This module provides a month calendar widget for Brick applications.
--
-- == Usage
--
-- The widget provides:
--
-- * A render function to display the calendar
-- * A set of actions for navigation (moveUp, moveDown, etc.)
-- * Configuration options
--
-- Applications should connect the provided actions to keyboard events in their event handlers.
-- Common navigation patterns include:
--
-- * Arrow keys: Use moveUp, moveDown, moveLeft, moveRight to navigate between days
-- * Month navigation: Use setMonthBefore, setMonthAfter to change months
-- * Year navigation: Use setYearBefore, setYearAfter to change years
--
-- When a navigation action is applied and no day is selected, the first day of the current month will be selected.
-- When navigating between days, if moving to a date outside the current month, the view will automatically
-- shift to that month.
module Brick.Widgets.Calendar
  ( -- * Render
    renderCalendar
  , CalendarState(..)

    -- * Actions
  , moveUp
  , moveDown
  , moveLeft
  , moveRight
  , setMonthBefore
  , setMonthAfter
  , setYearBefore
  , setYearAfter

  -- * Configuration
  , CalendarConfig(..)
  , DayLabelStyle(..)
  , OutsideMonthDisplay(..)
  , defaultCalendarConfig

    -- * Lenses
  , weekStart
  , dayLabelStyle
  , showDayLabels
  , outsideMonthDisplay


    -- * Resource name
  , CalendarResource(..)

    -- * Utilities
  , getFirstDayOfMonth
  , getDayLabel
  , getMonthLabel
  , getWeekDayLabels
  , formatDate
  , defaultCalendarAttrMap
  ) where

import qualified Brick.AttrMap as A
import qualified Graphics.Vty as V
import Brick.Util (fg)

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

-- | Attribute map for calendar widgets.
defaultCalendarAttrMap :: A.AttrMap
defaultCalendarAttrMap :: AttrMap
defaultCalendarAttrMap = Attr -> [(AttrName, Attr)] -> AttrMap
A.attrMap Attr
V.defAttr
  [ (String -> AttrName
A.attrName String
"calendar.day", Color -> Attr
fg Color
V.white)
  , (String -> AttrName
A.attrName String
"calendar.day" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
A.attrName String
"selected", Color -> Attr
fg Color
V.black Attr -> Color -> Attr
`V.withBackColor` Color
V.blue)
  , (String -> AttrName
A.attrName String
"calendar.outsideMonth", Color -> Attr
fg Color
V.brightBlack)
  , (String -> AttrName
A.attrName String
"calendar.outsideMonth" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
A.attrName String
"selected", Color -> Attr
fg Color
V.black Attr -> Color -> Attr
`V.withBackColor` Color
V.blue)
  , (String -> AttrName
A.attrName String
"calendar.hidden", Attr
V.currentAttr)
  , (String -> AttrName
A.attrName String
"calendar.nav", Color -> Attr
fg Color
V.blue)
  , (String -> AttrName
A.attrName String
"calendar.header", Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.bold)
  ]