mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
Use deepseq instead of parallel
This commit is contained in:
parent
44fb597350
commit
b75d0d265e
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user