git.iko.soy/typeable/extra-time
on master help sign in
Merge pull request #3 from typeable/wip/yuras/holidays
113c91bYuras
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+41
@@ -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