Just a whole bunch of changes

11 files changed, 208 insertions, 73 deletions

diff --git a/harness/include/plugin.h b/harness/include/plugin.h
index be3a022..4d69d76 100644
--- a/harness/include/plugin.h
+++ b/harness/include/plugin.h
@@ -146,7 +146,7 @@ typedef struct PLUGIN {
       opqst_t state));
 
   EXPORT(opqst_t (*plugin_handle_button)(struct wlr_pointer_button_event *event,
-                                         opqst_t state));
+                                         uint32_t modifiers, opqst_t state));
 
   /*
    * Handles a surface being mapped, unmapped or destroyed.
diff --git a/harness/src/wl.c b/harness/src/wl.c
index 8b7f437..8281b03 100644
--- a/harness/src/wl.c
+++ b/harness/src/wl.c
@@ -455,8 +455,12 @@ static void server_cursor_button(struct wl_listener *listener, void *data)
   struct tinywl_server *server =
       wl_container_of(listener, server, cursor_button);
   struct wlr_pointer_button_event *event = data;
+  struct wlr_seat *seat = server->seat;
+  struct wlr_keyboard *keyboard = wlr_seat_get_keyboard(seat);
+  uint32_t modifiers = wlr_keyboard_get_modifiers(keyboard);
 
-  plugin_call_update_state(server->plugin, plugin_handle_button, event);
+  plugin_call_update_state(server->plugin, plugin_handle_button, event,
+                           modifiers);
 
   /* Notify the client with pointer focus that a button press has occurred */
   // wlr_seat_pointer_notify_button(server->seat, event->time_msec,
diff --git a/package.yaml b/package.yaml
index cd8023b..d9e4add 100644
--- a/package.yaml
+++ b/package.yaml
@@ -36,6 +36,7 @@ dependencies:
 - data-default-class
 - transformers
 - monad-loops
+- singletons
 
 
 ghc-options:
@@ -59,6 +60,7 @@ ghc-options:
 - -XDerivingVia
 - -XDisambiguateRecordFields
 - -XLambdaCase
+- -XDataKinds
 - -fPIC
 
 executables:
diff --git a/src/Config.hs b/src/Config.hs
index 0bd0d43..e76e6ea 100644
--- a/src/Config.hs
+++ b/src/Config.hs
@@ -1,13 +1,15 @@
-{-# LANGUAGE DataKinds #-}
-
 module Config (config) where
 
 import Control.Monad (unless)
+import Data.Bits
 import Data.Data (Proxy (Proxy))
+import Wetterhorn.Core.ButtonEvent as ButtonEvent
+import Wetterhorn.Core.KeyEvent as KeyEvent
 import Wetterhorn.Core.W
 import Wetterhorn.Dsl.Bind
 import Wetterhorn.Dsl.Input
 import Wetterhorn.Keys.Macros
+import Wetterhorn.Keys.MagicModifierKey
 import Wetterhorn.Layout.Full
 
 config :: Config WindowLayout
@@ -26,7 +28,8 @@ config =
 
             bind ev (released btnLeft) $
               run $
-                wio $ putStrLn "Left Button Released!!"
+                wio $
+                  putStrLn "Left Button Released!!"
 
             unless (isPressEvent ev) $ do
               forwardEvent ev
@@ -41,18 +44,45 @@ config =
 
               bind ev2 (Mod1 .+ 'p') $
                 run $
-                  wio $ putStrLn "Test"
+                  wio $
+                    putStrLn "Test"
 
             bind ev (Mod1 .+ btnLeft) $
               run $
-                wio $ putStrLn "Left Button Press!!"
+                wio $
+                  putStrLn "Left Button Press!!"
 
             bind ev (Mod1 .+ 'q') macroStartStopKeybind
 
             bind ev (weak $ Mod1 .+ '@') macroReplayKeybind
 
+            bind ev (weak $ ModX 5 .+ btnLeft) $
+              run $
+                wio $
+                  putStrLn "Fake Modifier With Button!!!"
+
+            bind ev (weak $ ModX 5 .+ 't') $
+              run $
+                wio $
+                  putStrLn "Fake Modifier!!"
+
             forwardEvent ev
     }
   where
-    inputProxies :: Proxy '[MacroSupport, KeyLogger]
+    inputProxies ::
+      Proxy
+        '[ MacroSupport,
+           MagicModifierProxy 59 SetXtra -- Only log keys when F1 (keycode 59 is pressed)
+         ]
     inputProxies = Proxy
