-----------------------------------------------------------------------------
-- |
-- 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\/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 WSGroupId 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
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 -> WSGroupId
(Int -> WSGroupStorage -> ShowS)
-> (WSGroupStorage -> WSGroupId)
-> ([WSGroupStorage] -> ShowS)
-> Show WSGroupStorage
forall a.
(Int -> a -> ShowS) -> (a -> WSGroupId) -> ([a] -> ShowS) -> Show a
showList :: [WSGroupStorage] -> ShowS
$cshowList :: [WSGroupStorage] -> ShowS
show :: WSGroupStorage -> WSGroupId
$cshow :: WSGroupStorage -> WSGroupId
showsPrec :: Int -> WSGroupStorage -> ShowS
$cshowsPrec :: Int -> WSGroupStorage -> ShowS
Show)

withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage
withWSG :: (Map WSGroupId WSGroup -> Map WSGroupId WSGroup)
-> WSGroupStorage -> WSGroupStorage
withWSG Map WSGroupId WSGroup -> Map WSGroupId WSGroup
f = Map WSGroupId WSGroup -> WSGroupStorage
WSG (Map WSGroupId WSGroup -> WSGroupStorage)
-> (WSGroupStorage -> Map WSGroupId WSGroup)
-> WSGroupStorage
-> WSGroupStorage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WSGroupId WSGroup -> Map WSGroupId WSGroup
f (Map WSGroupId WSGroup -> Map WSGroupId WSGroup)
-> (WSGroupStorage -> Map WSGroupId WSGroup)
-> WSGroupStorage
-> Map WSGroupId WSGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WSGroupStorage -> Map WSGroupId WSGroup
unWSG

instance ExtensionClass WSGroupStorage where
  initialValue :: WSGroupStorage
initialValue = Map WSGroupId WSGroup -> WSGroupStorage
WSG Map WSGroupId 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 :: WSGroupId -> WSGroup -> X ()
addRawWSGroup WSGroupId
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 WSGroupId WSGroup -> Map WSGroupId WSGroup)
-> WSGroupStorage -> WSGroupStorage
withWSG ((Map WSGroupId WSGroup -> Map WSGroupId WSGroup)
 -> WSGroupStorage -> WSGroupStorage)
-> (WSGroup -> Map WSGroupId WSGroup -> Map WSGroupId WSGroup)
-> WSGroup
-> WSGroupStorage
-> WSGroupStorage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WSGroupId
-> WSGroup -> Map WSGroupId WSGroup -> Map WSGroupId WSGroup
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WSGroupId
name

-- | Add a new workspace group with the given name.
addWSGroup :: WSGroupId -> [WorkspaceId] -> X ()
addWSGroup :: WSGroupId -> [WSGroupId] -> X ()
addWSGroup WSGroupId
name [WSGroupId]
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 :: [(WSGroupId, ScreenId)]
wss  = (Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
 -> (WSGroupId, ScreenId))
-> [Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail]
-> [(WSGroupId, ScreenId)]
forall a b. (a -> b) -> [a] -> [b]
map ((Workspace WSGroupId (Layout Window) Window -> WSGroupId
forall i l a. Workspace i l a -> i
W.tag (Workspace WSGroupId (Layout Window) Window -> WSGroupId)
-> (Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
    -> Workspace WSGroupId (Layout Window) Window)
-> Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
-> WSGroupId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WSGroupId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) (Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
 -> WSGroupId)
-> (Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId)
-> Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
-> (WSGroupId, ScreenId)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen) ([Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail]
 -> [(WSGroupId, ScreenId)])
