master..17ecb06 · typeable/extra-time

data/opm-holidays.csvdeleted−112

since splitsnapshots

unifiedsplit

@@ -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+29−44

@@ -1,67 +1,52 @@

1−cabal-version: 2.4

1+cabal-version: 2.4

2+

2−name: extra-time

3+name: extra-time

3−version: 0.0.0.0

4+version: 0.0.0.0

4−license-file: LICENSE

5+license-file: LICENSE

5−author: typeable.io

6+author: typeable.io

6−maintainer: giorgio@marinel.li

7+maintainer: giorgio@marinel.li

7−build-type: Simple

8+build-type: Simple

8−extra-source-files:

9+extra-source-files: README.md

9− data/opm-holidays.csv

10− README.md

11

10

12library

11library

13 hs-source-dirs: src

12 hs-source-dirs: src

14 default-language: Haskell2010

13 default-language: Haskell2010

15 default-extensions:

14 default-extensions:

16− BangPatterns

17 DataKinds

15 DataKinds

18 DeriveFunctor

16 DeriveFunctor

19 DeriveGeneric

17 DeriveGeneric

20− DerivingStrategies

21 GeneralizedNewtypeDeriving

18 GeneralizedNewtypeDeriving

22 KindSignatures

19 KindSignatures

23− NamedFieldPuns

24 OverloadedStrings

20 OverloadedStrings

25 RankNTypes

21 RankNTypes

26 ScopedTypeVariables

22 ScopedTypeVariables

27 StandaloneDeriving

23 StandaloneDeriving

28 TemplateHaskell

24 TemplateHaskell

29 TypeApplications

25 TypeApplications

30−

31 build-depends:

26 build-depends:

32− , aeson

27+ -- | from ghc

33− , base >=4.11 && <5

28+ base >= 4.7 && < 5 ,

34− , binary

29+ binary ,

35− , binary-instances

36− , bytestring

37− , cassava

38− , cassava-embed

39− , containers >=0.5.8

40− , deepseq

30+ deepseq ,

41− , file-embed >=0.0.10

31+ mtl >= 2.2 ,

32+ text ,

33+ time,

34+ -- | from hackage

35+ aeson ,

42− , generic-arbitrary

36+ generic-arbitrary ,

43− , http-api-data

37+ http-api-data ,

44− , lens >=4.17

38+ lens >= 4.17 ,

45− , mtl >=2.2

46− , QuickCheck

39+ QuickCheck ,

47− , quickcheck-instances

40+ quickcheck-instances ,

48− , text

49− , th-lift

50− , time >=1.6

51− , timezone-series

41+ timezone-series ,

52− , vector

53−

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

42+ if !impl(ghcjs)

55 build-depends:

43 build-depends:

56− , dom-parser >=2.0

44+ dom-parser ,

57− , xml-conduit-writer

45+ xml-conduit-writer ,

58−

59 exposed-modules:

46 exposed-modules:

60 Data.Time.Extra

47 Data.Time.Extra

61− Data.Time.FastSeries

62 Data.Time.Fmt

48 Data.Time.Fmt

63− Data.Time.Holidays

64 Data.Time.LocalTime.Short

49 Data.Time.LocalTime.Short

65 Data.Time.Utils

50 Data.Time.Utils

66−

67− other-modules: Holidays.EDay

51+ other-modules:

52+ Data.Time.LocalTime.Instances

src/Data/Time/Extra.hs−7

@@ -4,7 +4,6 @@ module Data.Time.Extra

4 , _Minutes

5 , duration

6 , durationLocal

7− , durationUTC

8 , minutesToNDF

7 , minutesToNDF

9 , UTCDate(..)

8 , UTCDate(..)

10 , _UTCDate

9 , _UTCDate

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

85 calcDiff = diffUTCTime `on` localTimeToUTC utc

84 calcDiff = diffUTCTime `on` localTimeToUTC utc

86 timeDiff = round (calcDiff t1 t2)

85 timeDiff = round (calcDiff t1 t2)

87

86

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−

94minutesToNDF :: Minutes -> NominalDiffTime

87minutesToNDF :: Minutes -> NominalDiffTime

95minutesToNDF (Minutes mins) = 60 * realToFrac mins

