{-# 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 Trace.Hpc.Reflect (examineTix)
import Trace.Hpc.Tix (Tix (..), TixModule (..))

testUntilSameQCMany :: (Traversable t, QC.Testable a) => Int -> t a -> IO (t (Int, Maybe Integer))
testUntilSameQCMany :: Int -> t a -> IO (t (Int, Maybe Integer))
testUntilSameQCMany Int
howMany t a
ts = do
  (a -> IO (Int, Maybe Integer))
-> t a -> IO (t (Int, Maybe Integer))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> a -> IO (Int, Maybe Integer)
forall a. Testable a => Int -> a -> IO (Int, Maybe Integer)
testUntilSameQC Int
howMany) t a
ts

-- | QuickCheck
testUntilSameQC :: QC.Testable a => Int -> a -> IO (Int, Maybe Integer)
testUntilSameQC :: Int -> a -> IO (Int, Maybe Integer)
testUntilSameQC Int
n a
testable = do
  let rs :: [IO Integer]
rs = a -> IO Integer
forall prop. Testable prop => prop -> IO Integer
examineAndCount' (a -> IO Integer) -> [a] -> [IO Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
forall a. a -> [a]
repeat a
testable
  Integer
r1 <- [IO Integer] -> IO Integer
forall a. [a] -> a
head [IO Integer]
rs
  Int
-> Int -> Int -> [IO Integer] -> Integer -> IO (Int, Maybe Integer)
forall (m :: * -> *) a.
(Monad m, Eq a) =>
Int -> Int -> Int -> [m a] -> a -> m (Int, Maybe a)
grabUntilNSame Int
0 Int
n Int
n ([IO Integer] -> [IO Integer]
forall a. [a] -> [a]
tail [IO Integer]
rs) Integer
r1

examineAndCount' :: QC.Testable prop => prop -> IO Integer
examineAndCount' :: prop -> IO Integer
examineAndCount' prop
v = do
  -- poor QC, you got problems
  -- quickCheckWith (stdArgs {maxSize = 400, maxSuccess = 1}) v
  Property -> IO ()
forall prop. Testable prop => prop -> IO ()
QC.quickCheck (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 (Int, Maybe Integer))
testUntilSameHHMany :: Int -> t Property -> IO (t (Int, Maybe Integer))
testUntilSameHHMany Int
howMany t Property
ps = do
  (Property -> IO (Int, Maybe Integer))
-> t Property -> IO (t (Int, Maybe Integer))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> Property -> IO (Int, Maybe Integer)
testUntilSameHH Int
howMany) t Property
ps

testUntilSameHH :: Int -> HH.Property -> IO (Int, Maybe Integer)
testUntilSameHH :: Int -> Property -> IO (Int, Maybe Integer)
testUntilSameHH Int
n Property
prop = do
  let rs :: [IO Integer]
rs = 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
  Integer
r1 <- [IO Integer] -> IO Integer
forall a. [a] -> a
head [IO Integer]
rs
  Int
-> Int -> Int -> [IO Integer] -> Integer -> IO (Int, Maybe Integer)
forall (m :: * -> *) a.
(Monad m, Eq a) =>
Int -> Int -> Int -> [m a] -> a -> m (Int, Maybe a)
grabUntilNSame Int
0 Int
n Int
n ([IO Integer] -> [IO Integer]
forall a. [a] -> [a]
tail [IO Integer]
rs) Integer
r1

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
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
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"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
testUntilSameLC :: LC.Testable a => Int -> a -> IO (Int, Maybe Integer)
testUntilSameLC :: Int -> a -> IO (Int, Maybe Integer)
testUntilSameLC Int
n a
testable = do
  let rs :: [IO Integer]
rs = ([[Char]], Bool) -> IO Integer
examineAndCount (([[Char]], Bool) -> IO Integer)
-> [([[Char]], Bool)] -> [IO Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [([[Char]], Bool)]
forall a. Testable a => a -> [([[Char]], Bool)]
LC.results a
testable
  Integer
r1 <- [IO Integer] -> IO Integer
forall a. [a] -> a
head [IO Integer]
rs
  Int
-> Int -> Int -> [IO Integer] -> Integer -> IO (Int, Maybe Integer)
forall (m :: * -> *) a.
(Monad m, Eq a) =>
Int -> Int -> Int -> [m a] -> a -> m (Int, Maybe a)
grabUntilNSame Int
0 Int
n Int
n ([IO Integer] -> [IO Integer]
forall a. [a] -> [a]
tail [IO Integer]
rs) Integer
r1

examineAndCount :: ([String], Bool) -> IO Integer
examineAndCount :: ([[Char]], Bool) -> IO Integer
examineAndCount ([[Char]], Bool)
v = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (([[Char]], Bool) -> Bool
forall a b. (a, b) -> b
snd ([[Char]], Bool)
v) ([Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"your code is broken") IO () -> IO Integer -> IO Integer
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

grabUntilNSame :: (Monad m, Eq a) => Int -> Int -> Int -> [m a] -> a -> m (Int, Maybe a)
grabUntilNSame :: Int -> Int -> Int -> [m a] -> a -> m (Int, Maybe a)
grabUntilNSame Int
c Int
_ Int
0 [m a]
_ a
z = (Int, Maybe a) -> m (Int, Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
c, a -> Maybe a
forall a. a -> Maybe a
Just a
z)
grabUntilNSame Int
c Int
_ Int
_ [] a
_ = (Int, Maybe a) -> m (Int, Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
c, Maybe a
forall a. Maybe a
Nothing)
grabUntilNSame Int
c Int
orig Int
n (m a
a : [m a]
as) a
z = do
  a
a' <- m a
a
  if a
a' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
z
    then Int -> Int -> Int -> [m a] -> a -> m (Int, Maybe a)
forall (m :: * -> *) a.
(Monad m, Eq a) =>
Int -> Int -> Int -> [m a] -> a -> m (Int, Maybe a)
grabUntilNSame (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
orig (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [m a]
as a
z
    else Int -> Int -> Int -> [m a] -> a -> m (Int, Maybe a)
forall (m :: * -> *) a.
(Monad m, Eq a) =>
Int -> Int -> Int -> [m a] -> a -> m (Int, Maybe a)
grabUntilNSame (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
orig 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 [Char]
_ Hash
_ Int
_ [Integer]
regions) = [Integer] -> Integer
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 (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 (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