-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.WorkspaceNames
-- Description :  Persistently rename workspace and swap them along with their names.
-- Copyright   :  (c) Tomas Janousek <tomi@nomi.cz>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Tomas Janousek <tomi@nomi.cz>
-- Stability   :  experimental
-- Portability :  unportable
--
-- Provides bindings to rename workspaces, show these names in a status bar and
-- swap workspaces along with their names. These names survive restart.
-- Together with "XMonad.Layout.WorkspaceDir" this provides for a fully
-- dynamic topic space workflow.
--
-----------------------------------------------------------------------------

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

    -- * Workspace naming
    renameWorkspace,
    getWorkspaceNames',
    getWorkspaceNames,
    getWorkspaceName,
    getCurrentWorkspaceName,
    setWorkspaceName,
    setCurrentWorkspaceName,

    -- * Workspace swapping
    swapTo,
    swapTo',
    swapWithCurrent,

    -- * Workspace prompt
    workspaceNamePrompt,

    -- * StatusBar, EwmhDesktops integration
    workspaceNamesPP,
    workspaceNamesEwmh,
    ) where

import XMonad
import XMonad.Prelude (fromMaybe, isInfixOf, (<&>), (>=>))
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS

import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), anyWS)
import qualified XMonad.Actions.SwapWorkspaces as Swap
import XMonad.Hooks.StatusBar.PP (PP(..))
import XMonad.Hooks.EwmhDesktops (addEwmhWorkspaceRename)
import XMonad.Prompt (mkXPrompt, XPConfig)
import XMonad.Prompt.Workspace (Wor(Wor))
import XMonad.Util.WorkspaceCompare (getSortByIndex)

import qualified Data.Map as M

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.WorkspaceNames
--
-- Then add keybindings like the following:
--
-- >   , ((modm .|. shiftMask, xK_r      ), renameWorkspace def)
--
-- and apply workspaceNamesPP to your pretty-printer:
--
-- > myPP = workspaceNamesPP xmobarPP
--
-- Check "XMonad.Hooks.StatusBar" for more information on how to incorprate
-- this into your status bar.
--
-- To expose workspace names to pagers and other EWMH clients, integrate this
-- with "XMonad.Hooks.EwmhDesktops":
--
-- > main = xmonad $ … . workspaceNamesEwmh . ewmh . … $ def{…}
--
-- We also provide a modification of "XMonad.Actions.SwapWorkspaces"\'s
-- functionality, which may be used this way:
--
-- >   , ((modMask .|. shiftMask, xK_Left  ), swapTo Prev)
-- >   , ((modMask .|. shiftMask, xK_Right ), swapTo Next)
--
-- > [((modm .|. controlMask, k), swapWithCurrent i)
-- >     | (i, k) <- zip workspaces [xK_1 ..]]
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".



-- | Workspace names container.
newtype WorkspaceNames = WorkspaceNames (M.Map WorkspaceId String)
    deriving (ReadPrec [WorkspaceNames]
ReadPrec WorkspaceNames
Int -> ReadS WorkspaceNames
ReadS [WorkspaceNames]
(Int -> ReadS WorkspaceNames)
-> ReadS [WorkspaceNames]
-> ReadPrec WorkspaceNames
-> ReadPrec [WorkspaceNames]
-> Read WorkspaceNames
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkspaceNames]
$creadListPrec :: ReadPrec [WorkspaceNames]
readPrec :: ReadPrec WorkspaceNames
$creadPrec :: ReadPrec WorkspaceNames
readList :: ReadS [WorkspaceNames]
$creadList :: ReadS [WorkspaceNames]
readsPrec :: Int -> ReadS WorkspaceNames
$creadsPrec :: Int -> ReadS WorkspaceNames
Read, Int -> WorkspaceNames -> ShowS
[WorkspaceNames] -> ShowS
WorkspaceNames -> WorkspaceId
(Int -> WorkspaceNames -> ShowS)
-> (WorkspaceNames -> WorkspaceId)
-> ([WorkspaceNames] -> ShowS)
-> Show WorkspaceNames
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceNames] -> ShowS
$cshowList :: [WorkspaceNames] -> ShowS
show :: WorkspaceNames -> WorkspaceId
$cshow :: WorkspaceNames -> WorkspaceId
showsPrec :: Int -> WorkspaceNames -> ShowS
$cshowsPrec :: Int -> WorkspaceNames -> ShowS
Show)