88minutesToNDF (Minutes mins) = 60 * realToFrac mins

96

89

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

2module Data.Time.LocalTime.Short

3 ( ShortZonedTime

4 , shortZonedTime

@@ -21,11 +21,11 @@ import Control.Lens

21import Control.Monad.State

22import Data.Aeson

23import Data.Binary (Binary)

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

25import Data.Coerce

24import Data.Coerce

26import Data.Ord (comparing)

25import Data.Ord (comparing)

27import Data.Time as T

26import Data.Time as T

28import Data.Time.Fmt

27import Data.Time.Fmt

28+import Data.Time.LocalTime.Instances ()

29import Data.Time.Utils

30import GHC.Generics (Generic)

31import Test.QuickCheck (Arbitrary)

@@ -43,8 +43,7 @@ import Data.Time.Format.Internal

43newtype ShortZonedTime

44 = ShortZonedTime

45 { unShortZonedTime :: T.ZonedTime

46− } deriving stock (Generic)

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

46+ } deriving (FormatTime, NFData, Generic, FromJSON, ToJSON)

48

47

49shortZonedLocalDay :: ShortZonedTime -> T.Day

48shortZonedLocalDay :: ShortZonedTime -> T.Day

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

49shortZonedLocalDay = T.localDay . T.zonedTimeToLocalTime . unShortZonedTime

@@ -70,7 +69,6 @@ shortZonedTime = coerce . clipZonedTime

70instance ParseTime ShortZonedTime where

69instance ParseTime ShortZonedTime where

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

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

72#if MIN_VERSION_time(1,9,0)

71#if MIN_VERSION_time(1,9,0)

73− substituteTimeSpecifier _ = substituteTimeSpecifier (Proxy @T.ZonedTime)

74 parseTimeSpecifier _ = parseTimeSpecifier (Proxy @T.ZonedTime)

72 parseTimeSpecifier _ = parseTimeSpecifier (Proxy @T.ZonedTime)

75#endif

73#endif

76

74

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

96newtype ShortLocalTime

94newtype ShortLocalTime

97 = ShortLocalTime

95 = ShortLocalTime

98 { unShortLocalTime :: T.LocalTime

96 { unShortLocalTime :: T.LocalTime

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

97+ } deriving (Eq, Ord, FormatTime, NFData, Generic)

100− deriving newtype (FormatTime)

101− deriving newtype (NFData)

102

98

103instance Binary ShortLocalTime

99instance Binary ShortLocalTime

104

100

@@ -113,7 +109,6 @@ shortLocalTime = coerce . clipLocalTime

113instance ParseTime ShortLocalTime where

109instance ParseTime ShortLocalTime where

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

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

115#if MIN_VERSION_time(1,9,0)

111#if MIN_VERSION_time(1,9,0)

116− substituteTimeSpecifier _ = substituteTimeSpecifier (Proxy @T.ZonedTime)

117 parseTimeSpecifier _ = parseTimeSpecifier (Proxy @T.LocalTime)

112 parseTimeSpecifier _ = parseTimeSpecifier (Proxy @T.LocalTime)

118#endif

113#endif

119

114

src/Data/Time/Utils.hs+6−6

@@ -13,7 +13,7 @@ module Data.Time.Utils

13

14import Control.Lens

15import Data.Time

16−import Data.Time.FastSeries

16+import Data.Time.LocalTime.TimeZone.Series

17

18

19the24h :: NominalDiffTime

@@ -25,15 +25,15 @@ oneHour = 60 * 60

25oneMinute :: NominalDiffTime

26oneMinute = 60

27

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

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

29−--

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

31zoneLocalTime

29zoneLocalTime

32 :: TimeZoneSeries

30 :: TimeZoneSeries

33 -> LocalTime

31 -> LocalTime

34 -> ZonedTime

32 -> ZonedTime

33+zoneLocalTime tzs lt = let

34+ u = localTimeToUTC' tzs lt

35+ tz = timeZoneFromSeries tzs u

35−zoneLocalTime tzsf lt = ZonedTime lt tz

36+ in ZonedTime lt tz

36− where !tz = timeZoneFromSeriesLocal tzsf lt

37

38makeLensesFor

39 [("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.yaml−1

@@ -7,4 +7,3 @@ 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