-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.DynamicWorkspaceGroups
-- Description :  Dynamically manage workspace groups in multi-head setups.
-- Copyright   :  (c) Brent Yorgey 2009
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  <byorgey@gmail.com>
-- Stability   :  experimental
-- Portability :  unportable
--
-- Dynamically manage \"workspace groups\", sets of workspaces being
-- used together for some common task or purpose, to allow switching
-- between workspace groups in a single action.  Note that this only
-- makes sense for multi-head setups.
--
-----------------------------------------------------------------------------

module XMonad.Actions.DynamicWorkspaceGroups
    ( -- * Usage
      -- $usage

      WSGroupId

    , addRawWSGroup
    , addWSGroup
    , addCurrentWSGroup
    , forgetWSGroup
    , viewWSGroup

    , promptWSGroupView
    , promptWSGroupAdd
    , promptWSGroupForget

    , WSGPrompt
     -- * TopicSpace Integration
     -- $topics
    , 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

-- $usage
-- You can use this module by importing it into your @xmonad.hs@ file:
--
-- > import XMonad.Actions.DynamicWorkspaceGroups
--
-- Then add keybindings like the following (this example uses
-- "XMonad.Util.EZConfig"-style keybindings, but this is not necessary):
--
-- >    , ("M-y n", promptWSGroupAdd myXPConfig "Name this group: ")
-- >    , ("M-y g", promptWSGroupView myXPConfig "Go to group: ")
-- >    , ("M-y d", promptWSGroupForget myXPConfig "Forget group: ")
--

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]
(Int -> ReadS WSGroupStorage)
-> ReadS [WSGroupStorage]
-> ReadPrec WSGroupStorage
-> ReadPrec [WSGroupStorage]
-> Read WSGroupStorage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS WSGroupStorage
readsPrec :: Int -> ReadS WSGroupStorage
$creadList :: ReadS [WSGroupStorage]
readList :: ReadS [WSGroupStorage]
$creadPrec :: ReadPrec WSGroupStorage
readPrec :: ReadPrec WSGroupStorage
$creadListPrec :: ReadPrec [WSGroupStorage]
readListPrec :: ReadPrec [WSGroupStorage]
Read, Int -> WSGroupStorage -> ShowS
[WSGroupStorage] -> ShowS
WSGroupStorage -> WorkspaceId
(Int -> WSGroupStorage -> ShowS)
-> (WSGroupStorage -> WorkspaceId)
-> ([WSGroupStorage] -> ShowS)
-> Show WSGroupStorage
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WSGroupStorage -> ShowS
showsPrec :: Int -> WSGroupStorage -> ShowS
$cshow :: WSGroupStorage -> WorkspaceId
show :: WSGroupStorage -> WorkspaceId
$cshowList :: [WSGroupStorage] -> ShowS
showList :: [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 (Map WorkspaceId WSGroup -> WSGroupStorage)
-> (WSGroupStorage -> Map WorkspaceId WSGroup)
-> WSGroupStorage
-> WSGroupStorage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WorkspaceId WSGroup -> Map WorkspaceId WSGroup
f (Map WorkspaceId WSGroup -> Map WorkspaceId WSGroup)
-> (WSGroupStorage -> Map WorkspaceId WSGroup)
-> WSGroupStorage
-> Map WorkspaceId WSGroup
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 Map WorkspaceId WSGroup
forall k a. Map k a
M.empty
  extensionType :: WSGroupStorage -> StateExtension
extensionType = WSGroupStorage -> StateExtension
forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension

-- | Add a new workspace group of the given name, mapping to an
--   explicitly specified association between screen IDs and workspace
--   names.  This function could be useful for, say, creating some
--   standard workspace groups in your startup hook.
addRawWSGroup :: WSGroupId -> [(ScreenId, WorkspaceId)] -> X ()
addRawWSGroup :: WorkspaceId -> WSGroup -> X ()
addRawWSGroup WorkspaceId
name = (WSGroupStorage -> WSGroupStorage) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((WSGroupStorage -> WSGroupStorage) -> X ())
-> (WSGroup -> WSGroupStorage -> WSGroupStorage) -> WSGroup -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map WorkspaceId WSGroup -> Map WorkspaceId WSGroup)
-> WSGroupStorage -> WSGroupStorage
withWSG ((Map WorkspaceId WSGroup -> Map WorkspaceId WSGroup)
 -> WSGroupStorage -> WSGroupStorage)
