{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-}

-- | This package provides the ability to run a Checklist of several
-- "checks" during a single test.  A "bad" check does not immediately
-- result in a test failure; at the end of the test (passed or failed
-- due to primary testing), all failed checks are reported (and any
-- failed checks will result in an overall test failure at the end.
--
-- This type of checking can be very useful when needing to test
-- various aspects of an operation that is complex to setup, has
-- multiple effects, or where the checks are related such that knowing
-- about the multiple failures makes debugging easier.
--
-- An alternative approach is to have some sort of common preparation
-- code and use a separate test for each item.  This module simply
-- provides a convenient method to collate related items under the
-- aegis of a single test.
--
-- This package also provides the 'checkValues' function which can be
-- used to check a number of derived values from a single input value
-- via a checklist.  This can be used to independently verify a number
-- of record fields of a data structure or to validate related
-- operations performed from a single input.
--
-- See the documentation for 'check' and 'checkValues' for examples of
-- using this library.  The tests in the source package also provide
-- additional examples of usage.

module Test.Tasty.Checklist
  (
    -- * Checklist testing context
    withChecklist
  , CanCheck
  -- * Performing or Disabling checks
  , check
  , discardCheck
  -- * Type-safe multi-check specifications
  -- $checkValues
  -- $setup
  , checkValues
  , DerivedVal(Val, Got, Observe)
  -- * Error reporting
  , CheckResult
  , ChecklistFailures
  -- * Displaying tested values
  , TestShow(testShow)
  , testShowList
  , multiLineDiff
  )
where

import           Control.Exception ( evaluate )
import           Control.Monad ( join, unless )
import           Control.Monad.Catch
import           Control.Monad.IO.Class ( MonadIO, liftIO )
import           Data.IORef
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Parameterized.Context as Ctx
import           Data.Text ( Text )
import qualified Data.Text as T
import           System.IO ( hFlush, hPutStrLn, stdout, stderr )


-- | The ChecklistFailures exception is thrown if any checks have
-- failed during testing.

data ChecklistFailures = ChecklistFailures Text [CheckResult]

-- | The internal 'CheckResult' captures the failure information for a check

data CheckResult = CheckFailed CheckName (Maybe InputAsText) FailureMessage
                 | CheckMessage Text

newtype CheckName = CheckName { CheckName -> Text
checkName :: Text }
newtype InputAsText = InputAsText { InputAsText -> Text
inputAsText :: Text } deriving (InputAsText -> InputAsText -> Bool
(InputAsText -> InputAsText -> Bool)
-> (InputAsText -> InputAsText -> Bool) -> Eq InputAsText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputAsText -> InputAsText -> Bool
== :: InputAsText -> InputAsText -> Bool
$c/= :: InputAsText -> InputAsText -> Bool
/= :: InputAsText -> InputAsText -> Bool
Eq, Eq InputAsText
Eq InputAsText
-> (InputAsText -> InputAsText -> Ordering)
-> (InputAsText -> InputAsText -> Bool)
-> (InputAsText -> InputAsText -> Bool)
-> (InputAsText -> InputAsText -> Bool)
-> (InputAsText -> InputAsText -> Bool)
-> (InputAsText -> InputAsText -> InputAsText)
-> (InputAsText -> InputAsText -> InputAsText)
-> Ord InputAsText
InputAsText -> InputAsText -> Bool
InputAsText -> InputAsText -> Ordering
InputAsText -> InputAsText -> InputAsText
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InputAsText -> InputAsText -> Ordering
compare :: InputAsText -> InputAsText -> Ordering
$c< :: InputAsText -> InputAsText -> Bool
< :: InputAsText -> InputAsText -> Bool
$c<= :: InputAsText -> InputAsText -> Bool
<= :: InputAsText -> InputAsText -> Bool
$c> :: InputAsText -> InputAsText -> Bool
> :: InputAsText -> InputAsText -> Bool
$c>= :: InputAsText -> InputAsText -> Bool
>= :: InputAsText -> InputAsText -> Bool
$cmax :: InputAsText -> InputAsText -> InputAsText
max :: InputAsText -> InputAsText -> InputAsText
$cmin :: InputAsText -> InputAsText -> InputAsText
min :: InputAsText -> InputAsText -> InputAsText
Ord)
newtype FailureMessage = FailureMessage { FailureMessage -> Text
failureMessage :: Text }

instance Exception ChecklistFailures

instance Show CheckResult where
  show :: CheckResult -> String
show (CheckFailed CheckName
what Maybe InputAsText
onValue FailureMessage
msg) =
    let chknm :: String
chknm = if [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Text -> [Text]
T.lines (CheckName -> Text
checkName CheckName
what)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
                then String
"check: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (CheckName -> Text
checkName CheckName
what)
                else String
"check '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (CheckName -> Text
checkName CheckName
what) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'"
        chkmsg :: String
