From fc7ea97582ddf83266d2a1c0005fc4b786f8c03b Mon Sep 17 00:00:00 2001
From: Tomas Janousek <tomi@nomi.cz>
Date: Tue, 16 Mar 2021 16:18:44 +0000
Subject: [PATCH 1/4] X.H.DynamicLog: Reindent pprWindowSet

---
 XMonad/Hooks/DynamicLog.hs | 20 +++++++++++---------
 1 file changed, 11 insertions(+), 9 deletions(-)

diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs
index 789c66c7..f770c4a8 100644
--- a/XMonad/Hooks/DynamicLog.hs
+++ b/XMonad/Hooks/DynamicLog.hs
@@ -583,16 +583,18 @@ dynamicLogString pp = do
 pprWindowSet :: WorkspaceSort -> [Window] -> PP -> WindowSet -> String
 pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $
             map S.workspace (S.current s : S.visible s) ++ S.hidden s
-   where this     = S.currentTag s
-         visibles = map (S.tag . S.workspace) (S.visible s)
+  where
+    this     = S.currentTag s
+    visibles = map (S.tag . S.workspace) (S.visible s)
 
-         fmt w = printer pp (S.tag w)
-          where printer | any (\x -> (== Just (S.tag w)) (S.findTag x s)) urgents  = ppUrgent
-                        | S.tag w == this                                               = ppCurrent
-                        | S.tag w `elem` visibles && isJust (S.stack w)                 = ppVisible
-                        | S.tag w `elem` visibles                                       = liftA2 fromMaybe ppVisible ppVisibleNoWindows
-                        | isJust (S.stack w)                                            = ppHidden
-                        | otherwise                                                     = ppHiddenNoWindows
+    fmt w = printer pp (S.tag w)
+      where
+        printer | any (\x -> (== Just (S.tag w)) (S.findTag x s)) urgents = ppUrgent
+                | S.tag w == this                                         = ppCurrent
+                | S.tag w `elem` visibles && isJust (S.stack w)           = ppVisible
+                | S.tag w `elem` visibles                                 = liftA2 fromMaybe ppVisible ppVisibleNoWindows
+                | isJust (S.stack w)                                      = ppHidden
+                | otherwise                                               = ppHiddenNoWindows
 
 -- |
 -- Workspace logger with a format designed for Xinerama:

From 91010f6eb916aedeb8f9f8b5d0f456a688c5f094 Mon Sep 17 00:00:00 2001
From: Tomas Janousek <tomi@nomi.cz>
Date: Tue, 16 Mar 2021 17:21:22 +0000
Subject: [PATCH 2/4] X.H.DynamicLog: Add ppRename (composable tag
 augmentation)

This one is a Reader in WindowSpace, and therefore significantly
simplifies the composition of WorkspaceNames, IndependentScreens,
ClickableWorkspaces and possibly other similar modules.

Related: https://github.com/xmonad/xmonad-contrib/pull/390
Related: https://github.com/xmonad/xmonad-contrib/pull/462
---
 CHANGES.md                 | 4 ++++
 XMonad/Hooks/DynamicLog.hs | 6 +++++-
 2 files changed, 9 insertions(+), 1 deletion(-)

diff --git a/CHANGES.md b/CHANGES.md
index e7269279..7668ef88 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -229,6 +229,10 @@
       to provide the configs for the already existing functionality. This provides
       multiple status bars support.
 
+    - Added `ppRename` to `PP`, which makes it possible for extensions like
+      `workspaceNamesPP`, `marshallPP` and/or `clickablePP` to compose
+      intuitively.
+
   * `XMonad.Layout.BoringWindows`
 
     - Added boring-aware `swapUp`, `swapDown`, `siftUp`, and `siftDown` functions.
diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs
index f770c4a8..35321670 100644
--- a/XMonad/Hooks/DynamicLog.hs
+++ b/XMonad/Hooks/DynamicLog.hs
@@ -587,7 +587,7 @@ pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $
     this     = S.currentTag s
     visibles = map (S.tag . S.workspace) (S.visible s)
 
-    fmt w = printer pp (S.tag w)
+    fmt w = printer pp (ppRename pp (S.tag w) w)
       where
         printer | any (\x -> (== Just (S.tag w)) (S.findTag x s)) urgents = ppUrgent
                 | S.tag w == this                                         = ppCurrent
