@@ -540,7 +540,7 @@ annotatePath = go mempty
540
540
go :: Seq. Seq TestName -> AnnTestTree OptionSet -> AnnTestTree (OptionSet , Path )
541
541
go path = \ case
542
542
AnnEmptyTestTree -> AnnEmptyTestTree
543
- AnnSingleTest opts name tree ->
543
+ AnnSingleTest opts name tree ->
544
544
AnnSingleTest (opts, path |> name) name tree
545
545
AnnTestGroup opts name trees ->
546
546
let newPath = path |> name in
@@ -554,7 +554,15 @@ annotatePath = go mempty
554
554
filterByPattern :: AnnTestTree (OptionSet , Path ) -> AnnTestTree OptionSet
555
555
filterByPattern = snd . go (Any False )
556
556
where
557
- go
557
+ mkGroup opts name xs = case filter isNonEmpty xs of
558
+ [] -> AnnEmptyTestTree
559
+ ys -> AnnTestGroup opts name ys
560
+
561
+ isNonEmpty = \ case
562
+ AnnEmptyTestTree -> False
563
+ _ -> True
564
+
565
+ go
558
566
:: ForceTestMatch
559
567
-> AnnTestTree (OptionSet , Path )
560
568
-> (TestMatched , AnnTestTree OptionSet )
@@ -565,22 +573,22 @@ filterByPattern = snd . go (Any False)
565
573
AnnSingleTest (opts, path) name tree
566
574
| getAny forceMatch || testPatternMatches (lookupOption opts) path
567
575
-> (Any True , AnnSingleTest opts name tree)
568
- | otherwise
576
+ | otherwise
569
577
-> (Any False , AnnEmptyTestTree )
570
578
571
- AnnTestGroup (opts, _) name [] ->
572
- (forceMatch, AnnTestGroup opts name [] )
579
+ AnnTestGroup _ _ [] ->
580
+ (forceMatch, AnnEmptyTestTree )
573
581
574
582
AnnTestGroup (opts, _) name trees ->
575
583
case lookupOption opts of
576
584
Parallel ->
577
585
bimap
578
586
mconcat
579
- (AnnTestGroup opts name)
587
+ (mkGroup opts name)
580
588
(unzip (map (go forceMatch) trees))
581
589
Sequential _ ->
582
590
second
583
- (AnnTestGroup opts name)
591
+ (mkGroup opts name)
584
592
(mapAccumR go forceMatch trees)
585
593
586
594
AnnWithResource (opts, _) res0 tree ->
0 commit comments