Engine.hs

-- | FitSpec: refining property-sets for functional testing
--
-- This is the main engine, besides "Test.FitSpec.Mutable".
module Test.FitSpec.Engine
  ( property
  , Property

  , getResults
  , getResultsExtra
  , getResultsExtraTimeout
  , Result (..)
  , Results

  , propertiesNTests
  , propertiesTestsExhausted
  , propertiesToMap
  , propertiesHold
  , propertiesCE

  , minimal
  , complete

  , reduceImplications
  , filterNonCanon
  , Conjecture (..)
  , conjectures
  )
where

import Test.LeanCheck.Error
import Test.FitSpec.Utils
import Data.Maybe (catMaybes, listToMaybe)
import Data.List ((\\),union,transpose)
import Test.FitSpec.Mutable

-- | An encoded representation of a property suitable for use by FitSpec.
--
-- Each list of strings is a printable representation of one possible choice of
-- argument values for the property.  Each boolean indicate whether the
-- property holds for this choice.
type Property = [([String],Bool)]
type Properties = [Property]

-- | Given a 'Testable' type (as defined by 'Test.LeanCheck'), returns a 'Property'.
--
-- This function should be used on every property to create a property list to
-- be passed to 'report', 'reportWith', 'mainDefault' or 'mainWith'.
--
-- > property $ \x y -> x + y < y + (x::Int)
property :: Testable a => a -> Property
property = results

propertyHolds :: Int -> Property -> Bool
propertyHolds n = all snd . take n

propertyCE :: Int -> Property -> Maybe String
propertyCE n = listToMaybe . map (unwords . fst) . filter (not . snd) . take n

propertiesToMap :: [Property] -> Int -> [Bool]
propertiesToMap ps n = map (propertyHolds n) ps

propertiesHold :: Int -> [Property] -> Bool
propertiesHold n = all (propertyHolds n)

propertiesCE :: Int -> [Property] -> Maybe String
propertiesCE n = listToMaybe
               . catMaybes
               . zipWith (\n -> fmap ((show n ++ ":  ") ++)) [1..]
               . map (propertyCE n)

propertiesNTests :: Int -> [Property] -> [Int]
propertiesNTests n = map (length . take n)

propertiesTestsExhausted :: Int -> [Property] -> [Bool]
propertiesTestsExhausted n = map (<= n) . propertiesNTests (n+1)

filterNonCanon :: [Result a] -> [Result a]
filterNonCanon [] = []
filterNonCanon (r:rs) = (r:)
                      . filterNonCanon
                      . filter (not . null . sets)
                      . map (updateSets removeNonCanon)
                      $ rs
  where removeNonCanon = filter (not . (\p' -> (p' `contains`) `any` tail (sets r)))
        updateSets f r = r { sets = f (sets r) }

reduceImplications :: [Result a] -> [Result a]
reduceImplications [] = []
reduceImplications (r:rs) = r : map (r `reduce`) (reduceImplications rs)
  where r `reduce` r' = if or [s `contained` s' | s <- sets r, s' <- sets r']
                          then r' { implied = implied r' \\ implied r }
                          else r'


-- | A line of result for a single equivalence class of properties
--   with the exact same surviving mutants.
data Result a = Result
  { sets             :: [[Int]] -- ^ property-sets in the equivalence class
  , implied          :: [Int]   -- ^ properties implied by this class
  , survivors        :: [a]     -- ^ list of surviving mutants
  , smallestSurvivor :: Maybe a -- ^ smallest surviving mutant, if any
  , nSurvivors       :: Int -- ^ number of surviving mutants
  , nKilled          :: Int -- ^ number of killed mutants
  , totalMutants     :: Int -- ^ total number of mutants generated and tested
  , score            :: Int -- ^ percentage of killed mutants, 0-100
  , maxTests         :: Int -- ^ Requested number of tests (same for all rs.)
  , mutantsExhausted :: Bool -- ^ mutants were exhausted
  }
type Results a = [Result a]


-- | Return minimality and completeness results.  See 'report'.
getResults :: (Mutable a)
           => a -> (a -> [Property]) -> Int -> Int
           -> Results a
getResults = getResultsExtra []

getResultsExtra :: (Mutable a)
                => [a]
                -> a -> (a -> [Property]) -> Int -> Int
                -> Results a
getResultsExtra ems f ps nms nts = map (uncurry $ processRawResult mex nts)
                                 $ getRawResults is pmap ms
  where is = [1..(length $ ps f)]
        pmap f = propertiesToMap (ps f) nts
        ms' = take (nms+1) (tail $ mutants f)
        mex = length ms' <= nms
        ms = take nms ms' ++ ems

getResultsExtraTimeout :: (Mutable a)
                       => Int
                       -> [a]
                       -> a -> (a -> [Property]) -> Int -> Int
                       -> IO (Results a)
