{-# 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 :: CalendarState -> Widget CalendarResource
renderCalendar :: CalendarState -> Widget CalendarResource
renderCalendar state :: CalendarState
state@CalendarState{Int
Integer
Maybe Day
CalendarConfig
calYear :: Integer
calMonth :: Int
calSelectedDay :: Maybe Day
calConfig :: CalendarConfig
calYear :: CalendarState -> Integer
calMonth :: CalendarState -> Int
calSelectedDay :: CalendarState -> Maybe Day
calConfig :: CalendarState -> CalendarConfig
..} =
[Widget CalendarResource] -> Widget CalendarResource
forall n. [Widget n] -> Widget n
vBox [ CalendarState -> Widget CalendarResource
renderHeader CalendarState
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 CalendarResource
renderDayLabels CalendarConfig
calConfig
else Widget CalendarResource
forall n. Widget n
emptyWidget
, CalendarConfig
-> Integer -> Int -> Maybe Day -> Widget CalendarResource
renderDays CalendarConfig
calConfig Integer
calYear Int
calMonth Maybe Day
calSelectedDay
]
renderHeader :: CalendarState -> Widget CalendarResource
CalendarState{Int
Integer
Maybe Day
CalendarConfig
calYear :: CalendarState -> Integer
calMonth :: CalendarState -> Int
calSelectedDay :: CalendarState -> Maybe Day
calConfig :: CalendarState -> CalendarConfig
calYear :: Integer
calMonth :: Int
calSelectedDay :: Maybe Day
calConfig :: CalendarConfig
..} =
let monthText :: Text
monthText = CalendarConfig -> Integer -> Int -> Text
getMonthLabel CalendarConfig
calConfig Integer
calYear Int
calMonth
prevButton :: Widget CalendarResource
prevButton = CalendarResource
-> Widget CalendarResource -> Widget CalendarResource
forall n. Ord n => n -> Widget n -> Widget n
clickable CalendarResource
CalendarPrev (Widget CalendarResource -> Widget CalendarResource)
-> Widget CalendarResource -> Widget CalendarResource
forall a b. (a -> b) -> a -> b
$
AttrName -> Widget CalendarResource -> Widget CalendarResource
forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"calendar.nav") (Widget CalendarResource -> Widget CalendarResource)
-> Widget CalendarResource -> Widget CalendarResource
forall a b. (a -> b) -> a -> b
$
String -> Widget CalendarResource
forall n. String -> Widget n
str String
" << "
monthLabel :: Widget CalendarResource
monthLabel = CalendarResource
-> Widget CalendarResource -> Widget CalendarResource
forall n. Ord n => n -> Widget n -> Widget n
clickable (Int -> Int -> CalendarResource
CalendarMonth (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
calYear) Int
calMonth) (Widget CalendarResource -> Widget CalendarResource)
-> Widget CalendarResource -> Widget CalendarResource
forall a b. (a -> b) -> a -> b
$
Text -> Widget CalendarResource
forall n. Text -> Widget n
txt Text
monthText
nextButton :: Widget CalendarResource
nextButton = CalendarResource
-> Widget CalendarResource -> Widget CalendarResource
forall n. Ord n => n -> Widget n -> Widget n
clickable CalendarResource
CalendarNext (Widget CalendarResource -> Widget CalendarResource)
-> Widget CalendarResource -> Widget CalendarResource
forall a b. (a -> b) -> a -> b
$
AttrName -> Widget CalendarResource -> Widget CalendarResource
forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"calendar.nav") (Widget CalendarResource -> Widget CalendarResource)
-> Widget CalendarResource -> Widget CalendarResource
forall a b. (a -> b) -> a -> b
$
String -> Widget CalendarResource
forall n. String -> Widget n
str String
" >> "
in Int -> Widget CalendarResource -> Widget CalendarResource
forall n. Int -> Widget n -> Widget n
hLimit Int
20 (Widget CalendarResource -> Widget CalendarResource)
-> Widget CalendarResource -> Widget CalendarResource
forall a b. (a -> b) -> a -> b
$ Widget CalendarResource -> Widget CalendarResource
forall n. Widget n -> Widget n
hCenter (Widget CalendarResource -> Widget CalendarResource)
-> Widget CalendarResource -> Widget CalendarResource
forall a b. (a -> b) -> a -> b
$ [Widget CalendarResource] -> Widget CalendarResource
forall n. [Widget n] -> Widget n
hBox [Widget CalendarResource
prevButton, Widget CalendarResource
monthLabel, Widget CalendarResource
nextButton]
renderDayLabels :: CalendarConfig -> Widget CalendarResource
renderDayLabels :: CalendarConfig -> Widget CalendarResource
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 CalendarResource] -> Widget CalendarResource
forall n. [Widget n] -> Widget n
hBox ([Widget CalendarResource] -> Widget CalendarResource)
-> [Widget CalendarResource] -> Widget CalendarResource
forall a b. (a -> b) -> a -> b
$ ((Text, Padding) -> Widget CalendarResource)
-> [(Text, Padding)] -> [Widget CalendarResource]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Padding) -> Widget CalendarResource
forall {n}. (Text, Padding) -> Widget n
makeLabel [(Text, Padding)]
paddedLabels
renderDays :: CalendarConfig -> Integer -> Int -> Maybe Day -> Widget CalendarResource
renderDays :: CalendarConfig
-> Integer -> Int -> Maybe Day -> Widget CalendarResource
renderDays CalendarConfig
config Integer
year Int
month Maybe Day
selectedDay =
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 CalendarResource
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 CalendarResource
baseDayWidget = CalendarResource
-> Widget CalendarResource -> Widget CalendarResource
forall n. Ord n => n -> Widget n -> Widget n
clickable (Int -> Int -> Int -> CalendarResource
CalendarDay (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y) Int
m Int
d) (Widget CalendarResource -> Widget CalendarResource)
-> Widget CalendarResource -> Widget CalendarResource
forall a b. (a -> b) -> a -> b
$
Int -> Widget CalendarResource -> Widget CalendarResource
forall n. Int -> Widget n -> Widget n
hLimit Int
3 (Widget CalendarResource -> Widget CalendarResource)
-> Widget CalendarResource -> Widget CalendarResource
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget CalendarResource -> Widget CalendarResource
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
finalAttr (Text -> Widget CalendarResource
forall n. Text -> Widget n
txt Text
dayText)
dayWidget :: Widget CalendarResource
dayWidget = if Bool
isLast
then Widget CalendarResource
baseDayWidget
else Padding -> Widget CalendarResource -> Widget CalendarResource
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) Widget CalendarResource
baseDayWidget
in Widget CalendarResource
dayWidget
renderWeek :: [(Integer, Int, Int, Bool)] -> Widget CalendarResource
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 CalendarResource] -> Widget CalendarResource
forall n. [Widget n] -> Widget n
hBox ([Widget CalendarResource] -> Widget CalendarResource)
-> [Widget CalendarResource] -> Widget CalendarResource
forall a b. (a -> b) -> a -> b
$ (((Integer, Int, Int, Bool), Bool) -> Widget CalendarResource)
-> [((Integer, Int, Int, Bool), Bool)] -> [Widget CalendarResource]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer, Int, Int, Bool), Bool) -> Widget CalendarResource
renderDay [((Integer, Int, Int, Bool), Bool)]
daysWithIsLast
in [Widget CalendarResource] -> Widget CalendarResource
forall n. [Widget n] -> Widget n
vBox ([Widget CalendarResource] -> Widget CalendarResource)
-> [Widget CalendarResource] -> Widget CalendarResource
forall a b. (a -> b) -> a -> b
$ ([(Integer, Int, Int, Bool)] -> Widget CalendarResource)
-> [[(Integer, Int, Int, Bool)]] -> [Widget CalendarResource]
forall a b. (a -> b) -> [a] -> [b]
map [(Integer, Int, Int, Bool)] -> Widget CalendarResource
renderWeek [[(Integer, Int, Int, Bool)]]
weeks