Skip to content

Commit

Permalink
Make computeAlignment more efficient
Browse files Browse the repository at this point in the history
Currently `Test.Tasty.Ingredients.ConsoleReporter.computeAlignment` evaluation
is extremely inefficient: firstly because `data Maximum` lacks strictness
annotations, and secondly because `foldTestTree` operates not even
over `Maximum a`, but over `Int -> Maximum a`.

The patch improves efficiency of `computeAlignment` and arguably makes
its implementation simpler.
  • Loading branch information
Bodigrim committed Sep 24, 2023
1 parent 5ff2876 commit c6ea446
Showing 1 changed file with 8 additions and 24 deletions.
32 changes: 8 additions & 24 deletions core/Test/Tasty/Ingredients/ConsoleReporter.hs
Original file line number Diff line number Diff line change
Expand Up @@ -749,35 +749,19 @@ formatDesc n desc =
then paddedDesc
else chomped

data Maximum a
= Maximum a
| MinusInfinity

instance Ord a => Sem.Semigroup (Maximum a) where
Maximum a <> Maximum b = Maximum (a `max` b)
MinusInfinity <> a = a
a <> MinusInfinity = a
instance Ord a => Monoid (Maximum a) where
mempty = MinusInfinity
#if !MIN_VERSION_base(4,11,0)
mappend = (Sem.<>)
#endif

-- | Compute the amount of space needed to align \"OK\"s and \"FAIL\"s
computeAlignment :: OptionSet -> TestTree -> Int
computeAlignment opts =
fromMonoid .
foldTestTree
trivialFold
{ foldSingle = \_ name _ level -> Maximum (stringWidth name + level)
, foldGroup = \_opts _ m -> mconcat m . (+ indentSize)
max 0 .
foldTestTree0
minBound
TreeFold
{ foldSingle = \_ name _ -> stringWidth name
, foldGroup = \_ _ m -> if null m then minBound else maximum m + indentSize
, foldResource = \_ _ f -> f $ throwIO NotRunningTests
, foldAfter = \_ _ _ b -> b
}
opts
where
fromMonoid m =
case m 0 of
MinusInfinity -> 0
Maximum x -> x

-- | Compute the length/width of the string as it would appear in a monospace
-- terminal. This takes into account that even in a “mono”space font, not
Expand Down

0 comments on commit c6ea446

Please # to comment.