    {-# 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" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    indent String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    "using:"
                        String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    indent String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Text -> String
    T.unpack (InputAsText -> Text
    inputAsText InputAsText
    i)
        in if [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or [ String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    chknm Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    100
                 , String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    chkmsg Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    100
                 , String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    chkval Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    100
                 ]
           then Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    50 Char
    '#' String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    "\n\n" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    indent
                String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> 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
           else 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)

    indent :: String
    indent :: String
    indent = String
    "        "

    indenT :: Text
    indenT :: Text
    indenT = String -> Text
    T.pack String
    indent

    -- | 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
      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
      r <- (let ?checker = checks in t)
           `onException` (liftIO $
                           do cs <- List.reverse <$> readIORef checks
                              unless (null cs) $ do
                                hFlush stdout
                                hPutStrLn stderr ""
                                let pfx = String
    "        WARN "
                                mapM_ (hPutStrLn stderr . (pfx <>) . show) cs
                                hFlush stderr
                         )

      -- If t failed, never get here:
      liftIO $ do
        collected <- List.reverse <$> readIORef checks
        unless (null collected) $
          throwM (ChecklistFailures topMsg collected)
      return 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
      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)
      unless r $ do
        let 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 = CheckName -> Maybe InputAsText -> FailureMessage -> CheckResult
    CheckFailed (Text -> CheckName
    CheckName Text
    what) Maybe InputAsText
    failInput FailureMessage
    failtxt
        liftIO $ modifyIORef ?checker (chk:)

    -- | 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
                      dispInput :: InputAsText -> Text
    dispInput InputAsText
    i = if Text -> Int
    T.length (InputAsText -> Text
    inputAsText InputAsText
    i) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    100
                                    then InputAsText -> Text
    inputAsText InputAsText
    i Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n\n"
                                    else InputAsText -> Text
    inputAsText InputAsText
    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
    dispInput)
                                 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 =
                if Text -> Int
    T.length Text
    txt Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    100
                then Text
    txt Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    expline Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    failedpfx
                else 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
    expline Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    failedpfx
              expline :: Text
    expline = Text
    indenT 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"
              failedpfx :: Text
    failedpfx = Text
    indenT 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)