module XMonad.Hooks.WorkspaceHistory (
workspaceHistoryHook
, workspaceHistoryHookExclude
, workspaceHistory
, workspaceHistoryByScreen
, workspaceHistoryWithScreen
, workspaceHistoryTransaction
, workspaceHistoryModify
) where
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)
import qualified XMonad.Util.ExtensibleState as XS
newtype WorkspaceHistory = WorkspaceHistory
{ WorkspaceHistory -> [(ScreenId, WorkspaceId)]
history :: [(ScreenId, WorkspaceId)]
} deriving (ReadPrec [WorkspaceHistory]
ReadPrec WorkspaceHistory
Int -> ReadS WorkspaceHistory
ReadS [WorkspaceHistory]
(Int -> ReadS WorkspaceHistory)
-> ReadS [WorkspaceHistory]
-> ReadPrec WorkspaceHistory
-> ReadPrec [WorkspaceHistory]
-> Read WorkspaceHistory
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkspaceHistory]
$creadListPrec :: ReadPrec [WorkspaceHistory]
readPrec :: ReadPrec WorkspaceHistory
$creadPrec :: ReadPrec WorkspaceHistory
readList :: ReadS [WorkspaceHistory]
$creadList :: ReadS [WorkspaceHistory]
readsPrec :: Int -> ReadS WorkspaceHistory
$creadsPrec :: Int -> ReadS WorkspaceHistory
Read, Int -> WorkspaceHistory -> ShowS
[WorkspaceHistory] -> ShowS
WorkspaceHistory -> WorkspaceId
(Int -> WorkspaceHistory -> ShowS)
-> (WorkspaceHistory -> WorkspaceId)
-> ([WorkspaceHistory] -> ShowS)
-> Show WorkspaceHistory
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceHistory] -> ShowS
$cshowList :: [WorkspaceHistory] -> ShowS
show :: WorkspaceHistory -> WorkspaceId
$cshow :: WorkspaceHistory -> WorkspaceId
showsPrec :: Int -> WorkspaceHistory -> ShowS
$cshowsPrec :: Int -> WorkspaceHistory -> ShowS
Show)
instance NFData WorkspaceHistory where
rnf :: WorkspaceHistory -> ()
rnf (WorkspaceHistory [(ScreenId, WorkspaceId)]
hist) =
let go :: (a, b) -> ()
go = (a -> ()) -> (b -> ()) -> (a, b) -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
liftRnf2 a -> ()
forall a. a -> ()
rwhnf b -> ()
forall a. a -> ()
rwhnf
in ((ScreenId, WorkspaceId) -> ()) -> [(ScreenId, WorkspaceId)] -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf (ScreenId, WorkspaceId) -> ()
forall {a} {b}. (a, b) -> ()
go [(ScreenId, WorkspaceId)]
hist
instance ExtensionClass WorkspaceHistory where
initialValue :: WorkspaceHistory
initialValue = [(ScreenId, WorkspaceId)] -> WorkspaceHistory
WorkspaceHistory []
extensionType :: WorkspaceHistory -> StateExtension
extensionType = WorkspaceHistory -> StateExtension
forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension
workspaceHistoryHook :: X ()
workspaceHistoryHook :: X ()
workspaceHistoryHook = [WorkspaceId] -> X ()
workspaceHistoryHookExclude []
workspaceHistoryHookExclude :: [WorkspaceId] -> X ()
workspaceHistoryHookExclude :: [WorkspaceId] -> X ()
workspaceHistoryHookExclude [WorkspaceId]
ws = (WorkspaceHistory -> WorkspaceHistory) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify' ((WorkspaceHistory -> WorkspaceHistory) -> X ())
-> (WindowSet -> WorkspaceHistory -> WorkspaceHistory)
-> WindowSet
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> WorkspaceHistory -> WorkspaceHistory
update (WindowSet -> X ()) -> X WindowSet -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
where
update :: WindowSet -> WorkspaceHistory -> WorkspaceHistory
update :: WindowSet -> WorkspaceHistory -> WorkspaceHistory
update WindowSet
s = WorkspaceHistory -> WorkspaceHistory
forall a. NFData a => a -> a
force (WorkspaceHistory -> WorkspaceHistory)
-> (WorkspaceHistory -> WorkspaceHistory)
-> WorkspaceHistory
-> WorkspaceHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WorkspaceId] -> WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreenExclude [WorkspaceId]
ws WindowSet
s
workspaceHistoryWithScreen :: X [(ScreenId, WorkspaceId)]
workspaceHistoryWithScreen :: X [(ScreenId, WorkspaceId)]
workspaceHistoryWithScreen = (WorkspaceHistory -> [(ScreenId, WorkspaceId)])
-> X [(ScreenId, WorkspaceId)]
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets WorkspaceHistory -> [(ScreenId, WorkspaceId)]
history
workspaceHistoryByScreen :: X [(ScreenId, [WorkspaceId])]
workspaceHistoryByScreen :: X [(ScreenId, [WorkspaceId])]
workspaceHistoryByScreen =
([(ScreenId, WorkspaceId)] -> (ScreenId, [WorkspaceId]))
-> [[(ScreenId, WorkspaceId)]] -> [(ScreenId, [WorkspaceId])]
forall a b. (a -> b) -> [a] -> [b]
map (\[(ScreenId, WorkspaceId)]
wss -> ((ScreenId, WorkspaceId) -> ScreenId
forall a b. (a, b) -> a
fst ((ScreenId, WorkspaceId) -> ScreenId)
-> (ScreenId, WorkspaceId) -> ScreenId
forall a b. (a -> b) -> a -> b
$ [(ScreenId, WorkspaceId)] -> (ScreenId, WorkspaceId)
forall a. [a] -> a
head [(ScreenId, WorkspaceId)]
wss, ((ScreenId, WorkspaceId) -> WorkspaceId)
-> [(ScreenId, WorkspaceId)] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map (ScreenId, WorkspaceId) -> WorkspaceId
forall a b. (a, b) -> b
snd [(ScreenId, WorkspaceId)]
wss)) ([[(ScreenId, WorkspaceId)]] -> [(ScreenId, [WorkspaceId])])
-> ([(ScreenId, WorkspaceId)] -> [[(ScreenId, WorkspaceId)]])
-> [(ScreenId, WorkspaceId)]
-> [(ScreenId, [WorkspaceId])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((ScreenId, WorkspaceId) -> (ScreenId, WorkspaceId) -> Bool)
-> [(ScreenId, WorkspaceId)] -> [[(ScreenId, WorkspaceId)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\(ScreenId, WorkspaceId)
a (ScreenId, WorkspaceId)
b -> (ScreenId, WorkspaceId) -> ScreenId
forall a b. (a, b) -> a
fst (ScreenId, WorkspaceId)
a ScreenId -> ScreenId -> Bool
forall a. Eq a => a -> a -> Bool
== (ScreenId, WorkspaceId) -> ScreenId
forall a b. (a, b) -> a
fst (ScreenId, WorkspaceId)
b) ([(ScreenId, WorkspaceId)] -> [[(ScreenId, WorkspaceId)]])
-> ([(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)])
-> [(ScreenId, WorkspaceId)]
-> [[(ScreenId, WorkspaceId)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((ScreenId, WorkspaceId) -> (ScreenId, WorkspaceId) -> Ordering)
-> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(ScreenId, WorkspaceId)
a (ScreenId, WorkspaceId)
b -> ScreenId -> ScreenId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((ScreenId, WorkspaceId) -> ScreenId
forall a b. (a, b) -> a
fst (ScreenId, WorkspaceId)
a) (ScreenId -> Ordering) -> ScreenId -> Ordering
forall a b. (a -> b) -> a -> b
$ (ScreenId, WorkspaceId) -> ScreenId
forall a b. (a, b) -> a
fst (ScreenId, WorkspaceId)
b)([(ScreenId, WorkspaceId)] -> [(ScreenId, [WorkspaceId])])
-> X [(ScreenId, WorkspaceId)] -> X [(ScreenId, [WorkspaceId])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
X [(ScreenId, WorkspaceId)]
workspaceHistoryWithScreen
workspaceHistory :: X [WorkspaceId]
workspaceHistory :: X [WorkspaceId]
workspaceHistory = [WorkspaceId] -> [WorkspaceId]
forall a. Eq a => [a] -> [a]
nub ([WorkspaceId] -> [WorkspaceId])
-> ([(ScreenId, WorkspaceId)] -> [WorkspaceId])
-> [(ScreenId, WorkspaceId)]
-> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ScreenId, WorkspaceId) -> WorkspaceId)
-> [(ScreenId, WorkspaceId)] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map (ScreenId, WorkspaceId) -> WorkspaceId
forall a b. (a, b) -> b
snd ([(ScreenId, WorkspaceId)] -> [WorkspaceId])
-> X [(ScreenId, WorkspaceId)] -> X [WorkspaceId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WorkspaceHistory -> [(ScreenId, WorkspaceId)])
-> X [(ScreenId, WorkspaceId)]
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets WorkspaceHistory -> [(ScreenId, WorkspaceId)]
history
workspaceHistoryTransaction :: X () -> X ()
workspaceHistoryTransaction :: X () -> X ()
workspaceHistoryTransaction X ()
action = do
[(ScreenId, WorkspaceId)]
startingHistory <- (WorkspaceHistory -> [(ScreenId, WorkspaceId)])
-> X [(ScreenId, WorkspaceId)]
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets WorkspaceHistory -> [(ScreenId, WorkspaceId)]
history
X ()
action
WorkspaceHistory
new <- (WindowSet -> WorkspaceHistory -> WorkspaceHistory)
-> WorkspaceHistory -> WindowSet -> WorkspaceHistory
forall a b c. (a -> b -> c) -> b -> a -> c
flip WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreen ([(ScreenId, WorkspaceId)] -> WorkspaceHistory
WorkspaceHistory [(ScreenId, WorkspaceId)]
startingHistory) (WindowSet -> WorkspaceHistory)
-> X WindowSet -> X WorkspaceHistory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
WorkspaceHistory -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (WorkspaceHistory -> X ()) -> WorkspaceHistory -> X ()
forall a b. (a -> b) -> a -> b
$! WorkspaceHistory -> WorkspaceHistory
forall a. NFData a => a -> a
force WorkspaceHistory
new
updateLastActiveOnEachScreen :: WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreen :: WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreen = [WorkspaceId] -> WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreenExclude []
updateLastActiveOnEachScreenExclude :: [WorkspaceId] -> WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreenExclude :: [WorkspaceId] -> WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreenExclude [WorkspaceId]
ws StackSet {current :: forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
cur, visible :: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible = [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis} WorkspaceHistory
wh =
WorkspaceHistory :: [(ScreenId, WorkspaceId)] -> WorkspaceHistory
WorkspaceHistory { history :: [(ScreenId, WorkspaceId)]
history = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
forall {sid} {l} {a} {sd}.
Eq sid =>
Screen WorkspaceId l a sid sd
-> [(sid, WorkspaceId)] -> [(sid, WorkspaceId)]
doUpdate Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
cur ([(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)])
-> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
forall a b. (a -> b) -> a -> b
$ ([(ScreenId, WorkspaceId)]
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [(ScreenId, WorkspaceId)])
-> [(ScreenId, WorkspaceId)]
-> [Screen
WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [(ScreenId, WorkspaceId)]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [(ScreenId, WorkspaceId)]
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [(ScreenId, WorkspaceId)]
forall {sid} {l} {a} {sd}.
Eq sid =>
[(sid, WorkspaceId)]
-> Screen WorkspaceId l a sid sd -> [(sid, WorkspaceId)]
updateLastForScreen (WorkspaceHistory -> [(ScreenId, WorkspaceId)]
history WorkspaceHistory
wh) ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [(ScreenId, WorkspaceId)])
-> [Screen
WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [(ScreenId, WorkspaceId)]
forall a b. (a -> b) -> a -> b
$ [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. [a] -> [a] -> [a]
++ [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
cur] }
where
firstOnScreen :: b -> t (b, b) -> Maybe (b, b)
firstOnScreen b
sid = ((b, b) -> Bool) -> t (b, b) -> Maybe (b, b)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
sid) (b -> Bool) -> ((b, b) -> b) -> (b, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, b) -> b
forall a b. (a, b) -> a
fst)
doUpdate :: Screen WorkspaceId l a sid sd
-> [(sid, WorkspaceId)] -> [(sid, WorkspaceId)]
doUpdate Screen {workspace :: forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace = Workspace { tag :: forall i l a. Workspace i l a -> i
tag = WorkspaceId
wid }, screen :: forall i l a sid sd. Screen i l a sid sd -> sid
screen = sid
sid} [(sid, WorkspaceId)]
curr =
let newEntry :: (sid, WorkspaceId)
newEntry = (sid
sid, WorkspaceId
wid)
in if WorkspaceId
wid WorkspaceId -> [WorkspaceId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
ws then [(sid, WorkspaceId)]
curr else (sid, WorkspaceId)
newEntry (sid, WorkspaceId) -> [(sid, WorkspaceId)] -> [(sid, WorkspaceId)]
forall a. a -> [a] -> [a]
: (sid, WorkspaceId) -> [(sid, WorkspaceId)] -> [(sid, WorkspaceId)]
forall a. Eq a => a -> [a] -> [a]
delete (sid, WorkspaceId)
newEntry [(sid, WorkspaceId)]
curr
updateLastForScreen :: [(sid, WorkspaceId)]
-> Screen WorkspaceId l a sid sd -> [(sid, WorkspaceId)]
updateLastForScreen [(sid, WorkspaceId)]
curr Screen {workspace :: forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace = Workspace { tag :: forall i l a. Workspace i l a -> i
tag = WorkspaceId
wid }, screen :: forall i l a sid sd. Screen i l a sid sd -> sid
screen = sid
sid} =
let newEntry :: (sid, WorkspaceId)
newEntry = (sid
sid, WorkspaceId
wid)
alreadyCurrent :: Bool
alreadyCurrent = (sid, WorkspaceId) -> Maybe (sid, WorkspaceId)
forall a. a -> Maybe a
Just (sid, WorkspaceId)
newEntry Maybe (sid, WorkspaceId) -> Maybe (sid, WorkspaceId) -> Bool
forall a. Eq a => a -> a -> Bool
== sid -> [(sid, WorkspaceId)] -> Maybe (sid, WorkspaceId)
forall {t :: * -> *} {b} {b}.
(Foldable t, Eq b) =>
b -> t (b, b) -> Maybe (b, b)
firstOnScreen sid
sid [(sid, WorkspaceId)]
curr
in if Bool
alreadyCurrent Bool -> Bool -> Bool
|| WorkspaceId
wid WorkspaceId -> [WorkspaceId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
ws then [(sid, WorkspaceId)]
curr else (sid, WorkspaceId)
newEntry (sid, WorkspaceId) -> [(sid, WorkspaceId)] -> [(sid, WorkspaceId)]
forall a. a -> [a] -> [a]
: (sid, WorkspaceId) -> [(sid, WorkspaceId)] -> [(sid, WorkspaceId)]
forall a. Eq a => a -> [a] -> [a]
delete (sid, WorkspaceId)
newEntry [(sid, WorkspaceId)]
curr
workspaceHistoryModify :: ([(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]) -> X ()
workspaceHistoryModify :: ([(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]) -> X ()
workspaceHistoryModify [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
action = (WorkspaceHistory -> WorkspaceHistory) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify' ((WorkspaceHistory -> WorkspaceHistory) -> X ())
-> (WorkspaceHistory -> WorkspaceHistory) -> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceHistory -> WorkspaceHistory
forall a. NFData a => a -> a
force (WorkspaceHistory -> WorkspaceHistory)
-> (WorkspaceHistory -> WorkspaceHistory)
-> WorkspaceHistory
-> WorkspaceHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ScreenId, WorkspaceId)] -> WorkspaceHistory
WorkspaceHistory ([(ScreenId, WorkspaceId)] -> WorkspaceHistory)
-> (WorkspaceHistory -> [(ScreenId, WorkspaceId)])
-> WorkspaceHistory
-> WorkspaceHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
action ([(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)])
-> (WorkspaceHistory -> [(ScreenId, WorkspaceId)])
-> WorkspaceHistory
-> [(ScreenId, WorkspaceId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceHistory -> [(ScreenId, WorkspaceId)]
history