{-# LANGUAGE OverloadedStrings #-}
module Brick.Widgets.Calendar.Internal.Utils
(
getFirstDayOfMonth
, getDayLabel
, getMonthLabel
, getWeekDayLabels
, formatDate
, formatDayNumber
, chunksOf
) where
import Data.Time
import Data.Time.Calendar.Month
import Data.Text (Text)
import qualified Data.Text as T
import Brick.Widgets.Calendar.Internal.Core
import Lens.Micro
import Data.List (elemIndex)
import Data.Maybe (fromMaybe)
chunksOf :: Int -> [a] -> [[a]]
chunksOf :: forall a. Int -> [a] -> [[a]]
chunksOf Int
_ [] = []
chunksOf Int
n [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
chunksOf Int
n (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
xs)
getFirstDayOfMonth :: Integer -> Int -> DayOfWeek
getFirstDayOfMonth :: Integer -> Int -> DayOfWeek
getFirstDayOfMonth Integer
year Int
month =
Day -> DayOfWeek
dayOfWeek (Day -> DayOfWeek) -> Day -> DayOfWeek
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
year Int
month Int
1
getDayLabel :: DayLabelStyle -> DayOfWeek -> Text
getDayLabel :: DayLabelStyle -> DayOfWeek -> Text
getDayLabel DayLabelStyle
style DayOfWeek
dow = case (DayLabelStyle
style, DayOfWeek
dow) of
(DayLabelStyle
SingleChar, DayOfWeek
Monday) -> Text
"M "
(DayLabelStyle
SingleChar, DayOfWeek
Tuesday) -> Text
"T "
(DayLabelStyle
SingleChar, DayOfWeek
Wednesday) -> Text
"W "
(DayLabelStyle
SingleChar, DayOfWeek
Thursday) -> Text
"T "
(DayLabelStyle
SingleChar, DayOfWeek
Friday) -> Text
"F "
(DayLabelStyle
SingleChar, DayOfWeek
Saturday) -> Text
"S "
(DayLabelStyle
SingleChar, DayOfWeek
Sunday) -> Text
"S "
(DayLabelStyle
DoubleChar, DayOfWeek
Monday) -> Text
"Mo"
(DayLabelStyle
DoubleChar, DayOfWeek
Tuesday) -> Text
"Tu"
(DayLabelStyle
DoubleChar, DayOfWeek
Wednesday) -> Text
"We"
(DayLabelStyle
DoubleChar, DayOfWeek
Thursday) -> Text
"Th"
(DayLabelStyle
DoubleChar, DayOfWeek
Friday) -> Text
"Fr"
(DayLabelStyle
DoubleChar, DayOfWeek
Saturday) -> Text
"Sa"
(DayLabelStyle
DoubleChar, DayOfWeek
Sunday) -> Text
"Su"
(DayLabelStyle
DistinctInitials, DayOfWeek
Monday) -> Text
"M "
(DayLabelStyle
DistinctInitials, DayOfWeek
Tuesday) -> Text
"T "
(DayLabelStyle
DistinctInitials, DayOfWeek
Wednesday) -> Text
"W "
(DayLabelStyle
DistinctInitials, DayOfWeek
Thursday) -> Text
"Th"
(DayLabelStyle
DistinctInitials, DayOfWeek
Friday) -> Text
"F "
(DayLabelStyle
DistinctInitials, DayOfWeek
Saturday) -> Text
"S "
(DayLabelStyle
DistinctInitials, DayOfWeek
Sunday) -> Text
"Su"
getMonthLabel :: CalendarConfig -> Integer -> Int -> Text
getMonthLabel :: CalendarConfig -> Integer -> Int -> Text
getMonthLabel CalendarConfig
config Integer
year Int
month =
let m :: Month
m = Integer -> Int -> Month
YearMonth Integer
year Int
month
day :: Day
day = Month -> Int -> Day
MonthDay Month
m Int
1
fmt :: String
fmt = case CalendarConfig
config CalendarConfig
-> Getting DateFormat CalendarConfig DateFormat -> DateFormat
forall s a. s -> Getting a s a -> a
^. Getting DateFormat CalendarConfig DateFormat
Lens' CalendarConfig DateFormat
dateFormat of
DateFormat
DefaultFormat -> String
"%b %Y"
CustomFormat{headerFormat :: DateFormat -> String
headerFormat=String
f} -> String
f
in String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
fmt Day
day
getWeekDayLabels :: CalendarConfig -> [Text]
getWeekDayLabels :: CalendarConfig -> [Text]
getWeekDayLabels CalendarConfig
config =
let startDay :: DayOfWeek
startDay = 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
style :: DayLabelStyle
style = CalendarConfig
config CalendarConfig
-> Getting DayLabelStyle CalendarConfig DayLabelStyle
-> DayLabelStyle
forall s a. s -> Getting a s a -> a
^. Getting DayLabelStyle CalendarConfig DayLabelStyle
Lens' CalendarConfig DayLabelStyle
dayLabelStyle
allDays :: [DayOfWeek]
allDays = [DayOfWeek
Sunday, DayOfWeek
Monday, DayOfWeek
Tuesday, DayOfWeek
Wednesday, DayOfWeek
Thursday, DayOfWeek
Friday, DayOfWeek
Saturday]
startIdx :: Int
startIdx = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ DayOfWeek -> [DayOfWeek] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex DayOfWeek
startDay [DayOfWeek]
allDays
weekDays :: [DayOfWeek]
weekDays = Int -> [DayOfWeek] -> [DayOfWeek]
forall a. Int -> [a] -> [a]
drop Int
startIdx [DayOfWeek]
allDays [DayOfWeek] -> [DayOfWeek] -> [DayOfWeek]
forall a. [a] -> [a] -> [a]
++ Int -> [DayOfWeek] -> [DayOfWeek]
forall a. Int -> [a] -> [a]
take Int
startIdx [DayOfWeek]
allDays
in (DayOfWeek -> Text) -> [DayOfWeek] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DayLabelStyle -> DayOfWeek -> Text
getDayLabel DayLabelStyle
style) [DayOfWeek]
weekDays
formatDate :: CalendarConfig -> Day -> Text
formatDate :: CalendarConfig -> Day -> Text
formatDate CalendarConfig
config Day
day =
let fmt :: String
fmt = case CalendarConfig
config CalendarConfig
-> Getting DateFormat CalendarConfig DateFormat -> DateFormat
forall s a. s -> Getting a s a -> a
^. Getting DateFormat CalendarConfig DateFormat
Lens' CalendarConfig DateFormat
dateFormat of
DateFormat
DefaultFormat -> String
"%Y-%m-%d"
CustomFormat{dayFormat :: DateFormat -> String
dayFormat=String
f} -> String
f
in String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
fmt Day
day
formatDayNumber :: CalendarConfig -> Day -> Text
formatDayNumber :: CalendarConfig -> Day -> Text
formatDayNumber CalendarConfig
config Day
day =
let (Integer
_, Int
_, Int
d) = Day -> (Integer, Int, Int)
toGregorian Day
day
fmt :: Text
fmt = case CalendarConfig
config CalendarConfig
-> Getting DateFormat CalendarConfig DateFormat -> DateFormat
forall s a. s -> Getting a s a -> a
^. Getting DateFormat CalendarConfig DateFormat
Lens' CalendarConfig DateFormat
dateFormat of
DateFormat
DefaultFormat -> Int -> Char -> Text -> Text
T.justifyLeft Int
2 Char
' ' (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
d)
CustomFormat{dayFormat :: DateFormat -> String
dayFormat=String
f} -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
f Day
day
in Text
fmt