module XMonad.Actions.DynamicWorkspaceGroups
(
WSGroupId
, addRawWSGroup
, addWSGroup
, addCurrentWSGroup
, forgetWSGroup
, viewWSGroup
, promptWSGroupView
, promptWSGroupAdd
, promptWSGroupForget
, WSGPrompt
, viewTopicGroup
, promptTopicGroupView
) where
import Control.Arrow ((&&&))
import qualified Data.Map as M
import XMonad
import XMonad.Prelude (find, for_)
import qualified XMonad.StackSet as W
import XMonad.Prompt
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Actions.TopicSpace
type WSGroup = [(ScreenId,WorkspaceId)]
type WSGroupId = String
newtype WSGroupStorage = WSG { WSGroupStorage -> Map WorkspaceId WSGroup
unWSG :: M.Map WSGroupId WSGroup }
deriving (ReadPrec [WSGroupStorage]
ReadPrec WSGroupStorage
Int -> ReadS WSGroupStorage
ReadS [WSGroupStorage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WSGroupStorage]
$creadListPrec :: ReadPrec [WSGroupStorage]
readPrec :: ReadPrec WSGroupStorage
$creadPrec :: ReadPrec WSGroupStorage
readList :: ReadS [WSGroupStorage]
$creadList :: ReadS [WSGroupStorage]
readsPrec :: Int -> ReadS WSGroupStorage
$creadsPrec :: Int -> ReadS WSGroupStorage
Read, Int -> WSGroupStorage -> ShowS
[WSGroupStorage] -> ShowS
WSGroupStorage -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [WSGroupStorage] -> ShowS
$cshowList :: [WSGroupStorage] -> ShowS
show :: WSGroupStorage -> WorkspaceId
$cshow :: WSGroupStorage -> WorkspaceId
showsPrec :: Int -> WSGroupStorage -> ShowS
$cshowsPrec :: Int -> WSGroupStorage -> ShowS
Show)
withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage
withWSG :: (Map WorkspaceId WSGroup -> Map WorkspaceId WSGroup)
-> WSGroupStorage -> WSGroupStorage
withWSG Map WorkspaceId WSGroup -> Map WorkspaceId WSGroup
f = Map WorkspaceId WSGroup -> WSGroupStorage
WSG forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WorkspaceId WSGroup -> Map WorkspaceId WSGroup
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. WSGroupStorage -> Map WorkspaceId WSGroup
unWSG
instance ExtensionClass WSGroupStorage where
initialValue :: WSGroupStorage
initialValue = Map WorkspaceId WSGroup -> WSGroupStorage
WSG forall k a. Map k a
M.empty
extensionType :: WSGroupStorage -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension
addRawWSGroup :: WSGroupId -> [(ScreenId, WorkspaceId)] -> X ()
addRawWSGroup :: WorkspaceId -> WSGroup -> X ()
addRawWSGroup WorkspaceId
name = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map WorkspaceId WSGroup -> Map WorkspaceId WSGroup)
-> WSGroupStorage -> WSGroupStorage
withWSG forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WorkspaceId
name
addWSGroup :: WSGroupId -> [WorkspaceId] -> X ()
addWSGroup :: WorkspaceId -> [WorkspaceId] -> X ()
addWSGroup WorkspaceId
name [WorkspaceId]
wids = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
w -> do
let wss :: [(WorkspaceId, ScreenId)]
wss = forall a b. (a -> b) -> [a] -> [b]
map ((forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall i l a sid sd. Screen i l a sid sd -> sid
W.screen) forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> [Screen i l a s sd]
W.screens WindowSet
w
wmap :: Maybe WSGroup
wmap = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {m :: * -> *} {a} {b}. Monad m => (m a, b) -> m (a, b)
strength forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(WorkspaceId, ScreenId)]
wss forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id)) [WorkspaceId]
wids
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe WSGroup
wmap (WorkspaceId -> WSGroup -> X ()
addRawWSGroup WorkspaceId
name)
where strength :: (m a, b) -> m (a, b)
strength (m a
ma, b
b) = m a
ma forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b)
addCurrentWSGroup :: WSGroupId -> X ()
addCurrentWSGroup :: WorkspaceId -> X ()
addCurrentWSGroup WorkspaceId
name = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
w ->
WorkspaceId -> [WorkspaceId] -> X ()
addWSGroup WorkspaceId
name forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
w forall a. a -> [a] -> [a]
: forall i l a s sd. StackSet i l a s sd -> [Screen i l a s sd]
W.visible WindowSet
w)
forgetWSGroup :: WSGroupId -> X ()
forgetWSGroup :: WorkspaceId -> X ()
forgetWSGroup = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map WorkspaceId WSGroup -> Map WorkspaceId WSGroup)
-> WSGroupStorage -> WSGroupStorage
withWSG forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Map k a
M.delete
viewWSGroup :: WSGroupId -> X ()
viewWSGroup :: WorkspaceId -> X ()
viewWSGroup = (WorkspaceId -> X ()) -> WorkspaceId -> X ()
viewGroup ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.greedyView)
viewGroup :: (WorkspaceId -> X ()) -> WSGroupId -> X ()
viewGroup :: (WorkspaceId -> X ()) -> WorkspaceId -> X ()
viewGroup WorkspaceId -> X ()
fview WorkspaceId
name = do
WSG Map WorkspaceId WSGroup
m <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WorkspaceId
name Map WorkspaceId WSGroup
m) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((WorkspaceId -> X ()) -> ScreenId -> WorkspaceId -> X ()
viewWS WorkspaceId -> X ()
fview))
viewWS :: (WorkspaceId -> X ()) -> ScreenId -> WorkspaceId -> X ()
viewWS :: (WorkspaceId -> X ()) -> ScreenId -> WorkspaceId -> X ()
viewWS WorkspaceId -> X ()
fview ScreenId
sid WorkspaceId
wid = do
Maybe WorkspaceId
mw <- ScreenId -> X (Maybe WorkspaceId)
findScreenWS ScreenId
sid
case Maybe WorkspaceId
mw of
Just WorkspaceId
w -> do
(WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view WorkspaceId
w
WorkspaceId -> X ()
fview WorkspaceId
wid
Maybe WorkspaceId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
findScreenWS :: ScreenId -> X (Maybe WorkspaceId)
findScreenWS :: ScreenId -> X (Maybe WorkspaceId)
findScreenWS ScreenId
sid = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
==ScreenId
sid) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sid
W.screen) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> [Screen i l a s sd]
W.screens
newtype WSGPrompt = WSGPrompt String
instance XPrompt WSGPrompt where
showXPrompt :: WSGPrompt -> WorkspaceId
showXPrompt (WSGPrompt WorkspaceId
s) = WorkspaceId
s
promptWSGroupView :: XPConfig -> String -> X ()
promptWSGroupView :: XPConfig -> WorkspaceId -> X ()
promptWSGroupView = (WorkspaceId -> X ()) -> XPConfig -> WorkspaceId -> X ()
promptGroupView WorkspaceId -> X ()
viewWSGroup
promptGroupView :: (WSGroupId -> X ()) -> XPConfig -> String -> X ()
promptGroupView :: (WorkspaceId -> X ()) -> XPConfig -> WorkspaceId -> X ()
promptGroupView WorkspaceId -> X ()
fview XPConfig
xp WorkspaceId
s = do
[WorkspaceId]
gs <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k a. Map k a -> [k]
M.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. WSGroupStorage -> Map WorkspaceId WSGroup
unWSG) forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> WSGPrompt
WSGPrompt WorkspaceId
s) XPConfig
xp (XPConfig -> [WorkspaceId] -> ComplFunction
mkComplFunFromList' XPConfig
xp [WorkspaceId]
gs) WorkspaceId -> X ()
fview
promptWSGroupAdd :: XPConfig -> String -> X ()
promptWSGroupAdd :: XPConfig -> WorkspaceId -> X ()
promptWSGroupAdd XPConfig
xp WorkspaceId
s =
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> WSGPrompt
WSGPrompt WorkspaceId
s) XPConfig
xp (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return []) WorkspaceId -> X ()
addCurrentWSGroup
promptWSGroupForget :: XPConfig -> String -> X ()
promptWSGroupForget :: XPConfig -> WorkspaceId -> X ()
promptWSGroupForget XPConfig
xp WorkspaceId
s = do
[WorkspaceId]
gs <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k a. Map k a -> [k]
M.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. WSGroupStorage -> Map WorkspaceId WSGroup
unWSG) forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> WSGPrompt
WSGPrompt WorkspaceId
s) XPConfig
xp (XPConfig -> [WorkspaceId] -> ComplFunction
mkComplFunFromList' XPConfig
xp [WorkspaceId]
gs) WorkspaceId -> X ()
forgetWSGroup
promptTopicGroupView :: TopicConfig -> XPConfig -> String -> X ()
promptTopicGroupView :: TopicConfig -> XPConfig -> WorkspaceId -> X ()
promptTopicGroupView = (WorkspaceId -> X ()) -> XPConfig -> WorkspaceId -> X ()
promptGroupView forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopicConfig -> WorkspaceId -> X ()
viewTopicGroup
viewTopicGroup :: TopicConfig -> WSGroupId -> X ()
viewTopicGroup :: TopicConfig -> WorkspaceId -> X ()
viewTopicGroup = (WorkspaceId -> X ()) -> WorkspaceId -> X ()
viewGroup forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopicConfig -> WorkspaceId -> X ()
switchTopic