{- |
Module      : Web.Api.WebDriver.Assert
Description : Mini language for making falsifiable assertions.
Copyright   : 2018, Automattic, Inc.
License     : GPL-3
Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)
Stability   : experimental
Portability : POSIX

In this module we define assertions as first class objects and some helper functions for creating and manipulating them.
-}

{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
module Web.Api.WebDriver.Assert (
  -- * Assertions
    Assertion()
  , success
  , failure
  , AssertionStatement(..)
  , AssertionComment(..)
  , AssertionResult()
  , isSuccess
  , printAssertion

  -- * The `Assert` Class
  , Assert(..)

  -- * Assertion Summaries
  , AssertionSummary(..)
  , summarize
  , summarizeAll
  , printSummary
  , numAssertions

  -- * Basic Assertions
  , assertSuccessIf
  , assertSuccess
  , assertFailure
  , assertTrue
  , assertFalse
  , assertEqual
  , assertNotEqual
  , assertIsSubstring
  , assertIsNotSubstring
  , assertIsNamedSubstring
  , assertIsNotNamedSubstring
  ) where

import Data.List
  ( isInfixOf )
import Data.String
  ( IsString, fromString )
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Test.QuickCheck
  ( Arbitrary(..) )



-- | An `Assertion` consists of the following:
--
-- * A human-readable statement being asserted, which may be either true or false.
-- * A result (either success or failure).
-- * A comment, representing /why/ the assertion was made, to assist in debugging.
--
-- To construct assertions outside this module, use `success` and `failure`.

data Assertion = Assertion
  { Assertion -> AssertionStatement
assertionStatement :: AssertionStatement
  , Assertion -> AssertionComment
assertionComment :: AssertionComment
  , Assertion -> AssertionResult
assertionResult :: AssertionResult
  } deriving (Assertion -> Assertion -> Bool
(Assertion -> Assertion -> Bool)
-> (Assertion -> Assertion -> Bool) -> Eq Assertion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assertion -> Assertion -> Bool
$c/= :: Assertion -> Assertion -> Bool
== :: Assertion -> Assertion -> Bool
$c== :: Assertion -> Assertion -> Bool
Eq, Int -> Assertion -> ShowS
[Assertion] -> ShowS
Assertion -> String
(Int -> Assertion -> ShowS)
-> (Assertion -> String)
-> ([Assertion] -> ShowS)
-> Show Assertion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Assertion] -> ShowS
$cshowList :: [Assertion] -> ShowS
show :: Assertion -> String
$cshow :: Assertion -> String
showsPrec :: Int -> Assertion -> ShowS
$cshowsPrec :: Int -> Assertion -> ShowS
Show)



-- | Human-readable statement which may be true or false.
newtype AssertionStatement = AssertionStatement
  { AssertionStatement -> Text
theAssertionStatement :: Text
  } deriving AssertionStatement -> AssertionStatement -> Bool
(AssertionStatement -> AssertionStatement -> Bool)
-> (AssertionStatement -> AssertionStatement -> Bool)
-> Eq AssertionStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssertionStatement -> AssertionStatement -> Bool
$c/= :: AssertionStatement -> AssertionStatement -> Bool
== :: AssertionStatement -> AssertionStatement -> Bool
$c== :: AssertionStatement -> AssertionStatement -> Bool
Eq

instance Show AssertionStatement where
  show :: AssertionStatement -> String
show = Text -> String
T.unpack (Text -> String)
-> (AssertionStatement -> Text) -> AssertionStatement -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssertionStatement -> Text
theAssertionStatement

instance IsString AssertionStatement where
  fromString :: String -> AssertionStatement
fromString = Text -> AssertionStatement
AssertionStatement (Text -> AssertionStatement)
-> (String -> Text) -> String -> AssertionStatement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance Arbitrary AssertionStatement where
  arbitrary :: Gen AssertionStatement
arbitrary = Text -> AssertionStatement
AssertionStatement (Text -> AssertionStatement) -> Gen Text -> Gen AssertionStatement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack Gen String
forall a. Arbitrary a => Gen a
arbitrary)



-- | Human-readable explanation for why an assertion is made.
newtype AssertionComment = AssertionComment
  { AssertionComment -> Text
theAssertionComment :: Text
  } deriving AssertionComment -> AssertionComment -> Bool
