diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for evdev +## 2.3.0 -- 01-09-2023 +* Add `deviceOptsFromEvents` for more easily creating UInput devices with desired capabilities. +* Add some extra `Read` instances. +* Fix duplicate keys by using pattern synonyms. + ## 2.2.0 -- 05-11-2022 * More bindings: * `deviceAbsAxis` diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -19,7 +19,6 @@ ``` sudo groupadd uinput sudo usermod -a -G uinput $USER -echo 'KERNEL=="uinput", GROUP="uinput", MODE:="0660", OPTIONS+="static_node=uinput"' | sudo tee -a /etc/udev/rules +echo 'KERNEL=="uinput", GROUP="uinput", MODE:="0660", OPTIONS+="static_node=uinput"' | sudo tee -a /etc/udev/rules.d/99-uinput.rules > /dev/null ``` -Log out and back in for this to take effect. - +Log out and back in for this to take effect (or try `sudo udevadm control --reload-rules && sudo udevadm trigger`). diff --git a/evdev.cabal b/evdev.cabal --- a/evdev.cabal +++ b/evdev.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: evdev -version: 2.2.0 +version: 2.3.0 author: George Thomas maintainer: George Thomas description: Provides access to the Linux event device interface. @@ -20,29 +20,23 @@ common common build-depends: base >= 4.11 && < 5, - bytestring ^>= {0.10, 0.11}, + bytestring ^>= {0.10, 0.11, 0.12}, containers ^>= 0.6.2, extra ^>= {1.6.18, 1.7}, filepath-bytestring ^>= 1.4.2, monad-loops ^>= 0.4.3, - rawfilepath ^>= 1.0.0, + mtl ^>= {2.2, 2.3}, + rawfilepath ^>= {1.0, 1.1}, time ^>= {1.9.3, 1.10, 1.11, 1.12, 1.13}, unix ^>= 2.7.2, - default-language: Haskell2010 + default-language: GHC2021 default-extensions: BlockArguments - DerivingStrategies - FlexibleContexts - FlexibleInstances - GeneralizedNewtypeDeriving LambdaCase NamedFieldPuns - NumericUnderscores OverloadedStrings + PatternSynonyms RecordWildCards - ScopedTypeVariables - TupleSections - TypeApplications TypeFamilies ViewPatterns ghc-options: diff --git a/src/Evdev.hs b/src/Evdev.hs --- a/src/Evdev.hs +++ b/src/Evdev.hs @@ -90,7 +90,7 @@ { eventData :: EventData , eventTime :: DiffTime } - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show, Read) -- | An input event, without the timestamp. -- Each constructor corresponds to one [event type](https://www.kernel.org/doc/html/latest/input/event-codes.html#event-types), except for 'UnknownEvent'. @@ -110,14 +110,14 @@ | UnknownEvent Word16 EventCode EventValue {- ^ We include this primarily so that 'fromCEvent' can be well-defined - let us know if you ever actually see one emitted by a device, as it would likely indicate a shortcoming in the library. -} - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show, Read) -- | A direct representation of the /code/ field of the C /input_event/, for when there is no obvious meaningful sum type. newtype EventCode = EventCode Word16 - deriving (Eq, Ord, Show, Enum) + deriving (Eq, Ord, Show, Read, Enum) -- | A direct representation of the /value/ field of the C /input_event/, for when there is no obvious meaningful sum type. newtype EventValue = EventValue Int32 - deriving (Eq, Ord, Show, Enum) + deriving (Eq, Ord, Show, Read, Enum) -- | The status of a key. data KeyEvent diff --git a/src/Evdev/Codes.chs b/src/Evdev/Codes.chs --- a/src/Evdev/Codes.chs +++ b/src/Evdev/Codes.chs @@ -9,7 +9,37 @@ -- | Datatypes corresponding to the constants in [input-event-codes.h](https://github.com/torvalds/linux/blob/master/include/uapi/linux/input-event-codes.h). -- See [the Linux Kernel documentation](https://www.kernel.org/doc/html/latest/input/event-codes.html) for full details, noting that all names have been mechanically transformed into CamelCase. -module Evdev.Codes where +module Evdev.Codes + ( EventType(..) + , SyncEvent(..) + , Key + ( .. + , KeyHanguel + , KeyCoffee + , KeyDirection + , KeyBrightnessZero + , KeyWimax + , BtnMisc + , BtnMouse + , BtnTrigger + , BtnGamepad + , BtnSouth + , BtnEast + , BtnNorth + , BtnWest + , BtnDigi + , BtnWheel + , KeyBrightnessToggle + , BtnTriggerHappy ) + , RelativeAxis(..) + , AbsoluteAxis(..) + , SwitchEvent(..) + , MiscEvent(..) + , LEDEvent(..) + , RepeatEvent(..) + , SoundEvent(..) + , DeviceProperty(..) + ) where #include @@ -161,7 +191,7 @@ KEY_SCALE as KeyScale, KEY_KPCOMMA as KeyKpcomma, KEY_HANGEUL as KeyHangeul, - KEY_HANGUEL as KeyHanguel, + -- KEY_HANGUEL as KeyHanguel, (alias of KEY_HANGEUL) KEY_HANJA as KeyHanja, KEY_YEN as KeyYen, KEY_LEFTMETA as KeyLeftmeta, @@ -191,10 +221,10 @@ KEY_PROG2 as KeyProg2, KEY_WWW as KeyWww, KEY_MSDOS as KeyMsdos, - KEY_COFFEE as KeyCoffee, + -- KEY_COFFEE as KeyCoffee, (alias of KEY_SCREENLOCK) KEY_SCREENLOCK as KeyScreenlock, KEY_ROTATE_DISPLAY as KeyRotateDisplay, - KEY_DIRECTION as KeyDirection, + -- KEY_DIRECTION as KeyDirection, (alias of KEY_ROTATE_DISPLAY) KEY_CYCLEWINDOWS as KeyCyclewindows, KEY_MAIL as KeyMail, KEY_BOOKMARKS as KeyBookmarks, @@ -281,13 +311,13 @@ KEY_VIDEO_PREV as KeyVideoPrev, KEY_BRIGHTNESS_CYCLE as KeyBrightnessCycle, KEY_BRIGHTNESS_AUTO as KeyBrightnessAuto, - KEY_BRIGHTNESS_ZERO as KeyBrightnessZero, + -- KEY_BRIGHTNESS_ZERO as KeyBrightnessZero, (alias of KEY_BRIGHTNESS_AUTO) KEY_DISPLAY_OFF as KeyDisplayOff, KEY_WWAN as KeyWwan, - KEY_WIMAX as KeyWimax, + -- KEY_WIMAX as KeyWimax, (alias of KEY_WWAN) KEY_RFKILL as KeyRfkill, KEY_MICMUTE as KeyMicmute, - BTN_MISC as BtnMisc, + -- BTN_MISC as BtnMisc, (alias of BTN_0) BTN_0 as Btn0, BTN_1 as Btn1, BTN_2 as Btn2, @@ -298,7 +328,7 @@ BTN_7 as Btn7, BTN_8 as Btn8, BTN_9 as Btn9, - BTN_MOUSE as BtnMouse, + -- BTN_MOUSE as BtnMouse, (alias of BTN_LEFT) BTN_LEFT as BtnLeft, BTN_RIGHT as BtnRight, BTN_MIDDLE as BtnMiddle, @@ -308,7 +338,7 @@ BTN_BACK as BtnBack, BTN_TASK as BtnTask, BTN_JOYSTICK as BtnJoystick, - BTN_TRIGGER as BtnTrigger, + -- BTN_TRIGGER as BtnTrigger, (alias of BTN_JOYSTICK) BTN_THUMB as BtnThumb, BTN_THUMB2 as BtnThumb2, BTN_TOP as BtnTop, @@ -321,15 +351,15 @@ BTN_BASE5 as BtnBase5, BTN_BASE6 as BtnBase6, BTN_DEAD as BtnDead, - BTN_GAMEPAD as BtnGamepad, - BTN_SOUTH as BtnSouth, + -- BTN_GAMEPAD as BtnGamepad, (alias of BTN_A) + -- BTN_SOUTH as BtnSouth, (alias of BTN_A) BTN_A as BtnA, - BTN_EAST as BtnEast, + -- BTN_EAST as BtnEast, (alias of BTN_B) BTN_B as BtnB, BTN_C as BtnC, - BTN_NORTH as BtnNorth, + -- BTN_NORTH as BtnNorth, (alias of BTN_X) BTN_X as BtnX, - BTN_WEST as BtnWest, + -- BTN_WEST as BtnWest, (alias of BTN_Y) BTN_Y as BtnY, BTN_Z as BtnZ, BTN_TL as BtnTl, @@ -341,7 +371,7 @@ BTN_MODE as BtnMode, BTN_THUMBL as BtnThumbl, BTN_THUMBR as BtnThumbr, - BTN_DIGI as BtnDigi, + -- BTN_DIGI as BtnDigi, (alias of BTN_TOOL_PEN) BTN_TOOL_PEN as BtnToolPen, BTN_TOOL_RUBBER as BtnToolRubber, BTN_TOOL_BRUSH as BtnToolBrush, @@ -357,7 +387,7 @@ BTN_TOOL_DOUBLETAP as BtnToolDoubletap, BTN_TOOL_TRIPLETAP as BtnToolTripletap, BTN_TOOL_QUADTAP as BtnToolQuadtap, - BTN_WHEEL as BtnWheel, + -- BTN_WHEEL as BtnWheel, (alias of BTN_GEAR_DOWN) BTN_GEAR_DOWN as BtnGearDown, BTN_GEAR_UP as BtnGearUp, KEY_OK as KeyOk, @@ -440,7 +470,7 @@ KEY_ADDRESSBOOK as KeyAddressbook, KEY_MESSENGER as KeyMessenger, KEY_DISPLAYTOGGLE as KeyDisplaytoggle, - KEY_BRIGHTNESS_TOGGLE as KeyBrightnessToggle, + -- KEY_BRIGHTNESS_TOGGLE as KeyBrightnessToggle, (alias of KEY_DISPLAYTOGGLE) KEY_SPELLCHECK as KeySpellcheck, KEY_LOGOFF as KeyLogoff, KEY_DOLLAR as KeyDollar, @@ -538,7 +568,7 @@ KEY_KBDINPUTASSIST_NEXTGROUP as KeyKbdinputassistNextgroup, KEY_KBDINPUTASSIST_ACCEPT as KeyKbdinputassistAccept, KEY_KBDINPUTASSIST_CANCEL as KeyKbdinputassistCancel, - BTN_TRIGGER_HAPPY as BtnTriggerHappy, + -- BTN_TRIGGER_HAPPY as BtnTriggerHappy, (alias of BTN_TRIGGER_HAPPY1) BTN_TRIGGER_HAPPY1 as BtnTriggerHappy1, BTN_TRIGGER_HAPPY2 as BtnTriggerHappy2, BTN_TRIGGER_HAPPY3 as BtnTriggerHappy3, @@ -580,6 +610,57 @@ BTN_TRIGGER_HAPPY39 as BtnTriggerHappy39, BTN_TRIGGER_HAPPY40 as BtnTriggerHappy40} deriving (Bounded, Eq, Ord, Read, Show) #} + +pattern KeyHanguel :: Key +pattern KeyHanguel = KeyHangeul + +pattern KeyCoffee :: Key +pattern KeyCoffee = KeyScreenlock + +pattern KeyDirection :: Key +pattern KeyDirection = KeyRotateDisplay + +pattern KeyBrightnessZero :: Key +pattern KeyBrightnessZero = KeyBrightnessAuto + +pattern KeyWimax :: Key +pattern KeyWimax = KeyWwan + +pattern BtnMisc :: Key +pattern BtnMisc = Btn0 + +pattern BtnMouse :: Key +pattern BtnMouse = BtnLeft + +pattern BtnTrigger :: Key +pattern BtnTrigger = BtnJoystick + +pattern BtnGamepad :: Key +pattern BtnGamepad = BtnA + +pattern BtnSouth :: Key +pattern BtnSouth = BtnA + +pattern BtnEast :: Key +pattern BtnEast = BtnB + +pattern BtnNorth :: Key +pattern BtnNorth = BtnX + +pattern BtnWest :: Key +pattern BtnWest = BtnY + +pattern BtnDigi :: Key +pattern BtnDigi = BtnToolPen + +pattern BtnWheel :: Key +pattern BtnWheel = BtnGearDown + +pattern KeyBrightnessToggle :: Key +pattern KeyBrightnessToggle = KeyDisplaytoggle + +pattern BtnTriggerHappy :: Key +pattern BtnTriggerHappy = BtnTriggerHappy1 -- | Relative changes #if defined(REL_WHEEL_HI_RES) diff --git a/src/Evdev/Uinput.hs b/src/Evdev/Uinput.hs --- a/src/Evdev/Uinput.hs +++ b/src/Evdev/Uinput.hs @@ -4,8 +4,9 @@ newDevice, writeEvent, writeBatch, - defaultDeviceOpts, DeviceOpts (..), + defaultDeviceOpts, + deviceOptsFromEvents, deviceSyspath, deviceDevnode, @@ -19,6 +20,8 @@ ) where import Control.Monad +import Control.Monad.State +import Data.Foldable import Data.Tuple.Extra import Foreign @@ -43,7 +46,7 @@ LL.setDeviceName dev name let maybeSet :: (LL.Device -> a -> IO ()) -> Maybe a -> IO () - maybeSet setter x = maybe (pure ()) (setter dev) x + maybeSet = maybe mempty . ($ dev) maybeSet LL.setDevicePhys phys maybeSet LL.setDeviceUniq uniq maybeSet LL.libevdev_set_id_product idProduct @@ -142,3 +145,47 @@ deviceSyspath = LL.getSyspath . \(Device d) -> d deviceDevnode :: Device -> IO (Maybe ByteString) deviceDevnode = LL.getDevnode . \(Device d) -> d + +-- | Make options for a device capable of precisely the events in the list. +deviceOptsFromEvents :: + Maybe (AbsoluteAxis -> AbsInfo) -> + Maybe (RepeatEvent -> Int) -> + [EventData] -> + DeviceOpts +--TODO use records or lenses to reduce boilerplate +deviceOptsFromEvents absInfo rep = + ( \(keys, relAxes, absAxes, miscs, switchs, leds, sounds, reps, ffs, powers, ffStats) -> + let phys = Nothing + uniq = Nothing + idProduct = Nothing + idVendor = Nothing + idBustype = Nothing + idVersion = Nothing + in DeviceOpts{..} + ) + . flip execState (mempty, mempty, mempty, mempty, mempty, mempty, mempty, mempty, mempty, mempty, mempty) + . traverse_ \case + SyncEvent _ -> pure () + KeyEvent e _ -> modify \(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) -> + (e : a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) + RelativeEvent e _ -> modify \(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) -> + (a0, e : a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) + AbsoluteEvent e _ -> modify \(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) -> + (a0, a1, (e, maybe (AbsInfo 0 0 0 0 0 0) ($ e) absInfo) : a2, a3, a4, a5, a6, a7, a8, a9, a10) + MiscEvent e _ -> modify \(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) -> + (a0, a1, a2, e : a3, a4, a5, a6, a7, a8, a9, a10) + SwitchEvent e _ -> modify \(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) -> + (a0, a1, a2, a3, e : a4, a5, a6, a7, a8, a9, a10) + LEDEvent e _ -> modify \(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) -> + (a0, a1, a2, a3, a4, e : a5, a6, a7, a8, a9, a10) + SoundEvent e _ -> modify \(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) -> + (a0, a1, a2, a3, a4, a5, e : a6, a7, a8, a9, a10) + RepeatEvent e _ -> modify \(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) -> + (a0, a1, a2, a3, a4, a5, a6, (e, maybe 0 ($ e) rep) : a7, a8, a9, a10) + ForceFeedbackEvent e _ -> modify \(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) -> + (a0, a1, a2, a3, a4, a5, a6, a7, e : a8, a9, a10) + PowerEvent e _ -> modify \(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) -> + (a0, a1, a2, a3, a4, a5, a6, a7, a8, e : a9, a10) + ForceFeedbackStatusEvent e _ -> modify \(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) -> + (a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, e : a10) + UnknownEvent{} -> pure ()