@@ -0,0 +1,41 @@
1+module Data.Time.Holidays
2+ ( addTimeExcludingHolidays
3+ ) where
4+
5+import Data.Proxy
6+import qualified Data.Set as S
7+import Data.Time
8+import Data.Time.Calendar.OrdinalDate
9+import Data.Time.LocalTime.TimeZone.Series
10+
11+
12+addTimeExcludingHolidays
13+ :: S.Set Day
14+ -> TimeZoneSeries
15+ -> DiffTime
16+ -> UTCTime
17+ -> UTCTime
18+addTimeExcludingHolidays hDays tz dTime =
19+ addLocalTime' dTime . utcToLocalTime' tz
20+ where
21+ shouldSkip day = weekday `elem` [6, 7] || day `S.member` hDays
22+ where (_, weekday) = mondayStartWeek day
23+ dayPicoseconds =
24+ diffTimeToPicoseconds . secondsToDiffTime $ 60 * 60 * 24
25+ addLocalTime' :: DiffTime -> LocalTime -> UTCTime
26+ addLocalTime' dTime' (LocalTime lDay' lTime') =
27+ let
28+ actualDays = filter (not . shouldSkip) [lDay'..]
29+ -- Jumps to nearest day if `now` is a holiday
30+ lTime = if shouldSkip lDay'
31+ then midnight
32+ else lTime'
33+ -- At this point the head of `actualDays` and `lTime`
34+ -- is the day from which we should be counting
35+ (dDays, dPicoSeconds) =
36+ (diffTimeToPicoseconds $ dTime' + (timeOfDayToTime lTime))
37+ `divMod` dayPicoseconds
38+ resultDay = head . drop (fromIntegral dDays) $ actualDays
39+ resultTime =
40+ timeToTimeOfDay . picosecondsToDiffTime $ dPicoSeconds
41+ in localTimeToUTC' tz $ LocalTime resultDay resultTime