chkmsg = if Text -> Bool
T.null (FailureMessage -> Text
failureMessage FailureMessage
msg)
                 then String
""
                 else String
" with: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (FailureMessage -> Text
failureMessage FailureMessage
msg)
                      -- n.b. msg might be carefully crafted to preceed chkval
        chkval :: String
chkval = case Maybe InputAsText
onValue of
          Maybe InputAsText
Nothing -> String
""
          Just InputAsText
i -> String
"\n        using:       " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (InputAsText -> Text
inputAsText InputAsText
i)
    in String
"Failed " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
chknm String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
chkmsg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
chkval
  show (CheckMessage Text
txt) = String
"-- " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
txt

instance Show ChecklistFailures where
  show :: ChecklistFailures -> String
show (ChecklistFailures Text
topMsg [CheckResult]
fails) =
    let isMessage :: CheckResult -> Bool
isMessage = \case
          CheckMessage Text
_ -> Bool
True
          CheckResult
_ -> Bool
False
        checkCnt :: Int
checkCnt = [CheckResult] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([CheckResult] -> Int) -> [CheckResult] -> Int
forall a b. (a -> b) -> a -> b
$ (CheckResult -> Bool) -> [CheckResult] -> [CheckResult]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (CheckResult -> Bool) -> CheckResult -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckResult -> Bool
isMessage) [CheckResult]
fails
    in String
"ERROR: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
topMsg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n  "
       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
checkCnt String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" checks failed in this checklist:\n  -"
       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n  -" (CheckResult -> String
forall a. Show a => a -> String
show (CheckResult -> String) -> [CheckResult] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CheckResult]
fails)

-- | A convenient Constraint to apply to functions that will perform
-- checks (i.e. call 'check' one or more times)

type CanCheck = (?checker :: IORef [CheckResult])


-- | This should be used to wrap the test that contains checks.  This
-- initializes the environment needed for the checks to run, and on
-- exit from the test, reports any (and all) failed checks as a test
-- failure.

withChecklist :: (MonadIO m, MonadMask m)
              => Text -> (CanCheck => m a) -> m a
withChecklist :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Text -> (CanCheck => m a) -> m a
withChecklist Text
topMsg CanCheck => m a
t = do
  IORef [CheckResult]
checks <- IO (IORef [CheckResult]) -> m (IORef [CheckResult])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [CheckResult]) -> m (IORef [CheckResult]))
-> IO (IORef [CheckResult]) -> m (IORef [CheckResult])
forall a b. (a -> b) -> a -> b
$ [CheckResult] -> IO (IORef [CheckResult])
forall a. a -> IO (IORef a)
newIORef [CheckResult]
forall a. Monoid a => a
mempty
  a
r <- (let ?checker = CanCheck
IORef [CheckResult]
checks in m a
CanCheck => m a
t)
       m a -> m () -> m a
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`onException` (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
                       do [CheckResult]
cs <- [CheckResult] -> [CheckResult]
forall a. [a] -> [a]
List.reverse ([CheckResult] -> [CheckResult])
-> IO [CheckResult] -> IO [CheckResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef [CheckResult] -> IO [CheckResult]
forall a. IORef a -> IO a
readIORef IORef [CheckResult]
checks
                          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([CheckResult] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CheckResult]
cs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                            Handle -> IO ()
hFlush Handle
stdout
                            Handle -> String -> IO ()
hPutStrLn Handle
stderr String
""
                            let pfx :: String
pfx = String
"        WARN "
                            (CheckResult -> IO ()) -> [CheckResult] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ())
-> (CheckResult -> String) -> CheckResult -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
pfx String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (CheckResult -> String) -> CheckResult -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckResult -> String
forall a. Show a => a -> String
show) [CheckResult]
cs
                            Handle -> IO ()
