From 945c7435a41b93ff243b69f18a9c0216a7b70e24 Mon Sep 17 00:00:00 2001
From: Yann Herklotz <git@yannherklotz.com>
Date: Fri, 18 Oct 2019 14:59:56 +0100
Subject: Add -k functionality

---
 src/Verismith/Fuzz.hs | 30 ++++++++++++++++++++++++++----
 1 file changed, 26 insertions(+), 4 deletions(-)

(limited to 'src/Verismith/Fuzz.hs')

diff --git a/src/Verismith/Fuzz.hs b/src/Verismith/Fuzz.hs
index 81c00a0..f26630a 100644
--- a/src/Verismith/Fuzz.hs
+++ b/src/Verismith/Fuzz.hs
@@ -402,21 +402,43 @@ relativeFuzzReport fr@(FuzzReport dir _ _ _ _ _ _ _) = liftSh $ do
     newPath <- relPath dir
     return $ (fuzzDir .~ newPath) fr
 
+filterSynth :: SynthResult -> Bool
+filterSynth (SynthResult _ _ (Pass _) _) = True
+filterSynth _                            = False
+
+filterSim :: SimResult -> Bool
+filterSim (SimResult _ _ (Pass _) _) = True
+filterSim _                          = False
+
+filterSynthStat :: SynthStatus -> Bool
+filterSynthStat (SynthStatus _ (Pass _) _) = True
+filterSynthStat _                          = False
+
+passedFuzz :: FuzzReport -> Bool
+passedFuzz (FuzzReport _ synth sim synthstat _ _ _ _) =
+    (passedSynth + passedSim + passedSynthStat) == 0
+  where
+    passedSynth = length $ filter (not . filterSynth) synth
+    passedSim = length $ filter (not . filterSim) sim
+    passedSynthStat = length $ filter (not . filterSynthStat) synthstat
+
 fuzzInDir
-    :: MonadFuzz m => FilePath -> Gen SourceInfo -> Config -> Fuzz m FuzzReport
-fuzzInDir fp src conf = do
+    :: MonadFuzz m => Bool -> FilePath -> Gen SourceInfo -> Config -> Fuzz m FuzzReport
+fuzzInDir k fp src conf = do
     make fp
     res <- pop fp $ fuzz src conf
+    liftSh . when (passedFuzz res && not k) $ rm_rf fp
     relativeFuzzReport res
 
 fuzzMultiple
     :: MonadFuzz m
     => Int
+    -> Bool
     -> Maybe FilePath
     -> Gen SourceInfo
     -> Config
     -> Fuzz m [FuzzReport]
-fuzzMultiple n fp src conf = do
+fuzzMultiple n k fp src conf = do
     x <- case fp of
         Nothing -> do
             ct <- liftIO getZonedTime
@@ -436,7 +458,7 @@ fuzzMultiple n fp src conf = do
             results
         return results
   where
-    fuzzDir' n' = fuzzInDir (fromText $ "fuzz_" <> showT n') src conf
+    fuzzDir' n' = fuzzInDir k (fromText $ "fuzz_" <> showT n') src conf
     seed = conf ^. configProperty . propSeed
 
 sampleSeed :: MonadSh m => Maybe Seed -> Gen a -> m (Seed, a)
-- 
cgit