28ec1ce · typeable/extra-time

extra-time.cabal+1−6

compare with master

unifiedsplit

@@ -30,10 +30,7 @@ library

30 deepseq ,

31 mtl >= 2.2 ,

32 text ,

33− -- | In time-1.9 parseTimeM works in MonadFail

34− -- and require special processing.

35− -- See also https://gitlab.haskell.org/ghc/ghc/-/issues/12160

36− time < 1.9,

33+ time,

37 -- | from hackage

34 -- | from hackage

38 aeson ,

35 aeson ,

39 dom-parser ,

36 dom-parser ,

@@ -44,8 +41,6 @@ library

44 quickcheck-instances ,

41 quickcheck-instances ,

45 timezone-series ,

42 timezone-series ,

46 xml-conduit-writer ,

43 xml-conduit-writer ,

47− -- | internal packages

48− missing-lens ,

49 exposed-modules:

44 exposed-modules:

50 Data.Time.Extra

45 Data.Time.Extra

51 Data.Time.Fmt

46 Data.Time.Fmt

src/Data/Time/Extra.hs+5−3

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1module Data.Time.Extra

2module Data.Time.Extra

2 ( Minutes(..)

3 ( Minutes(..)

3 , _Minutes

4 , _Minutes

@@ -33,7 +34,6 @@ module Data.Time.Extra

33import Control.DeepSeq

34import Control.DeepSeq

34import Control.Lens

35import Control.Lens

35import Control.Monad

36import Control.Monad

36−import Control.Monad.Fail

37import Data.Aeson

38import Data.Binary

39import Data.Function (on)

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

45import Test.QuickCheck

46import Test.QuickCheck.Arbitrary.Generic

47

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

49+import Control.Monad.Fail

50+#endif

48

51

49newtype Minutes

52newtype Minutes

50 = Minutes { unMinutes :: Int

53 = Minutes { unMinutes :: Int

@@ -63,8 +66,7 @@ instance NFData Hours

63makePrisms ''Hours

66makePrisms ''Hours

64

67

65addUTCHours :: Hours -> UTCTime -> UTCTime

68addUTCHours :: Hours -> UTCTime -> UTCTime

66−addUTCHours (Hours h) t = addUTCTime s t

69+addUTCHours (Hours h) = addUTCTime $ fromIntegral (h * 3600)

67− where s = fromIntegral (h * 3600)

68

70

69duration :: ShortZonedTime -> ShortZonedTime -> Minutes

71duration :: ShortZonedTime -> ShortZonedTime -> Minutes

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

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

src/Data/Time/Fmt.hs+16−9

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

@@ -26,6 +28,10 @@ import Text.XML.DOM.Parser

26import Text.XML.Writer

28import Text.XML.Writer

27import Web.HttpApiData

29import Web.HttpApiData

28

30

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

32+import Control.Monad.Fail

33+#endif

34+

29

35

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

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

31 { unFmtTime :: a

37 { unFmtTime :: a

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

43

49

44fmtTimeFromString

50fmtTimeFromString

45 :: forall a fmt m

51 :: forall a fmt m

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

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

47 => String

53 => String

48 -> m (FmtTime fmt a)

54 -> m (FmtTime fmt a)

49fmtTimeFromString =

55fmtTimeFromString =

@@ -67,11 +73,14 @@ instance (ParseTime a, KnownSymbol fmt) => FromJSON (FmtTime fmt a) where

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

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

68 toUrlPiece = T.pack . fmtTimeToString

74 toUrlPiece = T.pack . fmtTimeToString

69

75

76+errParseFmtTime

77+ :: forall fmt s. (KnownSymbol fmt, IsString s, Semigroup s) => s -> s

78+errParseFmtTime t =

79+ "no parse " <> t <> " as " <> fromString (symbolVal (Proxy @fmt))

80+

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

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

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

82+ parseUrlPiece t =

72− where

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

84

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

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

77 toXML = toXML . T.pack . fmtTimeToString

86 toXML = toXML . T.pack . fmtTimeToString

@@ -79,10 +88,8 @@ instance (FormatTime a, KnownSymbol fmt) => ToXML (FmtTime fmt a) where

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

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

80 fromDom = do

89 fromDom = do

81 s <- fromDom

90 s <- fromDom

82− case fmtTimeFromString s of

83− Right a -> return a

84− Left e -> throwParserError $

85− PEContentWrongFormat (T.pack e)

91+ maybe (throwParserError $ PEContentWrongFormat $ errParseFmtTime @fmt s)

92+ pure $ fmtTimeFromString $ T.unpack s

86

93

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

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

88

95

src/Data/Time/LocalTime/Instances.hs−3

@@ -5,9 +5,6 @@ module Data.Time.LocalTime.Instances where

5import Data.Binary (Binary(..))

6import Data.Fixed (Fixed(..))

7import Data.Time

8− (Day(..), LocalTime(..), TimeOfDay(..), TimeZone(..), ZonedTime(..))

9−import qualified Data.Time as T

10−import Data.Time.Clock

11import GHC.Generics (Generic)

8import GHC.Generics (Generic)

12

9

13

10

src/Data/Time/LocalTime/Short.hs+15−3

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1module Data.Time.LocalTime.Short

2module Data.Time.LocalTime.Short

2 ( ShortZonedTime

3 ( ShortZonedTime

3 , shortZonedTime

4 , shortZonedTime

@@ -17,21 +18,25 @@ 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)

24import Data.Coerce

25import Data.Ord (comparing)

26−import qualified Data.Time as T

26+import Data.Time as T

27import Data.Time.Fmt

28−import Data.Time.Format

29import Data.Time.LocalTime.Instances ()

28import Data.Time.LocalTime.Instances ()

29+import Data.Time.Utils

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.

@@ -63,6 +68,9 @@ shortZonedTime = coerce . clipZonedTime

63

68

64instance ParseTime ShortZonedTime where

69instance ParseTime ShortZonedTime where

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

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

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

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

73+#endif

66

74

67instance Show ShortZonedTime where

75instance Show ShortZonedTime where

68 -- Display as a string.

76 -- Display as a string.

@@ -100,6 +108,10 @@ shortLocalTime = coerce . clipLocalTime

100

108

101instance ParseTime ShortLocalTime where

109instance ParseTime ShortLocalTime where

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

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

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

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

113+#endif

114+

103

115

104type FmtShortZonedTime fmt = FmtTime fmt ShortZonedTime

116type FmtShortZonedTime fmt = FmtTime fmt ShortZonedTime

105

117

src/Data/Time/Utils.hs+21−2

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

10

17

11

18

12the24h :: NominalDiffTime

19the24h :: NominalDiffTime

@@ -27,3 +34,15 @@ zoneLocalTime tzs lt = let

27 u = localTimeToUTC' tzs lt

34 u = localTimeToUTC' tzs lt

28 tz = timeZoneFromSeries tzs u

35 tz = timeZoneFromSeries tzs u

29 in ZonedTime lt tz

36 in ZonedTime lt tz

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