Use deepseq instead of parallel

This commit is contained in:
Ruben Astudillo 2021-11-23 20:35:40 -03:00
parent 44fb597350
commit b75d0d265e
4 changed files with 20 additions and 19 deletions

View File

@ -1,3 +1,4 @@
{-# language DeriveGeneric, DeriveAnyClass #-}
----------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.GroupNavigation
@ -34,13 +35,14 @@ module XMonad.Actions.GroupNavigation ( -- * Usage
import Control.Monad.Reader
import Control.Monad.State
import Control.Seq (using, seqFoldable, rseq)
import Control.DeepSeq
import Data.Map ((!))
import qualified Data.Map as Map
import Data.Sequence (Seq, ViewL (EmptyL, (:<)), viewl, (<|), (><), (|>))
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Graphics.X11.Types
import GHC.Generics
import Prelude hiding (concatMap, drop, elem, filter, null, reverse)
import XMonad.Core
import XMonad.ManageHook
@ -157,7 +159,7 @@ orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs'
-- The state extension that holds the history information
data HistoryDB = HistoryDB (Maybe Window) -- currently focused window
(Seq Window) -- previously focused windows
deriving (Read, Show)
deriving (Read, Show, Generic, NFData)
instance ExtensionClass HistoryDB where
@ -168,11 +170,8 @@ instance ExtensionClass HistoryDB where
-- focus history of all windows as the WindowSet changes.
historyHook :: X ()
historyHook = do
db <- XS.get
db'@(HistoryDB cur del) <- updateHistory db
let del' = del `using` seqFoldable rseq
cur' = cur `using` seqFoldable rseq
cur' `seq` del' `seq` XS.put db'
db' <- XS.get >>= updateHistory
db' `deepseq` XS.put db'
-- Updates the history in response to a WindowSet change
updateHistory :: HistoryDB -> X HistoryDB

View File

@ -28,9 +28,9 @@ module XMonad.Hooks.WorkspaceHistory (
, workspaceHistoryModify
) where
import Control.Seq (using, seqFoldable, seqTuple2, rseq)
import Control.Applicative
import Prelude
import Control.Applicative
import Control.DeepSeq
import Prelude
import XMonad
import XMonad.StackSet hiding (delete, filter, new)
import XMonad.Prelude (delete, find, foldl', groupBy, nub, sortBy)
@ -65,6 +65,13 @@ newtype WorkspaceHistory = WorkspaceHistory
-- reverse-chronological order.
} deriving (Read, Show)
-- @ScreenId@ is not an instance of NFData, but is a newtype on @Int@. @seq@
-- is enough for forcing it. This requires us to provide an instance.
instance NFData WorkspaceHistory where
rnf (WorkspaceHistory hist) =
let go = liftRnf2 rwhnf rwhnf
in liftRnf go hist
instance ExtensionClass WorkspaceHistory where
initialValue = WorkspaceHistory []
extensionType = PersistentExtension
@ -79,14 +86,9 @@ workspaceHistoryHook = workspaceHistoryHookExclude []
workspaceHistoryHookExclude :: [WorkspaceId] -> X ()
workspaceHistoryHookExclude ws = do
s <- gets windowset
let update' = forceHistory . updateLastActiveOnEachScreenExclude ws s
let update' = force . updateLastActiveOnEachScreenExclude ws s
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 = XS.gets history

View File

@ -94,7 +94,7 @@ modify f = put . f =<< get
-- | Like @modify@ but the result value is applied strictly in respect to
-- the monadic environment.
modify' :: (ExtensionClass a, XLike m) => (a -> a) -> m ()
modify' f = (\a -> let res = f a in res `seq` put res) =<< get
modify' f = (put $!) . f =<< get
-- | Add a value to the extensible state field. A previously stored value with the same
-- type will be overwritten. (More precisely: A value whose string representation of its type

View File

@ -62,7 +62,7 @@ library
X11 >= 1.10 && < 1.11,
xmonad >= 0.16.99999 && < 0.18,
utf8-string,
parallel
deepseq
default-language: Haskell2010
cpp-options: -DXMONAD_CONTRIB_VERSION_MAJOR=0
@ -449,7 +449,7 @@ test-suite tests
, process
, unix
, utf8-string
, parallel
, deepseq
, xmonad >= 0.16.9999 && < 0.18
cpp-options: -DTESTING
ghc-options: -Wall -Wno-unused-do-bind