changed broadcastMessage to be O(workspaces).

The current definition of broadcastMessage seems to be O(n^2) in the number of workspaces because it uses sendMessageWithNoRefresh and sendMessageWithNoRefresh uses updateLayout and updateLayout uses runOnWorkspaces.

This changes broadCastMessage and sendMessageWithNoRefresh to each use a single
call to runOnWorkspaces.
This commit is contained in:
Keith 2021-04-13 12:03:21 -04:00 committed by Tomas Janousek
parent 0ab42d4228
commit 183e14725f

View File

@ -440,17 +440,24 @@ sendMessage a = windowBracket_ $ do
-- | Send a message to all layouts, without refreshing. -- | Send a message to all layouts, without refreshing.
broadcastMessage :: Message a => a -> X () broadcastMessage :: Message a => a -> X ()
broadcastMessage a = withWindowSet $ \ws -> do broadcastMessage = filterMessageWithNoRefresh (const True)
let c = W.workspace . W.current $ ws
v = map W.workspace . W.visible $ ws
h = W.hidden ws
mapM_ (sendMessageWithNoRefresh a) (c : v ++ h)
-- | Send a message to a layout, without refreshing. -- | Send a message to a layout, without refreshing.
sendMessageWithNoRefresh :: Message a => a -> W.Workspace WorkspaceId (Layout Window) Window -> X () sendMessageWithNoRefresh :: Message a => a -> WindowSpace -> X ()
sendMessageWithNoRefresh a w = sendMessageWithNoRefresh a w =
handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing >>= filterMessageWithNoRefresh (((==) `on` W.tag) w) a
updateLayout (W.tag w)
-- | Send a message to the layouts of some workspaces, without refreshing.
filterMessageWithNoRefresh :: Message a => (WindowSpace -> Bool) -> a -> X ()
filterMessageWithNoRefresh p a = updateLayoutsBy $ \ wrk ->
if p wrk
then userCodeDef Nothing $ W.layout wrk `handleMessage` SomeMessage a
else pure Nothing
-- | Update the layouts of some workspaces.
updateLayoutsBy :: (WindowSpace -> X (Maybe (Layout Window))) -> X ()
updateLayoutsBy f = runOnWorkspaces $ \ wrk ->
maybe wrk (\ l' -> wrk{ W.layout = l' }) <$> f wrk
-- | Update the layout field of a workspace. -- | Update the layout field of a workspace.
updateLayout :: WorkspaceId -> Maybe (Layout Window) -> X () updateLayout :: WorkspaceId -> Maybe (Layout Window) -> X ()