(AssertionComment -> AssertionComment -> Bool)
-> (AssertionComment -> AssertionComment -> Bool)
-> Eq AssertionComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssertionComment -> AssertionComment -> Bool
$c/= :: AssertionComment -> AssertionComment -> Bool
== :: AssertionComment -> AssertionComment -> Bool
$c== :: AssertionComment -> AssertionComment -> Bool
Eq

instance Show AssertionComment where
  show :: AssertionComment -> String
show = Text -> String
T.unpack (Text -> String)
-> (AssertionComment -> Text) -> AssertionComment -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssertionComment -> Text
theAssertionComment

instance IsString AssertionComment where
  fromString :: String -> AssertionComment
fromString = Text -> AssertionComment
AssertionComment (Text -> AssertionComment)
-> (String -> Text) -> String -> AssertionComment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance Arbitrary AssertionComment where
  arbitrary :: Gen AssertionComment
arbitrary = Text -> AssertionComment
AssertionComment (Text -> AssertionComment) -> Gen Text -> Gen AssertionComment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack Gen String
forall a. Arbitrary a => Gen a
arbitrary)



-- | Type representing the result (success or failure) of an evaluated assertion.
data AssertionResult
  = AssertSuccess | AssertFailure
  deriving (AssertionResult -> AssertionResult -> Bool
(AssertionResult -> AssertionResult -> Bool)
-> (AssertionResult -> AssertionResult -> Bool)
-> Eq AssertionResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssertionResult -> AssertionResult -> Bool
$c/= :: AssertionResult -> AssertionResult -> Bool
== :: AssertionResult -> AssertionResult -> Bool
$c== :: AssertionResult -> AssertionResult -> Bool
Eq, Int -> AssertionResult -> ShowS
[AssertionResult] -> ShowS
AssertionResult -> String
(Int -> AssertionResult -> ShowS)
-> (AssertionResult -> String)
-> ([AssertionResult] -> ShowS)
-> Show AssertionResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssertionResult] -> ShowS
$cshowList :: [AssertionResult] -> ShowS
show :: AssertionResult -> String
$cshow :: AssertionResult -> String
showsPrec :: Int -> AssertionResult -> ShowS
$cshowsPrec :: Int -> AssertionResult -> ShowS
Show)

instance Arbitrary AssertionResult where
  arbitrary :: Gen AssertionResult
arbitrary = do
    Bool
p <- Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
    AssertionResult -> Gen AssertionResult
forall (m :: * -> *) a. Monad m => a -> m a
return (AssertionResult -> Gen AssertionResult)
-> AssertionResult -> Gen AssertionResult
forall a b. (a -> b) -> a -> b
$ if Bool
p then AssertionResult
AssertSuccess else AssertionResult
AssertFailure

-- | Detects successful assertions.
isSuccess :: Assertion -> Bool
isSuccess :: Assertion -> Bool
isSuccess Assertion
a = AssertionResult
AssertSuccess AssertionResult -> AssertionResult -> Bool
forall a. Eq a => a -> a -> Bool
== Assertion -> AssertionResult
assertionResult Assertion
a



-- | Basic string representation of an assertion.
printAssertion :: Assertion -> Text
printAssertion :: Assertion -> Text
printAssertion Assertion{AssertionResult
AssertionComment
AssertionStatement
assertionResult :: AssertionResult
assertionComment :: AssertionComment
assertionStatement :: AssertionStatement
assertionResult :: Assertion -> AssertionResult
assertionComment :: Assertion -> AssertionComment
assertionStatement :: Assertion -> AssertionStatement
..} =
  case AssertionResult
assertionResult of
    AssertionResult
AssertSuccess -> 
      [Text] -> Text
T.unwords
        [ Text
"\x1b[1;32mValid Assertion\x1b[0;39;49m"
        , Text
"\nassertion: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AssertionStatement -> Text
theAssertionStatement AssertionStatement
assertionStatement
        , Text
"\ncomment: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AssertionComment -> Text
theAssertionComment AssertionComment
assertionComment
        ]
    AssertionResult
AssertFailure ->
      [Text] -> Text
T.unwords
        [ Text
"\x1b[1;31mInvalid Assertion\x1b[0;39;49m"
        , Text
"\nassertion: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AssertionStatement -> Text
theAssertionStatement AssertionStatement
assertionStatement
        , Text
"\ncomment: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AssertionComment -> Text
theAssertionComment AssertionComment
assertionComment
        ]



