git.iko.soy/typeable/extra-time
on master help sign in
Ref: extra-time (#5956)

* Ref: extra-time * cleanup * increase time version

commit28ec1ceccef915480ee9ff3601b1b4706443976a authorDmitry Olshansky <Olshanskydr@gmail.com> dateFri 9 Apr 2021, 17:00 (6 years ago) parent82de1af
6 files changed+58−26
compare with master
unifiedsplit
extra-time.cabal+1−6 src/Data/Time/Extra.hs+5−3 src/Data/Time/Fmt.hs+16−9 src/Data/Time/LocalTime/Instances.hs−3 src/Data/Time/LocalTime/Short.hs+15−3 src/Data/Time/Utils.hs+21−2
extra-time.cabal+1−6
@@ -30,10 +30,7 @@ library
3030 deepseq ,
3131 mtl >= 2.2 ,
3232 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,
3734 -- | from hackage
3835 aeson ,
3936 dom-parser ,
@@ -44,8 +41,6 @@ library
4441 quickcheck-instances ,
4542 timezone-series ,
4643 xml-conduit-writer ,
47− -- | internal packages
48− missing-lens ,
4944 exposed-modules:
5045 Data.Time.Extra
5146 Data.Time.Fmt
src/Data/Time/Extra.hs+5−3
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12module Data.Time.Extra
23 ( Minutes(..)
34 , _Minutes
@@ -33,7 +34,6 @@ module Data.Time.Extra
3334import Control.DeepSeq
3435import Control.Lens
3536import Control.Monad
36−import Control.Monad.Fail
3737import Data.Aeson
3838import Data.Binary
3939import Data.Function (on)
@@ -45,6 +45,9 @@ import GHC.Generics (Generic)
4545import Test.QuickCheck
4646import Test.QuickCheck.Arbitrary.Generic
4747
48+#if !MIN_VERSION_base(4,13,0)
49+import Control.Monad.Fail
50+#endif
4851
4952newtype Minutes
5053 = Minutes { unMinutes :: Int
@@ -63,8 +66,7 @@ instance NFData Hours
6366makePrisms ''Hours
6467
6568addUTCHours :: Hours -> UTCTime -> UTCTime
66−addUTCHours (Hours h) t = addUTCTime s t
67− where s = fromIntegral (h * 3600)
69+addUTCHours (Hours h) = addUTCTime $ fromIntegral (h * 3600)
6870
6971duration :: ShortZonedTime -> ShortZonedTime -> Minutes
7072duration t1 t2 = Minutes (timeDiff `div` 60)
src/Data/Time/Fmt.hs+16−9
@@ -1,3 +1,5 @@
1+{-# LANGUAGE AllowAmbiguousTypes #-}
2+{-# LANGUAGE CPP #-}
13module Data.Time.Fmt
24 ( FmtTime(..)
35 , _FmtTime
@@ -26,6 +28,10 @@ import Text.XML.DOM.Parser
2628import Text.XML.Writer
2729import Web.HttpApiData
2830
31+#if !MIN_VERSION_base(4,13,0)
32+import Control.Monad.Fail
33+#endif
34+
2935
3036newtype FmtTime (fmt :: Symbol) a = FmtTime
3137 { unFmtTime :: a
@@ -43,7 +49,7 @@ fmtTimeToString =
4349
4450fmtTimeFromString
4551 :: forall a fmt m
46− . (ParseTime a, KnownSymbol fmt, Monad m)
52+ . (ParseTime a, KnownSymbol fmt, MonadFail m)
4753 => String
4854 -> m (FmtTime fmt a)
4955fmtTimeFromString =
@@ -67,11 +73,14 @@ instance (ParseTime a, KnownSymbol fmt) => FromJSON (FmtTime fmt a) where
6773instance (FormatTime a, KnownSymbol fmt) => ToHttpApiData (FmtTime fmt a) where
6874 toUrlPiece = T.pack . fmtTimeToString
6975
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+
7081instance (ParseTime a, KnownSymbol fmt) => FromHttpApiData (FmtTime fmt a) where
71− parseUrlPiece t = maybe err Right $ fmtTimeFromString $ T.unpack t
72− where
73− fmt = T.pack $ symbolVal (Proxy @fmt)
74− err = Left $ "no parse " <> t <> " as " <> fmt
82+ parseUrlPiece t =
83+ maybe (Left $ errParseFmtTime @fmt t) Right $ fmtTimeFromString $ T.unpack t
7584
7685instance (FormatTime a, KnownSymbol fmt) => ToXML (FmtTime fmt a) where
7786 toXML = toXML . T.pack . fmtTimeToString
@@ -79,10 +88,8 @@ instance (FormatTime a, KnownSymbol fmt) => ToXML (FmtTime fmt a) where
7988instance (ParseTime a, KnownSymbol fmt) => FromDom (FmtTime fmt a) where
8089 fromDom = do
8190 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
8693
8794type ZonedISO8601 = ("%FT%T%Q%z" :: Symbol)
8895
src/Data/Time/LocalTime/Instances.hs−3
@@ -5,9 +5,6 @@ module Data.Time.LocalTime.Instances where
55import Data.Binary (Binary(..))
66import Data.Fixed (Fixed(..))
77import Data.Time
8− (Day(..), LocalTime(..), TimeOfDay(..), TimeZone(..), ZonedTime(..))
9−import qualified Data.Time as T
10−import Data.Time.Clock
118import GHC.Generics (Generic)
129
1310
src/Data/Time/LocalTime/Short.hs+15−3
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12module Data.Time.LocalTime.Short
23 ( ShortZonedTime
34 , shortZonedTime
@@ -17,21 +18,25 @@ module Data.Time.LocalTime.Short
1718
1819import Control.DeepSeq (NFData)
1920import Control.Lens
20−import Control.Lens.Missing
2121import Control.Monad.State
2222import Data.Aeson
2323import Data.Binary (Binary)
2424import Data.Coerce
2525import Data.Ord (comparing)
26−import qualified Data.Time as T
26+import Data.Time as T
2727import Data.Time.Fmt
28−import Data.Time.Format
2928import Data.Time.LocalTime.Instances ()
29+import Data.Time.Utils
3030import GHC.Generics (Generic)
3131import Test.QuickCheck (Arbitrary)
3232import qualified Test.QuickCheck as QC
3333import Test.QuickCheck.Instances ()
3434
35+#if MIN_VERSION_time(1,9,0)
36+import Data.Proxy
37+import Data.Time.Format.Internal
38+#endif
39+
3540
3641-- | @ZonedTime@ where seconds = 0.
3742-- The constructor is not exported to maintain the invariant.
@@ -63,6 +68,9 @@ shortZonedTime = coerce . clipZonedTime
6368
6469instance ParseTime ShortZonedTime where
6570 buildTime tl ps = shortZonedTime <$> buildTime tl ps
71+#if MIN_VERSION_time(1,9,0)
72+ parseTimeSpecifier _ = parseTimeSpecifier (Proxy @T.ZonedTime)
73+#endif
6674
6775instance Show ShortZonedTime where
6876 -- Display as a string.
@@ -100,6 +108,10 @@ shortLocalTime = coerce . clipLocalTime
100108
101109instance ParseTime ShortLocalTime where
102110 buildTime tl ps = shortLocalTime <$> buildTime tl ps
111+#if MIN_VERSION_time(1,9,0)
112+ parseTimeSpecifier _ = parseTimeSpecifier (Proxy @T.LocalTime)
113+#endif
114+
103115
104116type FmtShortZonedTime fmt = FmtTime fmt ShortZonedTime
105117
src/Data/Time/Utils.hs+21−2
@@ -3,10 +3,17 @@ module Data.Time.Utils
33 , oneHour
44 , oneMinute
55 , zoneLocalTime
6+ , _zonedTimeToLocalTime
7+ , _localDay
8+ , _localTimeOfDay
9+ , _todSec
10+ , _todMin
11+ , _todHour
612 ) where
713
8−import Data.Time
9−import Data.Time.LocalTime.TimeZone.Series
14+import Control.Lens
15+import Data.Time
16+import Data.Time.LocalTime.TimeZone.Series
1017
1118
1219the24h :: NominalDiffTime
@@ -27,3 +34,15 @@ zoneLocalTime tzs lt = let
2734 u = localTimeToUTC' tzs lt
2835 tz = timeZoneFromSeries tzs u
2936 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