{-# 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 :: forall (t :: * -> *) a.
(Traversable t, Testable a) =>
Int -> t a -> IO (t (KudzuResult Integer))
testUntilSameQCMany Int
howMany t a
ts = do
    (a -> IO (KudzuResult Integer))
-> t a -> IO (t (KudzuResult Integer))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM (Int -> a -> IO (KudzuResult Integer)
forall a. Testable a => Int -> a -> IO (KudzuResult Integer)
testUntilSameQC Int
howMany) t a
ts

-- | QuickCheck
testUntilSameQC :: (QC.Testable a) => Int -> a -> IO (KudzuResult Integer)
testUntilSameQC :: forall a. Testable a => Int -> a -> IO (KudzuResult Integer)
testUntilSameQC Int
n a
testable = do
    let rs :: [IO Integer]
rs = (Int -> IO Integer) -> [Int] -> [IO Integer]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Int -> IO Integer
forall prop. Testable prop => prop -> Int -> IO Integer
examineAndCount' a
testable) [Int
0 .. Int
n]
    Int -> [IO Integer] -> IO (KudzuResult Integer)
forall (m :: * -> *) a.
(Monad m, Eq a) =>
Int -> [m a] -> m (KudzuResult a)
grabUntilNSame Int
n [IO Integer]
rs

examineAndCount' :: (QC.Testable prop) => prop -> Int -> IO Integer
examineAndCount' :: forall prop. Testable prop => prop -> Int -> IO Integer
examineAndCount' prop
v Int
size = do
    QCGen
qcg <- IO QCGen
QC.newQCGen
    Args -> Property -> IO ()
forall prop. Testable prop => Args -> prop -> IO ()
QC.quickCheckWith (Args
QC.stdArgs{QC.replay = Just (qcg, size)}) (Int -> prop -> Property
forall prop. Testable prop => Int -> prop -> Property
QC.withMaxSuccess Int
1 prop
v)
    Tix -> Integer
tixModuleCount (Tix -> Integer) -> IO Tix -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Tix
examineTix

-- | Hedgehog
testUntilSameHHMany :: (Traversable t) => Int -> t HH.Property -> IO (t (KudzuResult Integer))
testUntilSameHHMany :: forall (t :: * -> *).
Traversable t =>
Int -> t Property -> IO (t (KudzuResult Integer))
testUntilSameHHMany Int
howMany t Property
ps = do
    (Property -> IO (KudzuResult Integer))
-> t Property -> IO (t (KudzuResult Integer))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM (Int -> Property -> IO (KudzuResult Integer)
testUntilSameHH Int
howMany) t Property
ps