-> (WSGroup -> Map WorkspaceId WSGroup -> Map WorkspaceId WSGroup)
-> WSGroup
-> WSGroupStorage
-> WSGroupStorage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId
-> WSGroup -> Map WorkspaceId WSGroup -> Map WorkspaceId WSGroup
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WorkspaceId
name

-- | Add a new workspace group with the given name.
addWSGroup :: WSGroupId -> [WorkspaceId] -> X ()
addWSGroup :: WorkspaceId -> [WorkspaceId] -> X ()
addWSGroup WorkspaceId
name [WorkspaceId]
wids = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
w -> do
  let wss :: [(WorkspaceId, ScreenId)]
wss  = (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> (WorkspaceId, ScreenId))
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [(WorkspaceId, ScreenId)]
forall a b. (a -> b) -> [a] -> [b]
map ((Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Workspace WorkspaceId (Layout Window) Window)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceId)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> (WorkspaceId, ScreenId)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen) ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> [(WorkspaceId, ScreenId)])
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [(WorkspaceId, ScreenId)]
forall a b. (a -> b) -> a -> b
$ WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
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 = (WorkspaceId -> Maybe (ScreenId, WorkspaceId))
-> [WorkspaceId] -> Maybe WSGroup
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Maybe ScreenId, WorkspaceId) -> Maybe (ScreenId, WorkspaceId)
forall {m :: * -> *} {a} {b}. Monad m => (m a, b) -> m (a, b)
strength ((Maybe ScreenId, WorkspaceId) -> Maybe (ScreenId, WorkspaceId))
-> (WorkspaceId -> (Maybe ScreenId, WorkspaceId))
-> WorkspaceId
-> Maybe (ScreenId, WorkspaceId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((WorkspaceId -> [(WorkspaceId, ScreenId)] -> Maybe ScreenId)
-> [(WorkspaceId, ScreenId)] -> WorkspaceId -> Maybe ScreenId
forall a b c. (a -> b -> c) -> b -> a -> c
flip WorkspaceId -> [(WorkspaceId, ScreenId)] -> Maybe ScreenId
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(WorkspaceId, ScreenId)]
wss (WorkspaceId -> Maybe ScreenId)
-> ShowS -> WorkspaceId -> (Maybe ScreenId, WorkspaceId)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ShowS
forall a. a -> a
id)) [WorkspaceId]
wids
  Maybe WSGroup -> (WSGroup -> X ()) -> X ()
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 m a -> (a -> m (a, b)) -> m (a, b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> (a, b) -> m (a, b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b)

-- | Give a name to the current workspace group.
addCurrentWSGroup :: WSGroupId -> X ()
addCurrentWSGroup :: WorkspaceId -> X ()
addCurrentWSGroup WorkspaceId
name = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
w ->
  WorkspaceId -> [WorkspaceId] -> X ()
addWSGroup WorkspaceId
name ([WorkspaceId] -> X ()) -> [WorkspaceId] -> X ()
forall a b. (a -> b) -> a -> b
$ (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceId)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Workspace WorkspaceId (Layout Window) Window)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. [a] -> [a]
reverse ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> [Screen
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
w 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]
: WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a s sd. StackSet i l a s sd -> [Screen i l a s sd]
W.visible WindowSet
w)

-- | Delete the named workspace group from the list of workspace
--   groups.  Note that this has no effect on the workspaces involved;
--   it simply forgets the given name.
forgetWSGroup :: WSGroupId -> X ()
forgetWSGroup :: WorkspaceId -> X ()
forgetWSGroup = (WSGroupStorage -> WSGroupStorage) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((WSGroupStorage -> WSGroupStorage) -> X ())
-> (WorkspaceId -> WSGroupStorage -> WSGroupStorage)
-> WorkspaceId
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map WorkspaceId WSGroup -> Map WorkspaceId WSGroup)
-> WSGroupStorage -> WSGroupStorage
withWSG ((Map WorkspaceId WSGroup -> Map WorkspaceId WSGroup)
 -> WSGroupStorage -> WSGroupStorage)
