{-# LANGUAGE DerivingVia #-}
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, listToMaybe)
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
$creadsPrec :: Int -> ReadS WorkspaceHistory
readsPrec :: Int -> ReadS WorkspaceHistory
$creadList :: ReadS [WorkspaceHistory]
readList :: ReadS [WorkspaceHistory]
$creadPrec :: ReadPrec WorkspaceHistory
readPrec :: ReadPrec WorkspaceHistory
$creadListPrec :: ReadPrec [WorkspaceHistory]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> WorkspaceHistory -> ShowS
showsPrec :: Int -> WorkspaceHistory -> ShowS
$cshow :: WorkspaceHistory -> WorkspaceId
show :: WorkspaceHistory -> WorkspaceId
$cshowList :: [WorkspaceHistory] -> ShowS
showList :: [WorkspaceHistory] -> ShowS
Show)
deriving WorkspaceHistory -> ()
(WorkspaceHistory -> ()) -> NFData WorkspaceHistory
forall a. (a -> ()) -> NFData a
$crnf :: WorkspaceHistory -> ()
rnf :: WorkspaceHistory -> ()
NFData via [(Int, WorkspaceId)]
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
-> ((ScreenId, WorkspaceId) -> ScreenId)
-> Maybe (ScreenId, WorkspaceId)
-> ScreenId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ScreenId
0 (ScreenId, WorkspaceId) -> ScreenId
forall a b. (a, b) -> a
fst ([(ScreenId, WorkspaceId)] -> Maybe (ScreenId, WorkspaceId)
forall a. [a] -> Maybe a
listToMaybe [(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 { 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 b a. (b -> a -> b) -> b -> [a] -> b
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 a. Eq a => a -> [a] -> 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 a. Eq a => a -> [a] -> 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