instance ExtensionClass WorkspaceNames where
    initialValue :: WorkspaceNames
initialValue = Map WorkspaceId WorkspaceId -> WorkspaceNames
WorkspaceNames Map WorkspaceId WorkspaceId
forall k a. Map k a
M.empty
    extensionType :: WorkspaceNames -> StateExtension
extensionType = WorkspaceNames -> StateExtension
forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension

-- | Returns a lookup function that maps workspace tags to workspace names.
getWorkspaceNames' :: X (WorkspaceId -> Maybe String)
getWorkspaceNames' :: X (WorkspaceId -> Maybe WorkspaceId)
getWorkspaceNames' = do
    WorkspaceNames Map WorkspaceId WorkspaceId
m <- X WorkspaceNames
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    (WorkspaceId -> Maybe WorkspaceId)
-> X (WorkspaceId -> Maybe WorkspaceId)
forall (m :: * -> *) a. Monad m => a -> m a
return (WorkspaceId -> Map WorkspaceId WorkspaceId -> Maybe WorkspaceId
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map WorkspaceId WorkspaceId
m)

-- | Returns a function for 'ppRename' that appends @sep@ and the workspace
-- name, if set.
getWorkspaceNames :: String -> X (String -> WindowSpace -> String)
getWorkspaceNames :: WorkspaceId -> X (WorkspaceId -> WindowSpace -> WorkspaceId)
getWorkspaceNames WorkspaceId
sep = (WorkspaceId -> Maybe WorkspaceId)
-> WorkspaceId -> WindowSpace -> WorkspaceId
forall {t} {l} {a}.
(t -> Maybe WorkspaceId)
-> WorkspaceId -> Workspace t l a -> WorkspaceId
ren ((WorkspaceId -> Maybe WorkspaceId)
 -> WorkspaceId -> WindowSpace -> WorkspaceId)
-> X (WorkspaceId -> Maybe WorkspaceId)
-> X (WorkspaceId -> WindowSpace -> WorkspaceId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X (WorkspaceId -> Maybe WorkspaceId)
getWorkspaceNames'
  where
    ren :: (t -> Maybe WorkspaceId)
-> WorkspaceId -> Workspace t l a -> WorkspaceId
ren t -> Maybe WorkspaceId
name WorkspaceId
s Workspace t l a
w = WorkspaceId
s WorkspaceId -> ShowS
forall a. [a] -> [a] -> [a]
++ WorkspaceId -> ShowS -> Maybe WorkspaceId -> WorkspaceId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WorkspaceId
"" (WorkspaceId
sep WorkspaceId -> ShowS
forall a. [a] -> [a] -> [a]
++) (t -> Maybe WorkspaceId
name (Workspace t l a -> t
forall i l a. Workspace i l a -> i
W.tag Workspace t l a
w))

-- | Gets the name of a workspace, if set, otherwise returns nothing.
getWorkspaceName :: WorkspaceId -> X (Maybe String)
getWorkspaceName :: WorkspaceId -> X (Maybe WorkspaceId)
getWorkspaceName WorkspaceId
w = ((WorkspaceId -> Maybe WorkspaceId)
-> WorkspaceId -> Maybe WorkspaceId
forall a b. (a -> b) -> a -> b
$ WorkspaceId
w) ((WorkspaceId -> Maybe WorkspaceId) -> Maybe WorkspaceId)
-> X (WorkspaceId -> Maybe WorkspaceId) -> X (Maybe WorkspaceId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X (WorkspaceId -> Maybe WorkspaceId)
getWorkspaceNames'

-- | Gets the name of the current workspace. See 'getWorkspaceName'
getCurrentWorkspaceName :: X (Maybe String)
getCurrentWorkspaceName :: X (Maybe WorkspaceId)
getCurrentWorkspaceName = WorkspaceId -> X (Maybe WorkspaceId)
getWorkspaceName (WorkspaceId -> X (Maybe WorkspaceId))
-> X WorkspaceId -> X (Maybe WorkspaceId)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (XState -> WorkspaceId) -> X WorkspaceId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceId)
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset)