-- | Construct a successful assertion.
success
  :: AssertionStatement -- ^ Statement being asserted (the /what/)
  -> AssertionComment -- ^ An additional comment (the /why/)
  -> Assertion
success :: AssertionStatement -> AssertionComment -> Assertion
success AssertionStatement
statement AssertionComment
comment = Assertion :: AssertionStatement
-> AssertionComment -> AssertionResult -> Assertion
Assertion
  { assertionStatement :: AssertionStatement
assertionStatement = AssertionStatement
statement
  , assertionComment :: AssertionComment
assertionComment = AssertionComment
comment
  , assertionResult :: AssertionResult
assertionResult = AssertionResult
AssertSuccess
  }

-- | Construct a failed assertion.
failure
  :: AssertionStatement -- ^ Statement being asserted (the /what/)
  -> AssertionComment -- ^ An additional comment (the /why/)
  -> Assertion
failure :: AssertionStatement -> AssertionComment -> Assertion
failure AssertionStatement
statement AssertionComment
comment = Assertion :: AssertionStatement
-> AssertionComment -> AssertionResult -> Assertion
Assertion
  { assertionStatement :: AssertionStatement
assertionStatement = AssertionStatement
statement
  , assertionComment :: AssertionComment
assertionComment = AssertionComment
comment
  , assertionResult :: AssertionResult
assertionResult = AssertionResult
AssertFailure
  }



-- | Assertions are made and evaluated inside some context, represented by the `Assert` class.
class Assert m where
  -- | Make an assertion. Typically @m@ is a monad, and the `Assert` instance handles the assertion in @m@ by e.g. logging it, changing state, etc.
  assert :: Assertion -> m ()



-- | Generic boolean assertion; asserts success if @Bool@ is true and failure otherwise.
assertSuccessIf
  :: (Monad m, Assert m)
  => Bool
  -> AssertionStatement -- ^ Statement being asserted (the /what/)
  -> AssertionComment -- ^ An additional comment (the /why/)
  -> m ()
assertSuccessIf :: Bool -> AssertionStatement -> AssertionComment -> m ()
assertSuccessIf Bool
p AssertionStatement
statement AssertionComment
comment =
  Assertion -> m ()
forall (m :: * -> *). Assert m => Assertion -> m ()
assert (Assertion -> m ()) -> Assertion -> m ()
forall a b. (a -> b) -> a -> b
$ (if Bool
p then AssertionStatement -> AssertionComment -> Assertion
success else AssertionStatement -> AssertionComment -> Assertion
failure) AssertionStatement
statement AssertionComment
comment

-- | Assertion that always succeeds.
assertSuccess
  :: (Monad m, Assert m)
  => AssertionComment -- ^ An additional comment (the /why/)
  -> m ()
assertSuccess :: AssertionComment -> m ()
assertSuccess = Bool -> AssertionStatement -> AssertionComment -> m ()
forall (m :: * -> *).
(Monad m, Assert m) =>
Bool -> AssertionStatement -> AssertionComment -> m ()
assertSuccessIf Bool
True (Text -> AssertionStatement
AssertionStatement Text
"Success!")

-- | Assertion that always fails.
assertFailure
  :: (Monad m, Assert m)
  => AssertionComment -- ^ An additional comment (the /why/)
  -> m ()
assertFailure :: AssertionComment -> m ()
assertFailure = Bool -> AssertionStatement -> AssertionComment -> m ()
forall (m :: * -> *).
(Monad m, Assert m) =>
Bool -> AssertionStatement -> AssertionComment -> m ()
assertSuccessIf Bool
False (Text -> AssertionStatement
AssertionStatement Text
"Failure :(")

-- | Succeeds if @Bool@ is `True`.
assertTrue
  :: (Monad m, Assert m)
  => Bool
  -> AssertionComment -- ^ An additional comment (the /why/)
  -> m ()
assertTrue :: Bool -> AssertionComment -> m ()
assertTrue Bool
p = Bool -> AssertionStatement -> AssertionComment -> m ()
forall (m :: * -> *).
(Monad m, Assert m) =>
Bool -> AssertionStatement -> AssertionComment -> m ()
assertSuccessIf Bool
p
  (Text -> AssertionStatement
AssertionStatement (Text -> AssertionStatement) -> Text -> AssertionStatement
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Bool -> String
forall a. Show a => a -> String
show Bool
p) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is True")

