{-# 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]
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 b a. b -> (a -> b) -> Maybe a -> b
maybe ScreenId
0 forall a b. (a, b) -> a
fst (forall a. [a] -> Maybe a
listToMaybe [(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