make haskell naming reflect c functionality (why is this standard?)

kmonad.cabal

@@ -93,8 +93,8 @@ library
 
  if os(darwin)
  exposed-modules:
- KMonad.Keyboard.IO.Mac.HIDQueueSource
- KMonad.Keyboard.IO.Mac.VirtualHIDSink
+ KMonad.Keyboard.IO.Mac.IOKitSource
+ KMonad.Keyboard.IO.Mac.KextSink
  KMonad.Keyboard.IO.Mac.Types
  cxx-sources:
  c_src/mac/keyio_mac.cpp

src/KMonad/Args/Joiner.hs

@@ -44,8 +44,8 @@ import KMonad.Keyboard.IO.Windows.SendEventSink
 #endif
 
 #ifdef darwin_HOST_OS
-import KMonad.Keyboard.IO.Mac.HIDQueueSource
-import KMonad.Keyboard.IO.Mac.VirtualHIDSink
+import KMonad.Keyboard.IO.Mac.IOKitSource
+import KMonad.Keyboard.IO.Mac.KextSink
 #endif
 
 import Control.Monad.Except
@@ -227,7 +227,7 @@ pickOutput (KUinputSink t init) = pure $ runLF (uinputSink cfg)
  where cfg = defUinputCfg { _keyboardName = T.unpack t
  , _postInit = T.unpack <$> init }
 pickOutput KSendEventSink = throwError $ InvalidOS "SendEventSink"
-pickOutput KVirtualHIDSink = throwError $ InvalidOS "VirtualHIDSink"
+pickOutput KKextSink  = throwError $ InvalidOS "KextSink"
 
 #endif
 
@@ -243,21 +243,21 @@ pickInput (KIOKitSource _) = throwError $ InvalidOS "IOKitSource"
 pickOutput :: OToken -> J (LogFunc -> IO (Acquire KeySink))
 pickOutput KSendEventSink = pure $ runLF sendEventKeySink
 pickOutput (KUinputSink _ _) = throwError $ InvalidOS "UinputSink"
-pickOutput KVirtualHIDSink = throwError $ InvalidOS "VirtualHIDSink"
+pickOutput KKextSink  = throwError $ InvalidOS "KextSink"
 
 #endif
 
 #ifdef darwin_HOST_OS
 
--- | The Linux correspondence between IToken and actual code
+-- | The Mac correspondence between IToken and actual code
 pickInput :: IToken -> J (LogFunc -> IO (Acquire KeySource))
-pickInput (KIOKitSource name) = pure $ runLF (hidSource (T.unpack <$> name))
+pickInput (KIOKitSource name) = pure $ runLF (iokitSource (T.unpack <$> name))
 pickInput (KDeviceSource _) = throwError $ InvalidOS "DeviceSource"
 pickInput KLowLevelHookSource = throwError $ InvalidOS "LowLevelHookSource"
 
--- | The Linux correspondence between OToken and actual code
+-- | The Mac correspondence between OToken and actual code
 pickOutput :: OToken -> J (LogFunc -> IO (Acquire KeySink))
-pickOutput KVirtualHIDSink = pure $ runLF virtualHIDSink
+pickOutput KKextSink  = pure $ runLF kextSink
 pickOutput (KUinputSink _ _) = throwError $ InvalidOS "UinputSink"
 pickOutput KSendEventSink = throwError $ InvalidOS "SendEventSink"
 

src/KMonad/Args/Parser.hs

@@ -267,7 +267,7 @@ otokenP :: Parser OToken
 otokenP = choice . map try $
  [ statement "uinput-sink" $ KUinputSink <$> lexeme textP <*> optional textP
  , statement "send-event-sink" $ pure KSendEventSink
- , statement "kext" $ pure KVirtualHIDSink]
+ , statement "kext" $ pure KKextSink]
 
 -- | Parse the DefCfg token
 defcfgP :: Parser DefSettings

src/KMonad/Args/Types.hs

@@ -146,7 +146,7 @@ data IToken
 data OToken
  = KUinputSink Text (Maybe Text)
  | KSendEventSink
