X.Prelude: Add keymaskToString, keyToString

This technically introduces a regression with regards to the way that
modifier masks are printed in X.U.NamedActions and X.H.DebugEvents.
However, since this way of printing masks is move in line with
X.U.EZConfig, I personally don't think that this is noteworthy.

CHANGES.md

@@ -116,6 +116,11 @@
       resetting borders back in layouts where you want borders after calling
       `voidBorders`.
 
+  * `XMonad.Prelude`
+
+    - Added `keymaskToString` and `keyToString` to show a key mask and a
+      key in the style of `XMonad.Util.EZConfig`.
+
 ## 0.17.0 (October 27, 2021)
 
 ### Breaking Changes

XMonad/Hooks/DebugEvents.hs

@@ -111,7 +111,7 @@ debugEventsHook' ButtonEvent           {ev_window = w
   windowEvent "Button" w
   nl <- gets numberlockMask
   let msk | s == 0    = ""
-          | otherwise = "modifiers " ++ vmask nl s
+          | otherwise = "modifiers " ++ keymaskToString nl s
   say "  button" $ show b ++ msk
 
 debugEventsHook' DestroyWindowEvent    {ev_window = w
@@ -218,28 +218,6 @@ clientMessages =  [("_NET_ACTIVE_WINDOW",("_NET_ACTIVE_WINDOW",32,1))
                   ,("WM_SAVE_YOURSELF"  ,("STRING"            , 8,0))
                   ]
 
--- | Convert a modifier mask into a useful string
-vmask                 :: KeyMask -> KeyMask -> String
-vmask numLockMask msk =  unwords $
-                         reverse $
-                         fst     $
-                         foldr vmask' ([],msk) masks
-    where
-      masks = map (\m -> (m,show m)) [0..toEnum (finiteBitSize msk - 1)] ++
-              [(numLockMask,"num"  )
-              ,(   lockMask,"lock" )
-              ,(controlMask,"ctrl" )
-              ,(  shiftMask,"shift")
-              ,(   mod5Mask,"mod5" )
-              ,(   mod4Mask,"mod4" )
-              ,(   mod3Mask,"mod3" )
-              ,(   mod2Mask,"mod2" )
-              ,(   mod1Mask,"mod1" )
-              ]
-      vmask'   _   a@( _,0)                = a
-      vmask' (m,s)   (ss,v) | v .&. m == m = (s : ss,v .&. complement m)
-      vmask'   _        r                  = r
-
 -- formatting properties.  ick. --
 
 -- @@@ Document the parser.  Someday.

XMonad/Prelude.hs

@@ -22,6 +22,8 @@ module XMonad.Prelude (
     NonEmpty((:|)),
     notEmpty,
     safeGetWindowAttributes,
+    keyToString,
+    keymaskToString,
 ) where
 
 import Foreign (alloca, peek)
@@ -39,7 +41,9 @@ import Data.Maybe          as Exports
 import Data.Monoid         as Exports
 import Data.Traversable    as Exports
 
-import Data.List.NonEmpty (NonEmpty((:|)))
+import Data.Bifunctor (bimap)
+import Data.Bits
+import Data.List.NonEmpty (NonEmpty ((:|)))
 import GHC.Stack
 
 -- | Short for 'fromIntegral'.
@@ -80,3 +84,35 @@ safeGetWindowAttributes w = withDisplay $ \dpy -> io . alloca $ \p ->
   xGetWindowAttributes dpy w p >>= \case
     0 -> pure Nothing
     _ -> Just <$> peek p
+
+-- | Convert a modifier mask into a useful string.
+keymaskToString :: KeyMask -- ^ Num lock mask
+                -> KeyMask -- ^ Modifier mask
+                -> String
+keymaskToString numLockMask msk =
+  unwords . reverse . fst . foldr go ([], msk) $ masks
+ where
+  masks :: [(KeyMask, String)]
+  masks = map (\m -> (m, show m))
+              [0 .. toEnum (finiteBitSize msk - 1)]
+       ++ [ (numLockMask, "num-" )
+          , (lockMask,    "lock-")
+          , (controlMask, "C-"   )
+          , (shiftMask,   "S-"   )
+          , (mod5Mask,    "M5-"  )
+          , (mod4Mask,    "M4-"  )
+          , (mod3Mask,    "M3-"  )
+          , (mod2Mask,    "M2-"  )
+          , (mod1Mask,    "M1-"  )
+          ]
+
+  go :: (KeyMask, String) -> ([String], KeyMask) -> ([String], KeyMask)
+  go (m, s) a@(ss, v)
+    | v == 0       = a
+    | v .&. m == m = (s : ss, v .&. complement m)
+    | otherwise    = a
+
+-- | Convert a full key combination; i.e., a 'KeyMask' and 'KeySym'
+-- pair, into a string.
+keyToString :: (KeyMask, KeySym) -> [Char]
+keyToString = uncurry (++) . bimap (keymaskToString 0) keysymToString

XMonad/Util/NamedActions.hs

@@ -47,10 +47,9 @@ module XMonad.Util.NamedActions (
 
 
 import XMonad.Actions.Submap(submap)
-import XMonad.Prelude (groupBy)
+import XMonad.Prelude (groupBy, keyToString)
 import XMonad
-import Control.Arrow(Arrow((&&&), second, (***)))
-import Data.Bits(Bits((.&.), complement))
+import Control.Arrow(Arrow((&&&), second))
 import System.Exit(exitSuccess)
 
 import qualified Data.Map as M
@@ -166,22 +165,6 @@ submapName = NamedAction . (submap . M.map getAction . M.fromList &&& showKm)
      [(d, b)] -> [(d, b1)] -> [(d, NamedAction)]
 a ^++^ b = map (second NamedAction) a ++ map (second NamedAction) b
 
--- | Or allow another lookup table?
-modToString :: KeyMask -> String
-modToString mask = concatMap (++"-") $ filter (not . null)
-                $ map (uncurry pick)
-                [(mod1Mask, "M1")
-                ,(mod2Mask, "M2")
-                ,(mod3Mask, "M3")
-                ,(mod4Mask, "M4")
-                ,(mod5Mask, "M5")
-                ,(controlMask, "C")
-                ,(shiftMask,"Shift")]
-    where pick m str = if m .&. complement mask == 0 then str else ""
-
-keyToString :: (KeyMask, KeySym) -> [Char]
-keyToString = uncurry (++) . (modToString *** keysymToString)
-
 showKmSimple :: [((KeyMask, KeySym), NamedAction)] -> [[Char]]
 showKmSimple = concatMap (\(k,e) -> if snd k == 0 then "":showName e else map ((keyToString k ++) . smartSpace) $ showName e)