-- | Sets the name of a workspace. Empty string makes the workspace unnamed
-- again.
setWorkspaceName :: WorkspaceId -> String -> X ()
setWorkspaceName :: WorkspaceId -> WorkspaceId -> X ()
setWorkspaceName WorkspaceId
w WorkspaceId
name = do
    WorkspaceNames Map WorkspaceId WorkspaceId
m <- X WorkspaceNames
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    WorkspaceNames -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (WorkspaceNames -> X ()) -> WorkspaceNames -> X ()
forall a b. (a -> b) -> a -> b
$ Map WorkspaceId WorkspaceId -> WorkspaceNames
WorkspaceNames (Map WorkspaceId WorkspaceId -> WorkspaceNames)
-> Map WorkspaceId WorkspaceId -> WorkspaceNames
forall a b. (a -> b) -> a -> b
$ if WorkspaceId -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null WorkspaceId
name then WorkspaceId
-> Map WorkspaceId WorkspaceId -> Map WorkspaceId WorkspaceId
forall k a. Ord k => k -> Map k a -> Map k a
M.delete WorkspaceId
w Map WorkspaceId WorkspaceId
m else WorkspaceId
-> WorkspaceId
-> Map WorkspaceId WorkspaceId
-> Map WorkspaceId WorkspaceId
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WorkspaceId
w WorkspaceId
name Map WorkspaceId WorkspaceId
m
    X ()
refresh

-- | Sets the name of the current workspace. See 'setWorkspaceName'.
setCurrentWorkspaceName :: String -> X ()
setCurrentWorkspaceName :: WorkspaceId -> X ()
setCurrentWorkspaceName WorkspaceId
name = do
    WorkspaceId
current <- (XState -> WorkspaceId) -> X WorkspaceId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceId)
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset)
    WorkspaceId -> WorkspaceId -> X ()
setWorkspaceName WorkspaceId
current WorkspaceId
name

-- | Prompt for a new name for the current workspace and set it.
renameWorkspace :: XPConfig -> X ()
renameWorkspace :: XPConfig -> X ()
renameWorkspace XPConfig
conf =
    Wor -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt Wor
pr XPConfig
conf (IO [WorkspaceId] -> ComplFunction
forall a b. a -> b -> a
const ([WorkspaceId] -> IO [WorkspaceId]
forall (m :: * -> *) a. Monad m => a -> m a
return [])) WorkspaceId -> X ()
setCurrentWorkspaceName
    where pr :: Wor
pr = WorkspaceId -> Wor
Wor WorkspaceId
"Workspace name: "

-- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names.
swapTo :: Direction1D -> X ()
swapTo :: Direction1D -> X ()
swapTo Direction1D
dir = Direction1D -> WSType -> X ()
swapTo' Direction1D
dir WSType
anyWS

-- | Swap with the previous or next workspace of the given type.
swapTo' :: Direction1D -> WSType -> X ()
swapTo' :: Direction1D -> WSType -> X ()
swapTo' Direction1D
dir WSType
which = X WorkspaceSort -> Direction1D -> WSType -> Int -> X WorkspaceId
findWorkspace X WorkspaceSort
getSortByIndex Direction1D
dir WSType
which Int
1 X WorkspaceId -> (WorkspaceId -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> X ()
swapWithCurrent

-- | See 'XMonad.Actions.SwapWorkspaces.swapWithCurrent'. This is almost the
-- same with names.
swapWithCurrent :: WorkspaceId -> X ()
swapWithCurrent :: WorkspaceId -> X ()
swapWithCurrent WorkspaceId
t = do
    WorkspaceId
current <- (XState -> WorkspaceId) -> X WorkspaceId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceId)
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset)
    WorkspaceId -> WorkspaceId -> X ()
