<commit_before>-----------------------------------------------------------------------------
-- Copyright 2015, Ideas project team. This file is distributed under the
-- terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  <EMAIL>
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-- A lightweight wrapper for organizing tests (including QuickCheck tests). It
-- introduces the notion of a test suite, and it stores the test results for
-- later inspection (e.g., for the generation of a test report). A TestSuite
-- is a monoid.
--
-----------------------------------------------------------------------------

module Ideas.Common.Utils.TestSuite
   ( -- * TestSuite
     TestSuite, module Data.Monoid
   , suite, useProperty, usePropertyWith
   , assertTrue, assertNull, assertEquals, assertIO
   , assertMessage, assertMessageIO
   , onlyWarnings, rateOnError
     -- * Running a test suite
   , runTestSuite, runTestSuiteResult
     -- * Test Suite Result
   , Result, subResults, findSubResult
   , justOneSuite, allMessages, topMessages
   , nrOfTests, nrOfErrors, nrOfWarnings
   , timeInterval, makeSummary, printSummary
     -- * Message
   , Message, message, warning, messageLines
     -- * Status
   , Status, HasStatus(..)
   , isError, isWarning, isOk
     -- * Rating
   , Rating, HasRating(..)
   ) where

import Control.Exception
import Control.Monad
import Data.Foldable (toList)
import Data.IORef
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Time
import System.IO
import Test.QuickCheck hiding (Result)
import qualified Data.Sequence as S

----------------------------------------------------------------
-- Test Suite

newtype TestSuite = TS (S.Seq Test)

data Test = Case  String (IO Message)
          | Suite String TestSuite

instance Monoid TestSuite where
   mempty = TS mempty
   TS xs `mappend` TS ys = TS (xs <> ys)

tests :: TestSuite -> [Test]
tests (TS xs) = toList xs

makeTestSuite :: Test -> TestSuite
makeTestSuite = TS . S.singleton

----------------------------------------------------------------
-- Test suite constructors

-- | Construct a (named) test suite containing test cases and other suites
suite :: String -> [TestSuite] -> TestSuite
suite s = makeTestSuite . Suite s . mconcat

-- | Turn a QuickCheck property into the test suite. The first argument is
-- a label for the property
useProperty :: Testable prop => String -> prop -> TestSuite
useProperty = flip usePropertyWith stdArgs

-- | Turn a QuickCheck property into the test suite, also providing a test
-- configuration (Args)
usePropertyWith :: Testable prop => String -> Args -> prop -> TestSuite
usePropertyWith s args =
   makeTestSuite . Case s . liftM make . quickCheckWithResult args {chatty=False}
 where
   make qc =
      case qc of
         Success {} ->
            mempty
         Failure {reason = msg} ->
            message msg
         NoExpectedFailure {} ->
            message "no expected failure"
         GaveUp {numTests = i} ->
            warning ("passed only " ++ show i ++ " tests")

assertTrue :: String -> Bool -> TestSuite
assertTrue s = assertIO s . return

assertNull :: Show a => String -> [a] -> TestSuite
assertNull s xs = assertMessages s (null xs) (map show xs)

assertEquals :: (Eq a, Show a) => String -> a -> a -> TestSuite
assertEquals s x y = assertMessage s (x==y) $
   "not equal " ++ show x ++ " and " ++ show y

assertMessage :: String -> Bool -> String -> TestSuite<commit_msg>Adding missing pattern (for QuickCheck result)<commit_after>-----------------------------------------------------------------------------
-- Copyright 2015, Ideas project team. This file is distributed under the
-- terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  <EMAIL>
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-- A lightweight wrapper for organizing tests (including QuickCheck tests). It
-- introduces the notion of a test suite, and it stores the test results for
-- later inspection (e.g., for the generation of a test report). A TestSuite
-- is a monoid.
--
-----------------------------------------------------------------------------

module Ideas.Common.Utils.TestSuite
   ( -- * TestSuite
     TestSuite, module Data.Monoid
   , suite, useProperty, usePropertyWith
   , assertTrue, assertNull, assertEquals, assertIO
   , assertMessage, assertMessageIO
   , onlyWarnings, rateOnError
     -- * Running a test suite
   , runTestSuite, runTestSuiteResult
     -- * Test Suite Result
   , Result, subResults, findSubResult
   , justOneSuite, allMessages, topMessages
   , nrOfTests, nrOfErrors, nrOfWarnings
   , timeInterval, makeSummary, printSummary
     -- * Message
   , Message, message, warning, messageLines
     -- * Status
   , Status, HasStatus(..)
   , isError, isWarning, isOk
     -- * Rating
   , Rating, HasRating(..)
   ) where

import Control.Exception
import Control.Monad
import Data.Foldable (toList)
import Data.IORef
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Time
import System.IO
import Test.QuickCheck hiding (Result)
import qualified Data.Sequence as S

----------------------------------------------------------------
-- Test Suite

newtype TestSuite = TS (S.Seq Test)

data Test = Case  String (IO Message)
          | Suite String TestSuite

instance Monoid TestSuite where
   mempty = TS mempty
   TS xs `mappend` TS ys = TS (xs <> ys)

tests :: TestSuite -> [Test]
tests (TS xs) = toList xs

makeTestSuite :: Test -> TestSuite
makeTestSuite = TS . S.singleton

----------------------------------------------------------------
-- Test suite constructors

-- | Construct a (named) test suite containing test cases and other suites
suite :: String -> [TestSuite] -> TestSuite
suite s = makeTestSuite . Suite s . mconcat

-- | Turn a QuickCheck property into the test suite. The first argument is
-- a label for the property
useProperty :: Testable prop => String -> prop -> TestSuite
useProperty = flip usePropertyWith stdArgs

-- | Turn a QuickCheck property into the test suite, also providing a test
-- configuration (Args)
usePropertyWith :: Testable prop => String -> Args -> prop -> TestSuite
usePropertyWith s args =
   makeTestSuite . Case s . liftM make . quickCheckWithResult args {chatty=False}
 where
   make qc =
      case qc of
         Success {} ->
            mempty
         Failure {reason = msg} ->
            message msg
         NoExpectedFailure {} ->
            message "no expected failure"
         GaveUp {numTests = i} ->
            warning ("passed only " ++ show i ++ " tests")
         InsufficientCoverage {numTests = i} -> 
            warning ("only performed " ++ show i ++ " tests")

assertTrue :: String -> Bool -> TestSuite
assertTrue s = assertIO s . return

assertNull :: Show a => String -> [a] -> TestSuite
assertNull s xs = assertMessages s (null xs) (map show xs)

assertEquals :: (Eq a, Show a) => String -> a -> a -> TestSuite
assertEquals s x y = assertMessage s (x==y) $
   "not equal " ++ show x ++ " and " ++ show y

assertMessage :: String -> Bool -> String -> TestSuite
{'fraction_non_alphanumeric': 0.18571428571428572, 'fraction_numerical': 0.0016021361815754338, 'mean_word_length': 2.0954545454545452, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 62, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5377727', 'n_tokens_mistral': 1955, 'n_tokens_neox': 1906, 'n_words': 753}