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,8 +28,8 @@ module XMonad.Hooks.WorkspaceHistory (
, workspaceHistoryModify
) where
import Control.Seq (using, seqFoldable, seqTuple2, rseq)
import Control.Applicative
import Control.DeepSeq
import Prelude
import XMonad
import XMonad.StackSet hiding (delete, filter, new)
@ -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