Issue collegevine#3: test-coverage thresholds

.circleci/config.yml

@@ -39,7 +39,12 @@ jobs:
         - circle20-
 
     - run:
-        command: sysconfcpus -n 2 stack test
+        # All tests:
+        command: sysconfcpus -n 2 stack test :confcrypt-detailed-tests
+        # All tests with default 80% threshold:
+        #command: sysconfcpus -n 2 stack test :confcrypt-threshold-tests --coverage
+        # All tests with provided threshold:
+        # ex: command: sysconfcpus -n 2 stack test :confcrypt-threshold-tests --coverage --ta "--threshold 90"
         no_output_timeout: 3600s
 
     - store_test_results:
@@ -48,6 +53,16 @@ jobs:
         path: $CIRCLE_ARTIFACTS
     - store_artifacts:
         path: $CIRCLE_TEST_REPORTS
+  threshold-test-job:
+      <<: *defaults
+      steps:
+      - checkout
+      - run: source confcrypt-threshold-test.sh
+  coverage-job:
+      <<: *defaults
+      steps:
+      - checkout
+      - run: source coverage.sh
   lint-job:
       <<: *defaults
       steps:
@@ -58,5 +73,9 @@ workflows:
 
     build-and-test:
         jobs:
-            - test-job
+#            - test-job
+            - threshold-test-job
+            - coverage-job:
+                requires:
+                    - threshold-test-job
             - lint-job

.hpc-threshold

@@ -0,0 +1,26 @@
+[ Threshold 
+    { thresholdName = "Expressions used"
+    , thresholdRegex = "(\\d+)% expressions used"
+    , thresholdValue = 80.0
+    }
+, Threshold 
+    { thresholdName = "Boolean coverage"
+    , thresholdRegex = "(\\d+)% boolean coverage"
+    , thresholdValue = 80.0
+    }
+, Threshold 
+    { thresholdName = "Alternatives used"
+    , thresholdRegex = "(\\d+)% alternatives used"
+    , thresholdValue = 80.0
+    }
+, Threshold 
+    { thresholdName = "Local declarations used"
+    , thresholdRegex = "(\\d+)% local declarations used"
+    , thresholdValue = 80.0
+    }
+, Threshold 
+    { thresholdName = "Top-level declarations used"
+    , thresholdRegex = "(\\d+)% top-level declarations used"
+    , thresholdValue = 80.0
+    }
+]

coverage.sh

@@ -0,0 +1,12 @@
+#!/bin/bash
+
+set -e
+
+if ! [ -x "$(command -v hpc-threshold)" ]; then
+  stack install hpc-threshold
+fi
+
+stack hpc report --all 2>&1 | hpc-threshold > hpc-threshold.log
+
+# exit code
+exit $?

package.yaml

@@ -73,17 +73,19 @@ executables:
         TupleSections ExistentialQuantification TypeApplications UndecidableInstances BangPatterns ViewPatterns
         GADTs
 tests:
-  confcrypt-test:
-    main:                Tests.hs
+  confcrypt-detailed-tests:
+    main:                DetailedTests.hs
     source-dirs:
         - test
         - app
     other-modules:
         ConfCrypt.Parser.Tests,
         ConfCrypt.Commands.Tests,
         ConfCrypt.Encryption.Tests,
+        ConfCrypt.CLI.API,
         ConfCrypt.CLI.API.Tests,
         ConfCrypt.Common
+        Tests
     ghc-options:
     - -threaded
     - -rtsopts
@@ -98,3 +100,35 @@ tests:
     - memory
     default-extensions: MultiParamTypeClasses OverloadedStrings FlexibleContexts FlexibleInstances NamedFieldPuns
         TupleSections
+
+  confcrypt-threshold-tests:
+    main:                ThresholdTests.hs
+    source-dirs:
+        - test
+        - app
+    other-modules:
+        ConfCrypt.Parser.Tests,
+        ConfCrypt.Commands.Tests,
+        ConfCrypt.Encryption.Tests,
+        ConfCrypt.CLI.API,
+        ConfCrypt.CLI.API.Tests,
+        ConfCrypt.Common,
+        ConsoleReporter
+        Tests
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - confcrypt
+    - tasty
+    - tasty-quickcheck
+    - QuickCheck
+    - tasty-hunit
+    - HUnit
+    - memory
+    - tagged
+    - generic-deriving
+    - stm
+    default-extensions: MultiParamTypeClasses OverloadedStrings FlexibleContexts FlexibleInstances NamedFieldPuns
+        TupleSections