-> [Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail]
-> [(WSGroupId, ScreenId)]
forall a b. (a -> b) -> a -> b
$ WindowSet
-> [Screen WSGroupId (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 = (WSGroupId -> Maybe (ScreenId, WSGroupId))
-> [WSGroupId] -> Maybe WSGroup
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Maybe ScreenId, WSGroupId) -> Maybe (ScreenId, WSGroupId)
forall (m :: * -> *) a b. Monad m => (m a, b) -> m (a, b)
strength ((Maybe ScreenId, WSGroupId) -> Maybe (ScreenId, WSGroupId))
-> (WSGroupId -> (Maybe ScreenId, WSGroupId))
-> WSGroupId
-> Maybe (ScreenId, WSGroupId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((WSGroupId -> [(WSGroupId, ScreenId)] -> Maybe ScreenId)
-> [(WSGroupId, ScreenId)] -> WSGroupId -> Maybe ScreenId
forall a b c. (a -> b -> c) -> b -> a -> c
flip WSGroupId -> [(WSGroupId, ScreenId)] -> Maybe ScreenId
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(WSGroupId, ScreenId)]
wss (WSGroupId -> Maybe ScreenId)
-> ShowS -> WSGroupId -> (Maybe ScreenId, WSGroupId)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ShowS
forall a. a -> a
id)) [WSGroupId]
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 (WSGroupId -> WSGroup -> X ()
addRawWSGroup WSGroupId
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> (a, b) -> m (a, b)
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 :: WSGroupId -> X ()
addCurrentWSGroup WSGroupId
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 ->
  WSGroupId -> [WSGroupId] -> X ()
addWSGroup WSGroupId
name ([WSGroupId] -> X ()) -> [WSGroupId] -> X ()
forall a b. (a -> b) -> a -> b
$ (Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
 -> WSGroupId)
-> [Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail]
-> [WSGroupId]
forall a b. (a -> b) -> [a] -> [b]
map (Workspace WSGroupId (Layout Window) Window -> WSGroupId
forall i l a. Workspace i l a -> i
W.tag (Workspace WSGroupId (Layout Window) Window -> WSGroupId)
-> (Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
    -> Workspace WSGroupId (Layout Window) Window)
-> Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
-> WSGroupId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WSGroupId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) ([Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail]
forall a. [a] -> [a]
reverse ([Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail]
 -> [Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail])
-> [Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail]
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen WSGroupId (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 WSGroupId (Layout Window) Window ScreenId ScreenDetail
-> [Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen WSGroupId (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 :: WSGroupId -> X ()
forgetWSGroup = (WSGroupStorage -> WSGroupStorage) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((WSGroupStorage -> WSGroupStorage) -> X ())
-> (WSGroupId -> WSGroupStorage -> WSGroupStorage)
-> WSGroupId
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map WSGroupId WSGroup -> Map WSGroupId WSGroup)
-> WSGroupStorage -> WSGroupStorage
withWSG ((Map WSGroupId WSGroup -> Map WSGroupId WSGroup)
 -> WSGroupStorage -> WSGroupStorage)
-> (WSGroupId -> Map WSGroupId WSGroup -> Map WSGroupId WSGroup)
-> WSGroupId
-> WSGroupStorage
-> WSGroupStorage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WSGroupId -> Map WSGroupId WSGroup -> Map WSGroupId 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 :: WSGroupId -> X ()
viewWSGroup = (WSGroupId -> X ()) -> WSGroupId -> X ()
viewGroup ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WSGroupId -> WindowSet -> WindowSet) -> WSGroupId -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WSGroupId -> 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 :: (WSGroupId -> X ()) -> WSGroupId -> X ()
viewGroup WSGroupId -> X ()
fview WSGroupId
name = do
  WSG Map WSGroupId 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_ (WSGroupId -> Map WSGroupId WSGroup -> Maybe WSGroup
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WSGroupId
name Map WSGroupId WSGroup
m) ((WSGroup -> X ()) -> X ()) -> (WSGroup -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$
    ((ScreenId, WSGroupId) -> X ()) -> WSGroup -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((ScreenId -> WSGroupId -> X ()) -> (ScreenId, WSGroupId) -> X ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((WSGroupId -> X ()) -> ScreenId -> WSGroupId -> X ()
viewWS WSGroupId -> X ()
fview))

-- | View the given workspace on the given screen, using the provided function.
viewWS :: (WorkspaceId -> X ())  -> ScreenId -> WorkspaceId -> X ()
viewWS :: (WSGroupId -> X ()) -> ScreenId -> WSGroupId -> X ()
viewWS WSGroupId -> X ()
fview ScreenId
sid WSGroupId
wid = do
  Maybe WSGroupId
mw <- ScreenId -> X (Maybe WSGroupId)
findScreenWS ScreenId
sid
  case Maybe WSGroupId
mw of
    Just WSGroupId
w -> do
      (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ WSGroupId -> 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 WSGroupId
w
      WSGroupId -> X ()
fview WSGroupId
wid
    Maybe WSGroupId
Nothing -> () -> X ()
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 WSGroupId)
findScreenWS ScreenId
sid = (WindowSet -> X (Maybe WSGroupId)) -> X (Maybe WSGroupId)
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X (Maybe WSGroupId)) -> X (Maybe WSGroupId))
-> (WindowSet -> X (Maybe WSGroupId)) -> X (Maybe WSGroupId)
forall a b. (a -> b) -> a -> b
$
  Maybe WSGroupId -> X (Maybe WSGroupId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe WSGroupId -> X (Maybe WSGroupId))
-> (WindowSet -> Maybe WSGroupId)
-> WindowSet
-> X (Maybe WSGroupId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
 -> WSGroupId)
-> Maybe
     (Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail)
-> Maybe WSGroupId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Workspace WSGroupId (Layout Window) Window -> WSGroupId
forall i l a. Workspace i l a -> i
W.tag (Workspace WSGroupId (Layout Window) Window -> WSGroupId)
-> (Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
    -> Workspace WSGroupId (Layout Window) Window)
-> Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
-> WSGroupId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WSGroupId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) (Maybe
   (Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail)
 -> Maybe WSGroupId)
-> (WindowSet
    -> Maybe
         (Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail))
-> WindowSet
-> Maybe WSGroupId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
 -> Bool)
-> [Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail]
-> Maybe
     (Screen WSGroupId (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 WSGroupId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId)
-> Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen) ([Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail]
 -> Maybe
      (Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail))
-> (WindowSet
    -> [Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail])
-> WindowSet
-> Maybe
     (Screen WSGroupId (Layout Window) Window ScreenId ScreenDetail)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> [Screen WSGroupId (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 -> WSGroupId
showXPrompt (WSGPrompt WSGroupId
s) = WSGroupId
s

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

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

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

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

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