ce18945...master · typeable/extra-time

data/opm-holidays.csvnew file+112

since splitsnapshots

unifiedsplit

@@ -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

1+cabal-version: 2.4

2−

3−name: extra-time

2+name: extra-time

4−version: 0.0.0.0

3+version: 0.0.0.0

5−license-file: LICENSE

4+license-file: LICENSE

6−author: typeable.io

5+author: typeable.io

7−maintainer: giorgio@marinel.li

6+maintainer: giorgio@marinel.li

8−build-type: Simple

7+build-type: Simple

9−extra-source-files: README.md

8+extra-source-files:

9+ data/opm-holidays.csv

10+ README.md

10

11

11library

12library

12 hs-source-dirs: src

13 hs-source-dirs: src

13 default-language: Haskell2010

14 default-language: Haskell2010

14 default-extensions:

15 default-extensions:

16+ BangPatterns

15 DataKinds

17 DataKinds

16 DeriveFunctor

18 DeriveFunctor

17 DeriveGeneric

19 DeriveGeneric

20+ DerivingStrategies

18 GeneralizedNewtypeDeriving

21 GeneralizedNewtypeDeriving

19 KindSignatures

22 KindSignatures

23+ NamedFieldPuns

20 OverloadedStrings

24 OverloadedStrings

21 RankNTypes

25 RankNTypes

22 ScopedTypeVariables

26 ScopedTypeVariables

23 StandaloneDeriving

27 StandaloneDeriving

24 TemplateHaskell

28 TemplateHaskell

25 TypeApplications

29 TypeApplications

30+

26 build-depends:

31 build-depends:

27− -- | from ghc

32+ , aeson

28− base >= 4.7 && < 5 ,

33+ , base >=4.11 && <5

29− binary ,

34+ , binary

35+ , binary-instances

36+ , bytestring

37+ , cassava

38+ , cassava-embed

39+ , containers >=0.5.8

30− deepseq ,

40+ , deepseq

31− mtl >= 2.2 ,

41+ , file-embed >=0.0.10

32− text ,

33− time ,

34− -- | from hackage

35− aeson ,

36− dom-parser ,

37− generic-arbitrary ,

42+ , generic-arbitrary

38− http-api-data ,

43+ , http-api-data

39− lens >= 4.17 ,

44+ , lens >=4.17

45+ , mtl >=2.2

40− QuickCheck ,

46+ , QuickCheck

41− quickcheck-instances ,

47+ , quickcheck-instances

48+ , text

49+ , th-lift

50+ , time >=1.6

42− timezone-series ,

51+ , timezone-series

52+ , vector

53+

54+ if !(impl(ghcjs) || arch(javascript) || arch(wasm32))

55+ build-depends:

56+ , dom-parser >=2.0

43− xml-conduit-writer ,

57+ , xml-conduit-writer

44− -- | internal packages

58+

45− missing-lens ,

46 exposed-modules:

59 exposed-modules:

47 Data.Time.Extra

60 Data.Time.Extra

61+ Data.Time.FastSeries

48 Data.Time.Fmt

62 Data.Time.Fmt

63+ Data.Time.Holidays

49 Data.Time.LocalTime.Short

64 Data.Time.LocalTime.Short

50 Data.Time.Utils

65 Data.Time.Utils

66+

51− other-modules:

67+ other-modules: Holidays.EDay

52− Data.Time.LocalTime.Instances

src/Data/Time/Extra.hs+27−1

@@ -1,15 +1,19 @@