test/ConsoleReporter.hs

@@ -0,0 +1,169 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+
+module ConsoleReporter (thresholdRunner, Threshold(..) ) where
+
+import Control.Applicative
+import Control.Monad (mfilter)
+import Control.Monad.IO.Class (liftIO)
+import Data.Maybe (fromMaybe)
+import Data.Monoid (Sum(..))
+import Data.Proxy (Proxy(..))
+import Data.Tagged (Tagged(..))
+import Data.Typeable (Typeable)
+import GHC.Generics (Generic)
+import Generics.Deriving.Monoid (memptydefault, mappenddefault)
+import Options.Applicative (metavar)
+
+import qualified Control.Concurrent.STM as STM
+import qualified Control.Monad.State as State
+import qualified Data.Functor.Compose as Functor
+import qualified Data.IntMap as IntMap
+import qualified Test.Tasty as Tasty
+import qualified Test.Tasty.Providers as Tasty
+import qualified Test.Tasty.Options as Tasty
+import qualified Test.Tasty.Runners as Tasty
+
+--------------------------------------------------------------------------------
+newtype Threshold = Threshold Double
+  deriving (Ord, Eq, Typeable)
+instance Tasty.IsOption (Maybe Threshold) where
+  defaultValue = Just $ Threshold 80
+  parseValue = Just . mfilter inRange . fmap Threshold . Tasty.safeRead
+  optionName = Tagged "threshold"
+  optionHelp = Tagged "A success threshold percentage"
+  optionCLParser = Tasty.mkOptionCLParser (metavar "NUMBER")
+
+inRange :: Threshold -> Bool
+inRange (Threshold x) = x `elem` [0..100]
+
+--------------------------------------------------------------------------------
+data Summary = Summary { summaryFailures :: Sum Int
+                       , summaryErrors :: Sum Int
+                       , summarySuccesses :: Sum Int
+                       } deriving (Generic, Show)
+
+instance Monoid Summary where
+  mempty = memptydefault
+#if !MIN_VERSION_base(4,11,0)
+  mappend = mappenddefault
+#else
+instance Semigroup Summary where
+  (<>) = mappenddefault
+#endif
+
+
+--------------------------------------------------------------------------------
+{-|
+
+  To run tests using this ingredient, use 'Tasty.defaultMainWithIngredients',
+  passing 'thresholdRunner' as one possible ingredient. This ingredient will
+  run tests if you pass the @--threshold@ command line option. For example,
+  @--threshold 90@ will run all the tests and return an error exit code
+  if success percentage is under 90%.
+
+-}
+thresholdRunner :: Tasty.Ingredient
+thresholdRunner = Tasty.TestReporter optionDescription runner
+ where
+  optionDescription = [ Tasty.Option (Proxy :: Proxy (Maybe Threshold)) ]
+  runner options testTree = do
+    Threshold threshold <- Tasty.lookupOption options
+
+    return $ \statusMap ->
+      let
+        runTest :: (Tasty.IsTest t)
+                => Tasty.OptionSet
+                -> Tasty.TestName
+                -> t
+                -> Tasty.Traversal (Functor.Compose (State.StateT IntMap.Key IO) (Const Summary))
+        runTest _ _ _ = Tasty.Traversal $ Functor.Compose $ do
+          i <- State.get
+          summary <- liftIO $ STM.atomically $ do
+            status <- STM.readTVar $
+              fromMaybe (error "Attempted to lookup test by index outside bounds") $
+                IntMap.lookup i statusMap
+
+            case status of
+              -- If the test is done, record its result
+              Tasty.Done result
+                | Tasty.resultSuccessful result ->
+                    pure $ mempty { summarySuccesses = Sum 1 }
+                | otherwise ->
+                    case resultException result of
+                      Just _  -> pure $ mempty { summaryErrors = Sum 1 }
+                      Nothing -> pure $
+                        if resultTimedOut result
+                          then mempty { summaryErrors = Sum 1 }
+                          else mempty { summaryFailures = Sum 1 }
+
+              -- Otherwise the test has either not been started or is currently
+              -- executing
+              _ -> STM.retry
+
+          Const summary <$ State.modify (+ 1)
+
+      in do
+        (Const summary, _) <-
+          flip State.runStateT 0 $ Functor.getCompose $ Tasty.getTraversal $
+           Tasty.foldTestTree
+             Tasty.trivialFold { Tasty.foldSingle = runTest }
+             options
+             testTree
+
+        return $ \ _ -> do
+          let total = count summary
+              ratio2NumOfTests = show $ ceiling $ total * threshold / 100.0
+              ratios = mkRatios total summary
+              fieldS f = show $ getSum $ f summary
+              round2dp x = show $ fromIntegral (round $ x * 1e2) / 1e2
+              fieldR f = round2dp $ f ratios
+              r0 = "\nNumber of tests: " ++ show total ++ ", Threshold: "
+                ++ show threshold ++ "% => " ++ ratio2NumOfTests ++ " tests"
+              r1 = "\nFailures: " ++ fieldS summaryFailures
+                ++ " (" ++ fieldR rFailures ++ "%)"
+              r2 = "Errors: " ++ fieldS summaryErrors
+                ++ " (" ++ fieldR rErrors ++ "%)"
+              r3 = "Successes: " ++ fieldS summarySuccesses
+                ++ " (" ++ fieldR rSuccesses ++ "%)"
+          liftIO $ putStrLn $ r0 ++ r1 ++ ", " ++ r2 ++ ", " ++ r3
+          return $ check threshold total summary
+
+  resultException r =
+    case Tasty.resultOutcome r of
+         Tasty.Failure (Tasty.TestThrewException e) -> Just e
+         _ -> Nothing
+
+  resultTimedOut r =
+    case Tasty.resultOutcome r of
+         Tasty.Failure (Tasty.TestTimedOut _) -> True
+         _ -> False
+
+data Ratio = Ratio { rFailures :: Double
+                   , rErrors :: Double
+                   , rSuccesses :: Double
+                   }
+
+count :: Summary -> Double
+count summary =
+  fromIntegral $ getSum $ summarySuccesses summary
+                       <> summaryFailures summary
+                       <> summaryErrors summary
+
+mkRatios :: Double -> Summary -> Ratio
+mkRatios total summary =
+  let ratio n = n * 100 / total
+      field f = fromIntegral $ getSum $ f summary
+  in Ratio { rFailures = ratio (field summaryFailures)
+           , rErrors = ratio (field summaryErrors)
+           , rSuccesses = ratio (field summarySuccesses) }
+
+check :: Double -> Double -> Summary -> Bool
+check threshold total summary =
+  let success = fromIntegral $ getSum $ summarySuccesses summary
+      ratio = success * 100 / total
+  in ratio >= threshold