+
+data SetXtra
+
+instance InputProxy SetXtra where
+  onKeyEvent _ ie =
+    case ie of
+      (InputKeyEvent ke@(KeyEvent {KeyEvent.modifiers = modifiers})) ->
+        return $ InputKeyEvent ke {KeyEvent.modifiers = modifiers .|. modifierToMask (ModX 5)}
+      (InputButtonEvent be@(ButtonEvent {ButtonEvent.modifiers = modifiers})) ->
+        return $ InputButtonEvent be {ButtonEvent.modifiers = modifiers .|. modifierToMask (ModX 5)}
+      _ -> return ie
diff --git a/src/Wetterhorn/Core/ButtonEvent.hs b/src/Wetterhorn/Core/ButtonEvent.hs
index d3e0763..cc3d905 100644
--- a/src/Wetterhorn/Core/ButtonEvent.hs
+++ b/src/Wetterhorn/Core/ButtonEvent.hs
@@ -10,5 +10,6 @@ data ButtonEvent = ButtonEvent {
   pointer :: Ptr WlrPointer,
   timeMs :: Word32,
   button :: Word32,
+  modifiers :: Word32,
   state :: ButtonState
 } deriving (Eq, Show, Ord)
diff --git a/src/Wetterhorn/Core/W.hs b/src/Wetterhorn/Core/W.hs
index c252d59..862f9fa 100644
--- a/src/Wetterhorn/Core/W.hs
+++ b/src/Wetterhorn/Core/W.hs
@@ -7,6 +7,7 @@ import Control.Monad ((<=<))
 import Control.Monad.RWS (MonadIO (liftIO), MonadReader (..), MonadState, modify)
 import Control.Monad.Reader (ReaderT (runReaderT))
 import Control.Monad.State (StateT (runStateT), gets, modify')
+import Control.Monad.Trans.Class
 import Control.Monad.Trans.Maybe
 import Data.Data (TypeRep, Typeable, cast, tyConModule, tyConName, tyConPackage)
 import Data.Default.Class (Default, def)
@@ -19,8 +20,9 @@ import Data.Set (Set)
 import qualified Data.Set as Set
 import Foreign (Ptr, StablePtr, intPtrToPtr, ptrToIntPtr)
 import Text.Printf (printf)
-import Text.Read
+import Text.Read hiding (lift)
 import Type.Reflection (someTypeRep, someTypeRepTyCon)
+import Wetterhorn.Core.ButtonEvent (ButtonEvent)
 import Wetterhorn.Core.KeyEvent
 import Wetterhorn.Core.SurfaceEvent
 import Wetterhorn.Foreign.ForeignInterface (ForeignInterface)
@@ -28,7 +30,6 @@ import qualified Wetterhorn.Foreign.ForeignInterface as ForeignInterface
 import Wetterhorn.Foreign.WlRoots (Surface, WlrSeat)
 import Wetterhorn.StackSet hiding (layout)
 import qualified Wetterhorn.StackSet as StackSet
-import Wetterhorn.Core.ButtonEvent (ButtonEvent)
 
 data RationalRect = RationalRect Rational Rational Rational Rational
 
diff --git a/src/Wetterhorn/Dsl/Bind.hs b/src/Wetterhorn/Dsl/Bind.hs
index f6cdd7e..0b6adaf 100644
--- a/src/Wetterhorn/Dsl/Bind.hs
+++ b/src/Wetterhorn/Dsl/Bind.hs
@@ -8,6 +8,7 @@ module Wetterhorn.Dsl.Bind
     released,
     weak,
     run,
+    modifierToMask,
     module X,
   )
 where
@@ -16,7 +17,9 @@ import Control.Monad
 import Control.Monad.Trans
 import Data.Bits
 import Data.Word
+import Wetterhorn.Core.ButtonEvent (ButtonEvent(..))
 import qualified Wetterhorn.Core.ButtonEvent as ButtonEvent
+import Wetterhorn.Core.KeyEvent (KeyEvent(..))
 import qualified Wetterhorn.Core.KeyEvent as KeyEvent
 import Wetterhorn.Core.W
 import Wetterhorn.Dsl.Buttons as X
@@ -37,9 +40,21 @@ instance MatchEvent Button where
     return $ ButtonEvent.button be == b
   matches _ _ = return False
 
