ENH generalize showkyes

bin/xmonad.hs

@@ -129,7 +129,7 @@ run = do
           tt <- evalAlways $ fsTabbedTheme fs
           let conf =
                 ewmh $
-                  addKeymap dws sk kbs $
+                  addKeymap dws (liftIO . runIO . sk) kbs $
                     docks $
                       def
                         { terminal = myTerm
@@ -179,7 +179,7 @@ data FeatureSet = FeatureSet
   , fsACPIHandler :: Always (String -> X ())
   , fsTabbedTheme :: Always Theme
   , fsDynWorkspaces :: [Sometimes DynWorkspace]
-  , fsShowKeys :: Always ([((KeyMask, KeySym), NamedAction)] -> X ())
+  , fsShowKeys :: Always ([((KeyMask, KeySym), NamedAction)] -> XIO ())
   }
 
 tabbedFeature :: Always Theme

lib/XMonad/Internal/Command/DMenu.hs

@@ -19,16 +19,18 @@ module XMonad.Internal.Command.DMenu
 where
 
 import DBus
+import qualified Data.ByteString.Char8 as BC
 import Data.Internal.DBus
 import Data.Internal.XIO
 import Graphics.X11.Types
-import RIO hiding (hClose)
+import RIO
+import qualified RIO.ByteString as B
 import RIO.Directory
   ( XdgDirectory (..)
   , getXdgDirectory
   )
 import qualified RIO.Text as T
-import System.IO
+-- import System.IO
 import XMonad.Core hiding (spawn)
 import XMonad.Internal.Command.Desktop
 import XMonad.Internal.DBus.Common
@@ -207,7 +209,9 @@ runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act
 --------------------------------------------------------------------------------
 -- Shortcut menu
 
-runShowKeys :: Always ([((KeyMask, KeySym), NamedAction)] -> X ())
+runShowKeys
+  :: MonadUnliftIO m
+  => Always ([((KeyMask, KeySym), NamedAction)] -> m ())
 runShowKeys =
   Always "keyboard menu" $
     Option showKeysDMenu $
@@ -220,18 +224,20 @@ runShowKeys =
         spawnNotify $
           defNoteError {body = Just $ Text "could not display keymap"}
 
-showKeysDMenu :: SubfeatureRoot ([((KeyMask, KeySym), NamedAction)] -> X ())
+showKeysDMenu
+  :: MonadUnliftIO m
+  => SubfeatureRoot ([((KeyMask, KeySym), NamedAction)] -> m ())
 showKeysDMenu =
   Subfeature
     { sfName = "keyboard shortcut menu"
     , sfData = IORoot_ showKeys $ Only_ dmenuDep
     }
 
-showKeys :: [((KeyMask, KeySym), NamedAction)] -> X ()
+showKeys :: MonadUnliftIO m => [((KeyMask, KeySym), NamedAction)] -> m ()
 showKeys kbs = do
   h <- spawnPipe cmd
-  io $ hPutStr h $ unlines $ showKm kbs
-  io $ hClose h
+  B.hPut h $ BC.unlines $ BC.pack <$> showKm kbs
+  hClose h
   where
     cmd =
       fmtCmd myDmenuCmd $