hFlush Handle
stderr
                     )

  -- If t failed, never get here:
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    [CheckResult]
collected <- [CheckResult] -> [CheckResult]
forall a. [a] -> [a]
List.reverse ([CheckResult] -> [CheckResult])
-> IO [CheckResult] -> IO [CheckResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef [CheckResult] -> IO [CheckResult]
forall a. IORef a -> IO a
readIORef IORef [CheckResult]
checks
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([CheckResult] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CheckResult]
collected) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      ChecklistFailures -> IO ()
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Text -> [CheckResult] -> ChecklistFailures
ChecklistFailures Text
topMsg [CheckResult]
collected)
  a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | This is used to run a check within the code.  The first argument
-- is the "name" of this check, the second is a function that takes a
-- value and returns 'True' if the value is OK, or 'False' if the
-- value fails the check.  The last argument is the value to check.
--
-- >>> :set -XOverloadedStrings
-- >>> import Test.Tasty
-- >>> import Test.Tasty.HUnit
-- >>> :{
-- >>> defaultMain $ testCase "odd numbers" $ withChecklist "odds" $ do
-- >>>  let three = 3 :: Int
-- >>>  check "three is odd" odd three
-- >>>  check "two is odd" odd (2 :: Int)
-- >>>  check "7 + 3 is odd" odd $ 7 + three
-- >>>  check "7 is odd" odd (7 :: Int)
-- >>> :}
-- odd numbers: FAIL
--   Exception: ERROR: odds
--     2 checks failed in this checklist:
--     -Failed check 'two is odd' with: 2
--     -Failed check '7 + 3 is odd' with: 10
-- <BLANKLINE>
-- 1 out of 1 tests failed (...s)
-- *** Exception: ExitFailure 1
--
-- Any check failures are also printed to stdout (and omitted from the
-- above for clarity).  This is so that those failures are reported
-- even if a more standard test assertion is used that prevents
-- completion of the checklist.  Thus, if an @assertEqual "values"
-- three 7@ had been added to the above, that would have been the only
-- actual (and immediate) fail for the test, but any failing 'check's
-- appearing before that @assertEqual@ would still have printed.

check :: (CanCheck, TestShow a, MonadIO m)
      => Text -> (a -> Bool) -> a -> m ()
check :: forall a (m :: * -> *).
(CanCheck, TestShow a, MonadIO m) =>
Text -> (a -> Bool) -> a -> m ()
check = (a -> String)
-> Maybe InputAsText -> Text -> (a -> Bool) -> a -> m ()
forall (m :: * -> *) a.
(CanCheck, MonadIO m) =>
(a -> String)
-> Maybe InputAsText -> Text -> (a -> Bool) -> a -> m ()
checkShow a -> String
forall v. TestShow v => v -> String
testShow Maybe InputAsText
forall a. Maybe a
Nothing

checkShow :: (CanCheck, MonadIO m)
          => (a -> String)
          -> Maybe InputAsText
          -> Text -> (a -> Bool) -> a -> m ()
checkShow :: forall (m :: * -> *) a.
(CanCheck, MonadIO m) =>
(a -> String)
-> Maybe InputAsText -> Text -> (a -> Bool) -> a -> m ()
checkShow a -> String
showit Maybe InputAsText
failInput Text
what a -> Bool
eval a
val = do
  Bool
