SendEventSink.hs

{-|
Module      : KMonad.Keyboard.IO.Windows.SendEventSink
Description : Using Windows' send_event functionality to inject KeyEvent's
Copyright   : (c) David Janssen, 2019
License     : MIT
Maintainer  : janssen.dhj@gmail.com
Stability   : experimental
Portability : portable

This uses @sendKey@ from the @keyio_win.c@ to send keys to Windows. This itself
then uses the Windows 'SendInput' system call.

-}
module KMonad.Keyboard.IO.Windows.SendEventSink
  ( sendEventKeySink
  )
where

import KMonad.Prelude

import Foreign.Ptr
import Foreign.Marshal
import Foreign.Storable

import KMonad.Keyboard
import KMonad.Keyboard.IO
import KMonad.Keyboard.IO.Windows.Types


--------------------------------------------------------------------------------

foreign import ccall "sendKey"
  sendKey :: Ptr WinKeyEvent -> IO ()

-- | The SKSink environment
data SKSink = SKSink
  { _buffer :: Ptr WinKeyEvent -- ^ The pointer we write events to
  }
makeClassy ''SKSink

-- | Return a 'KeySink' using Window's @sendEvent@ functionality.
sendEventKeySink :: HasLogFunc e => RIO e (Acquire KeySink)
sendEventKeySink = mkKeySink skOpen skClose skSend

-- | Create the 'SKSink' environment
skOpen :: HasLogFunc e => RIO e SKSink
skOpen = do
  logInfo "Initializing Windows key sink"
  liftIO $ SKSink <$> mallocBytes (sizeOf (undefined :: WinKeyEvent))

-- | Close the 'SKSink' environment
skClose :: HasLogFunc e => SKSink -> RIO e ()
skClose sk = do
  logInfo "Closing Windows key sink"
  liftIO . free $ sk^.buffer

-- | Write an event to the pointer and prompt windows to inject it
--
-- NOTE: This can throw an error if event-conversion fails.
skSend :: HasLogFunc e => SKSink -> KeyEvent -> RIO e ()
skSend sk e = either throwIO go $ toWinKeyEvent e
  where go e' = liftIO $ do
          poke (sk^.buffer) e'
          sendKey $ sk^.buffer