swapNames WorkspaceId
t WorkspaceId
current
    (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
  -> StackSet
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> (StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId
-> WorkspaceId
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a s sd.
Eq i =>
i -> i -> StackSet i l a s sd -> StackSet i l a s sd
Swap.swapWorkspaces WorkspaceId
t WorkspaceId
current

-- | Swap names of the two workspaces.
swapNames :: WorkspaceId -> WorkspaceId -> X ()
swapNames :: WorkspaceId -> WorkspaceId -> X ()
swapNames WorkspaceId
w1 WorkspaceId
w2 = do
    WorkspaceNames Map WorkspaceId WorkspaceId
m <- X WorkspaceNames
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    let getname :: ShowS
getname WorkspaceId
w = WorkspaceId -> Maybe WorkspaceId -> WorkspaceId
forall a. a -> Maybe a -> a
fromMaybe WorkspaceId
"" (Maybe WorkspaceId -> WorkspaceId)
-> Maybe WorkspaceId -> WorkspaceId
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> Map WorkspaceId WorkspaceId -> Maybe WorkspaceId
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WorkspaceId
w Map WorkspaceId WorkspaceId
m
        set :: k -> t a -> Map k (t a) -> Map k (t a)
set k
w t a
name Map k (t a)
m' = if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
name then k -> Map k (t a) -> Map k (t a)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete k
w Map k (t a)
m' else k -> t a -> Map k (t a) -> Map k (t a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
w t a
name Map k (t a)
m'
    WorkspaceNames -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (WorkspaceNames -> X ()) -> WorkspaceNames -> X ()
forall a b. (a -> b) -> a -> b
$ Map WorkspaceId WorkspaceId -> WorkspaceNames
WorkspaceNames (Map WorkspaceId WorkspaceId -> WorkspaceNames)
-> Map WorkspaceId WorkspaceId -> WorkspaceNames
forall a b. (a -> b) -> a -> b
$ WorkspaceId
-> WorkspaceId
-> Map WorkspaceId WorkspaceId
-> Map WorkspaceId WorkspaceId
forall {t :: * -> *} {k} {a}.
(Foldable t, Ord k) =>
k -> t a -> Map k (t a) -> Map k (t a)
set WorkspaceId
w1 (ShowS
getname WorkspaceId
w2) (Map WorkspaceId WorkspaceId -> Map WorkspaceId WorkspaceId)
-> Map WorkspaceId WorkspaceId -> Map WorkspaceId WorkspaceId
forall a b. (a -> b) -> a -> b
$ WorkspaceId
-> WorkspaceId
-> Map WorkspaceId WorkspaceId
-> Map WorkspaceId WorkspaceId
forall {t :: * -> *} {k} {a}.
(Foldable t, Ord k) =>
k -> t a -> Map k (t a) -> Map k (t a)
set WorkspaceId
w2 (ShowS
getname WorkspaceId
w1) Map WorkspaceId WorkspaceId
m

-- | Same behavior than 'XMonad.Prompt.Workspace.workspacePrompt' excepted it acts on the workspace name provided by this module.
workspaceNamePrompt :: XPConfig -> (WorkspaceId -> X ()) -> X ()
workspaceNamePrompt :: XPConfig -> (WorkspaceId -> X ()) -> X ()
workspaceNamePrompt XPConfig
conf WorkspaceId -> X ()
job = do
    [WindowSpace]
myWorkspaces <- (XState -> [WindowSpace]) -> X [WindowSpace]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> [WindowSpace]) -> X [WindowSpace])
-> (XState -> [WindowSpace]) -> X [WindowSpace]
forall a b. (a -> b) -> a -> b
$ StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [WindowSpace]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> [WindowSpace])
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [WindowSpace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset
    [WorkspaceId]
myWorkspacesName <- WorkspaceId -> X (WorkspaceId -> WindowSpace -> WorkspaceId)
getWorkspaceNames WorkspaceId
":" X (WorkspaceId -> WindowSpace -> WorkspaceId)
-> ((WorkspaceId -> WindowSpace -> WorkspaceId) -> [WorkspaceId])
-> X [WorkspaceId]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \WorkspaceId -> WindowSpace -> WorkspaceId
n -> [WorkspaceId -> WindowSpace -> WorkspaceId
n (WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag WindowSpace
w) WindowSpace
w | WindowSpace
w <- [WindowSpace]
myWorkspaces]
    let pairs :: [(WorkspaceId, WorkspaceId)]
pairs = [WorkspaceId] -> [WorkspaceId] -> [(WorkspaceId, WorkspaceId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [WorkspaceId]
myWorkspacesName ((WindowSpace -> WorkspaceId) -> [WindowSpace] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag [WindowSpace]
myWorkspaces)
    Wor -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> Wor
Wor WorkspaceId
"Select workspace: ") XPConfig
conf
              ([WorkspaceId] -> ComplFunction
forall {m :: * -> *} {a}.
(Monad m, Eq a) =>
[[a]] -> [a] -> m [[a]]
contains [WorkspaceId]
myWorkspacesName)
              (WorkspaceId -> X ()
job (WorkspaceId -> X ()) -> ShowS -> WorkspaceId -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(WorkspaceId, WorkspaceId)] -> ShowS
forall {a}. Eq a => [(a, WorkspaceId)] -> a -> WorkspaceId
toWsId [(WorkspaceId, WorkspaceId)]
pairs)
  where toWsId :: [(a, WorkspaceId)] -> a -> WorkspaceId
toWsId [(a, WorkspaceId)]
pairs a
name = WorkspaceId -> Maybe WorkspaceId -> WorkspaceId
forall a. a -> Maybe a -> a
fromMaybe WorkspaceId
"" (a -> [(a, WorkspaceId)] -> Maybe WorkspaceId
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
name [(a, WorkspaceId)]
pairs)
        contains :: [[a]] -> [a] -> m [[a]]
contains [[a]]
completions [a]
input =
          [[a]] -> m [[a]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[a]] -> m [[a]]) -> [[a]] -> m [[a]]