testUntilSameHH :: Int -> HH.Property -> IO (KudzuResult Integer)
testUntilSameHH :: Int -> Property -> IO (KudzuResult Integer)
testUntilSameHH Int
n Property
prop = Int -> [IO Integer] -> IO (KudzuResult Integer)
forall (m :: * -> *) a.
(Monad m, Eq a) =>
Int -> [m a] -> m (KudzuResult a)
grabUntilNSame Int
n ([IO Integer] -> IO (KudzuResult Integer))
-> [IO Integer] -> IO (KudzuResult Integer)
forall a b. (a -> b) -> a -> b
$ Property -> IO Integer
examineAndCountHH (Property -> IO Integer) -> [Property] -> [IO Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Property -> [Property]
forall a. a -> [a]
repeat Property
prop

examineAndCountHH :: HH.Property -> IO Integer
examineAndCountHH :: Property -> IO Integer
examineAndCountHH Property
prop = do
    Bool
passed <- Property -> IO Bool
forall (m :: * -> *). MonadIO m => Property -> m Bool
HH.check (Property -> IO Bool)
-> (Property -> Property) -> Property -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> Property -> Property
HH.withTests TestLimit
1 (Property -> IO Bool) -> Property -> IO Bool
forall a b. (a -> b) -> a -> b
$ Property
prop
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
passed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error String
"property failed"
    Tix -> Integer
tixModuleCount (Tix -> Integer) -> IO Tix -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Tix
examineTix

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

testUntilSameLC :: (LC.Testable a) => Int -> a -> IO (KudzuResult Integer)
testUntilSameLC :: forall a. Testable a => Int -> a -> IO (KudzuResult Integer)
testUntilSameLC Int
n a
testable = Int -> [IO Integer] -> IO (KudzuResult Integer)
forall (m :: * -> *) a.
(Monad m, Eq a) =>
Int -> [m a] -> m (KudzuResult a)
grabUntilNSame Int
n ([IO Integer] -> IO (KudzuResult Integer))
-> [IO Integer] -> IO (KudzuResult Integer)
forall a b. (a -> b) -> a -> b
$ ([String], Bool) -> IO Integer
examineAndCount (([String], Bool) -> IO Integer)
-> [([String], Bool)] -> [IO Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [([String], Bool)]
forall a. Testable a => a -> [([String], Bool)]
LC.results a
testable

examineAndCount :: ([String], Bool) -> IO Integer
examineAndCount :: ([String], Bool) -> IO Integer
examineAndCount ([String], Bool)
v = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (([String], Bool) -> Bool
forall a b. (a, b) -> b
snd ([String], Bool)
v) (String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords (String
"test failed with:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ([String], Bool) -> [String]
forall a b. (a, b) -> a
fst ([String], Bool)
v)) IO () -> IO Integer -> IO Integer
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tix -> Integer
tixModuleCount (Tix -> Integer) -> IO Tix -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Tix
examineTix

data KudzuResult a = KFail Int | KSuccess Int a deriving (Int -> KudzuResult a -> ShowS
[KudzuResult a] -> ShowS
KudzuResult a -> String
(Int -> KudzuResult a -> ShowS)
-> (KudzuResult a -> String)
-> ([KudzuResult a] -> ShowS)
-> Show (KudzuResult a)
forall a. Show a => Int -> KudzuResult a -> ShowS
forall a. Show a => [KudzuResult a] -> ShowS
forall a. Show a => KudzuResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> KudzuResult a -> ShowS
showsPrec :: Int -> KudzuResult a -> ShowS
$cshow :: forall a. Show a => KudzuResult a -> String
show :: KudzuResult a -> String
$cshowList :: forall a. Show a => [KudzuResult a] -> ShowS
showList :: [KudzuResult a] -> ShowS
Show, KudzuResult a -> KudzuResult a -> Bool
(KudzuResult a -> KudzuResult a -> Bool)
-> (KudzuResult a -> KudzuResult a -> Bool) -> Eq (KudzuResult a)
forall a. Eq a => KudzuResult a -> KudzuResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => KudzuResult a -> KudzuResult a -> Bool
== :: KudzuResult a -> KudzuResult a -> Bool
$c/= :: forall a. Eq a => KudzuResult a -> KudzuResult a -> Bool
/= :: KudzuResult a -> KudzuResult a -> Bool
Eq, Eq (KudzuResult a)
Eq (KudzuResult a) =>
(KudzuResult a -> KudzuResult a -> Ordering)
-> (KudzuResult a -> KudzuResult a -> Bool)
-> (KudzuResult a -> KudzuResult a -> Bool)
-> (KudzuResult a -> KudzuResult a -> Bool)
-> (KudzuResult a -> KudzuResult a -> Bool)
-> (KudzuResult a -> KudzuResult a -> KudzuResult a)
-> (KudzuResult a -> KudzuResult a -> KudzuResult a)
-> Ord (KudzuResult a)
KudzuResult a -> KudzuResult a -> Bool
KudzuResult a -> KudzuResult a -> Ordering
KudzuResult a -> KudzuResult a -> KudzuResult a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (KudzuResult a)
forall a. Ord a => KudzuResult a -> KudzuResult a -> Bool
forall a. Ord a => KudzuResult a -> KudzuResult a -> Ordering
forall a. Ord a => KudzuResult a -> KudzuResult a -> KudzuResult a
$ccompare :: forall a. Ord a => KudzuResult a -> KudzuResult a -> Ordering
compare :: KudzuResult a -> KudzuResult a -> Ordering
$c< :: forall a. Ord a => KudzuResult a -> KudzuResult a -> Bool
< :: KudzuResult a -> KudzuResult a -> Bool
$c<= :: forall a. Ord a => KudzuResult a -> KudzuResult a -> Bool
<= :: KudzuResult a -> KudzuResult a -> Bool
$c> :: forall a. Ord a => KudzuResult a -> KudzuResult a -> Bool
> :: KudzuResult a -> KudzuResult a -> Bool
$c>= :: forall a. Ord a => KudzuResult a -> KudzuResult a -> Bool
>= :: KudzuResult a -> KudzuResult a -> Bool
$cmax :: forall a. Ord a => KudzuResult a -> KudzuResult a -> KudzuResult a
max :: KudzuResult a -> KudzuResult a -> KudzuResult a
$cmin :: forall a. Ord a => KudzuResult a -> KudzuResult a -> KudzuResult a
min :: KudzuResult a -> KudzuResult a -> KudzuResult a
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 :: forall (m :: * -> *) a.
(Monad m, Eq a) =>
Int -> [m a] -> m (KudzuResult a)
grabUntilNSame Int
_ [] = KudzuResult a -> m (KudzuResult a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KudzuResult a -> m (KudzuResult a))
-> KudzuResult a -> m (KudzuResult a)
forall a b. (a -> b) -> a -> b
$ Int -> KudzuResult a
forall a. Int -> KudzuResult a
KFail Int
0
grabUntilNSame Int
orig (m a
a : [m a]
as) = do
    a
a' <- m a
a -- run the first iteration of the test
    Int -> Int -> [m a] -> a -> m (KudzuResult a)
go Int
0 Int
orig [m a]
as a
a'
  where
    go :: Int -> Int -> [m a] -> a -> m (KudzuResult a)
go Int
c Int
0 [m a]
_ a
z = KudzuResult a -> m (KudzuResult a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KudzuResult a -> m (KudzuResult a))
-> KudzuResult a -> m (KudzuResult a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> KudzuResult a
forall a. Int -> a -> KudzuResult a
KSuccess Int
c a
z -- we reached the desired window size
    go Int
c Int
_ [] a
_ = KudzuResult a -> m (KudzuResult a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KudzuResult a -> m (KudzuResult a))
-> KudzuResult a -> m (KudzuResult a)
forall a b. (a -> b) -> a -> b
$ Int -> KudzuResult a
forall a. Int -> KudzuResult a
KFail Int
c -- if we run out of list elements for test results, we're done
    go Int
c Int
n (m a
b : [m a]
bs) a
z = do
        a
a' <- m a
b
        if a
a' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
z
            then Int -> Int -> [m a] -> a -> m (KudzuResult a)
go (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [m a]
bs a
z
            else Int -> Int -> [m a] -> a -> m (KudzuResult a)
go (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
orig [m a]
as a
a'

-- | How many regions were executed at least once for this module?
tixCount :: TixModule -> Integer
tixCount :: TixModule -> Integer
tixCount (TixModule String
_ Hash
_ Int
_ [Integer]
regions) = [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> [Integer] -> [Integer]
forall a b. a -> [b] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) [Integer]
regions

-- | How many regions were executed at least once for all these modules?
tixModuleCount :: Tix -> Integer
tixModuleCount :: Tix -> Integer
tixModuleCount (Tix [TixModule]
ms) = [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (TixModule -> Integer) -> [TixModule] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map TixModule -> Integer
tixCount [TixModule]
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"])]