3e734ec...master · typeable/extra-time

extra-time.cabal+42−39

since splitsnapshots

unifiedsplit

@@ -1,64 +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

8+extra-source-files:

9−extra-source-files: README.md, data/opm-holidays.csv

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

18 DerivingStrategies

20 DerivingStrategies

19 GeneralizedNewtypeDeriving

21 GeneralizedNewtypeDeriving

20− ImportQualifiedPost

21 KindSignatures

22 KindSignatures

23+ NamedFieldPuns

22 OverloadedStrings

24 OverloadedStrings

23 RankNTypes

25 RankNTypes

24 ScopedTypeVariables

26 ScopedTypeVariables

25 StandaloneDeriving

27 StandaloneDeriving

26 TemplateHaskell

28 TemplateHaskell

27 TypeApplications

29 TypeApplications

30+

28 build-depends:

31 build-depends:

29− -- | from ghc

32+ , aeson

30− base >= 4.7 && < 5 ,

33+ , base >=4.11 && <5

34+ , binary

31− binary ,

35+ , binary-instances

32− bytestring ,

36+ , bytestring

37+ , cassava

38+ , cassava-embed

33− containers ,

39+ , containers >=0.5.8

34− cassava ,

35− cassava-embed ,

36− file-embed ,

37− deepseq ,

40+ , deepseq

38− mtl >= 2.2 ,

41+ , file-embed >=0.0.10

39− template-haskell ,

40− text ,

41− th-lift ,

42− time,

43− -- | from hackage

44− aeson ,

45− generic-arbitrary ,

42+ , generic-arbitrary

46− http-api-data ,

43+ , http-api-data

47− lens >= 4.17 ,

44+ , lens >=4.17

45+ , mtl >=2.2

48− QuickCheck ,

46+ , QuickCheck

49− quickcheck-instances ,

47+ , quickcheck-instances

48+ , text

49+ , th-lift

50+ , time >=1.6

50− timezone-series ,

51+ , timezone-series

51− vector ,

52+ , vector

53+

52− if !impl(ghcjs)

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

53 build-depends:

55 build-depends:

54− dom-parser ,

56+ , dom-parser >=2.0

55− xml-conduit-writer ,

57+ , xml-conduit-writer

58+

56 exposed-modules:

59 exposed-modules:

57 Data.Time.Extra

60 Data.Time.Extra

61+ Data.Time.FastSeries

58 Data.Time.Fmt

62 Data.Time.Fmt

59 Data.Time.Holidays

63 Data.Time.Holidays

60 Data.Time.LocalTime.Short

64 Data.Time.LocalTime.Short

61 Data.Time.Utils

65 Data.Time.Utils

66+

62− other-modules:

67+ other-modules: Holidays.EDay

63− Data.Time.LocalTime.Instances

64− Holidays.EDay

src/Data/Time/Extra.hs+7

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

4 , _Minutes

5 , duration

6 , durationLocal

7+ , durationUTC

7 , minutesToNDF

8 , minutesToNDF

8 , UTCDate(..)

9 , UTCDate(..)

9 , _UTCDate

10 , _UTCDate

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

84 calcDiff = diffUTCTime `on` localTimeToUTC utc

85 calcDiff = diffUTCTime `on` localTimeToUTC utc

85 timeDiff = round (calcDiff t1 t2)

86 timeDiff = round (calcDiff t1 t2)

86

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+

87minutesToNDF :: Minutes -> NominalDiffTime

94minutesToNDF :: Minutes -> NominalDiffTime

88minutesToNDF (Minutes mins) = 60 * realToFrac mins

95minutesToNDF (Minutes mins) = 60 * realToFrac mins

89

96

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/Holidays.hs+1−1

@@ -7,7 +7,7 @@ import Data.Proxy

7import qualified Data.Set as S

8import Data.Time

9import Data.Time.Calendar.OrdinalDate

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

10+import Data.Time.FastSeries

11import Data.FileEmbed (makeRelativeToProject)

12import Data.Csv.Embed (embedRecords)

13import Holidays.EDay (eDayToDay, EDay)

src/Data/Time/LocalTime/Instances.hsdeleted−39

@@ -1,39 +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−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+1−1

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

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)

26import Data.Time as T

27import Data.Time as T

27import Data.Time.Fmt

28import Data.Time.Fmt

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

29import Data.Time.Utils

30import GHC.Generics (Generic)

31import Test.QuickCheck (Arbitrary)

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.LocalTime.TimeZone.Series

16+import Data.Time.FastSeries

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''.

29zoneLocalTime

31zoneLocalTime

30 :: TimeZoneSeries

32 :: TimeZoneSeries

31 -> LocalTime

33 -> LocalTime

32 -> ZonedTime

34 -> ZonedTime

33−zoneLocalTime tzs lt = let

34− u = localTimeToUTC' tzs lt

35− tz = timeZoneFromSeries tzs u

36− in ZonedTime lt tz

35+zoneLocalTime tzsf lt = ZonedTime lt tz

36+ where !tz = timeZoneFromSeriesLocal tzsf lt

37

38makeLensesFor

39 [("zonedTimeToLocalTime", "_zonedTimeToLocalTime")] ''ZonedTime

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