git.iko.soy/typeable/extra-time
on 1550439 help sign in
extra-time.cabal+39−42
since splitsnapshots
unifiedsplit
@@ -1,67 +1,64 @@
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− data/opm-holidays.csv
9+extra-source-files: README.md, 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
18 DerivingStrategies
21 GeneralizedNewtypeDeriving
19 GeneralizedNewtypeDeriving
20+ ImportQualifiedPost
22 KindSignatures
21 KindSignatures
23− NamedFieldPuns
24 OverloadedStrings
22 OverloadedStrings
25 RankNTypes
23 RankNTypes
26 ScopedTypeVariables
24 ScopedTypeVariables
27 StandaloneDeriving
25 StandaloneDeriving
28 TemplateHaskell
26 TemplateHaskell
29 TypeApplications
27 TypeApplications
30−
31 build-depends:
28 build-depends:
32− , aeson
29+ -- | from ghc
33− , base >=4.11 && <5
30+ base >= 4.7 && < 5 ,
34− , binary
31+ binary ,
35− , binary-instances
36− , bytestring
32+ bytestring ,
37− , cassava
38− , cassava-embed
39− , containers >=0.5.8
33+ containers ,
40− , deepseq
34+ cassava ,
35+ cassava-embed ,
41− , file-embed >=0.0.10
36+ file-embed ,
37+ deepseq ,
38+ mtl >= 2.2 ,
39+ template-haskell ,
40+ text ,
41+ th-lift ,
42+ time,
43+ -- | from hackage
44+ aeson ,
42− , generic-arbitrary
45+ generic-arbitrary ,
43− , http-api-data
46+ http-api-data ,
44− , lens >=4.17
47+ lens >= 4.17 ,
45− , mtl >=2.2
46− , QuickCheck
48+ QuickCheck ,
47− , quickcheck-instances
49+ quickcheck-instances ,
48− , text
49− , th-lift
50− , time >=1.6
51− , timezone-series
50+ timezone-series ,
52− , vector
51+ vector ,
53−
54− if !(impl(ghcjs) || arch(javascript) || arch(wasm32))
52+ if !impl(ghcjs)
55 build-depends:
53 build-depends:
56− , dom-parser >=2.0
54+ dom-parser ,
57− , xml-conduit-writer
55+ xml-conduit-writer ,
58−
59 exposed-modules:
56 exposed-modules:
60 Data.Time.Extra
57 Data.Time.Extra
61− Data.Time.FastSeries
62 Data.Time.Fmt
58 Data.Time.Fmt
63 Data.Time.Holidays
59 Data.Time.Holidays
64 Data.Time.LocalTime.Short
60 Data.Time.LocalTime.Short
65 Data.Time.Utils
61 Data.Time.Utils
66−
67− other-modules: Holidays.EDay
62+ other-modules:
63+ Data.Time.LocalTime.Instances
64+ Holidays.EDay
src/Data/Time/Extra.hs−7
@@ -4,7 +4,6 @@ module Data.Time.Extra
4 , _Minutes
4 , _Minutes
5 , duration
5 , duration
6 , durationLocal
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.hs+1−1
@@ -7,7 +7,7 @@ import Data.Proxy
7import qualified Data.Set as S
7import qualified Data.Set as S
8import Data.Time
8import Data.Time
9import Data.Time.Calendar.OrdinalDate
9import Data.Time.Calendar.OrdinalDate
10−import Data.Time.FastSeries
10+import Data.Time.LocalTime.TimeZone.Series
11import Data.FileEmbed (makeRelativeToProject)
11import Data.FileEmbed (makeRelativeToProject)
12import Data.Csv.Embed (embedRecords)
12import Data.Csv.Embed (embedRecords)
13import Holidays.EDay (eDayToDay, EDay)
13import Holidays.EDay (eDayToDay, EDay)
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+1−1
@@ -21,11 +21,11 @@ import Control.Lens
21import Control.Monad.State
21import Control.Monad.State
22import Data.Aeson
22import Data.Aeson
23import Data.Binary (Binary)
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
29import Data.Time.Utils
30import GHC.Generics (Generic)
30import GHC.Generics (Generic)
31import Test.QuickCheck (Arbitrary)
31import Test.QuickCheck (Arbitrary)
src/Data/Time/Utils.hs+6−6
@@ -13,7 +13,7 @@ module Data.Time.Utils
13
13
14import Control.Lens
14import Control.Lens
15import Data.Time
15import Data.Time
16−import Data.Time.FastSeries
16+import Data.Time.LocalTime.TimeZone.Series
17
17
18
18
19the24h :: NominalDiffTime
19the24h :: NominalDiffTime
@@ -25,15 +25,15 @@ oneHour = 60 * 60
25oneMinute :: NominalDiffTime
25oneMinute :: NominalDiffTime
26oneMinute = 60
26oneMinute = 60
27
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
37
38makeLensesFor
38makeLensesFor
39 [("zonedTimeToLocalTime", "_zonedTimeToLocalTime")] ''ZonedTime
39 [("zonedTimeToLocalTime", "_zonedTimeToLocalTime")] ''ZonedTime
src/Holidays/EDay.hs+1−1
@@ -7,7 +7,7 @@ import Data.ByteString.Char8
7import Data.Csv
7import Data.Csv
8import Data.Time
8import Data.Time
9import Data.Time.Calendar.OrdinalDate
9import Data.Time.Calendar.OrdinalDate
10−import qualified Data.Vector as V
10+import Data.Vector qualified as V
11import Language.Haskell.TH.Lift
11import Language.Haskell.TH.Lift
12
12
13data EDay = EDay {edYear :: Integer, edDay :: Int}
13data EDay = EDay {edYear :: Integer, edDay :: Int}