-- | Succeeds if @Bool@ is `False`.
assertFalse
  :: (Monad m, Assert m)
  => Bool
  -> AssertionComment -- ^ An additional comment (the /why/)
  -> m ()
assertFalse :: Bool -> AssertionComment -> m ()
assertFalse Bool
p = Bool -> AssertionStatement -> AssertionComment -> m ()
forall (m :: * -> *).
(Monad m, Assert m) =>
Bool -> AssertionStatement -> AssertionComment -> m ()
assertSuccessIf (Bool -> Bool
not Bool
p)
  (Text -> AssertionStatement
AssertionStatement (Text -> AssertionStatement) -> Text -> AssertionStatement
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Bool -> String
forall a. Show a => a -> String
show Bool
p) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is False")

-- | Succeeds if the given @t@s are equal according to their `Eq` instance.
assertEqual
  :: (Monad m, Assert m, Eq t, Show t)
  => t
  -> t
  -> AssertionComment -- ^ An additional comment (the /why/)
  -> m ()
assertEqual :: t -> t -> AssertionComment -> m ()
assertEqual t
x t
y = Bool -> AssertionStatement -> AssertionComment -> m ()
forall (m :: * -> *).
(Monad m, Assert m) =>
Bool -> AssertionStatement -> AssertionComment -> m ()
assertSuccessIf (t
x t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
y)
  (Text -> AssertionStatement
AssertionStatement (Text -> AssertionStatement) -> Text -> AssertionStatement
forall a b. (a -> b) -> a -> b
$
    String -> Text
T.pack (t -> String
forall a. Show a => a -> String
show t
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is equal to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (t -> String
forall a. Show a => a -> String
show t
y))

-- | Succeeds if the given @t@s are not equal according to their `Eq` instance.
assertNotEqual
  :: (Monad m, Assert m, Eq t, Show t)
  => t
  -> t
  -> AssertionComment -- ^ An additional comment (the /why/)
  -> m ()
assertNotEqual :: t -> t -> AssertionComment -> m ()
assertNotEqual t
x t
y = Bool -> AssertionStatement -> AssertionComment -> m ()
forall (m :: * -> *).
(Monad m, Assert m) =>
Bool -> AssertionStatement -> AssertionComment -> m ()
assertSuccessIf (t
x t -> t -> Bool
forall a. Eq a => a -> a -> Bool
/= t
y)
  (Text -> AssertionStatement
AssertionStatement (Text -> AssertionStatement) -> Text -> AssertionStatement
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (t -> String
forall a. Show a => a -> String
show t
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not equal to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (t -> String
forall a. Show a => a -> String
show t
y))

-- | Succeeds if the first list is an infix of the second, according to their `Eq` instance.
assertIsSubstring
  :: (Monad m, Assert m)
  => Text
  -> Text
  -> AssertionComment -- ^ An additional comment (the /why/)
  -> m ()
assertIsSubstring :: Text -> Text -> AssertionComment -> m ()
assertIsSubstring Text
x Text
y = Bool -> AssertionStatement -> AssertionComment -> m ()
forall (m :: * -> *).
(Monad m, Assert m) =>
Bool -> AssertionStatement -> AssertionComment -> m ()
assertSuccessIf (Text -> Text -> Bool
T.isInfixOf Text
x Text
y)
  (Text -> AssertionStatement
AssertionStatement (Text -> AssertionStatement) -> Text -> AssertionStatement
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is a substring of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
y))

-- | Succeeds if the first list is not an infix of the second, according to their `Eq` instance.
assertIsNotSubstring
  :: (Monad m, Assert m)
  => Text
  -> Text
  -> AssertionComment -- ^ An additional comment (the /why/)
  -> m ()
assertIsNotSubstring :: Text -> Text -> AssertionComment -> m ()
assertIsNotSubstring Text
x Text
y = Bool -> AssertionStatement -> AssertionComment -> m ()
forall (m :: * -> *).
(Monad m, Assert m) =>
Bool -> AssertionStatement -> AssertionComment -> m ()
assertSuccessIf (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bool
T.isInfixOf Text
x Text
y)
  (Text -> AssertionStatement
AssertionStatement (Text -> AssertionStatement) -> Text -> AssertionStatement
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a substring of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
y))

