-- |
-- Module      : Test.FitSpec.Report
-- Copyright   : (c) 2015-2017 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- 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
  { Args -> Int
nMutants :: Int -- ^ (starting) number of function mutations
  , Args -> Int
nTests   :: Int -- ^ (starting) number of test values (for each prop.)
  , Args -> Int
timeout  :: Int -- ^ timeout in seconds, 0 for just 'nTests' * 'nMutants'
  , Args -> [String]
names    :: [String] -- ^ names of functions: @["foo x y","goo x y"]@

  -- advanced options:
  , Args -> Bool
verbose      :: Bool         -- ^ whether to show detailed results
  , Args -> ShowMutantAs
showMutantAs :: ShowMutantAs -- ^ how to show mutants
  , Args -> Maybe Int
rows         :: Maybe Int    -- ^ number of surviving mutants to show
  , Args -> [String]
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
args = Args :: Int
-> Int
-> Int
-> [String]
-> Bool
-> ShowMutantAs
-> Maybe Int
-> [String]
-> Args
Args { nMutants :: Int
nMutants     =  Int
500
            , nTests :: Int
nTests       = Int
1000
            , timeout :: Int
timeout      = Int
5  -- seconds
            , names :: [String]
names        = []
            , verbose :: Bool
verbose      = Bool
False
            , showMutantAs :: ShowMutantAs
showMutantAs = ShowMutantAs
Tuple
            , rows :: Maybe Int
rows         = Maybe Int
forall a. Maybe a
Nothing
            , extra :: [String]
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 :: Int -> Int -> Args
fixargs Int
nm Int
nt = Args
args
  { nMutants :: Int
nMutants = Int
nm
  , nTests :: Int
nTests   = Int
nt
  , timeout :: Int
timeout  = Int
0
  }

showMutant :: ShowMutable a => Args -> a -> a -> String
showMutant :: Args -> a -> a -> String
showMutant Args
as = ShowMutantAs -> [String] -> a -> a -> String
forall a.
ShowMutable a =>
ShowMutantAs -> [String] -> a -> a -> String
showMutantByType (Args -> ShowMutantAs
showMutantAs Args
as) (Args -> [String]
names Args
as)
  where
    showMutantByType :: ShowMutantAs -> [String] -> a -> a -> String
showMutantByType ShowMutantAs
Tuple       = [String] -> a -> a -> String
forall a. ShowMutable a => [String] -> a -> a -> String
showMutantAsTuple
    showMutantByType ShowMutantAs
NestedTuple = [String] -> a -> a -> String
forall a. ShowMutable a => [String] -> a -> a -> String
showMutantNested
    showMutantByType ShowMutantAs
Definition  = [String] -> a -> a -> String
forall a. ShowMutable a => [String] -> a -> a -> String
showMutantDefinition
    showMutantByType ShowMutantAs
Bindings    = [String] -> a -> a -> String
forall a. ShowMutable a => [String] -> a -> a -> String
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 :: a -> (a -> [Property]) -> IO ()
report = Args -> a -> (a -> [Property]) -> IO ()
forall a.
(Mutable a, ShowMutable a) =>
Args -> a -> (a -> [Property]) -> IO ()
reportWith Args
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 :: Args -> a -> (a -> [Property]) -> IO ()
reportWith = [a] -> Args -> a -> (a -> [Property]) -> IO ()
forall a.
(Mutable a, ShowMutable a) =>
[a] -> Args -> a -> (a -> [Property]) -> IO ()
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 :: [a] -> Args -> a -> (a -> [Property]) -> IO ()
reportWithExtra [a]
extraMutants Args
args a
f a -> [Property]
properties = do
  let nm :: Int
nm = Args -> Int
nMutants Args
args
      nt :: Int
nt = Args -> Int
nTests Args
args
  case Int -> [Property] -> Maybe String
propertiesCE Int
nt (a -> [Property]
properties a
f) of
    Maybe String
Nothing -> [a] -> Args -> a -> (a -> [Property]) -> IO ()
forall a.
(Mutable a, ShowMutable a) =>
[a] -> Args -> a -> (a -> [Property]) -> IO ()
reportWithExtra' [a]
extraMutants Args
args a
f a -> [Property]
properties
    Just String
ce -> do
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"ERROR: The original function-set does not follow property set for "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" tests"
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Counter-example to property " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ce
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"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' :: [a] -> Args -> a -> (a -> [Property]) -> IO ()
reportWithExtra' [a]
extraMutants Args
args a
f a -> [Property]
properties = do
  Results a
results <- Int
-> [a] -> a -> (a -> [Property]) -> Int -> Int -> IO (Results a)
forall a.
Mutable a =>
Int
-> [a] -> a -> (a -> [Property]) -> Int -> Int -> IO (Results a)
getResultsExtraTimeout (Args -> Int
timeout Args
args)
                                    [a]
extraMutants
                                    a
f a -> [Property]
properties
                                    (Args -> Int
nMutants Args
args) (Args -> Int
nTests Args
args)

  let nm :: Int
nm = Result a -> Int
forall a. Result a -> Int
totalMutants (Result a -> Int) -> Result a -> Int
forall a b. (a -> b) -> a -> b
$ Results a -> Result a
forall a. [a] -> a
head Results a
results
      nt :: Int
nt = Result a -> Int
forall a. Result a -> Int
maxTests (Result a -> Int) -> Result a -> Int
forall a b. (a -> b) -> a -> b
$ Results a -> Result a
forall a. [a] -> a
head Results a
results
      nts :: [Int]
nts = Int -> [Property] -> [Int]
propertiesNTests Int
nt (a -> [Property]
properties a
f)
      tex :: Bool
tex = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> [Property] -> [Bool]
propertiesTestsExhausted Int
nt (a -> [Property]
properties a
f)
      mex :: Bool
mex = Result a -> Bool
forall a. Result a -> Bool
mutantsExhausted (Result a -> Bool) -> Result a -> Bool
forall a b. (a -> b) -> a -> b
$ Results a -> Result a
forall a. [a] -> a
head Results a
results
      apparent :: String
apparent | Bool
tex Bool -> Bool -> Bool
&& Bool
mex = String
""
               | Bool
otherwise  = String
"apparent "
  String -> IO ()
putStrLn (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
headToUpper (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
apparent String -> String -> String
forall a. [a] -> [a] -> [a]
++ Results a -> String
forall a. Results a -> String
qualifyCM Results a
results String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" specification based on"
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> [Int] -> Int -> Bool -> String
showNumberOfTestsAndMutants Bool
tex Bool
mex [Int]
nts Int
nm Bool
False

  let showR :: Maybe Int -> (a -> String) -> [Result a] -> String
showR | Args -> Bool
verbose Args
args = Maybe Int -> (a -> String) -> [Result a] -> String
forall a. Maybe Int -> (a -> String) -> [Result a] -> String
showDetailedResults
            | Bool
otherwise    = Maybe Int -> (a -> String) -> [Result a] -> String
forall a. Maybe Int -> (a -> String) -> [Result a] -> String
showResults
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Int -> (a -> String) -> Results a -> String
forall a. Maybe Int -> (a -> String) -> [Result a] -> String
showR (Args -> Maybe Int
rows Args
args) (Args -> a -> a -> String
forall a. ShowMutable a => Args -> a -> a -> String
showMutant Args
args a
f) Results a
results


showResults :: Maybe Int -> (a -> String)
            -> [Result a] -> String
showResults :: Maybe Int -> (a -> String) -> [Result a] -> String
showResults Maybe Int
mlimit a -> String
showMutant rs :: [Result a]
rs@(Result a
r:[Result a]
_) = String
completeness
                              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
minimality
  where
    showMutants :: [a] -> String
showMutants [a]
ms = String -> String
forall a. [a] -> [a]
init (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
showMutant [a]
ms
    completeness :: String
completeness = Int -> String
forall a. Show a => a -> String
show (Result a -> Int
forall a. Result a -> Int
nSurvivors Result a
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" survivors ("
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Result a -> Int
forall a. Result a -> Int
score Result a
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"% killed)"
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ case Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 Maybe Int
mlimit) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Result a -> [a]
forall a. Result a -> [a]
survivors Result a
r of
                     [] -> String
".\n"
                     [a
m] -> String
", smallest:\n"
                         String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"  " String -> String -> String
`beside` a -> String
showMutant a
m
                     [a]
ms  -> String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ms) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" smallest:\n"
                         String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"  " String -> String -> String
`beside` [a] -> String
showMutants [a]
ms
    minimality :: String
minimality = String
"apparent minimal property subsets:  "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([String] -> String
unwords ([String] -> String) -> ([[Int]] -> [String]) -> [[Int]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> String) -> [[Int]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> String
forall i. Show i => [i] -> String
showPropertySet ([[Int]] -> String) -> [[Int]] -> String
forall a b. (a -> b) -> a -> b
$ Result a -> [[Int]]
forall a. Result a -> [[Int]]
sets Result a
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ case Bool -> [Result a] -> String
forall a. Bool -> [Result a] -> String
showConjectures Bool
False [Result a]
rs of
                   String
"" -> String
"No conjectures.\n"
                   String
cs -> String
"conjectures:  " String -> String -> String
`beside` String
cs


showDetailedResults :: Maybe Int -> (a -> String)
                    -> [Result a] -> String
showDetailedResults :: Maybe Int -> (a -> String) -> [Result a] -> String
showDetailedResults Maybe Int
mlimit a -> String
showMutant [Result a]
rs = String
completeness
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
minimality
  where
    completeness :: String
completeness = String -> [[String]] -> String
table String
"   " ([[String]] -> String)
-> ([Result a] -> [[String]]) -> [Result a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
intersperse [String
"\n"]
                 ([[String]] -> [[String]])
-> ([Result a] -> [[String]]) -> [Result a] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ String
"Property\n sets"
                    , String
"#Survivors\n (%Killed)"
                    , String
"Smallest or simplest\n surviving mutant"
                    ][String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
:)
                 ([[String]] -> [[String]])
-> ([Result a] -> [[String]]) -> [Result a] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result a -> [String]) -> [Result a] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map Result a -> [String]
showResult
                 ([Result a] -> [[String]])
-> ([Result a] -> [Result a]) -> [Result a] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Result a] -> [Result a])
-> (Int -> [Result a] -> [Result a])
-> Maybe Int
-> [Result a]
-> [Result a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Result a] -> [Result a]
forall a. a -> a
id Int -> [Result a] -> [Result a]
forall a. Int -> [a] -> [a]
take Maybe Int
mlimit
                 ([Result a] -> String) -> [Result a] -> String
forall a b. (a -> b) -> a -> b
$ [Result a]
rs
    showResult :: Result a -> [String]
showResult Result a
r = [ [String] -> String
unwords ([String] -> String) -> ([[Int]] -> [String]) -> [[Int]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> String) -> [[Int]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> String
forall i. Show i => [i] -> String
showPropertySet ([[Int]] -> String) -> [[Int]] -> String
forall a b. (a -> b) -> a -> b
$ Result a -> [[Int]]
forall a. Result a -> [[Int]]
sets Result a
r
                   , Int -> String
forall a. Show a => a -> String
show  (Result a -> Int
forall a. Result a -> Int
nSurvivors Result a
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Result a -> Int
forall a. Result a -> Int
score Result a
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"%)"
                   , String -> (a -> String) -> Maybe a -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" a -> String
showMutant (Maybe a -> String) -> Maybe a -> String
forall a b. (a -> b) -> a -> b
$ Result a -> Maybe a
forall a. Result a -> Maybe a
smallestSurvivor Result a
r
                   ]
    minimality :: String
minimality = case Bool -> [Result a] -> String
forall a. Bool -> [Result a] -> String
showConjectures Bool
True [Result a]
rs of
                   String
"" -> String
"No conjectures.\n"
                   String
cs -> String
"Conjectures:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs


showNumberOfTestsAndMutants :: Bool -> Bool -> [Int] -> Int -> Bool -> String
showNumberOfTestsAndMutants :: Bool -> Bool -> [Int] -> Int -> Bool -> String
showNumberOfTestsAndMutants Bool
tex Bool
mex [Int]
nts Int
nm Bool
ssum = String
numTests String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
numMutants
  where
    mexS :: String
mexS | Bool
mex = String
" (exhausted)"
         | Bool
otherwise = String
""
    numMutants :: String
numMutants = String
"for each of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
showQuantity Int
nm String
"mutant variation" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
mexS String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".\n"
    numTests :: String
numTests | Bool
ssum = Int -> String -> String
showQuantity ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
nts) String
"test case"
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Bool
tex then String
" (exhausted)" else String
"")
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
             | Bool
otherwise = [String] -> String
unlines
                         ([String] -> String)
-> ([(Int, Integer)] -> [String]) -> [(Int, Integer)] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"(test cases exhausted)" | Bool
tex])
                         ([String] -> [String])
-> ([(Int, Integer)] -> [String]) -> [(Int, Integer)] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Integer) -> Int)
-> ((Int, Integer) -> Integer)
-> (Int -> [Integer] -> String)
-> [(Int, Integer)]
-> [String]
forall b a c d.
Ord b =>
(a -> b) -> (a -> c) -> (b -> [c] -> d) -> [a] -> [d]
sortGroupAndCollapse (Int, Integer) -> Int
forall a b. (a, b) -> a
fst (Int, Integer) -> Integer
forall a b. (a, b) -> b
snd Int -> [Integer] -> String
forall a. Show a => Int -> [a] -> String
testsForProps
                         ([(Int, Integer)] -> String) -> [(Int, Integer)] -> String