-> (WorkspaceId
    -> Map WorkspaceId WSGroup -> Map WorkspaceId WSGroup)
-> WorkspaceId
-> WSGroupStorage
-> WSGroupStorage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> Map WorkspaceId WSGroup -> Map WorkspaceId WSGroup
forall k a. Ord k => k -> Map k a -> Map k a
M.delete

-- | View the workspace group with the given name.
viewWSGroup :: WSGroupId -> X ()
viewWSGroup :: WorkspaceId -> X ()
viewWSGroup = (WorkspaceId -> X ()) -> WorkspaceId -> X ()
viewGroup ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WindowSet -> WindowSet
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)

-- | Internal function for viewing a group.
viewGroup :: (WorkspaceId -> X ()) -> WSGroupId -> X ()
viewGroup :: (WorkspaceId -> X ()) -> WorkspaceId -> X ()
viewGroup WorkspaceId -> X ()
fview WorkspaceId
name = do
  WSG Map WorkspaceId WSGroup
m <- X WSGroupStorage
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
  Maybe WSGroup -> (WSGroup -> X ()) -> X ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (WorkspaceId -> Map WorkspaceId WSGroup -> Maybe WSGroup
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WorkspaceId
name Map WorkspaceId WSGroup
m) ((WSGroup -> X ()) -> X ()) -> (WSGroup -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$
    ((ScreenId, WorkspaceId) -> X ()) -> WSGroup -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((ScreenId -> WorkspaceId -> X ())
-> (ScreenId, WorkspaceId) -> X ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((WorkspaceId -> X ()) -> ScreenId -> WorkspaceId -> X ()
viewWS WorkspaceId -> X ()
fview))

-- | View the given workspace on the given screen, using the provided function.
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 ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> WindowSet -> WindowSet
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 -> () -> X ()
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Find the workspace which is currently on the given screen.
findScreenWS :: ScreenId -> X (Maybe WorkspaceId)
findScreenWS :: ScreenId -> X (Maybe WorkspaceId)
findScreenWS ScreenId
sid = (WindowSet -> X (Maybe WorkspaceId)) -> X (Maybe WorkspaceId)
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X (Maybe WorkspaceId)) -> X (Maybe WorkspaceId))
-> (WindowSet -> X (Maybe WorkspaceId)) -> X (Maybe WorkspaceId)
forall a b. (a -> b) -> a -> b
$
  Maybe WorkspaceId -> X (Maybe WorkspaceId)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe WorkspaceId -> X (Maybe WorkspaceId))