-- | Succeeds if the first list is an infix of the second, named list, according to their `Eq` instance. This is similar to `assertIsSubstring`, except that the "name" of the second list argument is used in reporting failures. Handy if the second list is very large -- say the source of a webpage.
assertIsNamedSubstring
  :: (Monad m, Assert m)
  => Text
  -> (Text,Text)
  -> AssertionComment -- ^ An additional comment (the /why/)
  -> m ()
assertIsNamedSubstring :: Text -> (Text, Text) -> AssertionComment -> m ()
assertIsNamedSubstring Text
x (Text
y,Text
name) = Bool -> AssertionStatement -> AssertionComment -> m ()
forall (m :: * -> *).
(Monad m, Assert m) =>
Bool -> AssertionStatement -> AssertionComment -> m ()
assertSuccessIf (Text -> Text -> Bool
T.isInfixOf Text
x Text
y)
  (Text -> AssertionStatement
AssertionStatement (Text -> AssertionStatement) -> Text -> AssertionStatement
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is a substring of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name)

-- | Succeeds if the first list is not an infix of the second, named list, according to their `Eq` instance. This is similar to `assertIsNotSubstring`, except that the "name" of the second list argument is used in reporting failures. Handy if the second list is very large -- say the source of a webpage.
assertIsNotNamedSubstring
  :: (Monad m, Assert m)
  => Text
  -> (Text,Text)
  -> AssertionComment -- ^ An additional comment (the /why/)
  -> m ()
assertIsNotNamedSubstring :: Text -> (Text, Text) -> AssertionComment -> m ()
assertIsNotNamedSubstring Text
x (Text
y,Text
name) = Bool -> AssertionStatement -> AssertionComment -> m ()
forall (m :: * -> *).
(Monad m, Assert m) =>
Bool -> AssertionStatement -> AssertionComment -> m ()
assertSuccessIf (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bool
T.isInfixOf Text
x Text
y)
  (Text -> AssertionStatement
AssertionStatement (Text -> AssertionStatement) -> Text -> AssertionStatement
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a substring of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name)



-- | `Assertion`s are the most granular kind of "test" this library deals with. Typically we'll be interested in sets of many assertions. A single test case will include one or more assertions, which for reporting purposes we'd like to summarize. The summary for a list of assertions will include the number of successes, the number of failures, and the actual failures. Modeled this way assertion summaries form a monoid, which is handy.

data AssertionSummary = AssertionSummary
  { AssertionSummary -> Integer
numSuccesses :: Integer
  , AssertionSummary -> Integer
numFailures :: Integer
  , AssertionSummary -> [Assertion]
failures :: [Assertion]
  , AssertionSummary -> [Assertion]
successes :: [Assertion]
  } deriving (AssertionSummary -> AssertionSummary -> Bool
(AssertionSummary -> AssertionSummary -> Bool)
-> (AssertionSummary -> AssertionSummary -> Bool)
-> Eq AssertionSummary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssertionSummary -> AssertionSummary -> Bool
$c/= :: AssertionSummary -> AssertionSummary -> Bool
== :: AssertionSummary -> AssertionSummary -> Bool
$c== :: AssertionSummary -> AssertionSummary -> Bool
Eq, Int -> AssertionSummary -> ShowS
[AssertionSummary] -> ShowS
AssertionSummary -> String
(Int -> AssertionSummary -> ShowS)
-> (AssertionSummary -> String)
-> ([AssertionSummary] -> ShowS)
-> Show AssertionSummary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssertionSummary] -> ShowS
$cshowList :: [AssertionSummary] -> ShowS
show :: AssertionSummary -> String
$cshow :: AssertionSummary -> String
showsPrec :: Int -> AssertionSummary -> ShowS
$cshowsPrec :: Int -> AssertionSummary -> ShowS
Show)

instance Semigroup AssertionSummary where
  AssertionSummary
