Improve errors for multichannel tests

[martijnbastiaan]

The type class expect currently works on a single channel at a time. Even though all channels will be properly tested, just one channel will be shown in an error message even if multiple produce unexpected data. It can be annoying to figure out which channel produced unexpected data. We should work on that.

clash-protocols/src/Protocols/Hedgehog.hs

Lines 121 to 185 in 1c43320

	instance (TestType a, C.KnownDomain dom) => Test (Dfs dom a) where
	type ExpectType (Dfs dom a) = [a]
	expectToSimulateType :: Proxy (Dfs dom a) -> [a] -> [Maybe a]
	expectToSimulateType Proxy = map Just
	expect ::
	forall m.
	(HasCallStack, H.MonadTest m) =>
	Proxy (Dfs dom a) ->
	ExpectOptions ->
	[a] ->
	[Maybe a] ->
	m ()
	expect Proxy (ExpectOptions{eoEmptyTail, eoTimeout}) expected actual = do
	go False (fromMaybe maxBound eoTimeout) expected actual
	where
	go ::
	(HasCallStack, Eq v, Show v) =>
	-- Encountered failure?
	Bool ->
	-- Timeout counter. If it reaches zero we time out.
	Int ->
	-- Expected values
	[v] ->
	-- Actual values
	[Maybe v] ->
	-- Results
	m ()
	go _failed _timeout _expected [] =
	-- This really should not happen, protocols should produce data indefinitely
	error "unexpected end of signal"
	go True _timeout [] _ =
	-- Checked all expected values, but at least one of the actual values
	-- did not match.
	failDiffWith
	"Circuit produced unexpected values"
	expected
	(take (length expected) (catMaybes actual))
	go False _timeout [] actualRest = do
	-- Check for superfluous output from protocol
	case catMaybes (take eoEmptyTail actualRest) of
	[] -> pure ()
	superfluous ->
	let err = "Circuit produced more output than expected:" in
	H.failWith Nothing (err <> "\n\n" <> ppShow superfluous)
	go failed timeout es _ | timeout <= 0 =
	if failed then
	failDiffWith
	(concat [ "Circuit did not produce enough output and produced output "
	, "did not match the expected values." ] )
	expected
	(take (length expected - length es) (catMaybes actual))
	else
	H.failWith Nothing $ concat
	[ "Circuit did not produce enough output. Expected "
	, show (length expected), " more values:\n\n", ppShow es ]
	go failed0 timeout es (Nothing:as) = do
	-- Circuit did not output valid cycle, just continue
	go failed0 (pred timeout) es as
	go failed0 _timeout (e:es) (Just a:as) =
	-- Don't immediately stop on /= as we can still fail due to timeout
	let failed1 = e /= a || failed0 in do
	go failed1 (fromMaybe maxBound eoTimeout) es as