test/DetailedTests.hs

@@ -0,0 +1,8 @@
+import Tests
+import Test.Tasty (defaultMain, testGroup)
+
+main :: IO ()
+main = defaultMain $ testGroup "all tests" [
+    appTests,
+    libraryTests
+    ]

test/Tests.hs

@@ -1,14 +1,10 @@
+module Tests (appTests, libraryTests) where
+
 import ConfCrypt.Parser.Tests (parserTests)
 import ConfCrypt.Commands.Tests (commandTests)
 import ConfCrypt.Encryption.Tests (encryptionTests)
 import ConfCrypt.CLI.API.Tests (cliAPITests)
-import Test.Tasty (TestTree, defaultMain, testGroup)
-
-main :: IO ()
-main = defaultMain $ testGroup "all tests" [
-    appTests,
-    libraryTests
-    ]
+import Test.Tasty (TestTree, testGroup)
 
 appTests :: TestTree
 appTests = testGroup "all application tests" [

test/ThresholdTests.hs

@@ -0,0 +1,11 @@
+import Tests
+import Test.Tasty (defaultMainWithIngredients, testGroup)
+import Test.Tasty.Ingredients.ConsoleReporter (consoleTestReporter)
+import ConsoleReporter (thresholdRunner)
+
+main :: IO ()
+main = defaultMainWithIngredients [thresholdRunner, consoleTestReporter]
+     $ testGroup "all tests" [
+     appTests,
+     libraryTests
+     ]

threshold-test.sh

@@ -0,0 +1,6 @@
+#!/bin/bash
+
+# All tests with default 80% threshold:
+stack test :confcrypt-threshold-tests --coverage
+# All tests with provided threshold (example with 90%):
+#stack test :confcrypt-threshold-tests --coverage --ta "--threshold 90"