This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Utils/Schedule/Week/TimeSlot.hs
2020-10-24 20:34:21 +02:00

56 lines
1.7 KiB
Haskell

module Utils.Schedule.Week.TimeSlot
( TimeSlot(..)
, timeSlot
, timeSlotsFromTo
, isInTimeSlot
, nextTimeSlot
, timeSlotToUTCTime
, formatTimeSlotW
) where
import Import
import Handler.Utils.DateTime (formatTimeRangeW)
slotStep :: Int
slotStep = 2
data TimeSlot = TimeSlot
{ tsFrom :: TimeOfDay
, tsTo :: TimeOfDay -- end excluded
}
deriving (Eq, Ord, Show, Read, Generic, Typeable)
timeSlot :: Int -> TimeSlot
timeSlot h = TimeSlot{..} where
tsFrom = TimeOfDay h 0 0
tsTo = TimeOfDay (h+slotStep) 0 0
-- | Get TimeSlots from a given start TimeOfDay to a given end TimeOfDay
timeSlotsFromTo :: Int -> Int -> [TimeSlot]
timeSlotsFromTo f t = timeSlot <$> [f,f+slotStep..t]
-- | Check whether a given time of day lies within a given TimeSlot
isInTimeSlot :: TimeOfDay -> TimeSlot -> Bool
isInTimeSlot time TimeSlot{..} = tsFrom <= time && time < tsTo
-- | Get the successor of a TimeSlot
nextTimeSlot :: TimeSlot -> TimeSlot
nextTimeSlot TimeSlot{tsTo=tsFrom} = let tsTo = TimeOfDay (todHour tsFrom + slotStep) 0 0 in TimeSlot{..}
-- | Convert a TimeSlot to UTCTime for a given TimeZone
timeSlotToUTCTime :: TimeZone -> Day -> TimeSlot -> (UTCTime, UTCTime)
timeSlotToUTCTime tz d TimeSlot{..} = (timeOfDayToUTC tsFrom, timeOfDayToUTC tsTo) where
timeOfDayToUTC time =
let (slotDayOffset, slotTimeOfDay) = localToUTCTimeOfDay tz time
utctDay = slotDayOffset `addDays` d
utctDayTime = timeOfDayToTime slotTimeOfDay
in UTCTime{..}
-- | Format a given TimeSlot as time range
formatTimeSlotW :: TimeSlot -> Widget
formatTimeSlotW TimeSlot{..} = formatTimeRangeW SelFormatTime tsFrom $ Just tsTo