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