{-# 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
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
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
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
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'
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
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