@@ -1,4 +1,4 @@
1−{-# LANGUAGE CPP, OverloadedStrings, RecordWildCards, ScopedTypeVariables #-}
1+{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-}
22
33import Control.Monad (forM)
44import Data.Aeson (eitherDecode)
@@ -22,15 +22,9 @@ import Data.Time
2222import Instances ()
2323import Types
2424import Encoders
25−import System.IO
26−import System.IO.Unsafe (unsafePerformIO)
2725import Data.Int
2826import qualified Data.Map as Map
29−
30−#if !MIN_VERSION_time(1,5,0)
31−import System.Locale (defaultTimeLocale, dateTimeFmt)
32−#endif
33−
27+import Properties.ZonedTime (zonedTimeToJSON)
3428
3529roundTripCamel :: String -> Assertion
3630roundTripCamel name = assertEqual "" name (camelFrom '_' $ camelTo '_' name)
@@ -72,71 +66,6 @@ toFromJSON x = case fromJSON . toJSON $ x of
7266 Error _ -> property False
7367 Success x' -> x === x'
7468
75−zonedTimeToJSON :: ZonedTime -> Bool
76−zonedTimeToJSON t = and $
77− toFromJSON' "%FT%T%QZ" t (clearTimeZone t) : -- (javascript new Date().toISOString())
78− toFromJSON' "%F %T%Q%z" t t : -- (postgres)
79− toFromJSON' "%F %T%Q %Z" t t : -- (time's Show format)
80− toFromJSON' "%FT%T%Q%z" t t :
81− toFromJSON' "%Y-%mT%T%Q" t (clearTimeZone . clearDay $ t) :
82− toFromJSON' "%Y-%mT%R" t (clearTimeZone . clearDay . clearSeconds $ t) :
83− toFromJSON' "%Y-%mT%T" t (clearTimeZone . clearDay $ t) :
84− toFromJSON' "%Y-%mT%T%QZ" t (clearTimeZone . clearDay $ t) :
85− toFromJSON' "%Y-%mT%T%Q%z" t (clearDay t) :
86− toFromJSON' "%YT%T%Q" t (clearTimeZone . clearMonth . clearDay $ t) :
87− toFromJSON' "%YT%R" t (clearTimeZone . clearMonth . clearDay . clearSeconds $ t) :
88− toFromJSON' "%YT%T" t (clearTimeZone . clearMonth . clearDay $ t) :
89− toFromJSON' "%YT%T%QZ" t (clearTimeZone . clearMonth . clearDay $ t) :
90− toFromJSON' "%YT%T%Q%z" t (clearMonth . clearDay $ t) :
91− toFromJSON' "%FT%T%Q" t (clearTimeZone t) :
92− toFromJSON' "%FT%R" t (clearTimeZone . clearSeconds $ t) :
93− toFromJSON' "%FT%T" t (clearTimeZone t) :
94− toFromJSON' (dateTimeFmt defaultTimeLocale) t t :
95− []
96− where
97− toJSON' :: String -> ZonedTime -> Value
98− toJSON' format = toJSON . formatTime defaultTimeLocale format
99−
100− toFromJSON' :: String -> ZonedTime -> ZonedTime -> Bool
101− toFromJSON' format t_ t_' = case fromJSON . toJSON' format $ t_ of
102− Error msg -> error' msg
103− Success t_'' -> if t_'' == t_' then True else error' (show t_'')
104− where
105− error' :: String -> Bool
106− error' msg = unsafePerformIO (hPutStrLn stderr . ("zonedTimeToJSON: " ++) $ show
107− (format, t_, toJSON' format t_, t_', msg))
108− `seq` False
109−
110−clearTimeZone :: ZonedTime -> ZonedTime
111−clearTimeZone t = t { zonedTimeZone = TimeZone 0 False "" }
112−
113−clearMonth :: ZonedTime -> ZonedTime
114−clearMonth = f
115− where
116− f zt = zt { zonedTimeToLocalTime = g $ zonedTimeToLocalTime zt }
117− g lt = lt { localDay = h $ localDay lt }
118−
119− h :: Day -> Day
120− h = maybe (error "clearMonth") id . parseTime defaultTimeLocale "%Y-%m-%d" . formatTime defaultTimeLocale "%Y-01-%d"
121−
122−clearDay :: ZonedTime -> ZonedTime
123−clearDay = f
124− where
125− f zt = zt { zonedTimeToLocalTime = g $ zonedTimeToLocalTime zt }
126− g lt = lt { localDay = h $ localDay lt }
127−
128− h :: Day -> Day
129− h = maybe (error "clearDay") id . parseTime defaultTimeLocale "%Y-%m-%d" . formatTime defaultTimeLocale "%Y-%m-01"
130−
131−clearSeconds :: ZonedTime -> ZonedTime
132−clearSeconds = f
133− where
134− f zt = zt { zonedTimeToLocalTime = g $ zonedTimeToLocalTime zt }
135− g lt = lt { localTimeOfDay = h $ localTimeOfDay lt }
136−
137− h :: TimeOfDay -> TimeOfDay
138− h = maybe (error "clearSeconds") id . parseTime defaultTimeLocale "%H:%M:%S" . formatTime defaultTimeLocale "%H:%M:00"
139−
14069modifyFailureProp :: String -> String -> Bool
14170modifyFailureProp orig added =
14271 result == Error (added ++ orig)