{-# LANGUAGE LambdaCase #-}

module Brick.Widgets.Calendar.Internal.Actions
  ( -- * Navigation actions
    moveUp
  , moveDown
  , moveLeft
  , moveRight
  , setMonthBefore
  , 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 n -> CalendarState n
moveUp :: forall n. CalendarState n -> CalendarState n
moveUp =
  (Day -> Day) -> CalendarState n -> CalendarState n
forall n. (Day -> Day) -> CalendarState n -> CalendarState n
navigateSelection (Integer -> Day -> Day
addDays (-Integer
7))

moveDown :: CalendarState n -> CalendarState n
moveDown :: forall n. CalendarState n -> CalendarState n
moveDown =
  (Day -> Day) -> CalendarState n -> CalendarState n
forall n. (Day -> Day) -> CalendarState n -> CalendarState n
navigateSelection (Integer -> Day -> Day
addDays Integer
7)

moveLeft :: CalendarState n -> CalendarState n
moveLeft :: forall n. CalendarState n -> CalendarState n
moveLeft =
  (Day -> Day) -> CalendarState n -> CalendarState n
forall n. (Day -> Day) -> CalendarState n -> CalendarState n
navigateSelection (Integer -> Day -> Day
addDays (-Integer
1))

moveRight :: CalendarState n -> CalendarState n
moveRight :: forall n. CalendarState n -> CalendarState n
moveRight =
  (Day -> Day) -> CalendarState n -> CalendarState n
forall n. (Day -> Day) -> CalendarState n -> CalendarState n
navigateSelection (Integer -> Day -> Day
addDays Integer
1)

setMonthBefore :: CalendarState n -> CalendarState n
setMonthBefore :: forall n. CalendarState n -> CalendarState n
setMonthBefore =
  (Month -> Month) -> CalendarState n -> CalendarState n
forall n. (Month -> Month) -> CalendarState n -> CalendarState n
navigateMonth (Integer -> Month -> Month
addMonths (-Integer
1))

setMonthAfter :: CalendarState n -> CalendarState n
setMonthAfter :: forall n. CalendarState n -> CalendarState n
setMonthAfter =
  (Month -> Month) -> CalendarState n -> CalendarState n
forall n. (Month -> Month) -> CalendarState n -> CalendarState n
navigateMonth (Integer -> Month -> Month
addMonths Integer
1)

setYearBefore :: CalendarState n -> CalendarState n
setYearBefore :: forall n. CalendarState n -> CalendarState n
setYearBefore =
  (Month -> Month) -> CalendarState n -> CalendarState n
forall n. (Month -> Month) -> CalendarState n -> CalendarState n
navigateMonth (Integer -> Month -> Month
addMonths (-Integer
12))

setYearAfter :: CalendarState n -> CalendarState n
setYearAfter :: forall n. CalendarState n -> CalendarState n
setYearAfter =
  (Month -> Month) -> CalendarState n -> CalendarState n
forall n. (Month -> Month) -> CalendarState n -> CalendarState n
navigateMonth (Integer -> Month -> Month
addMonths Integer
12)

navigateSelection :: (Day -> Day) -> CalendarState n -> CalendarState n
navigateSelection :: forall n. (Day -> Day) -> CalendarState n -> CalendarState n
navigateSelection Day -> Day
dayTransform CalendarState n
s =
  case CalendarState n -> Maybe Day
forall n. CalendarState n -> Maybe Day
calSelectedDay CalendarState n
s of
    Maybe Day
Nothing -> 
      -- When no day is selected, select the first day of the current month
      CalendarState n
s { calSelectedDay = Just $ fromGregorian (calYear s) (calMonth s) 1 }
    Just Day
day ->
      let newDay :: Day
newDay = Day -> Day
dayTransform Day
day
          (Integer
y, MonthOfYear
m, MonthOfYear
_) = Day -> (Integer, MonthOfYear, MonthOfYear)
toGregorian Day
newDay
      in if MonthOfYear
m MonthOfYear -> MonthOfYear -> Bool
forall a. Eq a => a -> a -> Bool
/= CalendarState n -> MonthOfYear
forall n. CalendarState n -> MonthOfYear
calMonth CalendarState n
s Bool -> Bool -> Bool
|| Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= CalendarState n -> Integer
forall n. CalendarState n -> Integer
calYear CalendarState n
s
         -- If we've moved to a different month, update the view
         then CalendarState n
s { calYear = y, calMonth = m, calSelectedDay = Just newDay }
         -- Otherwise just update the selected day
         else CalendarState n
s { calSelectedDay = Just newDay }

navigateMonth :: (Month -> Month) -> CalendarState n -> CalendarState n
navigateMonth :: forall n. (Month -> Month) -> CalendarState n -> CalendarState n
navigateMonth Month -> Month
monthTransform CalendarState n
s = 
  let currentYM :: Month
currentYM = Integer -> MonthOfYear -> Month
YearMonth (CalendarState n -> Integer
forall n. CalendarState n -> Integer
calYear CalendarState n
s) (CalendarState n -> MonthOfYear
forall n. CalendarState n -> MonthOfYear
calMonth CalendarState n
s)
      newYM :: Month
newYM = Month -> Month
monthTransform Month
currentYM
      YearMonth Integer
newYear MonthOfYear
newMonth = Month
newYM
      
      -- Keep the same day if possible in the new month
      newDay :: Maybe Day
newDay = case CalendarState n -> Maybe Day
forall n. CalendarState n -> Maybe Day
calSelectedDay CalendarState n
s of
        Maybe Day
Nothing -> Maybe Day
forall a. Maybe a
Nothing
        Just Day
day -> 
          let (Integer
_, MonthOfYear
_, MonthOfYear
d) = Day -> (Integer, MonthOfYear, MonthOfYear)
toGregorian Day
day
              lastDayInNewMonth :: MonthOfYear
lastDayInNewMonth = Month -> MonthOfYear
forall p. DayPeriod p => p -> MonthOfYear
periodLength Month
newYM
              adjustedDay :: MonthOfYear
adjustedDay = MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Ord a => a -> a -> a
min MonthOfYear
d MonthOfYear
lastDayInNewMonth
          in Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> MonthOfYear -> MonthOfYear -> Day
fromGregorian Integer
newYear MonthOfYear
newMonth MonthOfYear
adjustedDay
          
  in CalendarState n
s { calYear = newYear, calMonth = newMonth, calSelectedDay = newDay }

handleCalendarEvent :: BrickEvent n e -> EventM n (CalendarState n) ()
handleCalendarEvent :: forall n e. BrickEvent n e -> EventM n (CalendarState n) ()
handleCalendarEvent = \case
  -- Navigate between days
  VtyEvent (V.EvKey Key
V.KUp [])      -> (CalendarState n -> CalendarState n)
-> EventM n (CalendarState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify CalendarState n -> CalendarState n
forall n. CalendarState n -> CalendarState n
moveUp
  VtyEvent (V.EvKey Key
V.KDown [])    -> (CalendarState n -> CalendarState n)
-> EventM n (CalendarState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify CalendarState n -> CalendarState n
forall n. CalendarState n -> CalendarState n
moveDown
  VtyEvent (V.EvKey Key
V.KLeft [])    -> (CalendarState n -> CalendarState n)
-> EventM n (CalendarState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify CalendarState n -> CalendarState n
forall n. CalendarState n -> CalendarState n
moveLeft
  VtyEvent (V.EvKey Key
V.KRight [])   -> (CalendarState n -> CalendarState n)
-> EventM n (CalendarState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify CalendarState n -> CalendarState n
forall n. CalendarState n -> CalendarState n
moveRight
  VtyEvent (V.EvKey (V.KChar Char
'h') []) -> (CalendarState n -> CalendarState n)
-> EventM n (CalendarState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify CalendarState n -> CalendarState n
forall n. CalendarState n -> CalendarState n
moveLeft
  VtyEvent (V.EvKey (V.KChar Char
'l') []) -> (CalendarState n -> CalendarState n)
-> EventM n (CalendarState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify CalendarState n -> CalendarState n
forall n. CalendarState n -> CalendarState n
moveRight
  VtyEvent (V.EvKey (V.KChar Char
'j') []) -> (CalendarState n -> CalendarState n)
-> EventM n (CalendarState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify CalendarState n -> CalendarState n
forall n. CalendarState n -> CalendarState n
moveDown
  VtyEvent (V.EvKey (V.KChar Char
'k') []) -> (CalendarState n -> CalendarState n)
-> EventM n (CalendarState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify CalendarState n -> CalendarState n
forall n. CalendarState n -> CalendarState n
moveUp
  
  -- Navigate between months
  VtyEvent (V.EvKey (V.KChar Char
'[') []) -> (CalendarState n -> CalendarState n)
-> EventM n (CalendarState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify CalendarState n -> CalendarState n
forall n. CalendarState n -> CalendarState n
setMonthBefore
  VtyEvent (V.EvKey (V.KChar Char
']') []) -> (CalendarState n -> CalendarState n)
-> EventM n (CalendarState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify CalendarState n -> CalendarState n
forall n. CalendarState n -> CalendarState n
setMonthAfter
  VtyEvent (V.EvKey (V.KChar Char
'H') []) -> (CalendarState n -> CalendarState n)
-> EventM n (CalendarState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify CalendarState n -> CalendarState n
forall n. CalendarState n -> CalendarState n
setMonthBefore
  VtyEvent (V.EvKey (V.KChar Char
'L') []) -> (CalendarState n -> CalendarState n)
-> EventM n (CalendarState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify CalendarState n -> CalendarState n
forall n. CalendarState n -> CalendarState n
setMonthAfter
  
  -- Navigate between years
  VtyEvent (V.EvKey (V.KChar Char
'{') []) -> (CalendarState n -> CalendarState n)
-> EventM n (CalendarState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify CalendarState n -> CalendarState n
forall n. CalendarState n -> CalendarState n
setYearBefore
  VtyEvent (V.EvKey (V.KChar Char
'}') []) -> (CalendarState n -> CalendarState n)
-> EventM n (CalendarState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify CalendarState n -> CalendarState n
forall n. CalendarState n -> CalendarState n
setYearAfter
  VtyEvent (V.EvKey (V.KChar Char
'J') []) -> (CalendarState n -> CalendarState n)
-> EventM n (CalendarState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify CalendarState n -> CalendarState n
forall n. CalendarState n -> CalendarState n
setYearBefore
  VtyEvent (V.EvKey (V.KChar Char
'K') []) -> (CalendarState n -> CalendarState n)
-> EventM n (CalendarState n) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify CalendarState n -> CalendarState n
forall n. CalendarState n -> CalendarState n
setYearAfter

  BrickEvent n e
_ -> () -> EventM n (CalendarState n) ()
forall a. a -> EventM n (CalendarState n) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()