git.iko.soy/typeable/extra-time
on master help sign in
Add time accounting for holidays
6da661eYuras Shumovich
extra-time.cabal+2
compare with master
unifiedsplit
@@ -27,6 +27,7 @@ library
27 -- | from ghc
27 -- | from ghc
28 base >= 4.7 && < 5 ,
28 base >= 4.7 && < 5 ,
29 binary ,
29 binary ,
30+ containers ,
30 deepseq ,
31 deepseq ,
31 mtl >= 2.2 ,
32 mtl >= 2.2 ,
32 text ,
33 text ,
@@ -46,6 +47,7 @@ library
46 exposed-modules:
47 exposed-modules:
47 Data.Time.Extra
48 Data.Time.Extra
48 Data.Time.Fmt
49 Data.Time.Fmt
50+ Data.Time.Holidays
49 Data.Time.LocalTime.Short
51 Data.Time.LocalTime.Short
50 Data.Time.Utils
52 Data.Time.Utils
51 other-modules:
53 other-modules:
src/Data/Time/Holidays.hsnew file+43
@@ -0,0 +1,43 @@
1+-- {-# OPTIONS_GHC -fwarn-name-shadowing #-}
2+
3+module Data.Time.Holidays
4+ ( addTimeExcludingHolidays
5+ ) where
6+
7+import Data.Proxy
8+import qualified Data.Set as S
9+import Data.Time
10+import Data.Time.Calendar.OrdinalDate
11+import Data.Time.LocalTime.TimeZone.Series
12+
13+
14+addTimeExcludingHolidays
15+ :: S.Set Day
16+ -> TimeZoneSeries
17+ -> DiffTime
18+ -> UTCTime
19+ -> UTCTime
20+addTimeExcludingHolidays hDays tz dTime =
21+ addLocalTime' dTime . utcToLocalTime' tz
22+ where
23+ shouldSkip day = weekday `elem` [6, 7] || day `S.member` hDays
24+ where (_, weekday) = mondayStartWeek day
25+ dayPicoseconds =
26+ diffTimeToPicoseconds . secondsToDiffTime $ 60 * 60 * 24
27+ addLocalTime' :: DiffTime -> LocalTime -> UTCTime
28+ addLocalTime' dTime' (LocalTime lDay' lTime') =
29+ let
30+ actualDays = filter (not . shouldSkip) [lDay'..]
31+ -- Jumps to nearest day if `now` is a holiday
32+ lTime = if shouldSkip lDay'
33+ then midnight
34+ else lTime'
35+ -- At this point the head of `actualDays` and `lTime`
36+ -- is the day from which we should be counting
37+ (dDays, dPicoSeconds) =
38+ (diffTimeToPicoseconds $ dTime' + (timeOfDayToTime lTime))
39+ `divMod` dayPicoseconds
40+ resultDay = head . drop (fromIntegral dDays) $ actualDays
41+ resultTime =
42+ timeToTimeOfDay . picosecondsToDiffTime $ dPicoSeconds
43+ in localTimeToUTC' tz $ LocalTime resultDay resultTime