diff options
| author | Will Thompson <will@willthompson.co.uk> | 2012-01-17 14:19:53 +0000 |
|---|---|---|
| committer | Will Thompson <will@willthompson.co.uk> | 2012-01-17 14:19:53 +0000 |
| commit | 5526f11b1971a502dd787c280560a31207d8b902 (patch) | |
| tree | f1defd42197cb844d0d01087f15fbd5ba1612578 | |
| parent | dd17752871a9c469844caf1d657ac0403cdec255 (diff) | |
Renderer: tell shapes en-mass where possible
This reduces appending of long chains of single-element lists.
| -rw-r--r-- | Bustle/Renderer.hs | 11 |
1 files changed, 8 insertions, 3 deletions
diff --git a/Bustle/Renderer.hs b/Bustle/Renderer.hs index 4756a3f..608aff3 100644 --- a/Bustle/Renderer.hs +++ b/Bustle/Renderer.hs @@ -481,7 +481,10 @@ remOther bus n u = do modifyApps bus $ Map.insert u ai' shape :: Shape -> Renderer () -shape s = tell $ RendererOutput [s] [] [] +shape s = tellShapes [s] + +tellShapes :: [Shape] -> Renderer () +tellShapes ss = tell $ RendererOutput ss [] [] region :: Stripe -> DetailedMessage -> Renderer () region r m = tell $ RendererOutput [] [(r, m)] [] @@ -532,7 +535,7 @@ advanceBy d = do | (u, ApplicationInfo (CurrentColumn x) os _) <- xs ] let (height, ss) = headers xs' (current' + 20) - mapM_ shape ss + tellShapes ss modify $ \bs -> bs { mostRecentLabels = (current' + height + 10) , row = row bs + height + 10 } @@ -548,7 +551,9 @@ advanceBy d = do appColumns = catMaybes . Map.fold ((:) . aiCurrentColumn) [] xs <- (++) <$> getsApps appColumns SessionBus <*> getsApps appColumns SystemBus - forM_ xs $ \x -> shape $ ClientLine x (current + 15) (next + 15) + tellShapes [ ClientLine x (current + 15) (next + 15) + | x <- xs + ] bestNames :: UniqueName -> Set OtherName -> [String] bestNames (UniqueName u) os |