kudzu-0.1.1.0: src/Kudzu.hs

{-# LANGUAGE OverloadedStrings #-}

module Kudzu where

import Control.Monad (unless)
import qualified Hedgehog as HH
import qualified Test.LeanCheck as LC
import qualified Test.QuickCheck as QC
import qualified Test.QuickCheck.Random as QC

-- import Trace.Hpc.Mix
import Trace.Hpc.Reflect (examineTix)
import Trace.Hpc.Tix (Tix (..), TixModule (..))

testUntilSameQCMany :: (Traversable t, QC.Testable a) => Int -> t a -> IO (t (KudzuResult Integer))
testUntilSameQCMany howMany ts = do
    mapM (testUntilSameQC howMany) ts

-- | QuickCheck
testUntilSameQC :: (QC.Testable a) => Int -> a -> IO (KudzuResult Integer)
testUntilSameQC n testable = do
    let rs = map (examineAndCount' testable) [0 .. n]
    grabUntilNSame n rs

examineAndCount' :: (QC.Testable prop) => prop -> Int -> IO Integer
examineAndCount' v size = do
    qcg <- QC.newQCGen
    QC.quickCheckWith (QC.stdArgs{QC.replay = Just (qcg, size)}) (QC.withMaxSuccess 1 v)
    tixModuleCount <$> examineTix

-- | Hedgehog
testUntilSameHHMany :: (Traversable t) => Int -> t HH.Property -> IO (t (KudzuResult Integer))
testUntilSameHHMany howMany ps = do
    mapM (testUntilSameHH howMany) ps

testUntilSameHH :: Int -> HH.Property -> IO (KudzuResult Integer)
testUntilSameHH n prop = grabUntilNSame n $ examineAndCountHH <$> repeat prop

examineAndCountHH :: HH.Property -> IO Integer
examineAndCountHH prop = do
    passed <- HH.check . HH.withTests 1 $ prop
    unless passed $ error "property failed"
    tixModuleCount <$> examineTix

-- | LeanCheck
testUntilSameLCMany :: (Traversable t, LC.Testable a) => Int -> t a -> IO (t (KudzuResult Integer))
testUntilSameLCMany howMany ts = do
    mapM (testUntilSameLC howMany) ts

testUntilSameLC :: (LC.Testable a) => Int -> a -> IO (KudzuResult Integer)
testUntilSameLC n testable = grabUntilNSame n $ examineAndCount <$> LC.results testable

examineAndCount :: ([String], Bool) -> IO Integer
examineAndCount v = unless (snd v) (error $ unwords ("test failed with:" : fst v)) >> tixModuleCount <$> examineTix

data KudzuResult a = KFail Int | KSuccess Int a deriving (Show, Eq, Ord)

-- | Keep running property tests until the "amount" of code coverage is the same for N iterations of one test.
grabUntilNSame ::
    (Monad m, Eq a) =>
    -- | How many iterations must be the same?
    Int ->
    -- | a lazy list of iterations
    [m a] ->
    m (KudzuResult a)
grabUntilNSame _ [] = pure $ KFail 0
grabUntilNSame orig (a : as) = do
    a' <- a -- run the first iteration of the test
    go 0 orig as a'
  where
    go c 0 _ z = pure $ KSuccess c z -- we reached the desired window size
    go c _ [] _ = pure $ KFail c -- if we run out of list elements for test results, we're done
    go c n (b : bs) z = do
        a' <- b
        if a' == z
            then go (c + 1) (n - 1) bs z
            else go (c + 1) orig as a'

-- | How many regions were executed at least once for this module?
tixCount :: TixModule -> Integer
tixCount (TixModule _ _ _ regions) = sum $ 1 <$ filter (> 0) regions

-- | How many regions were executed at least once for all these modules?
tixModuleCount :: Tix -> Integer
tixModuleCount (Tix ms) = sum $ map tixCount ms

-- foo = Mix "src/Data/Array/Accelerate/Trafo/Config.hs" 2024 - 04 - 22 14 : 30 : 08.311359928 UTC 3070486 8 [(41 : 18 - 41 : 32, ExpBox False), (42 : 3 - 42 : 8, ExpBox False), (42 : 15 - 42 : 20, ExpBox False), (42 : 25 - 42 : 34, ExpBox False), (42 : 24 - 42 : 39, ExpBox False), (42 : 14 - 42 : 40, ExpBox False), (42 : 3 - 42 : 40, ExpBox False), (42 : 51 - 42 : 68, ExpBox False), (42 : 46 - 42 : 68, ExpBox False), (42 : 3 - 42 : 68, ExpBox False), (43 : 15 - 43 : 26, ExpBox False), (43 : 43 - 43 : 67, ExpBox False), (43 : 32 - 43 : 67, ExpBox False), (43 : 14 - 43 : 68, ExpBox False), (42 : 3 - 43 : 68, ExpBox False), (44 : 15 - 44 : 26, ExpBox False), (44 : 43 - 44 : 69, ExpBox False), (44 : 32 - 44 : 69, ExpBox False), (44 : 14 - 44 : 70, ExpBox False), (42 : 3 - 44 : 70, ExpBox False), (41 : 18 - 44 : 70, ExpBox False), (41 : 1 - 44 : 70, TopLevelBox ["defaultOptions"]), (33 : 5 - 33 : 11, ExpBox False), (33 : 5 - 33 : 11, TopLevelBox ["options"]), (34 : 5 - 34 : 27, ExpBox False), (34 : 5 - 34 : 27, TopLevelBox ["unfolding_use_threshold"]), (35 : 5 - 35 : 29, ExpBox False), (35 : 5 - 35 : 29, TopLevelBox ["max_simplifier_iterations"]), (37 : 12 - 37 : 15, TopLevelBox ["showsPrec"]), (37 : 12 - 37 : 15, TopLevelBox ["show"]), (37 : 12 - 37 : 15, TopLevelBox ["showList"])]

-- bar = Mix "src/Data/Array/Accelerate/Classes/ToFloating.hs" 2024 - 04 - 22 14 : 30 : 08.304359842 UTC 1185370804 8 [(47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"]), (47 : 2 - 79 : 2, ExpBox False), (47 : 2 - 79 : 2, TopLevelBox ["toFloating"])]