-> (WindowSet -> Maybe WorkspaceId)
-> WindowSet
-> X (Maybe WorkspaceId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceId)
-> Maybe
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Maybe WorkspaceId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Workspace WorkspaceId (Layout Window) Window)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) (Maybe
   (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> Maybe WorkspaceId)
-> (WindowSet
    -> Maybe
         (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
-> WindowSet
-> Maybe WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Bool)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> Maybe
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((ScreenId -> ScreenId -> Bool
forall a. Eq a => a -> a -> Bool
==ScreenId
sid) (ScreenId -> Bool)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen) ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> Maybe
      (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
-> (WindowSet
    -> [Screen
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> WindowSet
-> Maybe
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
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

-- | Prompt for a workspace group to view.
promptWSGroupView :: XPConfig -> String -> X ()
promptWSGroupView :: XPConfig -> WorkspaceId -> X ()
promptWSGroupView = (WorkspaceId -> X ()) -> XPConfig -> WorkspaceId -> X ()
promptGroupView WorkspaceId -> X ()
viewWSGroup

-- | Internal function for making a prompt to view a workspace group
promptGroupView :: (WSGroupId -> X ()) -> XPConfig -> String -> X ()
promptGroupView :: (WorkspaceId -> X ()) -> XPConfig -> WorkspaceId -> X ()
promptGroupView WorkspaceId -> X ()
fview XPConfig
xp WorkspaceId
s = do
  [WorkspaceId]
gs <- (WSGroupStorage -> [WorkspaceId])
-> X WSGroupStorage -> X [WorkspaceId]
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map WorkspaceId WSGroup -> [WorkspaceId]
forall k a. Map k a -> [k]
M.keys (Map WorkspaceId WSGroup -> [WorkspaceId])
-> (WSGroupStorage -> Map WorkspaceId WSGroup)
-> WSGroupStorage
-> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WSGroupStorage -> Map WorkspaceId WSGroup
unWSG) X WSGroupStorage
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
  WSGPrompt
-> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
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

-- | Prompt for a name for the current workspace group.
promptWSGroupAdd :: XPConfig -> String -> X ()
promptWSGroupAdd :: XPConfig -> WorkspaceId -> X ()
promptWSGroupAdd XPConfig
xp WorkspaceId
s =
  WSGPrompt
-> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> WSGPrompt
WSGPrompt WorkspaceId
s) XPConfig
xp (IO [WorkspaceId] -> ComplFunction
forall a b. a -> b -> a
const (IO [WorkspaceId] -> ComplFunction)
-> IO [WorkspaceId] -> ComplFunction
forall a b. (a -> b) -> a -> b
$ [WorkspaceId] -> IO [WorkspaceId]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []) WorkspaceId -> X ()
addCurrentWSGroup

-- | Prompt for a workspace group to forget.
promptWSGroupForget :: XPConfig -> String -> X ()
promptWSGroupForget :: XPConfig -> WorkspaceId -> X ()
promptWSGroupForget XPConfig
xp WorkspaceId
s = do
  [WorkspaceId]
gs <- (WSGroupStorage -> [WorkspaceId])
-> X WSGroupStorage -> X [WorkspaceId]
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map WorkspaceId WSGroup -> [WorkspaceId]
forall k a. Map k a -> [k]
M.keys (Map WorkspaceId WSGroup -> [WorkspaceId])
-> (WSGroupStorage -> Map WorkspaceId WSGroup)
-> WSGroupStorage
-> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WSGroupStorage -> Map WorkspaceId WSGroup
unWSG) X WSGroupStorage
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
  WSGPrompt
-> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
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

-- $topics
-- You can use this module with "XMonad.Actions.TopicSpace" — just replace
-- 'promptWSGroupView' with 'promptTopicGroupView':
--
-- >    , ("M-y n", promptWSGroupAdd myXPConfig "Name this group: ")
-- >    , ("M-y g", promptTopicGroupView myTopicConfig myXPConfig "Go to group: ")
-- >    , ("M-y d", promptWSGroupForget myXPConfig "Forget group: ")
--
-- It's also a good idea to replace 'spawn' with
-- 'XMonad.Actions.SpawnOn.spawnOn' or 'XMonad.Actions.SpawnOn.spawnHere' in
-- your topic actions, so everything is spawned where it should be.

-- | Prompt for a workspace group to view, treating the workspaces as topics.
promptTopicGroupView :: TopicConfig -> XPConfig -> String -> X ()
promptTopicGroupView :: TopicConfig -> XPConfig -> WorkspaceId -> X ()
promptTopicGroupView = (WorkspaceId -> X ()) -> XPConfig -> WorkspaceId -> X ()
promptGroupView ((WorkspaceId -> X ()) -> XPConfig -> WorkspaceId -> X ())
-> (TopicConfig -> WorkspaceId -> X ())
-> TopicConfig
-> XPConfig
-> WorkspaceId
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopicConfig -> WorkspaceId -> X ()
viewTopicGroup

-- | View the workspace group with the given name, treating the workspaces as
-- topics.
viewTopicGroup :: TopicConfig -> WSGroupId -> X ()
viewTopicGroup :: TopicConfig -> WorkspaceId -> X ()
viewTopicGroup = (WorkspaceId -> X ()) -> WorkspaceId -> X ()
viewGroup ((WorkspaceId -> X ()) -> WorkspaceId -> X ())
-> (TopicConfig -> WorkspaceId -> X ())
-> TopicConfig
-> WorkspaceId
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopicConfig -> WorkspaceId -> X ()
switchTopic