@@ -1,80 +0,0 @@
1−{-# LANGUAGE CPP, OverloadedStrings, RecordWildCards, ScopedTypeVariables #-}
2−
3−module Properties.ZonedTime (zonedTimeToJSON) where
4−
5−import Data.Aeson.Internal (IResult(..), formatError, ifromJSON)
6−import Data.Aeson.Types
7−import Data.Time
8−import Instances ()
9−import Test.Framework (Test, testGroup)
10−import Test.Framework.Providers.QuickCheck2 (testProperty)
11−import Test.QuickCheck ((===), Property)
12−import Types
13−
14−#if !MIN_VERSION_time(1,5,0)
15−import System.Locale (defaultTimeLocale, dateTimeFmt)
16−#endif
17−
18−zonedTimeToJSON :: Test
19−zonedTimeToJSON = testGroup "ZonedTime" [
20− test "%FT%T%QZ" clearTimeZone -- javascript new Date().toISOString()
21− , test "%F %T%Q%z" id -- postgres
22− , test "%F %T%Q %Z" id -- time's Show format
23− , test "%FT%T%Q%z" id
24− , test "%Y-%mT%T%Q" (clearTimeZone . clearDay)
25− , test "%Y-%mT%R" (clearTimeZone . clearDay . clearSeconds)
26− , test "%Y-%mT%T" (clearTimeZone . clearDay)
27− , test "%Y-%mT%T%QZ" (clearTimeZone . clearDay)
28− , test "%Y-%mT%T%Q%z" clearDay
29− , test "%YT%T%Q" (clearTimeZone . clearMonth . clearDay)
30− , test "%YT%R" (clearTimeZone . clearMonth . clearDay . clearSeconds)
31− , test "%YT%T" (clearTimeZone . clearMonth . clearDay)
32− , test "%YT%T%QZ" (clearTimeZone . clearMonth . clearDay)
33− , test "%YT%T%Q%z" (clearMonth . clearDay)
34− , test "%FT%T%Q" clearTimeZone
35− , test "%FT%R" (clearTimeZone . clearSeconds)
36− , test "%FT%T" clearTimeZone
37− , test (dateTimeFmt defaultTimeLocale) id
38− ]
39− where
40− toJSON' :: String -> ZonedTime -> Value
41− toJSON' format = toJSON . formatTime defaultTimeLocale format
42−
43− test :: String -> (ZonedTime -> ZonedTime) -> Test
44− test format f = testProperty format go
45− where
46− go :: ZonedTime -> Property
47− go t = case ifromJSON (toJSON' format t) of
48− IError path msg -> failure "fromJSON" (formatError path msg) t
49− ISuccess t' -> t' === f t
50−
51−clearTimeZone :: ZonedTime -> ZonedTime
52−clearTimeZone t = t { zonedTimeZone = TimeZone 0 False "" }
53−
54−clearMonth :: ZonedTime -> ZonedTime
55−clearMonth zt = zt { zonedTimeToLocalTime = g (zonedTimeToLocalTime zt) }
56− where
57− g lt = lt { localDay = h (localDay lt) }
58−
59− h :: Day -> Day
60− h = maybe (error "clearMonth") id . parseTime defaultTimeLocale "%Y-%m-%d" .
61− formatTime defaultTimeLocale "%Y-01-%d"
62−
63−clearDay :: ZonedTime -> ZonedTime
64−clearDay zt = zt { zonedTimeToLocalTime = g (zonedTimeToLocalTime zt) }
65− where
66− g lt = lt { localDay = h (localDay lt) }
67−
68− h :: Day -> Day
69− h = maybe (error "clearDay") id . parseTime defaultTimeLocale "%Y-%m-%d" .
70− formatTime defaultTimeLocale "%Y-%m-01"
71−
72−clearSeconds :: ZonedTime -> ZonedTime
73−clearSeconds zt = zt { zonedTimeToLocalTime = g (zonedTimeToLocalTime zt) }
74− where
75− g lt = lt { localTimeOfDay = h (localTimeOfDay lt) }
76−
77− h :: TimeOfDay -> TimeOfDay
78− h = maybe (error "clearSeconds") id .
79− parseTime defaultTimeLocale "%H:%M:%S" .
80− formatTime defaultTimeLocale "%H:%M:00"