X.A.WorkspaceNames, X.L.IndependentScreens, X.U.ClickableWorkspaces: Use ppRename

Also, drop now useless integrations from X.U.ClickableWorkspaces:
workspaceNamesPP, marshallPP and clickablePP can now be composed
directly using >>= and it just works.

Related: https://github.com/xmonad/xmonad-contrib/pull/390
Related: https://github.com/xmonad/xmonad-contrib/pull/462

CHANGES.md

@@ -45,6 +45,11 @@
     - `execScriptHook` now has an `X` constraint (was: `MonadIO`), due to changes
       in how the xmonad core handles XDG directories.
 
+  * `XMonad.Actions.WorkspaceNames`
+
+    - The type of `getWorkspaceNames` was changed to fit into the new `ppRename`
+      field of `PP`.
+
 ### New Modules
 
   * `XMonad.Util.Hacks`

XMonad/Actions/WorkspaceNames.hs

@@ -54,6 +54,7 @@ import XMonad.Prompt (mkXPrompt, XPConfig)
 import XMonad.Prompt.Workspace (Wor(Wor))
 import XMonad.Util.WorkspaceCompare (getSortByIndex)
 
+import Control.Monad ((>=>))
 import Data.Functor ((<&>))
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
@@ -101,12 +102,12 @@ getWorkspaceNames' = do
     WorkspaceNames m <- XS.get
     return (`M.lookup` m)
 
--- | Returns a function that maps workspace tag @\"t\"@ to @\"t:name\"@ for
+-- | Returns a function for 'ppRename' that appends @sep@ and the workspace
--- workspaces with a name, and to @\"t\"@ otherwise.
+-- name, if set.
-getWorkspaceNames :: X (WorkspaceId -> String)
+getWorkspaceNames :: String -> X (String -> WindowSpace -> String)
-getWorkspaceNames = do
+getWorkspaceNames sep = ren <$> getWorkspaceNames'
-    lookup' <- getWorkspaceNames'
+  where
-    return $ \wks -> wks ++ maybe "" (':' :) (lookup' wks)
+    ren name s w = s ++ maybe "" (sep ++) (name (W.tag w))
 
 -- | Gets the name of a workspace, if set, otherwise returns nothing.
 getWorkspaceName :: WorkspaceId -> X (Maybe String)
@@ -139,17 +140,7 @@ renameWorkspace conf =
 -- | Modify "XMonad.Hooks.DynamicLog"\'s pretty-printing format to show
 -- workspace names as well.
 workspaceNamesPP :: PP -> X PP
-workspaceNamesPP pp = do
+workspaceNamesPP pp = getWorkspaceNames ":" <&> \ren -> pp{ ppRename = ppRename pp >=> ren }
-    names <- getWorkspaceNames
-    return $
-        pp {
-            ppCurrent         = ppCurrent         pp . names,
-            ppVisible         = ppVisible         pp . names,
-            ppHidden          = ppHidden          pp . names,
-            ppHiddenNoWindows = ppHiddenNoWindows pp . names,
-            ppVisibleNoWindows= ppVisibleNoWindows pp <&> (. names),
-            ppUrgent          = ppUrgent          pp . names
-        }
 
 -- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names.
 swapTo :: Direction1D -> X ()
@@ -176,17 +167,15 @@ swapNames w1 w2 = do
     XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) $ m
 
 -- | Same behavior than 'XMonad.Prompt.Workspace.workspacePrompt' excepted it acts on the workspace name provided by this module.
-workspaceNamePrompt :: XPConfig -> (String -> X ()) -> X ()
+workspaceNamePrompt :: XPConfig -> (WorkspaceId -> X ()) -> X ()
 workspaceNamePrompt conf job = do
-    myWorkspaces <- gets $ map W.tag . W.workspaces . windowset
+    myWorkspaces <- gets $ W.workspaces . windowset
-    myWorkspacesName <- getWorkspaceNames >>= \f -> return $ map f myWorkspaces
+    myWorkspacesName <- getWorkspaceNames ":" <&> \n -> [n (W.tag w) w | w <- myWorkspaces]
-    let pairs = zip myWorkspacesName myWorkspaces
+    let pairs = zip myWorkspacesName (map W.tag myWorkspaces)
     mkXPrompt (Wor "Select workspace: ") conf
               (contains myWorkspacesName)
               (job . toWsId pairs)
-  where toWsId pairs name = case lookup name pairs of
+  where toWsId pairs name = fromMaybe "" (lookup name pairs)
-                                Nothing -> ""
-                                Just i -> i
         contains completions input =
           return $ filter (Data.List.isInfixOf input) completions
 
@@ -197,6 +186,5 @@ workspaceNamePrompt conf job = do
 -- Usage:
 -- > logHook = (workspaceNamesListTransform >>= ewmhDesktopsLogHookCustom) <+> …
 workspaceNamesListTransform :: X ([WindowSpace] -> [WindowSpace])
-workspaceNamesListTransform = do
+workspaceNamesListTransform =
-    names <- getWorkspaceNames
+    getWorkspaceNames ":" <&> \names -> map $ \ws -> ws{ W.tag = names (W.tag ws) ws }
-    return $ map $ \ws -> ws{ W.tag = names $ W.tag ws }

XMonad/Layout/IndependentScreens.hs