forall a b. (a -> b) -> a -> b
$ ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [a]
input) [[a]]
completions

-- | Modify 'XMonad.Hooks.StatusBar.PP.PP'\'s pretty-printing format to show
-- workspace names as well.
workspaceNamesPP :: PP -> X PP
workspaceNamesPP :: PP -> X PP
workspaceNamesPP PP
pp = WorkspaceId -> X (WorkspaceId -> WindowSpace -> WorkspaceId)
getWorkspaceNames WorkspaceId
":" X (WorkspaceId -> WindowSpace -> WorkspaceId)
-> ((WorkspaceId -> WindowSpace -> WorkspaceId) -> PP) -> X PP
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \WorkspaceId -> WindowSpace -> WorkspaceId
ren -> PP
pp{ ppRename :: WorkspaceId -> WindowSpace -> WorkspaceId
ppRename = PP -> WorkspaceId -> WindowSpace -> WorkspaceId
ppRename PP
pp (WorkspaceId -> WindowSpace -> WorkspaceId)
-> (WorkspaceId -> WindowSpace -> WorkspaceId)
-> WorkspaceId
-> WindowSpace
-> WorkspaceId
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> WorkspaceId -> WindowSpace -> WorkspaceId
ren }

-- | Tell "XMonad.Hooks.EwmhDesktops" to append workspace names to desktop
-- names.
workspaceNamesEwmh :: XConfig l -> XConfig l
workspaceNamesEwmh :: forall (l :: * -> *). XConfig l -> XConfig l
workspaceNamesEwmh = X (WorkspaceId -> WindowSpace -> WorkspaceId)
-> XConfig l -> XConfig l
forall (l :: * -> *).
X (WorkspaceId -> WindowSpace -> WorkspaceId)
-> XConfig l -> XConfig l
addEwmhWorkspaceRename (X (WorkspaceId -> WindowSpace -> WorkspaceId)
 -> XConfig l -> XConfig l)
-> X (WorkspaceId -> WindowSpace -> WorkspaceId)
-> XConfig l
-> XConfig l
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> X (WorkspaceId -> WindowSpace -> WorkspaceId)
getWorkspaceNames WorkspaceId
":"