x <> :: AssertionSummary -> AssertionSummary -> AssertionSummary
<> AssertionSummary
y = AssertionSummary :: Integer
-> Integer -> [Assertion] -> [Assertion] -> AssertionSummary
AssertionSummary
    { numSuccesses :: Integer
numSuccesses = AssertionSummary -> Integer
numSuccesses AssertionSummary
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ AssertionSummary -> Integer
numSuccesses AssertionSummary
y
    , numFailures :: Integer
numFailures = AssertionSummary -> Integer
numFailures AssertionSummary
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ AssertionSummary -> Integer
numFailures AssertionSummary
y
    , failures :: [Assertion]
failures = AssertionSummary -> [Assertion]
failures AssertionSummary
x [Assertion] -> [Assertion] -> [Assertion]
forall a. [a] -> [a] -> [a]
++ AssertionSummary -> [Assertion]
failures AssertionSummary
y
    , successes :: [Assertion]
successes = AssertionSummary -> [Assertion]
successes AssertionSummary
x [Assertion] -> [Assertion] -> [Assertion]
forall a. [a] -> [a] -> [a]
++ AssertionSummary -> [Assertion]
successes AssertionSummary
y
    }

instance Monoid AssertionSummary where
  mempty :: AssertionSummary
mempty = Integer
-> Integer -> [Assertion] -> [Assertion] -> AssertionSummary
AssertionSummary Integer
0 Integer
0 [] []

  mappend :: AssertionSummary -> AssertionSummary -> AssertionSummary
mappend = AssertionSummary -> AssertionSummary -> AssertionSummary
forall a. Semigroup a => a -> a -> a
(<>)

-- | Summarize a single assertion.
summary :: Assertion -> AssertionSummary
summary :: Assertion -> AssertionSummary
summary Assertion
x = AssertionSummary :: Integer
-> Integer -> [Assertion] -> [Assertion] -> AssertionSummary
AssertionSummary
  { numSuccesses :: Integer
numSuccesses = if Assertion -> Bool
isSuccess Assertion
x then Integer
1 else Integer
0
  , numFailures :: Integer
numFailures = if Assertion -> Bool
isSuccess Assertion
x then Integer
0 else Integer
1
  , failures :: [Assertion]
failures = if Assertion -> Bool
isSuccess Assertion
x then [] else [Assertion
x]
  , successes :: [Assertion]
successes = if Assertion -> Bool
isSuccess Assertion
x then [Assertion
x] else []
  }

-- | Summarize a list of `Assertion`s.
summarize :: [Assertion] -> AssertionSummary
summarize :: [Assertion] -> AssertionSummary
summarize = [AssertionSummary] -> AssertionSummary
forall a. Monoid a => [a] -> a
mconcat ([AssertionSummary] -> AssertionSummary)
-> ([Assertion] -> [AssertionSummary])
-> [Assertion]
-> AssertionSummary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Assertion -> AssertionSummary)
-> [Assertion] -> [AssertionSummary]
forall a b. (a -> b) -> [a] -> [b]
map Assertion -> AssertionSummary
summary

-- | Summarize a list of `AssertionSummary`s.
summarizeAll :: [AssertionSummary] -> AssertionSummary
summarizeAll :: [AssertionSummary] -> AssertionSummary
summarizeAll = [AssertionSummary] -> AssertionSummary
forall a. Monoid a => [a] -> a
mconcat

-- | Very basic string representation of an `AssertionSummary`.
printSummary :: AssertionSummary -> IO ()
printSummary :: AssertionSummary -> IO ()
printSummary AssertionSummary{Integer
[Assertion]
successes :: [Assertion]
failures :: [Assertion]
numFailures :: Integer
numSuccesses :: Integer
successes :: AssertionSummary -> [Assertion]
failures :: AssertionSummary -> [Assertion]
numFailures :: AssertionSummary -> Integer
numSuccesses :: AssertionSummary -> Integer
..} = do
  (Assertion -> IO ()) -> [Assertion] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> IO ()
T.putStrLn (Text -> IO ()) -> (Assertion -> Text) -> Assertion -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assertion -> Text
printAssertion) [Assertion]
failures
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Assertions: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Integer
numSuccesses Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
numFailures)
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Failures: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
numFailures

-- | Total number of assertions made.
numAssertions :: AssertionSummary -> Integer
numAssertions :: AssertionSummary -> Integer
numAssertions AssertionSummary
x = AssertionSummary -> Integer
numSuccesses AssertionSummary
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ AssertionSummary -> Integer
numFailures AssertionSummary
x