r <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> IO Bool
forall a. a -> IO a
evaluate (a -> Bool
eval a
val)
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
r (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let failtxt :: FailureMessage
failtxt = Text -> FailureMessage
FailureMessage (Text -> FailureMessage) -> Text -> FailureMessage
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
showit a
val
    let chk :: CheckResult
chk = CheckName -> Maybe InputAsText -> FailureMessage -> CheckResult
CheckFailed (Text -> CheckName
CheckName Text
what) Maybe InputAsText
failInput FailureMessage
failtxt
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef [CheckResult] -> ([CheckResult] -> [CheckResult]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef CanCheck
IORef [CheckResult]
?checker (CheckResult
chkCheckResult -> [CheckResult] -> [CheckResult]
forall a. a -> [a] -> [a]
:)


-- | Sometimes checks are provided in common testing code, often in
-- setup/preparation for the main tests.  In some cases, the check is
-- not applicable for that particular test.  This function can be used
-- to discard any pending failures for the associated named check.
--
-- This is especially useful when a common code block is used to
-- perform a set of checks: if a few of the common checks are not
-- appropriate for the current situation, 'discardCheck' can be used
-- to throw away the results of those checks by matching on the check
-- name.

discardCheck :: (CanCheck, MonadIO m) => Text -> m ()
discardCheck :: forall (m :: * -> *). (CanCheck, MonadIO m) => Text -> m ()
discardCheck Text
what = do
  let isCheck :: Text -> CheckResult -> Bool
isCheck Text
n (CheckFailed CheckName
n' Maybe InputAsText
_ FailureMessage
_) = Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== CheckName -> Text
checkName CheckName
n'
      isCheck Text
_ (CheckMessage Text
_) = Bool
False
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef [CheckResult] -> ([CheckResult] -> [CheckResult]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef CanCheck
IORef [CheckResult]
?checker ((CheckResult -> Bool) -> [CheckResult] -> [CheckResult]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (CheckResult -> Bool) -> CheckResult -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CheckResult -> Bool
isCheck Text
what))

----------------------------------------------------------------------

-- $checkValues
--
-- Implementing a number of discrete 'check' calls can be tedious,
-- especially when they are validating different aspects of the same
-- result value.  To facilitate this, the 'checkValues' function can
-- be used along with a type-safe list of checks to perform.
--
-- To demonstrate this, first consider the following sample program,
-- which has code that generates a complex @Struct@ value, along with
-- tests for various fields in that @Struct@.

-- $setup
-- >>> :set -XPatternSynonyms
-- >>> :set -XOverloadedStrings
-- >>>
-- >>> import Data.Parameterized.Context ( pattern Empty, pattern (:>) )
-- >>> import Test.Tasty.Checklist
-- >>> import Test.Tasty
-- >>> import Test.Tasty.HUnit
-- >>>
-- >>> :{
-- >>> data Struct = MyStruct { foo :: Int, bar :: Char, baz :: String }
-- >>>
-- >>> instance Show Struct where
-- >>>    show s = baz s <> " is " <> show (foo s) <> [bar s]
-- >>> instance TestShow Struct where testShow = show
-- >>>
-- >>> someFun :: Int -> Struct
-- >>> someFun n = MyStruct (n * 6)
-- >>>               (if n * 6 == 42 then '!' else '?')
-- >>>               "The answer to the universe"
-- >>>
-- >>> oddAnswer :: Struct -> Bool
-- >>> oddAnswer = odd . foo
-- >>>
-- >>> test = testCase "someFun result" $
-- >>>    withChecklist "results for someFun" $
-- >>>    someFun 3 `checkValues`
-- >>>         (Empty
-- >>>         :> Val "foo" foo 42
-- >>>         :> Val "baz field" baz "The answer to the universe"
-- >>>         :> Val "shown" show "The answer to the universe is 42!"
-- >>>         :> Val "odd answer" oddAnswer False
-- >>>         :> Got "even answer" (not . oddAnswer)
-- >>>         :> Val "double-checking foo" foo 42
-- >>>         )
-- >>> :}
--
-- This code will be used below to demonstrate various advanced
-- checklist capabilities.

-- | The 'checkValues' is a checklist that tests various values that
-- can be derived from the input value.  The input value is provided,
-- along with an 'Data.Parameterized.Context.Assignment' list of
-- extraction functions and the expected result value (and name) of
-- that extraction.  Each extraction is performed as a check within
-- the checklist.
--
-- This is convenient to gather together a number of validations on a
-- single datatype and represent them economically.
--
-- One example is testing the fields of a record structure, given the
-- above code:
--
-- >>> defaultMain test
-- someFun result: FAIL
--   Exception: ERROR: results for someFun
--     3 checks failed in this checklist:
--     --- Input for below: The answer to the universe is 18?
--     -Failed check: foo
--           expected:    42
--           failed with: 18
--     -Failed check: shown
--           expected:    "The answer to the universe is 42!"
--           failed with: "The answer to the universe is 18?"
--     -Failed check: double-checking foo
--           expected:    42
--           failed with: 18
-- <BLANKLINE>
-- 1 out of 1 tests failed (...s)
-- *** Exception: ExitFailure 1
--
-- In this case, several of the values checked were correct, but more
-- than one was wrong.  Helpfully, this test output lists /all/ the
-- wrong answers for the single input provided.

checkValues :: CanCheck
            => TestShow dType
            => dType -> Ctx.Assignment (DerivedVal dType) idx ->  IO ()
checkValues :: forall dType (idx :: Ctx (*)).
(CanCheck, TestShow dType) =>
dType -> Assignment (DerivedVal dType) idx -> IO ()
checkValues dType
got Assignment (DerivedVal dType) idx
expF = do
  IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
evaluate (() -> IO ()) -> IO () -> IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall tp. Index idx tp -> DerivedVal dType tp -> IO ())
-> Assignment (DerivedVal dType) idx -> IO ()
forall {k} (m :: * -> *) (ctx :: Ctx k) (f :: k -> *).
Applicative m =>
(forall (tp :: k). Index ctx tp -> f tp -> m ())
-> Assignment f ctx -> m ()
Ctx.traverseWithIndex_ (dType -> Index idx tp -> DerivedVal dType tp -> IO ()
forall dType (idx :: Ctx (*)) valType.
(CanCheck, TestShow dType) =>
dType -> Index idx valType -> DerivedVal dType valType -> IO ()
chkValue dType
got) Assignment (DerivedVal dType) idx
expF
  -- All the checks are evaluating against the same 'got' value; normally a check
  -- reports the value that caused it to fail but that could get repetitious.
  -- This groups check failures by their input and removes the input from each
  -- checkfailure, instead starting the group with a CheckMessage describing the
  -- input for that entire group.
  let groupByInp :: t CheckResult -> [CheckResult]
groupByInp t CheckResult
chks =
        let gmap :: Map (Maybe InputAsText) [CheckResult]
gmap = (CheckResult
 -> Map (Maybe InputAsText) [CheckResult]
 -> Map (Maybe InputAsText) [CheckResult])
-> Map (Maybe InputAsText) [CheckResult]
-> t CheckResult
-> Map (Maybe InputAsText) [CheckResult]
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CheckResult
-> Map (Maybe InputAsText) [CheckResult]
-> Map (Maybe InputAsText) [CheckResult]
insByInp Map (Maybe InputAsText) [CheckResult]
forall a. Monoid a => a
mempty t CheckResult
chks
            insByInp :: CheckResult
-> Map (Maybe InputAsText) [CheckResult]
-> Map (Maybe InputAsText) [CheckResult]
insByInp = \case
              c :: CheckResult
c@(CheckFailed CheckName
_ Maybe InputAsText
mbi FailureMessage
_) -> ([CheckResult] -> [CheckResult] -> [CheckResult])
-> Maybe InputAsText
-> [CheckResult]
-> Map (Maybe InputAsText) [CheckResult]
-> Map (Maybe InputAsText) [CheckResult]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [CheckResult] -> [CheckResult] -> [CheckResult]
forall a. Semigroup a => a -> a -> a
(<>) Maybe InputAsText
mbi [CheckResult
c]
              CheckMessage Text
_ -> Map (Maybe InputAsText) [CheckResult]
-> Map (Maybe InputAsText) [CheckResult]
forall a. a -> a
id -- regrouping, ignore any previous groups
            addGroup :: (Maybe InputAsText, [CheckResult])
-> [CheckResult] -> [CheckResult]
addGroup (Maybe InputAsText
mbi,[CheckResult]
gchks) =
              let newChks :: [CheckResult]
newChks = CheckResult -> CheckResult
dropInput (CheckResult -> CheckResult) -> [CheckResult] -> [CheckResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CheckResult]
gchks
                  dropInput :: CheckResult -> CheckResult
dropInput (CheckFailed CheckName
nm Maybe InputAsText
_ FailureMessage
fmsg) =
                    if Text -> Maybe Text
forall a. a -> Maybe a
Just (FailureMessage -> Text
failureMessage FailureMessage
fmsg) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== (InputAsText -> Text
inputAsText (InputAsText -> Text) -> Maybe InputAsText -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InputAsText
mbi)
                    then CheckName -> Maybe InputAsText -> FailureMessage -> CheckResult
CheckFailed CheckName
nm Maybe InputAsText
forall a. Maybe a
Nothing
                         (FailureMessage -> CheckResult) -> FailureMessage -> CheckResult
forall a b. (a -> b) -> a -> b
$ Text -> FailureMessage
FailureMessage Text
"<< ^^ above input ^^ >>"
                    else CheckName -> Maybe InputAsText -> FailureMessage -> CheckResult
CheckFailed CheckName
nm Maybe InputAsText
forall a. Maybe a
Nothing FailureMessage
fmsg
                  dropInput i :: CheckResult
i@(CheckMessage Text
_) = CheckResult
i
                  grpTitle :: Text
grpTitle = Text -> (InputAsText -> Text) -> Maybe InputAsText -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"<no input identified>"
                             ((Text
"Input for below: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (InputAsText -> Text) -> InputAsText -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputAsText -> Text
inputAsText)
                             Maybe InputAsText
mbi
              in ([CheckResult] -> [CheckResult] -> [CheckResult]
forall a. Semigroup a => a -> a -> a
<> ([CheckResult]
newChks [CheckResult] -> [CheckResult] -> [CheckResult]
forall a. Semigroup a => a -> a -> a
<> [Text -> CheckResult
CheckMessage Text
grpTitle]))
        in ((Maybe InputAsText, [CheckResult])
 -> [CheckResult] -> [CheckResult])
-> [CheckResult]
-> [(Maybe InputAsText, [CheckResult])]
-> [CheckResult]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe InputAsText, [CheckResult])
-> [CheckResult] -> [CheckResult]
addGroup [CheckResult]
forall a. Monoid a => a
mempty ([(Maybe InputAsText, [CheckResult])] -> [CheckResult])
-> [(Maybe InputAsText, [CheckResult])] -> [CheckResult]
forall a b. (a -> b) -> a -> b
$ Map (Maybe InputAsText) [CheckResult]
-> [(Maybe InputAsText, [CheckResult])]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Maybe InputAsText) [CheckResult]
gmap

  IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef [CheckResult] -> ([CheckResult] -> [CheckResult]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef CanCheck
IORef [CheckResult]
?checker [CheckResult] -> [CheckResult]
forall {t :: * -> *}. Foldable t => t CheckResult -> [CheckResult]
groupByInp


chkValue :: CanCheck
         => TestShow dType
         => dType -> Ctx.Index idx valType -> DerivedVal dType valType -> IO ()
chkValue :: forall dType (idx :: Ctx (*)) valType.
(CanCheck, TestShow dType) =>
dType -> Index idx valType -> DerivedVal dType valType -> IO ()
chkValue dType
got Index idx valType
_idx =
  let ti :: Maybe InputAsText
ti = InputAsText -> Maybe InputAsText
forall a. a -> Maybe a
Just (InputAsText -> Maybe InputAsText)
-> InputAsText -> Maybe InputAsText
forall a b. (a -> b) -> a -> b
$ Text -> InputAsText
InputAsText (Text -> InputAsText) -> Text -> InputAsText
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ dType -> String
forall v. TestShow v => v -> String
testShow dType
got
  in \case
    (Val Text
txt dType -> valType
fld valType
v) ->
      let msg :: Text
msg = Text
txt
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"        " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"expected:    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tv Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"        " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"failed"
          tv :: Text
tv = String -> Text
T.pack (valType -> String
forall v. TestShow v => v -> String
testShow valType
v)
      in (valType -> String)
-> Maybe InputAsText
-> Text
-> (valType -> Bool)
-> valType
-> IO ()
forall (m :: * -> *) a.
(CanCheck, MonadIO m) =>
(a -> String)
-> Maybe InputAsText -> Text -> (a -> Bool) -> a -> m ()
checkShow valType -> String
forall v. TestShow v => v -> String
testShow Maybe InputAsText
ti Text
msg (valType
v valType -> valType -> Bool
forall a. Eq a => a -> a -> Bool
==) (valType -> IO ()) -> valType -> IO ()
forall a b. (a -> b) -> a -> b
$ dType -> valType
fld dType
got
    (Observe Text
txt dType -> valType
fld valType
v valType -> valType -> String
observationReport) ->
      let msg :: Text
msg = Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" observation failure"
      in (valType -> String)
-> Maybe InputAsText
-> Text
-> (valType -> Bool)
-> valType
-> IO ()
forall (m :: * -> *) a.
(CanCheck, MonadIO m) =>
(a -> String)
-> Maybe InputAsText -> Text -> (a -> Bool) -> a -> m ()
checkShow (valType -> valType -> String
observationReport valType
v) Maybe InputAsText
ti Text
msg (valType
v valType -> valType -> Bool
forall a. Eq a => a -> a -> Bool
==) (valType -> IO ()) -> valType -> IO ()
forall a b. (a -> b) -> a -> b
$ dType -> valType
fld dType
got
    (Got Text
txt dType -> Bool
fld) -> (Bool -> String)
-> Maybe InputAsText -> Text -> (Bool -> Bool) -> Bool -> IO ()
forall (m :: * -> *) a.
(CanCheck, MonadIO m) =>
(a -> String)
-> Maybe InputAsText -> Text -> (a -> Bool) -> a -> m ()
checkShow Bool -> String
forall v. TestShow v => v -> String
testShow Maybe InputAsText
ti Text
txt Bool -> Bool
forall a. a -> a
id (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ dType -> Bool
fld dType
got

-- | Each entry in the 'Data.Parameterized.Context.Assignment' list
-- for 'checkValues' should be one of these 'DerivedVal' values.
--
-- The @i@ type parameter is the input type, and the @d@ is the value
-- derived from that input type.

data DerivedVal i d where

  -- | Val allows specification of a description string, an extraction
  -- function, and the expected value to be extracted.  The
  -- 'checkValues' function will add a Failure if the expected value is
  -- not obtained.
  Val :: (TestShow d, Eq d) => Text -> (i -> d) -> d -> DerivedVal i d

  -- | Got allows specification of a description string and an
  -- extraction function.  The 'checkValues' function will add a
  -- Failure if the extraction result is False.
  --
  -- > Val "what" f True === Got "what" f
  --
  Got :: Text -> (i -> Bool) -> DerivedVal i Bool

  -- | Observe performs the same checking as Val except the TestShow
  -- information for the actual and expected values are not as useful
  -- (e.g. they are lengthy, multi-line, or gibberish) so instead this
  -- allows the specification of a function that will take the
  -- supplied expected value and the result of the extraction function
  -- (the actual), respectively, and generate its own description of
  -- the failure.
  --
  Observe :: (Eq d) => Text -> (i -> d) -> d -> (d -> d -> String) -> DerivedVal i d

----------------------------------------------------------------------

-- | The 'TestShow' class is defined to provide a way for the various
-- data objects tested by this module to be displayed when tests fail.
-- The default 'testShow' will use a 'Show' instance, but this can be
-- overridden if there are alternate ways to display a particular
-- object (e.g. pretty-printing, etc.)

class TestShow v where
  testShow :: v -> String
  default testShow :: Show v => v -> String
  testShow = v -> String
forall a. Show a => a -> String
show

-- Some TestShow instances using Show for regular datatypes
instance TestShow ()
instance TestShow Bool
instance TestShow Int
instance TestShow Integer
instance TestShow Float
instance TestShow Char
instance TestShow String

instance (TestShow a, TestShow b) => TestShow (a,b) where
  testShow :: (a, b) -> String
testShow (a
a,b
b) = String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall v. TestShow v => v -> String
testShow a
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> b -> String
forall v. TestShow v => v -> String
testShow b
b String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
instance (TestShow a, TestShow b, TestShow c) => TestShow (a,b,c) where
  testShow :: (a, b, c) -> String
testShow (a
a,b
b,c
c) = String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall v. TestShow v => v -> String
testShow a
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> b -> String
forall v. TestShow v => v -> String
testShow b
b String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> c -> String
forall v. TestShow v => v -> String
testShow c
c String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"

-- | A helper function for defining a testShow for lists of items.
--
-- > instance TestShow [Int] where testShow = testShowList

testShowList :: TestShow v => [v] -> String
testShowList :: forall v. TestShow v => [v] -> String
testShowList  [v]
l = String
"[ " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " (v -> String
forall v. TestShow v => v -> String
testShow (v -> String) -> [v] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
l)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ]"


