{-# 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
renderCalendar :: Ord n => CalendarState n -> Widget n
renderCalendar :: forall n. Ord n => CalendarState n -> Widget n
renderCalendar state :: CalendarState n
state@CalendarState{Int
Integer
Maybe Day
CalendarConfig
CalendarResource -> n
calYear :: Integer
calMonth :: Int
calSelectedDay :: Maybe Day
calConfig :: CalendarConfig
calendarName :: CalendarResource -> n
calYear :: forall n. CalendarState n -> Integer
calMonth :: forall n. CalendarState n -> Int
calSelectedDay :: forall n. CalendarState n -> Maybe Day
calConfig :: forall n. CalendarState n -> CalendarConfig
calendarName :: forall n. CalendarState n -> CalendarResource -> n
..} =
[Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox [ CalendarState n -> Widget n
forall n. Ord n => CalendarState n -> Widget n
renderHeader CalendarState n
state
, if CalendarConfig
calConfig CalendarConfig -> Getting Bool CalendarConfig Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool CalendarConfig Bool
Lens' CalendarConfig Bool
showDayLabels
then CalendarConfig -> Widget n
forall n. CalendarConfig -> Widget n
renderDayLabels CalendarConfig
calConfig
else Widget n
forall n. Widget n
emptyWidget
, CalendarConfig
-> Integer
-> Int
-> Maybe Day
-> (CalendarResource -> n)
-> Widget n
forall n.
Ord n =>
CalendarConfig
-> Integer
-> Int
-> Maybe Day
-> (CalendarResource -> n)
-> Widget n
renderDays CalendarConfig
calConfig Integer
calYear Int
calMonth Maybe Day
calSelectedDay CalendarResource -> n
calendarName
]
renderHeader :: Ord n => CalendarState n -> Widget n
CalendarState{Int
Integer
Maybe Day
CalendarConfig
CalendarResource -> n
calYear :: forall n. CalendarState n -> Integer
calMonth :: forall n. CalendarState n -> Int
calSelectedDay :: forall n. CalendarState n -> Maybe Day
calConfig :: forall n. CalendarState n -> CalendarConfig
calendarName :: forall n. CalendarState n -> CalendarResource -> n
calYear :: Integer
calMonth :: Int
calSelectedDay :: Maybe Day
calConfig :: CalendarConfig
calendarName :: CalendarResource -> n
..} =
let monthText :: Text
monthText = CalendarConfig -> Integer -> Int -> Text
getMonthLabel CalendarConfig
calConfig Integer
calYear Int
calMonth
prevButton :: Widget n
prevButton = n -> Widget n -> Widget n
forall n. Ord n => n -> Widget n -> Widget n
clickable (CalendarResource -> n
calendarName CalendarResource
CalendarPrev) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"calendar.nav") (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
String -> Widget n
forall n. String -> Widget n
str String
" << "
monthLabel :: Widget n
monthLabel = n -> Widget n -> Widget n
forall n. Ord n => n -> Widget n -> Widget n
clickable (CalendarResource -> n
calendarName (Int -> Int -> CalendarResource
CalendarMonth (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
calYear) Int
calMonth)) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Text -> Widget n
forall n. Text -> Widget n
txt Text
monthText
nextButton :: Widget n
nextButton = n -> Widget n -> Widget n
forall n. Ord n => n -> Widget n -> Widget n
clickable (CalendarResource -> n
calendarName CalendarResource
CalendarNext) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"calendar.nav") (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
String -> Widget n
forall n. String -> Widget n
str String
" >> "
in Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
20 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
forall n. Widget n -> Widget n
hCenter (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [Widget n
prevButton, Widget n
monthLabel, Widget n
nextButton]
renderDayLabels :: CalendarConfig -> Widget n
renderDayLabels :: forall n. CalendarConfig -> Widget n
renderDayLabels CalendarConfig
config =
let labels :: [Text]
labels = CalendarConfig -> [Text]
getWeekDayLabels CalendarConfig
config
paddedLabels :: [(Text, Padding)]
paddedLabels = [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
init [Text]
labels [Text] -> [Padding] -> [(Text, Padding)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` Padding -> [Padding]
forall a. a -> [a]
repeat (Int -> Padding
Pad Int
1) [(Text, Padding)] -> [(Text, Padding)] -> [(Text, Padding)]
forall a. [a] -> [a] -> [a]
++ [([Text] -> Text
forall a. HasCallStack => [a] -> a
last [Text]
labels, Int -> Padding
Pad Int
0)]
makeLabel :: (Text, Padding) -> Widget n
makeLabel (Text
l, Padding
p) = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
p (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"calendar.dayLabel") (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Text -> Widget n
forall n. Text -> Widget n
txt Text
l
in [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ ((Text, Padding) -> Widget n) -> [(Text, Padding)] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Padding) -> Widget n
forall {n}. (Text, Padding) -> Widget n
makeLabel [(Text, Padding)]
paddedLabels
renderDays :: Ord n => CalendarConfig -> Integer -> Int -> Maybe Day -> (CalendarResource -> n) -> Widget n
renderDays :: forall n.
Ord n =>
CalendarConfig
-> Integer
-> Int
-> Maybe Day
-> (CalendarResource -> n)
-> Widget n
renderDays CalendarConfig
config Integer
year Int
month Maybe Day
selectedDay CalendarResource -> n
nameF =
let yearMonth :: Month
yearMonth = Integer -> Int -> Month
YearMonth Integer
year Int
month
daysInMonth :: Int
daysInMonth = Month -> Int
forall p. DayPeriod p => p -> Int
periodLength Month
yearMonth
firstDay :: DayOfWeek
firstDay = Integer -> Int -> DayOfWeek
getFirstDayOfMonth Integer
year Int
month
prevYearMonth :: Month
prevYearMonth = Integer -> Month -> Month
addMonths (-Integer
1) Month
yearMonth
YearMonth Integer
prevYear Int
prevMonth = Month
prevYearMonth
prevMonthDays :: Int
prevMonthDays = Month -> Int
forall p. DayPeriod p => p -> Int
periodLength Month
prevYearMonth
firstDayInt :: Int
firstDayInt = DayOfWeek -> Int
forall a. Enum a => a -> Int
fromEnum DayOfWeek
firstDay
weekStartInt :: Int
weekStartInt = DayOfWeek -> Int
forall a. Enum a => a -> Int
fromEnum (DayOfWeek -> Int) -> DayOfWeek -> Int
forall a b. (a -> b) -> a -> b
$ CalendarConfig
config CalendarConfig
-> Getting DayOfWeek CalendarConfig DayOfWeek -> DayOfWeek
forall s a. s -> Getting a s a -> a
^. Getting DayOfWeek CalendarConfig DayOfWeek
Lens' CalendarConfig DayOfWeek
weekStart
startDayNum :: Int
startDayNum = (Int
firstDayInt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
weekStartInt) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
7
prevDays :: [(Integer, Int, Int, Bool)]
prevDays =
if Int
startDayNum Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then (Int -> (Integer, Int, Int, Bool))
-> [Int] -> [(Integer, Int, Int, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
d -> (Integer
prevYear, Int
prevMonth, Int
d, Bool
True))
[Int
prevMonthDays Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startDayNum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
prevMonthDays]
else []
currentDays :: [(Integer, Int, Int, Bool)]
currentDays = (Int -> (Integer, Int, Int, Bool))
-> [Int] -> [(Integer, Int, Int, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
d -> (Integer
year, Int
month, Int
d, Bool
False)) [Int
1..Int
daysInMonth]
nextYearMonth :: Month
nextYearMonth = Integer -> Month -> Month
addMonths Integer
1 Month
yearMonth
YearMonth Integer
nextYear Int
nextMonth = Month
nextYearMonth
totalDays :: Int
totalDays = [(Integer, Int, Int, Bool)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Integer, Int, Int, Bool)]
prevDays Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(Integer, Int, Int, Bool)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Integer, Int, Int, Bool)]
currentDays
daysNeeded :: Int
daysNeeded = Int
42 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
totalDays
nextDays :: [(Integer, Int, Int, Bool)]
nextDays = (Int -> (Integer, Int, Int, Bool))
-> [Int] -> [(Integer, Int, Int, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
d -> (Integer
nextYear, Int
nextMonth, Int
d, Bool
True)) [Int
1..Int
daysNeeded]
allDays :: [(Integer, Int, Int, Bool)]
allDays = [(Integer, Int, Int, Bool)]
prevDays [(Integer, Int, Int, Bool)]
-> [(Integer, Int, Int, Bool)] -> [(Integer, Int, Int, Bool)]
forall a. [a] -> [a] -> [a]
++ [(Integer, Int, Int, Bool)]
currentDays [(Integer, Int, Int, Bool)]
-> [(Integer, Int, Int, Bool)] -> [(Integer, Int, Int, Bool)]
forall a. [a] -> [a] -> [a]
++ [(Integer, Int, Int, Bool)]
nextDays
weeks :: [[(Integer, Int, Int, Bool)]]
weeks = Int -> [(Integer, Int, Int, Bool)] -> [[(Integer, Int, Int, Bool)]]
forall a. Int -> [a] -> [[a]]
chunksOf Int
7 [(Integer, Int, Int, Bool)]
allDays
renderDay :: ((Integer, Int, Int, Bool), Bool) -> Widget n
renderDay ((Integer, Int, Int, Bool)
dayInfo, Bool
isLast) =
let (Integer
y, Int
m, Int
d, Bool
isOutside) = (Integer, Int, Int, Bool)
dayInfo
day :: Day
day = Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
m Int
d
isSelected :: Bool
isSelected = Bool -> (Day -> Bool) -> Maybe Day -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Day -> Day -> Bool
forall a. Eq a => a -> a -> Bool
== Day
day) Maybe Day
selectedDay
attr :: AttrName
attr = if Bool
isOutside
then case CalendarConfig
config CalendarConfig
-> Getting OutsideMonthDisplay CalendarConfig OutsideMonthDisplay
-> OutsideMonthDisplay
forall s a. s -> Getting a s a -> a
^. Getting OutsideMonthDisplay CalendarConfig OutsideMonthDisplay
Lens' CalendarConfig OutsideMonthDisplay
outsideMonthDisplay of
OutsideMonthDisplay
Hide -> String -> AttrName
attrName String
"calendar.hidden"
OutsideMonthDisplay
ShowDimmed -> String -> AttrName
attrName String
"calendar.outsideMonth"
OutsideMonthDisplay
ShowNormal -> String -> AttrName
attrName String
"calendar.day"
else String -> AttrName
attrName String
"calendar.day"
finalAttr :: AttrName
finalAttr = if Bool
isSelected
then AttrName
attr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"selected"
else AttrName
attr
dayText :: Text
dayText = if Bool
isOutside Bool -> Bool -> Bool
&& CalendarConfig
config CalendarConfig
-> Getting OutsideMonthDisplay CalendarConfig OutsideMonthDisplay
-> OutsideMonthDisplay
forall s a. s -> Getting a s a -> a
^. Getting OutsideMonthDisplay CalendarConfig OutsideMonthDisplay
Lens' CalendarConfig OutsideMonthDisplay
outsideMonthDisplay OutsideMonthDisplay -> OutsideMonthDisplay -> Bool
forall a. Eq a => a -> a -> Bool
== OutsideMonthDisplay
Hide
then Text
" "
else CalendarConfig -> Day -> Text
formatDayNumber CalendarConfig
config Day
day
baseDayWidget :: Widget n
baseDayWidget = n -> Widget n -> Widget n
forall n. Ord n => n -> Widget n -> Widget n
clickable (CalendarResource -> n
nameF (Int -> Int -> Int -> CalendarResource
CalendarDay (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y) Int
m Int
d)) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
3 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
finalAttr (Text -> Widget n
forall n. Text -> Widget n
txt Text
dayText)
dayWidget :: Widget n
dayWidget = if Bool
isLast
then Widget n
baseDayWidget
else Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) Widget n
baseDayWidget
in Widget n
dayWidget
renderWeek :: [(Integer, Int, Int, Bool)] -> Widget n
renderWeek [(Integer, Int, Int, Bool)]
days =
let daysWithIsLast :: [((Integer, Int, Int, Bool), Bool)]
daysWithIsLast = [(Integer, Int, Int, Bool)]
-> [Bool] -> [((Integer, Int, Int, Bool), Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Integer, Int, Int, Bool)]
days (Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
6 Bool
False [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool
True])
in [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (((Integer, Int, Int, Bool), Bool) -> Widget n)
-> [((Integer, Int, Int, Bool), Bool)] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer, Int, Int, Bool), Bool) -> Widget n
renderDay [((Integer, Int, Int, Bool), Bool)]
daysWithIsLast
in [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ ([(Integer, Int, Int, Bool)] -> Widget n)
-> [[(Integer, Int, Int, Bool)]] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map [(Integer, Int, Int, Bool)] -> Widget n
renderWeek [[(Integer, Int, Int, Bool)]]
weeks