1{-# OPTIONS -fno-warn-orphans #-}
2
3module Test.Format.ISO8601
4    ( testISO8601
5    ) where
6
7import Data.Ratio
8import Data.Time.Compat
9import Data.Time.Format.ISO8601.Compat
10import Test.Arbitrary ()
11import Test.QuickCheck.Property
12import Test.Tasty
13import Test.Tasty.HUnit
14import Test.Tasty.QuickCheck hiding (reason)
15import Test.TestUtil
16
17deriving instance Eq ZonedTime
18
19readShowProperty :: (Eq a, Show a) => Format a -> a -> Property
20readShowProperty fmt val =
21    case formatShowM fmt val of
22        Nothing -> property Discard
23        Just str -> let
24            found = formatParseM fmt str
25            expected = Just val
26            in property $
27               if expected == found
28                   then succeeded
29                   else failed {reason = show str ++ ": expected " ++ (show expected) ++ ", found " ++ (show found)}
30
31readBoth :: NameTest t => (FormatExtension -> t) -> [TestTree]
32readBoth fmts = [nameTest "extended" $ fmts ExtendedFormat, nameTest "basic" $ fmts BasicFormat]
33
34readShowProperties :: (Eq a, Show a, Arbitrary a) => (FormatExtension -> Format a) -> [TestTree]
35readShowProperties fmts = readBoth $ \fe -> readShowProperty $ fmts fe
36
37newtype Durational t =
38    MkDurational t
39
40instance Show t => Show (Durational t) where
41    show (MkDurational t) = show t
42
43instance Arbitrary (Durational CalendarDiffDays) where
44    arbitrary = do
45        mm <- choose (-10000, 10000)
46        dd <- choose (-40, 40)
47        return $ MkDurational $ CalendarDiffDays mm dd
48
49instance Arbitrary (Durational CalendarDiffTime) where
50    arbitrary = let
51        limit = 40 * 86400
52        picofactor = 10 ^ (12 :: Int)
53        in do
54               mm <- choose (-10000, 10000)
55               ss <- choose (negate limit * picofactor, limit * picofactor)
56               return $ MkDurational $ CalendarDiffTime mm $ fromRational $ ss % picofactor
57
58testReadShowFormat :: TestTree
59testReadShowFormat =
60    nameTest
61        "read-show format"
62        [ nameTest "calendarFormat" $ readShowProperties $ calendarFormat
63        , nameTest "yearMonthFormat" $ readShowProperty $ yearMonthFormat
64        , nameTest "yearFormat" $ readShowProperty $ yearFormat
65        , nameTest "centuryFormat" $ readShowProperty $ centuryFormat
66        , nameTest "expandedCalendarFormat" $ readShowProperties $ expandedCalendarFormat 6
67        , nameTest "expandedYearMonthFormat" $ readShowProperty $ expandedYearMonthFormat 6
68        , nameTest "expandedYearFormat" $ readShowProperty $ expandedYearFormat 6
69        , nameTest "expandedCenturyFormat" $ readShowProperty $ expandedCenturyFormat 4
70        , nameTest "ordinalDateFormat" $ readShowProperties $ ordinalDateFormat
71        , nameTest "expandedOrdinalDateFormat" $ readShowProperties $ expandedOrdinalDateFormat 6
72        , nameTest "weekDateFormat" $ readShowProperties $ weekDateFormat
73        , nameTest "yearWeekFormat" $ readShowProperties $ yearWeekFormat
74        , nameTest "expandedWeekDateFormat" $ readShowProperties $ expandedWeekDateFormat 6
75        , nameTest "expandedYearWeekFormat" $ readShowProperties $ expandedYearWeekFormat 6
76        , nameTest "timeOfDayFormat" $ readShowProperties $ timeOfDayFormat
77        , nameTest "hourMinuteFormat" $ readShowProperties $ hourMinuteFormat
78        , nameTest "hourFormat" $ readShowProperty $ hourFormat
79        , nameTest "withTimeDesignator" $ readShowProperties $ \fe -> withTimeDesignator $ timeOfDayFormat fe
80        , nameTest "withUTCDesignator" $ readShowProperties $ \fe -> withUTCDesignator $ timeOfDayFormat fe
81        , nameTest "timeOffsetFormat" $ readShowProperties $ timeOffsetFormat
82        , nameTest "timeOfDayAndOffsetFormat" $ readShowProperties $ timeOfDayAndOffsetFormat
83        , nameTest "localTimeFormat" $
84          readShowProperties $ \fe -> localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)
85        , nameTest "zonedTimeFormat" $
86          readShowProperties $ \fe -> zonedTimeFormat (calendarFormat fe) (timeOfDayFormat fe) fe
87        , nameTest "utcTimeFormat" $ readShowProperties $ \fe -> utcTimeFormat (calendarFormat fe) (timeOfDayFormat fe)
88        , nameTest "dayAndTimeFormat" $
89          readShowProperties $ \fe -> dayAndTimeFormat (calendarFormat fe) (timeOfDayFormat fe)
90        , nameTest "timeAndOffsetFormat" $ readShowProperties $ \fe -> timeAndOffsetFormat (timeOfDayFormat fe) fe
91        , nameTest "durationDaysFormat" $ readShowProperty $ durationDaysFormat
92        , nameTest "durationTimeFormat" $ readShowProperty $ durationTimeFormat
93        , nameTest "alternativeDurationDaysFormat" $
94          readBoth $ \fe (MkDurational t) -> readShowProperty (alternativeDurationDaysFormat fe) t
95        , nameTest "alternativeDurationTimeFormat" $
96          readBoth $ \fe (MkDurational t) -> readShowProperty (alternativeDurationTimeFormat fe) t
97        , nameTest "intervalFormat" $
98          readShowProperties $ \fe ->
99              intervalFormat (localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)) durationTimeFormat
100        , nameTest "recurringIntervalFormat" $
101          readShowProperties $ \fe ->
102              recurringIntervalFormat (localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)) durationTimeFormat
103        ]
104
105testShowFormat :: String -> Format t -> String -> t -> TestTree
106testShowFormat name fmt str t = nameTest (name ++ ": " ++ str) $ assertEqual "" (Just str) $ formatShowM fmt t
107
108testShowFormats :: TestTree
109testShowFormats =
110    nameTest
111        "show format"
112        [ testShowFormat "durationDaysFormat" durationDaysFormat "P0D" $ CalendarDiffDays 0 0
113        , testShowFormat "durationDaysFormat" durationDaysFormat "P4Y" $ CalendarDiffDays 48 0
114        , testShowFormat "durationDaysFormat" durationDaysFormat "P7M" $ CalendarDiffDays 7 0
115        , testShowFormat "durationDaysFormat" durationDaysFormat "P5D" $ CalendarDiffDays 0 5
116        , testShowFormat "durationDaysFormat" durationDaysFormat "P2Y3M81D" $ CalendarDiffDays 27 81
117        , testShowFormat "durationTimeFormat" durationTimeFormat "P0D" $ CalendarDiffTime 0 0
118        , testShowFormat "durationTimeFormat" durationTimeFormat "P4Y" $ CalendarDiffTime 48 0
119        , testShowFormat "durationTimeFormat" durationTimeFormat "P7M" $ CalendarDiffTime 7 0
120        , testShowFormat "durationTimeFormat" durationTimeFormat "P5D" $ CalendarDiffTime 0 $ 5 * nominalDay
121        , testShowFormat "durationTimeFormat" durationTimeFormat "P2Y3M81D" $ CalendarDiffTime 27 $ 81 * nominalDay
122        , testShowFormat "durationTimeFormat" durationTimeFormat "PT2H" $ CalendarDiffTime 0 $ 7200
123        , testShowFormat "durationTimeFormat" durationTimeFormat "PT3M" $ CalendarDiffTime 0 $ 180
124        , testShowFormat "durationTimeFormat" durationTimeFormat "PT12S" $ CalendarDiffTime 0 $ 12
125        , testShowFormat "durationTimeFormat" durationTimeFormat "PT1M18.77634S" $ CalendarDiffTime 0 $ 78.77634
126        , testShowFormat "durationTimeFormat" durationTimeFormat "PT2H1M18.77634S" $ CalendarDiffTime 0 $ 7278.77634
127        , testShowFormat "durationTimeFormat" durationTimeFormat "P5DT2H1M18.77634S" $
128          CalendarDiffTime 0 $ 5 * nominalDay + 7278.77634
129        , testShowFormat "durationTimeFormat" durationTimeFormat "P7Y10M5DT2H1M18.77634S" $
130          CalendarDiffTime 94 $ 5 * nominalDay + 7278.77634
131        , testShowFormat "durationTimeFormat" durationTimeFormat "P7Y10MT2H1M18.77634S" $
132          CalendarDiffTime 94 $ 7278.77634
133        , testShowFormat "durationTimeFormat" durationTimeFormat "P8YT2H1M18.77634S" $ CalendarDiffTime 96 $ 7278.77634
134        , testShowFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0001-00-00" $
135          CalendarDiffDays 12 0
136        , testShowFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0002-03-29" $
137          CalendarDiffDays 27 29
138        , testShowFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0561-08-29" $
139          CalendarDiffDays (561 * 12 + 8) 29
140        , testShowFormat
141              "alternativeDurationTimeFormat"
142              (alternativeDurationTimeFormat ExtendedFormat)
143              "P0000-00-01T00:00:00" $
144          CalendarDiffTime 0 86400
145        , testShowFormat
146              "alternativeDurationTimeFormat"
147              (alternativeDurationTimeFormat ExtendedFormat)
148              "P0007-10-05T02:01:18.77634" $
149          CalendarDiffTime 94 $ 5 * nominalDay + 7278.77634
150        , testShowFormat
151              "alternativeDurationTimeFormat"
152              (alternativeDurationTimeFormat ExtendedFormat)
153              "P4271-10-05T02:01:18.77634" $
154          CalendarDiffTime (12 * 4271 + 10) $ 5 * nominalDay + 7278.77634
155        , testShowFormat "centuryFormat" centuryFormat "02" 2
156        , testShowFormat "centuryFormat" centuryFormat "21" 21
157        , testShowFormat
158              "intervalFormat etc."
159              (intervalFormat
160                   (localTimeFormat (calendarFormat ExtendedFormat) (timeOfDayFormat ExtendedFormat))
161                   durationTimeFormat)
162              "2015-06-13T21:13:56/P1Y2M7DT5H33M2.34S"
163              ( LocalTime (fromGregorian 2015 6 13) (TimeOfDay 21 13 56)
164              , CalendarDiffTime 14 $ 7 * nominalDay + 5 * 3600 + 33 * 60 + 2.34)
165        , testShowFormat
166              "recurringIntervalFormat etc."
167              (recurringIntervalFormat
168                   (localTimeFormat (calendarFormat ExtendedFormat) (timeOfDayFormat ExtendedFormat))
169                   durationTimeFormat)
170              "R74/2015-06-13T21:13:56/P1Y2M7DT5H33M2.34S"
171              ( 74
172              , LocalTime (fromGregorian 2015 6 13) (TimeOfDay 21 13 56)
173              , CalendarDiffTime 14 $ 7 * nominalDay + 5 * 3600 + 33 * 60 + 2.34)
174        , testShowFormat
175              "recurringIntervalFormat etc."
176              (recurringIntervalFormat (calendarFormat ExtendedFormat) durationDaysFormat)
177              "R74/2015-06-13/P1Y2M7D"
178              (74, fromGregorian 2015 6 13, CalendarDiffDays 14 7)
179        , testShowFormat "timeOffsetFormat" iso8601Format "-06:30" (minutesToTimeZone (-390))
180        , testShowFormat "timeOffsetFormat" iso8601Format "+00:00" (minutesToTimeZone 0)
181        , testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+0000" (minutesToTimeZone 0)
182        , testShowFormat "timeOffsetFormat" iso8601Format "+00:10" (minutesToTimeZone 10)
183        , testShowFormat "timeOffsetFormat" iso8601Format "-00:10" (minutesToTimeZone (-10))
184        , testShowFormat "timeOffsetFormat" iso8601Format "+01:35" (minutesToTimeZone 95)
185        , testShowFormat "timeOffsetFormat" iso8601Format "-01:35" (minutesToTimeZone (-95))
186        , testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+0135" (minutesToTimeZone 95)
187        , testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "-0135" (minutesToTimeZone (-95))
188        , testShowFormat
189              "timeOffsetFormat"
190              (timeOffsetFormat BasicFormat)
191              "-1100"
192              (minutesToTimeZone $ negate $ 11 * 60)
193        , testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+1015" (minutesToTimeZone $ 615)
194        , testShowFormat
195              "zonedTimeFormat"
196              iso8601Format
197              "2024-07-06T08:45:56.553-06:30"
198              (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone (-390)))
199        , testShowFormat
200              "zonedTimeFormat"
201              iso8601Format
202              "2024-07-06T08:45:56.553+06:30"
203              (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone 390))
204        , testShowFormat
205              "utcTimeFormat"
206              iso8601Format
207              "2024-07-06T08:45:56.553Z"
208              (UTCTime (fromGregorian 2024 07 06) (timeOfDayToTime $ TimeOfDay 8 45 56.553))
209        , testShowFormat
210              "utcTimeFormat"
211              iso8601Format
212              "2028-12-31T23:59:60.9Z"
213              (UTCTime (fromGregorian 2028 12 31) (timeOfDayToTime $ TimeOfDay 23 59 60.9))
214        , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1994-W52-7" (fromGregorian 1995 1 1)
215        , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1995-W01-1" (fromGregorian 1995 1 2)
216        , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1996-W52-7" (fromGregorian 1996 12 29)
217        , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1997-W01-2" (fromGregorian 1996 12 31)
218        , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1997-W01-3" (fromGregorian 1997 1 1)
219        , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1974-W32-6" (fromGregorian 1974 8 10)
220        , testShowFormat "weekDateFormat" (weekDateFormat BasicFormat) "1974W326" (fromGregorian 1974 8 10)
221        , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1995-W05-6" (fromGregorian 1995 2 4)
222        , testShowFormat "weekDateFormat" (weekDateFormat BasicFormat) "1995W056" (fromGregorian 1995 2 4)
223        , testShowFormat
224              "weekDateFormat"
225              (expandedWeekDateFormat 6 ExtendedFormat)
226              "+001995-W05-6"
227              (fromGregorian 1995 2 4)
228        , testShowFormat "weekDateFormat" (expandedWeekDateFormat 6 BasicFormat) "+001995W056" (fromGregorian 1995 2 4)
229        , testShowFormat "ordinalDateFormat" (ordinalDateFormat ExtendedFormat) "1846-235" (fromGregorian 1846 8 23)
230        , testShowFormat "ordinalDateFormat" (ordinalDateFormat BasicFormat) "1844236" (fromGregorian 1844 8 23)
231        , testShowFormat
232              "ordinalDateFormat"
233              (expandedOrdinalDateFormat 5 ExtendedFormat)
234              "+01846-235"
235              (fromGregorian 1846 8 23)
236        , testShowFormat "hourMinuteFormat" (hourMinuteFormat ExtendedFormat) "13:17.25" (TimeOfDay 13 17 15)
237        , testShowFormat "hourMinuteFormat" (hourMinuteFormat ExtendedFormat) "01:12.4" (TimeOfDay 1 12 24)
238        , testShowFormat "hourMinuteFormat" (hourMinuteFormat BasicFormat) "1317.25" (TimeOfDay 13 17 15)
239        , testShowFormat "hourMinuteFormat" (hourMinuteFormat BasicFormat) "0112.4" (TimeOfDay 1 12 24)
240        , testShowFormat "hourFormat" hourFormat "22" (TimeOfDay 22 0 0)
241        , testShowFormat "hourFormat" hourFormat "06" (TimeOfDay 6 0 0)
242        , testShowFormat "hourFormat" hourFormat "18.9475" (TimeOfDay 18 56 51)
243        ]
244
245testISO8601 :: TestTree
246testISO8601 = nameTest "ISO8601" [testShowFormats, testReadShowFormat]
247