1+{-# LANGUAGE CPP #-}

1module Data.Time.Extra

2module Data.Time.Extra

2 ( Minutes(..)

3 ( Minutes(..)

3 , _Minutes

4 , _Minutes

4 , duration

5 , duration

5 , durationLocal

6 , durationLocal

7+ , durationUTC

6 , minutesToNDF

8 , minutesToNDF

7 , UTCDate(..)

9 , UTCDate(..)

8 , _UTCDate

10 , _UTCDate

9 , UTCTime'(..)

11 , UTCTime'(..)

10 , _UTCTime'

12 , _UTCTime'

11 , mskTimeZone

13 , mskTimeZone

14+ , estTimeZone

12 , toAPITimeMSK

15 , toAPITimeMSK

16+ , toAPITimeEST

13 , apiDate

17 , apiDate

14 , module Data.Time.LocalTime.Short

18 , module Data.Time.LocalTime.Short

15 , TimeFrame

19 , TimeFrame

@@ -20,6 +24,8 @@ module Data.Time.Extra

20 , TimeFrameType(..)

24 , TimeFrameType(..)

21 , Hours(..)

25 , Hours(..)

22 , _Hours

26 , _Hours

27+ , addUTCHours

28+ , addUTCMinutes

23 , DateRange(..)

29 , DateRange(..)

24 , mkDateRange

30 , mkDateRange

25 , drFromDate

31 , drFromDate

@@ -30,7 +36,6 @@ module Data.Time.Extra

30import Control.DeepSeq

36import Control.DeepSeq

31import Control.Lens

37import Control.Lens

32import Control.Monad

38import Control.Monad

33−import Control.Monad.Fail

34import Data.Aeson

39import Data.Aeson

35import Data.Binary

40import Data.Binary

36import Data.Function (on)

41import Data.Function (on)

@@ -42,6 +47,9 @@ import GHC.Generics (Generic)

42import Test.QuickCheck

47import Test.QuickCheck

43import Test.QuickCheck.Arbitrary.Generic

48import Test.QuickCheck.Arbitrary.Generic

44

49

50+#if !MIN_VERSION_base(4,13,0)

51+import Control.Monad.Fail

52+#endif

45

53

46newtype Minutes

54newtype Minutes

47 = Minutes { unMinutes :: Int

55 = Minutes { unMinutes :: Int

@@ -59,6 +67,12 @@ instance NFData Hours

59

67

60makePrisms ''Hours

68makePrisms ''Hours

61

69

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+

62duration :: ShortZonedTime -> ShortZonedTime -> Minutes

76duration :: ShortZonedTime -> ShortZonedTime -> Minutes

63duration t1 t2 = Minutes (timeDiff `div` 60)

77duration t1 t2 = Minutes (timeDiff `div` 60)

64 where

78 where

@@ -71,6 +85,12 @@ durationLocal t1 t2 = Minutes (timeDiff `div` 60)

71 calcDiff = diffUTCTime `on` localTimeToUTC utc

85 calcDiff = diffUTCTime `on` localTimeToUTC utc

72 timeDiff = round (calcDiff t1 t2)

86 timeDiff = round (calcDiff t1 t2)

73

87

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+

74minutesToNDF :: Minutes -> NominalDiffTime

94minutesToNDF :: Minutes -> NominalDiffTime

75minutesToNDF (Minutes mins) = 60 * realToFrac mins

95minutesToNDF (Minutes mins) = 60 * realToFrac mins

76

96

@@ -155,9 +175,15 @@ apiDate = prism' toApiDate fromApiDate

155mskTimeZone :: TimeZone

175mskTimeZone :: TimeZone

156mskTimeZone = TimeZone (3 * 60) False "MSK"

176mskTimeZone = TimeZone (3 * 60) False "MSK"

157

177

178+estTimeZone :: TimeZone

179+estTimeZone = TimeZone (-5 * 60) False "EST"

180+

158toAPITimeMSK :: UTCTime -> ShortZonedTime

181toAPITimeMSK :: UTCTime -> ShortZonedTime

159toAPITimeMSK = shortZonedTime . utcToZonedTime mskTimeZone

182toAPITimeMSK = shortZonedTime . utcToZonedTime mskTimeZone

160

183

184+toAPITimeEST :: UTCTime -> ShortZonedTime

185+toAPITimeEST = shortZonedTime . utcToZonedTime estTimeZone

186+

161data TimeFrameType

187data TimeFrameType

162 = TimeOfArrival

188 = TimeOfArrival

163 | TimeOfDeparture

189 | 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 #-}

1module Data.Time.Fmt

3module Data.Time.Fmt

2 ( FmtTime(..)

4 ( FmtTime(..)

3 , _FmtTime

5 , _FmtTime

@@ -22,9 +24,16 @@ import Data.Time

22import GHC.Generics (Generic)

24import GHC.Generics (Generic)

23import GHC.TypeLits

25import GHC.TypeLits

24import Test.QuickCheck

26import Test.QuickCheck

27+import Web.HttpApiData

28+

29+#ifndef ghcjs_HOST_OS

25import Text.XML.DOM.Parser

30import Text.XML.DOM.Parser

26import Text.XML.Writer

31import 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

28

37

29

38

30newtype FmtTime (fmt :: Symbol) a = FmtTime

39newtype FmtTime (fmt :: Symbol) a = FmtTime

@@ -43,7 +52,7 @@ fmtTimeToString =

43

52

44fmtTimeFromString

53fmtTimeFromString

45 :: forall a fmt m

54 :: forall a fmt m

46− . (ParseTime a, KnownSymbol fmt, Monad m)

55+ . (ParseTime a, KnownSymbol fmt, MonadFail m)

47 => String

56 => String

48 -> m (FmtTime fmt a)

57 -> m (FmtTime fmt a)

49fmtTimeFromString =

58fmtTimeFromString =

@@ -67,22 +76,25 @@ instance (ParseTime a, KnownSymbol fmt) => FromJSON (FmtTime fmt a) where

67instance (FormatTime a, KnownSymbol fmt) => ToHttpApiData (FmtTime fmt a) where

76instance (FormatTime a, KnownSymbol fmt) => ToHttpApiData (FmtTime fmt a) where

68 toUrlPiece = T.pack . fmtTimeToString

77 toUrlPiece = T.pack . fmtTimeToString

69

78

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+

70instance (ParseTime a, KnownSymbol fmt) => FromHttpApiData (FmtTime fmt a) where

84instance (ParseTime a, KnownSymbol fmt) => FromHttpApiData (FmtTime fmt a) where

71− parseUrlPiece t = maybe err Right $ fmtTimeFromString $ T.unpack t

85+ parseUrlPiece t =

72− where

86+ maybe (Left $ errParseFmtTime @fmt t) Right $ fmtTimeFromString $ T.unpack t

73− fmt = T.pack $ symbolVal (Proxy @fmt)

74− err = Left $ "no parse " <> t <> " as " <> fmt

75

87

88+#ifndef ghcjs_HOST_OS

76instance (FormatTime a, KnownSymbol fmt) => ToXML (FmtTime fmt a) where

89instance (FormatTime a, KnownSymbol fmt) => ToXML (FmtTime fmt a) where

77 toXML = toXML . T.pack . fmtTimeToString

90 toXML = toXML . T.pack . fmtTimeToString

78

91

79instance (ParseTime a, KnownSymbol fmt) => FromDom (FmtTime fmt a) where

92instance (ParseTime a, KnownSymbol fmt) => FromDom (FmtTime fmt a) where

80 fromDom = do

93 fromDom = do

81 s <- fromDom

94 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

86

98

87type ZonedISO8601 = ("%FT%T%Q%z" :: Symbol)

99type ZonedISO8601 = ("%FT%T%Q%z" :: Symbol)

88

100

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 #-}

1module Data.Time.LocalTime.Short

2module Data.Time.LocalTime.Short

2 ( ShortZonedTime

3 ( ShortZonedTime

3 , shortZonedTime

4 , shortZonedTime

@@ -17,28 +18,33 @@ module Data.Time.LocalTime.Short

17

18

18import Control.DeepSeq (NFData)

19import Control.DeepSeq (NFData)

19import Control.Lens

20import Control.Lens

20−import Control.Lens.Missing

21import Control.Monad.State

22import Data.Aeson

23import Data.Binary (Binary)

24+import Data.Binary.Instances.Time ()

24import Data.Coerce

25import Data.Coerce

25import Data.Ord (comparing)

26import Data.Ord (comparing)

26−import qualified Data.Time as T

27+import Data.Time as T

27import Data.Time.Fmt

28import Data.Time.Fmt

28−import Data.Time.Format

29+import Data.Time.Utils

29−import Data.Time.LocalTime.Instances ()

30import GHC.Generics (Generic)

31import Test.QuickCheck (Arbitrary)

32import qualified Test.QuickCheck as QC

33import Test.QuickCheck.Instances ()

34

35+#if MIN_VERSION_time(1,9,0)

36+import Data.Proxy

37+import Data.Time.Format.Internal

38+#endif

39+

35

40

36-- | @ZonedTime@ where seconds = 0.

41-- | @ZonedTime@ where seconds = 0.

37-- The constructor is not exported to maintain the invariant.

42-- The constructor is not exported to maintain the invariant.

38newtype ShortZonedTime

43newtype ShortZonedTime

39 = ShortZonedTime

44 = ShortZonedTime

40 { unShortZonedTime :: T.ZonedTime

45 { unShortZonedTime :: T.ZonedTime

46+ } deriving stock (Generic)

41− } deriving (FormatTime, NFData, Generic, FromJSON, ToJSON)

47+ deriving newtype (FormatTime, NFData, FromJSON, ToJSON)

42

48

43shortZonedLocalDay :: ShortZonedTime -> T.Day

49shortZonedLocalDay :: ShortZonedTime -> T.Day

44shortZonedLocalDay = T.localDay . T.zonedTimeToLocalTime . unShortZonedTime

50shortZonedLocalDay = T.localDay . T.zonedTimeToLocalTime . unShortZonedTime

@@ -63,6 +69,10 @@ shortZonedTime = coerce . clipZonedTime

63

69

64instance ParseTime ShortZonedTime where

70instance ParseTime ShortZonedTime where

65 buildTime tl ps = shortZonedTime <$> buildTime tl ps

71 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

66

76

67instance Show ShortZonedTime where

77instance Show ShortZonedTime where

68 -- Display as a string.

78 -- Display as a string.

@@ -86,7 +96,9 @@ instance Ord ShortZonedTime where

86newtype ShortLocalTime

96newtype ShortLocalTime

87 = ShortLocalTime

97 = ShortLocalTime

88 { unShortLocalTime :: T.LocalTime

98 { unShortLocalTime :: T.LocalTime

89− } deriving (Eq, Ord, FormatTime, NFData, Generic)

99+ } deriving stock (Eq, Ord, Generic)

100+ deriving newtype (FormatTime)

101+ deriving newtype (NFData)

90

102

91instance Binary ShortLocalTime

103instance Binary ShortLocalTime

92

104

@@ -100,6 +112,11 @@ shortLocalTime = coerce . clipLocalTime

100

112

101instance ParseTime ShortLocalTime where

113instance ParseTime ShortLocalTime where

102 buildTime tl ps = shortLocalTime <$> buildTime tl ps

114 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+

103

120

104type FmtShortZonedTime fmt = FmtTime fmt ShortZonedTime

121type FmtShortZonedTime fmt = FmtTime fmt ShortZonedTime

105

122

src/Data/Time/Utils.hs+26−7

@@ -3,10 +3,17 @@ module Data.Time.Utils

3 , oneHour

4 , oneMinute

5 , zoneLocalTime

6+ , _zonedTimeToLocalTime

7+ , _localDay

8+ , _localTimeOfDay

9+ , _todSec

10+ , _todMin

11+ , _todHour

6 ) where

12 ) where

7

13

14+import Control.Lens

8−import Data.Time

15+import Data.Time

9−import Data.Time.LocalTime.TimeZone.Series

16+import Data.Time.FastSeries

10

17

11

18

12the24h :: NominalDiffTime

19the24h :: NominalDiffTime

@@ -18,12 +25,24 @@ oneHour = 60 * 60

18oneMinute :: NominalDiffTime

25oneMinute :: NominalDiffTime

19oneMinute = 60

26oneMinute = 60

20

27

21−-- | Calculate TimeZone using TimeZoneSeries and construct ZonedTime

28+-- | Calculate 'TimeZone' using 'TimeZoneSeries' and construct 'ZonedTime'.

29+--

30+-- See caveats on 'localTimeToUTC''.

22zoneLocalTime

31zoneLocalTime

23 :: TimeZoneSeries

32 :: TimeZoneSeries

24 -> LocalTime

33 -> LocalTime

25 -> ZonedTime

34 -> ZonedTime

26−zoneLocalTime tzs lt = let

35+zoneLocalTime tzsf lt = ZonedTime lt tz

27− u = localTimeToUTC' tzs lt

36+ where !tz = timeZoneFromSeriesLocal tzsf lt

28− tz = timeZoneFromSeries tzs u

37+

29− in ZonedTime lt tz

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