- | KVirtualHIDSink
+ | KKextSink
  deriving Show
 
 -- | All possible single settings

src/KMonad/Keyboard/IO/Mac/HIDQueueSource.hs → src/KMonad/Keyboard/IO/Mac/IOKitSource.hs

@@ -1,5 +1,5 @@
-module KMonad.Keyboard.IO.Mac.HIDQueueSource
- ( hidSource
+module KMonad.Keyboard.IO.Mac.IOKitSource
+ ( iokitSource
  )
 where
 
@@ -36,20 +36,20 @@ data EvBuf = EvBuf
 makeLenses ''EvBuf
 
 -- | Return a KeySource using the Mac IOKit approach
-hidSource :: HasLogFunc e
+iokitSource :: HasLogFunc e
  => (Maybe String)
  -> RIO e (Acquire KeySource)
-hidSource name = mkKeySource (hidOpen name) hidClose hidRead
+iokitSource name = mkKeySource (iokitOpen name) iokitClose iokitRead
 
 
 --------------------------------------------------------------------------------
 
--- | Ask Mac to allocate a queue for events from keyboard HID
-hidOpen :: HasLogFunc e
+-- | Ask IOKit to open keyboards matching the specified name
+iokitOpen :: HasLogFunc e
  => (Maybe String)
  -> RIO e EvBuf
-hidOpen m = do
- logInfo "Opening HID queue"
+iokitOpen m = do
+ logInfo "Opening IOKit devices"
  liftIO $ do
  str <- newCString (case m of
  Nothing -> ""
@@ -62,18 +62,18 @@ hidOpen m = do
  pure $ EvBuf buf
 
 -- | Ask Mac to close the queue
-hidClose :: HasLogFunc e => EvBuf -> RIO e ()
-hidClose b = do
- logInfo "Closing HID queue"
+iokitClose :: HasLogFunc e => EvBuf -> RIO e ()
+iokitClose b = do
+ logInfo "Closing IOKit devices"
  liftIO $ do
  _ <- release_kb
  free $ b^.buffer
 
 -- | Get a new 'KeyEvent' from Mac
 --
 -- NOTE: This can throw an error if the event fails to convert.
-hidRead :: HasLogFunc e => EvBuf -> RIO e KeyEvent
-hidRead b = do
+iokitRead :: HasLogFunc e => EvBuf -> RIO e KeyEvent
+iokitRead b = do
  we <- liftIO $ do
  _ <- wait_key $ b^.buffer
  peek $ b^.buffer

src/KMonad/Keyboard/IO/Mac/KextSink.hs

@@ -0,0 +1,46 @@
+module KMonad.Keyboard.IO.Mac.KextSink
+ ( kextSink
+ )
+where
+
+import KMonad.Prelude
+
+import Foreign.Ptr
+import Foreign.Marshal
+import Foreign.Storable
+
+import KMonad.Keyboard
+import KMonad.Keyboard.IO
+import KMonad.Keyboard.IO.Mac.Types
+
+foreign import ccall "send_key"
+ send_key :: Ptr MacKeyEvent -> IO ()
+
+data EvBuf = EvBuf
+ { _buffer :: Ptr MacKeyEvent -- ^ The pointer we write events to
+ }
+makeClassy ''EvBuf
+
+kextSink :: HasLogFunc e => RIO e (Acquire KeySink)
+kextSink = mkKeySink skOpen skClose skSend
+
+-- | Create the 'EvBuf' environment
+skOpen :: HasLogFunc e => RIO e EvBuf
+skOpen = do
+ logInfo "Initializing Mac key sink"
+ liftIO $ EvBuf <$> mallocBytes (sizeOf (undefined :: MacKeyEvent))
+
+-- | Close the 'EvBuf' environment
+skClose :: HasLogFunc e => EvBuf -> RIO e ()
+skClose sk = do
+ logInfo "Closing Mac 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 => EvBuf -> KeyEvent -> RIO e ()
+skSend sk e = either throwIO go $ toMacKeyEvent e
+ where go e' = liftIO $ do
+ poke (sk^.buffer) e'
+ send_key $ sk^.buffer