module Rahm.Desktop.Keys.KeyCodeMapping where

import Rahm.Desktop.Keys.Grab
import Data.Map (Map)
import qualified Data.Map as Map
import XMonad
import qualified XMonad.Util.ExtensibleConf as XC
import Control.Monad (forM_)
import Control.Monad.RWS (All(All))

type KeyCodeActionMap = Map (KeyMask, KeyCode) (X ())

getKeycodeMap :: X (Maybe KeyCodeActionMap)
getKeycodeMap = XC.ask

setupKeycodeMapping ::
  (forall l. XConfig l -> KeyCodeActionMap) -> XConfig l -> XConfig l
setupKeycodeMapping actionMap config =
  XC.once
    ( \c ->
        c
          { handleEventHook = handleEventHook c <> eventHandler,
            startupHook = startupHook c >> startupHandler
          }
    )
    (actionMap config)
    config
  where
    startupHandler = grabKeycodes

    eventHandler
      e@( KeyEvent
            { ev_event_type = t,
              ev_keycode = kc,
              ev_state = m
            }
          )
        | t == keyPress = do
          mapM_ (sequence_ . Map.lookup (m, kc))
            =<< getKeycodeMap
          return (All True)
    eventHandler e@MappingNotifyEvent {} = do
      -- Ideally, we'd like to grab the keys here, but XMonad regrabs its keys
      -- after the user event handlers run and in the process ungrab any keys
      -- we just grabbed.
      --
      -- So, we'll emit an X11 ClientMessage to tell us to regrab the keys
      -- instead. This will then run after xmonad ungrabs the keys.
      XConf {display = dpy, theRoot = rootw} <- ask
      io $ do
        at <- internAtom dpy "REGRAB_KEYCODES" False
        m <- internAtom dpy "" False
        allocaXEvent $ \ev -> do
          setEventType ev clientMessage
          setClientMessageEvent ev rootw at 32 m currentTime
          sendEvent dpy rootw False structureNotifyMask ev
          sync dpy False
      return (All True)
    eventHandler e@ClientMessageEvent {ev_message_type = atom} = do
      -- We are asked to regrab the keycodes, so we'll do that.
      dpy <- asks display
      name <- io $ getAtomName dpy atom

      if name == Just "REGRAB_KEYCODES"
        then grabKeycodes >> return (All False)
        else return (All True)
    eventHandler _ = return (All True)

grabKeycodes :: X ()
grabKeycodes = do
  XConf {display = dpy, theRoot = rootw} <- ask

  mKeycodeBinds <- getKeycodeMap
  forM_ mKeycodeBinds $ \keycodeBinds -> do
    forM_ (Map.toList keycodeBinds) $ \((m, kc), _) -> do
      doGrab dpy rootw (m, Kc kc)