-- | The multiLineDiff is another helper function that can be used to
-- format a line-by-line difference display of two Text
-- representations.  This is provided as a convenience function to
-- help format large text regions for easier comparison.

multiLineDiff :: T.Text -> T.Text -> String
multiLineDiff :: Text -> Text -> String
multiLineDiff Text
expected Text
actual =
  let dl :: (a, a) -> a
dl (a
e,a
a) = if a
e a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a then a -> a
forall {a}. (Semigroup a, IsString a) => a -> a
db a
e else a -> a -> a
forall {a}. (Semigroup a, IsString a) => a -> a -> a
de a
" ↱" a
e a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\n    " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a -> a -> a
forall {a}. (Semigroup a, IsString a) => a -> a -> a
da a
" ↳" a
a
      db :: a -> a
db a
b = a
"|        > " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b
      de :: a -> a -> a
de a
m a
e = a
"|" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
m a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"expect> " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
e
      da :: a -> a -> a
da a
m a
a = a
"|" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
m a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"actual> " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a
      el :: [Text]
el = Text -> Text
visible (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.lines Text
expected
      al :: [Text]
al = Text -> Text
visible (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.lines Text
actual
      visible :: Text -> Text
visible = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
" " Text
"␠"
                (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\n" Text
"␤"
                (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\t" Text
"␉"
                (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\012" Text
"␍"
      addnum :: Int -> T.Text -> T.Text
      addnum :: Int -> Text -> Text
addnum Int
n Text
l = let nt :: Text
nt = String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
                       nl :: Int
nl = Text -> Int
T.length Text
nt
                   in Int -> Text -> Text
T.take (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nl) Text
"    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l
      ll :: [a] -> Text
ll = String -> Text
T.pack (String -> Text) -> ([a] -> String) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> ([a] -> Int) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
      tl :: Text -> Text
tl = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Text -> Int) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length
      banner :: Text
banner = Text
"MISMATCH between "
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall {a}. [a] -> Text
ll [Text]
el Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"l/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
tl Text
expected Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"c expected and "
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall {a}. [a] -> Text
ll [Text]
al Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"l/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
tl Text
actual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"c actual"
      diffReport :: [Text]
diffReport = ((Int, Text) -> Text) -> [(Int, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Text -> Text) -> (Int, Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Text -> Text
addnum) ([(Int, Text)] -> [Text]) -> [(Int, Text)] -> [Text]
forall a b. (a -> b) -> a -> b
$
                   [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] ([Text] -> [(Int, Text)]) -> [Text] -> [(Int, Text)]
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$
                   -- Highly simplistic "diff" output assumes
                   -- correlated lines: added or removed lines just
                   -- cause everything to shown as different from that
                   -- point forward.
                   [ ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Text) -> Text
forall {a}. (Eq a, Semigroup a, IsString a) => (a, a) -> a
dl ([(Text, Text)] -> [Text]) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
el [Text]
al
                   , (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
de Text
"∌ ") ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
al) [Text]
el
                   , (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
da Text
"∹ ") ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
el) [Text]
al
                   ]
                   -- n.b. T.lines seems to consume trailing whitespace before
                   -- newlines as well.  This will show any of this whitespace
                   -- difference on the last line, but not for other lines with
                   -- whitespace.
                   [[Text]] -> [[Text]] -> [[Text]]
forall a. Semigroup a => a -> a -> a
<> if [Text]
el [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text]
al
                      then let maxlen :: Int
maxlen = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Text -> Int
T.length Text
expected) (Text -> Int
T.length Text
actual)
                               end :: Text -> Text
end Text
x = Int -> Text -> Text
T.drop (Int
maxlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) Text
x
                           in [ [ Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
de Text
"∌ ending " (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
visible (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
end Text
expected ]
                              , [ Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
da Text
"∹ ending " (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
visible (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
end Text
actual ]
                              ]
                      else [[Text]]
forall a. Monoid a => a
mempty
      details :: [Text]
details = Text
banner Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
diffReport
  in if Text
expected Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
actual then String
"<no difference>" else Text -> String
T.unpack ([Text] -> Text
T.unlines [Text]
details)