getResultsExtraTimeout 0 ems f ps m n = return $ getResultsExtra ems f ps m n
getResultsExtraTimeout t ems f ps nm0 nt0 = lastTimeout t resultss
  where
    resultss = map fst
             $ takeWhileIncreasingOn ((totalMutants . head) *** id)
             [ (getResultsExtra ems f ps nm nt, propertiesNTests nt $ ps f)
             | (nm,nt) <- iterate (incHalf *** incHalf) (nm0,nt0) ]
    incHalf x = x + x `div` 2

processRawResult :: Bool -> Int -> [[Int]] -> [(a,Bool)] -> Result a
processRawResult mex nt iss mhs = Result
  { sets      = relevantPropertySets iss
  , implied   = relevantImplications iss
  , survivors = ms
  , smallestSurvivor = listToMaybe ms
  , nSurvivors   = ns
  , nKilled      = nk
  , totalMutants = nm
  , score        = nk*100 `div` nm
  , maxTests     = nt
  , mutantsExhausted = mex
  }
  where ms = [m | (m,h) <- mhs, h]
        nm = length mhs
        ns = length ms
        nk = nm - ns

minimal :: Results a -> Bool
minimal (r:_) = null (implied r)
             && length (sets r) == 1

complete :: Results a -> Bool
complete (r:_) = nSurvivors r == 0

relevantPropertySets :: Eq i => [[i]] -> [[i]]
relevantPropertySets = filterU (not ... contained) . sortOn length

relevantImplications :: Eq i => [[i]] -> [i]
relevantImplications iss = foldr union [] iss
                        \\ foldr union [] (relevantPropertySets iss)

-- | Returns a description of property sets, grouping the ones that had the
--   same surviving mutants.  The resulting list is ordered starting with the
--   least surviving mutants to the most surviving mutants.
--
-- Arguments:
--
-- * @is@: list of property ids (@length is == length (pmap x)@)
--
-- * @pmap@: a property map
--
-- * @ms@: list of mutants to apply to the property map
--
-- Return a list of tuples containing:
--
--   * a list of property sets
--   * a list of mutants paired with booleans indicating whether each survived
getRawResults :: [i] -> (a -> [Bool]) -> [a] -> [([[i]],[(a,Bool)])]
getRawResults is ps ms = (id *** (zip ms)) `map` getRawResults' is ps ms

-- | Returns a description of property sets, grouping the ones that had the
--   same surviving mutants.  The resulting list is ordered starting with the
--   least surviving mutants to the most surviving mutants.
--
-- Arguments:
--
-- * @is@: list of property ids (@length is == length (pmap x)@)
--
-- * @pmap@: a property map
--
-- * @ms@: list of mutants to apply to the property map
--
-- Return a list of tuples containing:
--
--   * a list of property sets
--   * a boolean list indicating whether a given mutant survived
getRawResults' :: [i] -> (a -> [Bool]) -> [a] -> [([[i]],[Bool])]
getRawResults' is pmap = sortOn (count id . snd)
                       . sortAndGroupFstBySnd
                       . zip (subsets is)
                       . transpose
                       . map (compositions . pmap)

-- | 'nSurv' @props fs@ returns the number of values that match
--   compositions of properties on the property map.
--
-- * @props@ should be a function from a value to a list of properties that
--   match that value (in the case of functions, functions that "survive" those
--   properties).
--
-- * @fs@ is a list of values to be mapped over by @props@
--
-- > length (nSurvivors props fs)  ==  2 ^ (length (props fs))
--
-- This function is otherwise unused in this file.  It is just a simpler
-- version of 'pssurv' to serve as documentation.
nSurv :: (a -> [Bool]) -> [a] -> [Int]
nSurv props = map (count id)
            . transpose
            . map (compositions . props)


data Conjecture = Conjecture
  { isEq        :: Bool
  , isIm        :: Bool
  , cleft       :: [Int]
  , cright      :: [Int]
  , cscore      :: Int
  , cnKilled    :: Int
  , cnSurvivors :: Int
  } deriving Show

conjectures :: [Result a] -> [Conjecture]
conjectures = concatMap conjectures1
            . sortOn (abs . (50-) . score) -- closer to 50 the better!
            . reduceImplications
            . filterNonCanon
            . reverse

conjectures1 :: Result a -> [Conjecture]
conjectures1 r = [ p `eq` p' | p' <- ps ]
              ++ [ p `im` i  | (not.null) i ]
  where
    (p:ps) = sets r
    i      = implied r
    eq     = conj True
    im     = conj False
    conj isE p p' = Conjecture
      { isEq        = isE
      , isIm        = not isE
      , cleft       = p
      , cright      = p'
      , cscore      = score r
      , cnKilled    = nKilled r
      , cnSurvivors = nSurvivors r
      }
-- TODO: improve implication score
-- implication score can be improved by
-- by separating each implication on its own:
--   [4] ==> [2,3]
-- become
--   [4] ==> [2]
--   [4] ==> [3]
-- Then evaluating percentage of occurences of True ==> True and other cases