diff --git a/Data/Time/Format/Parse.hs b/Data/Time/Format/Parse.hs index aaf70294bec5fa65e5b80817b640c8a2bb29bad3..afbceefc1e945e25b92736d39baffe52640f0aa7 100644 --- a/Data/Time/Format/Parse.hs +++ b/Data/Time/Format/Parse.hs @@ -77,9 +77,9 @@ parseTime :: ParseTime t => -> String -- ^ Input string. -> Maybe t -- ^ The time value, or 'Nothing' if the input could -- not be parsed using the given format. -parseTime l fmt s = case readsTime l fmt s of - [(t,r)] | all isSpace r -> Just t - _ -> Nothing +parseTime l fmt s = case goodReadsTime l fmt s of + [t] -> Just t + _ -> Nothing -- | Parse a time value given a format string. Fails if the input could -- not be parsed using the given format. See 'parseTime' for details. @@ -88,10 +88,17 @@ readTime :: ParseTime t => -> String -- ^ Format string. -> String -- ^ Input string. -> t -- ^ The time value. -readTime l fmt s = case readsTime l fmt s of - [(t,r)] | all isSpace r -> t - [(_,x)] -> error $ "readTime: junk at end of " ++ show x - _ -> error $ "readsTime: bad input " ++ show s +readTime l fmt s = case goodReadsTime l fmt s of + [t] -> t + [] -> error $ "readTime: no parse of " ++ show s + _ -> error $ "readTime: multiple parses of " ++ show s + +goodReadsTime :: ParseTime t => + TimeLocale -- ^ Time locale. + -> String -- ^ Format string + -> String -- ^ Input string. + -> [t] +goodReadsTime l fmt s = [t | (t,r) <- readsTime l fmt s, all isSpace r] -- | Parse a time value given a format string. See 'parseTime' for details. readsTime :: ParseTime t => @@ -137,63 +144,99 @@ parseFormat l = p pc mpad c = [Value mpad c] parseInput :: TimeLocale -> DateFormat -> ReadP [(Char,String)] -parseInput l = liftM catMaybes . mapM p - where p (Value mpad c) = parseValue l mpad c >>= return . Just . (,) c - p WhiteSpace = skipSpaces >> return Nothing - p (Literal c) = char c >> return Nothing +parseInput _ [] = return [] +parseInput l (Value mpad c:ff) = do + s <- parseValue l mpad c + r <- parseInput l ff + return ((c,s):r) +parseInput l (Literal c:ff) = do + _ <- char c + parseInput l ff +parseInput l (WhiteSpace:ff) = do + _ <- satisfy isSpace + case ff of + (WhiteSpace:_) -> return () + _ -> skipSpaces + parseInput l ff -- | Get the string corresponding to the given format specifier. parseValue :: TimeLocale -> Maybe Padding -> Char -> ReadP String parseValue l mpad c = case c of - 'z' -> numericTZ - 'Z' -> munch1 isAlpha <++ - numericTZ <++ - return "" -- produced by %Z for LocalTime - 'P' -> oneOf (let (am,pm) = amPm l in [am, pm]) - 'p' -> oneOf (let (am,pm) = amPm l in [am, pm]) - 'H' -> digits ZeroPadding 2 - 'I' -> digits ZeroPadding 2 - 'k' -> digits SpacePadding 2 - 'l' -> digits SpacePadding 2 - 'M' -> digits ZeroPadding 2 - 'S' -> digits ZeroPadding 2 - 'q' -> digits ZeroPadding 12 - 'Q' -> liftM2 (:) (char '.') (munch isDigit) <++ return "" - 's' -> (char '-' >> liftM ('-':) (munch1 isDigit)) - <++ munch1 isDigit - 'Y' -> digits ZeroPadding 4 + -- century + 'C' -> digits SpacePadding 2 + 'f' -> digits SpacePadding 2 + + -- year + 'Y' -> digits SpacePadding 4 + 'G' -> digits SpacePadding 4 + + -- year of century 'y' -> digits ZeroPadding 2 - 'C' -> digits ZeroPadding 2 + 'g' -> digits ZeroPadding 2 + + -- month of year 'B' -> oneOf (map fst (months l)) 'b' -> oneOf (map snd (months l)) 'm' -> digits ZeroPadding 2 + + -- day of month 'd' -> digits ZeroPadding 2 'e' -> digits SpacePadding 2 - 'j' -> digits ZeroPadding 3 - 'G' -> digits ZeroPadding 4 - 'g' -> digits ZeroPadding 2 - 'f' -> digits ZeroPadding 2 + + -- week of year 'V' -> digits ZeroPadding 2 + 'U' -> digits ZeroPadding 2 + 'W' -> digits ZeroPadding 2 + + -- day of week 'u' -> oneOf $ map (:[]) ['1'..'7'] 'a' -> oneOf (map snd (wDays l)) 'A' -> oneOf (map fst (wDays l)) - 'U' -> digits ZeroPadding 2 'w' -> oneOf $ map (:[]) ['0'..'6'] - 'W' -> digits ZeroPadding 2 + + -- day of year + 'j' -> digits ZeroPadding 3 + + -- dayhalf of day (i.e. AM or PM) + 'P' -> oneOf (let (am,pm) = amPm l in [am, pm]) + 'p' -> oneOf (let (am,pm) = amPm l in [am, pm]) + + -- hour of day (i.e. 24h) + 'H' -> digits ZeroPadding 2 + 'k' -> digits SpacePadding 2 + + -- hour of dayhalf (i.e. 12h) + 'I' -> digits ZeroPadding 2 + 'l' -> digits SpacePadding 2 + + -- minute of hour + 'M' -> digits ZeroPadding 2 + + -- second of minute + 'S' -> digits ZeroPadding 2 + + -- picosecond of second + 'q' -> digits ZeroPadding 12 + 'Q' -> liftM2 (:) (char '.') (munch isDigit) <++ return "" + + -- time zone + 'z' -> numericTZ + 'Z' -> munch1 isAlpha <++ + numericTZ <++ + return "" -- produced by %Z for LocalTime + + -- seconds since epoch + 's' -> (char '-' >> liftM ('-':) (munch1 isDigit)) + <++ munch1 isDigit + _ -> fail $ "Unknown format character: " ++ show c where oneOf = choice . map string digitsforce ZeroPadding n = count n (satisfy isDigit) - digitsforce SpacePadding n = skipSpaces >> oneUpTo n (satisfy isDigit) - digitsforce NoPadding n = oneUpTo n (satisfy isDigit) + digitsforce SpacePadding _n = skipSpaces >> many1 (satisfy isDigit) + digitsforce NoPadding _n = many1 (satisfy isDigit) digits pad = digitsforce (fromMaybe pad mpad) - oneUpTo :: Int -> ReadP a -> ReadP [a] - oneUpTo 0 _ = pfail - oneUpTo n x = liftM2 (:) x (upTo (n-1) x) - upTo :: Int -> ReadP a -> ReadP [a] - upTo 0 _ = return [] - upTo n x = (oneUpTo n x) <++ return [] numericTZ = do s <- choice [char '+', char '-'] h <- digitsforce ZeroPadding 2 optional (char ':') @@ -205,13 +248,13 @@ parseValue l mpad c = -- * Instances for the time package types -- -data DayComponent = Year Integer -- 0-99, last two digits of both real years and week years - | Century Integer -- century of all years - | Month Int -- 1-12 - | Day Int -- 1-31 +data DayComponent = Century Integer -- century of all years + | CenturyYear Integer -- 0-99, last two digits of both real years and week years + | YearMonth Int -- 1-12 + | MonthDay Int -- 1-31 | YearDay Int -- 1-366 | WeekDay Int -- 1-7 (mon-sun) - | Week WeekType Int -- 1-53 or 0-53 + | YearWeek WeekType Int -- 1-53 or 0-53 data WeekType = ISOWeek | SundayWeek | MondayWeek @@ -221,31 +264,31 @@ instance ParseTime Day where f c x = case c of -- %Y: year - 'Y' -> let y = read x in [Century (y `div` 100), Year (y `mod` 100)] + 'Y' -> let y = read x in [Century (y `div` 100), CenturyYear (y `mod` 100)] -- %y: last two digits of year, 00 - 99 - 'y' -> [Year (read x)] - -- %C: century (being the first two digits of the year), 00 - 99 + 'y' -> [CenturyYear (read x)] + -- %C: century (all but the last two digits of the year), 00 - 99 'C' -> [Century (read x)] -- %B: month name, long form (fst from months locale), January - December - 'B' -> [Month (1 + fromJust (elemIndex (up x) (map (up . fst) (months l))))] + 'B' -> [YearMonth (1 + fromJust (elemIndex (up x) (map (up . fst) (months l))))] -- %b: month name, short form (snd from months locale), Jan - Dec - 'b' -> [Month (1 + fromJust (elemIndex (up x) (map (up . snd) (months l))))] + 'b' -> [YearMonth (1 + fromJust (elemIndex (up x) (map (up . snd) (months l))))] -- %m: month of year, leading 0 as needed, 01 - 12 - 'm' -> [Month (read x)] + 'm' -> [YearMonth (read x)] -- %d: day of month, leading 0 as needed, 01 - 31 - 'd' -> [Day (read x)] + 'd' -> [MonthDay (read x)] -- %e: day of month, leading space as needed, 1 - 31 - 'e' -> [Day (read x)] + 'e' -> [MonthDay (read x)] -- %j: day of year for Ordinal Date format, 001 - 366 'j' -> [YearDay (read x)] -- %G: year for Week Date format - 'G' -> let y = read x in [Century (y `div` 100), Year (y `mod` 100)] + 'G' -> let y = read x in [Century (y `div` 100), CenturyYear (y `mod` 100)] -- %g: last two digits of year for Week Date format, 00 - 99 - 'g' -> [Year (read x)] - -- %f century (first two digits of year) for Week Date format, 00 - 99 + 'g' -> [CenturyYear (read x)] + -- %f century (all but the last two digits of the year), 00 - 99 'f' -> [Century (read x)] -- %V: week for Week Date format, 01 - 53 - 'V' -> [Week ISOWeek (read x)] + 'V' -> [YearWeek ISOWeek (read x)] -- %u: day for Week Date format, 1 - 7 'u' -> [WeekDay (read x)] -- %a: day of week, short form (snd from wDays locale), Sun - Sat @@ -253,30 +296,30 @@ instance ParseTime Day where -- %A: day of week, long form (fst from wDays locale), Sunday - Saturday 'A' -> [WeekDay (1 + (fromJust (elemIndex (up x) (map (up . fst) (wDays l))) + 6) `mod` 7)] -- %U: week number of year, where weeks start on Sunday (as sundayStartWeek), 01 - 53 - 'U' -> [Week SundayWeek (read x)] + 'U' -> [YearWeek SundayWeek (read x)] -- %w: day of week number, 0 (= Sunday) - 6 (= Saturday) 'w' -> [WeekDay (((read x + 6) `mod` 7) + 1)] -- %W: week number of year, where weeks start on Monday (as mondayStartWeek), 01 - 53 - 'W' -> [Week MondayWeek (read x)] + 'W' -> [YearWeek MondayWeek (read x)] _ -> [] buildDay cs = rest cs where y = let - d = safeLast 70 [x | Year x <- cs] + d = safeLast 70 [x | CenturyYear x <- cs] c = safeLast (if d >= 69 then 19 else 20) [x | Century x <- cs] in 100 * c + d - rest (Month m:_) = let d = safeLast 1 [x | Day x <- cs] + rest (YearMonth m:_) = let d = safeLast 1 [x | MonthDay x <- cs] in fromGregorian y m d rest (YearDay d:_) = fromOrdinalDate y d - rest (Week wt w:_) = let d = safeLast 4 [x | WeekDay x <- cs] + rest (YearWeek wt w:_) = let d = safeLast 4 [x | WeekDay x <- cs] in case wt of ISOWeek -> fromWeekDate y w d SundayWeek -> fromSundayStartWeek y w (d `mod` 7) MondayWeek -> fromMondayStartWeek y w d rest (_:xs) = rest xs - rest [] = rest [Month 1] + rest [] = rest [YearMonth 1] safeLast x xs = last (x:xs) @@ -373,6 +416,7 @@ readTzOffset str = h = read [h1,h2] m = read [m1,m2] +-- Dubious _TIMEZONES_ :: [(String, (Int, Bool))] _TIMEZONES_ = -- New Zealand Daylight-Saving Time diff --git a/Test/AddDaysRef.hs b/Test/AddDaysRef.hs index 333bd7a8d3a3b1a1a0a79b7d4e2947b6eb731c17..570a617f3e5df889c3c464d79ce5ce4e14f98191 100644 --- a/Test/AddDaysRef.hs +++ b/Test/AddDaysRef.hs @@ -1,5 +1,6 @@ module Test.AddDaysRef where +addDaysRef :: String addDaysRef = unlines [ "2005-02-28 + -10 * day = 2005-02-18" diff --git a/Test/ClipDatesRef.hs b/Test/ClipDatesRef.hs index 30547b55ed6bc6e83a79bba286e843e8bc164aae..5416b9596286ceac0a023a20357d4b99168c54f1 100644 --- a/Test/ClipDatesRef.hs +++ b/Test/ClipDatesRef.hs @@ -1,5 +1,6 @@ module Test.ClipDatesRef where +clipDatesRef :: String clipDatesRef = unlines [ "YearAndDay" diff --git a/Test/LongWeekYearsRef.hs b/Test/LongWeekYearsRef.hs index 0b111ac6476e3207a46da372b06f89b11ae95406..aebd2cf68068de1af13321de2f9bfefd4fe695f0 100644 --- a/Test/LongWeekYearsRef.hs +++ b/Test/LongWeekYearsRef.hs @@ -1,5 +1,6 @@ module Test.LongWeekYearsRef where +longWeekYearsRef :: String longWeekYearsRef = unlines [ "1901: " diff --git a/Test/TAI_UTC_DAT.hs b/Test/TAI_UTC_DAT.hs index b7ccd8dfeb0d2d768735d516790625cc9ced0532..38bdcd1d8f622b40e6c0e20025ab82bb2795286c 100644 --- a/Test/TAI_UTC_DAT.hs +++ b/Test/TAI_UTC_DAT.hs @@ -1,5 +1,6 @@ module Test.TAI_UTC_DAT where +taiUTC_DAT :: String taiUTC_DAT = unlines [ "1961 JAN 1 =JD 2437300.5 TAI-UTC= 1.4228180 S + (MJD - 37300.) X 0.001296 S" diff --git a/Test/TestCalendarsRef.hs b/Test/TestCalendarsRef.hs index c71bc031c923f908a6efe21fad97633ddfee93f1..c4c22cafb07e9597a2814593ab6d606170e666a0 100644 --- a/Test/TestCalendarsRef.hs +++ b/Test/TestCalendarsRef.hs @@ -1,5 +1,6 @@ module Test.TestCalendarsRef where +testCalendarsRef :: String testCalendarsRef = unlines [ " == MJD -678576 == Gregorian 0000-12-31 == Julian 0001-01-02 == ISO 8601 0000-W52-7" diff --git a/Test/TestEasterRef.hs b/Test/TestEasterRef.hs index 04af69440cee63e3d21df5c01693cd0d3361d143..c086623f6a198f592c5c72a2a2870e3df20bcc0c 100644 --- a/Test/TestEasterRef.hs +++ b/Test/TestEasterRef.hs @@ -1,5 +1,6 @@ module Test.TestEasterRef where +testEasterRef :: String testEasterRef = unlines [ "2003-12-27 Saturday -> 2003-12-28 Sunday" diff --git a/Test/TestMonthDayRef.hs b/Test/TestMonthDayRef.hs index 9d8393aae53b2e3e87ebdb50398e6c01bfa7f92b..de5e6934d2a33e19b1f3b89d3f3ca2fe183c7b5b 100644 --- a/Test/TestMonthDayRef.hs +++ b/Test/TestMonthDayRef.hs @@ -1,5 +1,6 @@ module Test.TestMonthDayRef where +testMonthDayRef :: String testMonthDayRef = unlines [ "Regular:" diff --git a/Test/TestParseDAT_Ref.hs b/Test/TestParseDAT_Ref.hs index 8713e04b94d54ac71fb732927569694a2c892a87..acc292902bc59c2256ab15a2c5b8ad2b8da303c0 100644 --- a/Test/TestParseDAT_Ref.hs +++ b/Test/TestParseDAT_Ref.hs @@ -1,5 +1,6 @@ module Test.TestParseDAT_Ref where +testParseDAT_Ref :: String testParseDAT_Ref = unlines [ "1998-04-02 00:00:00 UTC == 1998-04-02 00:00:31 TAI" diff --git a/Test/TestParseTime.hs b/Test/TestParseTime.hs index fa7b2415b79237ade261f7624d262192cf46432e..5cc13d3a6ffc218aa685caccd0d9cc539af01c35 100644 --- a/Test/TestParseTime.hs +++ b/Test/TestParseTime.hs @@ -22,40 +22,48 @@ type NamedProperty = (String, Property) testParseTime :: Test testParseTime = testGroup "testParseTime" [ - testGroup "extests" (fmap exhaustiveTestInstances extests), + testGroup "extests" extests, testGroup "properties" (fmap (\(n,prop) -> testProperty n prop) properties) ] yearDays :: Integer -> [Day] yearDays y = [(fromGregorian y 1 1) .. (fromGregorian y 12 31)] -extests :: [ExhaustiveTest] +makeExhaustiveTest :: String -> [t] -> (t -> Test) -> Test +makeExhaustiveTest name cases f = testGroup name (fmap f cases) + +extests :: [Test] extests = [ - MkExhaustiveTest "parse %y" [0..99] parseYY, - MkExhaustiveTest "parse %C %y 1900s" [0..99] (parseCYY 19), - MkExhaustiveTest "parse %C %y 2000s" [0..99] (parseCYY 20), - MkExhaustiveTest "parse %C %y 1400s" [0..99] (parseCYY 14), - MkExhaustiveTest "parse %C %y 700s" [0..99] (parseCYY2 7), - MkExhaustiveTest "parse %C %y 700s" [0..99] (parseCYY 7) + makeExhaustiveTest "parse %y" [0..99] parseYY, + makeExhaustiveTest "parse %-C %y 1900s" [0,1,50,99] (parseCYY 19), + makeExhaustiveTest "parse %-C %y 2000s" [0,1,50,99] (parseCYY 20), + makeExhaustiveTest "parse %-C %y 1400s" [0,1,50,99] (parseCYY 14), + makeExhaustiveTest "parse %C %y 0700s" [0,1,50,99] (parseCYY2 7), + makeExhaustiveTest "parse %-C %y 700s" [0,1,50,99] (parseCYY 7), + makeExhaustiveTest "parse %-C %y 10000s" [0,1,50,99] (parseCYY 100), + makeExhaustiveTest "parse %-C centuries" [20..100] (parseCentury " "), + makeExhaustiveTest "parse %-C century X" [1,10,20,100] (parseCentury "X"), + makeExhaustiveTest "parse %-C century 2sp" [1,10,20,100] (parseCentury " "), + makeExhaustiveTest "parse %-C century 5sp" [1,10,20,100] (parseCentury " ") ] ++ (concat $ fmap (\y -> [ - (MkExhaustiveTest "parse %Y%m%d" (yearDays y) parseYMD), - (MkExhaustiveTest "parse %Y %m %d" (yearDays y) parseYearDayD), - (MkExhaustiveTest "parse %Y %-m %e" (yearDays y) parseYearDayE) - ]) [1,20,753,2000,2011,10001]) + (makeExhaustiveTest "parse %Y%m%d" (yearDays y) parseYMD), + (makeExhaustiveTest "parse %Y %m %d" (yearDays y) parseYearDayD), + (makeExhaustiveTest "parse %Y %-m %e" (yearDays y) parseYearDayE) + ]) [1,4,20,753,2000,2011,10001]) -parseYMD :: Day -> IO Result +parseYMD :: Day -> Test parseYMD day = case toGregorian day of - (y,m,d) -> return $ diff (Just day) (parse "%Y%m%d" ((show y) ++ (show2 m) ++ (show2 d))) + (y,m,d) -> parseTest (Just day) "%Y%m%d" ((show y) ++ (show2 m) ++ (show2 d)) -parseYearDayD :: Day -> IO Result +parseYearDayD :: Day -> Test parseYearDayD day = case toGregorian day of - (y,m,d) -> return $ diff (Just day) (parse "%Y %m %d" ((show y) ++ " " ++ (show2 m) ++ " " ++ (show2 d))) + (y,m,d) -> parseTest (Just day) "%Y %m %d" ((show y) ++ " " ++ (show2 m) ++ " " ++ (show2 d)) -parseYearDayE :: Day -> IO Result +parseYearDayE :: Day -> Test parseYearDayE day = case toGregorian day of - (y,m,d) -> return $ diff (Just day) (parse "%Y %-m %e" ((show y) ++ " " ++ (show m) ++ " " ++ (show d))) + (y,m,d) -> parseTest (Just day) "%Y %-m %e" ((show y) ++ " " ++ (show m) ++ " " ++ (show d)) -- | 1969 - 2068 expectedYear :: Integer -> Integer @@ -65,14 +73,35 @@ expectedYear i = 2000 + i show2 :: (Show n,Integral n) => n -> String show2 i = (show (div i 10)) ++ (show (mod i 10)) -parseYY :: Integer -> IO Result -parseYY i = return $ diff (Just (fromGregorian (expectedYear i) 1 1)) (parse "%y" (show2 i)) +parseYY :: Integer -> Test +parseYY i = parseTest (Just (fromGregorian (expectedYear i) 1 1)) "%y" (show2 i) + +parseCYY :: Integer -> Integer -> Test +parseCYY c i = parseTest (Just (fromGregorian ((c * 100) + i) 1 1)) "%-C %y" ((show c) ++ " " ++ (show2 i)) + +parseCYY2 :: Integer -> Integer -> Test +parseCYY2 c i = parseTest (Just (fromGregorian ((c * 100) + i) 1 1)) "%C %y" ((show2 c) ++ " " ++ (show2 i)) + +parseCentury :: String -> Integer -> Test +parseCentury int c = parseTest (Just (fromGregorian (c * 100) 1 1)) ("%-C" ++ int ++ "%y") ((show c) ++ int ++ "00") -parseCYY :: Integer -> Integer -> IO Result -parseCYY c i = return $ diff (Just (fromGregorian ((c * 100) + i) 1 1)) (parse "%C %y" ((show c) ++ " " ++ (show2 i))) +parseTest :: (Show t, Eq t, ParseTime t) => Maybe t -> String -> String -> Test +parseTest expected formatStr target = + let + found = parse formatStr target + result = diff expected found + name = (show formatStr) ++ " of " ++ (show target) + in pureTest name result -parseCYY2 :: Integer -> Integer -> IO Result -parseCYY2 c i = return $ diff (Just (fromGregorian ((c * 100) + i) 1 1)) (parse "%C %y" ((show2 c) ++ " " ++ (show2 i))) +readsTest :: (Show t, Eq t, ParseTime t) => Maybe t -> String -> String -> Test +readsTest expected formatStr target = + let + ff (Just e) = [(e,"")] + ff Nothing = [] + found = readsTime defaultTimeLocale formatStr target + result = diff (ff expected) found + name = (show formatStr) ++ " of " ++ (show target) + in pureTest name result parse :: ParseTime t => String -> String -> Maybe t parse f t = parseTime defaultTimeLocale f t @@ -370,10 +399,7 @@ partialTimeOfDayFormats = map FormatString partialLocalTimeFormats :: [FormatString LocalTime] partialLocalTimeFormats = map FormatString - [ - -- %c does not include second decimals - "%c" - ] + [ ] partialZonedTimeFormats :: [FormatString ZonedTime] partialZonedTimeFormats = map FormatString diff --git a/Test/TestTimeRef.hs b/Test/TestTimeRef.hs index 68c2080856d87ce6317babf558bb78a6744dc76a..f9a46a8eeabe37c8e31ca66ef9f63c6dbeedd4c8 100644 --- a/Test/TestTimeRef.hs +++ b/Test/TestTimeRef.hs @@ -1,5 +1,6 @@ module Test.TestTimeRef where +testTimeRef :: String testTimeRef = unlines [ "-678950=-0001-12-23=-0001-357=-0001-W51-4" diff --git a/Test/TestUtil.hs b/Test/TestUtil.hs index de22be326c5161bff75a4c305053152431b2a0dc..bb2b58e5a8e9c0a1cb89c400f76d24c260de63b6 100644 --- a/Test/TestUtil.hs +++ b/Test/TestUtil.hs @@ -34,10 +34,5 @@ pureTest name result = ioTest name (return result) diff :: (Show a,Eq a) => a -> a -> Result diff expected found | expected == found = Pass -diff expected found = Fail ("expected [" ++ (show expected) ++ "] but found [" ++ (show found) ++ "]") +diff expected found = Fail ("expected " ++ (show expected) ++ " but found " ++ (show found)) -data ExhaustiveTest = forall t. (Show t) => MkExhaustiveTest String [t] (t -> IO Result) - -exhaustiveTestInstances :: ExhaustiveTest -> Test -exhaustiveTestInstances (MkExhaustiveTest name cases f) = testGroup name (fmap toTI cases) where - toTI t = ioTest (show t) (f t)