git.iko.soy/typeable/extra-time
on 28ec1ce help sign in
11 files changed+78−361
since splitsnapshots
unifiedsplit
data/opm-holidays.csv−112 extra-time.cabal+28−45 src/Data/Time/Extra.hs−11 src/Data/Time/FastSeries.hs−85 src/Data/Time/Fmt.hs+1−6 src/Data/Time/Holidays.hs−49 src/Data/Time/LocalTime/Instances.hs+39 src/Data/Time/LocalTime/Short.hs+4−9 src/Data/Time/Utils.hs+6−6 src/Holidays/EDay.hs−28 stack.yaml−10
data/opm-holidays.csvdeleted−112
@@ -1,112 +0,0 @@
1−Date holiday observed
2−2018-11-22
3−2018-11-23
4−2018-12-25
5−2019-01-01
6−2020-01-01
7−2020-05-25
8−2020-07-03
9−2020-09-07
10−2020-11-26
11−2020-11-27
12−2020-12-25
13−2021-01-01
14−2022-01-02
15−2022-01-16
16−2022-02-20
17−2022-05-29
18−2022-06-19
19−2022-07-04
20−2022-09-04
21−2022-10-09
22−2022-11-10
23−2022-11-23
24−2022-12-25
25−2023-01-01
26−2023-01-15
27−2023-02-20
28−2023-05-27
29−2023-06-19
30−2023-07-04
31−2023-09-02
32−2023-10-04
33−2023-11-11
34−2023-11-28
35−2023-12-25
36−2024-01-01
37−2024-01-15
38−2024-02-19
39−2024-05-27
40−2024-06-19
41−2024-07-04
42−2024-09-02
43−2024-10-14
44−2024-11-11
45−2024-11-28
46−2024-12-25
47−2025-01-01
48−2025-01-20
49−2025-02-17
50−2025-05-26
51−2025-06-19
52−2025-07-04
53−2025-09-01
54−2025-10-13
55−2025-11-11
56−2025-11-27
57−2025-12-25
58−2026-01-01
59−2026-01-19
60−2026-02-16
61−2026-05-25
62−2026-06-19
63−2026-07-03
64−2026-09-07
65−2026-10-12
66−2026-11-11
67−2026-11-26
68−2026-12-25
69−2027-01-01
70−2027-01-18
71−2027-02-15
72−2027-05-31
73−2027-06-18
74−2027-07-05
75−2027-09-06
76−2027-10-11
77−2027-11-11
78−2027-11-25
79−2027-12-24
80−2027-12-31
81−2028-01-17
82−2028-02-21
83−2028-05-29
84−2028-06-19
85−2028-07-04
86−2028-09-04
87−2028-10-09
88−2028-11-10
89−2028-11-23
90−2028-12-25
91−2029-01-01
92−2029-01-15
93−2029-02-19
94−2029-05-28
95−2029-06-19
96−2029-07-04
97−2029-09-03
98−2029-10-08
99−2029-11-12
100−2029-11-22
101−2029-12-25
102−2030-01-01
103−2030-01-21
104−2030-02-18
105−2030-05-27
106−2030-06-19
107−2030-07-04
108−2030-09-02
109−2030-10-14
110−2030-11-11
111−2030-11-28
112−2030-12-25
extra-time.cabal+28−45
@@ -1,67 +1,50 @@
1−cabal-version: 2.4
2−name: extra-time
3−version: 0.0.0.0
4−license-file: LICENSE
5−author: typeable.io
6−maintainer: giorgio@marinel.li
7−build-type: Simple
8−extra-source-files:
9− data/opm-holidays.csv
10− README.md
1+cabal-version: 2.4
2+
3+name: extra-time
4+version: 0.0.0.0
5+license-file: LICENSE
6+author: typeable.io
7+maintainer: giorgio@marinel.li
8+build-type: Simple
9+extra-source-files: README.md
1110
1211library
1312 hs-source-dirs: src
1413 default-language: Haskell2010
1514 default-extensions:
16− BangPatterns
1715 DataKinds
1816 DeriveFunctor
1917 DeriveGeneric
20− DerivingStrategies
2118 GeneralizedNewtypeDeriving
2219 KindSignatures
23− NamedFieldPuns
2420 OverloadedStrings
2521 RankNTypes
2622 ScopedTypeVariables
2723 StandaloneDeriving
2824 TemplateHaskell
2925 TypeApplications
30−
3126 build-depends:
32− , aeson
33− , base >=4.11 && <5
34− , binary
35− , binary-instances
36− , bytestring
37− , cassava
38− , cassava-embed
39− , containers >=0.5.8
40− , deepseq
41− , file-embed >=0.0.10
42− , generic-arbitrary
43− , http-api-data
44− , lens >=4.17
45− , mtl >=2.2
46− , QuickCheck
47− , quickcheck-instances
48− , text
49− , th-lift
50− , time >=1.6
51− , timezone-series
52− , vector
53−
54− if !(impl(ghcjs) || arch(javascript) || arch(wasm32))
55− build-depends:
56− , dom-parser >=2.0
57− , xml-conduit-writer
58−
27+ -- | from ghc
28+ base >= 4.7 && < 5 ,
29+ binary ,
30+ deepseq ,
31+ mtl >= 2.2 ,
32+ text ,
33+ time,
34+ -- | from hackage
35+ aeson ,
36+ dom-parser ,
37+ generic-arbitrary ,
38+ http-api-data ,
39+ lens >= 4.17 ,
40+ QuickCheck ,
41+ quickcheck-instances ,
42+ timezone-series ,
43+ xml-conduit-writer ,
5944 exposed-modules:
6045 Data.Time.Extra
61− Data.Time.FastSeries
6246 Data.Time.Fmt
63− Data.Time.Holidays
6447 Data.Time.LocalTime.Short
6548 Data.Time.Utils
66−
67− other-modules: Holidays.EDay
49+ other-modules:
50+ Data.Time.LocalTime.Instances
src/Data/Time/Extra.hs−11
@@ -4,7 +4,6 @@ module Data.Time.Extra
44 , _Minutes
55 , duration
66 , durationLocal
7− , durationUTC
87 , minutesToNDF
98 , UTCDate(..)
109 , _UTCDate
@@ -25,7 +24,6 @@ module Data.Time.Extra
2524 , Hours(..)
2625 , _Hours
2726 , addUTCHours
28− , addUTCMinutes
2927 , DateRange(..)
3028 , mkDateRange
3129 , drFromDate
@@ -70,9 +68,6 @@ makePrisms ''Hours
7068addUTCHours :: Hours -> UTCTime -> UTCTime
7169addUTCHours (Hours h) = addUTCTime $ fromIntegral (h * 3600)
7270
73−addUTCMinutes :: Minutes -> UTCTime -> UTCTime
74−addUTCMinutes (Minutes m) = addUTCTime $ fromIntegral $ m * 60
75−
7671duration :: ShortZonedTime -> ShortZonedTime -> Minutes
7772duration t1 t2 = Minutes (timeDiff `div` 60)
7873 where
@@ -85,12 +80,6 @@ durationLocal t1 t2 = Minutes (timeDiff `div` 60)
8580 calcDiff = diffUTCTime `on` localTimeToUTC utc
8681 timeDiff = round (calcDiff t1 t2)
8782
88−durationUTC :: UTCTime -> UTCTime -> Minutes
89−durationUTC t1 t2 = Minutes (timeDiff `div` 60)
90− where
91− calcDiff = diffUTCTime
92− timeDiff = round (calcDiff t1 t2)
93−
9483minutesToNDF :: Minutes -> NominalDiffTime
9584minutesToNDF (Minutes mins) = 60 * realToFrac mins
9685
src/Data/Time/FastSeries.hsdeleted−85
@@ -1,85 +0,0 @@
1−module Data.Time.FastSeries
2− ( TimeZoneSeries
3− , toTimeZoneSeries
4− , fromTimeZoneSeries
5− , timeZoneFromSeries
6− , timeZoneFromSeriesLocal
7− , utcToLocalTime'
8− , localTimeToUTC'
9− ) where
10−
11−import Data.Map.Strict (Map)
12−import qualified Data.Map as Map
13−import Data.Time
14−import qualified Data.Time.LocalTime.TimeZone.Series as Series
15−
16−
17−-- | Contains the same data as 'Series.TimeZoneSeries' but precomputes some data
18−-- for faster conversion.
19−data TimeZoneSeries = TimeZoneSeries
20− { fallback :: !TimeZone
21− , transitionsUTC :: !(Map UTCTime TimeZone)
22− -- ^ UTC -> Local wants to know the last transition that happened before a
23− -- given 'UTCTime'
24− , transitionsLocal :: !(Map LocalTime TimeZone)
25− -- ^ Local -> UTC wants to know the largest transition @t@ into timezone
26− -- @tz@ such that @t <= localTimeToUTC tz lt@ where @lt@ is a given
27− -- 'LocalTime'. For a given TZ and valid time arguments, 'localTimeToUTC'
28− -- and 'utcToLocalTime' are inverses. Hence this is equivalent to
29− -- @utcToLocalTime t tz <= lt@.
30− }
31−
32−toTimeZoneSeries :: Series.TimeZoneSeries -> TimeZoneSeries
33−toTimeZoneSeries
34− Series.TimeZoneSeries { Series.tzsTimeZone, Series.tzsTransitions }
35− = TimeZoneSeries
36− { fallback = tzsTimeZone
37− , transitionsUTC = Map.fromDescList tzsTransitions
38− , transitionsLocal = Map.fromList
39− [(utcToLocalTime tz u, tz) | (u, tz) <- tzsTransitions]
40− }
41−
42−fromTimeZoneSeries :: TimeZoneSeries -> Series.TimeZoneSeries
43−fromTimeZoneSeries TimeZoneSeries { fallback, transitionsUTC }
44− = Series.TimeZoneSeries
45− { Series.tzsTimeZone = fallback
46− , Series.tzsTransitions = Map.toList transitionsUTC
47− }
48−
49−timeZoneFromSeries :: TimeZoneSeries -> UTCTime -> TimeZone
50−timeZoneFromSeries TimeZoneSeries { fallback, transitionsUTC } t
51− = maybe fallback snd $ Map.lookupLE t transitionsUTC
52−
53−-- | See caveat on 'localTimeToUTC''.
54−timeZoneFromSeriesLocal :: TimeZoneSeries -> LocalTime -> TimeZone
55−timeZoneFromSeriesLocal TimeZoneSeries { fallback, transitionsLocal } lt
56− = maybe fallback snd $ Map.lookupLE lt transitionsLocal
57−
58−utcToLocalTime' :: TimeZoneSeries -> UTCTime -> LocalTime
59−utcToLocalTime' tzsf t = utcToLocalTime tz t
60− where !tz = timeZoneFromSeries tzsf t
61−
62−-- | This conversion is not actually always well defined.
63−--
64−-- At the moment of switching to summer time, there is a range of 'LocalTime's
65−-- that are skipped. For these, 'Series.isValidLocalTime' returns 'False'. This
66−-- function converts them to 'UTCTime' as if the switch didn't happen.
67−--
68−-- Around the moment of switching away from summer time, there is a range of
69−-- 'LocalTime's that happen twice: first before the switch, then once again
70−-- after the switch. For these, 'Series.isRedundantLocalTime' returns 'True'.
71−-- In such ambiguous cases, this function always picks the occurrence after the
72−-- switch.
73−--
74−-- The handling of these corner cases matches exactly to that of
75−-- 'Series.localTimeToUTC''
76−--
77−-- This means the equation
78−-- @lt == utcToLocalTime' tzsf (localTimeToUTC' tzsf lt)@ does not hold for @lt@
79−-- that were skipped. And the equation
80−-- @t == localTimeToUTC' tzsf (utcToLocalTime' tzsf t)@ does not hold for @t@
81−-- that come just before switching awya from summer time. For other arguments
82−-- these equations are assumed to hold.
83−localTimeToUTC' :: TimeZoneSeries -> LocalTime -> UTCTime
84−localTimeToUTC' tzsf lt = localTimeToUTC tz lt
85− where !tz = timeZoneFromSeriesLocal tzsf lt
src/Data/Time/Fmt.hs+1−6
@@ -24,12 +24,9 @@ import Data.Time
2424import GHC.Generics (Generic)
2525import GHC.TypeLits
2626import Test.QuickCheck
27−import Web.HttpApiData
28−
29−#ifndef ghcjs_HOST_OS
3027import Text.XML.DOM.Parser
3128import Text.XML.Writer
32−#endif
29+import Web.HttpApiData
3330
3431#if !MIN_VERSION_base(4,13,0)
3532import Control.Monad.Fail
@@ -85,7 +82,6 @@ instance (ParseTime a, KnownSymbol fmt) => FromHttpApiData (FmtTime fmt a) where
8582 parseUrlPiece t =
8683 maybe (Left $ errParseFmtTime @fmt t) Right $ fmtTimeFromString $ T.unpack t
8784
88−#ifndef ghcjs_HOST_OS
8985instance (FormatTime a, KnownSymbol fmt) => ToXML (FmtTime fmt a) where
9086 toXML = toXML . T.pack . fmtTimeToString
9187
@@ -94,7 +90,6 @@ instance (ParseTime a, KnownSymbol fmt) => FromDom (FmtTime fmt a) where
9490 s <- fromDom
9591 maybe (throwParserError $ PEContentWrongFormat $ errParseFmtTime @fmt s)
9692 pure $ fmtTimeFromString $ T.unpack s
97−#endif
9893
9994type ZonedISO8601 = ("%FT%T%Q%z" :: Symbol)
10095
src/Data/Time/Holidays.hsdeleted−49
@@ -1,49 +0,0 @@
1−module Data.Time.Holidays
2− ( addTimeExcludingHolidays
3− , opmHolidays2023to2030
4− ) where
5−
6−import Data.Proxy
7−import qualified Data.Set as S
8−import Data.Time
9−import Data.Time.Calendar.OrdinalDate
10−import Data.Time.FastSeries
11−import Data.FileEmbed (makeRelativeToProject)
12−import Data.Csv.Embed (embedRecords)
13−import Holidays.EDay (eDayToDay, EDay)
14−
15−opmHolidays2023to2030 :: S.Set Day
16−opmHolidays2023to2030 = S.fromList $
17− eDayToDay <$>
18− $(makeRelativeToProject "data/opm-holidays.csv" >>= embedRecords (Proxy @(EDay)))
19−
20−addTimeExcludingHolidays
21− :: S.Set Day
22− -> TimeZoneSeries
23− -> DiffTime
24− -> UTCTime
25− -> UTCTime
26−addTimeExcludingHolidays hDays tz dTime =
27− addLocalTime' dTime . utcToLocalTime' tz
28− where
29− shouldSkip day = weekday `elem` [6, 7] || day `S.member` hDays
30− where (_, weekday) = mondayStartWeek day
31− dayPicoseconds =
32− diffTimeToPicoseconds . secondsToDiffTime $ 60 * 60 * 24
33− addLocalTime' :: DiffTime -> LocalTime -> UTCTime
34− addLocalTime' dTime' (LocalTime lDay' lTime') =
35− let
36− actualDays = filter (not . shouldSkip) [lDay'..]
37− -- Jumps to nearest day if `now` is a holiday
38− lTime = if shouldSkip lDay'
39− then midnight
40− else lTime'
41− -- At this point the head of `actualDays` and `lTime`
42− -- is the day from which we should be counting
43− (dDays, dPicoSeconds) =
44− (diffTimeToPicoseconds $ dTime' + (timeOfDayToTime lTime))
45− `divMod` dayPicoseconds
46− resultDay = head . drop (fromIntegral dDays) $ actualDays
47− resultTime =
48− timeToTimeOfDay . picosecondsToDiffTime $ dPicoSeconds
49− in localTimeToUTC' tz $ LocalTime resultDay resultTime
src/Data/Time/LocalTime/Instances.hsnew file+39
@@ -0,0 +1,39 @@
1+{-# OPTIONS_GHC -fno-warn-orphans #-}
2+
3+module Data.Time.LocalTime.Instances where
4+
5+import Data.Binary (Binary(..))
6+import Data.Fixed (Fixed(..))
7+import Data.Time
8+import GHC.Generics (Generic)
9+
10+
11+deriving instance Generic TimeZone
12+
13+instance Binary TimeZone
14+
15+deriving instance Generic Day
16+
17+instance Binary Day
18+
19+deriving instance Generic (Fixed a)
20+
21+deriving instance Generic TimeOfDay
22+
23+instance Binary TimeOfDay
24+
25+deriving instance Generic LocalTime
26+
27+instance Binary LocalTime
28+
29+deriving instance Generic ZonedTime
30+
31+instance Binary ZonedTime
32+
33+instance Binary DiffTime where
34+ put = put . toRational
35+ get = fromRational <$> get
36+
37+deriving instance Generic UTCTime
38+
39+instance Binary UTCTime
src/Data/Time/LocalTime/Short.hs+4−9
@@ -1,4 +1,4 @@
1−{-# LANGUAGE CPP, DerivingStrategies, DeriveAnyClass #-}
1+{-# LANGUAGE CPP #-}
22module Data.Time.LocalTime.Short
33 ( ShortZonedTime
44 , shortZonedTime
@@ -21,11 +21,11 @@ import Control.Lens
2121import Control.Monad.State
2222import Data.Aeson
2323import Data.Binary (Binary)
24−import Data.Binary.Instances.Time ()
2524import Data.Coerce
2625import Data.Ord (comparing)
2726import Data.Time as T
2827import Data.Time.Fmt
28+import Data.Time.LocalTime.Instances ()
2929import Data.Time.Utils
3030import GHC.Generics (Generic)
3131import Test.QuickCheck (Arbitrary)
@@ -43,8 +43,7 @@ import Data.Time.Format.Internal
4343newtype ShortZonedTime
4444 = ShortZonedTime
4545 { unShortZonedTime :: T.ZonedTime
46− } deriving stock (Generic)
47− deriving newtype (FormatTime, NFData, FromJSON, ToJSON)
46+ } deriving (FormatTime, NFData, Generic, FromJSON, ToJSON)
4847
4948shortZonedLocalDay :: ShortZonedTime -> T.Day
5049shortZonedLocalDay = T.localDay . T.zonedTimeToLocalTime . unShortZonedTime
@@ -70,7 +69,6 @@ shortZonedTime = coerce . clipZonedTime
7069instance ParseTime ShortZonedTime where
7170 buildTime tl ps = shortZonedTime <$> buildTime tl ps
7271#if MIN_VERSION_time(1,9,0)
73− substituteTimeSpecifier _ = substituteTimeSpecifier (Proxy @T.ZonedTime)
7472 parseTimeSpecifier _ = parseTimeSpecifier (Proxy @T.ZonedTime)
7573#endif
7674
@@ -96,9 +94,7 @@ instance Ord ShortZonedTime where
9694newtype ShortLocalTime
9795 = ShortLocalTime
9896 { unShortLocalTime :: T.LocalTime
99− } deriving stock (Eq, Ord, Generic)
100− deriving newtype (FormatTime)
101− deriving newtype (NFData)
97+ } deriving (Eq, Ord, FormatTime, NFData, Generic)
10298
10399instance Binary ShortLocalTime
104100
@@ -113,7 +109,6 @@ shortLocalTime = coerce . clipLocalTime
113109instance ParseTime ShortLocalTime where
114110 buildTime tl ps = shortLocalTime <$> buildTime tl ps
115111#if MIN_VERSION_time(1,9,0)
116− substituteTimeSpecifier _ = substituteTimeSpecifier (Proxy @T.ZonedTime)
117112 parseTimeSpecifier _ = parseTimeSpecifier (Proxy @T.LocalTime)
118113#endif
119114
src/Data/Time/Utils.hs+6−6
@@ -13,7 +13,7 @@ module Data.Time.Utils
1313
1414import Control.Lens
1515import Data.Time
16−import Data.Time.FastSeries
16+import Data.Time.LocalTime.TimeZone.Series
1717
1818
1919the24h :: NominalDiffTime
@@ -25,15 +25,15 @@ oneHour = 60 * 60
2525oneMinute :: NominalDiffTime
2626oneMinute = 60
2727
28−-- | Calculate 'TimeZone' using 'TimeZoneSeries' and construct 'ZonedTime'.
29−--
30−-- See caveats on 'localTimeToUTC''.
28+-- | Calculate TimeZone using TimeZoneSeries and construct ZonedTime
3129zoneLocalTime
3230 :: TimeZoneSeries
3331 -> LocalTime
3432 -> ZonedTime
35−zoneLocalTime tzsf lt = ZonedTime lt tz
36− where !tz = timeZoneFromSeriesLocal tzsf lt
33+zoneLocalTime tzs lt = let
34+ u = localTimeToUTC' tzs lt
35+ tz = timeZoneFromSeries tzs u
36+ in ZonedTime lt tz
3737
3838makeLensesFor
3939 [("zonedTimeToLocalTime", "_zonedTimeToLocalTime")] ''ZonedTime
src/Holidays/EDay.hsdeleted−28
@@ -1,28 +0,0 @@
1−{-# OPTIONS -Wno-orphans #-}
2−{-# LANGUAGE DeriveLift #-}
3−
4−module Holidays.EDay (EDay, eDayToDay) where
5−
6−import Data.ByteString.Char8
7−import Data.Csv
8−import Data.Time
9−import Data.Time.Calendar.OrdinalDate
10−import qualified Data.Vector as V
11−import Language.Haskell.TH.Lift
12−
13−data EDay = EDay {edYear :: Integer, edDay :: Int}
14− deriving stock (Eq,Ord,Show,Lift)
15−
16−eDayToDay :: EDay -> Day
17−eDayToDay (EDay y d) = fromOrdinalDate y d
18−
19−instance FromField EDay where
20− parseField f = mkEDay <$> parseTimeM False defaultTimeLocale (iso8601DateFormat Nothing) (unpack f)
21− where mkEDay d = let (theYear,theDay) = toOrdinalDate d in EDay theYear theDay
22−
23−instance FromRecord EDay where
24− parseRecord v
25− | n == 1 = unsafeIndex v 0
26− | otherwise = fail "Expected single field for a day"
27− where
28− n = V.length v
stack.yamldeleted−10
@@ -1,10 +0,0 @@
1−resolver: lts-19.28
2−nix:
3− packages: [openssl, postgresql_14, pcre, rdkafka, lzma, zlib]
4−packages:
5−- .
6−extra-deps:
7− - xml-lens-0.3.1@sha256:8ed0cea5a2c33d665f8e3d7116c91edc466e6954a287d90d496e70550a04493d,1115
8− - git: https://github.com/typeable/dom-parser.git
9− commit: 7d556ba528bfa216e99714f8a0d4d00f452803a9
10− - cassava-embed-0.1.0.0