forall a b. (a -> b) -> a -> b
$ [Int] -> [Integer] -> [(Int, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
nts [Integer
1..]
    testsForProps :: Int -> [a] -> String
testsForProps Int
n [a]
ps = Int -> String -> String
showQuantity Int
n String
"test case"
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [a] -> String
forall a. Show a => String -> [a] -> String
showEach String
"property" [a]
ps

showPropertySet :: Show i => [i] -> String
showPropertySet :: [i] -> String
showPropertySet = (\String
s -> String
"{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}") (String -> String) -> ([i] -> String) -> [i] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> String) -> ([i] -> [String]) -> [i] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> String) -> [i] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map i -> String
forall a. Show a => a -> String
show


-- | Show conjectures derived from results
showConjectures :: Bool -> [Result a] -> String
showConjectures :: Bool -> [Result a] -> String
showConjectures Bool
showVeryWeak = String -> [[String]] -> String
table String
" "
                             ([[String]] -> String)
-> ([Result a] -> [[String]]) -> [Result a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Conjecture -> [String]) -> [Conjecture] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map Conjecture -> [String]
showConjecture
                             ([Conjecture] -> [[String]])
-> ([Result a] -> [Conjecture]) -> [Result a] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Conjecture -> Bool) -> [Conjecture] -> [Conjecture]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Conjecture
r -> Bool
showVeryWeak
                                          Bool -> Bool -> Bool
