{-# 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)
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]
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
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)
deriving WorkspaceHistory -> ()
forall a. (a -> ()) -> NFData a
rnf :: WorkspaceHistory -> ()
$crnf :: WorkspaceHistory -> ()
NFData via [(Int, WorkspaceId)]
instance ExtensionClass WorkspaceHistory where
initialValue :: WorkspaceHistory
initialValue = [(ScreenId, WorkspaceId)] -> WorkspaceHistory
WorkspaceHistory []
extensionType :: WorkspaceHistory -> StateExtension
extensionType = 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 = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify' forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> WorkspaceHistory -> WorkspaceHistory
update forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 = forall a. NFData a => a -> a
force 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 = 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 =
forall a b. (a -> b) -> [a] -> [b]
map (\[(ScreenId, WorkspaceId)]
wss -> (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(ScreenId, WorkspaceId)]
wss, forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(ScreenId, WorkspaceId)]
wss)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\(ScreenId, WorkspaceId)
a (ScreenId, WorkspaceId)
b -> forall a b. (a, b) -> a
fst (ScreenId, WorkspaceId)
a forall a. Eq a => a -> a -> Bool
== forall a b. (a, b) -> a
fst (ScreenId, WorkspaceId)
b) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(ScreenId, WorkspaceId)
a (ScreenId, WorkspaceId)
b -> forall a. Ord a => a -> a -> Ordering
compare (forall a b. (a, b) -> a
fst (ScreenId, WorkspaceId)
a) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (ScreenId, WorkspaceId)
b)forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
X [(ScreenId, WorkspaceId)]
workspaceHistoryWithScreen
workspaceHistory :: X [WorkspaceId]
workspaceHistory :: X [WorkspaceId]
workspaceHistory = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets WorkspaceHistory -> [(ScreenId, WorkspaceId)]
history
X ()
action
WorkspaceHistory
new <- forall a b c. (a -> b -> c) -> b -> a -> c
flip WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreen ([(ScreenId, WorkspaceId)] -> WorkspaceHistory
WorkspaceHistory [(ScreenId, WorkspaceId)]
startingHistory) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put forall a b. (a -> b) -> a -> b
$! 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 = 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {sid} {l} {a} {sd}.
Eq sid =>
[(sid, WorkspaceId)]
-> Screen WorkspaceId l a sid sd -> [(sid, WorkspaceId)]
updateLastForScreen (WorkspaceHistory -> [(ScreenId, WorkspaceId)]
history WorkspaceHistory
wh) forall a b. (a -> b) -> a -> b
$ [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis 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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== b
sid) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
ws then [(sid, WorkspaceId)]
curr else (sid, WorkspaceId)
newEntry forall a. a -> [a] -> [a]
: 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 = forall a. a -> Maybe a
Just (sid, WorkspaceId)
newEntry forall a. Eq a => a -> a -> Bool
== 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
ws then [(sid, WorkspaceId)]
curr else (sid, WorkspaceId)
newEntry forall a. a -> [a] -> [a]
: 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 = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify' forall a b. (a -> b) -> a -> b
$ forall a. NFData a => a -> a
force forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ScreenId, WorkspaceId)] -> WorkspaceHistory
WorkspaceHistory forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
action forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceHistory -> [(ScreenId, WorkspaceId)]
history