@@ -938,6 +938,9 @@ data PP = PP { ppCurrent :: WorkspaceId -> String
                -- ^ how to print tags of empty visible workspaces
              , ppUrgent :: WorkspaceId -> String
                -- ^ format to be applied to tags of urgent workspaces.
+             , ppRename :: String -> WindowSpace -> String
+               -- ^ rename/augment the workspace tag
+               --   (note that @WindowSpace -> …@ acts as a Reader monad)
              , ppSep :: String
                -- ^ separator to use between different log sections
                -- (window name, layout, workspaces)
@@ -989,6 +992,7 @@ instance Default PP where
                , ppHiddenNoWindows = const ""
                , ppVisibleNoWindows= Nothing
                , ppUrgent          = id
+               , ppRename          = pure
                , ppSep             = " : "
                , ppWsSep           = " "
                , ppTitle           = shorten 80

From e91b0fef8202547ebb48c94eb8257fc52a7a7bc6 Mon Sep 17 00:00:00 2001
From: Tomas Janousek <tomi@nomi.cz>
Date: Tue, 16 Mar 2021 17:23:26 +0000
Subject: [PATCH 3/4] 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                          |  5 +++
 XMonad/Actions/WorkspaceNames.hs    | 42 +++++++------------
 XMonad/Layout/IndependentScreens.hs | 12 +-----
 XMonad/Util/ClickableWorkspaces.hs  | 62 ++++-------------------------
 4 files changed, 30 insertions(+), 91 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index 7668ef88..84f172ce 100644
--- a/CHANGES.md
+++ b/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`
diff --git a/XMonad/Actions/WorkspaceNames.hs b/XMonad/Actions/WorkspaceNames.hs
index 4464c383..49d04759 100644
--- a/XMonad/Actions/WorkspaceNames.hs
+++ b/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
--- workspaces with a name, and to @\"t\"@ otherwise.
-getWorkspaceNames :: X (WorkspaceId -> String)
-getWorkspaceNames = do
-    lookup' <- getWorkspaceNames'
-    return $ \wks -> wks ++ maybe "" (':' :) (lookup' wks)
+-- | Returns a function for 'ppRename' that appends @sep@ and the workspace
+-- name, if set.
+getWorkspaceNames :: String -> X (String -> WindowSpace -> String)
+getWorkspaceNames sep = ren <$> getWorkspaceNames'
+  where
+    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
-    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
-        }
+workspaceNamesPP pp = getWorkspaceNames ":" <&> \ren -> pp{ ppRename = ppRename pp >=> ren }
 
 -- | 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
-    myWorkspacesName <- getWorkspaceNames >>= \f -> return $ map f myWorkspaces
-    let pairs = zip myWorkspacesName myWorkspaces
+    myWorkspaces <- gets $ W.workspaces . windowset
+    myWorkspacesName <- getWorkspaceNames ":" <&> \n -> [n (W.tag w) w | w <- 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
-                                Nothing -> ""
-                                Just i -> i
+  where toWsId pairs name = fromMaybe "" (lookup name pairs)
         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
-    names <- getWorkspaceNames
-    return $ map $ \ws -> ws{ W.tag = names $ W.tag ws }
+workspaceNamesListTransform =
+    getWorkspaceNames ":" <&> \names -> map $ \ws -> ws{ W.tag = names (W.tag ws) ws }
diff --git a/XMonad/Layout/IndependentScreens.hs b/XMonad/Layout/IndependentScreens.hs
index f729c577..7117e1eb 100644
--- a/XMonad/Layout/IndependentScreens.hs
+++ b/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 {
-    ppCurrent           = ppCurrent         pp . unmarshallW,
-    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)
-    }
+marshallPP s pp = pp { ppRename = ppRename 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
diff --git a/XMonad/Util/ClickableWorkspaces.hs b/XMonad/Util/ClickableWorkspaces.hs
index 0ef4c44e..9e8c1dcf 100644
--- a/XMonad/Util/ClickableWorkspaces.hs
+++ b/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
--- 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.
+-- switches to that workspace.
 --
--- 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 ren = do
-  wsIndex <- getWsIndex
-  return $ \ws -> case wsIndex ws of
-                    Just idx -> clickableWrap idx (ren ws)
-                    Nothing -> ws
+getClickable :: X (String -> WindowSpace -> String)
+getClickable = getWsIndex <&> \idx s w -> maybe id clickableWrap (idx (W.tag w)) s
 
--- | Apply clickable wrapping to all workspace fields in given PP.
+-- | Apply clickable wrapping to the given PP.
 clickablePP :: PP -> X PP
-clickablePP = clickableRenamedPP id
-
--- | 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 }
+clickablePP pp = getClickable <&> \ren -> pp{ ppRename = ppRename pp >=> ren }

From b0f5c69bafb842d3fc6ae7b930ee044b0bac0e7a Mon Sep 17 00:00:00 2001
From: Tomas Janousek <tomi@nomi.cz>
Date: Tue, 16 Mar 2021 22:25:46 +0000
Subject: [PATCH 4/4] X.U.ClickableWorkspaces: Drop escaping from clickableWrap

This breaks putting <fn> tags and icons into workspace names, which some
people might like. Those few who generate workspace names dynamically
from window titles may (and should) escape it themselves.
---
 XMonad/Util/ClickableWorkspaces.hs | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/XMonad/Util/ClickableWorkspaces.hs b/XMonad/Util/ClickableWorkspaces.hs
index 9e8c1dcf..18916e18 100644
--- a/XMonad/Util/ClickableWorkspaces.hs
+++ b/XMonad/Util/ClickableWorkspaces.hs
@@ -25,7 +25,7 @@ import Control.Monad ((>=>))
 import Data.Functor ((<&>))
 
 import XMonad
-import XMonad.Hooks.DynamicLog (xmobarAction, xmobarRaw, PP(..))
+import XMonad.Hooks.DynamicLog (xmobarAction, PP(..))
 import XMonad.Util.WorkspaceCompare (getWsIndex)
 import qualified XMonad.StackSet as W
 
@@ -39,11 +39,16 @@ import qualified XMonad.StackSet as W
 --   * @xdotool@ on system (in path)
 --   * "XMonad.Hooks.EwmhDesktops" for @xdotool@ support (see Hackage docs for setup)
 --   * use of UnsafeStdinReader/UnsafeXMonadLog in xmobarrc (rather than StdinReader/XMonadLog)
+--
+-- Note that UnsafeStdinReader is potentially dangerous if your workspace
+-- names are dynamically generated from untrusted input (like window titles).
+-- You may need to add @xmobarRaw@ to 'ppRename' before applying
+-- 'clickablePP' in such case.
 
 -- | Wrap string with an xmobar action that uses @xdotool@ to switch to
 -- workspace @i@.
 clickableWrap :: Int -> String -> String
-clickableWrap i ws = xmobarAction ("xdotool set_desktop " ++ show i) "1" $ xmobarRaw ws
+clickableWrap i ws = xmobarAction ("xdotool set_desktop " ++ show i) "1" ws
 
 -- | Return a function that wraps workspace names in an xmobar action that
 -- switches to that workspace.