|| Conjecture -> Int
cnKilled Conjecture
r    Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
                                          Bool -> Bool -> Bool
&& Conjecture -> Int
cnSurvivors Conjecture
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)
                             ([Conjecture] -> [Conjecture])
-> ([Result a] -> [Conjecture]) -> [Result a] -> [Conjecture]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Result a] -> [Conjecture]
forall a. [Result a] -> [Conjecture]
conjectures

showConjecture :: Conjecture -> [String]
showConjecture :: Conjecture -> [String]
showConjecture Conjecture {isEq :: Conjecture -> Bool
isEq=Bool
eq, cleft :: Conjecture -> [Int]
cleft=[Int]
l, cright :: Conjecture -> [Int]
cright=[Int]
r, cscore :: Conjecture -> Int
cscore=Int
s} =
  [ [Int] -> String
forall i. Show i => [i] -> String
showPropertySet [Int]
l
  , if Bool
eq then String
" = " else String
"==>"
  , [Int] -> String
forall i. Show i => [i] -> String
showPropertySet [Int]
r
  , String
"   "
  , Int -> String
forall a. Show a => a -> String
show Int
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"% killed"
  , String
sMeaning
  ]
  where sMeaning :: String
sMeaning | Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1  Bool -> Bool -> Bool
|| Int
99 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s = String
"(very weak)"
                 | Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
11 Bool -> Bool -> Bool
|| Int
89 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s = String
"(weak)"
                 | Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
33 Bool -> Bool -> Bool
|| Int
67 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s = String
"(mild)"
                 | Bool
otherwise        = String
"(strong)" -- the closer to 50 the better

qualifyCM :: Results a -> String
qualifyCM :: Results a -> String
qualifyCM Results a
rs | Bool
c Bool -> Bool -> Bool
&& Bool
m    = String
"complete and minimal"
             | Bool
c         = String
"complete but non-minimal"
             |      Bool
m    = String
"minimal but incomplete"
             | Bool
otherwise = String
"incomplete and non-minimal"
  where c :: Bool
c = Results a -> Bool
forall a. Results a -> Bool
complete Results a
rs
        m :: Bool
m = Results a -> Bool
forall a. Results a -> Bool
minimal Results a
rs