-- | -- Module : Test.FitSpec.Report -- Copyright : (c) 2015-2017 Rudy Matela -- License : 3-Clause BSD (see the file LICENSE) -- Maintainer : Rudy Matela -- -- Generate 'Test.FitSpec' reports. module Test.FitSpec.Report ( report , reportWith , reportWithExtra , Args(..) , args , fixargs , Property , ShowMutantAs(..) ) where import Data.List (intercalate, intersperse) import Data.Maybe (fromMaybe) import Test.FitSpec.Engine import Test.FitSpec.Mutable import Test.FitSpec.ShowMutable import Test.FitSpec.Utils import Test.FitSpec.PrettyPrint -- | How to show mutants. Use this to fill 'showMutantAs'. data ShowMutantAs = Tuple | NestedTuple | Definition | Bindings -- | Extra arguments / configuration for 'reportWith'. -- See 'args' for default values. data Args = Args { nMutants :: Int -- ^ (starting) number of function mutations , nTests :: Int -- ^ (starting) number of test values (for each prop.) , timeout :: Int -- ^ timeout in seconds, 0 for just 'nTests' * 'nMutants' , names :: [String] -- ^ names of functions: @["foo x y","goo x y"]@ -- advanced options: , verbose :: Bool -- ^ whether to show detailed results , showMutantAs :: ShowMutantAs -- ^ how to show mutants , rows :: Maybe Int -- ^ number of surviving mutants to show , extra :: [String] -- ^ ignored argument (user defined meaning) } -- | Default arguments for 'reportWith': -- -- * @nMutants = 500@, start with 500 mutants -- -- * @nTests = 1000@, start with 1000 test values -- -- * @timeout = 5@, keep incresing the number of mutants -- until 5 seconds elapse -- -- * @names = []@, default function call template: -- -- > ["f x y z", "g x y z", "h x y z", ...] args :: Args args = Args { nMutants = 500 , nTests = 1000 , timeout = 5 -- seconds , names = [] , verbose = False , showMutantAs = Tuple , rows = Nothing , extra = [] } -- | Non timed-out default arguments. -- Make conjectures based on a fixed number of mutants and tests, e.g.: -- -- > reportWith (fixargs 100 200) f pmap -- -- This is just a shorthand, see: -- -- > fixargs nm nt = args { nMutants = nm, nTests = nt, timeout = 0 } -- -- > (fixargs nm nt) { nMutants = 500, nTests = 1000, timeout = 5 } = args fixargs :: Int -> Int -> Args fixargs nm nt = args { nMutants = nm , nTests = nt , timeout = 0 } showMutant :: ShowMutable a => Args -> a -> a -> String showMutant as = showMutantByType (showMutantAs as) (names as) where showMutantByType Tuple = showMutantAsTuple showMutantByType NestedTuple = showMutantNested showMutantByType Definition = showMutantDefinition showMutantByType Bindings = showMutantBindings -- | Report results generated by FitSpec. -- Uses standard configuration (see 'args'). -- Needs a function to be mutated and a property map. -- Example (specification of boolean negation): -- -- > properties not = -- > [ property $ \p -> not (not p) == p -- > , property $ \p -> not (not (not p)) == not p -- > ] -- > -- > main = report not properties report :: (Mutable a, ShowMutable a) => a -> (a -> [Property]) -> IO () report = reportWith args -- | Same as 'report' but can be configured via 'Args' ('args' or 'fixargs'), -- e.g.: -- -- > reportWith args { timeout = 10 } fun properties reportWith :: (Mutable a, ShowMutable a) => Args -> a -> (a -> [Property]) -> IO () reportWith = reportWithExtra [] -- | Same as 'reportWith', but accepts a list of manually defined (extra) -- mutants to be tested alongside those automatically generated. reportWithExtra :: (Mutable a, ShowMutable a) => [a] -> Args -> a -> (a -> [Property]) -> IO () reportWithExtra extraMutants args f properties = do let nm = nMutants args nt = nTests args case propertiesCE nt (properties f) of Nothing -> reportWithExtra' extraMutants args f properties Just ce -> do putStrLn $ "ERROR: The original function-set does not follow property set for " ++ show nt ++ " tests" putStrLn $ "Counter-example to property " ++ ce putStrLn $ "Aborting." -- | Same as 'reportWithExtra', does not abort if the original function does not -- follow the property set. reportWithExtra' :: (Mutable a, ShowMutable a) => [a] -> Args -> a -> (a -> [Property]) -> IO () reportWithExtra' extraMutants args f properties = do results <- getResultsExtraTimeout (timeout args) extraMutants f properties (nMutants args) (nTests args) let nm = totalMutants $ head results nt = maxTests $ head results nts = propertiesNTests nt (properties f) tex = and $ propertiesTestsExhausted nt (properties f) mex = mutantsExhausted $ head results apparent | tex && mex = "" | otherwise = "apparent " putStrLn . headToUpper $ apparent ++ qualifyCM results ++ " specification based on" putStrLn $ showNumberOfTestsAndMutants tex mex nts nm False let showR | verbose args = showDetailedResults | otherwise = showResults putStrLn $ showR (rows args) (showMutant args f) results showResults :: Maybe Int -> (a -> String) -> [Result a] -> String showResults mlimit showMutant rs@(r:_) = completeness ++ "\n" ++ minimality where showMutants ms = init . unlines $ map showMutant ms completeness = show (nSurvivors r) ++ " survivors (" ++ show (score r) ++ "% killed)" ++ case take (fromMaybe 1 mlimit) $ survivors r of [] -> ".\n" [m] -> ", smallest:\n" ++ " " `beside` showMutant m ms -> ", " ++ show (length ms) ++ " smallest:\n" ++ " " `beside` showMutants ms minimality = "apparent minimal property subsets: " ++ (unwords . map showPropertySet $ sets r) ++ "\n" ++ case showConjectures False rs of "" -> "No conjectures.\n" cs -> "conjectures: " `beside` cs showDetailedResults :: Maybe Int -> (a -> String) -> [Result a] -> String showDetailedResults mlimit showMutant rs = completeness ++ "\n" ++ minimality where completeness = table " " . intersperse ["\n"] . ([ "Property\n sets" , "#Survivors\n (%Killed)" , "Smallest or simplest\n surviving mutant" ]:) . map showResult . maybe id take mlimit $ rs showResult r = [ unwords . map showPropertySet $ sets r , show (nSurvivors r) ++ " (" ++ show (score r) ++ "%)" , maybe "" showMutant $ smallestSurvivor r ] minimality = case showConjectures True rs of "" -> "No conjectures.\n" cs -> "Conjectures:\n" ++ cs showNumberOfTestsAndMutants :: Bool -> Bool -> [Int] -> Int -> Bool -> String showNumberOfTestsAndMutants tex mex nts nm ssum = numTests ++ numMutants where mexS | mex = " (exhausted)" | otherwise = "" numMutants = "for each of " ++ showQuantity nm "mutant variation" ++ mexS ++ ".\n" numTests | ssum = showQuantity (sum nts) "test case" ++ (if tex then " (exhausted)" else "") ++ "\n" | otherwise = unlines . (++ ["(test cases exhausted)" | tex]) . sortGroupAndCollapse fst snd testsForProps $ zip nts [1..] testsForProps n ps = showQuantity n "test case" ++ " for " ++ showEach "property" ps showPropertySet :: Show i => [i] -> String showPropertySet = (\s -> "{" ++ s ++ "}") . intercalate "," . map show -- | Show conjectures derived from results showConjectures :: Bool -> [Result a] -> String showConjectures showVeryWeak = table " " . map showConjecture . filter (\r -> showVeryWeak || cnKilled r /= 0 && cnSurvivors r /= 0) . conjectures showConjecture :: Conjecture -> [String] showConjecture Conjecture {isEq=eq, cleft=l, cright=r, cscore=s} = [ showPropertySet l , if eq then " = " else "==>" , showPropertySet r , " " , show s ++ "% killed" , sMeaning ] where sMeaning | s < 1 || 99 < s = "(very weak)" | s < 11 || 89 < s = "(weak)" | s < 33 || 67 < s = "(mild)" | otherwise = "(strong)" -- the closer to 50 the better qualifyCM :: Results a -> String qualifyCM rs | c && m = "complete and minimal" | c = "complete but non-minimal" | m = "minimal but incomplete" | otherwise = "incomplete and non-minimal" where c = complete rs m = minimal rs