Fix workspaceHistoryHook memory leak

The XS.modify was leaving thunk on the history that the demand analyser
could not prove to be neccesary as they depended on the future user
interaction. This was bad as the time advance there was less and less
neccesity to force such value, so the thunk would be increasing. Since the
datatypes that the `WorkspaceHistory` are really simple, we can just
evaluate and save a good chunk of memory.
This commit is contained in:
Ruben Astudillo
2021-11-20 01:29:54 -03:00
parent ed5d6f0d78
commit 44fb597350

View File

@@ -28,9 +28,9 @@ module XMonad.Hooks.WorkspaceHistory (
, workspaceHistoryModify , workspaceHistoryModify
) where ) where
import Control.Seq (using, seqFoldable, seqTuple2, rseq)
import Control.Applicative import Control.Applicative
import Prelude import Prelude
import XMonad import XMonad
import XMonad.StackSet hiding (delete, filter, new) import XMonad.StackSet hiding (delete, filter, new)
import XMonad.Prelude (delete, find, foldl', groupBy, nub, sortBy) import XMonad.Prelude (delete, find, foldl', groupBy, nub, sortBy)
@@ -72,16 +72,21 @@ instance ExtensionClass WorkspaceHistory where
-- | A 'logHook' that keeps track of the order in which workspaces have -- | A 'logHook' that keeps track of the order in which workspaces have
-- been viewed. -- been viewed.
workspaceHistoryHook :: X () workspaceHistoryHook :: X ()
workspaceHistoryHook = gets windowset >>= (XS.modify . updateLastActiveOnEachScreen) workspaceHistoryHook = workspaceHistoryHookExclude []
-- | Like 'workspaceHistoryHook', but with the ability to exclude -- | Like 'workspaceHistoryHook', but with the ability to exclude
-- certain workspaces. -- certain workspaces.
workspaceHistoryHookExclude :: [WorkspaceId] -> X () workspaceHistoryHookExclude :: [WorkspaceId] -> X ()
workspaceHistoryHookExclude ws = do workspaceHistoryHookExclude ws = do
s <- gets windowset s <- gets windowset
let update' a = force (updateLastActiveOnEachScreenExclude ws s a) let update' = forceHistory . updateLastActiveOnEachScreenExclude ws s
XS.modify' update' XS.modify' update'
forceHistory :: WorkspaceHistory -> WorkspaceHistory
forceHistory (WorkspaceHistory l) =
let l' = l `using` seqFoldable (seqTuple2 rseq rseq)
in l' `seq` WorkspaceHistory l'
workspaceHistoryWithScreen :: X [(ScreenId, WorkspaceId)] workspaceHistoryWithScreen :: X [(ScreenId, WorkspaceId)]
workspaceHistoryWithScreen = XS.gets history workspaceHistoryWithScreen = XS.gets history