--- | Enumeration of possible modifiers
-data Modifier = Shift | Lock | Control | Mod1 | Mod2 | Mod3 | Mod4 | Mod5
-  deriving (Eq, Ord, Show, Read, Enum, Bounded)
+-- | Enumeration of possible modifiers.
+--
+-- ModX can be used for extra user-defined modifiers which are not standard xkb
+-- modifiers.
+data Modifier
+  = Shift
+  | Lock
+  | Control
+  | Mod1
+  | Mod2
+  | Mod3
+  | Mod4
+  | Mod5
+  | ModX Int
+  deriving (Eq, Ord, Show, Read)
 
 -- | Converts a modifier to its associated mask.
 modifierToMask :: Modifier -> Word32
@@ -54,6 +69,7 @@ modifierToMask m =
       Mod3 -> 5
       Mod4 -> 6
       Mod5 -> 7
+      ModX b -> b + 8
 
 released :: (MatchEvent m) => m -> InputEvent -> W Bool
 released me ev | not (isPressEvent ev) = matches me ev
@@ -66,16 +82,8 @@ data MatchModifiers = MatchModifiers
   }
 
 instance MatchEvent MatchModifiers where
-  matches (MatchModifiers weak bits base) ev@(InputKeyEvent ke) = do
-    b <- liftW $ base ev
-
-    return $
-      b
-        && ( (not weak && KeyEvent.modifiers ke == bits)
-               || (weak && (bits .&. KeyEvent.modifiers ke == bits))
-           )
   matches (MatchModifiers weak bits base) ev = do
-    mods <- liftW getModifierState
+    mods <- getMods ev
     b <- liftW $ base ev
 
     return $
@@ -83,6 +91,10 @@ instance MatchEvent MatchModifiers where
         && ( (not weak && mods == bits)
                || (weak && (bits .&. mods == bits))
            )
+    where
+      getMods (InputButtonEvent (ButtonEvent {ButtonEvent.modifiers = mods})) = return mods
+      getMods (InputKeyEvent (KeyEvent {KeyEvent.modifiers = mods})) = return mods
+      getMods _ = getModifierState
 
 class LiftMatchModifiers a where
   toModifiers :: a -> MatchModifiers
diff --git a/src/Wetterhorn/Dsl/Input.hs b/src/Wetterhorn/Dsl/Input.hs
index 1d1a89a..1a0c294 100644
--- a/src/Wetterhorn/Dsl/Input.hs
+++ b/src/Wetterhorn/Dsl/Input.hs
@@ -4,6 +4,7 @@ module Wetterhorn.Dsl.Input
   ( InputM,
     InputEvent (..),
     InputProxy (..),
+    NoProxy,
     withProxies,
     forwardEvent,
     forwardKey,
@@ -23,14 +24,24 @@ module Wetterhorn.Dsl.Input
   )
 where
 
-import Control.Concurrent (forkIO, threadDelay)
+import Control.Concurrent (threadDelay)
 import Control.Monad
 import Control.Monad.Cont (MonadCont)
-import Control.Monad.RWS (MonadIO (liftIO), MonadReader (ask, local), MonadState (get), MonadTrans (lift), RWST, asks, execRWST, gets, mapRWST, modify)
+import Control.Monad.Loops (andM)
+import Control.Monad.RWS
+  ( MonadIO (liftIO),
+    MonadReader (ask),
+    MonadState (get),
+    MonadTrans (lift),
+    RWST,
+    execRWST,
+    gets,
+    modify,
+  )
 import Control.Monad.Trans.Cont
-import Data.Proxy
+import Control.Monad.Trans.Maybe (MaybeT (runMaybeT))
 import Data.IORef (newIORef, readIORef, writeIORef)
-import Data.Maybe (fromMaybe)
+import Data.Proxy
 import Data.Word (Word32)
 import qualified Wetterhorn.Core.ButtonEvent as ButtonEvent
 import qualified Wetterhorn.Core.KeyEvent as KeyEvent
@@ -39,7 +50,7 @@ import qualified Wetterhorn.Core.W as W
 import Wetterhorn.Foreign.WlRoots (guardNull, wlrKeyboardGetModifiers, wlrSeatGetKeyboard, wlrSeatKeyboardNotifyKey, wlrSeatSetKeyboard)
 
 class InputProxy (spy :: k) where
