Issue03 test and coverage thresholds

.circleci/config.yml

@@ -7,7 +7,7 @@ defaults: &defaults
       CIRCLE_TEST_REPORTS: /tmp/circleci-test-results  # Came from Circle's own translation utility, not sure if really needed
 
     docker:
-    - image: haskell:8.4.3
+    - image: jhenligne/confcrypt:0.0
 
 version: 2
 jobs:
@@ -16,19 +16,6 @@ jobs:
     steps:
     - checkout
     - run: mkdir -p $CIRCLE_ARTIFACTS $CIRCLE_TEST_REPORTS
-
-    # Install libsysconfcpus, which allows us to intercept calls from ghc -> host OS and return the number of available cores rather
-    # than the total number of host cores. ie. run the build w/ the allowed 2 cores, instead of 32 or whatever the host indicates.
-    - run: if [ ! -d sysconfcpus/bin ];
-           then
-                buildDir=pwd
-                git clone https://github.com/obmarg/libsysconfcpus.git;
-                cd libsysconfcpus ;
-                ./configure;
-                make && make install;
-                cd ..;
-           fi
-
     - restore_cache:
         keys:
         # This branch if available
@@ -37,26 +24,85 @@ jobs:
         - circle20-master-
         # Any branch if there are none on the default branch - this should be unnecessary if you have your default branch configured correctly
         - circle20-
-
     - run:
-        command: sysconfcpus -n 2 stack test
+        command: sysconfcpus -n 2 stack test :confcrypt-detailed-tests
         no_output_timeout: 3600s
-
     - store_test_results:
         path: $CIRCLE_ARTIFACTS
     - store_artifacts:
         path: $CIRCLE_ARTIFACTS
     - store_artifacts:
         path: $CIRCLE_TEST_REPORTS
+
+  threshold-test-job:
+    <<: *defaults
+    steps:
+    - checkout
+    - restore_cache:
+          name: Restore Cached Dependencies
+          keys:
+            - cci-haskell-v1-{{ checksum "package.yaml" }}-{{ checksum "stack.yaml" }}
+    - run:
+          name: Resolve/Update Dependencies
+          command: stack setup
+    - save_cache:
+          name: Cache Dependencies
+          key: cci-haskell-v1-{{ checksum "package.yaml" }}-{{ checksum "stack.yaml" }}
+          paths:
+            - ~/.stack
+            - .stack-work
+    - restore_cache:
+        keys:
+        # This branch if available
+        - circle20-{{ .Branch }}-
+        # Default branch if not
+        - circle20-master-
+        # Any branch if there are none on the default branch - this should be unnecessary if you have your default branch configured correctly
+        - circle20-
+        - haskell-stack
+    - run:
+        # 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
+    - save_cache:
+          name: Stack Artifacts
+          key: haskell-stack
+          paths:
+            - .stack-work
+
+  coverage-job:
+    <<: *defaults
+    steps:
+    - checkout
+    - restore_cache:
+        keys:
+        # This branch if available
+        - circle20-{{ .Branch }}-
+        # Default branch if not
+        - circle20-master-
+        # Any branch if there are none on the default branch - this should be unnecessary if you have your default branch configured correctly
+        - circle20-
+        - haskell-stack
+    - run:
+        command: stack hpc report --all 2>&1 | hpc-threshold
+        no_output_timeout: 3600s
+
   lint-job:
       <<: *defaults
       steps:
       - checkout
       - run: source hlint.sh
+
 workflows:
     version: 2
 
     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
+    }
+]

package.yaml

@@ -77,18 +77,48 @@ 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
+    - -with-rtsopts=-N
+    dependencies:
+    - confcrypt
+    - tasty
+    - tasty-quickcheck
+    - QuickCheck
+    - tasty-hunit
+    - HUnit
+    - 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,
-        ConfCrypt.CLI.API
+        ConsoleReporter
+        Tests
     ghc-options:
     - -threaded
     - -rtsopts
@@ -101,5 +131,8 @@ tests:
     - 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
+    ]