Search code examples
haskellxmonadxmonad-contrib

XMonad: How to make an X () action run only once on key down?

I would like to set up my XMonad such that I have a keybinding that switches to a specific layout when a key is being pressed down and held, and then switches back to the other specific layout when the same key is released.

To switch to the first layout on key down, I have my keybindings in XMonad defined like this:

myKeyDownBindings :: XConfig l -> M.Map ( KeyMask, KeySym ) ( X () )
myKeyDownBindings conf@(XConfig {XMonad.modMask = myModMask}) = mkKeymap conf $
[
, ("M-<Space>", sendMessage $ JumpToLayout "mySpecialLayout")
-- ...
]

To switch back to the other layout on key release, I have another key binding defined like this:

myKeyUpBindings :: XConfig l -> M.Map ( KeyMask, KeySym ) ( X () )
myKeyUpBindings conf@(XConfig {XMonad.modMask = myModMask}) = mkKeymap conf $
    [
       ("M-<Space>", sendMessage $ JumpToLayout "myRegularLayout")
    ]

...and I made an event hook module very closely based on this answer that takes myKeyUpBindings as an argument:

module Hooks.KeyUp  (keyUpEventHook) where

import              XMonad
import              Data.Monoid
import qualified    Data.Map as M  (Map, lookup)

keyUpEventHook :: M.Map ( KeyMask, KeySym ) ( X () ) -> Event -> X All
keyUpEventHook ks ev =
    handle ev ks
 >> return (All True)

handle :: Event -> M.Map ( KeyMask, KeySym ) ( X () ) -> X ()
handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code}) ks
    | t == keyRelease =
    withDisplay $ \dpy -> do
        s  <- io $ keycodeToKeysym dpy code 0
        mClean <- cleanMask m
        userCodeDef () $ whenJust (M.lookup (mClean, s) ks) id
handle _ _ = return ()

Then I pass both myKeyUpBindings and myKeyDownBindings to XMonad like this:

myEventHook :: Event -> X All
myEventHook ev = keyUpEventHook (myKeyUpBindings myConfig)
               $ ev

myConfig = def
    {
      keys                  = myKeyDownBindings
    , handleEventHook       = myEventHook
    -- ...
    }

This nearly works; it switches to "mySpecialLayout" on key down and "myRegularLayout" on key up...but the problem is that when I hold down spacebar for more than a moment, XMonad starts to flicker really fast between the two layouts, instead of just switching once to "mySpecialLayout". How can I make it so that XMonad runs the X () action from keys only once when the key is pressed?

Possible approach?

I am thinking it may be possible to do this by using XMonad.Util.ExtensibleState to toggle a boolean variable on key down and again on key up, and have my key down X () action be either return () (if the value is True) or sendMessage $ JumpToLayout "mySpecialLayout" (if the value is False), but I am not sure how I would implement this. How would I read the boolean value from the mutable state--say, in an if statement? I know this is incorrect, but this is along the lines of my thinking:

myKeyDownBindings :: XConfig l -> M.Map ( KeyMask, KeySym ) ( X () )
myKeyDownBindings conf@(XConfig {XMonad.modMask = myModMask}) = mkKeymap conf $
    [
       ("M-<Space>", jumpToKeyDownLayout)
    ]
myKeyUpBindings :: XConfig l -> M.Map ( KeyMask, KeySym ) ( X () )
myKeyUpBindings conf@(XConfig {XMonad.modMask = myModMask}) = mkKeymap conf $
    [
       ("M-<Space>", jumpToKeyUpLayout)
    ]

data KeyDownStatus = KeyDownStatus Bool
instance ExtensionClass KeyDownStatus where
  initialValue = KeyDownStatus False

jumpToKeyUpLayout :: X ()
jumpToKeyUpLayout = XS.put (KeyDownStatus False)
                  >> (sendMessage $ JumpToLayout "myRegularLayout")

jumpToKeyDownLayout :: X ()
jumpToKeyDownLayout = (XS.get :: X KeyDownStatus)
                  >>= \keyAlreadyDown ->      -- this is the wrong type
                      case keyAlreadyDown of   -- how do I do the equivalent of this for my type?
                          True  -> return ()
                          False -> XS.put (KeyDownStatus True)
                                >> (sendMessage $ JumpToLayout "mySpecialLayout")

This yields the following compilation error, which I kind of expected but do not know how to resolve:

    • Couldn't match expected type ‘KeyDownStatus’
                  with actual type ‘Bool’
    • In the pattern: True
      In a case alternative: True -> return ()
      In the expression:
        case keyAlreadyDown of
          True -> return ()
          False
            -> XS.put (KeyDownStatus True)
                 >> (sendMessage $ JumpToLayout "grid")
    |
118 |                           True  -> return ()
    |                           ^^^^

I looked at this Reddit post with an answer about that module and only got more confused.

UPDATE #1

Fixed the compilation error thanks to a provided answer. Here is my current code for switching the workspaces:

data KeyStatus = Down | Up deriving (Eq, Read, Show)
instance ExtensionClass KeyStatus where initialValue = Up

myLayoutToggle :: KeyStatus -> String -> X ()
myLayoutToggle s l = (XS.get :: X KeyStatus)
                 >>= \key ->
                        if key == s then return ()
                        else             XS.put (s)
                                      >> (sendMessage $ JumpToLayout l)

and then I call it like:

myKeyUpBindings conf@(XConfig {XMonad.modMask = myModMask}) = mkKeymap conf $
    [
      ("M-<Space>", myLayoutToggle Up "myRegularLayout")
    ]
myKeyDownBindings conf@(XConfig {XMonad.modMask = myModMask}) = mkKeymap conf $
    [
      ("M-<Space>", myLayoutToggle Down "mySpecialLayout")
    ]

This works exactly as it did before; it still flickers. If I replace a line in myLayoutToggle to debug...

myLayoutToggle s l = (XS.get :: X KeyStatus)
                 >>= \key ->
                        if key == s then (spawn $ "echo Returning because key is already " ++ (show s) ++ ">>" ++ myPath ++ ".tmp" )
                                      >> return ()
                        else             XS.put (s)
                                        >> (spawn $ "echo Key switched status to " ++ (show s) ++ ">>" ++ myPath ++ ".tmp" )

...and then press down M-<Space> once and hold for roughly one second, this is what gets written to .tmp:

Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Down
Key switched status to Up
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Down
Key switched status to Up
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up
Key switched status to Down
Key switched status to Up

What is happening here? Why is key == s never returning True?

Solution

  • Very close. You just need to include the KeyDownStatus constructor in your match:

    case keyAlreadyDown of
    KeyDownStatus True -> ...
    KeyDownStatus False -> ...

    Additionally, you could use newtype instead of data. In this case it almost certainly does not matter, but generally it's better to use newtype than data for single-constructor, single-field types; this reduces memory allocation and indirection a tiny bit.

    newtype KeyDownStatus = KeyDownStatus Bool
-- OR, you could mimic the declaration `data Bool = False | True` directly
data KeyDownStatus = Down | Up