start refactor

Author: shapr

src/Kudzu.hs

@@ -10,62 +10,72 @@ import qualified Test.QuickCheck.Random 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 :: (Traversable t, QC.Testable a) => Int -> t a -> IO (t (KudzuResult Integer))
 testUntilSameQCMany howMany ts = do
-  mapM (testUntilSameQC howMany) ts
+    mapM (testUntilSameQC howMany) ts
 
 -- | QuickCheck
-testUntilSameQC :: QC.Testable a => Int -> a -> IO (Int, Maybe Integer)
+testUntilSameQC :: (QC.Testable a) => Int -> a -> IO (KudzuResult Integer)
 testUntilSameQC n testable = do
-  let rs = map (examineAndCount' testable) [0..n]
-  r1 <- head rs
-  grabUntilNSame 0 n n (tail rs) r1
+    let rs = map (examineAndCount' testable) [0 .. n]
+    r1 <- head rs
+    grabUntilNSame 0 n n (tail rs) r1
 
-examineAndCount' :: QC.Testable prop => prop -> Int -> IO Integer
+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
+    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 (Int, Maybe Integer))
+testUntilSameHHMany :: (Traversable t) => Int -> t HH.Property -> IO (t (KudzuResult Integer))
 testUntilSameHHMany howMany ps = do
-  mapM (testUntilSameHH howMany) ps
+    mapM (testUntilSameHH howMany) ps
 
-testUntilSameHH :: Int -> HH.Property -> IO (Int, Maybe Integer)
+testUntilSameHH :: Int -> HH.Property -> IO (KudzuResult Integer)
 testUntilSameHH n prop = do
-  let rs = examineAndCountHH <$> repeat prop
-  r1 <- head rs
-  grabUntilNSame 0 n n (tail rs) r1
+    let rs = examineAndCountHH <$> repeat prop
+    r1 <- head rs
+    grabUntilNSame 0 n n (tail rs) r1
 
 examineAndCountHH :: HH.Property -> IO Integer
 examineAndCountHH prop = do
-  passed <- HH.check prop
-  unless passed $ error "property failed"
-  tixModuleCount <$> examineTix
+    passed <- HH.check prop
+    unless passed $ error "property failed"
+    tixModuleCount <$> examineTix
 
 -- | LeanCheck
-testUntilSameLCMany :: (Traversable t, LC.Testable a) => Int -> t a -> IO (t (Int, Maybe Integer))
+testUntilSameLCMany :: (Traversable t, LC.Testable a) => Int -> t a -> IO (t (KudzuResult Integer))
 testUntilSameLCMany howMany ts = do
-  mapM (testUntilSameLC howMany) ts
+    mapM (testUntilSameLC howMany) ts
 
-testUntilSameLC :: LC.Testable a => Int -> a -> IO (Int, Maybe Integer)
+testUntilSameLC :: (LC.Testable a) => Int -> a -> IO (KudzuResult Integer)
 testUntilSameLC n testable = do
-  let rs = examineAndCount <$> LC.results testable
-  r1 <- head rs
-  grabUntilNSame 0 n n (tail rs) r1
+    let rs = examineAndCount <$> LC.results testable
+    r1 <- head rs
+    grabUntilNSame 0 n n (tail rs) r1
 
 examineAndCount :: ([String], Bool) -> IO Integer
-examineAndCount v = unless (snd v) (error $ unwords ("test failed with:":fst v)) >> tixModuleCount <$> examineTix
+examineAndCount v = unless (snd v) (error $ unwords ("test failed with:" : fst v)) >> tixModuleCount <$> examineTix
 
-grabUntilNSame :: (Monad m, Eq a) => Int -> Int -> Int -> [m a] -> a -> m (Int, Maybe a)
-grabUntilNSame c _ 0 _ z = pure (c, Just z)
-grabUntilNSame c _ _ [] _ = pure (c, Nothing)
+data KudzuResult a = KFail Int | KSuccess Int a
+
+{-
+Keep running property tests until the "amount" of code coverage is the same for N iterations of one test.
+orig: the number of iterations of a test that must have the same amount of code coverage before you give up and stop.
+c: the number of iterations checked
+n: countdown to the success case
+  -}
+grabUntilNSame :: (Monad m, Eq a) => Int -> Int -> Int -> [m a] -> a -> m (KudzuResult a)
+grabUntilNSame c _ 0 _ z = pure $ KSuccess c z -- we reached the desired window size
+grabUntilNSame c _ _ [] _ = pure $ KFail c -- if we run out of list elements for test results, we're done
 grabUntilNSame c orig n (a : as) z = do
-  a' <- a
-  if a' == z
-    then grabUntilNSame (c + 1) orig (n - 1) as z
-    else grabUntilNSame (c + 1) orig orig as a'
+    a' <- a
+    if a' == z -- is the count of regions covered from this run the same as last run?
+        then grabUntilNSame (c + 1) orig (n - 1) as z
+        else grabUntilNSame (c + 1) orig orig as a'
+
+-- where go c n a z =
 
 -- | How many regions were executed at least once for this module?
 tixCount :: TixModule -> Integer