-  onKeyEvent :: Proxy spy -> InputEvent -> W InputEvent
+  onKeyEvent :: Proxy spy -> InputEvent -> MaybeT W InputEvent
 
 instance (InputProxy h, InputProxy t) => InputProxy (h ': t) where
   onKeyEvent _ = onKeyEvent (Proxy :: Proxy h) <=< onKeyEvent (Proxy :: Proxy t)
@@ -47,9 +58,9 @@ instance (InputProxy h, InputProxy t) => InputProxy (h ': t) where
 instance InputProxy '[] where
   onKeyEvent _ = return
 
-data NoSpy
+data NoProxy
 
-instance InputProxy NoSpy where
+instance InputProxy NoProxy where
   onKeyEvent _ = return
 
 instance (InputProxy s1, InputProxy s2) => InputProxy (s1, s2) where
@@ -135,19 +146,26 @@ replayEvents :: [InputEvent] -> InputM spy ()
 replayEvents events = do
   ioref <- liftIO (newIORef events)
 
-  oldInput <- InputM $ gets inputSource
-
-  let newInput = InputM $ do
-        r <- liftIO (readIORef ioref)
-        case r of
-          [] -> do
-            modify $ \st -> st {inputSource = oldInput}
-            let (InputM action) = oldInput in action
-          (a : as) -> do
-            liftIO (writeIORef ioref as)
-            return a
+  (InputM oldInput) <- InputM $ gets inputSource
+
+  let newInput =
+        InputM $
+          shiftT
+            ( \thingToDo -> do
+                r <- liftIO (readIORef ioref)
+                case r of
+                  [] -> do
+                    modify $ \st -> st {inputSource = InputM oldInput}
+                    a <- oldInput
+                    lift (thingToDo a)
+                  (a : as) -> do
+                    liftIO (writeIORef ioref as)
+                    lift (thingToDo a)
+            )
 
   InputM $ modify $ \st -> st {inputSource = newInput}
+  where
+    delay to act = liftIO (threadDelay to) >> act
 
 -- | Call in the reset handler with the InputM handler you wolud like to use.
 useInputHandler :: (InputProxy spy) => InputM spy () -> W ()
@@ -156,7 +174,11 @@ useInputHandler (forever -> top@(InputM ctop)) = do
 
 -- | Returns the next input event that's either a kep press or a button press.
 nextInputPressEvent :: InputM spy InputEvent
-nextInputPressEvent = nextInputEventThat isPressEvent
+nextInputPressEvent = nextInputEventThat (andM [isPressEvent, not . modifierKey])
+
+modifierKey :: InputEvent -> Bool
+modifierKey (InputKeyEvent (KeyEvent.KeyEvent {codepoint = '\NUL'})) = True
+modifierKey _ = False
 
 nextInputEventThat :: (InputEvent -> Bool) -> InputM spy InputEvent
 nextInputEventThat fn =
@@ -205,19 +227,21 @@ useSeatEvents =
     shiftT
       ( \thingToDo -> do
           putButtonHandler $ \be -> do
-            clearButtonHandler
-            clearKeyHandler
             runSpies thingToDo (InputButtonEvent be)
 
           putKeyHandler $ \ke -> do
-            clearButtonHandler
-            clearKeyHandler
             runSpies thingToDo (InputKeyEvent ke)
       )
   where
     runSpies fn ev = do
-      ev' <- lift $ onKeyEvent (Proxy :: Proxy spy) ev
-      fn ev'
+      evM <- lift $ runMaybeT (onKeyEvent (Proxy :: Proxy spy) ev)
+      mapM_
+        ( \ev' -> do
+            clearButtonHandler
+            clearKeyHandler
+            fn ev'
+        )
+        evM
 
     clearButtonHandler =
       lift $
diff --git a/src/Wetterhorn/Foreign/Export.hs b/src/Wetterhorn/Foreign/Export.hs
index 3d24766..51bd72b 100644
--- a/src/Wetterhorn/Foreign/Export.hs
+++ b/src/Wetterhorn/Foreign/Export.hs
@@ -38,7 +38,8 @@ runForeign fn stblptr = do
   (_, state') <- W.runW (fn $ toWetter w) (ctx, st)
   newStablePtr (ctx, state')
 
-runForeignWithReturn :: (Storable a) => (Wetter -> W a) -> Ptr a -> Wetterhorn -> IO Wetterhorn
+runForeignWithReturn ::
+  (Storable a) => (Wetter -> W a) -> Ptr a -> Wetterhorn -> IO Wetterhorn
 runForeignWithReturn fn ptr stableptr = do
   w@(ctx, st) <- deRefStablePtr stableptr
   freeStablePtr stableptr
@@ -46,7 +47,13 @@ runForeignWithReturn fn ptr stableptr = do
   poke ptr val
   newStablePtr (ctx, state')
 
-runForeignWithReturn2 :: (Storable a, Storable b) => (Wetter -> W (a, b)) -> Ptr a -> Ptr b -> Wetterhorn -> IO Wetterhorn
+runForeignWithReturn2 ::
+  (Storable a, Storable b) =>
+  (Wetter -> W (a, b)) ->
+  Ptr a ->
+  Ptr b ->
+  Wetterhorn ->
+  IO Wetterhorn
 runForeignWithReturn2 fn ptrA ptrB stableptr = do
   w@(ctx, st) <- deRefStablePtr stableptr
   freeStablePtr stableptr
@@ -101,10 +108,10 @@ pluginMarshalState stblptr outlen = do
   return ret
 
 foreign export ccall "plugin_handle_button"
-  pluginHandleButton :: Ptr WlrPointerButtonEvent -> Wetterhorn -> IO Wetterhorn
+  pluginHandleButton :: Ptr WlrPointerButtonEvent -> Word32 -> Wetterhorn -> IO Wetterhorn
 
-pluginHandleButton :: Ptr WlrPointerButtonEvent -> Wetterhorn -> IO Wetterhorn
-pluginHandleButton eventPtr = do
+pluginHandleButton :: Ptr WlrPointerButtonEvent -> Word32 -> Wetterhorn -> IO Wetterhorn
+pluginHandleButton eventPtr modifiers = do
   runForeign $
     \( _,
        W.State {W.currentHooks = W.Hooks {buttonHook = buttonHook}}
@@ -115,6 +122,7 @@ pluginHandleButton eventPtr = do
               <$> demarshal
               <*> demarshal
               <*> demarshal
+              <*> pure modifiers
               <*> ( ( \u8 ->
                         if (u8 :: Word8) == 0
                           then ButtonReleased
@@ -188,7 +196,8 @@ foreign export ccall "plugin_handle_xwayland_surface"
   pluginHandleXWaylandSurface ::
     Ptr WlrXWaylandSurface -> CInt -> Wetterhorn -> IO Wetterhorn
 
-pluginHandleXWaylandSurface :: Ptr WlrXWaylandSurface -> CInt -> Wetterhorn -> IO Wetterhorn
+pluginHandleXWaylandSurface ::
+  Ptr WlrXWaylandSurface -> CInt -> Wetterhorn -> IO Wetterhorn
 pluginHandleXWaylandSurface p t =
   runForeign
     ( \( _,
diff --git a/src/Wetterhorn/Keys/Macros.hs b/src/Wetterhorn/Keys/Macros.hs
index b7683df..a794193 100644
--- a/src/Wetterhorn/Keys/Macros.hs
+++ b/src/Wetterhorn/Keys/Macros.hs
@@ -1,8 +1,17 @@
-{-# LANGUAGE DataKinds #-}
-
-module Wetterhorn.Keys.Macros where
+-- There are constraints used for better type-level enforced safety rules.
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
+
+module Wetterhorn.Keys.Macros
+  ( MacroSupport,
+    macroStartStopKeybind,
+    macroReplayKeybind,
+    stopMacroRecording,
+    startRecording,
+  )
+where
 
 import Control.Monad.IO.Class (MonadIO (liftIO))
+import Control.Monad.Trans (MonadTrans (lift))
 import Data.Default.Class
 import Data.Map (Map)
 import qualified Data.Map as Map
@@ -16,7 +25,7 @@ import Wetterhorn.Core.W
 import Wetterhorn.Dsl.Input
 import Wetterhorn.Foreign.WlRoots (WlrInputDevice)
 
-data RecordedKey = RecordedKey Word32 KeyState Word32 Word32 Char
+data RecordedKey = RecordedKey Word32 Word32 KeyState Word32 Word32 Char
   deriving (Read, Show)
 
 data MacrosState = MacrosState
@@ -31,7 +40,7 @@ instance Default MacrosState where
 instance ExtensionClass MacrosState
 
 type family Find a ls where
-  Find b (a ': t) = (b == a) || Find b t
+  Find b (a : t) = (b == a) || Find b t
   Find _ '[] = False
 
 -- | Provides a Vim-esque keybinding behavior for macro recording.
@@ -88,14 +97,13 @@ replayMacro inputDevice s = do
   mapM_ (replayEvents . map toInputEvent . reverse . tail) m
   where
     toInputEvent :: RecordedKey -> InputEvent
-    toInputEvent (RecordedKey kc st mo sym cp) =
-      InputKeyEvent $ KeyEvent 0 kc st mo sym cp inputDevice
+    toInputEvent (RecordedKey ts kc st mo keysym cp) =
+      InputKeyEvent $ KeyEvent ts kc st mo keysym cp inputDevice
 
 pushMacroKey :: (Wlike m) => KeyEvent -> m ()
 pushMacroKey ke = do
   cur <- xgets currentlyRecording
   whenJust cur $ \ch -> do
-    liftW $ wio $ putStrLn $ "-> " ++ show ke
     let recordedKey = toRecordedKey ke
      in xmodify $ \m@MacrosState {macros = macros} ->
           m {macros = Map.insertWith (++) ch [recordedKey] macros}
@@ -103,23 +111,15 @@ pushMacroKey ke = do
     whenJust (Just a) fn = fn a
     whenJust _ _ = return ()
 
-    toRecordedKey (KeyEvent _ c s m sym cp _) = RecordedKey c s m sym cp
+    toRecordedKey (KeyEvent ts c s m keysym cp _) = RecordedKey ts c s m keysym cp
 
+-- | Phantom type defining a proxy required to support macros.
 data MacroSupport
 
-data KeyLogger
-
-instance InputProxy KeyLogger where
-  onKeyEvent _ ie = do
-    case ie of
-      (InputKeyEvent (KeyEvent {codepoint = c})) ->
-        wio $ print c
-      _ -> return ()
-    return ie
-
+-- | Instance for macro support.
 instance InputProxy MacroSupport where
   onKeyEvent _ ie = do
-    whenKeyEvent ie pushMacroKey
+    lift $ whenKeyEvent ie pushMacroKey
     return ie
 
 class HasMacroSupport t
@@ -141,3 +141,5 @@ instance
       ~ True
   ) =>
   HasMacroSupport t
+
+instance HasMacroSupport MacroSupport
diff --git a/src/Wetterhorn/Keys/MagicModifierKey.hs b/src/Wetterhorn/Keys/MagicModifierKey.hs
new file mode 100644
index 0000000..6bc8bb3
--- /dev/null
+++ b/src/Wetterhorn/Keys/MagicModifierKey.hs
@@ -0,0 +1,50 @@
+module Wetterhorn.Keys.MagicModifierKey where
+
+import Data.Data
+import Data.Default.Class
+import GHC.TypeNats
+import Wetterhorn.Core.KeyEvent
+import Wetterhorn.Core.W
+import Wetterhorn.Dsl.Bind
+import Wetterhorn.Dsl.Input
+import Control.Monad.RWS (MonadTrans(lift))
+import Control.Monad.Trans.Maybe (MaybeT(..))
+
+data MagicModifierProxy (keycode :: Natural) inputproxy
+  deriving (Typeable)
+
+newtype MagicModifierState (keycode :: Natural) = MagicModifierState {isPressed :: Bool}
+  deriving (Typeable, Eq, Show, Ord, Read)
+
+instance Default (MagicModifierState k) where
+  def = MagicModifierState False
+
+instance (KnownNat k) => ExtensionClass (MagicModifierState k)
+
+instance
+  (KnownNat keycode, InputProxy inputproxy) =>
+  InputProxy (MagicModifierProxy keycode inputproxy)
+  where
+  onKeyEvent proxy ie = do
+    case ie of
+      (InputKeyEvent (KeyEvent {keycode = kc, state = state}))
+        | fromIntegral kc == natVal (keycodeProxy proxy) -> do
+          lift $ setMagicModifierPressed proxy (state == KeyPressed)
+          MaybeT (return Nothing)
+      _ -> do
+        pressed <- lift $ isMagicModifierPressed proxy
+        if pressed
+          then onKeyEvent (Proxy :: Proxy inputproxy) ie
+          else return ie
+    where
+      keycodeProxy :: Proxy (MagicModifierProxy kc a) -> Proxy kc
+      keycodeProxy _ = Proxy
+
+      isMagicModifierPressed p = isPressed <$> getModState p
+      setMagicModifierPressed p = modifyModState p . const
+
+      getModState :: (KnownNat kc) => Proxy (MagicModifierProxy kc a) -> W (MagicModifierState kc)
+      getModState _ = xget
+
+      modifyModState :: (KnownNat kc) => Proxy (MagicModifierProxy kc a) -> (MagicModifierState kc -> Bool) -> W ()
+      modifyModState _ fn = xmodify (MagicModifierState . fn)