git.iko.soy/typeable/http-api-data
on master help sign in
Merge pull request #22 from fizruk/time-instances

Instances for more time types

commit0d8367f2da96616f36c219b87b1a72fb7b2dbb52 authorNickolay Kudasov <fizruk@users.noreply.github.com> dateThu 10 Dec 2015, 13:08 (11 years ago) parent56e3b9debf27b4
5 files changed+71
compare with master
unifiedsplit
.travis.yml+2 CHANGELOG.md+2 Web/HttpApiData/Internal.hs+43 http-api-data.cabal+1 test/Spec.hs+23
.travis.yml+2
@@ -10,7 +10,9 @@ env:
1010
1111matrix:
1212 allow_failures:
13+ - env: GHCVER=7.6.3 CABALVER=1.18 CABAL_FLAGS=
1314 - env: GHCVER=head CABALVER=head CABAL_FLAGS=
15+ - env: GHCVER=7.6.3 CABALVER=1.18 CABAL_FLAGS=use-text-show
1416 - env: GHCVER=head CABALVER=head CABAL_FLAGS=use-text-show
1517
1618before_install:
CHANGELOG.md+2
@@ -1,3 +1,5 @@
1+* Add instances for more `time` types: `LocalTime`, `ZonedTime`, `UTCTime` and `NominalDiffTime`
2+
130.2.1
24---
35
Web/HttpApiData/Internal.hs+43
@@ -28,6 +28,7 @@ import Data.Text.Read (signed, decimal, rational, Reader)
2828import qualified Data.Text as T
2929import qualified Data.Text.Lazy as L
3030
31+import Data.Time.Locale.Compat
3132import Data.Time
3233import Data.Version
3334
@@ -364,6 +365,26 @@ instance ToHttpApiData Word64 where toUrlPiece = showt
364365-- "2015-10-03"
365366instance ToHttpApiData Day where toUrlPiece = T.pack . show
366367
368+timeToUrlPiece :: FormatTime t => String -> t -> Text
369+timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))
370+
371+-- |
372+-- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)
373+-- "2015-10-03T14:55:01"
374+instance ToHttpApiData LocalTime where toUrlPiece = timeToUrlPiece "%H:%M:%S"
375+
376+-- |
377+-- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)) utc
378+-- "2015-10-03T14:55:01+0000"
379+instance ToHttpApiData ZonedTime where toUrlPiece = timeToUrlPiece "%H:%M:%S%z"
380+
381+-- |
382+-- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864
383+-- "2015-10-03T00:14:24Z"
384+instance ToHttpApiData UTCTime where toUrlPiece = timeToUrlPiece "%H:%M:%SZ"
385+
386+instance ToHttpApiData NominalDiffTime where toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer)
387+
367388instance ToHttpApiData String where toUrlPiece = T.pack
368389instance ToHttpApiData Text where toUrlPiece = id
369390instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
@@ -445,6 +466,28 @@ instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
445466-- Right (2016,12,1)
446467instance FromHttpApiData Day where parseUrlPiece = readTextData
447468
469+timeParseUrlPiece :: ParseTime t => String -> Text -> Either Text t
470+timeParseUrlPiece fmt = parseMaybeTextData (timeParseUrlPieceMaybe . T.unpack)
471+ where
472+ timeParseUrlPieceMaybe = parseTime defaultTimeLocale (iso8601DateFormat (Just fmt))
473+
474+-- |
475+-- >>> parseUrlPiece "2015-10-03T14:55:01" :: Either Text LocalTime
476+-- Right 2015-10-03 14:55:01
477+instance FromHttpApiData LocalTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S"
478+
479+-- |
480+-- >>> parseUrlPiece "2015-10-03T14:55:01+0000" :: Either Text ZonedTime
481+-- Right 2015-10-03 14:55:01 +0000
482+instance FromHttpApiData ZonedTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S%z"
483+
484+-- |
485+-- >>> parseUrlPiece "2015-10-03T00:14:24Z" :: Either Text UTCTime
486+-- Right 2015-10-03 00:14:24 UTC
487+instance FromHttpApiData UTCTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%SZ"
488+
489+instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap fromInteger . parseUrlPiece
490+
448491instance FromHttpApiData All where parseUrlPiece = fmap All . parseUrlPiece
449492instance FromHttpApiData Any where parseUrlPiece = fmap Any . parseUrlPiece
450493
http-api-data.cabal+1
@@ -25,6 +25,7 @@ library
2525 , text >= 0.5
2626 , bytestring
2727 , time
28+ , time-locale-compat
2829 if flag(use-text-show)
2930 cpp-options: -DUSE_TEXT_SHOW
3031 build-depends: text-show >= 2
test/Spec.hs+23
@@ -27,6 +27,25 @@ instance Arbitrary L.Text where
2727instance Arbitrary Day where
2828 arbitrary = liftA3 fromGregorian (fmap abs arbitrary) arbitrary arbitrary
2929
30+instance Arbitrary LocalTime where
31+ arbitrary = LocalTime
32+ <$> arbitrary
33+ <*> liftA3 TimeOfDay (choose (0, 23)) (choose (0, 59)) (fromInteger <$> choose (0, 60))
34+
35+instance Eq ZonedTime where
36+ ZonedTime t (TimeZone x _ _) == ZonedTime t' (TimeZone y _ _) = t == t' && x == y
37+
38+instance Arbitrary ZonedTime where
39+ arbitrary = ZonedTime
40+ <$> arbitrary
41+ <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z']))
42+
43+instance Arbitrary UTCTime where
44+ arbitrary = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))
45+
46+instance Arbitrary NominalDiffTime where
47+ arbitrary = fromInteger <$> arbitrary
48+
3049instance Arbitrary Version where
3150 arbitrary = (version . map abs) <$> nonempty
3251 where
@@ -89,6 +108,10 @@ spec = do
89108 checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"
90109 checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"
91110 checkUrlPiece (Proxy :: Proxy Day) "Day"
111+ checkUrlPiece (Proxy :: Proxy LocalTime) "LocalTime"
112+ checkUrlPiece (Proxy :: Proxy ZonedTime) "ZonedTime"
113+ checkUrlPiece (Proxy :: Proxy UTCTime) "UTCTime"
114+ checkUrlPiece (Proxy :: Proxy NominalDiffTime) "NominalDiffTime"
92115 checkUrlPiece (Proxy :: Proxy Version) "Version"
93116
94117 checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"