git.iko.soy/typeable/extra-time
on master help sign in
11 files changed+427−96
since splitsnapshots
unifiedsplit
data/opm-holidays.csv+112 extra-time.cabal+45−30 src/Data/Time/Extra.hs+27−1 src/Data/Time/FastSeries.hs+85 src/Data/Time/Fmt.hs+22−10 src/Data/Time/Holidays.hs+49 src/Data/Time/LocalTime/Instances.hs−42 src/Data/Time/LocalTime/Short.hs+23−6 src/Data/Time/Utils.hs+26−7 src/Holidays/EDay.hs+28 stack.yaml+10
data/opm-holidays.csvnew file+112
@@ -0,0 +1,112 @@
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+45−30
@@ -1,52 +1,67 @@
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
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
1011
1112library
1213 hs-source-dirs: src
1314 default-language: Haskell2010
1415 default-extensions:
16+ BangPatterns
1517 DataKinds
1618 DeriveFunctor
1719 DeriveGeneric
20+ DerivingStrategies
1821 GeneralizedNewtypeDeriving
1922 KindSignatures
23+ NamedFieldPuns
2024 OverloadedStrings
2125 RankNTypes
2226 ScopedTypeVariables
2327 StandaloneDeriving
2428 TemplateHaskell
2529 TypeApplications
30+
2631 build-depends:
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 ,
44− -- | internal packages
45− missing-lens ,
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+
4659 exposed-modules:
4760 Data.Time.Extra
61+ Data.Time.FastSeries
4862 Data.Time.Fmt
63+ Data.Time.Holidays
4964 Data.Time.LocalTime.Short
5065 Data.Time.Utils
51− other-modules:
52− Data.Time.LocalTime.Instances
66+
67+ other-modules: Holidays.EDay
src/Data/Time/Extra.hs+27−1
@@ -1,15 +1,19 @@
1+{-# LANGUAGE CPP #-}
12module Data.Time.Extra
23 ( Minutes(..)
34 , _Minutes
45 , duration
56 , durationLocal
7+ , durationUTC
68 , minutesToNDF
79 , UTCDate(..)
810 , _UTCDate
911 , UTCTime'(..)
1012 , _UTCTime'
1113 , mskTimeZone
14+ , estTimeZone
1215 , toAPITimeMSK
16+ , toAPITimeEST
1317 , apiDate
1418 , module Data.Time.LocalTime.Short
1519 , TimeFrame
@@ -20,6 +24,8 @@ module Data.Time.Extra
2024 , TimeFrameType(..)
2125 , Hours(..)
2226 , _Hours
27+ , addUTCHours
28+ , addUTCMinutes
2329 , DateRange(..)
2430 , mkDateRange
2531 , drFromDate
@@ -30,7 +36,6 @@ module Data.Time.Extra
3036import Control.DeepSeq
3137import Control.Lens
3238import Control.Monad
33−import Control.Monad.Fail
3439import Data.Aeson
3540import Data.Binary
3641import Data.Function (on)
@@ -42,6 +47,9 @@ import GHC.Generics (Generic)
4247import Test.QuickCheck
4348import Test.QuickCheck.Arbitrary.Generic
4449
50+#if !MIN_VERSION_base(4,13,0)
51+import Control.Monad.Fail
52+#endif
4553
4654newtype Minutes
4755 = Minutes { unMinutes :: Int
@@ -59,6 +67,12 @@ instance NFData Hours
5967
6068makePrisms ''Hours
6169
70+addUTCHours :: Hours -> UTCTime -> UTCTime
71+addUTCHours (Hours h) = addUTCTime $ fromIntegral (h * 3600)
72+
73+addUTCMinutes :: Minutes -> UTCTime -> UTCTime
74+addUTCMinutes (Minutes m) = addUTCTime $ fromIntegral $ m * 60
75+
6276duration :: ShortZonedTime -> ShortZonedTime -> Minutes
6377duration t1 t2 = Minutes (timeDiff `div` 60)
6478 where
@@ -71,6 +85,12 @@ durationLocal t1 t2 = Minutes (timeDiff `div` 60)
7185 calcDiff = diffUTCTime `on` localTimeToUTC utc
7286 timeDiff = round (calcDiff t1 t2)
7387
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+
7494minutesToNDF :: Minutes -> NominalDiffTime
7595minutesToNDF (Minutes mins) = 60 * realToFrac mins
7696
@@ -155,9 +175,15 @@ apiDate = prism' toApiDate fromApiDate
155175mskTimeZone :: TimeZone
156176mskTimeZone = TimeZone (3 * 60) False "MSK"
157177
178+estTimeZone :: TimeZone
179+estTimeZone = TimeZone (-5 * 60) False "EST"
180+
158181toAPITimeMSK :: UTCTime -> ShortZonedTime
159182toAPITimeMSK = shortZonedTime . utcToZonedTime mskTimeZone
160183
184+toAPITimeEST :: UTCTime -> ShortZonedTime
185+toAPITimeEST = shortZonedTime . utcToZonedTime estTimeZone
186+
161187data TimeFrameType
162188 = TimeOfArrival
163189 | TimeOfDeparture
src/Data/Time/FastSeries.hsnew file+85
@@ -0,0 +1,85 @@
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+22−10
@@ -1,3 +1,5 @@
1+{-# LANGUAGE AllowAmbiguousTypes #-}
2+{-# LANGUAGE CPP #-}
13module Data.Time.Fmt
24 ( FmtTime(..)
35 , _FmtTime
@@ -22,9 +24,16 @@ import Data.Time
2224import GHC.Generics (Generic)
2325import GHC.TypeLits
2426import Test.QuickCheck
27+import Web.HttpApiData
28+
29+#ifndef ghcjs_HOST_OS
2530import Text.XML.DOM.Parser
2631import Text.XML.Writer
27−import Web.HttpApiData
32+#endif
33+
34+#if !MIN_VERSION_base(4,13,0)
35+import Control.Monad.Fail
36+#endif
2837
2938
3039newtype FmtTime (fmt :: Symbol) a = FmtTime
@@ -43,7 +52,7 @@ fmtTimeToString =
4352
4453fmtTimeFromString
4554 :: forall a fmt m
46− . (ParseTime a, KnownSymbol fmt, Monad m)
55+ . (ParseTime a, KnownSymbol fmt, MonadFail m)
4756 => String
4857 -> m (FmtTime fmt a)
4958fmtTimeFromString =
@@ -67,22 +76,25 @@ instance (ParseTime a, KnownSymbol fmt) => FromJSON (FmtTime fmt a) where
6776instance (FormatTime a, KnownSymbol fmt) => ToHttpApiData (FmtTime fmt a) where
6877 toUrlPiece = T.pack . fmtTimeToString
6978
79+errParseFmtTime
80+ :: forall fmt s. (KnownSymbol fmt, IsString s, Semigroup s) => s -> s
81+errParseFmtTime t =
82+ "no parse " <> t <> " as " <> fromString (symbolVal (Proxy @fmt))
83+
7084instance (ParseTime a, KnownSymbol fmt) => FromHttpApiData (FmtTime fmt a) where
71− parseUrlPiece t = maybe err Right $ fmtTimeFromString $ T.unpack t
72− where
73− fmt = T.pack $ symbolVal (Proxy @fmt)
74− err = Left $ "no parse " <> t <> " as " <> fmt
85+ parseUrlPiece t =
86+ maybe (Left $ errParseFmtTime @fmt t) Right $ fmtTimeFromString $ T.unpack t
7587
88+#ifndef ghcjs_HOST_OS
7689instance (FormatTime a, KnownSymbol fmt) => ToXML (FmtTime fmt a) where
7790 toXML = toXML . T.pack . fmtTimeToString
7891
7992instance (ParseTime a, KnownSymbol fmt) => FromDom (FmtTime fmt a) where
8093 fromDom = do
8194 s <- fromDom
82− case fmtTimeFromString s of
83− Right a -> return a
84− Left e -> throwParserError $
85− PEContentWrongFormat (T.pack e)
95+ maybe (throwParserError $ PEContentWrongFormat $ errParseFmtTime @fmt s)
96+ pure $ fmtTimeFromString $ T.unpack s
97+#endif
8698
8799type ZonedISO8601 = ("%FT%T%Q%z" :: Symbol)
88100
src/Data/Time/Holidays.hsnew file+49
@@ -0,0 +1,49 @@
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.hsdeleted−42
@@ -1,42 +0,0 @@
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− (Day(..), LocalTime(..), TimeOfDay(..), TimeZone(..), ZonedTime(..))
9−import qualified Data.Time as T
10−import Data.Time.Clock
11−import GHC.Generics (Generic)
12−
13−
14−deriving instance Generic TimeZone
15−
16−instance Binary TimeZone
17−
18−deriving instance Generic Day
19−
20−instance Binary Day
21−
22−deriving instance Generic (Fixed a)
23−
24−deriving instance Generic TimeOfDay
25−
26−instance Binary TimeOfDay
27−
28−deriving instance Generic LocalTime
29−
30−instance Binary LocalTime
31−
32−deriving instance Generic ZonedTime
33−
34−instance Binary ZonedTime
35−
36−instance Binary DiffTime where
37− put = put . toRational
38− get = fromRational <$> get
39−
40−deriving instance Generic UTCTime
41−
42−instance Binary UTCTime
src/Data/Time/LocalTime/Short.hs+23−6
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP, DerivingStrategies, DeriveAnyClass #-}
12module Data.Time.LocalTime.Short
23 ( ShortZonedTime
34 , shortZonedTime
@@ -17,28 +18,33 @@ module Data.Time.LocalTime.Short
1718
1819import Control.DeepSeq (NFData)
1920import Control.Lens
20−import Control.Lens.Missing
2121import Control.Monad.State
2222import Data.Aeson
2323import Data.Binary (Binary)
24+import Data.Binary.Instances.Time ()
2425import Data.Coerce
2526import Data.Ord (comparing)
26−import qualified Data.Time as T
27+import Data.Time as T
2728import Data.Time.Fmt
28−import Data.Time.Format
29−import Data.Time.LocalTime.Instances ()
29+import Data.Time.Utils
3030import GHC.Generics (Generic)
3131import Test.QuickCheck (Arbitrary)
3232import qualified Test.QuickCheck as QC
3333import Test.QuickCheck.Instances ()
3434
35+#if MIN_VERSION_time(1,9,0)
36+import Data.Proxy
37+import Data.Time.Format.Internal
38+#endif
39+
3540
3641-- | @ZonedTime@ where seconds = 0.
3742-- The constructor is not exported to maintain the invariant.
3843newtype ShortZonedTime
3944 = ShortZonedTime
4045 { unShortZonedTime :: T.ZonedTime
41− } deriving (FormatTime, NFData, Generic, FromJSON, ToJSON)
46+ } deriving stock (Generic)
47+ deriving newtype (FormatTime, NFData, FromJSON, ToJSON)
4248
4349shortZonedLocalDay :: ShortZonedTime -> T.Day
4450shortZonedLocalDay = T.localDay . T.zonedTimeToLocalTime . unShortZonedTime
@@ -63,6 +69,10 @@ shortZonedTime = coerce . clipZonedTime
6369
6470instance ParseTime ShortZonedTime where
6571 buildTime tl ps = shortZonedTime <$> buildTime tl ps
72+#if MIN_VERSION_time(1,9,0)
73+ substituteTimeSpecifier _ = substituteTimeSpecifier (Proxy @T.ZonedTime)
74+ parseTimeSpecifier _ = parseTimeSpecifier (Proxy @T.ZonedTime)
75+#endif
6676
6777instance Show ShortZonedTime where
6878 -- Display as a string.
@@ -86,7 +96,9 @@ instance Ord ShortZonedTime where
8696newtype ShortLocalTime
8797 = ShortLocalTime
8898 { unShortLocalTime :: T.LocalTime
89− } deriving (Eq, Ord, FormatTime, NFData, Generic)
99+ } deriving stock (Eq, Ord, Generic)
100+ deriving newtype (FormatTime)
101+ deriving newtype (NFData)
90102
91103instance Binary ShortLocalTime
92104
@@ -100,6 +112,11 @@ shortLocalTime = coerce . clipLocalTime
100112
101113instance ParseTime ShortLocalTime where
102114 buildTime tl ps = shortLocalTime <$> buildTime tl ps
115+#if MIN_VERSION_time(1,9,0)
116+ substituteTimeSpecifier _ = substituteTimeSpecifier (Proxy @T.ZonedTime)
117+ parseTimeSpecifier _ = parseTimeSpecifier (Proxy @T.LocalTime)
118+#endif
119+
103120
104121type FmtShortZonedTime fmt = FmtTime fmt ShortZonedTime
105122
src/Data/Time/Utils.hs+26−7
@@ -3,10 +3,17 @@ module Data.Time.Utils
33 , oneHour
44 , oneMinute
55 , zoneLocalTime
6+ , _zonedTimeToLocalTime
7+ , _localDay
8+ , _localTimeOfDay
9+ , _todSec
10+ , _todMin
11+ , _todHour
612 ) where
713
8−import Data.Time
9−import Data.Time.LocalTime.TimeZone.Series
14+import Control.Lens
15+import Data.Time
16+import Data.Time.FastSeries
1017
1118
1219the24h :: NominalDiffTime
@@ -18,12 +25,24 @@ oneHour = 60 * 60
1825oneMinute :: NominalDiffTime
1926oneMinute = 60
2027
21−-- | Calculate TimeZone using TimeZoneSeries and construct ZonedTime
28+-- | Calculate 'TimeZone' using 'TimeZoneSeries' and construct 'ZonedTime'.
29+--
30+-- See caveats on 'localTimeToUTC''.
2231zoneLocalTime
2332 :: TimeZoneSeries
2433 -> LocalTime
2534 -> ZonedTime
26−zoneLocalTime tzs lt = let
27− u = localTimeToUTC' tzs lt
28− tz = timeZoneFromSeries tzs u
29− in ZonedTime lt tz
35+zoneLocalTime tzsf lt = ZonedTime lt tz
36+ where !tz = timeZoneFromSeriesLocal tzsf lt
37+
38+makeLensesFor
39+ [("zonedTimeToLocalTime", "_zonedTimeToLocalTime")] ''ZonedTime
40+
41+makeLensesFor
42+ [("localDay", "_localDay"), ("localTimeOfDay", "_localTimeOfDay")]
43+ ''LocalTime
44+
45+makeLensesFor
46+ [ ("todSec", "_todSec")
47+ , ("todMin", "_todMin")
48+ , ("todHour", "_todHour")] ''TimeOfDay
src/Holidays/EDay.hsnew file+28
@@ -0,0 +1,28 @@
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.yamlnew file+10
@@ -0,0 +1,10 @@
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