@@ -31,7 +31,6 @@ module XMonad.Layout.IndependentScreens (
 -- for the screen stuff
 import Control.Applicative(liftA2)
 import Control.Arrow hiding ((|||))
-import Data.Functor ((<&>))
 import Data.List (nub, genericLength)
 import Graphics.X11.Xinerama
 import XMonad
@@ -135,15 +134,8 @@ countScreens = fmap genericLength . liftIO $ openDisplay "" >>= liftA2 (<*) getS
 -- > logHook = let log screen handle = dynamicLogWithPP . marshallPP screen . pp $ handle
 -- >           in log 0 hLeft >> log 1 hRight
 marshallPP :: ScreenId -> PP -> PP
-marshallPP s pp = pp {
+marshallPP s pp = pp { ppRename = ppRename pp . unmarshallW
-    ppCurrent           = ppCurrent         pp . unmarshallW,
+                     , ppSort = fmap (marshallSort s) (ppSort pp) }
-    ppVisible           = ppVisible         pp . unmarshallW,
-    ppHidden            = ppHidden          pp . unmarshallW,
-    ppHiddenNoWindows   = ppHiddenNoWindows pp . unmarshallW,
-    ppVisibleNoWindows  = ppVisibleNoWindows pp <&> (. unmarshallW),
-    ppUrgent            = ppUrgent          pp . unmarshallW,
-    ppSort              = fmap (marshallSort s) (ppSort pp)
-    }
 
 -- | Take a pretty-printer and turn it into one that only runs when the current
 -- workspace is one associated with the given screen. The way this works is a

XMonad/Util/ClickableWorkspaces.hs

@@ -18,22 +18,16 @@ module XMonad.Util.ClickableWorkspaces (
   -- * Usage
   -- $usage
   clickablePP,
-  clickableRenamedPP,
   clickableWrap,
-
-  -- * Integrations
-  clickableWorkspaceNamesPP,
-  clickableMarshallPP,
-  clickableMarshallWorkspaceNamesPP
   ) where
 
+import Control.Monad ((>=>))
 import Data.Functor ((<&>))
 
 import XMonad
-import XMonad.Actions.WorkspaceNames
 import XMonad.Hooks.DynamicLog (xmobarAction, xmobarRaw, PP(..))
-import XMonad.Layout.IndependentScreens
 import XMonad.Util.WorkspaceCompare (getWsIndex)
+import qualified XMonad.StackSet as W
 
 -- $usage
 -- However you have set up your PP, apply @clickablePP@ to it, and bind the result
@@ -52,54 +46,14 @@ clickableWrap :: Int -> String -> String
 clickableWrap i ws = xmobarAction ("xdotool set_desktop " ++ show i) "1" $ xmobarRaw ws
 
 -- | Return a function that wraps workspace names in an xmobar action that
--- switches to that workspace. That workspace name must be exactly as
+-- switches to that workspace.
--- configured in 'XMonad.Core.workspaces', so this takes an additional
--- parameter that allows renaming/marshalling of the name for display, which
--- is applied after the workspace's index is looked up.
 --
--- This additionally assumes that 'XMonad.Hooks.EwmhDesktops.ewmhDesktopsEventHook'
+-- This assumes that 'XMonad.Hooks.EwmhDesktops.ewmhDesktopsEventHook'
 -- isn't configured to change the workspace order. We might need to add an
 -- additional parameter if anyone needs that.
-getClickable :: (WorkspaceId -> String) -> X (WorkspaceId -> String)
+getClickable :: X (String -> WindowSpace -> String)
-getClickable ren = do
+getClickable = getWsIndex <&> \idx s w -> maybe id clickableWrap (idx (W.tag w)) s
-  wsIndex <- getWsIndex
-  return $ \ws -> case wsIndex ws of
-                    Just idx -> clickableWrap idx (ren ws)
-                    Nothing -> ws
 
--- | Apply clickable wrapping to all workspace fields in given PP.
+-- | Apply clickable wrapping to the given PP.
 clickablePP :: PP -> X PP
-clickablePP = clickableRenamedPP id
+clickablePP pp = getClickable <&> \ren -> pp{ ppRename = ppRename pp >=> ren }
-
--- | Alternative to 'clickablePP' that allows changing the visible workspace
--- name. Useful for integration with modules that change workspace names, such
--- as "XMonad.Layout.IndependentScreens" and "XMonad.Actions.WorkspaceNames".
-clickableRenamedPP :: (WorkspaceId -> String) -> PP -> X PP
-clickableRenamedPP ren pp = do
-  clickable <- getClickable ren
-  return $
-    pp { ppCurrent         = ppCurrent pp . clickable
-       , ppVisible         = ppVisible pp . clickable
-       , ppHidden          = ppHidden pp . clickable
-       , ppHiddenNoWindows = ppHiddenNoWindows pp . clickable
-       , ppVisibleNoWindows= ppVisibleNoWindows pp <&> (. clickable)
-       , ppUrgent          = ppUrgent pp . clickable
-       }
-
--- | Integration with "XMonad.Actions.WorkspaceNames".
-clickableWorkspaceNamesPP :: PP -> X PP
-clickableWorkspaceNamesPP pp = do
-    rename <- getWorkspaceNames
-    clickableRenamedPP rename pp
-
--- | Integration with "XMonad.Layout.IndependentScreens".
-clickableMarshallPP :: ScreenId -> PP -> X PP
-clickableMarshallPP s pp =
-    clickableRenamedPP unmarshallW pp{ ppSort = marshallSort s <$> ppSort pp }
-
--- | Integration with both "XMonad.Actions.WorkspaceNames" and
--- "XMonad.Layout.IndependentScreens".
-clickableMarshallWorkspaceNamesPP :: ScreenId -> PP -> X PP
-clickableMarshallWorkspaceNamesPP s pp = do
-    rename <- getWorkspaceNames
-    clickableRenamedPP (unmarshallW . rename) pp{ ppSort = marshallSort s <$> ppSort pp }