From b1c58277e6896720e216d46cdfc52207f607ddcd Mon Sep 17 00:00:00 2001
From: George Thomas <georgefsthomas@gmail.com>
Date: Sun, 20 Apr 2025 17:13:23 +0100
Subject: [PATCH 1/2] Wait for uinput device creation

---
 evdev/evdev.cabal         |  1 +
 evdev/src/Evdev/Uinput.hs | 30 +++++++++++++++++++++++++++++-
 2 files changed, 30 insertions(+), 1 deletion(-)

diff --git a/evdev/evdev.cabal b/evdev/evdev.cabal
index 58409c8..e4c18f9 100644
--- a/evdev/evdev.cabal
+++ b/evdev/evdev.cabal
@@ -29,6 +29,7 @@ common common
         rawfilepath ^>= {1.0, 1.1},
         time ^>= {1.9.3, 1.10, 1.11, 1.12, 1.13, 1.14},
         unix ^>= 2.8,
+        udev,
     default-language: GHC2021
     default-extensions:
         BlockArguments
diff --git a/evdev/src/Evdev/Uinput.hs b/evdev/src/Evdev/Uinput.hs
index c609767..9d66e2e 100644
--- a/evdev/src/Evdev/Uinput.hs
+++ b/evdev/src/Evdev/Uinput.hs
@@ -32,6 +32,12 @@ import Evdev.Codes
 import qualified Evdev.LowLevel as LL
 import Util
 
+import Control.Concurrent (newEmptyMVar, putMVar, readMVar)
+import Control.Monad.Loops (untilM_)
+import Data.Maybe (fromMaybe)
+import GHC.Event qualified as Event
+import System.UDev qualified as UDev
+
 -- | A `uinput` device.
 newtype Device = Device LL.UDevice
 
@@ -84,7 +90,29 @@ newDevice name DeviceOpts{..} = do
         LL.withAbsInfo absInfo $ \ptr ->
             enable ptr EvAbs [fromEnum' axis]
 
-    fmap Device $ cec $ LL.createFromDevice dev $ fromEnum' LL.UOMManaged
+    -- wait for device creation
+    mv <- newEmptyMVar
+    udev <- UDev.newUDev
+    monitor <- UDev.newFromNetlink udev UDev.UDevId
+    UDev.enableReceiving monitor
+    UDev.filterAddMatchSubsystemDevtype monitor "input" Nothing
+    UDev.enableReceiving monitor
+    fd <- UDev.getFd monitor
+    eventManager <- fromMaybe (error "not using GHC's threaded RTS") <$> Event.getSystemEventManager
+    fdKey <-
+        Event.registerFd
+            eventManager
+            (\_ _ -> traverse_ (putMVar mv) . UDev.getDevnode =<< UDev.receiveDevice monitor)
+            fd
+            Event.evtRead
+            Event.MultiShot
+    uinputDev <- fmap Device $ cec $ LL.createFromDevice dev $ fromEnum' LL.UOMManaged
+    deviceDevnode uinputDev >>= \case
+        Nothing -> pure () -- shouldn't generally happen - just return and hope for the best
+        Just devnode -> untilM_ (pure ()) $ (== devnode) <$> readMVar mv
+    Event.unregisterFd eventManager fdKey
+    UDev.freeUDev udev
+    pure uinputDev
   where
     cec :: CErrCall a => IO a -> IO (CErrCallRes a)
     cec = cErrCall "newDevice" ()

From 5574863a36a61d364dc08d22ae4365c2e8717030 Mon Sep 17 00:00:00 2001
From: George Thomas <georgefsthomas@gmail.com>
Date: Sun, 20 Apr 2025 17:15:00 +0100
Subject: [PATCH 2/2] Add 100ms wait to uinput device creation

---
 evdev/src/Evdev/Uinput.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/evdev/src/Evdev/Uinput.hs b/evdev/src/Evdev/Uinput.hs
index 9d66e2e..5319ba9 100644
--- a/evdev/src/Evdev/Uinput.hs
+++ b/evdev/src/Evdev/Uinput.hs
@@ -32,7 +32,7 @@ import Evdev.Codes
 import qualified Evdev.LowLevel as LL
 import Util
 
-import Control.Concurrent (newEmptyMVar, putMVar, readMVar)
+import Control.Concurrent (newEmptyMVar, putMVar, readMVar, threadDelay)
 import Control.Monad.Loops (untilM_)
 import Data.Maybe (fromMaybe)
 import GHC.Event qualified as Event
@@ -112,6 +112,7 @@ newDevice name DeviceOpts{..} = do
         Just devnode -> untilM_ (pure ()) $ (== devnode) <$> readMVar mv
     Event.unregisterFd eventManager fdKey
     UDev.freeUDev udev
+    threadDelay 100000
     pure uinputDev
   where
     cec :: CErrCall a => IO a -> IO (CErrCallRes a)