From a3c25a2001d8d8f8e78dc7d33037c479580b012f Mon Sep 17 00:00:00 2001 From: George Thomas Date: Mon, 30 Mar 2026 23:57:37 +0100 Subject: [PATCH 01/55] initial manual scaffolding of deps etc. --- cabal.project | 12 ++++++++++++ evdev/evdev.cabal | 3 +++ flake.nix | 6 ++++++ 3 files changed, 21 insertions(+) diff --git a/cabal.project b/cabal.project index 1415e03..d26d19b 100644 --- a/cabal.project +++ b/cabal.project @@ -3,6 +3,18 @@ packages: evdev-streamly evdev-examples +source-repository-package + type: git + location: https://github.com/well-typed/hs-bindgen + tag: 3c4af10590d0d09e825a9735e9a03d7f60914e21 + subdir: c-expr-dsl c-expr-runtime hs-bindgen hs-bindgen-runtime + --sha256: UCA7w+u20+CX1XN8so76UfJkM0FKKpljOgweP2FjtS4= +source-repository-package + type: git + location: https://github.com/well-typed/libclang + tag: 1054474fae403bfb52c7919680cac03d3d3d4237 + --sha256: LTAyNMY4Vu0vPeEq2wXB0KWY4kGtqtHTRmADjLdkv78= + if impl(ghc >= 9.10) allow-newer: -- deprecated - we'll replace it ASAP in favour of `OsPath` diff --git a/evdev/evdev.cabal b/evdev/evdev.cabal index b08cf0d..f1d7589 100644 --- a/evdev/evdev.cabal +++ b/evdev/evdev.cabal @@ -24,9 +24,12 @@ common common containers ^>= {0.6.2, 0.7, 0.8}, extra ^>= {1.6.18, 1.7, 1.8}, filepath-bytestring ^>= {1.4.2, 1.5}, + hs-bindgen ^>= {0.1}, + hs-bindgen-runtime ^>= {0.1}, monad-loops ^>= 0.4.3, mtl ^>= {2.2, 2.3}, rawfilepath ^>= {1.0, 1.1}, + template-haskell ^>= {2.21, 2.22, 2.23}, time ^>= {1.9.3, 1.10, 1.11, 1.12, 1.13, 1.14, 1.15}, unix ^>= 2.8, default-language: GHC2021 diff --git a/flake.nix b/flake.nix index 844e269..a651495 100644 --- a/flake.nix +++ b/flake.nix @@ -18,6 +18,12 @@ shell.tools.cabal = "latest"; shell.tools.haskell-language-server = "latest"; shell.withHoogle = false; + modules = [{ + packages.libclang-bindings.components.library = { + build-tools = [ pkgs.llvmPackages.llvm ]; + libs = [ pkgs.llvmPackages.libclang ]; + }; + }]; }; }) ]; From 0a88fa6d4b1defee8bf524a6fdcab241bf7ddb3e Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 00:13:22 +0100 Subject: [PATCH 02/55] git-ignore --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index db4503f..17b57c7 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,5 @@ dist-newstyle .ghc.environment.* cabal.project.local +result +evdev/output From dec0884f6921dc827452f419265049e951c71928 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 00:13:01 +0100 Subject: [PATCH 03/55] initial vibey attempt to replace c2hs with hs-bindgen --- evdev/evdev.cabal | 3 +- evdev/src/Evdev/Codes.chs | 811 -------- evdev/src/Evdev/Codes.hs | 3504 ++++++++++++++++++++++++++++++++++ evdev/src/Evdev/LowLevel.chs | 205 -- evdev/src/Evdev/LowLevel.hs | 407 ++++ evdev/src/Evdev/Raw.hs | 38 + 6 files changed, 3950 insertions(+), 1018 deletions(-) delete mode 100644 evdev/src/Evdev/Codes.chs create mode 100644 evdev/src/Evdev/Codes.hs delete mode 100644 evdev/src/Evdev/LowLevel.chs create mode 100644 evdev/src/Evdev/LowLevel.hs create mode 100644 evdev/src/Evdev/Raw.hs diff --git a/evdev/evdev.cabal b/evdev/evdev.cabal index f1d7589..fec452b 100644 --- a/evdev/evdev.cabal +++ b/evdev/evdev.cabal @@ -53,14 +53,13 @@ library Evdev.Uinput other-modules: Evdev.LowLevel + Evdev.Raw Util hs-source-dirs: src c-sources: src-c/evdev-hs.c pkgconfig-depends: libevdev - build-tool-depends: - c2hs:c2hs test-suite test import: common diff --git a/evdev/src/Evdev/Codes.chs b/evdev/src/Evdev/Codes.chs deleted file mode 100644 index f1bbf02..0000000 --- a/evdev/src/Evdev/Codes.chs +++ /dev/null @@ -1,811 +0,0 @@ -{- -TODO haddock doesn't quite work correctly with LINE pragmas - https://github.com/haskell/haddock/issues/441 - for now we can work around this by deleting the pragmas before upload to hackage - -seems to be on its way to being fixed with `.hie` files (enable `-fwrite-ide-info`) - https://github.com/haskell/haddock/commit/8bc3c2990475a254e168fbdb005af93f9397b19c --} - --- | 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 - ( 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 - --- | Each of these corresponds to one of the contructors of 'Evdev.EventData'. So you're unlikely to need to use these directly (C doesn't have ADTs - we do). -{#enum define EventType { - EV_SYN as EvSyn, - EV_KEY as EvKey, - EV_REL as EvRel, - EV_ABS as EvAbs, - EV_MSC as EvMsc, - EV_SW as EvSw, - EV_LED as EvLed, - EV_SND as EvSnd, - EV_REP as EvRep, - EV_FF as EvFf, - EV_PWR as EvPwr, - EV_FF_STATUS as EvFfStatus} - deriving (Bounded, Eq, Ord, Read, Show) #} - --- | Synchronization events -{#enum define SyncEvent { - SYN_REPORT as SynReport, -- | Used to separate packets of simultaneous events - SYN_CONFIG as SynConfig, - SYN_MT_REPORT as SynMtReport, - SYN_DROPPED as SynDropped} --TODO handle SYN_DROPPED automatically for streams - deriving (Bounded, Eq, Ord, Read, Show) #} - --- | Keys and buttons -{#enum define Key { - KEY_RESERVED as KeyReserved, - KEY_ESC as KeyEsc, - KEY_1 as Key1, - KEY_2 as Key2, - KEY_3 as Key3, - KEY_4 as Key4, - KEY_5 as Key5, - KEY_6 as Key6, - KEY_7 as Key7, - KEY_8 as Key8, - KEY_9 as Key9, - KEY_0 as Key0, - KEY_MINUS as KeyMinus, - KEY_EQUAL as KeyEqual, - KEY_BACKSPACE as KeyBackspace, - KEY_TAB as KeyTab, - KEY_Q as KeyQ, - KEY_W as KeyW, - KEY_E as KeyE, - KEY_R as KeyR, - KEY_T as KeyT, - KEY_Y as KeyY, - KEY_U as KeyU, - KEY_I as KeyI, - KEY_O as KeyO, - KEY_P as KeyP, - KEY_LEFTBRACE as KeyLeftbrace, - KEY_RIGHTBRACE as KeyRightbrace, - KEY_ENTER as KeyEnter, - KEY_LEFTCTRL as KeyLeftctrl, - KEY_A as KeyA, - KEY_S as KeyS, - KEY_D as KeyD, - KEY_F as KeyF, - KEY_G as KeyG, - KEY_H as KeyH, - KEY_J as KeyJ, - KEY_K as KeyK, - KEY_L as KeyL, - KEY_SEMICOLON as KeySemicolon, - KEY_APOSTROPHE as KeyApostrophe, - KEY_GRAVE as KeyGrave, - KEY_LEFTSHIFT as KeyLeftshift, - KEY_BACKSLASH as KeyBackslash, - KEY_Z as KeyZ, - KEY_X as KeyX, - KEY_C as KeyC, - KEY_V as KeyV, - KEY_B as KeyB, - KEY_N as KeyN, - KEY_M as KeyM, - KEY_COMMA as KeyComma, - KEY_DOT as KeyDot, - KEY_SLASH as KeySlash, - KEY_RIGHTSHIFT as KeyRightshift, - KEY_KPASTERISK as KeyKpasterisk, - KEY_LEFTALT as KeyLeftalt, - KEY_SPACE as KeySpace, - KEY_CAPSLOCK as KeyCapslock, - KEY_F1 as KeyF1, - KEY_F2 as KeyF2, - KEY_F3 as KeyF3, - KEY_F4 as KeyF4, - KEY_F5 as KeyF5, - KEY_F6 as KeyF6, - KEY_F7 as KeyF7, - KEY_F8 as KeyF8, - KEY_F9 as KeyF9, - KEY_F10 as KeyF10, - KEY_NUMLOCK as KeyNumlock, - KEY_SCROLLLOCK as KeyScrolllock, - KEY_KP7 as KeyKp7, - KEY_KP8 as KeyKp8, - KEY_KP9 as KeyKp9, - KEY_KPMINUS as KeyKpminus, - KEY_KP4 as KeyKp4, - KEY_KP5 as KeyKp5, - KEY_KP6 as KeyKp6, - KEY_KPPLUS as KeyKpplus, - KEY_KP1 as KeyKp1, - KEY_KP2 as KeyKp2, - KEY_KP3 as KeyKp3, - KEY_KP0 as KeyKp0, - KEY_KPDOT as KeyKpdot, - KEY_ZENKAKUHANKAKU as KeyZenkakuhankaku, - KEY_102ND as Key102nd, - KEY_F11 as KeyF11, - KEY_F12 as KeyF12, - KEY_RO as KeyRo, - KEY_KATAKANA as KeyKatakana, - KEY_HIRAGANA as KeyHiragana, - KEY_HENKAN as KeyHenkan, - KEY_KATAKANAHIRAGANA as KeyKatakanahiragana, - KEY_MUHENKAN as KeyMuhenkan, - KEY_KPJPCOMMA as KeyKpjpcomma, - KEY_KPENTER as KeyKpenter, - KEY_RIGHTCTRL as KeyRightctrl, - KEY_KPSLASH as KeyKpslash, - KEY_SYSRQ as KeySysrq, - KEY_RIGHTALT as KeyRightalt, - KEY_LINEFEED as KeyLinefeed, - KEY_HOME as KeyHome, - KEY_UP as KeyUp, - KEY_PAGEUP as KeyPageup, - KEY_LEFT as KeyLeft, - KEY_RIGHT as KeyRight, - KEY_END as KeyEnd, - KEY_DOWN as KeyDown, - KEY_PAGEDOWN as KeyPagedown, - KEY_INSERT as KeyInsert, - KEY_DELETE as KeyDelete, - KEY_MACRO as KeyMacro, - KEY_MUTE as KeyMute, - KEY_VOLUMEDOWN as KeyVolumedown, - KEY_VOLUMEUP as KeyVolumeup, - KEY_POWER as KeyPower, - KEY_KPEQUAL as KeyKpequal, - KEY_KPPLUSMINUS as KeyKpplusminus, - KEY_PAUSE as KeyPause, - KEY_SCALE as KeyScale, - KEY_KPCOMMA as KeyKpcomma, - KEY_HANGEUL as KeyHangeul, - -- KEY_HANGUEL as KeyHanguel, (alias of KEY_HANGEUL) - KEY_HANJA as KeyHanja, - KEY_YEN as KeyYen, - KEY_LEFTMETA as KeyLeftmeta, - KEY_RIGHTMETA as KeyRightmeta, - KEY_COMPOSE as KeyCompose, - KEY_STOP as KeyStop, - KEY_AGAIN as KeyAgain, - KEY_PROPS as KeyProps, - KEY_UNDO as KeyUndo, - KEY_FRONT as KeyFront, - KEY_COPY as KeyCopy, - KEY_OPEN as KeyOpen, - KEY_PASTE as KeyPaste, - KEY_FIND as KeyFind, - KEY_CUT as KeyCut, - KEY_HELP as KeyHelp, - KEY_MENU as KeyMenu, - KEY_CALC as KeyCalc, - KEY_SETUP as KeySetup, - KEY_SLEEP as KeySleep, - KEY_WAKEUP as KeyWakeup, - KEY_FILE as KeyFile, - KEY_SENDFILE as KeySendfile, - KEY_DELETEFILE as KeyDeletefile, - KEY_XFER as KeyXfer, - KEY_PROG1 as KeyProg1, - KEY_PROG2 as KeyProg2, - KEY_WWW as KeyWww, - KEY_MSDOS as KeyMsdos, - -- KEY_COFFEE as KeyCoffee, (alias of KEY_SCREENLOCK) - KEY_SCREENLOCK as KeyScreenlock, - KEY_ROTATE_DISPLAY as KeyRotateDisplay, - -- KEY_DIRECTION as KeyDirection, (alias of KEY_ROTATE_DISPLAY) - KEY_CYCLEWINDOWS as KeyCyclewindows, - KEY_MAIL as KeyMail, - KEY_BOOKMARKS as KeyBookmarks, - KEY_COMPUTER as KeyComputer, - KEY_BACK as KeyBack, - KEY_FORWARD as KeyForward, - KEY_CLOSECD as KeyClosecd, - KEY_EJECTCD as KeyEjectcd, - KEY_EJECTCLOSECD as KeyEjectclosecd, - KEY_NEXTSONG as KeyNextsong, - KEY_PLAYPAUSE as KeyPlaypause, - KEY_PREVIOUSSONG as KeyPrevioussong, - KEY_STOPCD as KeyStopcd, - KEY_RECORD as KeyRecord, - KEY_REWIND as KeyRewind, - KEY_PHONE as KeyPhone, - KEY_ISO as KeyIso, - KEY_CONFIG as KeyConfig, - KEY_HOMEPAGE as KeyHomepage, - KEY_REFRESH as KeyRefresh, - KEY_EXIT as KeyExit, - KEY_MOVE as KeyMove, - KEY_EDIT as KeyEdit, - KEY_SCROLLUP as KeyScrollup, - KEY_SCROLLDOWN as KeyScrolldown, - KEY_KPLEFTPAREN as KeyKpleftparen, - KEY_KPRIGHTPAREN as KeyKprightparen, - KEY_NEW as KeyNew, - KEY_REDO as KeyRedo, - KEY_F13 as KeyF13, - KEY_F14 as KeyF14, - KEY_F15 as KeyF15, - KEY_F16 as KeyF16, - KEY_F17 as KeyF17, - KEY_F18 as KeyF18, - KEY_F19 as KeyF19, - KEY_F20 as KeyF20, - KEY_F21 as KeyF21, - KEY_F22 as KeyF22, - KEY_F23 as KeyF23, - KEY_F24 as KeyF24, - KEY_PLAYCD as KeyPlaycd, - KEY_PAUSECD as KeyPausecd, - KEY_PROG3 as KeyProg3, - KEY_PROG4 as KeyProg4, - KEY_DASHBOARD as KeyDashboard, - KEY_SUSPEND as KeySuspend, - KEY_CLOSE as KeyClose, - KEY_PLAY as KeyPlay, - KEY_FASTFORWARD as KeyFastforward, - KEY_BASSBOOST as KeyBassboost, - KEY_PRINT as KeyPrint, - KEY_HP as KeyHp, - KEY_CAMERA as KeyCamera, - KEY_SOUND as KeySound, - KEY_QUESTION as KeyQuestion, - KEY_EMAIL as KeyEmail, - KEY_CHAT as KeyChat, - KEY_SEARCH as KeySearch, - KEY_CONNECT as KeyConnect, - KEY_FINANCE as KeyFinance, - KEY_SPORT as KeySport, - KEY_SHOP as KeyShop, - KEY_ALTERASE as KeyAlterase, - KEY_CANCEL as KeyCancel, - KEY_BRIGHTNESSDOWN as KeyBrightnessdown, - KEY_BRIGHTNESSUP as KeyBrightnessup, - KEY_MEDIA as KeyMedia, - KEY_SWITCHVIDEOMODE as KeySwitchvideomode, - KEY_KBDILLUMTOGGLE as KeyKbdillumtoggle, - KEY_KBDILLUMDOWN as KeyKbdillumdown, - KEY_KBDILLUMUP as KeyKbdillumup, - KEY_SEND as KeySend, - KEY_REPLY as KeyReply, - KEY_FORWARDMAIL as KeyForwardmail, - KEY_SAVE as KeySave, - KEY_DOCUMENTS as KeyDocuments, - KEY_BATTERY as KeyBattery, - KEY_BLUETOOTH as KeyBluetooth, - KEY_WLAN as KeyWlan, - KEY_UWB as KeyUwb, - KEY_UNKNOWN as KeyUnknown, - KEY_VIDEO_NEXT as KeyVideoNext, - KEY_VIDEO_PREV as KeyVideoPrev, - KEY_BRIGHTNESS_CYCLE as KeyBrightnessCycle, - KEY_BRIGHTNESS_AUTO as KeyBrightnessAuto, - -- KEY_BRIGHTNESS_ZERO as KeyBrightnessZero, (alias of KEY_BRIGHTNESS_AUTO) - KEY_DISPLAY_OFF as KeyDisplayOff, - KEY_WWAN as KeyWwan, - -- KEY_WIMAX as KeyWimax, (alias of KEY_WWAN) - KEY_RFKILL as KeyRfkill, - KEY_MICMUTE as KeyMicmute, - -- BTN_MISC as BtnMisc, (alias of BTN_0) - BTN_0 as Btn0, - BTN_1 as Btn1, - BTN_2 as Btn2, - BTN_3 as Btn3, - BTN_4 as Btn4, - BTN_5 as Btn5, - BTN_6 as Btn6, - BTN_7 as Btn7, - BTN_8 as Btn8, - BTN_9 as Btn9, - -- BTN_MOUSE as BtnMouse, (alias of BTN_LEFT) - BTN_LEFT as BtnLeft, - BTN_RIGHT as BtnRight, - BTN_MIDDLE as BtnMiddle, - BTN_SIDE as BtnSide, - BTN_EXTRA as BtnExtra, - BTN_FORWARD as BtnForward, - BTN_BACK as BtnBack, - BTN_TASK as BtnTask, - BTN_JOYSTICK as BtnJoystick, - -- BTN_TRIGGER as BtnTrigger, (alias of BTN_JOYSTICK) - BTN_THUMB as BtnThumb, - BTN_THUMB2 as BtnThumb2, - BTN_TOP as BtnTop, - BTN_TOP2 as BtnTop2, - BTN_PINKIE as BtnPinkie, - BTN_BASE as BtnBase, - BTN_BASE2 as BtnBase2, - BTN_BASE3 as BtnBase3, - BTN_BASE4 as BtnBase4, - BTN_BASE5 as BtnBase5, - BTN_BASE6 as BtnBase6, - BTN_DEAD as BtnDead, - -- BTN_GAMEPAD as BtnGamepad, (alias of BTN_A) - -- BTN_SOUTH as BtnSouth, (alias of BTN_A) - BTN_A as BtnA, - -- BTN_EAST as BtnEast, (alias of BTN_B) - BTN_B as BtnB, - BTN_C as BtnC, - -- BTN_NORTH as BtnNorth, (alias of BTN_X) - BTN_X as BtnX, - -- BTN_WEST as BtnWest, (alias of BTN_Y) - BTN_Y as BtnY, - BTN_Z as BtnZ, - BTN_TL as BtnTl, - BTN_TR as BtnTr, - BTN_TL2 as BtnTl2, - BTN_TR2 as BtnTr2, - BTN_SELECT as BtnSelect, - BTN_START as BtnStart, - BTN_MODE as BtnMode, - BTN_THUMBL as BtnThumbl, - BTN_THUMBR as BtnThumbr, - -- BTN_DIGI as BtnDigi, (alias of BTN_TOOL_PEN) - BTN_TOOL_PEN as BtnToolPen, - BTN_TOOL_RUBBER as BtnToolRubber, - BTN_TOOL_BRUSH as BtnToolBrush, - BTN_TOOL_PENCIL as BtnToolPencil, - BTN_TOOL_AIRBRUSH as BtnToolAirbrush, - BTN_TOOL_FINGER as BtnToolFinger, - BTN_TOOL_MOUSE as BtnToolMouse, - BTN_TOOL_LENS as BtnToolLens, - BTN_TOOL_QUINTTAP as BtnToolQuinttap, - BTN_TOUCH as BtnTouch, - BTN_STYLUS as BtnStylus, - BTN_STYLUS2 as BtnStylus2, - BTN_TOOL_DOUBLETAP as BtnToolDoubletap, - BTN_TOOL_TRIPLETAP as BtnToolTripletap, - BTN_TOOL_QUADTAP as BtnToolQuadtap, - -- BTN_WHEEL as BtnWheel, (alias of BTN_GEAR_DOWN) - BTN_GEAR_DOWN as BtnGearDown, - BTN_GEAR_UP as BtnGearUp, - KEY_OK as KeyOk, - KEY_SELECT as KeySelect, - KEY_GOTO as KeyGoto, - KEY_CLEAR as KeyClear, - KEY_POWER2 as KeyPower2, - KEY_OPTION as KeyOption, - KEY_INFO as KeyInfo, - KEY_TIME as KeyTime, - KEY_VENDOR as KeyVendor, - KEY_ARCHIVE as KeyArchive, - KEY_PROGRAM as KeyProgram, - KEY_CHANNEL as KeyChannel, - KEY_FAVORITES as KeyFavorites, - KEY_EPG as KeyEpg, - KEY_PVR as KeyPvr, - KEY_MHP as KeyMhp, - KEY_LANGUAGE as KeyLanguage, - KEY_TITLE as KeyTitle, - KEY_SUBTITLE as KeySubtitle, - KEY_ANGLE as KeyAngle, - KEY_ZOOM as KeyZoom, - KEY_MODE as KeyMode, - KEY_KEYBOARD as KeyKeyboard, - KEY_SCREEN as KeyScreen, - KEY_PC as KeyPc, - KEY_TV as KeyTv, - KEY_TV2 as KeyTv2, - KEY_VCR as KeyVcr, - KEY_VCR2 as KeyVcr2, - KEY_SAT as KeySat, - KEY_SAT2 as KeySat2, - KEY_CD as KeyCd, - KEY_TAPE as KeyTape, - KEY_RADIO as KeyRadio, - KEY_TUNER as KeyTuner, - KEY_PLAYER as KeyPlayer, - KEY_TEXT as KeyText, - KEY_DVD as KeyDvd, - KEY_AUX as KeyAux, - KEY_MP3 as KeyMp3, - KEY_AUDIO as KeyAudio, - KEY_VIDEO as KeyVideo, - KEY_DIRECTORY as KeyDirectory, - KEY_LIST as KeyList, - KEY_MEMO as KeyMemo, - KEY_CALENDAR as KeyCalendar, - KEY_RED as KeyRed, - KEY_GREEN as KeyGreen, - KEY_YELLOW as KeyYellow, - KEY_BLUE as KeyBlue, - KEY_CHANNELUP as KeyChannelup, - KEY_CHANNELDOWN as KeyChanneldown, - KEY_FIRST as KeyFirst, - KEY_LAST as KeyLast, - KEY_AB as KeyAb, - KEY_NEXT as KeyNext, - KEY_RESTART as KeyRestart, - KEY_SLOW as KeySlow, - KEY_SHUFFLE as KeyShuffle, - KEY_BREAK as KeyBreak, - KEY_PREVIOUS as KeyPrevious, - KEY_DIGITS as KeyDigits, - KEY_TEEN as KeyTeen, - KEY_TWEN as KeyTwen, - KEY_VIDEOPHONE as KeyVideophone, - KEY_GAMES as KeyGames, - KEY_ZOOMIN as KeyZoomin, - KEY_ZOOMOUT as KeyZoomout, - KEY_ZOOMRESET as KeyZoomreset, - KEY_WORDPROCESSOR as KeyWordprocessor, - KEY_EDITOR as KeyEditor, - KEY_SPREADSHEET as KeySpreadsheet, - KEY_GRAPHICSEDITOR as KeyGraphicseditor, - KEY_PRESENTATION as KeyPresentation, - KEY_DATABASE as KeyDatabase, - KEY_NEWS as KeyNews, - KEY_VOICEMAIL as KeyVoicemail, - KEY_ADDRESSBOOK as KeyAddressbook, - KEY_MESSENGER as KeyMessenger, - KEY_DISPLAYTOGGLE as KeyDisplaytoggle, - -- KEY_BRIGHTNESS_TOGGLE as KeyBrightnessToggle, (alias of KEY_DISPLAYTOGGLE) - KEY_SPELLCHECK as KeySpellcheck, - KEY_LOGOFF as KeyLogoff, - KEY_DOLLAR as KeyDollar, - KEY_EURO as KeyEuro, - KEY_FRAMEBACK as KeyFrameback, - KEY_FRAMEFORWARD as KeyFrameforward, - KEY_CONTEXT_MENU as KeyContextMenu, - KEY_MEDIA_REPEAT as KeyMediaRepeat, - KEY_10CHANNELSUP as Key10channelsup, - KEY_10CHANNELSDOWN as Key10channelsdown, - KEY_IMAGES as KeyImages, - KEY_DEL_EOL as KeyDelEol, - KEY_DEL_EOS as KeyDelEos, - KEY_INS_LINE as KeyInsLine, - KEY_DEL_LINE as KeyDelLine, - KEY_FN as KeyFn, - KEY_FN_ESC as KeyFnEsc, - KEY_FN_F1 as KeyFnF1, - KEY_FN_F2 as KeyFnF2, - KEY_FN_F3 as KeyFnF3, - KEY_FN_F4 as KeyFnF4, - KEY_FN_F5 as KeyFnF5, - KEY_FN_F6 as KeyFnF6, - KEY_FN_F7 as KeyFnF7, - KEY_FN_F8 as KeyFnF8, - KEY_FN_F9 as KeyFnF9, - KEY_FN_F10 as KeyFnF10, - KEY_FN_F11 as KeyFnF11, - KEY_FN_F12 as KeyFnF12, - KEY_FN_1 as KeyFn1, - KEY_FN_2 as KeyFn2, - KEY_FN_D as KeyFnD, - KEY_FN_E as KeyFnE, - KEY_FN_F as KeyFnF, - KEY_FN_S as KeyFnS, - KEY_FN_B as KeyFnB, - KEY_BRL_DOT1 as KeyBrlDot1, - KEY_BRL_DOT2 as KeyBrlDot2, - KEY_BRL_DOT3 as KeyBrlDot3, - KEY_BRL_DOT4 as KeyBrlDot4, - KEY_BRL_DOT5 as KeyBrlDot5, - KEY_BRL_DOT6 as KeyBrlDot6, - KEY_BRL_DOT7 as KeyBrlDot7, - KEY_BRL_DOT8 as KeyBrlDot8, - KEY_BRL_DOT9 as KeyBrlDot9, - KEY_BRL_DOT10 as KeyBrlDot10, - KEY_NUMERIC_0 as KeyNumeric0, - KEY_NUMERIC_1 as KeyNumeric1, - KEY_NUMERIC_2 as KeyNumeric2, - KEY_NUMERIC_3 as KeyNumeric3, - KEY_NUMERIC_4 as KeyNumeric4, - KEY_NUMERIC_5 as KeyNumeric5, - KEY_NUMERIC_6 as KeyNumeric6, - KEY_NUMERIC_7 as KeyNumeric7, - KEY_NUMERIC_8 as KeyNumeric8, - KEY_NUMERIC_9 as KeyNumeric9, - KEY_NUMERIC_STAR as KeyNumericStar, - KEY_NUMERIC_POUND as KeyNumericPound, - KEY_NUMERIC_A as KeyNumericA, - KEY_NUMERIC_B as KeyNumericB, - KEY_NUMERIC_C as KeyNumericC, - KEY_NUMERIC_D as KeyNumericD, - KEY_CAMERA_FOCUS as KeyCameraFocus, - KEY_WPS_BUTTON as KeyWpsButton, - KEY_TOUCHPAD_TOGGLE as KeyTouchpadToggle, - KEY_TOUCHPAD_ON as KeyTouchpadOn, - KEY_TOUCHPAD_OFF as KeyTouchpadOff, - KEY_CAMERA_ZOOMIN as KeyCameraZoomin, - KEY_CAMERA_ZOOMOUT as KeyCameraZoomout, - KEY_CAMERA_UP as KeyCameraUp, - KEY_CAMERA_DOWN as KeyCameraDown, - KEY_CAMERA_LEFT as KeyCameraLeft, - KEY_CAMERA_RIGHT as KeyCameraRight, - KEY_ATTENDANT_ON as KeyAttendantOn, - KEY_ATTENDANT_OFF as KeyAttendantOff, - KEY_ATTENDANT_TOGGLE as KeyAttendantToggle, - KEY_LIGHTS_TOGGLE as KeyLightsToggle, - BTN_DPAD_UP as BtnDpadUp, - BTN_DPAD_DOWN as BtnDpadDown, - BTN_DPAD_LEFT as BtnDpadLeft, - BTN_DPAD_RIGHT as BtnDpadRight, - KEY_ALS_TOGGLE as KeyAlsToggle, - KEY_BUTTONCONFIG as KeyButtonconfig, - KEY_TASKMANAGER as KeyTaskmanager, - KEY_JOURNAL as KeyJournal, - KEY_CONTROLPANEL as KeyControlpanel, - KEY_APPSELECT as KeyAppselect, - KEY_SCREENSAVER as KeyScreensaver, - KEY_VOICECOMMAND as KeyVoicecommand, - KEY_BRIGHTNESS_MIN as KeyBrightnessMin, - KEY_BRIGHTNESS_MAX as KeyBrightnessMax, - KEY_KBDINPUTASSIST_PREV as KeyKbdinputassistPrev, - KEY_KBDINPUTASSIST_NEXT as KeyKbdinputassistNext, - KEY_KBDINPUTASSIST_PREVGROUP as KeyKbdinputassistPrevgroup, - KEY_KBDINPUTASSIST_NEXTGROUP as KeyKbdinputassistNextgroup, - KEY_KBDINPUTASSIST_ACCEPT as KeyKbdinputassistAccept, - KEY_KBDINPUTASSIST_CANCEL as KeyKbdinputassistCancel, - -- 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, - BTN_TRIGGER_HAPPY4 as BtnTriggerHappy4, - BTN_TRIGGER_HAPPY5 as BtnTriggerHappy5, - BTN_TRIGGER_HAPPY6 as BtnTriggerHappy6, - BTN_TRIGGER_HAPPY7 as BtnTriggerHappy7, - BTN_TRIGGER_HAPPY8 as BtnTriggerHappy8, - BTN_TRIGGER_HAPPY9 as BtnTriggerHappy9, - BTN_TRIGGER_HAPPY10 as BtnTriggerHappy10, - BTN_TRIGGER_HAPPY11 as BtnTriggerHappy11, - BTN_TRIGGER_HAPPY12 as BtnTriggerHappy12, - BTN_TRIGGER_HAPPY13 as BtnTriggerHappy13, - BTN_TRIGGER_HAPPY14 as BtnTriggerHappy14, - BTN_TRIGGER_HAPPY15 as BtnTriggerHappy15, - BTN_TRIGGER_HAPPY16 as BtnTriggerHappy16, - BTN_TRIGGER_HAPPY17 as BtnTriggerHappy17, - BTN_TRIGGER_HAPPY18 as BtnTriggerHappy18, - BTN_TRIGGER_HAPPY19 as BtnTriggerHappy19, - BTN_TRIGGER_HAPPY20 as BtnTriggerHappy20, - BTN_TRIGGER_HAPPY21 as BtnTriggerHappy21, - BTN_TRIGGER_HAPPY22 as BtnTriggerHappy22, - BTN_TRIGGER_HAPPY23 as BtnTriggerHappy23, - BTN_TRIGGER_HAPPY24 as BtnTriggerHappy24, - BTN_TRIGGER_HAPPY25 as BtnTriggerHappy25, - BTN_TRIGGER_HAPPY26 as BtnTriggerHappy26, - BTN_TRIGGER_HAPPY27 as BtnTriggerHappy27, - BTN_TRIGGER_HAPPY28 as BtnTriggerHappy28, - BTN_TRIGGER_HAPPY29 as BtnTriggerHappy29, - BTN_TRIGGER_HAPPY30 as BtnTriggerHappy30, - BTN_TRIGGER_HAPPY31 as BtnTriggerHappy31, - BTN_TRIGGER_HAPPY32 as BtnTriggerHappy32, - BTN_TRIGGER_HAPPY33 as BtnTriggerHappy33, - BTN_TRIGGER_HAPPY34 as BtnTriggerHappy34, - BTN_TRIGGER_HAPPY35 as BtnTriggerHappy35, - BTN_TRIGGER_HAPPY36 as BtnTriggerHappy36, - BTN_TRIGGER_HAPPY37 as BtnTriggerHappy37, - BTN_TRIGGER_HAPPY38 as BtnTriggerHappy38, - 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) -{#enum define RelativeAxis { - REL_X as RelX, - REL_Y as RelY, - REL_Z as RelZ, - REL_RX as RelRx, - REL_RY as RelRy, - REL_RZ as RelRz, - REL_HWHEEL as RelHwheel, - REL_DIAL as RelDial, - REL_WHEEL as RelWheel, - REL_MISC as RelMisc, - REL_RESERVED as RelReserved, - REL_WHEEL_HI_RES as RelWheelHiRes, - REL_HWHEEL_HI_RES as RelHWheelHiRes} - deriving (Bounded, Eq, Ord, Read, Show) #} -# else -{#enum define RelativeAxis { - REL_X as RelX, - REL_Y as RelY, - REL_Z as RelZ, - REL_RX as RelRx, - REL_RY as RelRy, - REL_RZ as RelRz, - REL_HWHEEL as RelHwheel, - REL_DIAL as RelDial, - REL_WHEEL as RelWheel, - REL_MISC as RelMisc, - REL_RESERVED as RelReserved} - deriving (Bounded, Eq, Ord, Read, Show) #} -#endif - --- | Absolute changes -{#enum define AbsoluteAxis { - ABS_X as AbsX, - ABS_Y as AbsY, - ABS_Z as AbsZ, - ABS_RX as AbsRx, - ABS_RY as AbsRy, - ABS_RZ as AbsRz, - ABS_THROTTLE as AbsThrottle, - ABS_RUDDER as AbsRudder, - ABS_WHEEL as AbsWheel, - ABS_GAS as AbsGas, - ABS_BRAKE as AbsBrake, - ABS_HAT0X as AbsHat0x, - ABS_HAT0Y as AbsHat0y, - ABS_HAT1X as AbsHat1x, - ABS_HAT1Y as AbsHat1y, - ABS_HAT2X as AbsHat2x, - ABS_HAT2Y as AbsHat2y, - ABS_HAT3X as AbsHat3x, - ABS_HAT3Y as AbsHat3y, - ABS_PRESSURE as AbsPressure, - ABS_DISTANCE as AbsDistance, - ABS_TILT_X as AbsTiltX, - ABS_TILT_Y as AbsTiltY, - ABS_TOOL_WIDTH as AbsToolWidth, - ABS_VOLUME as AbsVolume, - ABS_MISC as AbsMisc, - ABS_RESERVED as AbsReserved, - ABS_MT_SLOT as AbsMtSlot, - ABS_MT_TOUCH_MAJOR as AbsMtTouchMajor, - ABS_MT_TOUCH_MINOR as AbsMtTouchMinor, - ABS_MT_WIDTH_MAJOR as AbsMtWidthMajor, - ABS_MT_WIDTH_MINOR as AbsMtWidthMinor, - ABS_MT_ORIENTATION as AbsMtOrientation, - ABS_MT_POSITION_X as AbsMtPositionX, - ABS_MT_POSITION_Y as AbsMtPositionY, - ABS_MT_TOOL_TYPE as AbsMtToolType, - ABS_MT_BLOB_ID as AbsMtBlobId, - ABS_MT_TRACKING_ID as AbsMtTrackingId, - ABS_MT_PRESSURE as AbsMtPressure, - ABS_MT_DISTANCE as AbsMtDistance, - ABS_MT_TOOL_X as AbsMtToolX, - ABS_MT_TOOL_Y as AbsMtToolY} - deriving (Bounded, Eq, Ord, Read, Show) #} - --- | Stateful binary switches -{#enum define SwitchEvent { - SW_LID as SwLid, - SW_TABLET_MODE as SwTabletMode, - SW_HEADPHONE_INSERT as SwHeadphoneInsert, - SW_RFKILL_ALL as SwRfkillAll, - SW_RADIO as SwRadio, - SW_MICROPHONE_INSERT as SwMicrophoneInsert, - SW_DOCK as SwDock, - SW_LINEOUT_INSERT as SwLineoutInsert, - SW_JACK_PHYSICAL_INSERT as SwJackPhysicalInsert, - SW_VIDEOOUT_INSERT as SwVideooutInsert, - SW_CAMERA_LENS_COVER as SwCameraLensCover, - SW_KEYPAD_SLIDE as SwKeypadSlide, - SW_FRONT_PROXIMITY as SwFrontProximity, - SW_ROTATE_LOCK as SwRotateLock, - SW_LINEIN_INSERT as SwLineinInsert, - SW_MUTE_DEVICE as SwMuteDevice} - deriving (Bounded, Eq, Ord, Read, Show) #} - --- | Miscellaneous -{#enum define MiscEvent { - MSC_SERIAL as MscSerial, - MSC_PULSELED as MscPulseled, - MSC_GESTURE as MscGesture, - MSC_RAW as MscRaw, - MSC_SCAN as MscScan, - MSC_TIMESTAMP as MscTimestamp} - deriving (Bounded, Eq, Ord, Read, Show) #} - --- | LEDs -{#enum define LEDEvent { - LED_NUML as LedNuml, - LED_CAPSL as LedCapsl, - LED_SCROLLL as LedScrolll, - LED_COMPOSE as LedCompose, - LED_KANA as LedKana, - LED_SLEEP as LedSleep, - LED_SUSPEND as LedSuspend, - LED_MUTE as LedMute, - LED_MISC as LedMisc, - LED_MAIL as LedMail, - LED_CHARGING as LedCharging} - deriving (Bounded, Eq, Ord, Read, Show) #} - --- | Specifying autorepeating events -{#enum define RepeatEvent { - REP_DELAY as RepDelay, - REP_PERIOD as RepPeriod} - deriving (Bounded, Eq, Ord, Read, Show) #} - --- | For simple sound output devices -{#enum define SoundEvent { - SND_CLICK as SndClick, - SND_BELL as SndBell, - SND_TONE as SndTone} - deriving (Bounded, Eq, Ord, Read, Show) #} - --- | Device properties -{#enum define DeviceProperty { - INPUT_PROP_POINTER as InputPropPointer, - INPUT_PROP_DIRECT as InputPropDirect, - INPUT_PROP_BUTTONPAD as InputPropButtonpad, - INPUT_PROP_SEMI_MT as InputPropSemiMt, - INPUT_PROP_TOPBUTTONPAD as InputPropTopbuttonpad, - INPUT_PROP_POINTING_STICK as InputPropPointingStick, - INPUT_PROP_ACCELEROMETER as InputPropAccelerometer} - deriving (Bounded, Eq, Ord, Read, Show) #} diff --git a/evdev/src/Evdev/Codes.hs b/evdev/src/Evdev/Codes.hs new file mode 100644 index 0000000..a0c0bc9 --- /dev/null +++ b/evdev/src/Evdev/Codes.hs @@ -0,0 +1,3504 @@ +{-# LANGUAGE PatternSynonyms #-} + +-- | 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 + ( 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 + + + + + +-- | Each of these corresponds to one of the contructors of 'Evdev.EventData'. So you're unlikely to need to use these directly (C doesn't have ADTs - we do). +data EventType = EvSyn + | EvKey + | EvRel + | EvAbs + | EvMsc + | EvSw + | EvLed + | EvSnd + | EvRep + | EvFf + | EvPwr + | EvFfStatus + deriving (Bounded,Eq,Ord,Read,Show) +instance Enum EventType where + succ EvSyn = EvKey + succ EvKey = EvRel + succ EvRel = EvAbs + succ EvAbs = EvMsc + succ EvMsc = EvSw + succ EvSw = EvLed + succ EvLed = EvSnd + succ EvSnd = EvRep + succ EvRep = EvFf + succ EvFf = EvPwr + succ EvPwr = EvFfStatus + succ EvFfStatus = error "EventType.succ: EvFfStatus has no successor" + + pred EvKey = EvSyn + pred EvRel = EvKey + pred EvAbs = EvRel + pred EvMsc = EvAbs + pred EvSw = EvMsc + pred EvLed = EvSw + pred EvSnd = EvLed + pred EvRep = EvSnd + pred EvFf = EvRep + pred EvPwr = EvFf + pred EvFfStatus = EvPwr + pred EvSyn = error "EventType.pred: EvSyn has no predecessor" + + enumFromTo from to = go from + where + end = fromEnum to + go v = case compare (fromEnum v) end of + LT -> v : go (succ v) + EQ -> [v] + GT -> [] + + enumFrom from = enumFromTo from EvFfStatus + + fromEnum EvSyn = 0 + fromEnum EvKey = 1 + fromEnum EvRel = 2 + fromEnum EvAbs = 3 + fromEnum EvMsc = 4 + fromEnum EvSw = 5 + fromEnum EvLed = 17 + fromEnum EvSnd = 18 + fromEnum EvRep = 20 + fromEnum EvFf = 21 + fromEnum EvPwr = 22 + fromEnum EvFfStatus = 23 + + toEnum 0 = EvSyn + toEnum 1 = EvKey + toEnum 2 = EvRel + toEnum 3 = EvAbs + toEnum 4 = EvMsc + toEnum 5 = EvSw + toEnum 17 = EvLed + toEnum 18 = EvSnd + toEnum 20 = EvRep + toEnum 21 = EvFf + toEnum 22 = EvPwr + toEnum 23 = EvFfStatus + toEnum unmatched = error ("EventType.toEnum: Cannot match " ++ show unmatched) + + + +-- | Synchronization events +data SyncEvent = SynReport + | SynConfig + | SynMtReport + | SynDropped + deriving (Bounded,Eq,Ord,Read,Show) +instance Enum SyncEvent where + succ SynReport = SynConfig + succ SynConfig = SynMtReport + succ SynMtReport = SynDropped + succ SynDropped = error "SyncEvent.succ: SynDropped has no successor" + + pred SynConfig = SynReport + pred SynMtReport = SynConfig + pred SynDropped = SynMtReport + pred SynReport = error "SyncEvent.pred: SynReport has no predecessor" + + enumFromTo from to = go from + where + end = fromEnum to + go v = case compare (fromEnum v) end of + LT -> v : go (succ v) + EQ -> [v] + GT -> [] + + enumFrom from = enumFromTo from SynDropped + + fromEnum SynReport = 0 + fromEnum SynConfig = 1 + fromEnum SynMtReport = 2 + fromEnum SynDropped = 3 + + toEnum 0 = SynReport + toEnum 1 = SynConfig + toEnum 2 = SynMtReport + toEnum 3 = SynDropped + toEnum unmatched = error ("SyncEvent.toEnum: Cannot match " ++ show unmatched) + + + +-- | Keys and buttons +data Key = KeyReserved + | KeyEsc + | Key1 + | Key2 + | Key3 + | Key4 + | Key5 + | Key6 + | Key7 + | Key8 + | Key9 + | Key0 + | KeyMinus + | KeyEqual + | KeyBackspace + | KeyTab + | KeyQ + | KeyW + | KeyE + | KeyR + | KeyT + | KeyY + | KeyU + | KeyI + | KeyO + | KeyP + | KeyLeftbrace + | KeyRightbrace + | KeyEnter + | KeyLeftctrl + | KeyA + | KeyS + | KeyD + | KeyF + | KeyG + | KeyH + | KeyJ + | KeyK + | KeyL + | KeySemicolon + | KeyApostrophe + | KeyGrave + | KeyLeftshift + | KeyBackslash + | KeyZ + | KeyX + | KeyC + | KeyV + | KeyB + | KeyN + | KeyM + | KeyComma + | KeyDot + | KeySlash + | KeyRightshift + | KeyKpasterisk + | KeyLeftalt + | KeySpace + | KeyCapslock + | KeyF1 + | KeyF2 + | KeyF3 + | KeyF4 + | KeyF5 + | KeyF6 + | KeyF7 + | KeyF8 + | KeyF9 + | KeyF10 + | KeyNumlock + | KeyScrolllock + | KeyKp7 + | KeyKp8 + | KeyKp9 + | KeyKpminus + | KeyKp4 + | KeyKp5 + | KeyKp6 + | KeyKpplus + | KeyKp1 + | KeyKp2 + | KeyKp3 + | KeyKp0 + | KeyKpdot + | KeyZenkakuhankaku + | Key102nd + | KeyF11 + | KeyF12 + | KeyRo + | KeyKatakana + | KeyHiragana + | KeyHenkan + | KeyKatakanahiragana + | KeyMuhenkan + | KeyKpjpcomma + | KeyKpenter + | KeyRightctrl + | KeyKpslash + | KeySysrq + | KeyRightalt + | KeyLinefeed + | KeyHome + | KeyUp + | KeyPageup + | KeyLeft + | KeyRight + | KeyEnd + | KeyDown + | KeyPagedown + | KeyInsert + | KeyDelete + | KeyMacro + | KeyMute + | KeyVolumedown + | KeyVolumeup + | KeyPower + | KeyKpequal + | KeyKpplusminus + | KeyPause + | KeyScale + | KeyKpcomma + | KeyHangeul + | KeyHanja + | KeyYen + | KeyLeftmeta + | KeyRightmeta + | KeyCompose + | KeyStop + | KeyAgain + | KeyProps + | KeyUndo + | KeyFront + | KeyCopy + | KeyOpen + | KeyPaste + | KeyFind + | KeyCut + | KeyHelp + | KeyMenu + | KeyCalc + | KeySetup + | KeySleep + | KeyWakeup + | KeyFile + | KeySendfile + | KeyDeletefile + | KeyXfer + | KeyProg1 + | KeyProg2 + | KeyWww + | KeyMsdos + | KeyScreenlock + | KeyRotateDisplay + | KeyCyclewindows + | KeyMail + | KeyBookmarks + | KeyComputer + | KeyBack + | KeyForward + | KeyClosecd + | KeyEjectcd + | KeyEjectclosecd + | KeyNextsong + | KeyPlaypause + | KeyPrevioussong + | KeyStopcd + | KeyRecord + | KeyRewind + | KeyPhone + | KeyIso + | KeyConfig + | KeyHomepage + | KeyRefresh + | KeyExit + | KeyMove + | KeyEdit + | KeyScrollup + | KeyScrolldown + | KeyKpleftparen + | KeyKprightparen + | KeyNew + | KeyRedo + | KeyF13 + | KeyF14 + | KeyF15 + | KeyF16 + | KeyF17 + | KeyF18 + | KeyF19 + | KeyF20 + | KeyF21 + | KeyF22 + | KeyF23 + | KeyF24 + | KeyPlaycd + | KeyPausecd + | KeyProg3 + | KeyProg4 + | KeyDashboard + | KeySuspend + | KeyClose + | KeyPlay + | KeyFastforward + | KeyBassboost + | KeyPrint + | KeyHp + | KeyCamera + | KeySound + | KeyQuestion + | KeyEmail + | KeyChat + | KeySearch + | KeyConnect + | KeyFinance + | KeySport + | KeyShop + | KeyAlterase + | KeyCancel + | KeyBrightnessdown + | KeyBrightnessup + | KeyMedia + | KeySwitchvideomode + | KeyKbdillumtoggle + | KeyKbdillumdown + | KeyKbdillumup + | KeySend + | KeyReply + | KeyForwardmail + | KeySave + | KeyDocuments + | KeyBattery + | KeyBluetooth + | KeyWlan + | KeyUwb + | KeyUnknown + | KeyVideoNext + | KeyVideoPrev + | KeyBrightnessCycle + | KeyBrightnessAuto + | KeyDisplayOff + | KeyWwan + | KeyRfkill + | KeyMicmute + | Btn0 + | Btn1 + | Btn2 + | Btn3 + | Btn4 + | Btn5 + | Btn6 + | Btn7 + | Btn8 + | Btn9 + | BtnLeft + | BtnRight + | BtnMiddle + | BtnSide + | BtnExtra + | BtnForward + | BtnBack + | BtnTask + | BtnJoystick + | BtnThumb + | BtnThumb2 + | BtnTop + | BtnTop2 + | BtnPinkie + | BtnBase + | BtnBase2 + | BtnBase3 + | BtnBase4 + | BtnBase5 + | BtnBase6 + | BtnDead + | BtnA + | BtnB + | BtnC + | BtnX + | BtnY + | BtnZ + | BtnTl + | BtnTr + | BtnTl2 + | BtnTr2 + | BtnSelect + | BtnStart + | BtnMode + | BtnThumbl + | BtnThumbr + | BtnToolPen + | BtnToolRubber + | BtnToolBrush + | BtnToolPencil + | BtnToolAirbrush + | BtnToolFinger + | BtnToolMouse + | BtnToolLens + | BtnToolQuinttap + | BtnTouch + | BtnStylus + | BtnStylus2 + | BtnToolDoubletap + | BtnToolTripletap + | BtnToolQuadtap + | BtnGearDown + | BtnGearUp + | KeyOk + | KeySelect + | KeyGoto + | KeyClear + | KeyPower2 + | KeyOption + | KeyInfo + | KeyTime + | KeyVendor + | KeyArchive + | KeyProgram + | KeyChannel + | KeyFavorites + | KeyEpg + | KeyPvr + | KeyMhp + | KeyLanguage + | KeyTitle + | KeySubtitle + | KeyAngle + | KeyZoom + | KeyMode + | KeyKeyboard + | KeyScreen + | KeyPc + | KeyTv + | KeyTv2 + | KeyVcr + | KeyVcr2 + | KeySat + | KeySat2 + | KeyCd + | KeyTape + | KeyRadio + | KeyTuner + | KeyPlayer + | KeyText + | KeyDvd + | KeyAux + | KeyMp3 + | KeyAudio + | KeyVideo + | KeyDirectory + | KeyList + | KeyMemo + | KeyCalendar + | KeyRed + | KeyGreen + | KeyYellow + | KeyBlue + | KeyChannelup + | KeyChanneldown + | KeyFirst + | KeyLast + | KeyAb + | KeyNext + | KeyRestart + | KeySlow + | KeyShuffle + | KeyBreak + | KeyPrevious + | KeyDigits + | KeyTeen + | KeyTwen + | KeyVideophone + | KeyGames + | KeyZoomin + | KeyZoomout + | KeyZoomreset + | KeyWordprocessor + | KeyEditor + | KeySpreadsheet + | KeyGraphicseditor + | KeyPresentation + | KeyDatabase + | KeyNews + | KeyVoicemail + | KeyAddressbook + | KeyMessenger + | KeyDisplaytoggle + | KeySpellcheck + | KeyLogoff + | KeyDollar + | KeyEuro + | KeyFrameback + | KeyFrameforward + | KeyContextMenu + | KeyMediaRepeat + | Key10channelsup + | Key10channelsdown + | KeyImages + | KeyDelEol + | KeyDelEos + | KeyInsLine + | KeyDelLine + | KeyFn + | KeyFnEsc + | KeyFnF1 + | KeyFnF2 + | KeyFnF3 + | KeyFnF4 + | KeyFnF5 + | KeyFnF6 + | KeyFnF7 + | KeyFnF8 + | KeyFnF9 + | KeyFnF10 + | KeyFnF11 + | KeyFnF12 + | KeyFn1 + | KeyFn2 + | KeyFnD + | KeyFnE + | KeyFnF + | KeyFnS + | KeyFnB + | KeyBrlDot1 + | KeyBrlDot2 + | KeyBrlDot3 + | KeyBrlDot4 + | KeyBrlDot5 + | KeyBrlDot6 + | KeyBrlDot7 + | KeyBrlDot8 + | KeyBrlDot9 + | KeyBrlDot10 + | KeyNumeric0 + | KeyNumeric1 + | KeyNumeric2 + | KeyNumeric3 + | KeyNumeric4 + | KeyNumeric5 + | KeyNumeric6 + | KeyNumeric7 + | KeyNumeric8 + | KeyNumeric9 + | KeyNumericStar + | KeyNumericPound + | KeyNumericA + | KeyNumericB + | KeyNumericC + | KeyNumericD + | KeyCameraFocus + | KeyWpsButton + | KeyTouchpadToggle + | KeyTouchpadOn + | KeyTouchpadOff + | KeyCameraZoomin + | KeyCameraZoomout + | KeyCameraUp + | KeyCameraDown + | KeyCameraLeft + | KeyCameraRight + | KeyAttendantOn + | KeyAttendantOff + | KeyAttendantToggle + | KeyLightsToggle + | BtnDpadUp + | BtnDpadDown + | BtnDpadLeft + | BtnDpadRight + | KeyAlsToggle + | KeyButtonconfig + | KeyTaskmanager + | KeyJournal + | KeyControlpanel + | KeyAppselect + | KeyScreensaver + | KeyVoicecommand + | KeyBrightnessMin + | KeyBrightnessMax + | KeyKbdinputassistPrev + | KeyKbdinputassistNext + | KeyKbdinputassistPrevgroup + | KeyKbdinputassistNextgroup + | KeyKbdinputassistAccept + | KeyKbdinputassistCancel + | BtnTriggerHappy1 + | BtnTriggerHappy2 + | BtnTriggerHappy3 + | BtnTriggerHappy4 + | BtnTriggerHappy5 + | BtnTriggerHappy6 + | BtnTriggerHappy7 + | BtnTriggerHappy8 + | BtnTriggerHappy9 + | BtnTriggerHappy10 + | BtnTriggerHappy11 + | BtnTriggerHappy12 + | BtnTriggerHappy13 + | BtnTriggerHappy14 + | BtnTriggerHappy15 + | BtnTriggerHappy16 + | BtnTriggerHappy17 + | BtnTriggerHappy18 + | BtnTriggerHappy19 + | BtnTriggerHappy20 + | BtnTriggerHappy21 + | BtnTriggerHappy22 + | BtnTriggerHappy23 + | BtnTriggerHappy24 + | BtnTriggerHappy25 + | BtnTriggerHappy26 + | BtnTriggerHappy27 + | BtnTriggerHappy28 + | BtnTriggerHappy29 + | BtnTriggerHappy30 + | BtnTriggerHappy31 + | BtnTriggerHappy32 + | BtnTriggerHappy33 + | BtnTriggerHappy34 + | BtnTriggerHappy35 + | BtnTriggerHappy36 + | BtnTriggerHappy37 + | BtnTriggerHappy38 + | BtnTriggerHappy39 + | BtnTriggerHappy40 + deriving (Bounded,Eq,Ord,Read,Show) +instance Enum Key where + succ KeyReserved = KeyEsc + succ KeyEsc = Key1 + succ Key1 = Key2 + succ Key2 = Key3 + succ Key3 = Key4 + succ Key4 = Key5 + succ Key5 = Key6 + succ Key6 = Key7 + succ Key7 = Key8 + succ Key8 = Key9 + succ Key9 = Key0 + succ Key0 = KeyMinus + succ KeyMinus = KeyEqual + succ KeyEqual = KeyBackspace + succ KeyBackspace = KeyTab + succ KeyTab = KeyQ + succ KeyQ = KeyW + succ KeyW = KeyE + succ KeyE = KeyR + succ KeyR = KeyT + succ KeyT = KeyY + succ KeyY = KeyU + succ KeyU = KeyI + succ KeyI = KeyO + succ KeyO = KeyP + succ KeyP = KeyLeftbrace + succ KeyLeftbrace = KeyRightbrace + succ KeyRightbrace = KeyEnter + succ KeyEnter = KeyLeftctrl + succ KeyLeftctrl = KeyA + succ KeyA = KeyS + succ KeyS = KeyD + succ KeyD = KeyF + succ KeyF = KeyG + succ KeyG = KeyH + succ KeyH = KeyJ + succ KeyJ = KeyK + succ KeyK = KeyL + succ KeyL = KeySemicolon + succ KeySemicolon = KeyApostrophe + succ KeyApostrophe = KeyGrave + succ KeyGrave = KeyLeftshift + succ KeyLeftshift = KeyBackslash + succ KeyBackslash = KeyZ + succ KeyZ = KeyX + succ KeyX = KeyC + succ KeyC = KeyV + succ KeyV = KeyB + succ KeyB = KeyN + succ KeyN = KeyM + succ KeyM = KeyComma + succ KeyComma = KeyDot + succ KeyDot = KeySlash + succ KeySlash = KeyRightshift + succ KeyRightshift = KeyKpasterisk + succ KeyKpasterisk = KeyLeftalt + succ KeyLeftalt = KeySpace + succ KeySpace = KeyCapslock + succ KeyCapslock = KeyF1 + succ KeyF1 = KeyF2 + succ KeyF2 = KeyF3 + succ KeyF3 = KeyF4 + succ KeyF4 = KeyF5 + succ KeyF5 = KeyF6 + succ KeyF6 = KeyF7 + succ KeyF7 = KeyF8 + succ KeyF8 = KeyF9 + succ KeyF9 = KeyF10 + succ KeyF10 = KeyNumlock + succ KeyNumlock = KeyScrolllock + succ KeyScrolllock = KeyKp7 + succ KeyKp7 = KeyKp8 + succ KeyKp8 = KeyKp9 + succ KeyKp9 = KeyKpminus + succ KeyKpminus = KeyKp4 + succ KeyKp4 = KeyKp5 + succ KeyKp5 = KeyKp6 + succ KeyKp6 = KeyKpplus + succ KeyKpplus = KeyKp1 + succ KeyKp1 = KeyKp2 + succ KeyKp2 = KeyKp3 + succ KeyKp3 = KeyKp0 + succ KeyKp0 = KeyKpdot + succ KeyKpdot = KeyZenkakuhankaku + succ KeyZenkakuhankaku = Key102nd + succ Key102nd = KeyF11 + succ KeyF11 = KeyF12 + succ KeyF12 = KeyRo + succ KeyRo = KeyKatakana + succ KeyKatakana = KeyHiragana + succ KeyHiragana = KeyHenkan + succ KeyHenkan = KeyKatakanahiragana + succ KeyKatakanahiragana = KeyMuhenkan + succ KeyMuhenkan = KeyKpjpcomma + succ KeyKpjpcomma = KeyKpenter + succ KeyKpenter = KeyRightctrl + succ KeyRightctrl = KeyKpslash + succ KeyKpslash = KeySysrq + succ KeySysrq = KeyRightalt + succ KeyRightalt = KeyLinefeed + succ KeyLinefeed = KeyHome + succ KeyHome = KeyUp + succ KeyUp = KeyPageup + succ KeyPageup = KeyLeft + succ KeyLeft = KeyRight + succ KeyRight = KeyEnd + succ KeyEnd = KeyDown + succ KeyDown = KeyPagedown + succ KeyPagedown = KeyInsert + succ KeyInsert = KeyDelete + succ KeyDelete = KeyMacro + succ KeyMacro = KeyMute + succ KeyMute = KeyVolumedown + succ KeyVolumedown = KeyVolumeup + succ KeyVolumeup = KeyPower + succ KeyPower = KeyKpequal + succ KeyKpequal = KeyKpplusminus + succ KeyKpplusminus = KeyPause + succ KeyPause = KeyScale + succ KeyScale = KeyKpcomma + succ KeyKpcomma = KeyHangeul + succ KeyHangeul = KeyHanja + succ KeyHanja = KeyYen + succ KeyYen = KeyLeftmeta + succ KeyLeftmeta = KeyRightmeta + succ KeyRightmeta = KeyCompose + succ KeyCompose = KeyStop + succ KeyStop = KeyAgain + succ KeyAgain = KeyProps + succ KeyProps = KeyUndo + succ KeyUndo = KeyFront + succ KeyFront = KeyCopy + succ KeyCopy = KeyOpen + succ KeyOpen = KeyPaste + succ KeyPaste = KeyFind + succ KeyFind = KeyCut + succ KeyCut = KeyHelp + succ KeyHelp = KeyMenu + succ KeyMenu = KeyCalc + succ KeyCalc = KeySetup + succ KeySetup = KeySleep + succ KeySleep = KeyWakeup + succ KeyWakeup = KeyFile + succ KeyFile = KeySendfile + succ KeySendfile = KeyDeletefile + succ KeyDeletefile = KeyXfer + succ KeyXfer = KeyProg1 + succ KeyProg1 = KeyProg2 + succ KeyProg2 = KeyWww + succ KeyWww = KeyMsdos + succ KeyMsdos = KeyScreenlock + succ KeyScreenlock = KeyRotateDisplay + succ KeyRotateDisplay = KeyCyclewindows + succ KeyCyclewindows = KeyMail + succ KeyMail = KeyBookmarks + succ KeyBookmarks = KeyComputer + succ KeyComputer = KeyBack + succ KeyBack = KeyForward + succ KeyForward = KeyClosecd + succ KeyClosecd = KeyEjectcd + succ KeyEjectcd = KeyEjectclosecd + succ KeyEjectclosecd = KeyNextsong + succ KeyNextsong = KeyPlaypause + succ KeyPlaypause = KeyPrevioussong + succ KeyPrevioussong = KeyStopcd + succ KeyStopcd = KeyRecord + succ KeyRecord = KeyRewind + succ KeyRewind = KeyPhone + succ KeyPhone = KeyIso + succ KeyIso = KeyConfig + succ KeyConfig = KeyHomepage + succ KeyHomepage = KeyRefresh + succ KeyRefresh = KeyExit + succ KeyExit = KeyMove + succ KeyMove = KeyEdit + succ KeyEdit = KeyScrollup + succ KeyScrollup = KeyScrolldown + succ KeyScrolldown = KeyKpleftparen + succ KeyKpleftparen = KeyKprightparen + succ KeyKprightparen = KeyNew + succ KeyNew = KeyRedo + succ KeyRedo = KeyF13 + succ KeyF13 = KeyF14 + succ KeyF14 = KeyF15 + succ KeyF15 = KeyF16 + succ KeyF16 = KeyF17 + succ KeyF17 = KeyF18 + succ KeyF18 = KeyF19 + succ KeyF19 = KeyF20 + succ KeyF20 = KeyF21 + succ KeyF21 = KeyF22 + succ KeyF22 = KeyF23 + succ KeyF23 = KeyF24 + succ KeyF24 = KeyPlaycd + succ KeyPlaycd = KeyPausecd + succ KeyPausecd = KeyProg3 + succ KeyProg3 = KeyProg4 + succ KeyProg4 = KeyDashboard + succ KeyDashboard = KeySuspend + succ KeySuspend = KeyClose + succ KeyClose = KeyPlay + succ KeyPlay = KeyFastforward + succ KeyFastforward = KeyBassboost + succ KeyBassboost = KeyPrint + succ KeyPrint = KeyHp + succ KeyHp = KeyCamera + succ KeyCamera = KeySound + succ KeySound = KeyQuestion + succ KeyQuestion = KeyEmail + succ KeyEmail = KeyChat + succ KeyChat = KeySearch + succ KeySearch = KeyConnect + succ KeyConnect = KeyFinance + succ KeyFinance = KeySport + succ KeySport = KeyShop + succ KeyShop = KeyAlterase + succ KeyAlterase = KeyCancel + succ KeyCancel = KeyBrightnessdown + succ KeyBrightnessdown = KeyBrightnessup + succ KeyBrightnessup = KeyMedia + succ KeyMedia = KeySwitchvideomode + succ KeySwitchvideomode = KeyKbdillumtoggle + succ KeyKbdillumtoggle = KeyKbdillumdown + succ KeyKbdillumdown = KeyKbdillumup + succ KeyKbdillumup = KeySend + succ KeySend = KeyReply + succ KeyReply = KeyForwardmail + succ KeyForwardmail = KeySave + succ KeySave = KeyDocuments + succ KeyDocuments = KeyBattery + succ KeyBattery = KeyBluetooth + succ KeyBluetooth = KeyWlan + succ KeyWlan = KeyUwb + succ KeyUwb = KeyUnknown + succ KeyUnknown = KeyVideoNext + succ KeyVideoNext = KeyVideoPrev + succ KeyVideoPrev = KeyBrightnessCycle + succ KeyBrightnessCycle = KeyBrightnessAuto + succ KeyBrightnessAuto = KeyDisplayOff + succ KeyDisplayOff = KeyWwan + succ KeyWwan = KeyRfkill + succ KeyRfkill = KeyMicmute + succ KeyMicmute = Btn0 + succ Btn0 = Btn1 + succ Btn1 = Btn2 + succ Btn2 = Btn3 + succ Btn3 = Btn4 + succ Btn4 = Btn5 + succ Btn5 = Btn6 + succ Btn6 = Btn7 + succ Btn7 = Btn8 + succ Btn8 = Btn9 + succ Btn9 = BtnLeft + succ BtnLeft = BtnRight + succ BtnRight = BtnMiddle + succ BtnMiddle = BtnSide + succ BtnSide = BtnExtra + succ BtnExtra = BtnForward + succ BtnForward = BtnBack + succ BtnBack = BtnTask + succ BtnTask = BtnJoystick + succ BtnJoystick = BtnThumb + succ BtnThumb = BtnThumb2 + succ BtnThumb2 = BtnTop + succ BtnTop = BtnTop2 + succ BtnTop2 = BtnPinkie + succ BtnPinkie = BtnBase + succ BtnBase = BtnBase2 + succ BtnBase2 = BtnBase3 + succ BtnBase3 = BtnBase4 + succ BtnBase4 = BtnBase5 + succ BtnBase5 = BtnBase6 + succ BtnBase6 = BtnDead + succ BtnDead = BtnA + succ BtnA = BtnB + succ BtnB = BtnC + succ BtnC = BtnX + succ BtnX = BtnY + succ BtnY = BtnZ + succ BtnZ = BtnTl + succ BtnTl = BtnTr + succ BtnTr = BtnTl2 + succ BtnTl2 = BtnTr2 + succ BtnTr2 = BtnSelect + succ BtnSelect = BtnStart + succ BtnStart = BtnMode + succ BtnMode = BtnThumbl + succ BtnThumbl = BtnThumbr + succ BtnThumbr = BtnToolPen + succ BtnToolPen = BtnToolRubber + succ BtnToolRubber = BtnToolBrush + succ BtnToolBrush = BtnToolPencil + succ BtnToolPencil = BtnToolAirbrush + succ BtnToolAirbrush = BtnToolFinger + succ BtnToolFinger = BtnToolMouse + succ BtnToolMouse = BtnToolLens + succ BtnToolLens = BtnToolQuinttap + succ BtnToolQuinttap = BtnTouch + succ BtnTouch = BtnStylus + succ BtnStylus = BtnStylus2 + succ BtnStylus2 = BtnToolDoubletap + succ BtnToolDoubletap = BtnToolTripletap + succ BtnToolTripletap = BtnToolQuadtap + succ BtnToolQuadtap = BtnGearDown + succ BtnGearDown = BtnGearUp + succ BtnGearUp = KeyOk + succ KeyOk = KeySelect + succ KeySelect = KeyGoto + succ KeyGoto = KeyClear + succ KeyClear = KeyPower2 + succ KeyPower2 = KeyOption + succ KeyOption = KeyInfo + succ KeyInfo = KeyTime + succ KeyTime = KeyVendor + succ KeyVendor = KeyArchive + succ KeyArchive = KeyProgram + succ KeyProgram = KeyChannel + succ KeyChannel = KeyFavorites + succ KeyFavorites = KeyEpg + succ KeyEpg = KeyPvr + succ KeyPvr = KeyMhp + succ KeyMhp = KeyLanguage + succ KeyLanguage = KeyTitle + succ KeyTitle = KeySubtitle + succ KeySubtitle = KeyAngle + succ KeyAngle = KeyZoom + succ KeyZoom = KeyMode + succ KeyMode = KeyKeyboard + succ KeyKeyboard = KeyScreen + succ KeyScreen = KeyPc + succ KeyPc = KeyTv + succ KeyTv = KeyTv2 + succ KeyTv2 = KeyVcr + succ KeyVcr = KeyVcr2 + succ KeyVcr2 = KeySat + succ KeySat = KeySat2 + succ KeySat2 = KeyCd + succ KeyCd = KeyTape + succ KeyTape = KeyRadio + succ KeyRadio = KeyTuner + succ KeyTuner = KeyPlayer + succ KeyPlayer = KeyText + succ KeyText = KeyDvd + succ KeyDvd = KeyAux + succ KeyAux = KeyMp3 + succ KeyMp3 = KeyAudio + succ KeyAudio = KeyVideo + succ KeyVideo = KeyDirectory + succ KeyDirectory = KeyList + succ KeyList = KeyMemo + succ KeyMemo = KeyCalendar + succ KeyCalendar = KeyRed + succ KeyRed = KeyGreen + succ KeyGreen = KeyYellow + succ KeyYellow = KeyBlue + succ KeyBlue = KeyChannelup + succ KeyChannelup = KeyChanneldown + succ KeyChanneldown = KeyFirst + succ KeyFirst = KeyLast + succ KeyLast = KeyAb + succ KeyAb = KeyNext + succ KeyNext = KeyRestart + succ KeyRestart = KeySlow + succ KeySlow = KeyShuffle + succ KeyShuffle = KeyBreak + succ KeyBreak = KeyPrevious + succ KeyPrevious = KeyDigits + succ KeyDigits = KeyTeen + succ KeyTeen = KeyTwen + succ KeyTwen = KeyVideophone + succ KeyVideophone = KeyGames + succ KeyGames = KeyZoomin + succ KeyZoomin = KeyZoomout + succ KeyZoomout = KeyZoomreset + succ KeyZoomreset = KeyWordprocessor + succ KeyWordprocessor = KeyEditor + succ KeyEditor = KeySpreadsheet + succ KeySpreadsheet = KeyGraphicseditor + succ KeyGraphicseditor = KeyPresentation + succ KeyPresentation = KeyDatabase + succ KeyDatabase = KeyNews + succ KeyNews = KeyVoicemail + succ KeyVoicemail = KeyAddressbook + succ KeyAddressbook = KeyMessenger + succ KeyMessenger = KeyDisplaytoggle + succ KeyDisplaytoggle = KeySpellcheck + succ KeySpellcheck = KeyLogoff + succ KeyLogoff = KeyDollar + succ KeyDollar = KeyEuro + succ KeyEuro = KeyFrameback + succ KeyFrameback = KeyFrameforward + succ KeyFrameforward = KeyContextMenu + succ KeyContextMenu = KeyMediaRepeat + succ KeyMediaRepeat = Key10channelsup + succ Key10channelsup = Key10channelsdown + succ Key10channelsdown = KeyImages + succ KeyImages = KeyDelEol + succ KeyDelEol = KeyDelEos + succ KeyDelEos = KeyInsLine + succ KeyInsLine = KeyDelLine + succ KeyDelLine = KeyFn + succ KeyFn = KeyFnEsc + succ KeyFnEsc = KeyFnF1 + succ KeyFnF1 = KeyFnF2 + succ KeyFnF2 = KeyFnF3 + succ KeyFnF3 = KeyFnF4 + succ KeyFnF4 = KeyFnF5 + succ KeyFnF5 = KeyFnF6 + succ KeyFnF6 = KeyFnF7 + succ KeyFnF7 = KeyFnF8 + succ KeyFnF8 = KeyFnF9 + succ KeyFnF9 = KeyFnF10 + succ KeyFnF10 = KeyFnF11 + succ KeyFnF11 = KeyFnF12 + succ KeyFnF12 = KeyFn1 + succ KeyFn1 = KeyFn2 + succ KeyFn2 = KeyFnD + succ KeyFnD = KeyFnE + succ KeyFnE = KeyFnF + succ KeyFnF = KeyFnS + succ KeyFnS = KeyFnB + succ KeyFnB = KeyBrlDot1 + succ KeyBrlDot1 = KeyBrlDot2 + succ KeyBrlDot2 = KeyBrlDot3 + succ KeyBrlDot3 = KeyBrlDot4 + succ KeyBrlDot4 = KeyBrlDot5 + succ KeyBrlDot5 = KeyBrlDot6 + succ KeyBrlDot6 = KeyBrlDot7 + succ KeyBrlDot7 = KeyBrlDot8 + succ KeyBrlDot8 = KeyBrlDot9 + succ KeyBrlDot9 = KeyBrlDot10 + succ KeyBrlDot10 = KeyNumeric0 + succ KeyNumeric0 = KeyNumeric1 + succ KeyNumeric1 = KeyNumeric2 + succ KeyNumeric2 = KeyNumeric3 + succ KeyNumeric3 = KeyNumeric4 + succ KeyNumeric4 = KeyNumeric5 + succ KeyNumeric5 = KeyNumeric6 + succ KeyNumeric6 = KeyNumeric7 + succ KeyNumeric7 = KeyNumeric8 + succ KeyNumeric8 = KeyNumeric9 + succ KeyNumeric9 = KeyNumericStar + succ KeyNumericStar = KeyNumericPound + succ KeyNumericPound = KeyNumericA + succ KeyNumericA = KeyNumericB + succ KeyNumericB = KeyNumericC + succ KeyNumericC = KeyNumericD + succ KeyNumericD = KeyCameraFocus + succ KeyCameraFocus = KeyWpsButton + succ KeyWpsButton = KeyTouchpadToggle + succ KeyTouchpadToggle = KeyTouchpadOn + succ KeyTouchpadOn = KeyTouchpadOff + succ KeyTouchpadOff = KeyCameraZoomin + succ KeyCameraZoomin = KeyCameraZoomout + succ KeyCameraZoomout = KeyCameraUp + succ KeyCameraUp = KeyCameraDown + succ KeyCameraDown = KeyCameraLeft + succ KeyCameraLeft = KeyCameraRight + succ KeyCameraRight = KeyAttendantOn + succ KeyAttendantOn = KeyAttendantOff + succ KeyAttendantOff = KeyAttendantToggle + succ KeyAttendantToggle = KeyLightsToggle + succ KeyLightsToggle = BtnDpadUp + succ BtnDpadUp = BtnDpadDown + succ BtnDpadDown = BtnDpadLeft + succ BtnDpadLeft = BtnDpadRight + succ BtnDpadRight = KeyAlsToggle + succ KeyAlsToggle = KeyButtonconfig + succ KeyButtonconfig = KeyTaskmanager + succ KeyTaskmanager = KeyJournal + succ KeyJournal = KeyControlpanel + succ KeyControlpanel = KeyAppselect + succ KeyAppselect = KeyScreensaver + succ KeyScreensaver = KeyVoicecommand + succ KeyVoicecommand = KeyBrightnessMin + succ KeyBrightnessMin = KeyBrightnessMax + succ KeyBrightnessMax = KeyKbdinputassistPrev + succ KeyKbdinputassistPrev = KeyKbdinputassistNext + succ KeyKbdinputassistNext = KeyKbdinputassistPrevgroup + succ KeyKbdinputassistPrevgroup = KeyKbdinputassistNextgroup + succ KeyKbdinputassistNextgroup = KeyKbdinputassistAccept + succ KeyKbdinputassistAccept = KeyKbdinputassistCancel + succ KeyKbdinputassistCancel = BtnTriggerHappy1 + succ BtnTriggerHappy1 = BtnTriggerHappy2 + succ BtnTriggerHappy2 = BtnTriggerHappy3 + succ BtnTriggerHappy3 = BtnTriggerHappy4 + succ BtnTriggerHappy4 = BtnTriggerHappy5 + succ BtnTriggerHappy5 = BtnTriggerHappy6 + succ BtnTriggerHappy6 = BtnTriggerHappy7 + succ BtnTriggerHappy7 = BtnTriggerHappy8 + succ BtnTriggerHappy8 = BtnTriggerHappy9 + succ BtnTriggerHappy9 = BtnTriggerHappy10 + succ BtnTriggerHappy10 = BtnTriggerHappy11 + succ BtnTriggerHappy11 = BtnTriggerHappy12 + succ BtnTriggerHappy12 = BtnTriggerHappy13 + succ BtnTriggerHappy13 = BtnTriggerHappy14 + succ BtnTriggerHappy14 = BtnTriggerHappy15 + succ BtnTriggerHappy15 = BtnTriggerHappy16 + succ BtnTriggerHappy16 = BtnTriggerHappy17 + succ BtnTriggerHappy17 = BtnTriggerHappy18 + succ BtnTriggerHappy18 = BtnTriggerHappy19 + succ BtnTriggerHappy19 = BtnTriggerHappy20 + succ BtnTriggerHappy20 = BtnTriggerHappy21 + succ BtnTriggerHappy21 = BtnTriggerHappy22 + succ BtnTriggerHappy22 = BtnTriggerHappy23 + succ BtnTriggerHappy23 = BtnTriggerHappy24 + succ BtnTriggerHappy24 = BtnTriggerHappy25 + succ BtnTriggerHappy25 = BtnTriggerHappy26 + succ BtnTriggerHappy26 = BtnTriggerHappy27 + succ BtnTriggerHappy27 = BtnTriggerHappy28 + succ BtnTriggerHappy28 = BtnTriggerHappy29 + succ BtnTriggerHappy29 = BtnTriggerHappy30 + succ BtnTriggerHappy30 = BtnTriggerHappy31 + succ BtnTriggerHappy31 = BtnTriggerHappy32 + succ BtnTriggerHappy32 = BtnTriggerHappy33 + succ BtnTriggerHappy33 = BtnTriggerHappy34 + succ BtnTriggerHappy34 = BtnTriggerHappy35 + succ BtnTriggerHappy35 = BtnTriggerHappy36 + succ BtnTriggerHappy36 = BtnTriggerHappy37 + succ BtnTriggerHappy37 = BtnTriggerHappy38 + succ BtnTriggerHappy38 = BtnTriggerHappy39 + succ BtnTriggerHappy39 = BtnTriggerHappy40 + succ BtnTriggerHappy40 = error "Key.succ: BtnTriggerHappy40 has no successor" + + pred KeyEsc = KeyReserved + pred Key1 = KeyEsc + pred Key2 = Key1 + pred Key3 = Key2 + pred Key4 = Key3 + pred Key5 = Key4 + pred Key6 = Key5 + pred Key7 = Key6 + pred Key8 = Key7 + pred Key9 = Key8 + pred Key0 = Key9 + pred KeyMinus = Key0 + pred KeyEqual = KeyMinus + pred KeyBackspace = KeyEqual + pred KeyTab = KeyBackspace + pred KeyQ = KeyTab + pred KeyW = KeyQ + pred KeyE = KeyW + pred KeyR = KeyE + pred KeyT = KeyR + pred KeyY = KeyT + pred KeyU = KeyY + pred KeyI = KeyU + pred KeyO = KeyI + pred KeyP = KeyO + pred KeyLeftbrace = KeyP + pred KeyRightbrace = KeyLeftbrace + pred KeyEnter = KeyRightbrace + pred KeyLeftctrl = KeyEnter + pred KeyA = KeyLeftctrl + pred KeyS = KeyA + pred KeyD = KeyS + pred KeyF = KeyD + pred KeyG = KeyF + pred KeyH = KeyG + pred KeyJ = KeyH + pred KeyK = KeyJ + pred KeyL = KeyK + pred KeySemicolon = KeyL + pred KeyApostrophe = KeySemicolon + pred KeyGrave = KeyApostrophe + pred KeyLeftshift = KeyGrave + pred KeyBackslash = KeyLeftshift + pred KeyZ = KeyBackslash + pred KeyX = KeyZ + pred KeyC = KeyX + pred KeyV = KeyC + pred KeyB = KeyV + pred KeyN = KeyB + pred KeyM = KeyN + pred KeyComma = KeyM + pred KeyDot = KeyComma + pred KeySlash = KeyDot + pred KeyRightshift = KeySlash + pred KeyKpasterisk = KeyRightshift + pred KeyLeftalt = KeyKpasterisk + pred KeySpace = KeyLeftalt + pred KeyCapslock = KeySpace + pred KeyF1 = KeyCapslock + pred KeyF2 = KeyF1 + pred KeyF3 = KeyF2 + pred KeyF4 = KeyF3 + pred KeyF5 = KeyF4 + pred KeyF6 = KeyF5 + pred KeyF7 = KeyF6 + pred KeyF8 = KeyF7 + pred KeyF9 = KeyF8 + pred KeyF10 = KeyF9 + pred KeyNumlock = KeyF10 + pred KeyScrolllock = KeyNumlock + pred KeyKp7 = KeyScrolllock + pred KeyKp8 = KeyKp7 + pred KeyKp9 = KeyKp8 + pred KeyKpminus = KeyKp9 + pred KeyKp4 = KeyKpminus + pred KeyKp5 = KeyKp4 + pred KeyKp6 = KeyKp5 + pred KeyKpplus = KeyKp6 + pred KeyKp1 = KeyKpplus + pred KeyKp2 = KeyKp1 + pred KeyKp3 = KeyKp2 + pred KeyKp0 = KeyKp3 + pred KeyKpdot = KeyKp0 + pred KeyZenkakuhankaku = KeyKpdot + pred Key102nd = KeyZenkakuhankaku + pred KeyF11 = Key102nd + pred KeyF12 = KeyF11 + pred KeyRo = KeyF12 + pred KeyKatakana = KeyRo + pred KeyHiragana = KeyKatakana + pred KeyHenkan = KeyHiragana + pred KeyKatakanahiragana = KeyHenkan + pred KeyMuhenkan = KeyKatakanahiragana + pred KeyKpjpcomma = KeyMuhenkan + pred KeyKpenter = KeyKpjpcomma + pred KeyRightctrl = KeyKpenter + pred KeyKpslash = KeyRightctrl + pred KeySysrq = KeyKpslash + pred KeyRightalt = KeySysrq + pred KeyLinefeed = KeyRightalt + pred KeyHome = KeyLinefeed + pred KeyUp = KeyHome + pred KeyPageup = KeyUp + pred KeyLeft = KeyPageup + pred KeyRight = KeyLeft + pred KeyEnd = KeyRight + pred KeyDown = KeyEnd + pred KeyPagedown = KeyDown + pred KeyInsert = KeyPagedown + pred KeyDelete = KeyInsert + pred KeyMacro = KeyDelete + pred KeyMute = KeyMacro + pred KeyVolumedown = KeyMute + pred KeyVolumeup = KeyVolumedown + pred KeyPower = KeyVolumeup + pred KeyKpequal = KeyPower + pred KeyKpplusminus = KeyKpequal + pred KeyPause = KeyKpplusminus + pred KeyScale = KeyPause + pred KeyKpcomma = KeyScale + pred KeyHangeul = KeyKpcomma + pred KeyHanja = KeyHangeul + pred KeyYen = KeyHanja + pred KeyLeftmeta = KeyYen + pred KeyRightmeta = KeyLeftmeta + pred KeyCompose = KeyRightmeta + pred KeyStop = KeyCompose + pred KeyAgain = KeyStop + pred KeyProps = KeyAgain + pred KeyUndo = KeyProps + pred KeyFront = KeyUndo + pred KeyCopy = KeyFront + pred KeyOpen = KeyCopy + pred KeyPaste = KeyOpen + pred KeyFind = KeyPaste + pred KeyCut = KeyFind + pred KeyHelp = KeyCut + pred KeyMenu = KeyHelp + pred KeyCalc = KeyMenu + pred KeySetup = KeyCalc + pred KeySleep = KeySetup + pred KeyWakeup = KeySleep + pred KeyFile = KeyWakeup + pred KeySendfile = KeyFile + pred KeyDeletefile = KeySendfile + pred KeyXfer = KeyDeletefile + pred KeyProg1 = KeyXfer + pred KeyProg2 = KeyProg1 + pred KeyWww = KeyProg2 + pred KeyMsdos = KeyWww + pred KeyScreenlock = KeyMsdos + pred KeyRotateDisplay = KeyScreenlock + pred KeyCyclewindows = KeyRotateDisplay + pred KeyMail = KeyCyclewindows + pred KeyBookmarks = KeyMail + pred KeyComputer = KeyBookmarks + pred KeyBack = KeyComputer + pred KeyForward = KeyBack + pred KeyClosecd = KeyForward + pred KeyEjectcd = KeyClosecd + pred KeyEjectclosecd = KeyEjectcd + pred KeyNextsong = KeyEjectclosecd + pred KeyPlaypause = KeyNextsong + pred KeyPrevioussong = KeyPlaypause + pred KeyStopcd = KeyPrevioussong + pred KeyRecord = KeyStopcd + pred KeyRewind = KeyRecord + pred KeyPhone = KeyRewind + pred KeyIso = KeyPhone + pred KeyConfig = KeyIso + pred KeyHomepage = KeyConfig + pred KeyRefresh = KeyHomepage + pred KeyExit = KeyRefresh + pred KeyMove = KeyExit + pred KeyEdit = KeyMove + pred KeyScrollup = KeyEdit + pred KeyScrolldown = KeyScrollup + pred KeyKpleftparen = KeyScrolldown + pred KeyKprightparen = KeyKpleftparen + pred KeyNew = KeyKprightparen + pred KeyRedo = KeyNew + pred KeyF13 = KeyRedo + pred KeyF14 = KeyF13 + pred KeyF15 = KeyF14 + pred KeyF16 = KeyF15 + pred KeyF17 = KeyF16 + pred KeyF18 = KeyF17 + pred KeyF19 = KeyF18 + pred KeyF20 = KeyF19 + pred KeyF21 = KeyF20 + pred KeyF22 = KeyF21 + pred KeyF23 = KeyF22 + pred KeyF24 = KeyF23 + pred KeyPlaycd = KeyF24 + pred KeyPausecd = KeyPlaycd + pred KeyProg3 = KeyPausecd + pred KeyProg4 = KeyProg3 + pred KeyDashboard = KeyProg4 + pred KeySuspend = KeyDashboard + pred KeyClose = KeySuspend + pred KeyPlay = KeyClose + pred KeyFastforward = KeyPlay + pred KeyBassboost = KeyFastforward + pred KeyPrint = KeyBassboost + pred KeyHp = KeyPrint + pred KeyCamera = KeyHp + pred KeySound = KeyCamera + pred KeyQuestion = KeySound + pred KeyEmail = KeyQuestion + pred KeyChat = KeyEmail + pred KeySearch = KeyChat + pred KeyConnect = KeySearch + pred KeyFinance = KeyConnect + pred KeySport = KeyFinance + pred KeyShop = KeySport + pred KeyAlterase = KeyShop + pred KeyCancel = KeyAlterase + pred KeyBrightnessdown = KeyCancel + pred KeyBrightnessup = KeyBrightnessdown + pred KeyMedia = KeyBrightnessup + pred KeySwitchvideomode = KeyMedia + pred KeyKbdillumtoggle = KeySwitchvideomode + pred KeyKbdillumdown = KeyKbdillumtoggle + pred KeyKbdillumup = KeyKbdillumdown + pred KeySend = KeyKbdillumup + pred KeyReply = KeySend + pred KeyForwardmail = KeyReply + pred KeySave = KeyForwardmail + pred KeyDocuments = KeySave + pred KeyBattery = KeyDocuments + pred KeyBluetooth = KeyBattery + pred KeyWlan = KeyBluetooth + pred KeyUwb = KeyWlan + pred KeyUnknown = KeyUwb + pred KeyVideoNext = KeyUnknown + pred KeyVideoPrev = KeyVideoNext + pred KeyBrightnessCycle = KeyVideoPrev + pred KeyBrightnessAuto = KeyBrightnessCycle + pred KeyDisplayOff = KeyBrightnessAuto + pred KeyWwan = KeyDisplayOff + pred KeyRfkill = KeyWwan + pred KeyMicmute = KeyRfkill + pred Btn0 = KeyMicmute + pred Btn1 = Btn0 + pred Btn2 = Btn1 + pred Btn3 = Btn2 + pred Btn4 = Btn3 + pred Btn5 = Btn4 + pred Btn6 = Btn5 + pred Btn7 = Btn6 + pred Btn8 = Btn7 + pred Btn9 = Btn8 + pred BtnLeft = Btn9 + pred BtnRight = BtnLeft + pred BtnMiddle = BtnRight + pred BtnSide = BtnMiddle + pred BtnExtra = BtnSide + pred BtnForward = BtnExtra + pred BtnBack = BtnForward + pred BtnTask = BtnBack + pred BtnJoystick = BtnTask + pred BtnThumb = BtnJoystick + pred BtnThumb2 = BtnThumb + pred BtnTop = BtnThumb2 + pred BtnTop2 = BtnTop + pred BtnPinkie = BtnTop2 + pred BtnBase = BtnPinkie + pred BtnBase2 = BtnBase + pred BtnBase3 = BtnBase2 + pred BtnBase4 = BtnBase3 + pred BtnBase5 = BtnBase4 + pred BtnBase6 = BtnBase5 + pred BtnDead = BtnBase6 + pred BtnA = BtnDead + pred BtnB = BtnA + pred BtnC = BtnB + pred BtnX = BtnC + pred BtnY = BtnX + pred BtnZ = BtnY + pred BtnTl = BtnZ + pred BtnTr = BtnTl + pred BtnTl2 = BtnTr + pred BtnTr2 = BtnTl2 + pred BtnSelect = BtnTr2 + pred BtnStart = BtnSelect + pred BtnMode = BtnStart + pred BtnThumbl = BtnMode + pred BtnThumbr = BtnThumbl + pred BtnToolPen = BtnThumbr + pred BtnToolRubber = BtnToolPen + pred BtnToolBrush = BtnToolRubber + pred BtnToolPencil = BtnToolBrush + pred BtnToolAirbrush = BtnToolPencil + pred BtnToolFinger = BtnToolAirbrush + pred BtnToolMouse = BtnToolFinger + pred BtnToolLens = BtnToolMouse + pred BtnToolQuinttap = BtnToolLens + pred BtnTouch = BtnToolQuinttap + pred BtnStylus = BtnTouch + pred BtnStylus2 = BtnStylus + pred BtnToolDoubletap = BtnStylus2 + pred BtnToolTripletap = BtnToolDoubletap + pred BtnToolQuadtap = BtnToolTripletap + pred BtnGearDown = BtnToolQuadtap + pred BtnGearUp = BtnGearDown + pred KeyOk = BtnGearUp + pred KeySelect = KeyOk + pred KeyGoto = KeySelect + pred KeyClear = KeyGoto + pred KeyPower2 = KeyClear + pred KeyOption = KeyPower2 + pred KeyInfo = KeyOption + pred KeyTime = KeyInfo + pred KeyVendor = KeyTime + pred KeyArchive = KeyVendor + pred KeyProgram = KeyArchive + pred KeyChannel = KeyProgram + pred KeyFavorites = KeyChannel + pred KeyEpg = KeyFavorites + pred KeyPvr = KeyEpg + pred KeyMhp = KeyPvr + pred KeyLanguage = KeyMhp + pred KeyTitle = KeyLanguage + pred KeySubtitle = KeyTitle + pred KeyAngle = KeySubtitle + pred KeyZoom = KeyAngle + pred KeyMode = KeyZoom + pred KeyKeyboard = KeyMode + pred KeyScreen = KeyKeyboard + pred KeyPc = KeyScreen + pred KeyTv = KeyPc + pred KeyTv2 = KeyTv + pred KeyVcr = KeyTv2 + pred KeyVcr2 = KeyVcr + pred KeySat = KeyVcr2 + pred KeySat2 = KeySat + pred KeyCd = KeySat2 + pred KeyTape = KeyCd + pred KeyRadio = KeyTape + pred KeyTuner = KeyRadio + pred KeyPlayer = KeyTuner + pred KeyText = KeyPlayer + pred KeyDvd = KeyText + pred KeyAux = KeyDvd + pred KeyMp3 = KeyAux + pred KeyAudio = KeyMp3 + pred KeyVideo = KeyAudio + pred KeyDirectory = KeyVideo + pred KeyList = KeyDirectory + pred KeyMemo = KeyList + pred KeyCalendar = KeyMemo + pred KeyRed = KeyCalendar + pred KeyGreen = KeyRed + pred KeyYellow = KeyGreen + pred KeyBlue = KeyYellow + pred KeyChannelup = KeyBlue + pred KeyChanneldown = KeyChannelup + pred KeyFirst = KeyChanneldown + pred KeyLast = KeyFirst + pred KeyAb = KeyLast + pred KeyNext = KeyAb + pred KeyRestart = KeyNext + pred KeySlow = KeyRestart + pred KeyShuffle = KeySlow + pred KeyBreak = KeyShuffle + pred KeyPrevious = KeyBreak + pred KeyDigits = KeyPrevious + pred KeyTeen = KeyDigits + pred KeyTwen = KeyTeen + pred KeyVideophone = KeyTwen + pred KeyGames = KeyVideophone + pred KeyZoomin = KeyGames + pred KeyZoomout = KeyZoomin + pred KeyZoomreset = KeyZoomout + pred KeyWordprocessor = KeyZoomreset + pred KeyEditor = KeyWordprocessor + pred KeySpreadsheet = KeyEditor + pred KeyGraphicseditor = KeySpreadsheet + pred KeyPresentation = KeyGraphicseditor + pred KeyDatabase = KeyPresentation + pred KeyNews = KeyDatabase + pred KeyVoicemail = KeyNews + pred KeyAddressbook = KeyVoicemail + pred KeyMessenger = KeyAddressbook + pred KeyDisplaytoggle = KeyMessenger + pred KeySpellcheck = KeyDisplaytoggle + pred KeyLogoff = KeySpellcheck + pred KeyDollar = KeyLogoff + pred KeyEuro = KeyDollar + pred KeyFrameback = KeyEuro + pred KeyFrameforward = KeyFrameback + pred KeyContextMenu = KeyFrameforward + pred KeyMediaRepeat = KeyContextMenu + pred Key10channelsup = KeyMediaRepeat + pred Key10channelsdown = Key10channelsup + pred KeyImages = Key10channelsdown + pred KeyDelEol = KeyImages + pred KeyDelEos = KeyDelEol + pred KeyInsLine = KeyDelEos + pred KeyDelLine = KeyInsLine + pred KeyFn = KeyDelLine + pred KeyFnEsc = KeyFn + pred KeyFnF1 = KeyFnEsc + pred KeyFnF2 = KeyFnF1 + pred KeyFnF3 = KeyFnF2 + pred KeyFnF4 = KeyFnF3 + pred KeyFnF5 = KeyFnF4 + pred KeyFnF6 = KeyFnF5 + pred KeyFnF7 = KeyFnF6 + pred KeyFnF8 = KeyFnF7 + pred KeyFnF9 = KeyFnF8 + pred KeyFnF10 = KeyFnF9 + pred KeyFnF11 = KeyFnF10 + pred KeyFnF12 = KeyFnF11 + pred KeyFn1 = KeyFnF12 + pred KeyFn2 = KeyFn1 + pred KeyFnD = KeyFn2 + pred KeyFnE = KeyFnD + pred KeyFnF = KeyFnE + pred KeyFnS = KeyFnF + pred KeyFnB = KeyFnS + pred KeyBrlDot1 = KeyFnB + pred KeyBrlDot2 = KeyBrlDot1 + pred KeyBrlDot3 = KeyBrlDot2 + pred KeyBrlDot4 = KeyBrlDot3 + pred KeyBrlDot5 = KeyBrlDot4 + pred KeyBrlDot6 = KeyBrlDot5 + pred KeyBrlDot7 = KeyBrlDot6 + pred KeyBrlDot8 = KeyBrlDot7 + pred KeyBrlDot9 = KeyBrlDot8 + pred KeyBrlDot10 = KeyBrlDot9 + pred KeyNumeric0 = KeyBrlDot10 + pred KeyNumeric1 = KeyNumeric0 + pred KeyNumeric2 = KeyNumeric1 + pred KeyNumeric3 = KeyNumeric2 + pred KeyNumeric4 = KeyNumeric3 + pred KeyNumeric5 = KeyNumeric4 + pred KeyNumeric6 = KeyNumeric5 + pred KeyNumeric7 = KeyNumeric6 + pred KeyNumeric8 = KeyNumeric7 + pred KeyNumeric9 = KeyNumeric8 + pred KeyNumericStar = KeyNumeric9 + pred KeyNumericPound = KeyNumericStar + pred KeyNumericA = KeyNumericPound + pred KeyNumericB = KeyNumericA + pred KeyNumericC = KeyNumericB + pred KeyNumericD = KeyNumericC + pred KeyCameraFocus = KeyNumericD + pred KeyWpsButton = KeyCameraFocus + pred KeyTouchpadToggle = KeyWpsButton + pred KeyTouchpadOn = KeyTouchpadToggle + pred KeyTouchpadOff = KeyTouchpadOn + pred KeyCameraZoomin = KeyTouchpadOff + pred KeyCameraZoomout = KeyCameraZoomin + pred KeyCameraUp = KeyCameraZoomout + pred KeyCameraDown = KeyCameraUp + pred KeyCameraLeft = KeyCameraDown + pred KeyCameraRight = KeyCameraLeft + pred KeyAttendantOn = KeyCameraRight + pred KeyAttendantOff = KeyAttendantOn + pred KeyAttendantToggle = KeyAttendantOff + pred KeyLightsToggle = KeyAttendantToggle + pred BtnDpadUp = KeyLightsToggle + pred BtnDpadDown = BtnDpadUp + pred BtnDpadLeft = BtnDpadDown + pred BtnDpadRight = BtnDpadLeft + pred KeyAlsToggle = BtnDpadRight + pred KeyButtonconfig = KeyAlsToggle + pred KeyTaskmanager = KeyButtonconfig + pred KeyJournal = KeyTaskmanager + pred KeyControlpanel = KeyJournal + pred KeyAppselect = KeyControlpanel + pred KeyScreensaver = KeyAppselect + pred KeyVoicecommand = KeyScreensaver + pred KeyBrightnessMin = KeyVoicecommand + pred KeyBrightnessMax = KeyBrightnessMin + pred KeyKbdinputassistPrev = KeyBrightnessMax + pred KeyKbdinputassistNext = KeyKbdinputassistPrev + pred KeyKbdinputassistPrevgroup = KeyKbdinputassistNext + pred KeyKbdinputassistNextgroup = KeyKbdinputassistPrevgroup + pred KeyKbdinputassistAccept = KeyKbdinputassistNextgroup + pred KeyKbdinputassistCancel = KeyKbdinputassistAccept + pred BtnTriggerHappy1 = KeyKbdinputassistCancel + pred BtnTriggerHappy2 = BtnTriggerHappy1 + pred BtnTriggerHappy3 = BtnTriggerHappy2 + pred BtnTriggerHappy4 = BtnTriggerHappy3 + pred BtnTriggerHappy5 = BtnTriggerHappy4 + pred BtnTriggerHappy6 = BtnTriggerHappy5 + pred BtnTriggerHappy7 = BtnTriggerHappy6 + pred BtnTriggerHappy8 = BtnTriggerHappy7 + pred BtnTriggerHappy9 = BtnTriggerHappy8 + pred BtnTriggerHappy10 = BtnTriggerHappy9 + pred BtnTriggerHappy11 = BtnTriggerHappy10 + pred BtnTriggerHappy12 = BtnTriggerHappy11 + pred BtnTriggerHappy13 = BtnTriggerHappy12 + pred BtnTriggerHappy14 = BtnTriggerHappy13 + pred BtnTriggerHappy15 = BtnTriggerHappy14 + pred BtnTriggerHappy16 = BtnTriggerHappy15 + pred BtnTriggerHappy17 = BtnTriggerHappy16 + pred BtnTriggerHappy18 = BtnTriggerHappy17 + pred BtnTriggerHappy19 = BtnTriggerHappy18 + pred BtnTriggerHappy20 = BtnTriggerHappy19 + pred BtnTriggerHappy21 = BtnTriggerHappy20 + pred BtnTriggerHappy22 = BtnTriggerHappy21 + pred BtnTriggerHappy23 = BtnTriggerHappy22 + pred BtnTriggerHappy24 = BtnTriggerHappy23 + pred BtnTriggerHappy25 = BtnTriggerHappy24 + pred BtnTriggerHappy26 = BtnTriggerHappy25 + pred BtnTriggerHappy27 = BtnTriggerHappy26 + pred BtnTriggerHappy28 = BtnTriggerHappy27 + pred BtnTriggerHappy29 = BtnTriggerHappy28 + pred BtnTriggerHappy30 = BtnTriggerHappy29 + pred BtnTriggerHappy31 = BtnTriggerHappy30 + pred BtnTriggerHappy32 = BtnTriggerHappy31 + pred BtnTriggerHappy33 = BtnTriggerHappy32 + pred BtnTriggerHappy34 = BtnTriggerHappy33 + pred BtnTriggerHappy35 = BtnTriggerHappy34 + pred BtnTriggerHappy36 = BtnTriggerHappy35 + pred BtnTriggerHappy37 = BtnTriggerHappy36 + pred BtnTriggerHappy38 = BtnTriggerHappy37 + pred BtnTriggerHappy39 = BtnTriggerHappy38 + pred BtnTriggerHappy40 = BtnTriggerHappy39 + pred KeyReserved = error "Key.pred: KeyReserved has no predecessor" + + enumFromTo from to = go from + where + end = fromEnum to + go v = case compare (fromEnum v) end of + LT -> v : go (succ v) + EQ -> [v] + GT -> [] + + enumFrom from = enumFromTo from BtnTriggerHappy40 + + fromEnum KeyReserved = 0 + fromEnum KeyEsc = 1 + fromEnum Key1 = 2 + fromEnum Key2 = 3 + fromEnum Key3 = 4 + fromEnum Key4 = 5 + fromEnum Key5 = 6 + fromEnum Key6 = 7 + fromEnum Key7 = 8 + fromEnum Key8 = 9 + fromEnum Key9 = 10 + fromEnum Key0 = 11 + fromEnum KeyMinus = 12 + fromEnum KeyEqual = 13 + fromEnum KeyBackspace = 14 + fromEnum KeyTab = 15 + fromEnum KeyQ = 16 + fromEnum KeyW = 17 + fromEnum KeyE = 18 + fromEnum KeyR = 19 + fromEnum KeyT = 20 + fromEnum KeyY = 21 + fromEnum KeyU = 22 + fromEnum KeyI = 23 + fromEnum KeyO = 24 + fromEnum KeyP = 25 + fromEnum KeyLeftbrace = 26 + fromEnum KeyRightbrace = 27 + fromEnum KeyEnter = 28 + fromEnum KeyLeftctrl = 29 + fromEnum KeyA = 30 + fromEnum KeyS = 31 + fromEnum KeyD = 32 + fromEnum KeyF = 33 + fromEnum KeyG = 34 + fromEnum KeyH = 35 + fromEnum KeyJ = 36 + fromEnum KeyK = 37 + fromEnum KeyL = 38 + fromEnum KeySemicolon = 39 + fromEnum KeyApostrophe = 40 + fromEnum KeyGrave = 41 + fromEnum KeyLeftshift = 42 + fromEnum KeyBackslash = 43 + fromEnum KeyZ = 44 + fromEnum KeyX = 45 + fromEnum KeyC = 46 + fromEnum KeyV = 47 + fromEnum KeyB = 48 + fromEnum KeyN = 49 + fromEnum KeyM = 50 + fromEnum KeyComma = 51 + fromEnum KeyDot = 52 + fromEnum KeySlash = 53 + fromEnum KeyRightshift = 54 + fromEnum KeyKpasterisk = 55 + fromEnum KeyLeftalt = 56 + fromEnum KeySpace = 57 + fromEnum KeyCapslock = 58 + fromEnum KeyF1 = 59 + fromEnum KeyF2 = 60 + fromEnum KeyF3 = 61 + fromEnum KeyF4 = 62 + fromEnum KeyF5 = 63 + fromEnum KeyF6 = 64 + fromEnum KeyF7 = 65 + fromEnum KeyF8 = 66 + fromEnum KeyF9 = 67 + fromEnum KeyF10 = 68 + fromEnum KeyNumlock = 69 + fromEnum KeyScrolllock = 70 + fromEnum KeyKp7 = 71 + fromEnum KeyKp8 = 72 + fromEnum KeyKp9 = 73 + fromEnum KeyKpminus = 74 + fromEnum KeyKp4 = 75 + fromEnum KeyKp5 = 76 + fromEnum KeyKp6 = 77 + fromEnum KeyKpplus = 78 + fromEnum KeyKp1 = 79 + fromEnum KeyKp2 = 80 + fromEnum KeyKp3 = 81 + fromEnum KeyKp0 = 82 + fromEnum KeyKpdot = 83 + fromEnum KeyZenkakuhankaku = 85 + fromEnum Key102nd = 86 + fromEnum KeyF11 = 87 + fromEnum KeyF12 = 88 + fromEnum KeyRo = 89 + fromEnum KeyKatakana = 90 + fromEnum KeyHiragana = 91 + fromEnum KeyHenkan = 92 + fromEnum KeyKatakanahiragana = 93 + fromEnum KeyMuhenkan = 94 + fromEnum KeyKpjpcomma = 95 + fromEnum KeyKpenter = 96 + fromEnum KeyRightctrl = 97 + fromEnum KeyKpslash = 98 + fromEnum KeySysrq = 99 + fromEnum KeyRightalt = 100 + fromEnum KeyLinefeed = 101 + fromEnum KeyHome = 102 + fromEnum KeyUp = 103 + fromEnum KeyPageup = 104 + fromEnum KeyLeft = 105 + fromEnum KeyRight = 106 + fromEnum KeyEnd = 107 + fromEnum KeyDown = 108 + fromEnum KeyPagedown = 109 + fromEnum KeyInsert = 110 + fromEnum KeyDelete = 111 + fromEnum KeyMacro = 112 + fromEnum KeyMute = 113 + fromEnum KeyVolumedown = 114 + fromEnum KeyVolumeup = 115 + fromEnum KeyPower = 116 + fromEnum KeyKpequal = 117 + fromEnum KeyKpplusminus = 118 + fromEnum KeyPause = 119 + fromEnum KeyScale = 120 + fromEnum KeyKpcomma = 121 + fromEnum KeyHangeul = 122 + fromEnum KeyHanja = 123 + fromEnum KeyYen = 124 + fromEnum KeyLeftmeta = 125 + fromEnum KeyRightmeta = 126 + fromEnum KeyCompose = 127 + fromEnum KeyStop = 128 + fromEnum KeyAgain = 129 + fromEnum KeyProps = 130 + fromEnum KeyUndo = 131 + fromEnum KeyFront = 132 + fromEnum KeyCopy = 133 + fromEnum KeyOpen = 134 + fromEnum KeyPaste = 135 + fromEnum KeyFind = 136 + fromEnum KeyCut = 137 + fromEnum KeyHelp = 138 + fromEnum KeyMenu = 139 + fromEnum KeyCalc = 140 + fromEnum KeySetup = 141 + fromEnum KeySleep = 142 + fromEnum KeyWakeup = 143 + fromEnum KeyFile = 144 + fromEnum KeySendfile = 145 + fromEnum KeyDeletefile = 146 + fromEnum KeyXfer = 147 + fromEnum KeyProg1 = 148 + fromEnum KeyProg2 = 149 + fromEnum KeyWww = 150 + fromEnum KeyMsdos = 151 + fromEnum KeyScreenlock = 152 + fromEnum KeyRotateDisplay = 153 + fromEnum KeyCyclewindows = 154 + fromEnum KeyMail = 155 + fromEnum KeyBookmarks = 156 + fromEnum KeyComputer = 157 + fromEnum KeyBack = 158 + fromEnum KeyForward = 159 + fromEnum KeyClosecd = 160 + fromEnum KeyEjectcd = 161 + fromEnum KeyEjectclosecd = 162 + fromEnum KeyNextsong = 163 + fromEnum KeyPlaypause = 164 + fromEnum KeyPrevioussong = 165 + fromEnum KeyStopcd = 166 + fromEnum KeyRecord = 167 + fromEnum KeyRewind = 168 + fromEnum KeyPhone = 169 + fromEnum KeyIso = 170 + fromEnum KeyConfig = 171 + fromEnum KeyHomepage = 172 + fromEnum KeyRefresh = 173 + fromEnum KeyExit = 174 + fromEnum KeyMove = 175 + fromEnum KeyEdit = 176 + fromEnum KeyScrollup = 177 + fromEnum KeyScrolldown = 178 + fromEnum KeyKpleftparen = 179 + fromEnum KeyKprightparen = 180 + fromEnum KeyNew = 181 + fromEnum KeyRedo = 182 + fromEnum KeyF13 = 183 + fromEnum KeyF14 = 184 + fromEnum KeyF15 = 185 + fromEnum KeyF16 = 186 + fromEnum KeyF17 = 187 + fromEnum KeyF18 = 188 + fromEnum KeyF19 = 189 + fromEnum KeyF20 = 190 + fromEnum KeyF21 = 191 + fromEnum KeyF22 = 192 + fromEnum KeyF23 = 193 + fromEnum KeyF24 = 194 + fromEnum KeyPlaycd = 200 + fromEnum KeyPausecd = 201 + fromEnum KeyProg3 = 202 + fromEnum KeyProg4 = 203 + fromEnum KeyDashboard = 204 + fromEnum KeySuspend = 205 + fromEnum KeyClose = 206 + fromEnum KeyPlay = 207 + fromEnum KeyFastforward = 208 + fromEnum KeyBassboost = 209 + fromEnum KeyPrint = 210 + fromEnum KeyHp = 211 + fromEnum KeyCamera = 212 + fromEnum KeySound = 213 + fromEnum KeyQuestion = 214 + fromEnum KeyEmail = 215 + fromEnum KeyChat = 216 + fromEnum KeySearch = 217 + fromEnum KeyConnect = 218 + fromEnum KeyFinance = 219 + fromEnum KeySport = 220 + fromEnum KeyShop = 221 + fromEnum KeyAlterase = 222 + fromEnum KeyCancel = 223 + fromEnum KeyBrightnessdown = 224 + fromEnum KeyBrightnessup = 225 + fromEnum KeyMedia = 226 + fromEnum KeySwitchvideomode = 227 + fromEnum KeyKbdillumtoggle = 228 + fromEnum KeyKbdillumdown = 229 + fromEnum KeyKbdillumup = 230 + fromEnum KeySend = 231 + fromEnum KeyReply = 232 + fromEnum KeyForwardmail = 233 + fromEnum KeySave = 234 + fromEnum KeyDocuments = 235 + fromEnum KeyBattery = 236 + fromEnum KeyBluetooth = 237 + fromEnum KeyWlan = 238 + fromEnum KeyUwb = 239 + fromEnum KeyUnknown = 240 + fromEnum KeyVideoNext = 241 + fromEnum KeyVideoPrev = 242 + fromEnum KeyBrightnessCycle = 243 + fromEnum KeyBrightnessAuto = 244 + fromEnum KeyDisplayOff = 245 + fromEnum KeyWwan = 246 + fromEnum KeyRfkill = 247 + fromEnum KeyMicmute = 248 + fromEnum Btn0 = 256 + fromEnum Btn1 = 257 + fromEnum Btn2 = 258 + fromEnum Btn3 = 259 + fromEnum Btn4 = 260 + fromEnum Btn5 = 261 + fromEnum Btn6 = 262 + fromEnum Btn7 = 263 + fromEnum Btn8 = 264 + fromEnum Btn9 = 265 + fromEnum BtnLeft = 272 + fromEnum BtnRight = 273 + fromEnum BtnMiddle = 274 + fromEnum BtnSide = 275 + fromEnum BtnExtra = 276 + fromEnum BtnForward = 277 + fromEnum BtnBack = 278 + fromEnum BtnTask = 279 + fromEnum BtnJoystick = 288 + fromEnum BtnThumb = 289 + fromEnum BtnThumb2 = 290 + fromEnum BtnTop = 291 + fromEnum BtnTop2 = 292 + fromEnum BtnPinkie = 293 + fromEnum BtnBase = 294 + fromEnum BtnBase2 = 295 + fromEnum BtnBase3 = 296 + fromEnum BtnBase4 = 297 + fromEnum BtnBase5 = 298 + fromEnum BtnBase6 = 299 + fromEnum BtnDead = 303 + fromEnum BtnA = 304 + fromEnum BtnB = 305 + fromEnum BtnC = 306 + fromEnum BtnX = 307 + fromEnum BtnY = 308 + fromEnum BtnZ = 309 + fromEnum BtnTl = 310 + fromEnum BtnTr = 311 + fromEnum BtnTl2 = 312 + fromEnum BtnTr2 = 313 + fromEnum BtnSelect = 314 + fromEnum BtnStart = 315 + fromEnum BtnMode = 316 + fromEnum BtnThumbl = 317 + fromEnum BtnThumbr = 318 + fromEnum BtnToolPen = 320 + fromEnum BtnToolRubber = 321 + fromEnum BtnToolBrush = 322 + fromEnum BtnToolPencil = 323 + fromEnum BtnToolAirbrush = 324 + fromEnum BtnToolFinger = 325 + fromEnum BtnToolMouse = 326 + fromEnum BtnToolLens = 327 + fromEnum BtnToolQuinttap = 328 + fromEnum BtnTouch = 330 + fromEnum BtnStylus = 331 + fromEnum BtnStylus2 = 332 + fromEnum BtnToolDoubletap = 333 + fromEnum BtnToolTripletap = 334 + fromEnum BtnToolQuadtap = 335 + fromEnum BtnGearDown = 336 + fromEnum BtnGearUp = 337 + fromEnum KeyOk = 352 + fromEnum KeySelect = 353 + fromEnum KeyGoto = 354 + fromEnum KeyClear = 355 + fromEnum KeyPower2 = 356 + fromEnum KeyOption = 357 + fromEnum KeyInfo = 358 + fromEnum KeyTime = 359 + fromEnum KeyVendor = 360 + fromEnum KeyArchive = 361 + fromEnum KeyProgram = 362 + fromEnum KeyChannel = 363 + fromEnum KeyFavorites = 364 + fromEnum KeyEpg = 365 + fromEnum KeyPvr = 366 + fromEnum KeyMhp = 367 + fromEnum KeyLanguage = 368 + fromEnum KeyTitle = 369 + fromEnum KeySubtitle = 370 + fromEnum KeyAngle = 371 + fromEnum KeyZoom = 372 + fromEnum KeyMode = 373 + fromEnum KeyKeyboard = 374 + fromEnum KeyScreen = 375 + fromEnum KeyPc = 376 + fromEnum KeyTv = 377 + fromEnum KeyTv2 = 378 + fromEnum KeyVcr = 379 + fromEnum KeyVcr2 = 380 + fromEnum KeySat = 381 + fromEnum KeySat2 = 382 + fromEnum KeyCd = 383 + fromEnum KeyTape = 384 + fromEnum KeyRadio = 385 + fromEnum KeyTuner = 386 + fromEnum KeyPlayer = 387 + fromEnum KeyText = 388 + fromEnum KeyDvd = 389 + fromEnum KeyAux = 390 + fromEnum KeyMp3 = 391 + fromEnum KeyAudio = 392 + fromEnum KeyVideo = 393 + fromEnum KeyDirectory = 394 + fromEnum KeyList = 395 + fromEnum KeyMemo = 396 + fromEnum KeyCalendar = 397 + fromEnum KeyRed = 398 + fromEnum KeyGreen = 399 + fromEnum KeyYellow = 400 + fromEnum KeyBlue = 401 + fromEnum KeyChannelup = 402 + fromEnum KeyChanneldown = 403 + fromEnum KeyFirst = 404 + fromEnum KeyLast = 405 + fromEnum KeyAb = 406 + fromEnum KeyNext = 407 + fromEnum KeyRestart = 408 + fromEnum KeySlow = 409 + fromEnum KeyShuffle = 410 + fromEnum KeyBreak = 411 + fromEnum KeyPrevious = 412 + fromEnum KeyDigits = 413 + fromEnum KeyTeen = 414 + fromEnum KeyTwen = 415 + fromEnum KeyVideophone = 416 + fromEnum KeyGames = 417 + fromEnum KeyZoomin = 418 + fromEnum KeyZoomout = 419 + fromEnum KeyZoomreset = 420 + fromEnum KeyWordprocessor = 421 + fromEnum KeyEditor = 422 + fromEnum KeySpreadsheet = 423 + fromEnum KeyGraphicseditor = 424 + fromEnum KeyPresentation = 425 + fromEnum KeyDatabase = 426 + fromEnum KeyNews = 427 + fromEnum KeyVoicemail = 428 + fromEnum KeyAddressbook = 429 + fromEnum KeyMessenger = 430 + fromEnum KeyDisplaytoggle = 431 + fromEnum KeySpellcheck = 432 + fromEnum KeyLogoff = 433 + fromEnum KeyDollar = 434 + fromEnum KeyEuro = 435 + fromEnum KeyFrameback = 436 + fromEnum KeyFrameforward = 437 + fromEnum KeyContextMenu = 438 + fromEnum KeyMediaRepeat = 439 + fromEnum Key10channelsup = 440 + fromEnum Key10channelsdown = 441 + fromEnum KeyImages = 442 + fromEnum KeyDelEol = 448 + fromEnum KeyDelEos = 449 + fromEnum KeyInsLine = 450 + fromEnum KeyDelLine = 451 + fromEnum KeyFn = 464 + fromEnum KeyFnEsc = 465 + fromEnum KeyFnF1 = 466 + fromEnum KeyFnF2 = 467 + fromEnum KeyFnF3 = 468 + fromEnum KeyFnF4 = 469 + fromEnum KeyFnF5 = 470 + fromEnum KeyFnF6 = 471 + fromEnum KeyFnF7 = 472 + fromEnum KeyFnF8 = 473 + fromEnum KeyFnF9 = 474 + fromEnum KeyFnF10 = 475 + fromEnum KeyFnF11 = 476 + fromEnum KeyFnF12 = 477 + fromEnum KeyFn1 = 478 + fromEnum KeyFn2 = 479 + fromEnum KeyFnD = 480 + fromEnum KeyFnE = 481 + fromEnum KeyFnF = 482 + fromEnum KeyFnS = 483 + fromEnum KeyFnB = 484 + fromEnum KeyBrlDot1 = 497 + fromEnum KeyBrlDot2 = 498 + fromEnum KeyBrlDot3 = 499 + fromEnum KeyBrlDot4 = 500 + fromEnum KeyBrlDot5 = 501 + fromEnum KeyBrlDot6 = 502 + fromEnum KeyBrlDot7 = 503 + fromEnum KeyBrlDot8 = 504 + fromEnum KeyBrlDot9 = 505 + fromEnum KeyBrlDot10 = 506 + fromEnum KeyNumeric0 = 512 + fromEnum KeyNumeric1 = 513 + fromEnum KeyNumeric2 = 514 + fromEnum KeyNumeric3 = 515 + fromEnum KeyNumeric4 = 516 + fromEnum KeyNumeric5 = 517 + fromEnum KeyNumeric6 = 518 + fromEnum KeyNumeric7 = 519 + fromEnum KeyNumeric8 = 520 + fromEnum KeyNumeric9 = 521 + fromEnum KeyNumericStar = 522 + fromEnum KeyNumericPound = 523 + fromEnum KeyNumericA = 524 + fromEnum KeyNumericB = 525 + fromEnum KeyNumericC = 526 + fromEnum KeyNumericD = 527 + fromEnum KeyCameraFocus = 528 + fromEnum KeyWpsButton = 529 + fromEnum KeyTouchpadToggle = 530 + fromEnum KeyTouchpadOn = 531 + fromEnum KeyTouchpadOff = 532 + fromEnum KeyCameraZoomin = 533 + fromEnum KeyCameraZoomout = 534 + fromEnum KeyCameraUp = 535 + fromEnum KeyCameraDown = 536 + fromEnum KeyCameraLeft = 537 + fromEnum KeyCameraRight = 538 + fromEnum KeyAttendantOn = 539 + fromEnum KeyAttendantOff = 540 + fromEnum KeyAttendantToggle = 541 + fromEnum KeyLightsToggle = 542 + fromEnum BtnDpadUp = 544 + fromEnum BtnDpadDown = 545 + fromEnum BtnDpadLeft = 546 + fromEnum BtnDpadRight = 547 + fromEnum KeyAlsToggle = 560 + fromEnum KeyButtonconfig = 576 + fromEnum KeyTaskmanager = 577 + fromEnum KeyJournal = 578 + fromEnum KeyControlpanel = 579 + fromEnum KeyAppselect = 580 + fromEnum KeyScreensaver = 581 + fromEnum KeyVoicecommand = 582 + fromEnum KeyBrightnessMin = 592 + fromEnum KeyBrightnessMax = 593 + fromEnum KeyKbdinputassistPrev = 608 + fromEnum KeyKbdinputassistNext = 609 + fromEnum KeyKbdinputassistPrevgroup = 610 + fromEnum KeyKbdinputassistNextgroup = 611 + fromEnum KeyKbdinputassistAccept = 612 + fromEnum KeyKbdinputassistCancel = 613 + fromEnum BtnTriggerHappy1 = 704 + fromEnum BtnTriggerHappy2 = 705 + fromEnum BtnTriggerHappy3 = 706 + fromEnum BtnTriggerHappy4 = 707 + fromEnum BtnTriggerHappy5 = 708 + fromEnum BtnTriggerHappy6 = 709 + fromEnum BtnTriggerHappy7 = 710 + fromEnum BtnTriggerHappy8 = 711 + fromEnum BtnTriggerHappy9 = 712 + fromEnum BtnTriggerHappy10 = 713 + fromEnum BtnTriggerHappy11 = 714 + fromEnum BtnTriggerHappy12 = 715 + fromEnum BtnTriggerHappy13 = 716 + fromEnum BtnTriggerHappy14 = 717 + fromEnum BtnTriggerHappy15 = 718 + fromEnum BtnTriggerHappy16 = 719 + fromEnum BtnTriggerHappy17 = 720 + fromEnum BtnTriggerHappy18 = 721 + fromEnum BtnTriggerHappy19 = 722 + fromEnum BtnTriggerHappy20 = 723 + fromEnum BtnTriggerHappy21 = 724 + fromEnum BtnTriggerHappy22 = 725 + fromEnum BtnTriggerHappy23 = 726 + fromEnum BtnTriggerHappy24 = 727 + fromEnum BtnTriggerHappy25 = 728 + fromEnum BtnTriggerHappy26 = 729 + fromEnum BtnTriggerHappy27 = 730 + fromEnum BtnTriggerHappy28 = 731 + fromEnum BtnTriggerHappy29 = 732 + fromEnum BtnTriggerHappy30 = 733 + fromEnum BtnTriggerHappy31 = 734 + fromEnum BtnTriggerHappy32 = 735 + fromEnum BtnTriggerHappy33 = 736 + fromEnum BtnTriggerHappy34 = 737 + fromEnum BtnTriggerHappy35 = 738 + fromEnum BtnTriggerHappy36 = 739 + fromEnum BtnTriggerHappy37 = 740 + fromEnum BtnTriggerHappy38 = 741 + fromEnum BtnTriggerHappy39 = 742 + fromEnum BtnTriggerHappy40 = 743 + + toEnum 0 = KeyReserved + toEnum 1 = KeyEsc + toEnum 2 = Key1 + toEnum 3 = Key2 + toEnum 4 = Key3 + toEnum 5 = Key4 + toEnum 6 = Key5 + toEnum 7 = Key6 + toEnum 8 = Key7 + toEnum 9 = Key8 + toEnum 10 = Key9 + toEnum 11 = Key0 + toEnum 12 = KeyMinus + toEnum 13 = KeyEqual + toEnum 14 = KeyBackspace + toEnum 15 = KeyTab + toEnum 16 = KeyQ + toEnum 17 = KeyW + toEnum 18 = KeyE + toEnum 19 = KeyR + toEnum 20 = KeyT + toEnum 21 = KeyY + toEnum 22 = KeyU + toEnum 23 = KeyI + toEnum 24 = KeyO + toEnum 25 = KeyP + toEnum 26 = KeyLeftbrace + toEnum 27 = KeyRightbrace + toEnum 28 = KeyEnter + toEnum 29 = KeyLeftctrl + toEnum 30 = KeyA + toEnum 31 = KeyS + toEnum 32 = KeyD + toEnum 33 = KeyF + toEnum 34 = KeyG + toEnum 35 = KeyH + toEnum 36 = KeyJ + toEnum 37 = KeyK + toEnum 38 = KeyL + toEnum 39 = KeySemicolon + toEnum 40 = KeyApostrophe + toEnum 41 = KeyGrave + toEnum 42 = KeyLeftshift + toEnum 43 = KeyBackslash + toEnum 44 = KeyZ + toEnum 45 = KeyX + toEnum 46 = KeyC + toEnum 47 = KeyV + toEnum 48 = KeyB + toEnum 49 = KeyN + toEnum 50 = KeyM + toEnum 51 = KeyComma + toEnum 52 = KeyDot + toEnum 53 = KeySlash + toEnum 54 = KeyRightshift + toEnum 55 = KeyKpasterisk + toEnum 56 = KeyLeftalt + toEnum 57 = KeySpace + toEnum 58 = KeyCapslock + toEnum 59 = KeyF1 + toEnum 60 = KeyF2 + toEnum 61 = KeyF3 + toEnum 62 = KeyF4 + toEnum 63 = KeyF5 + toEnum 64 = KeyF6 + toEnum 65 = KeyF7 + toEnum 66 = KeyF8 + toEnum 67 = KeyF9 + toEnum 68 = KeyF10 + toEnum 69 = KeyNumlock + toEnum 70 = KeyScrolllock + toEnum 71 = KeyKp7 + toEnum 72 = KeyKp8 + toEnum 73 = KeyKp9 + toEnum 74 = KeyKpminus + toEnum 75 = KeyKp4 + toEnum 76 = KeyKp5 + toEnum 77 = KeyKp6 + toEnum 78 = KeyKpplus + toEnum 79 = KeyKp1 + toEnum 80 = KeyKp2 + toEnum 81 = KeyKp3 + toEnum 82 = KeyKp0 + toEnum 83 = KeyKpdot + toEnum 85 = KeyZenkakuhankaku + toEnum 86 = Key102nd + toEnum 87 = KeyF11 + toEnum 88 = KeyF12 + toEnum 89 = KeyRo + toEnum 90 = KeyKatakana + toEnum 91 = KeyHiragana + toEnum 92 = KeyHenkan + toEnum 93 = KeyKatakanahiragana + toEnum 94 = KeyMuhenkan + toEnum 95 = KeyKpjpcomma + toEnum 96 = KeyKpenter + toEnum 97 = KeyRightctrl + toEnum 98 = KeyKpslash + toEnum 99 = KeySysrq + toEnum 100 = KeyRightalt + toEnum 101 = KeyLinefeed + toEnum 102 = KeyHome + toEnum 103 = KeyUp + toEnum 104 = KeyPageup + toEnum 105 = KeyLeft + toEnum 106 = KeyRight + toEnum 107 = KeyEnd + toEnum 108 = KeyDown + toEnum 109 = KeyPagedown + toEnum 110 = KeyInsert + toEnum 111 = KeyDelete + toEnum 112 = KeyMacro + toEnum 113 = KeyMute + toEnum 114 = KeyVolumedown + toEnum 115 = KeyVolumeup + toEnum 116 = KeyPower + toEnum 117 = KeyKpequal + toEnum 118 = KeyKpplusminus + toEnum 119 = KeyPause + toEnum 120 = KeyScale + toEnum 121 = KeyKpcomma + toEnum 122 = KeyHangeul + toEnum 123 = KeyHanja + toEnum 124 = KeyYen + toEnum 125 = KeyLeftmeta + toEnum 126 = KeyRightmeta + toEnum 127 = KeyCompose + toEnum 128 = KeyStop + toEnum 129 = KeyAgain + toEnum 130 = KeyProps + toEnum 131 = KeyUndo + toEnum 132 = KeyFront + toEnum 133 = KeyCopy + toEnum 134 = KeyOpen + toEnum 135 = KeyPaste + toEnum 136 = KeyFind + toEnum 137 = KeyCut + toEnum 138 = KeyHelp + toEnum 139 = KeyMenu + toEnum 140 = KeyCalc + toEnum 141 = KeySetup + toEnum 142 = KeySleep + toEnum 143 = KeyWakeup + toEnum 144 = KeyFile + toEnum 145 = KeySendfile + toEnum 146 = KeyDeletefile + toEnum 147 = KeyXfer + toEnum 148 = KeyProg1 + toEnum 149 = KeyProg2 + toEnum 150 = KeyWww + toEnum 151 = KeyMsdos + toEnum 152 = KeyScreenlock + toEnum 153 = KeyRotateDisplay + toEnum 154 = KeyCyclewindows + toEnum 155 = KeyMail + toEnum 156 = KeyBookmarks + toEnum 157 = KeyComputer + toEnum 158 = KeyBack + toEnum 159 = KeyForward + toEnum 160 = KeyClosecd + toEnum 161 = KeyEjectcd + toEnum 162 = KeyEjectclosecd + toEnum 163 = KeyNextsong + toEnum 164 = KeyPlaypause + toEnum 165 = KeyPrevioussong + toEnum 166 = KeyStopcd + toEnum 167 = KeyRecord + toEnum 168 = KeyRewind + toEnum 169 = KeyPhone + toEnum 170 = KeyIso + toEnum 171 = KeyConfig + toEnum 172 = KeyHomepage + toEnum 173 = KeyRefresh + toEnum 174 = KeyExit + toEnum 175 = KeyMove + toEnum 176 = KeyEdit + toEnum 177 = KeyScrollup + toEnum 178 = KeyScrolldown + toEnum 179 = KeyKpleftparen + toEnum 180 = KeyKprightparen + toEnum 181 = KeyNew + toEnum 182 = KeyRedo + toEnum 183 = KeyF13 + toEnum 184 = KeyF14 + toEnum 185 = KeyF15 + toEnum 186 = KeyF16 + toEnum 187 = KeyF17 + toEnum 188 = KeyF18 + toEnum 189 = KeyF19 + toEnum 190 = KeyF20 + toEnum 191 = KeyF21 + toEnum 192 = KeyF22 + toEnum 193 = KeyF23 + toEnum 194 = KeyF24 + toEnum 200 = KeyPlaycd + toEnum 201 = KeyPausecd + toEnum 202 = KeyProg3 + toEnum 203 = KeyProg4 + toEnum 204 = KeyDashboard + toEnum 205 = KeySuspend + toEnum 206 = KeyClose + toEnum 207 = KeyPlay + toEnum 208 = KeyFastforward + toEnum 209 = KeyBassboost + toEnum 210 = KeyPrint + toEnum 211 = KeyHp + toEnum 212 = KeyCamera + toEnum 213 = KeySound + toEnum 214 = KeyQuestion + toEnum 215 = KeyEmail + toEnum 216 = KeyChat + toEnum 217 = KeySearch + toEnum 218 = KeyConnect + toEnum 219 = KeyFinance + toEnum 220 = KeySport + toEnum 221 = KeyShop + toEnum 222 = KeyAlterase + toEnum 223 = KeyCancel + toEnum 224 = KeyBrightnessdown + toEnum 225 = KeyBrightnessup + toEnum 226 = KeyMedia + toEnum 227 = KeySwitchvideomode + toEnum 228 = KeyKbdillumtoggle + toEnum 229 = KeyKbdillumdown + toEnum 230 = KeyKbdillumup + toEnum 231 = KeySend + toEnum 232 = KeyReply + toEnum 233 = KeyForwardmail + toEnum 234 = KeySave + toEnum 235 = KeyDocuments + toEnum 236 = KeyBattery + toEnum 237 = KeyBluetooth + toEnum 238 = KeyWlan + toEnum 239 = KeyUwb + toEnum 240 = KeyUnknown + toEnum 241 = KeyVideoNext + toEnum 242 = KeyVideoPrev + toEnum 243 = KeyBrightnessCycle + toEnum 244 = KeyBrightnessAuto + toEnum 245 = KeyDisplayOff + toEnum 246 = KeyWwan + toEnum 247 = KeyRfkill + toEnum 248 = KeyMicmute + toEnum 256 = Btn0 + toEnum 257 = Btn1 + toEnum 258 = Btn2 + toEnum 259 = Btn3 + toEnum 260 = Btn4 + toEnum 261 = Btn5 + toEnum 262 = Btn6 + toEnum 263 = Btn7 + toEnum 264 = Btn8 + toEnum 265 = Btn9 + toEnum 272 = BtnLeft + toEnum 273 = BtnRight + toEnum 274 = BtnMiddle + toEnum 275 = BtnSide + toEnum 276 = BtnExtra + toEnum 277 = BtnForward + toEnum 278 = BtnBack + toEnum 279 = BtnTask + toEnum 288 = BtnJoystick + toEnum 289 = BtnThumb + toEnum 290 = BtnThumb2 + toEnum 291 = BtnTop + toEnum 292 = BtnTop2 + toEnum 293 = BtnPinkie + toEnum 294 = BtnBase + toEnum 295 = BtnBase2 + toEnum 296 = BtnBase3 + toEnum 297 = BtnBase4 + toEnum 298 = BtnBase5 + toEnum 299 = BtnBase6 + toEnum 303 = BtnDead + toEnum 304 = BtnA + toEnum 305 = BtnB + toEnum 306 = BtnC + toEnum 307 = BtnX + toEnum 308 = BtnY + toEnum 309 = BtnZ + toEnum 310 = BtnTl + toEnum 311 = BtnTr + toEnum 312 = BtnTl2 + toEnum 313 = BtnTr2 + toEnum 314 = BtnSelect + toEnum 315 = BtnStart + toEnum 316 = BtnMode + toEnum 317 = BtnThumbl + toEnum 318 = BtnThumbr + toEnum 320 = BtnToolPen + toEnum 321 = BtnToolRubber + toEnum 322 = BtnToolBrush + toEnum 323 = BtnToolPencil + toEnum 324 = BtnToolAirbrush + toEnum 325 = BtnToolFinger + toEnum 326 = BtnToolMouse + toEnum 327 = BtnToolLens + toEnum 328 = BtnToolQuinttap + toEnum 330 = BtnTouch + toEnum 331 = BtnStylus + toEnum 332 = BtnStylus2 + toEnum 333 = BtnToolDoubletap + toEnum 334 = BtnToolTripletap + toEnum 335 = BtnToolQuadtap + toEnum 336 = BtnGearDown + toEnum 337 = BtnGearUp + toEnum 352 = KeyOk + toEnum 353 = KeySelect + toEnum 354 = KeyGoto + toEnum 355 = KeyClear + toEnum 356 = KeyPower2 + toEnum 357 = KeyOption + toEnum 358 = KeyInfo + toEnum 359 = KeyTime + toEnum 360 = KeyVendor + toEnum 361 = KeyArchive + toEnum 362 = KeyProgram + toEnum 363 = KeyChannel + toEnum 364 = KeyFavorites + toEnum 365 = KeyEpg + toEnum 366 = KeyPvr + toEnum 367 = KeyMhp + toEnum 368 = KeyLanguage + toEnum 369 = KeyTitle + toEnum 370 = KeySubtitle + toEnum 371 = KeyAngle + toEnum 372 = KeyZoom + toEnum 373 = KeyMode + toEnum 374 = KeyKeyboard + toEnum 375 = KeyScreen + toEnum 376 = KeyPc + toEnum 377 = KeyTv + toEnum 378 = KeyTv2 + toEnum 379 = KeyVcr + toEnum 380 = KeyVcr2 + toEnum 381 = KeySat + toEnum 382 = KeySat2 + toEnum 383 = KeyCd + toEnum 384 = KeyTape + toEnum 385 = KeyRadio + toEnum 386 = KeyTuner + toEnum 387 = KeyPlayer + toEnum 388 = KeyText + toEnum 389 = KeyDvd + toEnum 390 = KeyAux + toEnum 391 = KeyMp3 + toEnum 392 = KeyAudio + toEnum 393 = KeyVideo + toEnum 394 = KeyDirectory + toEnum 395 = KeyList + toEnum 396 = KeyMemo + toEnum 397 = KeyCalendar + toEnum 398 = KeyRed + toEnum 399 = KeyGreen + toEnum 400 = KeyYellow + toEnum 401 = KeyBlue + toEnum 402 = KeyChannelup + toEnum 403 = KeyChanneldown + toEnum 404 = KeyFirst + toEnum 405 = KeyLast + toEnum 406 = KeyAb + toEnum 407 = KeyNext + toEnum 408 = KeyRestart + toEnum 409 = KeySlow + toEnum 410 = KeyShuffle + toEnum 411 = KeyBreak + toEnum 412 = KeyPrevious + toEnum 413 = KeyDigits + toEnum 414 = KeyTeen + toEnum 415 = KeyTwen + toEnum 416 = KeyVideophone + toEnum 417 = KeyGames + toEnum 418 = KeyZoomin + toEnum 419 = KeyZoomout + toEnum 420 = KeyZoomreset + toEnum 421 = KeyWordprocessor + toEnum 422 = KeyEditor + toEnum 423 = KeySpreadsheet + toEnum 424 = KeyGraphicseditor + toEnum 425 = KeyPresentation + toEnum 426 = KeyDatabase + toEnum 427 = KeyNews + toEnum 428 = KeyVoicemail + toEnum 429 = KeyAddressbook + toEnum 430 = KeyMessenger + toEnum 431 = KeyDisplaytoggle + toEnum 432 = KeySpellcheck + toEnum 433 = KeyLogoff + toEnum 434 = KeyDollar + toEnum 435 = KeyEuro + toEnum 436 = KeyFrameback + toEnum 437 = KeyFrameforward + toEnum 438 = KeyContextMenu + toEnum 439 = KeyMediaRepeat + toEnum 440 = Key10channelsup + toEnum 441 = Key10channelsdown + toEnum 442 = KeyImages + toEnum 448 = KeyDelEol + toEnum 449 = KeyDelEos + toEnum 450 = KeyInsLine + toEnum 451 = KeyDelLine + toEnum 464 = KeyFn + toEnum 465 = KeyFnEsc + toEnum 466 = KeyFnF1 + toEnum 467 = KeyFnF2 + toEnum 468 = KeyFnF3 + toEnum 469 = KeyFnF4 + toEnum 470 = KeyFnF5 + toEnum 471 = KeyFnF6 + toEnum 472 = KeyFnF7 + toEnum 473 = KeyFnF8 + toEnum 474 = KeyFnF9 + toEnum 475 = KeyFnF10 + toEnum 476 = KeyFnF11 + toEnum 477 = KeyFnF12 + toEnum 478 = KeyFn1 + toEnum 479 = KeyFn2 + toEnum 480 = KeyFnD + toEnum 481 = KeyFnE + toEnum 482 = KeyFnF + toEnum 483 = KeyFnS + toEnum 484 = KeyFnB + toEnum 497 = KeyBrlDot1 + toEnum 498 = KeyBrlDot2 + toEnum 499 = KeyBrlDot3 + toEnum 500 = KeyBrlDot4 + toEnum 501 = KeyBrlDot5 + toEnum 502 = KeyBrlDot6 + toEnum 503 = KeyBrlDot7 + toEnum 504 = KeyBrlDot8 + toEnum 505 = KeyBrlDot9 + toEnum 506 = KeyBrlDot10 + toEnum 512 = KeyNumeric0 + toEnum 513 = KeyNumeric1 + toEnum 514 = KeyNumeric2 + toEnum 515 = KeyNumeric3 + toEnum 516 = KeyNumeric4 + toEnum 517 = KeyNumeric5 + toEnum 518 = KeyNumeric6 + toEnum 519 = KeyNumeric7 + toEnum 520 = KeyNumeric8 + toEnum 521 = KeyNumeric9 + toEnum 522 = KeyNumericStar + toEnum 523 = KeyNumericPound + toEnum 524 = KeyNumericA + toEnum 525 = KeyNumericB + toEnum 526 = KeyNumericC + toEnum 527 = KeyNumericD + toEnum 528 = KeyCameraFocus + toEnum 529 = KeyWpsButton + toEnum 530 = KeyTouchpadToggle + toEnum 531 = KeyTouchpadOn + toEnum 532 = KeyTouchpadOff + toEnum 533 = KeyCameraZoomin + toEnum 534 = KeyCameraZoomout + toEnum 535 = KeyCameraUp + toEnum 536 = KeyCameraDown + toEnum 537 = KeyCameraLeft + toEnum 538 = KeyCameraRight + toEnum 539 = KeyAttendantOn + toEnum 540 = KeyAttendantOff + toEnum 541 = KeyAttendantToggle + toEnum 542 = KeyLightsToggle + toEnum 544 = BtnDpadUp + toEnum 545 = BtnDpadDown + toEnum 546 = BtnDpadLeft + toEnum 547 = BtnDpadRight + toEnum 560 = KeyAlsToggle + toEnum 576 = KeyButtonconfig + toEnum 577 = KeyTaskmanager + toEnum 578 = KeyJournal + toEnum 579 = KeyControlpanel + toEnum 580 = KeyAppselect + toEnum 581 = KeyScreensaver + toEnum 582 = KeyVoicecommand + toEnum 592 = KeyBrightnessMin + toEnum 593 = KeyBrightnessMax + toEnum 608 = KeyKbdinputassistPrev + toEnum 609 = KeyKbdinputassistNext + toEnum 610 = KeyKbdinputassistPrevgroup + toEnum 611 = KeyKbdinputassistNextgroup + toEnum 612 = KeyKbdinputassistAccept + toEnum 613 = KeyKbdinputassistCancel + toEnum 704 = BtnTriggerHappy1 + toEnum 705 = BtnTriggerHappy2 + toEnum 706 = BtnTriggerHappy3 + toEnum 707 = BtnTriggerHappy4 + toEnum 708 = BtnTriggerHappy5 + toEnum 709 = BtnTriggerHappy6 + toEnum 710 = BtnTriggerHappy7 + toEnum 711 = BtnTriggerHappy8 + toEnum 712 = BtnTriggerHappy9 + toEnum 713 = BtnTriggerHappy10 + toEnum 714 = BtnTriggerHappy11 + toEnum 715 = BtnTriggerHappy12 + toEnum 716 = BtnTriggerHappy13 + toEnum 717 = BtnTriggerHappy14 + toEnum 718 = BtnTriggerHappy15 + toEnum 719 = BtnTriggerHappy16 + toEnum 720 = BtnTriggerHappy17 + toEnum 721 = BtnTriggerHappy18 + toEnum 722 = BtnTriggerHappy19 + toEnum 723 = BtnTriggerHappy20 + toEnum 724 = BtnTriggerHappy21 + toEnum 725 = BtnTriggerHappy22 + toEnum 726 = BtnTriggerHappy23 + toEnum 727 = BtnTriggerHappy24 + toEnum 728 = BtnTriggerHappy25 + toEnum 729 = BtnTriggerHappy26 + toEnum 730 = BtnTriggerHappy27 + toEnum 731 = BtnTriggerHappy28 + toEnum 732 = BtnTriggerHappy29 + toEnum 733 = BtnTriggerHappy30 + toEnum 734 = BtnTriggerHappy31 + toEnum 735 = BtnTriggerHappy32 + toEnum 736 = BtnTriggerHappy33 + toEnum 737 = BtnTriggerHappy34 + toEnum 738 = BtnTriggerHappy35 + toEnum 739 = BtnTriggerHappy36 + toEnum 740 = BtnTriggerHappy37 + toEnum 741 = BtnTriggerHappy38 + toEnum 742 = BtnTriggerHappy39 + toEnum 743 = BtnTriggerHappy40 + toEnum unmatched = error ("Key.toEnum: Cannot match " ++ show unmatched) + + + +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 +data RelativeAxis = RelX + | RelY + | RelZ + | RelRx + | RelRy + | RelRz + | RelHwheel + | RelDial + | RelWheel + | RelMisc + | RelReserved + | RelWheelHiRes + | RelHWheelHiRes + deriving (Bounded,Eq,Ord,Read,Show) +instance Enum RelativeAxis where + succ RelX = RelY + succ RelY = RelZ + succ RelZ = RelRx + succ RelRx = RelRy + succ RelRy = RelRz + succ RelRz = RelHwheel + succ RelHwheel = RelDial + succ RelDial = RelWheel + succ RelWheel = RelMisc + succ RelMisc = RelReserved + succ RelReserved = RelWheelHiRes + succ RelWheelHiRes = RelHWheelHiRes + succ RelHWheelHiRes = error "RelativeAxis.succ: RelHWheelHiRes has no successor" + + pred RelY = RelX + pred RelZ = RelY + pred RelRx = RelZ + pred RelRy = RelRx + pred RelRz = RelRy + pred RelHwheel = RelRz + pred RelDial = RelHwheel + pred RelWheel = RelDial + pred RelMisc = RelWheel + pred RelReserved = RelMisc + pred RelWheelHiRes = RelReserved + pred RelHWheelHiRes = RelWheelHiRes + pred RelX = error "RelativeAxis.pred: RelX has no predecessor" + + enumFromTo from to = go from + where + end = fromEnum to + go v = case compare (fromEnum v) end of + LT -> v : go (succ v) + EQ -> [v] + GT -> [] + + enumFrom from = enumFromTo from RelHWheelHiRes + + fromEnum RelX = 0 + fromEnum RelY = 1 + fromEnum RelZ = 2 + fromEnum RelRx = 3 + fromEnum RelRy = 4 + fromEnum RelRz = 5 + fromEnum RelHwheel = 6 + fromEnum RelDial = 7 + fromEnum RelWheel = 8 + fromEnum RelMisc = 9 + fromEnum RelReserved = 10 + fromEnum RelWheelHiRes = 11 + fromEnum RelHWheelHiRes = 12 + + toEnum 0 = RelX + toEnum 1 = RelY + toEnum 2 = RelZ + toEnum 3 = RelRx + toEnum 4 = RelRy + toEnum 5 = RelRz + toEnum 6 = RelHwheel + toEnum 7 = RelDial + toEnum 8 = RelWheel + toEnum 9 = RelMisc + toEnum 10 = RelReserved + toEnum 11 = RelWheelHiRes + toEnum 12 = RelHWheelHiRes + toEnum unmatched = error ("RelativeAxis.toEnum: Cannot match " ++ show unmatched) + + + +-- | Absolute changes +data AbsoluteAxis = AbsX + | AbsY + | AbsZ + | AbsRx + | AbsRy + | AbsRz + | AbsThrottle + | AbsRudder + | AbsWheel + | AbsGas + | AbsBrake + | AbsHat0x + | AbsHat0y + | AbsHat1x + | AbsHat1y + | AbsHat2x + | AbsHat2y + | AbsHat3x + | AbsHat3y + | AbsPressure + | AbsDistance + | AbsTiltX + | AbsTiltY + | AbsToolWidth + | AbsVolume + | AbsMisc + | AbsReserved + | AbsMtSlot + | AbsMtTouchMajor + | AbsMtTouchMinor + | AbsMtWidthMajor + | AbsMtWidthMinor + | AbsMtOrientation + | AbsMtPositionX + | AbsMtPositionY + | AbsMtToolType + | AbsMtBlobId + | AbsMtTrackingId + | AbsMtPressure + | AbsMtDistance + | AbsMtToolX + | AbsMtToolY + deriving (Bounded,Eq,Ord,Read,Show) +instance Enum AbsoluteAxis where + succ AbsX = AbsY + succ AbsY = AbsZ + succ AbsZ = AbsRx + succ AbsRx = AbsRy + succ AbsRy = AbsRz + succ AbsRz = AbsThrottle + succ AbsThrottle = AbsRudder + succ AbsRudder = AbsWheel + succ AbsWheel = AbsGas + succ AbsGas = AbsBrake + succ AbsBrake = AbsHat0x + succ AbsHat0x = AbsHat0y + succ AbsHat0y = AbsHat1x + succ AbsHat1x = AbsHat1y + succ AbsHat1y = AbsHat2x + succ AbsHat2x = AbsHat2y + succ AbsHat2y = AbsHat3x + succ AbsHat3x = AbsHat3y + succ AbsHat3y = AbsPressure + succ AbsPressure = AbsDistance + succ AbsDistance = AbsTiltX + succ AbsTiltX = AbsTiltY + succ AbsTiltY = AbsToolWidth + succ AbsToolWidth = AbsVolume + succ AbsVolume = AbsMisc + succ AbsMisc = AbsReserved + succ AbsReserved = AbsMtSlot + succ AbsMtSlot = AbsMtTouchMajor + succ AbsMtTouchMajor = AbsMtTouchMinor + succ AbsMtTouchMinor = AbsMtWidthMajor + succ AbsMtWidthMajor = AbsMtWidthMinor + succ AbsMtWidthMinor = AbsMtOrientation + succ AbsMtOrientation = AbsMtPositionX + succ AbsMtPositionX = AbsMtPositionY + succ AbsMtPositionY = AbsMtToolType + succ AbsMtToolType = AbsMtBlobId + succ AbsMtBlobId = AbsMtTrackingId + succ AbsMtTrackingId = AbsMtPressure + succ AbsMtPressure = AbsMtDistance + succ AbsMtDistance = AbsMtToolX + succ AbsMtToolX = AbsMtToolY + succ AbsMtToolY = error "AbsoluteAxis.succ: AbsMtToolY has no successor" + + pred AbsY = AbsX + pred AbsZ = AbsY + pred AbsRx = AbsZ + pred AbsRy = AbsRx + pred AbsRz = AbsRy + pred AbsThrottle = AbsRz + pred AbsRudder = AbsThrottle + pred AbsWheel = AbsRudder + pred AbsGas = AbsWheel + pred AbsBrake = AbsGas + pred AbsHat0x = AbsBrake + pred AbsHat0y = AbsHat0x + pred AbsHat1x = AbsHat0y + pred AbsHat1y = AbsHat1x + pred AbsHat2x = AbsHat1y + pred AbsHat2y = AbsHat2x + pred AbsHat3x = AbsHat2y + pred AbsHat3y = AbsHat3x + pred AbsPressure = AbsHat3y + pred AbsDistance = AbsPressure + pred AbsTiltX = AbsDistance + pred AbsTiltY = AbsTiltX + pred AbsToolWidth = AbsTiltY + pred AbsVolume = AbsToolWidth + pred AbsMisc = AbsVolume + pred AbsReserved = AbsMisc + pred AbsMtSlot = AbsReserved + pred AbsMtTouchMajor = AbsMtSlot + pred AbsMtTouchMinor = AbsMtTouchMajor + pred AbsMtWidthMajor = AbsMtTouchMinor + pred AbsMtWidthMinor = AbsMtWidthMajor + pred AbsMtOrientation = AbsMtWidthMinor + pred AbsMtPositionX = AbsMtOrientation + pred AbsMtPositionY = AbsMtPositionX + pred AbsMtToolType = AbsMtPositionY + pred AbsMtBlobId = AbsMtToolType + pred AbsMtTrackingId = AbsMtBlobId + pred AbsMtPressure = AbsMtTrackingId + pred AbsMtDistance = AbsMtPressure + pred AbsMtToolX = AbsMtDistance + pred AbsMtToolY = AbsMtToolX + pred AbsX = error "AbsoluteAxis.pred: AbsX has no predecessor" + + enumFromTo from to = go from + where + end = fromEnum to + go v = case compare (fromEnum v) end of + LT -> v : go (succ v) + EQ -> [v] + GT -> [] + + enumFrom from = enumFromTo from AbsMtToolY + + fromEnum AbsX = 0 + fromEnum AbsY = 1 + fromEnum AbsZ = 2 + fromEnum AbsRx = 3 + fromEnum AbsRy = 4 + fromEnum AbsRz = 5 + fromEnum AbsThrottle = 6 + fromEnum AbsRudder = 7 + fromEnum AbsWheel = 8 + fromEnum AbsGas = 9 + fromEnum AbsBrake = 10 + fromEnum AbsHat0x = 16 + fromEnum AbsHat0y = 17 + fromEnum AbsHat1x = 18 + fromEnum AbsHat1y = 19 + fromEnum AbsHat2x = 20 + fromEnum AbsHat2y = 21 + fromEnum AbsHat3x = 22 + fromEnum AbsHat3y = 23 + fromEnum AbsPressure = 24 + fromEnum AbsDistance = 25 + fromEnum AbsTiltX = 26 + fromEnum AbsTiltY = 27 + fromEnum AbsToolWidth = 28 + fromEnum AbsVolume = 32 + fromEnum AbsMisc = 40 + fromEnum AbsReserved = 46 + fromEnum AbsMtSlot = 47 + fromEnum AbsMtTouchMajor = 48 + fromEnum AbsMtTouchMinor = 49 + fromEnum AbsMtWidthMajor = 50 + fromEnum AbsMtWidthMinor = 51 + fromEnum AbsMtOrientation = 52 + fromEnum AbsMtPositionX = 53 + fromEnum AbsMtPositionY = 54 + fromEnum AbsMtToolType = 55 + fromEnum AbsMtBlobId = 56 + fromEnum AbsMtTrackingId = 57 + fromEnum AbsMtPressure = 58 + fromEnum AbsMtDistance = 59 + fromEnum AbsMtToolX = 60 + fromEnum AbsMtToolY = 61 + + toEnum 0 = AbsX + toEnum 1 = AbsY + toEnum 2 = AbsZ + toEnum 3 = AbsRx + toEnum 4 = AbsRy + toEnum 5 = AbsRz + toEnum 6 = AbsThrottle + toEnum 7 = AbsRudder + toEnum 8 = AbsWheel + toEnum 9 = AbsGas + toEnum 10 = AbsBrake + toEnum 16 = AbsHat0x + toEnum 17 = AbsHat0y + toEnum 18 = AbsHat1x + toEnum 19 = AbsHat1y + toEnum 20 = AbsHat2x + toEnum 21 = AbsHat2y + toEnum 22 = AbsHat3x + toEnum 23 = AbsHat3y + toEnum 24 = AbsPressure + toEnum 25 = AbsDistance + toEnum 26 = AbsTiltX + toEnum 27 = AbsTiltY + toEnum 28 = AbsToolWidth + toEnum 32 = AbsVolume + toEnum 40 = AbsMisc + toEnum 46 = AbsReserved + toEnum 47 = AbsMtSlot + toEnum 48 = AbsMtTouchMajor + toEnum 49 = AbsMtTouchMinor + toEnum 50 = AbsMtWidthMajor + toEnum 51 = AbsMtWidthMinor + toEnum 52 = AbsMtOrientation + toEnum 53 = AbsMtPositionX + toEnum 54 = AbsMtPositionY + toEnum 55 = AbsMtToolType + toEnum 56 = AbsMtBlobId + toEnum 57 = AbsMtTrackingId + toEnum 58 = AbsMtPressure + toEnum 59 = AbsMtDistance + toEnum 60 = AbsMtToolX + toEnum 61 = AbsMtToolY + toEnum unmatched = error ("AbsoluteAxis.toEnum: Cannot match " ++ show unmatched) + + + +-- | Stateful binary switches +data SwitchEvent = SwLid + | SwTabletMode + | SwHeadphoneInsert + | SwRfkillAll + | SwRadio + | SwMicrophoneInsert + | SwDock + | SwLineoutInsert + | SwJackPhysicalInsert + | SwVideooutInsert + | SwCameraLensCover + | SwKeypadSlide + | SwFrontProximity + | SwRotateLock + | SwLineinInsert + | SwMuteDevice + deriving (Bounded,Eq,Ord,Read,Show) +instance Enum SwitchEvent where + succ SwLid = SwTabletMode + succ SwTabletMode = SwHeadphoneInsert + succ SwHeadphoneInsert = SwRfkillAll + succ SwRfkillAll = SwMicrophoneInsert + succ SwRadio = SwMicrophoneInsert + succ SwMicrophoneInsert = SwDock + succ SwDock = SwLineoutInsert + succ SwLineoutInsert = SwJackPhysicalInsert + succ SwJackPhysicalInsert = SwVideooutInsert + succ SwVideooutInsert = SwCameraLensCover + succ SwCameraLensCover = SwKeypadSlide + succ SwKeypadSlide = SwFrontProximity + succ SwFrontProximity = SwRotateLock + succ SwRotateLock = SwLineinInsert + succ SwLineinInsert = SwMuteDevice + succ SwMuteDevice = error "SwitchEvent.succ: SwMuteDevice has no successor" + + pred SwTabletMode = SwLid + pred SwHeadphoneInsert = SwTabletMode + pred SwRfkillAll = SwHeadphoneInsert + pred SwRadio = SwHeadphoneInsert + pred SwMicrophoneInsert = SwRfkillAll + pred SwDock = SwMicrophoneInsert + pred SwLineoutInsert = SwDock + pred SwJackPhysicalInsert = SwLineoutInsert + pred SwVideooutInsert = SwJackPhysicalInsert + pred SwCameraLensCover = SwVideooutInsert + pred SwKeypadSlide = SwCameraLensCover + pred SwFrontProximity = SwKeypadSlide + pred SwRotateLock = SwFrontProximity + pred SwLineinInsert = SwRotateLock + pred SwMuteDevice = SwLineinInsert + pred SwLid = error "SwitchEvent.pred: SwLid has no predecessor" + + enumFromTo from to = go from + where + end = fromEnum to + go v = case compare (fromEnum v) end of + LT -> v : go (succ v) + EQ -> [v] + GT -> [] + + enumFrom from = enumFromTo from SwMuteDevice + + fromEnum SwLid = 0 + fromEnum SwTabletMode = 1 + fromEnum SwHeadphoneInsert = 2 + fromEnum SwRfkillAll = 3 + fromEnum SwRadio = 3 + fromEnum SwMicrophoneInsert = 4 + fromEnum SwDock = 5 + fromEnum SwLineoutInsert = 6 + fromEnum SwJackPhysicalInsert = 7 + fromEnum SwVideooutInsert = 8 + fromEnum SwCameraLensCover = 9 + fromEnum SwKeypadSlide = 10 + fromEnum SwFrontProximity = 11 + fromEnum SwRotateLock = 12 + fromEnum SwLineinInsert = 13 + fromEnum SwMuteDevice = 14 + + toEnum 0 = SwLid + toEnum 1 = SwTabletMode + toEnum 2 = SwHeadphoneInsert + toEnum 3 = SwRfkillAll + toEnum 4 = SwMicrophoneInsert + toEnum 5 = SwDock + toEnum 6 = SwLineoutInsert + toEnum 7 = SwJackPhysicalInsert + toEnum 8 = SwVideooutInsert + toEnum 9 = SwCameraLensCover + toEnum 10 = SwKeypadSlide + toEnum 11 = SwFrontProximity + toEnum 12 = SwRotateLock + toEnum 13 = SwLineinInsert + toEnum 14 = SwMuteDevice + toEnum unmatched = error ("SwitchEvent.toEnum: Cannot match " ++ show unmatched) + + + +-- | Miscellaneous +data MiscEvent = MscSerial + | MscPulseled + | MscGesture + | MscRaw + | MscScan + | MscTimestamp + deriving (Bounded,Eq,Ord,Read,Show) +instance Enum MiscEvent where + succ MscSerial = MscPulseled + succ MscPulseled = MscGesture + succ MscGesture = MscRaw + succ MscRaw = MscScan + succ MscScan = MscTimestamp + succ MscTimestamp = error "MiscEvent.succ: MscTimestamp has no successor" + + pred MscPulseled = MscSerial + pred MscGesture = MscPulseled + pred MscRaw = MscGesture + pred MscScan = MscRaw + pred MscTimestamp = MscScan + pred MscSerial = error "MiscEvent.pred: MscSerial has no predecessor" + + enumFromTo from to = go from + where + end = fromEnum to + go v = case compare (fromEnum v) end of + LT -> v : go (succ v) + EQ -> [v] + GT -> [] + + enumFrom from = enumFromTo from MscTimestamp + + fromEnum MscSerial = 0 + fromEnum MscPulseled = 1 + fromEnum MscGesture = 2 + fromEnum MscRaw = 3 + fromEnum MscScan = 4 + fromEnum MscTimestamp = 5 + + toEnum 0 = MscSerial + toEnum 1 = MscPulseled + toEnum 2 = MscGesture + toEnum 3 = MscRaw + toEnum 4 = MscScan + toEnum 5 = MscTimestamp + toEnum unmatched = error ("MiscEvent.toEnum: Cannot match " ++ show unmatched) + + + +-- | LEDs +data LEDEvent = LedNuml + | LedCapsl + | LedScrolll + | LedCompose + | LedKana + | LedSleep + | LedSuspend + | LedMute + | LedMisc + | LedMail + | LedCharging + deriving (Bounded,Eq,Ord,Read,Show) +instance Enum LEDEvent where + succ LedNuml = LedCapsl + succ LedCapsl = LedScrolll + succ LedScrolll = LedCompose + succ LedCompose = LedKana + succ LedKana = LedSleep + succ LedSleep = LedSuspend + succ LedSuspend = LedMute + succ LedMute = LedMisc + succ LedMisc = LedMail + succ LedMail = LedCharging + succ LedCharging = error "LEDEvent.succ: LedCharging has no successor" + + pred LedCapsl = LedNuml + pred LedScrolll = LedCapsl + pred LedCompose = LedScrolll + pred LedKana = LedCompose + pred LedSleep = LedKana + pred LedSuspend = LedSleep + pred LedMute = LedSuspend + pred LedMisc = LedMute + pred LedMail = LedMisc + pred LedCharging = LedMail + pred LedNuml = error "LEDEvent.pred: LedNuml has no predecessor" + + enumFromTo from to = go from + where + end = fromEnum to + go v = case compare (fromEnum v) end of + LT -> v : go (succ v) + EQ -> [v] + GT -> [] + + enumFrom from = enumFromTo from LedCharging + + fromEnum LedNuml = 0 + fromEnum LedCapsl = 1 + fromEnum LedScrolll = 2 + fromEnum LedCompose = 3 + fromEnum LedKana = 4 + fromEnum LedSleep = 5 + fromEnum LedSuspend = 6 + fromEnum LedMute = 7 + fromEnum LedMisc = 8 + fromEnum LedMail = 9 + fromEnum LedCharging = 10 + + toEnum 0 = LedNuml + toEnum 1 = LedCapsl + toEnum 2 = LedScrolll + toEnum 3 = LedCompose + toEnum 4 = LedKana + toEnum 5 = LedSleep + toEnum 6 = LedSuspend + toEnum 7 = LedMute + toEnum 8 = LedMisc + toEnum 9 = LedMail + toEnum 10 = LedCharging + toEnum unmatched = error ("LEDEvent.toEnum: Cannot match " ++ show unmatched) + + + +-- | Specifying autorepeating events +data RepeatEvent = RepDelay + | RepPeriod + deriving (Bounded,Eq,Ord,Read,Show) +instance Enum RepeatEvent where + succ RepDelay = RepPeriod + succ RepPeriod = error "RepeatEvent.succ: RepPeriod has no successor" + + pred RepPeriod = RepDelay + pred RepDelay = error "RepeatEvent.pred: RepDelay has no predecessor" + + enumFromTo from to = go from + where + end = fromEnum to + go v = case compare (fromEnum v) end of + LT -> v : go (succ v) + EQ -> [v] + GT -> [] + + enumFrom from = enumFromTo from RepPeriod + + fromEnum RepDelay = 0 + fromEnum RepPeriod = 1 + + toEnum 0 = RepDelay + toEnum 1 = RepPeriod + toEnum unmatched = error ("RepeatEvent.toEnum: Cannot match " ++ show unmatched) + + + +-- | For simple sound output devices +data SoundEvent = SndClick + | SndBell + | SndTone + deriving (Bounded,Eq,Ord,Read,Show) +instance Enum SoundEvent where + succ SndClick = SndBell + succ SndBell = SndTone + succ SndTone = error "SoundEvent.succ: SndTone has no successor" + + pred SndBell = SndClick + pred SndTone = SndBell + pred SndClick = error "SoundEvent.pred: SndClick has no predecessor" + + enumFromTo from to = go from + where + end = fromEnum to + go v = case compare (fromEnum v) end of + LT -> v : go (succ v) + EQ -> [v] + GT -> [] + + enumFrom from = enumFromTo from SndTone + + fromEnum SndClick = 0 + fromEnum SndBell = 1 + fromEnum SndTone = 2 + + toEnum 0 = SndClick + toEnum 1 = SndBell + toEnum 2 = SndTone + toEnum unmatched = error ("SoundEvent.toEnum: Cannot match " ++ show unmatched) + + + +-- | Device properties +data DeviceProperty = InputPropPointer + | InputPropDirect + | InputPropButtonpad + | InputPropSemiMt + | InputPropTopbuttonpad + | InputPropPointingStick + | InputPropAccelerometer + deriving (Bounded,Eq,Ord,Read,Show) +instance Enum DeviceProperty where + succ InputPropPointer = InputPropDirect + succ InputPropDirect = InputPropButtonpad + succ InputPropButtonpad = InputPropSemiMt + succ InputPropSemiMt = InputPropTopbuttonpad + succ InputPropTopbuttonpad = InputPropPointingStick + succ InputPropPointingStick = InputPropAccelerometer + succ InputPropAccelerometer = error "DeviceProperty.succ: InputPropAccelerometer has no successor" + + pred InputPropDirect = InputPropPointer + pred InputPropButtonpad = InputPropDirect + pred InputPropSemiMt = InputPropButtonpad + pred InputPropTopbuttonpad = InputPropSemiMt + pred InputPropPointingStick = InputPropTopbuttonpad + pred InputPropAccelerometer = InputPropPointingStick + pred InputPropPointer = error "DeviceProperty.pred: InputPropPointer has no predecessor" + + enumFromTo from to = go from + where + end = fromEnum to + go v = case compare (fromEnum v) end of + LT -> v : go (succ v) + EQ -> [v] + GT -> [] + + enumFrom from = enumFromTo from InputPropAccelerometer + + fromEnum InputPropPointer = 0 + fromEnum InputPropDirect = 1 + fromEnum InputPropButtonpad = 2 + fromEnum InputPropSemiMt = 3 + fromEnum InputPropTopbuttonpad = 4 + fromEnum InputPropPointingStick = 5 + fromEnum InputPropAccelerometer = 6 + + toEnum 0 = InputPropPointer + toEnum 1 = InputPropDirect + toEnum 2 = InputPropButtonpad + toEnum 3 = InputPropSemiMt + toEnum 4 = InputPropTopbuttonpad + toEnum 5 = InputPropPointingStick + toEnum 6 = InputPropAccelerometer + toEnum unmatched = error ("DeviceProperty.toEnum: Cannot match " ++ show unmatched) + + diff --git a/evdev/src/Evdev/LowLevel.chs b/evdev/src/Evdev/LowLevel.chs deleted file mode 100644 index e99c365..0000000 --- a/evdev/src/Evdev/LowLevel.chs +++ /dev/null @@ -1,205 +0,0 @@ -module Evdev.LowLevel where - -import Control.Monad (join) -import Data.ByteString (ByteString,packCString,useAsCString) -import Data.Coerce (coerce) -import Data.Int (Int32,Int64) -import Data.Word (Word16, Word32) -import Foreign (Ptr,allocaBytes,mallocBytes,mallocForeignPtrBytes,newForeignPtr_,nullPtr,peek,withForeignPtr) -import Foreign.C (CInt(..),CLong(..),CUInt(..),CUShort(..),CString) -import Foreign.C.Error (Errno(Errno), eOK, eAGAIN) -import System.Posix.Types (Fd(Fd)) - -import Evdev.Codes - -#include -#include -#include -#include - -{#enum libevdev_read_flag as ReadFlag { - LIBEVDEV_READ_FLAG_SYNC as Sync, - LIBEVDEV_READ_FLAG_NORMAL as Normal, - LIBEVDEV_READ_FLAG_FORCE_SYNC as ForceSync, - LIBEVDEV_READ_FLAG_BLOCKING as Blocking } - deriving (Eq,Ord,Show) #} - -{#enum libevdev_grab_mode as GrabMode { underscoreToCase } deriving (Show) #} - -{#pointer *libevdev as Device foreign finalizer libevdev_hs_close newtype #} ---TODO any reason c2hs doesn't allow a haskell function as the finalizer? - -- failing that, any reason not to have actual inline c? ---TODO expose this directly, seeing as the GC makes no guarantees of promptness -#c -void libevdev_hs_close(struct libevdev *dev); -#endc - -{#pointer *libevdev_uinput as UDevice foreign finalizer libevdev_uinput_destroy newtype #} - ---TODO '{#enum libevdev_uinput_open_mode {} #}' results in malformed output - c2hs bug -{#enum libevdev_uinput_open_mode as UInputOpenMode {LIBEVDEV_UINPUT_OPEN_MANAGED as UOMManaged} #} - - -data CEvent = CEvent - { cEventType :: Word16 - , cEventCode :: Word16 - , cEventValue :: Int32 - , cEventTime :: CTimeVal - } - deriving (Eq, Ord, Read, Show) - -data CTimeVal = CTimeVal - { tvSec :: Int64 - , tvUsec :: Int64 - } - deriving (Eq, Ord, Read, Show) - - -{- Complex stuff -} - -{#fun libevdev_next_event { `Device', `CUInt', `Ptr ()' } -> `Errno' Errno #} -nextEvent :: Device -> CUInt -> IO (Errno, CEvent) -nextEvent dev flags = allocaBytes {#sizeof input_event #} $ \evPtr -> - (,) <$> libevdev_next_event dev flags evPtr <*> getEvent evPtr -nextEventMay :: Device -> CUInt -> IO (Errno, Maybe CEvent) -nextEventMay dev flags = allocaBytes {#sizeof input_event #} $ \evPtr -> do - err <- libevdev_next_event dev flags evPtr - if err /= eOK - then return - ( if negateErrno err == eAGAIN then eOK else err - , Nothing - ) - else (eOK,) . Just <$> getEvent evPtr -getEvent :: Ptr () -> IO CEvent -getEvent evPtr = CEvent - <$> (coerce <$> {#get input_event->type #} evPtr) - <*> (coerce <$> {#get input_event->code #} evPtr) - <*> (coerce <$> {#get input_event->value #} evPtr) - <*> ( CTimeVal - <$> (coerce <$> {#get input_event->time.tv_sec #} evPtr) - <*> (coerce <$> {#get input_event->time.tv_usec #} evPtr) - ) - -{#fun libevdev_grab { `Device', `GrabMode' } -> `Errno' Errno #} -grabDevice :: Device -> GrabMode -> IO Errno -grabDevice = libevdev_grab - ---TODO use 'libevdev_new_from_fd' when https://github.com/haskell/c2hs/issues/236 fixed -{#fun libevdev_new {} -> `Device' #} -{#fun libevdev_set_fd { `Device', unFd `Fd' } -> `Errno' Errno #} -newDeviceFromFd :: Fd -> IO (Errno, Device) -newDeviceFromFd fd = libevdev_new >>= \dev -> (, dev) <$> libevdev_set_fd dev fd - ---TODO 'useAsCString' copies, which seems unnecessary due to the 'const' in the C function -{#fun libevdev_set_name { `Device', `CString' } -> `()' #} -setDeviceName :: Device -> ByteString -> IO () -setDeviceName dev name = useAsCString name $ libevdev_set_name dev -{#fun libevdev_set_phys { `Device', `CString' } -> `()' #} -setDevicePhys :: Device -> ByteString -> IO () -setDevicePhys dev phys = useAsCString phys $ libevdev_set_phys dev -{#fun libevdev_set_uniq { `Device', `CString' } -> `()' #} -setDeviceUniq :: Device -> ByteString -> IO () -setDeviceUniq dev uniq = useAsCString uniq $ libevdev_set_uniq dev - ---TODO c2hs can't seem to help us here due to the nested pointer -foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_uinput_create_from_device" - libevdev_uinput_create_from_device :: Ptr Device -> CInt -> Ptr (Ptr UDevice) -> IO CInt -createFromDevice :: Device -> Fd -> IO (Errno, UDevice) -createFromDevice dev (Fd fd) = withDevice dev $ \devP -> do - devFPP <- mallocForeignPtrBytes 0 - (e,x) <- withForeignPtr devFPP $ \devPP -> - (,) <$> libevdev_uinput_create_from_device devP fd devPP <*> peek devPP - devFP <- newForeignPtr_ x - return (Errno e, UDevice devFP) - ---TODO since the same technique produces just one 'IO' for 'deviceName', is this another c2hs bug? -{#fun libevdev_uinput_get_syspath { `UDevice' } -> `IO (Maybe ByteString)' packCString' #} -getSyspath :: UDevice -> IO (Maybe ByteString) -getSyspath = join . libevdev_uinput_get_syspath -{#fun libevdev_uinput_get_devnode { `UDevice' } -> `IO (Maybe ByteString)' packCString' #} -getDevnode :: UDevice -> IO (Maybe ByteString) -getDevnode = join . libevdev_uinput_get_devnode - -data AbsInfo = AbsInfo - { absValue :: Int32 - , absMinimum :: Int32 - , absMaximum :: Int32 - , absFuzz :: Int32 - , absFlat :: Int32 - , absResolution :: Int32 - } - deriving (Show) -withAbsInfo :: AbsInfo -> (Ptr () -> IO a) -> IO a -withAbsInfo AbsInfo{..} f = do - p <- mallocBytes {#sizeof input_absinfo#} - {#set input_absinfo.value#} p $ CInt absValue - {#set input_absinfo.minimum#} p $ CInt absMinimum - {#set input_absinfo.maximum#} p $ CInt absMaximum - {#set input_absinfo.fuzz#} p $ CInt absFuzz - {#set input_absinfo.flat#} p $ CInt absFlat - {#set input_absinfo.resolution#} p $ CInt absResolution - pf <- newForeignPtr_ p - withForeignPtr pf f - ---TODO can c2hs make this simpler at all? -foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_get_abs_info" - libevdev_get_abs_info :: Ptr Device -> CUInt -> IO (Ptr ()) -getAbsInfo :: Device -> Word32 -> IO (Maybe AbsInfo) -getAbsInfo dev x = withDevice dev \devPtr -> - libevdev_get_abs_info devPtr (CUInt x) >>= handleNull (pure Nothing) \absinfoPtr -> do - CInt absValue <- {#get input_absinfo.value#} absinfoPtr - CInt absMinimum <- {#get input_absinfo.minimum#} absinfoPtr - CInt absMaximum <- {#get input_absinfo.maximum#} absinfoPtr - CInt absFuzz <- {#get input_absinfo.fuzz#} absinfoPtr - CInt absFlat <- {#get input_absinfo.flat#} absinfoPtr - CInt absResolution <- {#get input_absinfo.resolution#} absinfoPtr - pure $ Just AbsInfo{..} - - -{- Simpler functions -} - -{#fun libevdev_has_property as hasProperty { `Device', convertEnum `DeviceProperty' } -> `Bool' #} -{#fun libevdev_has_event_type as hasEventType { `Device', convertEnum `EventType' } -> `Bool' #} -{#fun libevdev_has_event_code as hasEventCode { `Device', `Word16', `Word16' } -> `Bool' #} -{#fun libevdev_get_fd as deviceFd { `Device' } -> `Fd' Fd #} -{#fun libevdev_get_name as deviceName { `Device' } -> `IO ByteString' packCString #} -{#fun libevdev_get_phys as devicePhys { `Device' } -> `IO (Maybe ByteString)' packCString' #} -{#fun libevdev_get_uniq as deviceUniq { `Device' } -> `IO (Maybe ByteString)' packCString' #} -{#fun libevdev_get_id_product as deviceProduct { `Device' } -> `Int' #} -{#fun libevdev_get_id_vendor as deviceVendor { `Device' } -> `Int' #} -{#fun libevdev_get_id_bustype as deviceBustype { `Device' } -> `Int' #} -{#fun libevdev_get_id_version as deviceVersion { `Device' } -> `Int' #} -{#fun libevdev_set_id_product { `Device', `Int' } -> `()' #} -{#fun libevdev_set_id_vendor { `Device', `Int' } -> `()' #} -{#fun libevdev_set_id_bustype { `Device', `Int' } -> `()' #} -{#fun libevdev_set_id_version { `Device', `Int' } -> `()' #} -{#fun libevdev_enable_event_type as enableType { `Device', `Word16' } -> `Errno' Errno #} -{#fun libevdev_enable_event_code as enableCode { `Device', `Word16', `Word16', `Ptr ()' } -> `Errno' Errno #} -{#fun libevdev_uinput_write_event as writeEvent { `UDevice', `Word16', `Word16', `Int32' } -> `Errno' Errno #} - --- | LEDs values -{#enum define LEDValue { - LIBEVDEV_LED_ON as LedOn, - LIBEVDEV_LED_OFF as LedOff} - deriving (Bounded, Eq, Ord, Read, Show) #} -{#fun libevdev_kernel_set_led_value { `Device', convertEnum `LEDEvent', `LEDValue' } -> `Errno' Errno #} - -{- Util -} - -convertEnum :: (Enum a, Integral b) => a -> b -convertEnum = fromIntegral . fromEnum - -(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d -(.:) = (.) . (.) - -unFd :: Fd -> CInt -unFd (Fd n) = n - -handleNull :: b -> (Ptr a -> b) -> Ptr a -> b -handleNull def f p = if p == nullPtr then def else f p - -packCString' :: CString -> IO (Maybe ByteString) -packCString' = handleNull (return Nothing) (fmap Just . packCString) - -negateErrno :: Errno -> Errno -negateErrno (Errno cint) = Errno (-cint) diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs new file mode 100644 index 0000000..1a55c96 --- /dev/null +++ b/evdev/src/Evdev/LowLevel.hs @@ -0,0 +1,407 @@ +{-# LANGUAGE DisambiguateRecordFields #-} + +-- | Low-level bindings to libevdev, wrapping the hs-bindgen raw bindings. +module Evdev.LowLevel ( + -- * Enums + ReadFlag(..), + GrabMode(..), + LEDValue(..), + UInputOpenMode(..), + + -- * Opaque device types + Device, + withDevice, + UDevice, + withUDevice, + + -- * Data types + CEvent(..), + CTimeVal(..), + AbsInfo(..), + + -- * Device lifecycle + newDeviceFromFd, + libevdev_new, + libevdev_set_fd, + + -- * Events + nextEvent, + nextEventMay, + + -- * Grabbing + grabDevice, + + -- * Device properties (getters) + deviceFd, + deviceName, + devicePhys, + deviceUniq, + deviceProduct, + deviceVendor, + deviceBustype, + deviceVersion, + + -- * Device properties (setters) + setDeviceName, + setDevicePhys, + setDeviceUniq, + libevdev_set_id_product, + libevdev_set_id_vendor, + libevdev_set_id_bustype, + libevdev_set_id_version, + + -- * Capability queries + hasProperty, + hasEventType, + hasEventCode, + + -- * Abs info + getAbsInfo, + withAbsInfo, + + -- * Event enabling + enableType, + enableCode, + + -- * Uinput + createFromDevice, + getSyspath, + getDevnode, + writeEvent, + + -- * LEDs + libevdev_kernel_set_led_value, + + -- * Util + convertEnum, + negateErrno, +) where + +import Data.ByteString (ByteString, packCString, useAsCString) +import Data.Int (Int32, Int64) +import Data.Word (Word16, Word32) +import Foreign (ForeignPtr, FunPtr, Ptr, allocaBytes, castPtr, mallocBytes, mallocForeignPtrBytes, newForeignPtr, newForeignPtr_, nullPtr, peek, poke, withForeignPtr) +import Foreign.C (CInt(..), CLong(..), CUInt(..), CUShort(..), CString) +import Foreign.C.ConstPtr (ConstPtr(..)) +import Foreign.C.Error (Errno(Errno), eOK, eAGAIN) +import Foreign.Storable (sizeOf) +import System.Posix.Types (Fd(Fd)) + +import Evdev.Raw (Libevdev, Libevdev_uinput, Input_event(..), Input_absinfo(..), Timeval(..), C__U16(..), C__S32(..), C__Time_t(..), C__Suseconds_t(..)) +import qualified Evdev.Raw as Raw +import Evdev.Codes (DeviceProperty, EventType, LEDEvent) + +-- * Enums + +data ReadFlag = Sync | Normal | ForceSync | Blocking + deriving (Eq, Ord, Show, Enum) + +data GrabMode = LibevdevGrab | LibevdevUngrab + deriving (Show, Enum) + +data LEDValue = LedOn | LedOff + deriving (Bounded, Eq, Ord, Read, Show, Enum) + +data UInputOpenMode = UOMManaged + deriving (Show, Enum) + +readFlagToRaw :: ReadFlag -> Raw.Libevdev_read_flag +readFlagToRaw = \case + Sync -> Raw.LIBEVDEV_READ_FLAG_SYNC + Normal -> Raw.LIBEVDEV_READ_FLAG_NORMAL + ForceSync -> Raw.LIBEVDEV_READ_FLAG_FORCE_SYNC + Blocking -> Raw.LIBEVDEV_READ_FLAG_BLOCKING + +grabModeToRaw :: GrabMode -> Raw.Libevdev_grab_mode +grabModeToRaw = \case + LibevdevGrab -> Raw.LIBEVDEV_GRAB + LibevdevUngrab -> Raw.LIBEVDEV_UNGRAB + +ledValueToRaw :: LEDValue -> Raw.Libevdev_led_value +ledValueToRaw = \case + LedOn -> Raw.LIBEVDEV_LED_ON + LedOff -> Raw.LIBEVDEV_LED_OFF + +-- * Opaque device types + +newtype Device = Device (ForeignPtr Libevdev) +newtype UDevice = UDevice (ForeignPtr Libevdev_uinput) + +withDevice :: Device -> (Ptr Libevdev -> IO a) -> IO a +withDevice (Device fp) = withForeignPtr fp + +withUDevice :: UDevice -> (Ptr Libevdev_uinput -> IO a) -> IO a +withUDevice (UDevice fp) = withForeignPtr fp + +foreign import ccall "&libevdev_hs_close" finalizer_libevdev_hs_close :: FunPtr (Ptr Libevdev -> IO ()) +foreign import ccall "&libevdev_uinput_destroy" finalizer_libevdev_uinput_destroy :: FunPtr (Ptr Libevdev_uinput -> IO ()) + +-- | Convert a Ptr to a ConstPtr (for calling const-qualified C functions) +constPtr :: Ptr a -> ConstPtr a +constPtr = ConstPtr + +-- | Convert a ConstPtr to a regular Ptr +unConstPtr' :: ConstPtr a -> Ptr a +unConstPtr' (ConstPtr p) = p + +-- * Data types + +data CEvent = CEvent + { cEventType :: Word16 + , cEventCode :: Word16 + , cEventValue :: Int32 + , cEventTime :: CTimeVal + } + deriving (Eq, Ord, Read, Show) + +data CTimeVal = CTimeVal + { tvSec :: Int64 + , tvUsec :: Int64 + } + deriving (Eq, Ord, Read, Show) + +data AbsInfo = AbsInfo + { absValue :: Int32 + , absMinimum :: Int32 + , absMaximum :: Int32 + , absFuzz :: Int32 + , absFlat :: Int32 + , absResolution :: Int32 + } + deriving (Show) + +-- * Device lifecycle + +libevdev_new :: IO Device +libevdev_new = do + ptr <- Raw.libevdev_new + fp <- newForeignPtr finalizer_libevdev_hs_close ptr + pure (Device fp) + +libevdev_set_fd :: Device -> Fd -> IO Errno +libevdev_set_fd dev (Fd fd) = withDevice dev $ \devPtr -> + Errno <$> Raw.libevdev_set_fd devPtr fd + +newDeviceFromFd :: Fd -> IO (Errno, Device) +newDeviceFromFd fd = do + dev <- libevdev_new + err <- libevdev_set_fd dev fd + pure (err, dev) + +-- * Events + +inputEventSize :: Int +inputEventSize = sizeOf (undefined :: Input_event) + +nextEvent :: Device -> CUInt -> IO (Errno, CEvent) +nextEvent dev flags = withDevice dev $ \devPtr -> + allocaBytes inputEventSize $ \evPtr -> do + err <- Raw.libevdev_next_event devPtr flags (castPtr evPtr) + ev <- getEvent evPtr + pure (Errno err, ev) + +nextEventMay :: Device -> CUInt -> IO (Errno, Maybe CEvent) +nextEventMay dev flags = withDevice dev $ \devPtr -> + allocaBytes inputEventSize $ \evPtr -> do + err <- Raw.libevdev_next_event devPtr flags (castPtr evPtr) + if Errno err /= eOK + then pure + ( if negateErrno (Errno err) == eAGAIN then eOK else Errno err + , Nothing + ) + else do + ev <- getEvent evPtr + pure (eOK, Just ev) + +getEvent :: Ptr Input_event -> IO CEvent +getEvent evPtr = do + Input_event{time, type', code, value} <- peek evPtr + let C__U16 (CUShort t) = type' + C__U16 (CUShort c) = code + C__S32 (CInt v) = value + Timeval{tv_sec, tv_usec} = time + C__Time_t (CLong sec) = tv_sec + C__Suseconds_t (CLong usec) = tv_usec + pure $ CEvent + { cEventType = fromIntegral t + , cEventCode = fromIntegral c + , cEventValue = fromIntegral v + , cEventTime = CTimeVal (fromIntegral sec) (fromIntegral usec) + } + +-- * Grabbing + +grabDevice :: Device -> GrabMode -> IO Errno +grabDevice dev mode = withDevice dev $ \devPtr -> + Errno <$> Raw.libevdev_grab devPtr (grabModeToRaw mode) + +-- * Device properties (getters) + +deviceFd :: Device -> IO Fd +deviceFd dev = withDevice dev $ \devPtr -> + Fd <$> Raw.libevdev_get_fd (constPtr devPtr) + +deviceName :: Device -> IO (IO ByteString) +deviceName dev = withDevice dev $ \devPtr -> do + cstr <- Raw.libevdev_get_name (constPtr devPtr) + pure $ packCString (unConstPtr' cstr) + +devicePhys :: Device -> IO (IO (Maybe ByteString)) +devicePhys dev = withDevice dev $ \devPtr -> do + cstr <- Raw.libevdev_get_phys (constPtr devPtr) + pure $ packCString' (unConstPtr' cstr) + +deviceUniq :: Device -> IO (IO (Maybe ByteString)) +deviceUniq dev = withDevice dev $ \devPtr -> do + cstr <- Raw.libevdev_get_uniq (constPtr devPtr) + pure $ packCString' (unConstPtr' cstr) + +deviceProduct :: Device -> IO Int +deviceProduct dev = withDevice dev $ \devPtr -> + fromIntegral <$> Raw.libevdev_get_id_product (constPtr devPtr) + +deviceVendor :: Device -> IO Int +deviceVendor dev = withDevice dev $ \devPtr -> + fromIntegral <$> Raw.libevdev_get_id_vendor (constPtr devPtr) + +deviceBustype :: Device -> IO Int +deviceBustype dev = withDevice dev $ \devPtr -> + fromIntegral <$> Raw.libevdev_get_id_bustype (constPtr devPtr) + +deviceVersion :: Device -> IO Int +deviceVersion dev = withDevice dev $ \devPtr -> + fromIntegral <$> Raw.libevdev_get_id_version (constPtr devPtr) + +-- * Device properties (setters) + +setDeviceName :: Device -> ByteString -> IO () +setDeviceName dev name = withDevice dev $ \devPtr -> + useAsCString name $ \cstr -> Raw.libevdev_set_name devPtr (constPtr cstr) + +setDevicePhys :: Device -> ByteString -> IO () +setDevicePhys dev phys = withDevice dev $ \devPtr -> + useAsCString phys $ \cstr -> Raw.libevdev_set_phys devPtr (constPtr cstr) + +setDeviceUniq :: Device -> ByteString -> IO () +setDeviceUniq dev uniq = withDevice dev $ \devPtr -> + useAsCString uniq $ \cstr -> Raw.libevdev_set_uniq devPtr (constPtr cstr) + +libevdev_set_id_product :: Device -> Int -> IO () +libevdev_set_id_product dev n = withDevice dev $ \devPtr -> + Raw.libevdev_set_id_product devPtr (fromIntegral n) + +libevdev_set_id_vendor :: Device -> Int -> IO () +libevdev_set_id_vendor dev n = withDevice dev $ \devPtr -> + Raw.libevdev_set_id_vendor devPtr (fromIntegral n) + +libevdev_set_id_bustype :: Device -> Int -> IO () +libevdev_set_id_bustype dev n = withDevice dev $ \devPtr -> + Raw.libevdev_set_id_bustype devPtr (fromIntegral n) + +libevdev_set_id_version :: Device -> Int -> IO () +libevdev_set_id_version dev n = withDevice dev $ \devPtr -> + Raw.libevdev_set_id_version devPtr (fromIntegral n) + +-- * Capability queries + +hasProperty :: Device -> DeviceProperty -> IO Bool +hasProperty dev prop = withDevice dev $ \devPtr -> + (/= 0) <$> Raw.libevdev_has_property (constPtr devPtr) (convertEnum prop) + +hasEventType :: Device -> EventType -> IO Bool +hasEventType dev et = withDevice dev $ \devPtr -> + (/= 0) <$> Raw.libevdev_has_event_type (constPtr devPtr) (convertEnum et) + +hasEventCode :: Device -> Word16 -> Word16 -> IO Bool +hasEventCode dev t c = withDevice dev $ \devPtr -> + (/= 0) <$> Raw.libevdev_has_event_code (constPtr devPtr) (fromIntegral t) (fromIntegral c) + +-- * Abs info + +getAbsInfo :: Device -> Word32 -> IO (Maybe AbsInfo) +getAbsInfo dev code = withDevice dev $ \devPtr -> do + ptr <- Raw.libevdev_get_abs_info (constPtr devPtr) (CUInt code) + let rawPtr = unConstPtr' ptr :: Ptr Input_absinfo + if rawPtr == nullPtr + then pure Nothing + else do + Input_absinfo + { value = C__S32 (CInt v) + , minimum = C__S32 (CInt mn) + , maximum = C__S32 (CInt mx) + , fuzz = C__S32 (CInt fz) + , flat = C__S32 (CInt fl) + , resolution = C__S32 (CInt res) + } <- peek rawPtr + pure $ Just AbsInfo + { absValue = v + , absMinimum = mn + , absMaximum = mx + , absFuzz = fz + , absFlat = fl + , absResolution = res + } + +withAbsInfo :: AbsInfo -> (Ptr () -> IO a) -> IO a +withAbsInfo AbsInfo{..} f = do + let info = Input_absinfo + { value = C__S32 (CInt absValue) + , minimum = C__S32 (CInt absMinimum) + , maximum = C__S32 (CInt absMaximum) + , fuzz = C__S32 (CInt absFuzz) + , flat = C__S32 (CInt absFlat) + , resolution = C__S32 (CInt absResolution) + } + p <- mallocBytes (sizeOf info) + poke (castPtr p) info + fp <- newForeignPtr_ p + withForeignPtr fp f + +-- * Event enabling + +enableType :: Device -> Word16 -> IO Errno +enableType dev t = withDevice dev $ \devPtr -> + Errno <$> Raw.libevdev_enable_event_type devPtr (fromIntegral t) + +enableCode :: Device -> Word16 -> Word16 -> Ptr () -> IO Errno +enableCode dev t c dataPtr = withDevice dev $ \devPtr -> + Errno <$> Raw.libevdev_enable_event_code devPtr (fromIntegral t) (fromIntegral c) (constPtr $ castPtr dataPtr) + +-- * Uinput + +createFromDevice :: Device -> Fd -> IO (Errno, UDevice) +createFromDevice dev (Fd fd) = withDevice dev $ \devPtr -> do + udevPtrPtr <- mallocForeignPtrBytes (sizeOf (undefined :: Ptr ())) + (e, udevPtr) <- withForeignPtr udevPtrPtr $ \pp -> + (,) <$> Raw.libevdev_uinput_create_from_device (constPtr devPtr) fd (castPtr pp) <*> peek pp + udevFP <- newForeignPtr_ udevPtr + pure (Errno e, UDevice udevFP) + +getSyspath :: UDevice -> IO (Maybe ByteString) +getSyspath dev = withUDevice dev $ \devPtr -> + Raw.libevdev_uinput_get_syspath devPtr >>= packCString' . unConstPtr' + +getDevnode :: UDevice -> IO (Maybe ByteString) +getDevnode dev = withUDevice dev $ \devPtr -> + Raw.libevdev_uinput_get_devnode devPtr >>= packCString' . unConstPtr' + +writeEvent :: UDevice -> Word16 -> Word16 -> Int32 -> IO Errno +writeEvent dev t c v = withUDevice dev $ \devPtr -> + Errno <$> Raw.libevdev_uinput_write_event (constPtr devPtr) (fromIntegral t) (fromIntegral c) (fromIntegral v) + +-- * LEDs + +libevdev_kernel_set_led_value :: Device -> LEDEvent -> LEDValue -> IO Errno +libevdev_kernel_set_led_value dev led val = withDevice dev $ \devPtr -> + Errno <$> Raw.libevdev_kernel_set_led_value devPtr (convertEnum led) (ledValueToRaw val) + +-- * Util + +convertEnum :: (Enum a, Integral b) => a -> b +convertEnum = fromIntegral . fromEnum + +packCString' :: CString -> IO (Maybe ByteString) +packCString' p = if p == nullPtr then pure Nothing else Just <$> packCString p + +negateErrno :: Errno -> Errno +negateErrno (Errno cint) = Errno (-cint) diff --git a/evdev/src/Evdev/Raw.hs b/evdev/src/Evdev/Raw.hs new file mode 100644 index 0000000..ffeba48 --- /dev/null +++ b/evdev/src/Evdev/Raw.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE NoFieldSelectors #-} + +module Evdev.Raw where + +import HsBindgen.Runtime.LibC qualified +import HsBindgen.TH + +do + withHsBindgen + def + { clang = + def + { extraIncludeDirs = + [ Dir "/nix/store/iqs23in0fqnf44vnb8l98x7bai77jiv3-libevdev-1.13.4/include" + , Dir "/nix/store/iqs23in0fqnf44vnb8l98x7bai77jiv3-libevdev-1.13.4/include/libevdev-1.0" + , Dir "/nix/store/7iwv8dcgsjmkrnn752hnfdxh3f7wahmd-linux-headers-6.16.7/include" + , Dir "/nix/store/gi4cz4ir3zlwhf1azqfgxqdnczfrwsr7-glibc-2.40-66-dev/include" + , Dir "/nix/store/kl4w4f8bb77faahsdv40gjmfzg2d081d-clang-21.1.2-lib/lib/clang/21/include" + ] + } + , fieldNamingStrategy = OmitFieldPrefixes + , programSlicing = EnableProgramSlicing + } + def + do + hashInclude "libevdev-1.0/libevdev/libevdev.h" + hashInclude "libevdev-1.0/libevdev/libevdev-uinput.h" + hashInclude "linux/input.h" + hashInclude "linux/input-event-codes.h" From 962fb09b211d4ceedc1580007d99588dccb0337a Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 00:51:51 +0100 Subject: [PATCH 04/55] use uinput finalizer --- evdev/src/Evdev/LowLevel.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index 1a55c96..82f83ca 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -374,7 +374,7 @@ createFromDevice dev (Fd fd) = withDevice dev $ \devPtr -> do udevPtrPtr <- mallocForeignPtrBytes (sizeOf (undefined :: Ptr ())) (e, udevPtr) <- withForeignPtr udevPtrPtr $ \pp -> (,) <$> Raw.libevdev_uinput_create_from_device (constPtr devPtr) fd (castPtr pp) <*> peek pp - udevFP <- newForeignPtr_ udevPtr + udevFP <- newForeignPtr finalizer_libevdev_uinput_destroy udevPtr pure (Errno e, UDevice udevFP) getSyspath :: UDevice -> IO (Maybe ByteString) From 48b80853926e425f46a2fbd2d07ebd9f1b92d787 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 00:59:45 +0100 Subject: [PATCH 05/55] fix examples etc. by using correct enum conversions --- evdev/src/Evdev/LowLevel.hs | 34 ++++++++++++++++++++++++++++++---- 1 file changed, 30 insertions(+), 4 deletions(-) diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index 82f83ca..5133177 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -94,16 +94,42 @@ import Evdev.Codes (DeviceProperty, EventType, LEDEvent) -- * Enums data ReadFlag = Sync | Normal | ForceSync | Blocking - deriving (Eq, Ord, Show, Enum) + deriving (Eq, Ord, Show) +instance Enum ReadFlag where + fromEnum Sync = 1 + fromEnum Normal = 2 + fromEnum ForceSync = 4 + fromEnum Blocking = 8 + toEnum 1 = Sync + toEnum 2 = Normal + toEnum 4 = ForceSync + toEnum 8 = Blocking + toEnum n = error $ "ReadFlag.toEnum: Cannot match " ++ show n data GrabMode = LibevdevGrab | LibevdevUngrab - deriving (Show, Enum) + deriving (Show) +instance Enum GrabMode where + fromEnum LibevdevGrab = 3 + fromEnum LibevdevUngrab = 4 + toEnum 3 = LibevdevGrab + toEnum 4 = LibevdevUngrab + toEnum n = error $ "GrabMode.toEnum: Cannot match " ++ show n data LEDValue = LedOn | LedOff - deriving (Bounded, Eq, Ord, Read, Show, Enum) + deriving (Bounded, Eq, Ord, Read, Show) +instance Enum LEDValue where + fromEnum LedOn = 3 + fromEnum LedOff = 4 + toEnum 3 = LedOn + toEnum 4 = LedOff + toEnum n = error $ "LEDValue.toEnum: Cannot match " ++ show n data UInputOpenMode = UOMManaged - deriving (Show, Enum) + deriving (Show) +instance Enum UInputOpenMode where + fromEnum UOMManaged = -2 + toEnum (-2) = UOMManaged + toEnum n = error $ "UInputOpenMode.toEnum: Cannot match " ++ show n readFlagToRaw :: ReadFlag -> Raw.Libevdev_read_flag readFlagToRaw = \case From f2dd91529cbf144d046231c103b74c7cc9e28663 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 00:59:54 +0100 Subject: [PATCH 06/55] refactor to avoid hardcoding numbers --- evdev/src/Evdev/LowLevel.hs | 52 +++++++++++++++++++++---------------- 1 file changed, 30 insertions(+), 22 deletions(-) diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index 5133177..2a7a1df 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -93,43 +93,51 @@ import Evdev.Codes (DeviceProperty, EventType, LEDEvent) -- * Enums +-- | Extract an Int from an hs-bindgen enum newtype +rawEnum :: Integral a => a -> Int +rawEnum = fromIntegral + data ReadFlag = Sync | Normal | ForceSync | Blocking deriving (Eq, Ord, Show) instance Enum ReadFlag where - fromEnum Sync = 1 - fromEnum Normal = 2 - fromEnum ForceSync = 4 - fromEnum Blocking = 8 - toEnum 1 = Sync - toEnum 2 = Normal - toEnum 4 = ForceSync - toEnum 8 = Blocking - toEnum n = error $ "ReadFlag.toEnum: Cannot match " ++ show n + fromEnum Sync = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_SYNC in rawEnum n + fromEnum Normal = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_NORMAL in rawEnum n + fromEnum ForceSync = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_FORCE_SYNC in rawEnum n + fromEnum Blocking = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_BLOCKING in rawEnum n + toEnum n + | n == fromEnum Sync = Sync + | n == fromEnum Normal = Normal + | n == fromEnum ForceSync = ForceSync + | n == fromEnum Blocking = Blocking + | otherwise = error $ "ReadFlag.toEnum: Cannot match " ++ show n data GrabMode = LibevdevGrab | LibevdevUngrab deriving (Show) instance Enum GrabMode where - fromEnum LibevdevGrab = 3 - fromEnum LibevdevUngrab = 4 - toEnum 3 = LibevdevGrab - toEnum 4 = LibevdevUngrab - toEnum n = error $ "GrabMode.toEnum: Cannot match " ++ show n + fromEnum LibevdevGrab = let Raw.Libevdev_grab_mode n = Raw.LIBEVDEV_GRAB in rawEnum n + fromEnum LibevdevUngrab = let Raw.Libevdev_grab_mode n = Raw.LIBEVDEV_UNGRAB in rawEnum n + toEnum n + | n == fromEnum LibevdevGrab = LibevdevGrab + | n == fromEnum LibevdevUngrab = LibevdevUngrab + | otherwise = error $ "GrabMode.toEnum: Cannot match " ++ show n data LEDValue = LedOn | LedOff deriving (Bounded, Eq, Ord, Read, Show) instance Enum LEDValue where - fromEnum LedOn = 3 - fromEnum LedOff = 4 - toEnum 3 = LedOn - toEnum 4 = LedOff - toEnum n = error $ "LEDValue.toEnum: Cannot match " ++ show n + fromEnum LedOn = let Raw.Libevdev_led_value n = Raw.LIBEVDEV_LED_ON in rawEnum n + fromEnum LedOff = let Raw.Libevdev_led_value n = Raw.LIBEVDEV_LED_OFF in rawEnum n + toEnum n + | n == fromEnum LedOn = LedOn + | n == fromEnum LedOff = LedOff + | otherwise = error $ "LEDValue.toEnum: Cannot match " ++ show n data UInputOpenMode = UOMManaged deriving (Show) instance Enum UInputOpenMode where - fromEnum UOMManaged = -2 - toEnum (-2) = UOMManaged - toEnum n = error $ "UInputOpenMode.toEnum: Cannot match " ++ show n + fromEnum UOMManaged = let Raw.Libevdev_uinput_open_mode n = Raw.LIBEVDEV_UINPUT_OPEN_MANAGED in rawEnum n + toEnum n + | n == fromEnum UOMManaged = UOMManaged + | otherwise = error $ "UInputOpenMode.toEnum: Cannot match " ++ show n readFlagToRaw :: ReadFlag -> Raw.Libevdev_read_flag readFlagToRaw = \case From b3fcd8769fea2dae3702ba93d9caa8b7ffbdbbf8 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 01:05:08 +0100 Subject: [PATCH 07/55] remove unused function --- evdev/src/Evdev/LowLevel.hs | 7 ------- 1 file changed, 7 deletions(-) diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index 2a7a1df..d0abfec 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -139,13 +139,6 @@ instance Enum UInputOpenMode where | n == fromEnum UOMManaged = UOMManaged | otherwise = error $ "UInputOpenMode.toEnum: Cannot match " ++ show n -readFlagToRaw :: ReadFlag -> Raw.Libevdev_read_flag -readFlagToRaw = \case - Sync -> Raw.LIBEVDEV_READ_FLAG_SYNC - Normal -> Raw.LIBEVDEV_READ_FLAG_NORMAL - ForceSync -> Raw.LIBEVDEV_READ_FLAG_FORCE_SYNC - Blocking -> Raw.LIBEVDEV_READ_FLAG_BLOCKING - grabModeToRaw :: GrabMode -> Raw.Libevdev_grab_mode grabModeToRaw = \case LibevdevGrab -> Raw.LIBEVDEV_GRAB From 91532e76cffdf6bcd6ff73068b8bf7059e888374 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 10:23:11 +0100 Subject: [PATCH 08/55] minimise TH paths --- evdev/src/Evdev/Raw.hs | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/evdev/src/Evdev/Raw.hs b/evdev/src/Evdev/Raw.hs index ffeba48..428726c 100644 --- a/evdev/src/Evdev/Raw.hs +++ b/evdev/src/Evdev/Raw.hs @@ -20,11 +20,8 @@ do { clang = def { extraIncludeDirs = - [ Dir "/nix/store/iqs23in0fqnf44vnb8l98x7bai77jiv3-libevdev-1.13.4/include" - , Dir "/nix/store/iqs23in0fqnf44vnb8l98x7bai77jiv3-libevdev-1.13.4/include/libevdev-1.0" - , Dir "/nix/store/7iwv8dcgsjmkrnn752hnfdxh3f7wahmd-linux-headers-6.16.7/include" + [ Dir "/nix/store/iqs23in0fqnf44vnb8l98x7bai77jiv3-libevdev-1.13.4/include/libevdev-1.0" , Dir "/nix/store/gi4cz4ir3zlwhf1azqfgxqdnczfrwsr7-glibc-2.40-66-dev/include" - , Dir "/nix/store/kl4w4f8bb77faahsdv40gjmfzg2d081d-clang-21.1.2-lib/lib/clang/21/include" ] } , fieldNamingStrategy = OmitFieldPrefixes @@ -32,7 +29,5 @@ do } def do - hashInclude "libevdev-1.0/libevdev/libevdev.h" - hashInclude "libevdev-1.0/libevdev/libevdev-uinput.h" - hashInclude "linux/input.h" - hashInclude "linux/input-event-codes.h" + hashInclude "libevdev/libevdev.h" + hashInclude "libevdev/libevdev-uinput.h" From ca568564072647ce1749f5ac27d221726de05dbc Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 10:23:51 +0100 Subject: [PATCH 09/55] simplify header --- evdev/src/Evdev/LowLevel.hs | 79 +------------------------------------ 1 file changed, 1 insertion(+), 78 deletions(-) diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index d0abfec..494c89f 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -1,81 +1,4 @@ -{-# LANGUAGE DisambiguateRecordFields #-} - --- | Low-level bindings to libevdev, wrapping the hs-bindgen raw bindings. -module Evdev.LowLevel ( - -- * Enums - ReadFlag(..), - GrabMode(..), - LEDValue(..), - UInputOpenMode(..), - - -- * Opaque device types - Device, - withDevice, - UDevice, - withUDevice, - - -- * Data types - CEvent(..), - CTimeVal(..), - AbsInfo(..), - - -- * Device lifecycle - newDeviceFromFd, - libevdev_new, - libevdev_set_fd, - - -- * Events - nextEvent, - nextEventMay, - - -- * Grabbing - grabDevice, - - -- * Device properties (getters) - deviceFd, - deviceName, - devicePhys, - deviceUniq, - deviceProduct, - deviceVendor, - deviceBustype, - deviceVersion, - - -- * Device properties (setters) - setDeviceName, - setDevicePhys, - setDeviceUniq, - libevdev_set_id_product, - libevdev_set_id_vendor, - libevdev_set_id_bustype, - libevdev_set_id_version, - - -- * Capability queries - hasProperty, - hasEventType, - hasEventCode, - - -- * Abs info - getAbsInfo, - withAbsInfo, - - -- * Event enabling - enableType, - enableCode, - - -- * Uinput - createFromDevice, - getSyspath, - getDevnode, - writeEvent, - - -- * LEDs - libevdev_kernel_set_led_value, - - -- * Util - convertEnum, - negateErrno, -) where +module Evdev.LowLevel where import Data.ByteString (ByteString, packCString, useAsCString) import Data.Int (Int32, Int64) From df3b053a7f161b3a9e65b19ceacb4dfd960bd136 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 10:24:11 +0100 Subject: [PATCH 10/55] format --- evdev/src/Evdev/LowLevel.hs | 112 +++++++++++++++++++----------------- 1 file changed, 59 insertions(+), 53 deletions(-) diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index 494c89f..2e4d75b 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -4,53 +4,53 @@ import Data.ByteString (ByteString, packCString, useAsCString) import Data.Int (Int32, Int64) import Data.Word (Word16, Word32) import Foreign (ForeignPtr, FunPtr, Ptr, allocaBytes, castPtr, mallocBytes, mallocForeignPtrBytes, newForeignPtr, newForeignPtr_, nullPtr, peek, poke, withForeignPtr) -import Foreign.C (CInt(..), CLong(..), CUInt(..), CUShort(..), CString) -import Foreign.C.ConstPtr (ConstPtr(..)) -import Foreign.C.Error (Errno(Errno), eOK, eAGAIN) +import Foreign.C (CInt (..), CLong (..), CString, CUInt (..), CUShort (..)) +import Foreign.C.ConstPtr (ConstPtr (..)) +import Foreign.C.Error (Errno (Errno), eAGAIN, eOK) import Foreign.Storable (sizeOf) -import System.Posix.Types (Fd(Fd)) +import System.Posix.Types (Fd (Fd)) -import Evdev.Raw (Libevdev, Libevdev_uinput, Input_event(..), Input_absinfo(..), Timeval(..), C__U16(..), C__S32(..), C__Time_t(..), C__Suseconds_t(..)) -import qualified Evdev.Raw as Raw import Evdev.Codes (DeviceProperty, EventType, LEDEvent) +import Evdev.Raw (C__S32 (..), C__Suseconds_t (..), C__Time_t (..), C__U16 (..), Input_absinfo (..), Input_event (..), Libevdev, Libevdev_uinput, Timeval (..)) +import Evdev.Raw qualified as Raw -- * Enums -- | Extract an Int from an hs-bindgen enum newtype -rawEnum :: Integral a => a -> Int +rawEnum :: (Integral a) => a -> Int rawEnum = fromIntegral data ReadFlag = Sync | Normal | ForceSync | Blocking deriving (Eq, Ord, Show) instance Enum ReadFlag where - fromEnum Sync = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_SYNC in rawEnum n - fromEnum Normal = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_NORMAL in rawEnum n - fromEnum ForceSync = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_FORCE_SYNC in rawEnum n - fromEnum Blocking = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_BLOCKING in rawEnum n + fromEnum Sync = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_SYNC in rawEnum n + fromEnum Normal = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_NORMAL in rawEnum n + fromEnum ForceSync = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_FORCE_SYNC in rawEnum n + fromEnum Blocking = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_BLOCKING in rawEnum n toEnum n - | n == fromEnum Sync = Sync - | n == fromEnum Normal = Normal + | n == fromEnum Sync = Sync + | n == fromEnum Normal = Normal | n == fromEnum ForceSync = ForceSync - | n == fromEnum Blocking = Blocking + | n == fromEnum Blocking = Blocking | otherwise = error $ "ReadFlag.toEnum: Cannot match " ++ show n data GrabMode = LibevdevGrab | LibevdevUngrab deriving (Show) instance Enum GrabMode where - fromEnum LibevdevGrab = let Raw.Libevdev_grab_mode n = Raw.LIBEVDEV_GRAB in rawEnum n - fromEnum LibevdevUngrab = let Raw.Libevdev_grab_mode n = Raw.LIBEVDEV_UNGRAB in rawEnum n + fromEnum LibevdevGrab = let Raw.Libevdev_grab_mode n = Raw.LIBEVDEV_GRAB in rawEnum n + fromEnum LibevdevUngrab = let Raw.Libevdev_grab_mode n = Raw.LIBEVDEV_UNGRAB in rawEnum n toEnum n - | n == fromEnum LibevdevGrab = LibevdevGrab + | n == fromEnum LibevdevGrab = LibevdevGrab | n == fromEnum LibevdevUngrab = LibevdevUngrab | otherwise = error $ "GrabMode.toEnum: Cannot match " ++ show n data LEDValue = LedOn | LedOff deriving (Bounded, Eq, Ord, Read, Show) instance Enum LEDValue where - fromEnum LedOn = let Raw.Libevdev_led_value n = Raw.LIBEVDEV_LED_ON in rawEnum n + fromEnum LedOn = let Raw.Libevdev_led_value n = Raw.LIBEVDEV_LED_ON in rawEnum n fromEnum LedOff = let Raw.Libevdev_led_value n = Raw.LIBEVDEV_LED_OFF in rawEnum n toEnum n - | n == fromEnum LedOn = LedOn + | n == fromEnum LedOn = LedOn | n == fromEnum LedOff = LedOff | otherwise = error $ "LEDValue.toEnum: Cannot match " ++ show n @@ -64,12 +64,12 @@ instance Enum UInputOpenMode where grabModeToRaw :: GrabMode -> Raw.Libevdev_grab_mode grabModeToRaw = \case - LibevdevGrab -> Raw.LIBEVDEV_GRAB + LibevdevGrab -> Raw.LIBEVDEV_GRAB LibevdevUngrab -> Raw.LIBEVDEV_UNGRAB ledValueToRaw :: LEDValue -> Raw.Libevdev_led_value ledValueToRaw = \case - LedOn -> Raw.LIBEVDEV_LED_ON + LedOn -> Raw.LIBEVDEV_LED_ON LedOff -> Raw.LIBEVDEV_LED_OFF -- * Opaque device types @@ -155,10 +155,11 @@ nextEventMay dev flags = withDevice dev $ \devPtr -> allocaBytes inputEventSize $ \evPtr -> do err <- Raw.libevdev_next_event devPtr flags (castPtr evPtr) if Errno err /= eOK - then pure - ( if negateErrno (Errno err) == eAGAIN then eOK else Errno err - , Nothing - ) + then + pure + ( if negateErrno (Errno err) == eAGAIN then eOK else Errno err + , Nothing + ) else do ev <- getEvent evPtr pure (eOK, Just ev) @@ -172,12 +173,13 @@ getEvent evPtr = do Timeval{tv_sec, tv_usec} = time C__Time_t (CLong sec) = tv_sec C__Suseconds_t (CLong usec) = tv_usec - pure $ CEvent - { cEventType = fromIntegral t - , cEventCode = fromIntegral c - , cEventValue = fromIntegral v - , cEventTime = CTimeVal (fromIntegral sec) (fromIntegral usec) - } + pure $ + CEvent + { cEventType = fromIntegral t + , cEventCode = fromIntegral c + , cEventValue = fromIntegral v + , cEventTime = CTimeVal (fromIntegral sec) (fromIntegral usec) + } -- * Grabbing @@ -276,32 +278,36 @@ getAbsInfo dev code = withDevice dev $ \devPtr -> do then pure Nothing else do Input_absinfo - { value = C__S32 (CInt v) - , minimum = C__S32 (CInt mn) - , maximum = C__S32 (CInt mx) - , fuzz = C__S32 (CInt fz) - , flat = C__S32 (CInt fl) + { value = C__S32 (CInt v) + , minimum = C__S32 (CInt mn) + , maximum = C__S32 (CInt mx) + , fuzz = C__S32 (CInt fz) + , flat = C__S32 (CInt fl) , resolution = C__S32 (CInt res) - } <- peek rawPtr - pure $ Just AbsInfo - { absValue = v - , absMinimum = mn - , absMaximum = mx - , absFuzz = fz - , absFlat = fl - , absResolution = res - } + } <- + peek rawPtr + pure $ + Just + AbsInfo + { absValue = v + , absMinimum = mn + , absMaximum = mx + , absFuzz = fz + , absFlat = fl + , absResolution = res + } withAbsInfo :: AbsInfo -> (Ptr () -> IO a) -> IO a withAbsInfo AbsInfo{..} f = do - let info = Input_absinfo - { value = C__S32 (CInt absValue) - , minimum = C__S32 (CInt absMinimum) - , maximum = C__S32 (CInt absMaximum) - , fuzz = C__S32 (CInt absFuzz) - , flat = C__S32 (CInt absFlat) - , resolution = C__S32 (CInt absResolution) - } + let info = + Input_absinfo + { value = C__S32 (CInt absValue) + , minimum = C__S32 (CInt absMinimum) + , maximum = C__S32 (CInt absMaximum) + , fuzz = C__S32 (CInt absFuzz) + , flat = C__S32 (CInt absFlat) + , resolution = C__S32 (CInt absResolution) + } p <- mallocBytes (sizeOf info) poke (castPtr p) info fp <- newForeignPtr_ p From e4258697cbc678670a432cccbd25dc2abe489a82 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 10:25:35 +0100 Subject: [PATCH 11/55] simplify internal imports --- evdev/src/Evdev/LowLevel.hs | 63 ++++++++++++++++++------------------- 1 file changed, 31 insertions(+), 32 deletions(-) diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index 2e4d75b..d1644dc 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -10,8 +10,7 @@ import Foreign.C.Error (Errno (Errno), eAGAIN, eOK) import Foreign.Storable (sizeOf) import System.Posix.Types (Fd (Fd)) -import Evdev.Codes (DeviceProperty, EventType, LEDEvent) -import Evdev.Raw (C__S32 (..), C__Suseconds_t (..), C__Time_t (..), C__U16 (..), Input_absinfo (..), Input_event (..), Libevdev, Libevdev_uinput, Timeval (..)) +import Evdev.Codes import Evdev.Raw qualified as Raw -- * Enums @@ -74,17 +73,17 @@ ledValueToRaw = \case -- * Opaque device types -newtype Device = Device (ForeignPtr Libevdev) -newtype UDevice = UDevice (ForeignPtr Libevdev_uinput) +newtype Device = Device (ForeignPtr Raw.Libevdev) +newtype UDevice = UDevice (ForeignPtr Raw.Libevdev_uinput) -withDevice :: Device -> (Ptr Libevdev -> IO a) -> IO a +withDevice :: Device -> (Ptr Raw.Libevdev -> IO a) -> IO a withDevice (Device fp) = withForeignPtr fp -withUDevice :: UDevice -> (Ptr Libevdev_uinput -> IO a) -> IO a +withUDevice :: UDevice -> (Ptr Raw.Libevdev_uinput -> IO a) -> IO a withUDevice (UDevice fp) = withForeignPtr fp -foreign import ccall "&libevdev_hs_close" finalizer_libevdev_hs_close :: FunPtr (Ptr Libevdev -> IO ()) -foreign import ccall "&libevdev_uinput_destroy" finalizer_libevdev_uinput_destroy :: FunPtr (Ptr Libevdev_uinput -> IO ()) +foreign import ccall "&libevdev_hs_close" finalizer_libevdev_hs_close :: FunPtr (Ptr Raw.Libevdev -> IO ()) +foreign import ccall "&libevdev_uinput_destroy" finalizer_libevdev_uinput_destroy :: FunPtr (Ptr Raw.Libevdev_uinput -> IO ()) -- | Convert a Ptr to a ConstPtr (for calling const-qualified C functions) constPtr :: Ptr a -> ConstPtr a @@ -141,7 +140,7 @@ newDeviceFromFd fd = do -- * Events inputEventSize :: Int -inputEventSize = sizeOf (undefined :: Input_event) +inputEventSize = sizeOf (undefined :: Raw.Input_event) nextEvent :: Device -> CUInt -> IO (Errno, CEvent) nextEvent dev flags = withDevice dev $ \devPtr -> @@ -164,15 +163,15 @@ nextEventMay dev flags = withDevice dev $ \devPtr -> ev <- getEvent evPtr pure (eOK, Just ev) -getEvent :: Ptr Input_event -> IO CEvent +getEvent :: Ptr Raw.Input_event -> IO CEvent getEvent evPtr = do - Input_event{time, type', code, value} <- peek evPtr - let C__U16 (CUShort t) = type' - C__U16 (CUShort c) = code - C__S32 (CInt v) = value - Timeval{tv_sec, tv_usec} = time - C__Time_t (CLong sec) = tv_sec - C__Suseconds_t (CLong usec) = tv_usec + Raw.Input_event{time, type', code, value} <- peek evPtr + let Raw.C__U16 (CUShort t) = type' + Raw.C__U16 (CUShort c) = code + Raw.C__S32 (CInt v) = value + Raw.Timeval{tv_sec, tv_usec} = time + Raw.C__Time_t (CLong sec) = tv_sec + Raw.C__Suseconds_t (CLong usec) = tv_usec pure $ CEvent { cEventType = fromIntegral t @@ -273,17 +272,17 @@ hasEventCode dev t c = withDevice dev $ \devPtr -> getAbsInfo :: Device -> Word32 -> IO (Maybe AbsInfo) getAbsInfo dev code = withDevice dev $ \devPtr -> do ptr <- Raw.libevdev_get_abs_info (constPtr devPtr) (CUInt code) - let rawPtr = unConstPtr' ptr :: Ptr Input_absinfo + let rawPtr = unConstPtr' ptr :: Ptr Raw.Input_absinfo if rawPtr == nullPtr then pure Nothing else do - Input_absinfo - { value = C__S32 (CInt v) - , minimum = C__S32 (CInt mn) - , maximum = C__S32 (CInt mx) - , fuzz = C__S32 (CInt fz) - , flat = C__S32 (CInt fl) - , resolution = C__S32 (CInt res) + Raw.Input_absinfo + { value = Raw.C__S32 (CInt v) + , minimum = Raw.C__S32 (CInt mn) + , maximum = Raw.C__S32 (CInt mx) + , fuzz = Raw.C__S32 (CInt fz) + , flat = Raw.C__S32 (CInt fl) + , resolution = Raw.C__S32 (CInt res) } <- peek rawPtr pure $ @@ -300,13 +299,13 @@ getAbsInfo dev code = withDevice dev $ \devPtr -> do withAbsInfo :: AbsInfo -> (Ptr () -> IO a) -> IO a withAbsInfo AbsInfo{..} f = do let info = - Input_absinfo - { value = C__S32 (CInt absValue) - , minimum = C__S32 (CInt absMinimum) - , maximum = C__S32 (CInt absMaximum) - , fuzz = C__S32 (CInt absFuzz) - , flat = C__S32 (CInt absFlat) - , resolution = C__S32 (CInt absResolution) + Raw.Input_absinfo + { value = Raw.C__S32 (CInt absValue) + , minimum = Raw.C__S32 (CInt absMinimum) + , maximum = Raw.C__S32 (CInt absMaximum) + , fuzz = Raw.C__S32 (CInt absFuzz) + , flat = Raw.C__S32 (CInt absFlat) + , resolution = Raw.C__S32 (CInt absResolution) } p <- mallocBytes (sizeOf info) poke (castPtr p) info From 93f095bdba95b28457410cff74769c5582ddc181 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 11:40:13 +0100 Subject: [PATCH 12/55] temporarily expose modules in order to get haddocks for generated code --- evdev/evdev.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/evdev/evdev.cabal b/evdev/evdev.cabal index fec452b..1d40597 100644 --- a/evdev/evdev.cabal +++ b/evdev/evdev.cabal @@ -51,9 +51,9 @@ library Evdev Evdev.Codes Evdev.Uinput - other-modules: Evdev.LowLevel Evdev.Raw + other-modules: Util hs-source-dirs: src c-sources: From a2d354dd8f40de7ab39c23ff13fd43a2236de0c7 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 11:53:35 +0100 Subject: [PATCH 13/55] simplify enums, incl. dropping weird and unnecessary Enum instances that we previously got free from c2hs --- evdev/src/Evdev.hs | 45 ++++++++++++++++-------- evdev/src/Evdev/LowLevel.hs | 70 ------------------------------------- evdev/src/Evdev/Uinput.hs | 5 ++- 3 files changed, 35 insertions(+), 85 deletions(-) diff --git a/evdev/src/Evdev.hs b/evdev/src/Evdev.hs index 455d112..f52c5eb 100644 --- a/evdev/src/Evdev.hs +++ b/evdev/src/Evdev.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedRecordDot #-} {-# OPTIONS_GHC -fno-state-hack #-} -- | The main module for working with devices and events. @@ -36,7 +37,7 @@ module Evdev ( -- * Lower-level newDeviceFromFd, nextEventMay, - LL.LEDValue(..), + LEDValue(..), setDeviceLED, -- ** C-style types -- | These correspond more directly to C's /input_event/ and /timeval/. @@ -66,13 +67,14 @@ import Data.Time.Clock (DiffTime) import Data.Tuple.Extra (uncurry3) import Data.Word (Word16) import Foreign ((.|.)) -import Foreign.C (CUInt) +import Foreign.C (CUInt, Errno (Errno)) import System.Posix.Process (getProcessID) import System.Posix.Files (readSymbolicLink) import System.Posix.ByteString (Fd, RawFilePath) import System.Posix.IO.ByteString (OpenMode (..), defaultFileFlags, openFd) import qualified Evdev.LowLevel as LL +import qualified Evdev.Raw as Raw import Evdev.Codes import Util @@ -126,21 +128,30 @@ data KeyEvent | Repeated deriving (Bounded, Enum, Eq, Ord, Read, Show) -convertFlags :: Set LL.ReadFlag -> CUInt -convertFlags = fromIntegral . foldr ((.|.) . fromEnum) 0 +data ReadFlag = Sync | Normal | ForceSync | Blocking + deriving (Eq, Ord, Show) -defaultReadFlags :: Set LL.ReadFlag -defaultReadFlags = Set.fromList [LL.Normal, LL.Blocking] +convertFlags :: Set ReadFlag -> CUInt +convertFlags = foldr ((.|.) . (.unwrap) . convert) 0 + where + convert = \case + Sync -> Raw.LIBEVDEV_READ_FLAG_SYNC + Normal -> Raw.LIBEVDEV_READ_FLAG_NORMAL + ForceSync -> Raw.LIBEVDEV_READ_FLAG_FORCE_SYNC + Blocking -> Raw.LIBEVDEV_READ_FLAG_BLOCKING + +defaultReadFlags :: Set ReadFlag +defaultReadFlags = Set.fromList [Normal, Blocking] -nonBlockingReadFlags :: Set LL.ReadFlag -nonBlockingReadFlags = Set.fromList [LL.Normal] +nonBlockingReadFlags :: Set ReadFlag +nonBlockingReadFlags = Set.fromList [Normal] -- | Prevent other clients (including kernel-internal ones) from receiving events. Often a bad idea. grabDevice :: Device -> IO () -grabDevice = grabDevice' LL.LibevdevGrab +grabDevice = grabDevice' Raw.LIBEVDEV_GRAB -- | Release a grabbed device. ungrabDevice :: Device -> IO () -ungrabDevice = grabDevice' LL.LibevdevUngrab +ungrabDevice = grabDevice' Raw.LIBEVDEV_UNGRAB -- | Get the next event from the device. nextEvent :: Device -> IO Event @@ -258,15 +269,21 @@ deviceHasEvent dev e = LL.hasEventCode (cDevice dev) typ code deviceAbsAxis :: Device -> AbsoluteAxis -> IO (Maybe LL.AbsInfo) deviceAbsAxis dev = LL.getAbsInfo (cDevice dev) . fromEnum' +data LEDValue = LedOn | LedOff + deriving (Bounded, Eq, Ord, Read, Show) + -- | Set the state of a LED on a device. -setDeviceLED :: Device -> LEDEvent -> LL.LEDValue -> IO () -setDeviceLED dev led val = cErrCall "setDeviceLED" dev (LL.libevdev_kernel_set_led_value (cDevice dev) led val) +setDeviceLED :: Device -> LEDEvent -> LEDValue -> IO () +setDeviceLED dev led val = cErrCall "setDeviceLED" dev $ LL.withDevice (cDevice dev) \devPtr -> + Errno <$> Raw.libevdev_kernel_set_led_value devPtr (LL.convertEnum led) case val of + LedOn -> Raw.LIBEVDEV_LED_ON + LedOff -> Raw.LIBEVDEV_LED_OFF {- Util -} -grabDevice' :: LL.GrabMode -> Device -> IO () +grabDevice' :: Raw.Libevdev_grab_mode -> Device -> IO () grabDevice' mode dev = cErrCall "grabDevice" dev $ - LL.grabDevice (cDevice dev) mode + LL.withDevice (cDevice dev) $ fmap Errno . flip Raw.libevdev_grab mode {- TODO this is a workaround until c2hs has a better story for enum conversions diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index d1644dc..b4dbbb4 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -13,64 +13,6 @@ import System.Posix.Types (Fd (Fd)) import Evdev.Codes import Evdev.Raw qualified as Raw --- * Enums - --- | Extract an Int from an hs-bindgen enum newtype -rawEnum :: (Integral a) => a -> Int -rawEnum = fromIntegral - -data ReadFlag = Sync | Normal | ForceSync | Blocking - deriving (Eq, Ord, Show) -instance Enum ReadFlag where - fromEnum Sync = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_SYNC in rawEnum n - fromEnum Normal = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_NORMAL in rawEnum n - fromEnum ForceSync = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_FORCE_SYNC in rawEnum n - fromEnum Blocking = let Raw.Libevdev_read_flag n = Raw.LIBEVDEV_READ_FLAG_BLOCKING in rawEnum n - toEnum n - | n == fromEnum Sync = Sync - | n == fromEnum Normal = Normal - | n == fromEnum ForceSync = ForceSync - | n == fromEnum Blocking = Blocking - | otherwise = error $ "ReadFlag.toEnum: Cannot match " ++ show n - -data GrabMode = LibevdevGrab | LibevdevUngrab - deriving (Show) -instance Enum GrabMode where - fromEnum LibevdevGrab = let Raw.Libevdev_grab_mode n = Raw.LIBEVDEV_GRAB in rawEnum n - fromEnum LibevdevUngrab = let Raw.Libevdev_grab_mode n = Raw.LIBEVDEV_UNGRAB in rawEnum n - toEnum n - | n == fromEnum LibevdevGrab = LibevdevGrab - | n == fromEnum LibevdevUngrab = LibevdevUngrab - | otherwise = error $ "GrabMode.toEnum: Cannot match " ++ show n - -data LEDValue = LedOn | LedOff - deriving (Bounded, Eq, Ord, Read, Show) -instance Enum LEDValue where - fromEnum LedOn = let Raw.Libevdev_led_value n = Raw.LIBEVDEV_LED_ON in rawEnum n - fromEnum LedOff = let Raw.Libevdev_led_value n = Raw.LIBEVDEV_LED_OFF in rawEnum n - toEnum n - | n == fromEnum LedOn = LedOn - | n == fromEnum LedOff = LedOff - | otherwise = error $ "LEDValue.toEnum: Cannot match " ++ show n - -data UInputOpenMode = UOMManaged - deriving (Show) -instance Enum UInputOpenMode where - fromEnum UOMManaged = let Raw.Libevdev_uinput_open_mode n = Raw.LIBEVDEV_UINPUT_OPEN_MANAGED in rawEnum n - toEnum n - | n == fromEnum UOMManaged = UOMManaged - | otherwise = error $ "UInputOpenMode.toEnum: Cannot match " ++ show n - -grabModeToRaw :: GrabMode -> Raw.Libevdev_grab_mode -grabModeToRaw = \case - LibevdevGrab -> Raw.LIBEVDEV_GRAB - LibevdevUngrab -> Raw.LIBEVDEV_UNGRAB - -ledValueToRaw :: LEDValue -> Raw.Libevdev_led_value -ledValueToRaw = \case - LedOn -> Raw.LIBEVDEV_LED_ON - LedOff -> Raw.LIBEVDEV_LED_OFF - -- * Opaque device types newtype Device = Device (ForeignPtr Raw.Libevdev) @@ -180,12 +122,6 @@ getEvent evPtr = do , cEventTime = CTimeVal (fromIntegral sec) (fromIntegral usec) } --- * Grabbing - -grabDevice :: Device -> GrabMode -> IO Errno -grabDevice dev mode = withDevice dev $ \devPtr -> - Errno <$> Raw.libevdev_grab devPtr (grabModeToRaw mode) - -- * Device properties (getters) deviceFd :: Device -> IO Fd @@ -344,12 +280,6 @@ writeEvent :: UDevice -> Word16 -> Word16 -> Int32 -> IO Errno writeEvent dev t c v = withUDevice dev $ \devPtr -> Errno <$> Raw.libevdev_uinput_write_event (constPtr devPtr) (fromIntegral t) (fromIntegral c) (fromIntegral v) --- * LEDs - -libevdev_kernel_set_led_value :: Device -> LEDEvent -> LEDValue -> IO Errno -libevdev_kernel_set_led_value dev led val = withDevice dev $ \devPtr -> - Errno <$> Raw.libevdev_kernel_set_led_value devPtr (convertEnum led) (ledValueToRaw val) - -- * Util convertEnum :: (Enum a, Integral b) => a -> b diff --git a/evdev/src/Evdev/Uinput.hs b/evdev/src/Evdev/Uinput.hs index c609767..7765fe7 100644 --- a/evdev/src/Evdev/Uinput.hs +++ b/evdev/src/Evdev/Uinput.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedRecordDot #-} + -- | Create virtual input devices. module Evdev.Uinput ( Device, @@ -30,6 +32,7 @@ import Data.ByteString.Char8 (ByteString) import Evdev hiding (Device, newDevice) import Evdev.Codes import qualified Evdev.LowLevel as LL +import qualified Evdev.Raw as Raw import Util -- | A `uinput` device. @@ -84,7 +87,7 @@ newDevice name DeviceOpts{..} = do LL.withAbsInfo absInfo $ \ptr -> enable ptr EvAbs [fromEnum' axis] - fmap Device $ cec $ LL.createFromDevice dev $ fromEnum' LL.UOMManaged + fmap Device $ cec $ LL.createFromDevice dev $ fromIntegral (Raw.LIBEVDEV_UINPUT_OPEN_MANAGED).unwrap where cec :: CErrCall a => IO a -> IO (CErrCallRes a) cec = cErrCall "newDevice" () From b29ccf104e6e9d7ab6da39daee6a300525d1e01d Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 11:59:28 +0100 Subject: [PATCH 14/55] update CI versions (should just use Nix now really...) --- .github/workflows/haskell.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index e5275f7..d9c1df4 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -20,8 +20,8 @@ jobs: uses: haskell-actions/setup@v2 id: setup with: - ghc-version: '9.4' - cabal-version: '3.10' + ghc-version: '9.12' + cabal-version: '3.16' cabal-update: true - name: Install libevdev From ae18f0ff9b8973660a590457a811f71b5ccaf7c5 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 12:24:07 +0100 Subject: [PATCH 15/55] remove pointless const pointer conversion helpers --- evdev/src/Evdev/LowLevel.hs | 56 ++++++++++++++++--------------------- 1 file changed, 24 insertions(+), 32 deletions(-) diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index b4dbbb4..c9fc46f 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -27,14 +27,6 @@ withUDevice (UDevice fp) = withForeignPtr fp foreign import ccall "&libevdev_hs_close" finalizer_libevdev_hs_close :: FunPtr (Ptr Raw.Libevdev -> IO ()) foreign import ccall "&libevdev_uinput_destroy" finalizer_libevdev_uinput_destroy :: FunPtr (Ptr Raw.Libevdev_uinput -> IO ()) --- | Convert a Ptr to a ConstPtr (for calling const-qualified C functions) -constPtr :: Ptr a -> ConstPtr a -constPtr = ConstPtr - --- | Convert a ConstPtr to a regular Ptr -unConstPtr' :: ConstPtr a -> Ptr a -unConstPtr' (ConstPtr p) = p - -- * Data types data CEvent = CEvent @@ -126,52 +118,52 @@ getEvent evPtr = do deviceFd :: Device -> IO Fd deviceFd dev = withDevice dev $ \devPtr -> - Fd <$> Raw.libevdev_get_fd (constPtr devPtr) + Fd <$> Raw.libevdev_get_fd (ConstPtr devPtr) deviceName :: Device -> IO (IO ByteString) deviceName dev = withDevice dev $ \devPtr -> do - cstr <- Raw.libevdev_get_name (constPtr devPtr) - pure $ packCString (unConstPtr' cstr) + cstr <- Raw.libevdev_get_name (ConstPtr devPtr) + pure $ packCString (unConstPtr cstr) devicePhys :: Device -> IO (IO (Maybe ByteString)) devicePhys dev = withDevice dev $ \devPtr -> do - cstr <- Raw.libevdev_get_phys (constPtr devPtr) - pure $ packCString' (unConstPtr' cstr) + cstr <- Raw.libevdev_get_phys (ConstPtr devPtr) + pure $ packCString' (unConstPtr cstr) deviceUniq :: Device -> IO (IO (Maybe ByteString)) deviceUniq dev = withDevice dev $ \devPtr -> do - cstr <- Raw.libevdev_get_uniq (constPtr devPtr) - pure $ packCString' (unConstPtr' cstr) + cstr <- Raw.libevdev_get_uniq (ConstPtr devPtr) + pure $ packCString' (unConstPtr cstr) deviceProduct :: Device -> IO Int deviceProduct dev = withDevice dev $ \devPtr -> - fromIntegral <$> Raw.libevdev_get_id_product (constPtr devPtr) + fromIntegral <$> Raw.libevdev_get_id_product (ConstPtr devPtr) deviceVendor :: Device -> IO Int deviceVendor dev = withDevice dev $ \devPtr -> - fromIntegral <$> Raw.libevdev_get_id_vendor (constPtr devPtr) + fromIntegral <$> Raw.libevdev_get_id_vendor (ConstPtr devPtr) deviceBustype :: Device -> IO Int deviceBustype dev = withDevice dev $ \devPtr -> - fromIntegral <$> Raw.libevdev_get_id_bustype (constPtr devPtr) + fromIntegral <$> Raw.libevdev_get_id_bustype (ConstPtr devPtr) deviceVersion :: Device -> IO Int deviceVersion dev = withDevice dev $ \devPtr -> - fromIntegral <$> Raw.libevdev_get_id_version (constPtr devPtr) + fromIntegral <$> Raw.libevdev_get_id_version (ConstPtr devPtr) -- * Device properties (setters) setDeviceName :: Device -> ByteString -> IO () setDeviceName dev name = withDevice dev $ \devPtr -> - useAsCString name $ \cstr -> Raw.libevdev_set_name devPtr (constPtr cstr) + useAsCString name $ \cstr -> Raw.libevdev_set_name devPtr (ConstPtr cstr) setDevicePhys :: Device -> ByteString -> IO () setDevicePhys dev phys = withDevice dev $ \devPtr -> - useAsCString phys $ \cstr -> Raw.libevdev_set_phys devPtr (constPtr cstr) + useAsCString phys $ \cstr -> Raw.libevdev_set_phys devPtr (ConstPtr cstr) setDeviceUniq :: Device -> ByteString -> IO () setDeviceUniq dev uniq = withDevice dev $ \devPtr -> - useAsCString uniq $ \cstr -> Raw.libevdev_set_uniq devPtr (constPtr cstr) + useAsCString uniq $ \cstr -> Raw.libevdev_set_uniq devPtr (ConstPtr cstr) libevdev_set_id_product :: Device -> Int -> IO () libevdev_set_id_product dev n = withDevice dev $ \devPtr -> @@ -193,22 +185,22 @@ libevdev_set_id_version dev n = withDevice dev $ \devPtr -> hasProperty :: Device -> DeviceProperty -> IO Bool hasProperty dev prop = withDevice dev $ \devPtr -> - (/= 0) <$> Raw.libevdev_has_property (constPtr devPtr) (convertEnum prop) + (/= 0) <$> Raw.libevdev_has_property (ConstPtr devPtr) (convertEnum prop) hasEventType :: Device -> EventType -> IO Bool hasEventType dev et = withDevice dev $ \devPtr -> - (/= 0) <$> Raw.libevdev_has_event_type (constPtr devPtr) (convertEnum et) + (/= 0) <$> Raw.libevdev_has_event_type (ConstPtr devPtr) (convertEnum et) hasEventCode :: Device -> Word16 -> Word16 -> IO Bool hasEventCode dev t c = withDevice dev $ \devPtr -> - (/= 0) <$> Raw.libevdev_has_event_code (constPtr devPtr) (fromIntegral t) (fromIntegral c) + (/= 0) <$> Raw.libevdev_has_event_code (ConstPtr devPtr) (fromIntegral t) (fromIntegral c) -- * Abs info getAbsInfo :: Device -> Word32 -> IO (Maybe AbsInfo) getAbsInfo dev code = withDevice dev $ \devPtr -> do - ptr <- Raw.libevdev_get_abs_info (constPtr devPtr) (CUInt code) - let rawPtr = unConstPtr' ptr :: Ptr Raw.Input_absinfo + ptr <- Raw.libevdev_get_abs_info (ConstPtr devPtr) (CUInt code) + let rawPtr = unConstPtr ptr :: Ptr Raw.Input_absinfo if rawPtr == nullPtr then pure Nothing else do @@ -256,7 +248,7 @@ enableType dev t = withDevice dev $ \devPtr -> enableCode :: Device -> Word16 -> Word16 -> Ptr () -> IO Errno enableCode dev t c dataPtr = withDevice dev $ \devPtr -> - Errno <$> Raw.libevdev_enable_event_code devPtr (fromIntegral t) (fromIntegral c) (constPtr $ castPtr dataPtr) + Errno <$> Raw.libevdev_enable_event_code devPtr (fromIntegral t) (fromIntegral c) (ConstPtr $ castPtr dataPtr) -- * Uinput @@ -264,21 +256,21 @@ createFromDevice :: Device -> Fd -> IO (Errno, UDevice) createFromDevice dev (Fd fd) = withDevice dev $ \devPtr -> do udevPtrPtr <- mallocForeignPtrBytes (sizeOf (undefined :: Ptr ())) (e, udevPtr) <- withForeignPtr udevPtrPtr $ \pp -> - (,) <$> Raw.libevdev_uinput_create_from_device (constPtr devPtr) fd (castPtr pp) <*> peek pp + (,) <$> Raw.libevdev_uinput_create_from_device (ConstPtr devPtr) fd (castPtr pp) <*> peek pp udevFP <- newForeignPtr finalizer_libevdev_uinput_destroy udevPtr pure (Errno e, UDevice udevFP) getSyspath :: UDevice -> IO (Maybe ByteString) getSyspath dev = withUDevice dev $ \devPtr -> - Raw.libevdev_uinput_get_syspath devPtr >>= packCString' . unConstPtr' + Raw.libevdev_uinput_get_syspath devPtr >>= packCString' . unConstPtr getDevnode :: UDevice -> IO (Maybe ByteString) getDevnode dev = withUDevice dev $ \devPtr -> - Raw.libevdev_uinput_get_devnode devPtr >>= packCString' . unConstPtr' + Raw.libevdev_uinput_get_devnode devPtr >>= packCString' . unConstPtr writeEvent :: UDevice -> Word16 -> Word16 -> Int32 -> IO Errno writeEvent dev t c v = withUDevice dev $ \devPtr -> - Errno <$> Raw.libevdev_uinput_write_event (constPtr devPtr) (fromIntegral t) (fromIntegral c) (fromIntegral v) + Errno <$> Raw.libevdev_uinput_write_event (ConstPtr devPtr) (fromIntegral t) (fromIntegral c) (fromIntegral v) -- * Util From 432b6f343f9dceaca63036af54844be437805ce2 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 12:33:31 +0100 Subject: [PATCH 16/55] simplify getAbsInfo --- evdev/src/Evdev/LowLevel.hs | 39 ++++++++++++++----------------------- 1 file changed, 15 insertions(+), 24 deletions(-) diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index c9fc46f..f61d608 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -198,31 +198,19 @@ hasEventCode dev t c = withDevice dev $ \devPtr -> -- * Abs info getAbsInfo :: Device -> Word32 -> IO (Maybe AbsInfo) -getAbsInfo dev code = withDevice dev $ \devPtr -> do - ptr <- Raw.libevdev_get_abs_info (ConstPtr devPtr) (CUInt code) - let rawPtr = unConstPtr ptr :: Ptr Raw.Input_absinfo - if rawPtr == nullPtr - then pure Nothing - else do +getAbsInfo dev code = withDevice dev \devPtr -> do + (unConstPtr <$> Raw.libevdev_get_abs_info (ConstPtr devPtr) (CUInt code)) + >>= handleNull (pure Nothing) \absInfoPtr -> do Raw.Input_absinfo - { value = Raw.C__S32 (CInt v) - , minimum = Raw.C__S32 (CInt mn) - , maximum = Raw.C__S32 (CInt mx) - , fuzz = Raw.C__S32 (CInt fz) - , flat = Raw.C__S32 (CInt fl) - , resolution = Raw.C__S32 (CInt res) + { value = Raw.C__S32 (CInt absValue) + , minimum = Raw.C__S32 (CInt absMinimum) + , maximum = Raw.C__S32 (CInt absMaximum) + , fuzz = Raw.C__S32 (CInt absFuzz) + , flat = Raw.C__S32 (CInt absFlat) + , resolution = Raw.C__S32 (CInt absResolution) } <- - peek rawPtr - pure $ - Just - AbsInfo - { absValue = v - , absMinimum = mn - , absMaximum = mx - , absFuzz = fz - , absFlat = fl - , absResolution = res - } + peek absInfoPtr + pure $ Just AbsInfo{..} withAbsInfo :: AbsInfo -> (Ptr () -> IO a) -> IO a withAbsInfo AbsInfo{..} f = do @@ -277,8 +265,11 @@ writeEvent dev t c v = withUDevice dev $ \devPtr -> convertEnum :: (Enum a, Integral b) => a -> b convertEnum = fromIntegral . fromEnum +handleNull :: b -> (Ptr a -> b) -> Ptr a -> b +handleNull def f p = if p == nullPtr then def else f p + packCString' :: CString -> IO (Maybe ByteString) -packCString' p = if p == nullPtr then pure Nothing else Just <$> packCString p +packCString' = handleNull (return Nothing) (fmap Just . packCString) negateErrno :: Errno -> Errno negateErrno (Errno cint) = Errno (-cint) From 50411cb6d06b88747a00e3a3e7b7b7abc6afe417 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 12:57:20 +0100 Subject: [PATCH 17/55] simplify uinput device construction --- evdev/src/Evdev/LowLevel.hs | 13 ++----------- evdev/src/Evdev/Uinput.hs | 11 +++++++---- 2 files changed, 9 insertions(+), 15 deletions(-) diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index f61d608..f45f12a 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -2,6 +2,7 @@ module Evdev.LowLevel where import Data.ByteString (ByteString, packCString, useAsCString) import Data.Int (Int32, Int64) +import Data.Void (Void) import Data.Word (Word16, Word32) import Foreign (ForeignPtr, FunPtr, Ptr, allocaBytes, castPtr, mallocBytes, mallocForeignPtrBytes, newForeignPtr, newForeignPtr_, nullPtr, peek, poke, withForeignPtr) import Foreign.C (CInt (..), CLong (..), CString, CUInt (..), CUShort (..)) @@ -212,7 +213,7 @@ getAbsInfo dev code = withDevice dev \devPtr -> do peek absInfoPtr pure $ Just AbsInfo{..} -withAbsInfo :: AbsInfo -> (Ptr () -> IO a) -> IO a +withAbsInfo :: AbsInfo -> (Ptr Void -> IO a) -> IO a withAbsInfo AbsInfo{..} f = do let info = Raw.Input_absinfo @@ -228,16 +229,6 @@ withAbsInfo AbsInfo{..} f = do fp <- newForeignPtr_ p withForeignPtr fp f --- * Event enabling - -enableType :: Device -> Word16 -> IO Errno -enableType dev t = withDevice dev $ \devPtr -> - Errno <$> Raw.libevdev_enable_event_type devPtr (fromIntegral t) - -enableCode :: Device -> Word16 -> Word16 -> Ptr () -> IO Errno -enableCode dev t c dataPtr = withDevice dev $ \devPtr -> - Errno <$> Raw.libevdev_enable_event_code devPtr (fromIntegral t) (fromIntegral c) (ConstPtr $ castPtr dataPtr) - -- * Uinput createFromDevice :: Device -> Fd -> IO (Errno, UDevice) diff --git a/evdev/src/Evdev/Uinput.hs b/evdev/src/Evdev/Uinput.hs index 7765fe7..b372e39 100644 --- a/evdev/src/Evdev/Uinput.hs +++ b/evdev/src/Evdev/Uinput.hs @@ -26,6 +26,8 @@ import Control.Monad.State import Data.Foldable import Data.Tuple.Extra import Foreign +import Foreign.C +import Foreign.C.ConstPtr import Data.ByteString.Char8 (ByteString) @@ -57,10 +59,11 @@ newDevice name DeviceOpts{..} = do maybeSet LL.libevdev_set_id_bustype idBustype maybeSet LL.libevdev_set_id_version idVersion - let enable :: Ptr () -> EventType -> [Word16] -> IO () - enable ptr t cs = do - unless (null cs) $ cec $ LL.enableType dev t' - forM_ cs $ \c -> cec $ LL.enableCode dev t' c ptr + let enable dataPtr t cs = do + unless (null cs) $ cec $ LL.withDevice dev \devPtr -> + Errno <$> Raw.libevdev_enable_event_type devPtr t' + forM_ cs $ \c -> cec $ LL.withDevice dev \devPtr -> + Errno <$> Raw.libevdev_enable_event_code devPtr t' c (ConstPtr dataPtr) where t' = fromEnum' t From 4bd4c7f9a6a801efc3cfdbecda3597e6ddff9fcc Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 14:16:47 +0100 Subject: [PATCH 18/55] simplify event types --- evdev/src/Evdev.hs | 46 +++++++++++++++++-------- evdev/src/Evdev/LowLevel.hs | 68 +++---------------------------------- evdev/test/Test.hs | 3 +- 3 files changed, 37 insertions(+), 80 deletions(-) diff --git a/evdev/src/Evdev.hs b/evdev/src/Evdev.hs index f52c5eb..a55106a 100644 --- a/evdev/src/Evdev.hs +++ b/evdev/src/Evdev.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LexicalNegation #-} {-# LANGUAGE OverloadedRecordDot #-} {-# OPTIONS_GHC -fno-state-hack #-} @@ -42,12 +43,12 @@ module Evdev ( -- ** C-style types -- | These correspond more directly to C's /input_event/ and /timeval/. -- They are used internally, but may be useful for advanced users. - LL.CEvent(..), + Raw.Input_event(..), toCEvent, fromCEvent, toCEventData, fromCEventData, - LL.CTimeVal(..), + Raw.Timeval(..), toCTimeVal, fromCTimeVal, ) where @@ -55,6 +56,7 @@ module Evdev ( import Control.Arrow ((&&&)) import Control.Monad (filterM, join) import Data.ByteString.Char8 (ByteString, pack) +import Data.Coerce (coerce) import Data.Int (Int32) import Data.List.Extra (enumerate) import Data.Map ((!?), Map) @@ -66,8 +68,8 @@ import qualified Data.Set as Set import Data.Time.Clock (DiffTime) import Data.Tuple.Extra (uncurry3) import Data.Word (Word16) -import Foreign ((.|.)) -import Foreign.C (CUInt, Errno (Errno)) +import Foreign (alloca, peek, (.|.)) +import Foreign.C (CInt (CInt), CUInt, CUShort (CUShort), Errno (Errno), eAGAIN, eOK) import System.Posix.Process (getProcessID) import System.Posix.Files (readSymbolicLink) import System.Posix.ByteString (Fd, RawFilePath) @@ -156,17 +158,31 @@ ungrabDevice = grabDevice' Raw.LIBEVDEV_UNGRAB -- | Get the next event from the device. nextEvent :: Device -> IO Event nextEvent dev = - fromCEvent <$> cErrCall "nextEvent" dev (LL.nextEvent (cDevice dev) (convertFlags defaultReadFlags)) + cErrCall "nextEvent" dev $ LL.withDevice (cDevice dev) \devPtr -> alloca \evPtr -> + (,) + <$> (Errno <$> Raw.libevdev_next_event devPtr (convertFlags defaultReadFlags) evPtr) + <*> (fromCEvent <$> peek evPtr) {- | Get the next event from the device, if one is available. Designed for use with devices created from a non-blocking file descriptor. Otherwise equal to @fmap Just . nextEvent@. -} nextEventMay :: Device -> IO (Maybe Event) nextEventMay dev = - fmap fromCEvent <$> cErrCall "nextEventMay" dev (LL.nextEventMay (cDevice dev) (convertFlags nonBlockingReadFlags)) - -fromCEvent :: LL.CEvent -> Event -fromCEvent (LL.CEvent t c v time) = Event (fromCEventData (t,c,v)) $ fromCTimeVal time + cErrCall "nextEventMay" dev $ LL.withDevice (cDevice dev) \devPtr -> alloca \evPtr -> do + err <- Raw.libevdev_next_event devPtr (convertFlags nonBlockingReadFlags) evPtr + if Errno err /= eOK + then + pure + ( if Errno -err == eAGAIN then eOK else Errno err + , Nothing + ) + else (eOK,) . Just . fromCEvent <$> peek evPtr + +fromCEvent :: Raw.Input_event -> Event +fromCEvent Raw.Input_event{type', code, value, time} = + Event + (fromCEventData (coerce type', coerce code, coerce value)) + (fromCTimeVal time) fromCEventData :: (Word16, Word16, Int32) -> EventData fromCEventData (t, EventCode -> c, EventValue -> v) = fromMaybe (UnknownEvent t c v) $ toEnum' t >>= \case @@ -183,8 +199,8 @@ fromCEventData (t, EventCode -> c, EventValue -> v) = fromMaybe (UnknownEvent t EvPwr -> Just $ PowerEvent c v EvFfStatus -> Just $ ForceFeedbackStatusEvent c v -toCEvent :: Event -> LL.CEvent -toCEvent (Event e time) = uncurry3 LL.CEvent (toCEventData e) $ toCTimeVal time +toCEvent :: Event -> Raw.Input_event +toCEvent (Event e time) = uncurry3 (Raw.Input_event $ toCTimeVal time) (coerce $ toCEventData e) toCEventData :: EventData -> (Word16, Word16, Int32) toCEventData = \case @@ -203,13 +219,13 @@ toCEventData = \case ForceFeedbackStatusEvent (fromEnum' -> c) (fromEnum' -> v) -> (fromEnum' EvFfStatus, c, v) UnknownEvent (fromEnum' -> t) (fromEnum' -> c) (fromEnum' -> v) -> (t, c, v) -fromCTimeVal :: LL.CTimeVal -> DiffTime -fromCTimeVal (LL.CTimeVal s us) = +fromCTimeVal :: Raw.Timeval -> DiffTime +fromCTimeVal Raw.Timeval{tv_sec = s, tv_usec = us} = fromRational $ fromIntegral s + (fromIntegral us % 1_000_000) --TODO QuickCheck inverse -toCTimeVal :: DiffTime -> LL.CTimeVal -toCTimeVal t = LL.CTimeVal n (round $ f * 1_000_000) +toCTimeVal :: DiffTime -> Raw.Timeval +toCTimeVal t = Raw.Timeval n (round $ f * 1_000_000) where (n,f) = properFraction t {- | Create a device from a valid path - usually /\/dev\/input\/eventX/ for some numeric /X/. diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index f45f12a..090560f 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -1,13 +1,13 @@ module Evdev.LowLevel where import Data.ByteString (ByteString, packCString, useAsCString) -import Data.Int (Int32, Int64) +import Data.Int (Int32) import Data.Void (Void) import Data.Word (Word16, Word32) -import Foreign (ForeignPtr, FunPtr, Ptr, allocaBytes, castPtr, mallocBytes, mallocForeignPtrBytes, newForeignPtr, newForeignPtr_, nullPtr, peek, poke, withForeignPtr) -import Foreign.C (CInt (..), CLong (..), CString, CUInt (..), CUShort (..)) +import Foreign (ForeignPtr, FunPtr, Ptr, castPtr, mallocBytes, mallocForeignPtrBytes, newForeignPtr, newForeignPtr_, nullPtr, peek, poke, withForeignPtr) +import Foreign.C (CInt (..), CString, CUInt (..)) import Foreign.C.ConstPtr (ConstPtr (..)) -import Foreign.C.Error (Errno (Errno), eAGAIN, eOK) +import Foreign.C.Error (Errno (Errno)) import Foreign.Storable (sizeOf) import System.Posix.Types (Fd (Fd)) @@ -30,20 +30,6 @@ foreign import ccall "&libevdev_uinput_destroy" finalizer_libevdev_uinput_destro -- * Data types -data CEvent = CEvent - { cEventType :: Word16 - , cEventCode :: Word16 - , cEventValue :: Int32 - , cEventTime :: CTimeVal - } - deriving (Eq, Ord, Read, Show) - -data CTimeVal = CTimeVal - { tvSec :: Int64 - , tvUsec :: Int64 - } - deriving (Eq, Ord, Read, Show) - data AbsInfo = AbsInfo { absValue :: Int32 , absMinimum :: Int32 @@ -72,49 +58,6 @@ newDeviceFromFd fd = do err <- libevdev_set_fd dev fd pure (err, dev) --- * Events - -inputEventSize :: Int -inputEventSize = sizeOf (undefined :: Raw.Input_event) - -nextEvent :: Device -> CUInt -> IO (Errno, CEvent) -nextEvent dev flags = withDevice dev $ \devPtr -> - allocaBytes inputEventSize $ \evPtr -> do - err <- Raw.libevdev_next_event devPtr flags (castPtr evPtr) - ev <- getEvent evPtr - pure (Errno err, ev) - -nextEventMay :: Device -> CUInt -> IO (Errno, Maybe CEvent) -nextEventMay dev flags = withDevice dev $ \devPtr -> - allocaBytes inputEventSize $ \evPtr -> do - err <- Raw.libevdev_next_event devPtr flags (castPtr evPtr) - if Errno err /= eOK - then - pure - ( if negateErrno (Errno err) == eAGAIN then eOK else Errno err - , Nothing - ) - else do - ev <- getEvent evPtr - pure (eOK, Just ev) - -getEvent :: Ptr Raw.Input_event -> IO CEvent -getEvent evPtr = do - Raw.Input_event{time, type', code, value} <- peek evPtr - let Raw.C__U16 (CUShort t) = type' - Raw.C__U16 (CUShort c) = code - Raw.C__S32 (CInt v) = value - Raw.Timeval{tv_sec, tv_usec} = time - Raw.C__Time_t (CLong sec) = tv_sec - Raw.C__Suseconds_t (CLong usec) = tv_usec - pure $ - CEvent - { cEventType = fromIntegral t - , cEventCode = fromIntegral c - , cEventValue = fromIntegral v - , cEventTime = CTimeVal (fromIntegral sec) (fromIntegral usec) - } - -- * Device properties (getters) deviceFd :: Device -> IO Fd @@ -261,6 +204,3 @@ handleNull def f p = if p == nullPtr then def else f p packCString' :: CString -> IO (Maybe ByteString) packCString' = handleNull (return Nothing) (fmap Just . packCString) - -negateErrno :: Errno -> Errno -negateErrno (Errno cint) = Errno (-cint) diff --git a/evdev/test/Test.hs b/evdev/test/Test.hs index f68aecf..ea912fb 100644 --- a/evdev/test/Test.hs +++ b/evdev/test/Test.hs @@ -12,6 +12,7 @@ import Data.Time import Evdev import Evdev.Codes import qualified Evdev.Uinput as Uinput +import Foreign.C import RawFilePath import System.FilePath.ByteString import System.IO.Error @@ -54,7 +55,7 @@ inverses = [ testGroup "TimeVal" [ testProperty "1" \(s, us) -> - let tv = CTimeVal s us + let tv = Timeval (fromIntegral @CLong s) (fromIntegral @CLong us) in s < 0 || us < 0 || us >= 1_000_000 || toCTimeVal (fromCTimeVal tv) == tv , testProperty "2" \n -> let -- 'toCTimeVal' goes from picoseconds to microseconds From aeaedb1ac018f0b065a68a90002c4d74d3cc6428 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 14:38:41 +0100 Subject: [PATCH 19/55] attempt to nixify CI --- .github/workflows/haskell.yml | 55 +++++++---------------------------- flake.nix | 11 ++++++- 2 files changed, 20 insertions(+), 46 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index d9c1df4..8fa2e01 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -11,51 +11,16 @@ jobs: name: main runs-on: ubuntu-latest steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 + - uses: DeterminateSystems/nix-installer-action@main + - uses: DeterminateSystems/magic-nix-cache-action@main - - name: Set user input permissions - run: sudo usermod -a -G input $USER + - name: Build all packages + run: nix build .#ci - - name: Set up GHC - uses: haskell-actions/setup@v2 - id: setup - with: - ghc-version: '9.12' - cabal-version: '3.16' - cabal-update: true + # TODO work around test permissions and ARM build and + # - name: Run checks + # run: nix flake check - - name: Install libevdev - run: sudo apt install -y libevdev-dev - - - name: Configure the build - run: | - cabal configure --enable-tests --enable-benchmarks --disable-documentation - cabal build all --dry-run - - - name: Restore cached dependencies - uses: actions/cache/restore@v3 - id: cache - env: - key: ${{ runner.os }}-ghc-${{ steps.setup.outputs.ghc-version }}-cabal-${{ steps.setup.outputs.cabal-version }} - with: - path: ${{ steps.setup.outputs.cabal-store }} - key: ${{ env.key }}-plan-${{ hashFiles('**/plan.json') }} - restore-keys: ${{ env.key }}- - - - name: Install dependencies - run: cabal build all --only-dependencies - - - name: Save cached dependencies - uses: actions/cache/save@v3 - if: ${{ steps.cache.outputs.cache-primary-key != steps.cache.outputs.cache-matched-key }} - with: - path: ${{ steps.setup.outputs.cabal-store }} - key: ${{ steps.cache.outputs.cache-primary-key }} - - - name: Build - run: cabal build all - - - name: Run tests - run: | - cabal build test - sudo $(cabal list-bin test) + - name: Run main test with permissions + run: sudo $(nix build .#evdev:test:test --print-out-paths)/bin/test diff --git a/flake.nix b/flake.nix index a651495..1df4757 100644 --- a/flake.nix +++ b/flake.nix @@ -28,6 +28,15 @@ }) ]; pkgs = import nixpkgs { inherit system overlays; inherit (haskell-nix) config; }; + flake = pkgs.myHaskellProject.flake { }; in - pkgs.myHaskellProject.flake { }); + flake // { + packages = flake.packages // { + ci = pkgs.linkFarm "ci" ( + pkgs.lib.mapAttrsToList (name: drv: { inherit name; path = drv; }) + flake.ciJobs.packages + ); + }; + } + ); } From 658a065ad616b1d98591475f6960675e6c4123e0 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 15:47:19 +0100 Subject: [PATCH 20/55] further simplify absinfo and uinput construction, fixing malloc memory leak --- evdev/src/Evdev.hs | 34 ++++++++++++++++++++---- evdev/src/Evdev/LowLevel.hs | 52 +++---------------------------------- evdev/src/Evdev/Uinput.hs | 31 +++++++++++++--------- 3 files changed, 51 insertions(+), 66 deletions(-) diff --git a/evdev/src/Evdev.hs b/evdev/src/Evdev.hs index a55106a..1d9fe54 100644 --- a/evdev/src/Evdev.hs +++ b/evdev/src/Evdev.hs @@ -23,7 +23,7 @@ module Evdev ( deviceBustype, deviceVersion, deviceAbsAxis, - LL.AbsInfo (..), + AbsInfo (..), -- ** Grabbing grabDevice, ungrabDevice, @@ -57,6 +57,7 @@ import Control.Arrow ((&&&)) import Control.Monad (filterM, join) import Data.ByteString.Char8 (ByteString, pack) import Data.Coerce (coerce) +import Data.Functor ((<&>)) import Data.Int (Int32) import Data.List.Extra (enumerate) import Data.Map ((!?), Map) @@ -68,8 +69,9 @@ import qualified Data.Set as Set import Data.Time.Clock (DiffTime) import Data.Tuple.Extra (uncurry3) import Data.Word (Word16) -import Foreign (alloca, peek, (.|.)) -import Foreign.C (CInt (CInt), CUInt, CUShort (CUShort), Errno (Errno), eAGAIN, eOK) +import Foreign (alloca, (.|.), peek) +import Foreign.C (CInt (CInt), CUInt (CUInt), CUShort (CUShort), Errno (Errno), eAGAIN, eOK) +import Foreign.C.ConstPtr (ConstPtr (ConstPtr), unConstPtr) import System.Posix.Process (getProcessID) import System.Posix.Files (readSymbolicLink) import System.Posix.ByteString (Fd, RawFilePath) @@ -282,8 +284,30 @@ deviceHasEvent :: Device -> EventData -> IO Bool deviceHasEvent dev e = LL.hasEventCode (cDevice dev) typ code where (typ,code,_val) = toCEventData e -deviceAbsAxis :: Device -> AbsoluteAxis -> IO (Maybe LL.AbsInfo) -deviceAbsAxis dev = LL.getAbsInfo (cDevice dev) . fromEnum' +data AbsInfo = AbsInfo + { absValue :: Int32 + , absMinimum :: Int32 + , absMaximum :: Int32 + , absFuzz :: Int32 + , absFlat :: Int32 + , absResolution :: Int32 + } + deriving (Show) + +deviceAbsAxis :: Device -> AbsoluteAxis -> IO (Maybe AbsInfo) +deviceAbsAxis dev (fromEnum' -> code) = LL.withDevice (cDevice dev) \devPtr -> + (unConstPtr <$> Raw.libevdev_get_abs_info (ConstPtr devPtr) (CUInt code)) + >>= LL.handleNull (pure Nothing) \absInfoPtr -> + peek absInfoPtr <&> \raw -> + Just + AbsInfo + { absValue = coerce raw.value + , absMinimum = coerce raw.minimum + , absMaximum = coerce raw.maximum + , absFuzz = coerce raw.fuzz + , absFlat = coerce raw.flat + , absResolution = coerce raw.resolution + } data LEDValue = LedOn | LedOff deriving (Bounded, Eq, Ord, Read, Show) diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index 090560f..aedd877 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -2,10 +2,9 @@ module Evdev.LowLevel where import Data.ByteString (ByteString, packCString, useAsCString) import Data.Int (Int32) -import Data.Void (Void) -import Data.Word (Word16, Word32) -import Foreign (ForeignPtr, FunPtr, Ptr, castPtr, mallocBytes, mallocForeignPtrBytes, newForeignPtr, newForeignPtr_, nullPtr, peek, poke, withForeignPtr) -import Foreign.C (CInt (..), CString, CUInt (..)) +import Data.Word (Word16) +import Foreign (ForeignPtr, FunPtr, Ptr, castPtr, mallocForeignPtrBytes, newForeignPtr, nullPtr, peek, withForeignPtr) +import Foreign.C (CString) import Foreign.C.ConstPtr (ConstPtr (..)) import Foreign.C.Error (Errno (Errno)) import Foreign.Storable (sizeOf) @@ -28,18 +27,6 @@ withUDevice (UDevice fp) = withForeignPtr fp foreign import ccall "&libevdev_hs_close" finalizer_libevdev_hs_close :: FunPtr (Ptr Raw.Libevdev -> IO ()) foreign import ccall "&libevdev_uinput_destroy" finalizer_libevdev_uinput_destroy :: FunPtr (Ptr Raw.Libevdev_uinput -> IO ()) --- * Data types - -data AbsInfo = AbsInfo - { absValue :: Int32 - , absMinimum :: Int32 - , absMaximum :: Int32 - , absFuzz :: Int32 - , absFlat :: Int32 - , absResolution :: Int32 - } - deriving (Show) - -- * Device lifecycle libevdev_new :: IO Device @@ -139,39 +126,6 @@ hasEventCode :: Device -> Word16 -> Word16 -> IO Bool hasEventCode dev t c = withDevice dev $ \devPtr -> (/= 0) <$> Raw.libevdev_has_event_code (ConstPtr devPtr) (fromIntegral t) (fromIntegral c) --- * Abs info - -getAbsInfo :: Device -> Word32 -> IO (Maybe AbsInfo) -getAbsInfo dev code = withDevice dev \devPtr -> do - (unConstPtr <$> Raw.libevdev_get_abs_info (ConstPtr devPtr) (CUInt code)) - >>= handleNull (pure Nothing) \absInfoPtr -> do - Raw.Input_absinfo - { value = Raw.C__S32 (CInt absValue) - , minimum = Raw.C__S32 (CInt absMinimum) - , maximum = Raw.C__S32 (CInt absMaximum) - , fuzz = Raw.C__S32 (CInt absFuzz) - , flat = Raw.C__S32 (CInt absFlat) - , resolution = Raw.C__S32 (CInt absResolution) - } <- - peek absInfoPtr - pure $ Just AbsInfo{..} - -withAbsInfo :: AbsInfo -> (Ptr Void -> IO a) -> IO a -withAbsInfo AbsInfo{..} f = do - let info = - Raw.Input_absinfo - { value = Raw.C__S32 (CInt absValue) - , minimum = Raw.C__S32 (CInt absMinimum) - , maximum = Raw.C__S32 (CInt absMaximum) - , fuzz = Raw.C__S32 (CInt absFuzz) - , flat = Raw.C__S32 (CInt absFlat) - , resolution = Raw.C__S32 (CInt absResolution) - } - p <- mallocBytes (sizeOf info) - poke (castPtr p) info - fp <- newForeignPtr_ p - withForeignPtr fp f - -- * Uinput createFromDevice :: Device -> Fd -> IO (Errno, UDevice) diff --git a/evdev/src/Evdev/Uinput.hs b/evdev/src/Evdev/Uinput.hs index b372e39..4499a5e 100644 --- a/evdev/src/Evdev/Uinput.hs +++ b/evdev/src/Evdev/Uinput.hs @@ -24,12 +24,14 @@ module Evdev.Uinput ( import Control.Monad import Control.Monad.State import Data.Foldable +import Data.Function import Data.Tuple.Extra import Foreign import Foreign.C import Foreign.C.ConstPtr import Data.ByteString.Char8 (ByteString) +import Data.Coerce (coerce) import Evdev hiding (Device, newDevice) import Evdev.Codes @@ -59,16 +61,17 @@ newDevice name DeviceOpts{..} = do maybeSet LL.libevdev_set_id_bustype idBustype maybeSet LL.libevdev_set_id_version idVersion - let enable dataPtr t cs = do + let enable (dataPtr :: Maybe (Either (Ptr Raw.Input_absinfo) (Ptr Int))) t cs = do unless (null cs) $ cec $ LL.withDevice dev \devPtr -> Errno <$> Raw.libevdev_enable_event_type devPtr t' forM_ cs $ \c -> cec $ LL.withDevice dev \devPtr -> - Errno <$> Raw.libevdev_enable_event_code devPtr t' c (ConstPtr dataPtr) + Errno <$> Raw.libevdev_enable_event_code devPtr t' c + (ConstPtr $ maybe nullPtr (either castPtr castPtr) dataPtr) where t' = fromEnum' t mapM_ - (uncurry $ enable nullPtr) + (uncurry $ enable Nothing) [ (EvKey, map fromEnum' keys) , (EvRel, map fromEnum' relAxes) , (EvMsc, map fromEnum' miscs) @@ -80,15 +83,19 @@ newDevice name DeviceOpts{..} = do , (EvFfStatus, map fromEnum' ffStats) ] - forM_ reps $ \(rep, n) -> do - pf <- mallocForeignPtr - withForeignPtr pf \p -> do - poke p n - enable (castPtr p) EvRep [fromEnum' rep] + forM_ reps \(rep, n) -> with n \p -> + enable (Just $ Right p) EvRep [fromEnum' rep] - forM_ absAxes $ \(axis, absInfo) -> - LL.withAbsInfo absInfo $ \ptr -> - enable ptr EvAbs [fromEnum' axis] + forM_ absAxes \(axis, AbsInfo{..}) -> + Raw.Input_absinfo + { value = coerce absValue + , minimum = coerce absMinimum + , maximum = coerce absMaximum + , fuzz = coerce absFuzz + , flat = coerce absFlat + , resolution = coerce absResolution + } + & flip with \ptr -> enable (Just $ Left ptr) EvAbs [fromEnum' axis] fmap Device $ cec $ LL.createFromDevice dev $ fromIntegral (Raw.LIBEVDEV_UINPUT_OPEN_MANAGED).unwrap where @@ -104,7 +111,7 @@ data DeviceOpts = DeviceOpts , idVersion :: Maybe Int , keys :: [Key] , relAxes :: [RelativeAxis] - , absAxes :: [(AbsoluteAxis, LL.AbsInfo)] + , absAxes :: [(AbsoluteAxis, AbsInfo)] , miscs :: [MiscEvent] , switchs :: [SwitchEvent] , leds :: [LEDEvent] From 75eeeb9bd5da5840b78dc29b552add82af10df4f Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 15:50:07 +0100 Subject: [PATCH 21/55] try cachix for CI --- .github/workflows/haskell.yml | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 8fa2e01..6f6c4a0 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -12,8 +12,13 @@ jobs: runs-on: ubuntu-latest steps: - uses: actions/checkout@v4 - - uses: DeterminateSystems/nix-installer-action@main - - uses: DeterminateSystems/magic-nix-cache-action@main + - uses: cachix/install-nix-action@v30 + with: + github_access_token: ${{ secrets.GITHUB_TOKEN }} + - uses: cachix/cachix-action@v15 + with: + name: georgefst + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - name: Build all packages run: nix build .#ci From c7884cc23e25d1ec6e5fb40d64ab008fdba25b26 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 16:05:43 +0100 Subject: [PATCH 22/55] add iog keys --- .github/workflows/haskell.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 6f6c4a0..228f03a 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -15,6 +15,9 @@ jobs: - uses: cachix/install-nix-action@v30 with: github_access_token: ${{ secrets.GITHUB_TOKEN }} + extra_nix_config: | + extra-substituters = https://cache.iog.io + extra-trusted-public-keys = hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= - uses: cachix/cachix-action@v15 with: name: georgefst From b81851b2274af34a5b35575a2d02f347d48a3304 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 16:21:18 +0100 Subject: [PATCH 23/55] add unofficial iog keys --- .github/workflows/haskell.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 228f03a..f4940b6 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -16,8 +16,8 @@ jobs: with: github_access_token: ${{ secrets.GITHUB_TOKEN }} extra_nix_config: | - extra-substituters = https://cache.iog.io - extra-trusted-public-keys = hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= + extra-substituters = https://cache.iog.io https://cache.zw3rk.com + extra-trusted-public-keys = hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= loony-tools:pr9m4BkM/5/eSTZlkQyRt57Jz7OMBxNSUiMC4FkcNfk= - uses: cachix/cachix-action@v15 with: name: georgefst From 91849606e0471eb1cb779f00a5109b54e9b5f3ce Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 17:06:33 +0100 Subject: [PATCH 24/55] further simplify uinput creation, and avoid potential access to uninitialised memory --- evdev/src/Evdev/LowLevel.hs | 14 ++------------ evdev/src/Evdev/Uinput.hs | 9 ++++++++- 2 files changed, 10 insertions(+), 13 deletions(-) diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index aedd877..211c574 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -3,11 +3,9 @@ module Evdev.LowLevel where import Data.ByteString (ByteString, packCString, useAsCString) import Data.Int (Int32) import Data.Word (Word16) -import Foreign (ForeignPtr, FunPtr, Ptr, castPtr, mallocForeignPtrBytes, newForeignPtr, nullPtr, peek, withForeignPtr) -import Foreign.C (CString) +import Foreign (ForeignPtr, FunPtr, Ptr, newForeignPtr, nullPtr, withForeignPtr) +import Foreign.C (CString, Errno (Errno)) import Foreign.C.ConstPtr (ConstPtr (..)) -import Foreign.C.Error (Errno (Errno)) -import Foreign.Storable (sizeOf) import System.Posix.Types (Fd (Fd)) import Evdev.Codes @@ -128,14 +126,6 @@ hasEventCode dev t c = withDevice dev $ \devPtr -> -- * Uinput -createFromDevice :: Device -> Fd -> IO (Errno, UDevice) -createFromDevice dev (Fd fd) = withDevice dev $ \devPtr -> do - udevPtrPtr <- mallocForeignPtrBytes (sizeOf (undefined :: Ptr ())) - (e, udevPtr) <- withForeignPtr udevPtrPtr $ \pp -> - (,) <$> Raw.libevdev_uinput_create_from_device (ConstPtr devPtr) fd (castPtr pp) <*> peek pp - udevFP <- newForeignPtr finalizer_libevdev_uinput_destroy udevPtr - pure (Errno e, UDevice udevFP) - getSyspath :: UDevice -> IO (Maybe ByteString) getSyspath dev = withUDevice dev $ \devPtr -> Raw.libevdev_uinput_get_syspath devPtr >>= packCString' . unConstPtr diff --git a/evdev/src/Evdev/Uinput.hs b/evdev/src/Evdev/Uinput.hs index 4499a5e..1d6e2a5 100644 --- a/evdev/src/Evdev/Uinput.hs +++ b/evdev/src/Evdev/Uinput.hs @@ -97,7 +97,14 @@ newDevice name DeviceOpts{..} = do } & flip with \ptr -> enable (Just $ Left ptr) EvAbs [fromEnum' axis] - fmap Device $ cec $ LL.createFromDevice dev $ fromIntegral (Raw.LIBEVDEV_UINPUT_OPEN_MANAGED).unwrap + LL.withDevice dev \devPtr -> alloca \pp -> do + cec $ Errno <$> Raw.libevdev_uinput_create_from_device + (ConstPtr devPtr) + (coerce (Raw.LIBEVDEV_UINPUT_OPEN_MANAGED).unwrap) + pp + udevPtr <- peek pp + udevFP <- newForeignPtr LL.finalizer_libevdev_uinput_destroy udevPtr + pure $ Device $ LL.UDevice udevFP where cec :: CErrCall a => IO a -> IO (CErrCallRes a) cec = cErrCall "newDevice" () From 92cffd908279cd3ac6b54b7da79ad7c745a732fd Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 17:24:15 +0100 Subject: [PATCH 25/55] remove pointless low-level opaque device types --- evdev/src/Evdev.hs | 14 ++--- evdev/src/Evdev/LowLevel.hs | 107 ++++++++++++++++-------------------- evdev/src/Evdev/Uinput.hs | 12 ++-- evdev/src/Util.hs | 4 +- 4 files changed, 64 insertions(+), 73 deletions(-) diff --git a/evdev/src/Evdev.hs b/evdev/src/Evdev.hs index 1d9fe54..c1ac5f6 100644 --- a/evdev/src/Evdev.hs +++ b/evdev/src/Evdev.hs @@ -69,7 +69,7 @@ import qualified Data.Set as Set import Data.Time.Clock (DiffTime) import Data.Tuple.Extra (uncurry3) import Data.Word (Word16) -import Foreign (alloca, (.|.), peek) +import Foreign (alloca, (.|.), peek, ForeignPtr, withForeignPtr) import Foreign.C (CInt (CInt), CUInt (CUInt), CUShort (CUShort), Errno (Errno), eAGAIN, eOK) import Foreign.C.ConstPtr (ConstPtr (ConstPtr), unConstPtr) import System.Posix.Process (getProcessID) @@ -85,7 +85,7 @@ import Util -- stores path that was originally used, as it seems impossible to recover this later -- We don't allow the user to access the underlying low-level C device. -- | An input device. -data Device = Device { cDevice :: LL.Device, devicePath :: ByteString } +data Device = Device { cDevice :: ForeignPtr Raw.Libevdev, devicePath :: ByteString } instance Show Device where @@ -160,7 +160,7 @@ ungrabDevice = grabDevice' Raw.LIBEVDEV_UNGRAB -- | Get the next event from the device. nextEvent :: Device -> IO Event nextEvent dev = - cErrCall "nextEvent" dev $ LL.withDevice (cDevice dev) \devPtr -> alloca \evPtr -> + cErrCall "nextEvent" dev $ withForeignPtr (cDevice dev) \devPtr -> alloca \evPtr -> (,) <$> (Errno <$> Raw.libevdev_next_event devPtr (convertFlags defaultReadFlags) evPtr) <*> (fromCEvent <$> peek evPtr) @@ -170,7 +170,7 @@ Designed for use with devices created from a non-blocking file descriptor. Other -} nextEventMay :: Device -> IO (Maybe Event) nextEventMay dev = - cErrCall "nextEventMay" dev $ LL.withDevice (cDevice dev) \devPtr -> alloca \evPtr -> do + cErrCall "nextEventMay" dev $ withForeignPtr (cDevice dev) \devPtr -> alloca \evPtr -> do err <- Raw.libevdev_next_event devPtr (convertFlags nonBlockingReadFlags) evPtr if Errno err /= eOK then @@ -295,7 +295,7 @@ data AbsInfo = AbsInfo deriving (Show) deviceAbsAxis :: Device -> AbsoluteAxis -> IO (Maybe AbsInfo) -deviceAbsAxis dev (fromEnum' -> code) = LL.withDevice (cDevice dev) \devPtr -> +deviceAbsAxis dev (fromEnum' -> code) = withForeignPtr (cDevice dev) \devPtr -> (unConstPtr <$> Raw.libevdev_get_abs_info (ConstPtr devPtr) (CUInt code)) >>= LL.handleNull (pure Nothing) \absInfoPtr -> peek absInfoPtr <&> \raw -> @@ -314,7 +314,7 @@ data LEDValue = LedOn | LedOff -- | Set the state of a LED on a device. setDeviceLED :: Device -> LEDEvent -> LEDValue -> IO () -setDeviceLED dev led val = cErrCall "setDeviceLED" dev $ LL.withDevice (cDevice dev) \devPtr -> +setDeviceLED dev led val = cErrCall "setDeviceLED" dev $ withForeignPtr (cDevice dev) \devPtr -> Errno <$> Raw.libevdev_kernel_set_led_value devPtr (LL.convertEnum led) case val of LedOn -> Raw.LIBEVDEV_LED_ON LedOff -> Raw.LIBEVDEV_LED_OFF @@ -323,7 +323,7 @@ setDeviceLED dev led val = cErrCall "setDeviceLED" dev $ LL.withDevice (cDevice grabDevice' :: Raw.Libevdev_grab_mode -> Device -> IO () grabDevice' mode dev = cErrCall "grabDevice" dev $ - LL.withDevice (cDevice dev) $ fmap Errno . flip Raw.libevdev_grab mode + withForeignPtr (cDevice dev) $ fmap Errno . flip Raw.libevdev_grab mode {- TODO this is a workaround until c2hs has a better story for enum conversions diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index 211c574..c85995b 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -11,33 +11,22 @@ import System.Posix.Types (Fd (Fd)) import Evdev.Codes import Evdev.Raw qualified as Raw --- * Opaque device types - -newtype Device = Device (ForeignPtr Raw.Libevdev) -newtype UDevice = UDevice (ForeignPtr Raw.Libevdev_uinput) - -withDevice :: Device -> (Ptr Raw.Libevdev -> IO a) -> IO a -withDevice (Device fp) = withForeignPtr fp - -withUDevice :: UDevice -> (Ptr Raw.Libevdev_uinput -> IO a) -> IO a -withUDevice (UDevice fp) = withForeignPtr fp +-- * Device lifecycle foreign import ccall "&libevdev_hs_close" finalizer_libevdev_hs_close :: FunPtr (Ptr Raw.Libevdev -> IO ()) foreign import ccall "&libevdev_uinput_destroy" finalizer_libevdev_uinput_destroy :: FunPtr (Ptr Raw.Libevdev_uinput -> IO ()) --- * Device lifecycle - -libevdev_new :: IO Device +libevdev_new :: IO (ForeignPtr Raw.Libevdev) libevdev_new = do ptr <- Raw.libevdev_new fp <- newForeignPtr finalizer_libevdev_hs_close ptr - pure (Device fp) + pure fp -libevdev_set_fd :: Device -> Fd -> IO Errno -libevdev_set_fd dev (Fd fd) = withDevice dev $ \devPtr -> +libevdev_set_fd :: ForeignPtr Raw.Libevdev -> Fd -> IO Errno +libevdev_set_fd dev (Fd fd) = withForeignPtr dev $ \devPtr -> Errno <$> Raw.libevdev_set_fd devPtr fd -newDeviceFromFd :: Fd -> IO (Errno, Device) +newDeviceFromFd :: Fd -> IO (Errno, ForeignPtr Raw.Libevdev) newDeviceFromFd fd = do dev <- libevdev_new err <- libevdev_set_fd dev fd @@ -45,97 +34,97 @@ newDeviceFromFd fd = do -- * Device properties (getters) -deviceFd :: Device -> IO Fd -deviceFd dev = withDevice dev $ \devPtr -> +deviceFd :: ForeignPtr Raw.Libevdev -> IO Fd +deviceFd dev = withForeignPtr dev $ \devPtr -> Fd <$> Raw.libevdev_get_fd (ConstPtr devPtr) -deviceName :: Device -> IO (IO ByteString) -deviceName dev = withDevice dev $ \devPtr -> do +deviceName :: ForeignPtr Raw.Libevdev -> IO (IO ByteString) +deviceName dev = withForeignPtr dev $ \devPtr -> do cstr <- Raw.libevdev_get_name (ConstPtr devPtr) pure $ packCString (unConstPtr cstr) -devicePhys :: Device -> IO (IO (Maybe ByteString)) -devicePhys dev = withDevice dev $ \devPtr -> do +devicePhys :: ForeignPtr Raw.Libevdev -> IO (IO (Maybe ByteString)) +devicePhys dev = withForeignPtr dev $ \devPtr -> do cstr <- Raw.libevdev_get_phys (ConstPtr devPtr) pure $ packCString' (unConstPtr cstr) -deviceUniq :: Device -> IO (IO (Maybe ByteString)) -deviceUniq dev = withDevice dev $ \devPtr -> do +deviceUniq :: ForeignPtr Raw.Libevdev -> IO (IO (Maybe ByteString)) +deviceUniq dev = withForeignPtr dev $ \devPtr -> do cstr <- Raw.libevdev_get_uniq (ConstPtr devPtr) pure $ packCString' (unConstPtr cstr) -deviceProduct :: Device -> IO Int -deviceProduct dev = withDevice dev $ \devPtr -> +deviceProduct :: ForeignPtr Raw.Libevdev -> IO Int +deviceProduct dev = withForeignPtr dev $ \devPtr -> fromIntegral <$> Raw.libevdev_get_id_product (ConstPtr devPtr) -deviceVendor :: Device -> IO Int -deviceVendor dev = withDevice dev $ \devPtr -> +deviceVendor :: ForeignPtr Raw.Libevdev -> IO Int +deviceVendor dev = withForeignPtr dev $ \devPtr -> fromIntegral <$> Raw.libevdev_get_id_vendor (ConstPtr devPtr) -deviceBustype :: Device -> IO Int -deviceBustype dev = withDevice dev $ \devPtr -> +deviceBustype :: ForeignPtr Raw.Libevdev -> IO Int +deviceBustype dev = withForeignPtr dev $ \devPtr -> fromIntegral <$> Raw.libevdev_get_id_bustype (ConstPtr devPtr) -deviceVersion :: Device -> IO Int -deviceVersion dev = withDevice dev $ \devPtr -> +deviceVersion :: ForeignPtr Raw.Libevdev -> IO Int +deviceVersion dev = withForeignPtr dev $ \devPtr -> fromIntegral <$> Raw.libevdev_get_id_version (ConstPtr devPtr) -- * Device properties (setters) -setDeviceName :: Device -> ByteString -> IO () -setDeviceName dev name = withDevice dev $ \devPtr -> +setDeviceName :: ForeignPtr Raw.Libevdev -> ByteString -> IO () +setDeviceName dev name = withForeignPtr dev $ \devPtr -> useAsCString name $ \cstr -> Raw.libevdev_set_name devPtr (ConstPtr cstr) -setDevicePhys :: Device -> ByteString -> IO () -setDevicePhys dev phys = withDevice dev $ \devPtr -> +setDevicePhys :: ForeignPtr Raw.Libevdev -> ByteString -> IO () +setDevicePhys dev phys = withForeignPtr dev $ \devPtr -> useAsCString phys $ \cstr -> Raw.libevdev_set_phys devPtr (ConstPtr cstr) -setDeviceUniq :: Device -> ByteString -> IO () -setDeviceUniq dev uniq = withDevice dev $ \devPtr -> +setDeviceUniq :: ForeignPtr Raw.Libevdev -> ByteString -> IO () +setDeviceUniq dev uniq = withForeignPtr dev $ \devPtr -> useAsCString uniq $ \cstr -> Raw.libevdev_set_uniq devPtr (ConstPtr cstr) -libevdev_set_id_product :: Device -> Int -> IO () -libevdev_set_id_product dev n = withDevice dev $ \devPtr -> +libevdev_set_id_product :: ForeignPtr Raw.Libevdev -> Int -> IO () +libevdev_set_id_product dev n = withForeignPtr dev $ \devPtr -> Raw.libevdev_set_id_product devPtr (fromIntegral n) -libevdev_set_id_vendor :: Device -> Int -> IO () -libevdev_set_id_vendor dev n = withDevice dev $ \devPtr -> +libevdev_set_id_vendor :: ForeignPtr Raw.Libevdev -> Int -> IO () +libevdev_set_id_vendor dev n = withForeignPtr dev $ \devPtr -> Raw.libevdev_set_id_vendor devPtr (fromIntegral n) -libevdev_set_id_bustype :: Device -> Int -> IO () -libevdev_set_id_bustype dev n = withDevice dev $ \devPtr -> +libevdev_set_id_bustype :: ForeignPtr Raw.Libevdev -> Int -> IO () +libevdev_set_id_bustype dev n = withForeignPtr dev $ \devPtr -> Raw.libevdev_set_id_bustype devPtr (fromIntegral n) -libevdev_set_id_version :: Device -> Int -> IO () -libevdev_set_id_version dev n = withDevice dev $ \devPtr -> +libevdev_set_id_version :: ForeignPtr Raw.Libevdev -> Int -> IO () +libevdev_set_id_version dev n = withForeignPtr dev $ \devPtr -> Raw.libevdev_set_id_version devPtr (fromIntegral n) -- * Capability queries -hasProperty :: Device -> DeviceProperty -> IO Bool -hasProperty dev prop = withDevice dev $ \devPtr -> +hasProperty :: ForeignPtr Raw.Libevdev -> DeviceProperty -> IO Bool +hasProperty dev prop = withForeignPtr dev $ \devPtr -> (/= 0) <$> Raw.libevdev_has_property (ConstPtr devPtr) (convertEnum prop) -hasEventType :: Device -> EventType -> IO Bool -hasEventType dev et = withDevice dev $ \devPtr -> +hasEventType :: ForeignPtr Raw.Libevdev -> EventType -> IO Bool +hasEventType dev et = withForeignPtr dev $ \devPtr -> (/= 0) <$> Raw.libevdev_has_event_type (ConstPtr devPtr) (convertEnum et) -hasEventCode :: Device -> Word16 -> Word16 -> IO Bool -hasEventCode dev t c = withDevice dev $ \devPtr -> +hasEventCode :: ForeignPtr Raw.Libevdev -> Word16 -> Word16 -> IO Bool +hasEventCode dev t c = withForeignPtr dev $ \devPtr -> (/= 0) <$> Raw.libevdev_has_event_code (ConstPtr devPtr) (fromIntegral t) (fromIntegral c) -- * Uinput -getSyspath :: UDevice -> IO (Maybe ByteString) -getSyspath dev = withUDevice dev $ \devPtr -> +getSyspath :: ForeignPtr Raw.Libevdev_uinput -> IO (Maybe ByteString) +getSyspath dev = withForeignPtr dev $ \devPtr -> Raw.libevdev_uinput_get_syspath devPtr >>= packCString' . unConstPtr -getDevnode :: UDevice -> IO (Maybe ByteString) -getDevnode dev = withUDevice dev $ \devPtr -> +getDevnode :: ForeignPtr Raw.Libevdev_uinput -> IO (Maybe ByteString) +getDevnode dev = withForeignPtr dev $ \devPtr -> Raw.libevdev_uinput_get_devnode devPtr >>= packCString' . unConstPtr -writeEvent :: UDevice -> Word16 -> Word16 -> Int32 -> IO Errno -writeEvent dev t c v = withUDevice dev $ \devPtr -> +writeEvent :: ForeignPtr Raw.Libevdev_uinput -> Word16 -> Word16 -> Int32 -> IO Errno +writeEvent dev t c v = withForeignPtr dev $ \devPtr -> Errno <$> Raw.libevdev_uinput_write_event (ConstPtr devPtr) (fromIntegral t) (fromIntegral c) (fromIntegral v) -- * Util diff --git a/evdev/src/Evdev/Uinput.hs b/evdev/src/Evdev/Uinput.hs index 1d6e2a5..eaa41cf 100644 --- a/evdev/src/Evdev/Uinput.hs +++ b/evdev/src/Evdev/Uinput.hs @@ -40,7 +40,7 @@ import qualified Evdev.Raw as Raw import Util -- | A `uinput` device. -newtype Device = Device LL.UDevice +newtype Device = Device (ForeignPtr Raw.Libevdev_uinput) -- | Create a new `uinput` device. newDevice :: @@ -52,7 +52,7 @@ newDevice name DeviceOpts{..} = do dev <- LL.libevdev_new LL.setDeviceName dev name - let maybeSet :: (LL.Device -> a -> IO ()) -> Maybe a -> IO () + let maybeSet :: (ForeignPtr Raw.Libevdev -> a -> IO ()) -> Maybe a -> IO () maybeSet = maybe mempty . ($ dev) maybeSet LL.setDevicePhys phys maybeSet LL.setDeviceUniq uniq @@ -62,9 +62,9 @@ newDevice name DeviceOpts{..} = do maybeSet LL.libevdev_set_id_version idVersion let enable (dataPtr :: Maybe (Either (Ptr Raw.Input_absinfo) (Ptr Int))) t cs = do - unless (null cs) $ cec $ LL.withDevice dev \devPtr -> + unless (null cs) $ cec $ withForeignPtr dev \devPtr -> Errno <$> Raw.libevdev_enable_event_type devPtr t' - forM_ cs $ \c -> cec $ LL.withDevice dev \devPtr -> + forM_ cs $ \c -> cec $ withForeignPtr dev \devPtr -> Errno <$> Raw.libevdev_enable_event_code devPtr t' c (ConstPtr $ maybe nullPtr (either castPtr castPtr) dataPtr) where @@ -97,14 +97,14 @@ newDevice name DeviceOpts{..} = do } & flip with \ptr -> enable (Just $ Left ptr) EvAbs [fromEnum' axis] - LL.withDevice dev \devPtr -> alloca \pp -> do + withForeignPtr dev \devPtr -> alloca \pp -> do cec $ Errno <$> Raw.libevdev_uinput_create_from_device (ConstPtr devPtr) (coerce (Raw.LIBEVDEV_UINPUT_OPEN_MANAGED).unwrap) pp udevPtr <- peek pp udevFP <- newForeignPtr LL.finalizer_libevdev_uinput_destroy udevPtr - pure $ Device $ LL.UDevice udevFP + pure $ Device udevFP where cec :: CErrCall a => IO a -> IO (CErrCallRes a) cec = cErrCall "newDevice" () diff --git a/evdev/src/Util.hs b/evdev/src/Util.hs index 269cf4e..35ad0d0 100644 --- a/evdev/src/Util.hs +++ b/evdev/src/Util.hs @@ -1,10 +1,12 @@ module Util where import qualified Data.ByteString.Char8 as BS +import Foreign (ForeignPtr) import Foreign.C.Error (Errno (Errno), errnoToIOError) import System.Posix.ByteString (RawFilePath) import qualified Evdev.LowLevel as LL +import qualified Evdev.Raw as Raw fromEnum' :: (Num c, Enum a) => a -> c fromEnum' = fromIntegral . fromEnum @@ -18,7 +20,7 @@ instance CErrInfo () where cErrInfo () = return Nothing instance CErrInfo RawFilePath where cErrInfo = pure . pure -instance CErrInfo LL.UDevice where +instance CErrInfo (ForeignPtr Raw.Libevdev_uinput) where cErrInfo = LL.getSyspath -- for c actions which return an error value (0 for success) From dea82a440816bb8e547ae48c569ca4e8bbe68e85 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 17:24:32 +0100 Subject: [PATCH 26/55] minor refactors --- evdev/src/Evdev/LowLevel.hs | 5 +---- evdev/src/Evdev/Uinput.hs | 4 +--- 2 files changed, 2 insertions(+), 7 deletions(-) diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index c85995b..dd1fa3b 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -17,10 +17,7 @@ foreign import ccall "&libevdev_hs_close" finalizer_libevdev_hs_close :: FunPtr foreign import ccall "&libevdev_uinput_destroy" finalizer_libevdev_uinput_destroy :: FunPtr (Ptr Raw.Libevdev_uinput -> IO ()) libevdev_new :: IO (ForeignPtr Raw.Libevdev) -libevdev_new = do - ptr <- Raw.libevdev_new - fp <- newForeignPtr finalizer_libevdev_hs_close ptr - pure fp +libevdev_new = newForeignPtr finalizer_libevdev_hs_close =<< Raw.libevdev_new libevdev_set_fd :: ForeignPtr Raw.Libevdev -> Fd -> IO Errno libevdev_set_fd dev (Fd fd) = withForeignPtr dev $ \devPtr -> diff --git a/evdev/src/Evdev/Uinput.hs b/evdev/src/Evdev/Uinput.hs index eaa41cf..976e4b4 100644 --- a/evdev/src/Evdev/Uinput.hs +++ b/evdev/src/Evdev/Uinput.hs @@ -102,9 +102,7 @@ newDevice name DeviceOpts{..} = do (ConstPtr devPtr) (coerce (Raw.LIBEVDEV_UINPUT_OPEN_MANAGED).unwrap) pp - udevPtr <- peek pp - udevFP <- newForeignPtr LL.finalizer_libevdev_uinput_destroy udevPtr - pure $ Device udevFP + fmap Device . newForeignPtr LL.finalizer_libevdev_uinput_destroy =<< peek pp where cec :: CErrCall a => IO a -> IO (CErrCallRes a) cec = cErrCall "newDevice" () From 7a9a19e3970e5c848f4ff1f3a67d799147a2523f Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 18:27:07 +0100 Subject: [PATCH 27/55] inline uinput functions and start simplifying utils --- evdev/src/Evdev.hs | 4 ++-- evdev/src/Evdev/LowLevel.hs | 35 +++++------------------------------ evdev/src/Evdev/Uinput.hs | 13 ++++++++----- evdev/src/Util.hs | 25 +++++++++++++++++++------ 4 files changed, 34 insertions(+), 43 deletions(-) diff --git a/evdev/src/Evdev.hs b/evdev/src/Evdev.hs index c1ac5f6..1f49227 100644 --- a/evdev/src/Evdev.hs +++ b/evdev/src/Evdev.hs @@ -297,7 +297,7 @@ data AbsInfo = AbsInfo deviceAbsAxis :: Device -> AbsoluteAxis -> IO (Maybe AbsInfo) deviceAbsAxis dev (fromEnum' -> code) = withForeignPtr (cDevice dev) \devPtr -> (unConstPtr <$> Raw.libevdev_get_abs_info (ConstPtr devPtr) (CUInt code)) - >>= LL.handleNull (pure Nothing) \absInfoPtr -> + >>= handleNull (pure Nothing) \absInfoPtr -> peek absInfoPtr <&> \raw -> Just AbsInfo @@ -315,7 +315,7 @@ data LEDValue = LedOn | LedOff -- | Set the state of a LED on a device. setDeviceLED :: Device -> LEDEvent -> LEDValue -> IO () setDeviceLED dev led val = cErrCall "setDeviceLED" dev $ withForeignPtr (cDevice dev) \devPtr -> - Errno <$> Raw.libevdev_kernel_set_led_value devPtr (LL.convertEnum led) case val of + Errno <$> Raw.libevdev_kernel_set_led_value devPtr (fromEnum' led) case val of LedOn -> Raw.LIBEVDEV_LED_ON LedOff -> Raw.LIBEVDEV_LED_OFF diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs index dd1fa3b..d8a5404 100644 --- a/evdev/src/Evdev/LowLevel.hs +++ b/evdev/src/Evdev/LowLevel.hs @@ -1,15 +1,15 @@ module Evdev.LowLevel where import Data.ByteString (ByteString, packCString, useAsCString) -import Data.Int (Int32) import Data.Word (Word16) -import Foreign (ForeignPtr, FunPtr, Ptr, newForeignPtr, nullPtr, withForeignPtr) -import Foreign.C (CString, Errno (Errno)) +import Foreign (ForeignPtr, FunPtr, Ptr, newForeignPtr, withForeignPtr) +import Foreign.C (Errno (Errno)) import Foreign.C.ConstPtr (ConstPtr (..)) import System.Posix.Types (Fd (Fd)) import Evdev.Codes import Evdev.Raw qualified as Raw +import Util -- * Device lifecycle @@ -100,37 +100,12 @@ libevdev_set_id_version dev n = withForeignPtr dev $ \devPtr -> hasProperty :: ForeignPtr Raw.Libevdev -> DeviceProperty -> IO Bool hasProperty dev prop = withForeignPtr dev $ \devPtr -> - (/= 0) <$> Raw.libevdev_has_property (ConstPtr devPtr) (convertEnum prop) + (/= 0) <$> Raw.libevdev_has_property (ConstPtr devPtr) (fromEnum' prop) hasEventType :: ForeignPtr Raw.Libevdev -> EventType -> IO Bool hasEventType dev et = withForeignPtr dev $ \devPtr -> - (/= 0) <$> Raw.libevdev_has_event_type (ConstPtr devPtr) (convertEnum et) + (/= 0) <$> Raw.libevdev_has_event_type (ConstPtr devPtr) (fromEnum' et) hasEventCode :: ForeignPtr Raw.Libevdev -> Word16 -> Word16 -> IO Bool hasEventCode dev t c = withForeignPtr dev $ \devPtr -> (/= 0) <$> Raw.libevdev_has_event_code (ConstPtr devPtr) (fromIntegral t) (fromIntegral c) - --- * Uinput - -getSyspath :: ForeignPtr Raw.Libevdev_uinput -> IO (Maybe ByteString) -getSyspath dev = withForeignPtr dev $ \devPtr -> - Raw.libevdev_uinput_get_syspath devPtr >>= packCString' . unConstPtr - -getDevnode :: ForeignPtr Raw.Libevdev_uinput -> IO (Maybe ByteString) -getDevnode dev = withForeignPtr dev $ \devPtr -> - Raw.libevdev_uinput_get_devnode devPtr >>= packCString' . unConstPtr - -writeEvent :: ForeignPtr Raw.Libevdev_uinput -> Word16 -> Word16 -> Int32 -> IO Errno -writeEvent dev t c v = withForeignPtr dev $ \devPtr -> - Errno <$> Raw.libevdev_uinput_write_event (ConstPtr devPtr) (fromIntegral t) (fromIntegral c) (fromIntegral v) - --- * Util - -convertEnum :: (Enum a, Integral b) => a -> b -convertEnum = fromIntegral . fromEnum - -handleNull :: b -> (Ptr a -> b) -> Ptr a -> b -handleNull def f p = if p == nullPtr then def else f p - -packCString' :: CString -> IO (Maybe ByteString) -packCString' = handleNull (return Nothing) (fmap Just . packCString) diff --git a/evdev/src/Evdev/Uinput.hs b/evdev/src/Evdev/Uinput.hs index 976e4b4..00d3d99 100644 --- a/evdev/src/Evdev/Uinput.hs +++ b/evdev/src/Evdev/Uinput.hs @@ -25,7 +25,6 @@ import Control.Monad import Control.Monad.State import Data.Foldable import Data.Function -import Data.Tuple.Extra import Foreign import Foreign.C import Foreign.C.ConstPtr @@ -150,8 +149,12 @@ defaultDeviceOpts = -- | Write a single event. Doesn't issue a sync event, so: @writeEvent dev e /= writeBatch dev [e]@. writeEvent :: Device -> EventData -> IO () -writeEvent (Device dev) e = do - cErrCall "writeEvent" dev $ uncurry3 (LL.writeEvent dev) $ toCEventData e +writeEvent (Device dev) e = + withForeignPtr dev \devPtr -> cErrCall "writeEvent" (deviceSyspath $ Device dev) $ + Errno <$> Raw.libevdev_uinput_write_event (ConstPtr devPtr) (fromIntegral t) (fromIntegral c) (fromIntegral v) + where + (t, c, v) = toCEventData e + -- | Write several events followed by a 'SynReport'. writeBatch :: Foldable t => Device -> t EventData -> IO () @@ -160,9 +163,9 @@ writeBatch dev es = do writeEvent dev $ SyncEvent SynReport deviceSyspath :: Device -> IO (Maybe ByteString) -deviceSyspath = LL.getSyspath . \(Device d) -> d +deviceSyspath (Device dev) = withForeignPtr dev $ packCString' . unConstPtr <=< Raw.libevdev_uinput_get_syspath deviceDevnode :: Device -> IO (Maybe ByteString) -deviceDevnode = LL.getDevnode . \(Device d) -> d +deviceDevnode (Device dev) = withForeignPtr dev $ packCString' . unConstPtr <=< Raw.libevdev_uinput_get_devnode -- | Make options for a device capable of precisely the events in the list. deviceOptsFromEvents :: diff --git a/evdev/src/Util.hs b/evdev/src/Util.hs index 35ad0d0..ec8b0b3 100644 --- a/evdev/src/Util.hs +++ b/evdev/src/Util.hs @@ -1,16 +1,22 @@ module Util where +import Data.ByteString (ByteString, packCString) import qualified Data.ByteString.Char8 as BS -import Foreign (ForeignPtr) +import Data.Tuple (swap) +import Foreign (Ptr, nullPtr) +import Foreign.C (CString) import Foreign.C.Error (Errno (Errno), errnoToIOError) import System.Posix.ByteString (RawFilePath) -import qualified Evdev.LowLevel as LL -import qualified Evdev.Raw as Raw - fromEnum' :: (Num c, Enum a) => a -> c fromEnum' = fromIntegral . fromEnum +handleNull :: b -> (Ptr a -> b) -> Ptr a -> b +handleNull def f p = if p == nullPtr then def else f p + +packCString' :: CString -> IO (Maybe ByteString) +packCString' = handleNull (return Nothing) (fmap Just . packCString) + --TODO careful - for some C calls (eg. libevdev_enable_event_code), -- int returned doesn't necessarily correspond to a particular error number --TODO this kinda seems like overkill, but things were getting ugly without it... @@ -20,8 +26,12 @@ instance CErrInfo () where cErrInfo () = return Nothing instance CErrInfo RawFilePath where cErrInfo = pure . pure -instance CErrInfo (ForeignPtr Raw.Libevdev_uinput) where - cErrInfo = LL.getSyspath +instance CErrInfo (IO RawFilePath) where + cErrInfo = fmap pure +instance CErrInfo (Maybe RawFilePath) where + cErrInfo = pure +instance CErrInfo (IO (Maybe RawFilePath)) where + cErrInfo = id -- for c actions which return an error value (0 for success) -- run the action, throwing a relevant exception if the C errno is not 0 @@ -40,3 +50,6 @@ instance CErrCall (Errno, a) where Errno n -> do path' <- cErrInfo info ioError $ errnoToIOError func (Errno $ abs n) Nothing $ BS.unpack <$> path' +instance CErrCall (IO a, Errno) where + type CErrCallRes (IO a, Errno) = a + cErrCall func info x = cErrCall @(Errno, a) func info $ sequence =<< swap <$> x From aca489f0f3da5f151f647bcbb74fe608d44b6430 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 18:59:48 +0100 Subject: [PATCH 28/55] inline the rest of LowLevel --- evdev/evdev.cabal | 1 - evdev/src/Evdev.hs | 54 ++++++++++-------- evdev/src/Evdev/LowLevel.hs | 111 ------------------------------------ evdev/src/Evdev/Raw.hs | 4 ++ evdev/src/Evdev/Uinput.hs | 26 ++++----- evdev/src/Util.hs | 20 ++----- 6 files changed, 52 insertions(+), 164 deletions(-) delete mode 100644 evdev/src/Evdev/LowLevel.hs diff --git a/evdev/evdev.cabal b/evdev/evdev.cabal index 1d40597..9c1c4c8 100644 --- a/evdev/evdev.cabal +++ b/evdev/evdev.cabal @@ -51,7 +51,6 @@ library Evdev Evdev.Codes Evdev.Uinput - Evdev.LowLevel Evdev.Raw other-modules: Util diff --git a/evdev/src/Evdev.hs b/evdev/src/Evdev.hs index 1f49227..b0cf0ad 100644 --- a/evdev/src/Evdev.hs +++ b/evdev/src/Evdev.hs @@ -55,8 +55,10 @@ module Evdev ( import Control.Arrow ((&&&)) import Control.Monad (filterM, join) +import Data.ByteString (packCString) import Data.ByteString.Char8 (ByteString, pack) import Data.Coerce (coerce) +import Data.Function ((&)) import Data.Functor ((<&>)) import Data.Int (Int32) import Data.List.Extra (enumerate) @@ -69,15 +71,14 @@ import qualified Data.Set as Set import Data.Time.Clock (DiffTime) import Data.Tuple.Extra (uncurry3) import Data.Word (Word16) -import Foreign (alloca, (.|.), peek, ForeignPtr, withForeignPtr) +import Foreign (alloca, (.|.), peek, ForeignPtr, withForeignPtr, newForeignPtr) import Foreign.C (CInt (CInt), CUInt (CUInt), CUShort (CUShort), Errno (Errno), eAGAIN, eOK) -import Foreign.C.ConstPtr (ConstPtr (ConstPtr), unConstPtr) +import Foreign.C.ConstPtr (ConstPtr (..)) import System.Posix.Process (getProcessID) import System.Posix.Files (readSymbolicLink) -import System.Posix.ByteString (Fd, RawFilePath) +import System.Posix.ByteString (Fd (Fd), RawFilePath) import System.Posix.IO.ByteString (OpenMode (..), defaultFileFlags, openFd) -import qualified Evdev.LowLevel as LL import qualified Evdev.Raw as Raw import Evdev.Codes import Util @@ -160,7 +161,7 @@ ungrabDevice = grabDevice' Raw.LIBEVDEV_UNGRAB -- | Get the next event from the device. nextEvent :: Device -> IO Event nextEvent dev = - cErrCall "nextEvent" dev $ withForeignPtr (cDevice dev) \devPtr -> alloca \evPtr -> + cErrCallDev "nextEvent" dev $ withForeignPtr (cDevice dev) \devPtr -> alloca \evPtr -> (,) <$> (Errno <$> Raw.libevdev_next_event devPtr (convertFlags defaultReadFlags) evPtr) <*> (fromCEvent <$> peek evPtr) @@ -170,7 +171,7 @@ Designed for use with devices created from a non-blocking file descriptor. Other -} nextEventMay :: Device -> IO (Maybe Event) nextEventMay dev = - cErrCall "nextEventMay" dev $ withForeignPtr (cDevice dev) \devPtr -> alloca \evPtr -> do + cErrCallDev "nextEventMay" dev $ withForeignPtr (cDevice dev) \devPtr -> alloca \evPtr -> do err <- Raw.libevdev_next_event devPtr (convertFlags nonBlockingReadFlags) evPtr if Errno err /= eOK then @@ -246,7 +247,10 @@ __WARNING__: Don't attempt to reuse the 'Fd' - it will be closed when the 'Devic -} newDeviceFromFd :: Fd -> IO Device newDeviceFromFd fd = do - dev <- cErrCall "newDeviceFromFd" () $ LL.newDeviceFromFd fd + dev <- cErrCall "newDeviceFromFd" mempty do + dev <- newForeignPtr Raw.finalizer_libevdev_hs_close =<< Raw.libevdev_new + err <- withForeignPtr dev $ fmap Errno . flip Raw.libevdev_set_fd (coerce fd) + pure (err, dev) pid <- getProcessID path <- readSymbolicLink $ "/proc/" <> show pid <> "/fd/" <> show fd return $ Device{cDevice = dev, devicePath = pack path} @@ -256,33 +260,37 @@ evdevDir :: RawFilePath evdevDir = "/dev/input" deviceName :: Device -> IO ByteString -deviceName = join . LL.deviceName . cDevice +deviceName = join . flip withForeignPtr (fmap (packCString . unConstPtr) . Raw.libevdev_get_name . ConstPtr) . cDevice deviceFd :: Device -> IO Fd -deviceFd = LL.deviceFd . cDevice +deviceFd = flip withForeignPtr (fmap Fd . Raw.libevdev_get_fd . ConstPtr) . cDevice devicePhys :: Device -> IO (Maybe ByteString) -devicePhys = join . LL.devicePhys . cDevice +devicePhys = join . flip withForeignPtr (fmap (packCString' . unConstPtr) . Raw.libevdev_get_phys . ConstPtr) . cDevice deviceUniq :: Device -> IO (Maybe ByteString) -deviceUniq = join . LL.deviceUniq . cDevice +deviceUniq = join . flip withForeignPtr (fmap (packCString' . unConstPtr) . Raw.libevdev_get_uniq . ConstPtr) . cDevice deviceProduct :: Device -> IO Int -deviceProduct = LL.deviceProduct . cDevice +deviceProduct = flip withForeignPtr (fmap fromIntegral . Raw.libevdev_get_id_product . ConstPtr) . cDevice deviceVendor :: Device -> IO Int -deviceVendor = LL.deviceVendor . cDevice +deviceVendor = flip withForeignPtr (fmap fromIntegral . Raw.libevdev_get_id_vendor . ConstPtr) . cDevice deviceBustype :: Device -> IO Int -deviceBustype = LL.deviceBustype . cDevice +deviceBustype = flip withForeignPtr (fmap fromIntegral . Raw.libevdev_get_id_bustype . ConstPtr) . cDevice deviceVersion :: Device -> IO Int -deviceVersion = LL.deviceVersion . cDevice +deviceVersion = flip withForeignPtr (fmap fromIntegral . Raw.libevdev_get_id_version . ConstPtr) . cDevice deviceProperties :: Device -> IO [DeviceProperty] -deviceProperties dev = filterM (LL.hasProperty $ cDevice dev) enumerate +deviceProperties (Device dev _) = enumerate & filterM \prop -> withForeignPtr dev \p -> + toBool <$> Raw.libevdev_has_property (ConstPtr p) (fromEnum' prop) deviceEventTypes :: Device -> IO [EventType] -deviceEventTypes dev = filterM (LL.hasEventType $ cDevice dev) enumerate +deviceEventTypes (Device dev _) = enumerate & filterM \et -> withForeignPtr dev \p -> + toBool <$> Raw.libevdev_has_event_type (ConstPtr p) (fromEnum' et) --TODO this is an imperfect API since '_val' is ignored entirely deviceHasEvent :: Device -> EventData -> IO Bool -deviceHasEvent dev e = LL.hasEventCode (cDevice dev) typ code - where (typ,code,_val) = toCEventData e +deviceHasEvent (Device dev _) e = withForeignPtr dev \p -> + toBool <$> Raw.libevdev_has_event_code (ConstPtr p) (fromIntegral t) (fromIntegral c) + where + (t, c, _v) = toCEventData e data AbsInfo = AbsInfo { absValue :: Int32 @@ -314,7 +322,7 @@ data LEDValue = LedOn | LedOff -- | Set the state of a LED on a device. setDeviceLED :: Device -> LEDEvent -> LEDValue -> IO () -setDeviceLED dev led val = cErrCall "setDeviceLED" dev $ withForeignPtr (cDevice dev) \devPtr -> +setDeviceLED dev led val = cErrCallDev "setDeviceLED" dev $ withForeignPtr (cDevice dev) \devPtr -> Errno <$> Raw.libevdev_kernel_set_led_value devPtr (fromEnum' led) case val of LedOn -> Raw.LIBEVDEV_LED_ON LedOff -> Raw.LIBEVDEV_LED_OFF @@ -322,7 +330,7 @@ setDeviceLED dev led val = cErrCall "setDeviceLED" dev $ withForeignPtr (cDevice {- Util -} grabDevice' :: Raw.Libevdev_grab_mode -> Device -> IO () -grabDevice' mode dev = cErrCall "grabDevice" dev $ +grabDevice' mode dev = cErrCallDev "grabDevice" dev $ withForeignPtr (cDevice dev) $ fmap Errno . flip Raw.libevdev_grab mode {- @@ -347,5 +355,5 @@ toEnum' = (enumMap !?) enumMap :: Map k a enumMap = Map.fromList $ map (toEnum . fromEnum &&& id) enumerate -instance CErrInfo Device where - cErrInfo = return . Just . devicePath +cErrCallDev :: CErrCall a => String -> Device -> IO a -> IO (CErrCallRes a) +cErrCallDev f = cErrCall f . return . Just . devicePath diff --git a/evdev/src/Evdev/LowLevel.hs b/evdev/src/Evdev/LowLevel.hs deleted file mode 100644 index d8a5404..0000000 --- a/evdev/src/Evdev/LowLevel.hs +++ /dev/null @@ -1,111 +0,0 @@ -module Evdev.LowLevel where - -import Data.ByteString (ByteString, packCString, useAsCString) -import Data.Word (Word16) -import Foreign (ForeignPtr, FunPtr, Ptr, newForeignPtr, withForeignPtr) -import Foreign.C (Errno (Errno)) -import Foreign.C.ConstPtr (ConstPtr (..)) -import System.Posix.Types (Fd (Fd)) - -import Evdev.Codes -import Evdev.Raw qualified as Raw -import Util - --- * Device lifecycle - -foreign import ccall "&libevdev_hs_close" finalizer_libevdev_hs_close :: FunPtr (Ptr Raw.Libevdev -> IO ()) -foreign import ccall "&libevdev_uinput_destroy" finalizer_libevdev_uinput_destroy :: FunPtr (Ptr Raw.Libevdev_uinput -> IO ()) - -libevdev_new :: IO (ForeignPtr Raw.Libevdev) -libevdev_new = newForeignPtr finalizer_libevdev_hs_close =<< Raw.libevdev_new - -libevdev_set_fd :: ForeignPtr Raw.Libevdev -> Fd -> IO Errno -libevdev_set_fd dev (Fd fd) = withForeignPtr dev $ \devPtr -> - Errno <$> Raw.libevdev_set_fd devPtr fd - -newDeviceFromFd :: Fd -> IO (Errno, ForeignPtr Raw.Libevdev) -newDeviceFromFd fd = do - dev <- libevdev_new - err <- libevdev_set_fd dev fd - pure (err, dev) - --- * Device properties (getters) - -deviceFd :: ForeignPtr Raw.Libevdev -> IO Fd -deviceFd dev = withForeignPtr dev $ \devPtr -> - Fd <$> Raw.libevdev_get_fd (ConstPtr devPtr) - -deviceName :: ForeignPtr Raw.Libevdev -> IO (IO ByteString) -deviceName dev = withForeignPtr dev $ \devPtr -> do - cstr <- Raw.libevdev_get_name (ConstPtr devPtr) - pure $ packCString (unConstPtr cstr) - -devicePhys :: ForeignPtr Raw.Libevdev -> IO (IO (Maybe ByteString)) -devicePhys dev = withForeignPtr dev $ \devPtr -> do - cstr <- Raw.libevdev_get_phys (ConstPtr devPtr) - pure $ packCString' (unConstPtr cstr) - -deviceUniq :: ForeignPtr Raw.Libevdev -> IO (IO (Maybe ByteString)) -deviceUniq dev = withForeignPtr dev $ \devPtr -> do - cstr <- Raw.libevdev_get_uniq (ConstPtr devPtr) - pure $ packCString' (unConstPtr cstr) - -deviceProduct :: ForeignPtr Raw.Libevdev -> IO Int -deviceProduct dev = withForeignPtr dev $ \devPtr -> - fromIntegral <$> Raw.libevdev_get_id_product (ConstPtr devPtr) - -deviceVendor :: ForeignPtr Raw.Libevdev -> IO Int -deviceVendor dev = withForeignPtr dev $ \devPtr -> - fromIntegral <$> Raw.libevdev_get_id_vendor (ConstPtr devPtr) - -deviceBustype :: ForeignPtr Raw.Libevdev -> IO Int -deviceBustype dev = withForeignPtr dev $ \devPtr -> - fromIntegral <$> Raw.libevdev_get_id_bustype (ConstPtr devPtr) - -deviceVersion :: ForeignPtr Raw.Libevdev -> IO Int -deviceVersion dev = withForeignPtr dev $ \devPtr -> - fromIntegral <$> Raw.libevdev_get_id_version (ConstPtr devPtr) - --- * Device properties (setters) - -setDeviceName :: ForeignPtr Raw.Libevdev -> ByteString -> IO () -setDeviceName dev name = withForeignPtr dev $ \devPtr -> - useAsCString name $ \cstr -> Raw.libevdev_set_name devPtr (ConstPtr cstr) - -setDevicePhys :: ForeignPtr Raw.Libevdev -> ByteString -> IO () -setDevicePhys dev phys = withForeignPtr dev $ \devPtr -> - useAsCString phys $ \cstr -> Raw.libevdev_set_phys devPtr (ConstPtr cstr) - -setDeviceUniq :: ForeignPtr Raw.Libevdev -> ByteString -> IO () -setDeviceUniq dev uniq = withForeignPtr dev $ \devPtr -> - useAsCString uniq $ \cstr -> Raw.libevdev_set_uniq devPtr (ConstPtr cstr) - -libevdev_set_id_product :: ForeignPtr Raw.Libevdev -> Int -> IO () -libevdev_set_id_product dev n = withForeignPtr dev $ \devPtr -> - Raw.libevdev_set_id_product devPtr (fromIntegral n) - -libevdev_set_id_vendor :: ForeignPtr Raw.Libevdev -> Int -> IO () -libevdev_set_id_vendor dev n = withForeignPtr dev $ \devPtr -> - Raw.libevdev_set_id_vendor devPtr (fromIntegral n) - -libevdev_set_id_bustype :: ForeignPtr Raw.Libevdev -> Int -> IO () -libevdev_set_id_bustype dev n = withForeignPtr dev $ \devPtr -> - Raw.libevdev_set_id_bustype devPtr (fromIntegral n) - -libevdev_set_id_version :: ForeignPtr Raw.Libevdev -> Int -> IO () -libevdev_set_id_version dev n = withForeignPtr dev $ \devPtr -> - Raw.libevdev_set_id_version devPtr (fromIntegral n) - --- * Capability queries - -hasProperty :: ForeignPtr Raw.Libevdev -> DeviceProperty -> IO Bool -hasProperty dev prop = withForeignPtr dev $ \devPtr -> - (/= 0) <$> Raw.libevdev_has_property (ConstPtr devPtr) (fromEnum' prop) - -hasEventType :: ForeignPtr Raw.Libevdev -> EventType -> IO Bool -hasEventType dev et = withForeignPtr dev $ \devPtr -> - (/= 0) <$> Raw.libevdev_has_event_type (ConstPtr devPtr) (fromEnum' et) - -hasEventCode :: ForeignPtr Raw.Libevdev -> Word16 -> Word16 -> IO Bool -hasEventCode dev t c = withForeignPtr dev $ \devPtr -> - (/= 0) <$> Raw.libevdev_has_event_code (ConstPtr devPtr) (fromIntegral t) (fromIntegral c) diff --git a/evdev/src/Evdev/Raw.hs b/evdev/src/Evdev/Raw.hs index 428726c..72f29d8 100644 --- a/evdev/src/Evdev/Raw.hs +++ b/evdev/src/Evdev/Raw.hs @@ -11,6 +11,7 @@ module Evdev.Raw where +import Foreign import HsBindgen.Runtime.LibC qualified import HsBindgen.TH @@ -31,3 +32,6 @@ do do hashInclude "libevdev/libevdev.h" hashInclude "libevdev/libevdev-uinput.h" + +foreign import ccall "&libevdev_hs_close" finalizer_libevdev_hs_close :: FunPtr (Ptr Libevdev -> IO ()) +foreign import ccall "&libevdev_uinput_destroy" finalizer_libevdev_uinput_destroy :: FunPtr (Ptr Libevdev_uinput -> IO ()) diff --git a/evdev/src/Evdev/Uinput.hs b/evdev/src/Evdev/Uinput.hs index 00d3d99..4a25e17 100644 --- a/evdev/src/Evdev/Uinput.hs +++ b/evdev/src/Evdev/Uinput.hs @@ -29,12 +29,12 @@ import Foreign import Foreign.C import Foreign.C.ConstPtr +import Data.ByteString (useAsCString) import Data.ByteString.Char8 (ByteString) import Data.Coerce (coerce) import Evdev hiding (Device, newDevice) import Evdev.Codes -import qualified Evdev.LowLevel as LL import qualified Evdev.Raw as Raw import Util @@ -48,17 +48,15 @@ newDevice :: DeviceOpts -> IO Device newDevice name DeviceOpts{..} = do - dev <- LL.libevdev_new - LL.setDeviceName dev name - - let maybeSet :: (ForeignPtr Raw.Libevdev -> a -> IO ()) -> Maybe a -> IO () - maybeSet = maybe mempty . ($ dev) - maybeSet LL.setDevicePhys phys - maybeSet LL.setDeviceUniq uniq - maybeSet LL.libevdev_set_id_product idProduct - maybeSet LL.libevdev_set_id_vendor idVendor - maybeSet LL.libevdev_set_id_bustype idBustype - maybeSet LL.libevdev_set_id_version idVersion + dev <- newForeignPtr Raw.finalizer_libevdev_hs_close =<< Raw.libevdev_new + withForeignPtr dev \p -> useAsCString name $ Raw.libevdev_set_name p . ConstPtr + + for_ phys \x -> withForeignPtr dev \p -> useAsCString x $ Raw.libevdev_set_phys p . ConstPtr + for_ uniq \x -> withForeignPtr dev \p -> useAsCString x $ Raw.libevdev_set_uniq p . ConstPtr + for_ idProduct \x -> withForeignPtr dev \p -> Raw.libevdev_set_id_product p $ fromIntegral x + for_ idVendor \x -> withForeignPtr dev \p -> Raw.libevdev_set_id_vendor p $ fromIntegral x + for_ idBustype \x -> withForeignPtr dev \p -> Raw.libevdev_set_id_bustype p $ fromIntegral x + for_ idVersion \x -> withForeignPtr dev \p -> Raw.libevdev_set_id_version p $ fromIntegral x let enable (dataPtr :: Maybe (Either (Ptr Raw.Input_absinfo) (Ptr Int))) t cs = do unless (null cs) $ cec $ withForeignPtr dev \devPtr -> @@ -101,10 +99,10 @@ newDevice name DeviceOpts{..} = do (ConstPtr devPtr) (coerce (Raw.LIBEVDEV_UINPUT_OPEN_MANAGED).unwrap) pp - fmap Device . newForeignPtr LL.finalizer_libevdev_uinput_destroy =<< peek pp + fmap Device . newForeignPtr Raw.finalizer_libevdev_uinput_destroy =<< peek pp where cec :: CErrCall a => IO a -> IO (CErrCallRes a) - cec = cErrCall "newDevice" () + cec = cErrCall "newDevice" mempty data DeviceOpts = DeviceOpts { phys :: Maybe ByteString diff --git a/evdev/src/Util.hs b/evdev/src/Util.hs index ec8b0b3..a7b80e8 100644 --- a/evdev/src/Util.hs +++ b/evdev/src/Util.hs @@ -17,27 +17,17 @@ handleNull def f p = if p == nullPtr then def else f p packCString' :: CString -> IO (Maybe ByteString) packCString' = handleNull (return Nothing) (fmap Just . packCString) +toBool :: (Eq a, Num a) => a -> Bool +toBool = (/= 0) + --TODO careful - for some C calls (eg. libevdev_enable_event_code), -- int returned doesn't necessarily correspond to a particular error number --TODO this kinda seems like overkill, but things were getting ugly without it... -class CErrInfo a where - cErrInfo :: a -> IO (Maybe RawFilePath) -instance CErrInfo () where - cErrInfo () = return Nothing -instance CErrInfo RawFilePath where - cErrInfo = pure . pure -instance CErrInfo (IO RawFilePath) where - cErrInfo = fmap pure -instance CErrInfo (Maybe RawFilePath) where - cErrInfo = pure -instance CErrInfo (IO (Maybe RawFilePath)) where - cErrInfo = id - -- for c actions which return an error value (0 for success) -- run the action, throwing a relevant exception if the C errno is not 0 class CErrCall a where type CErrCallRes a - cErrCall :: CErrInfo info => String -> info -> IO a -> IO (CErrCallRes a) + cErrCall :: String -> IO (Maybe RawFilePath) -> IO a -> IO (CErrCallRes a) instance CErrCall Errno where type CErrCallRes Errno = () cErrCall func path x = cErrCall func path $ (,()) <$> x @@ -48,7 +38,7 @@ instance CErrCall (Errno, a) where case errno of Errno 0 -> return res Errno n -> do - path' <- cErrInfo info + path' <- info ioError $ errnoToIOError func (Errno $ abs n) Nothing $ BS.unpack <$> path' instance CErrCall (IO a, Errno) where type CErrCallRes (IO a, Errno) = a From 2cb4e9583ef4ebde9e7ec28c82483795ea48fdf6 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 20:39:31 +0100 Subject: [PATCH 29/55] rename local foreign import --- evdev/src/Evdev.hs | 2 +- evdev/src/Evdev/Raw.hs | 2 +- evdev/src/Evdev/Uinput.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/evdev/src/Evdev.hs b/evdev/src/Evdev.hs index b0cf0ad..c27810c 100644 --- a/evdev/src/Evdev.hs +++ b/evdev/src/Evdev.hs @@ -248,7 +248,7 @@ __WARNING__: Don't attempt to reuse the 'Fd' - it will be closed when the 'Devic newDeviceFromFd :: Fd -> IO Device newDeviceFromFd fd = do dev <- cErrCall "newDeviceFromFd" mempty do - dev <- newForeignPtr Raw.finalizer_libevdev_hs_close =<< Raw.libevdev_new + dev <- newForeignPtr Raw.libevdev_hs_close =<< Raw.libevdev_new err <- withForeignPtr dev $ fmap Errno . flip Raw.libevdev_set_fd (coerce fd) pure (err, dev) pid <- getProcessID diff --git a/evdev/src/Evdev/Raw.hs b/evdev/src/Evdev/Raw.hs index 72f29d8..5c4c3e6 100644 --- a/evdev/src/Evdev/Raw.hs +++ b/evdev/src/Evdev/Raw.hs @@ -33,5 +33,5 @@ do hashInclude "libevdev/libevdev.h" hashInclude "libevdev/libevdev-uinput.h" -foreign import ccall "&libevdev_hs_close" finalizer_libevdev_hs_close :: FunPtr (Ptr Libevdev -> IO ()) +foreign import ccall "&libevdev_hs_close" libevdev_hs_close :: FunPtr (Ptr Libevdev -> IO ()) foreign import ccall "&libevdev_uinput_destroy" finalizer_libevdev_uinput_destroy :: FunPtr (Ptr Libevdev_uinput -> IO ()) diff --git a/evdev/src/Evdev/Uinput.hs b/evdev/src/Evdev/Uinput.hs index 4a25e17..23aa162 100644 --- a/evdev/src/Evdev/Uinput.hs +++ b/evdev/src/Evdev/Uinput.hs @@ -48,7 +48,7 @@ newDevice :: DeviceOpts -> IO Device newDevice name DeviceOpts{..} = do - dev <- newForeignPtr Raw.finalizer_libevdev_hs_close =<< Raw.libevdev_new + dev <- newForeignPtr Raw.libevdev_hs_close =<< Raw.libevdev_new withForeignPtr dev \p -> useAsCString name $ Raw.libevdev_set_name p . ConstPtr for_ phys \x -> withForeignPtr dev \p -> useAsCString x $ Raw.libevdev_set_phys p . ConstPtr From ea6577a93d8bc1d5f83589f3687936d8125c1d11 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 20:40:42 +0100 Subject: [PATCH 30/55] use type synonym --- evdev/src/Evdev/Raw.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/evdev/src/Evdev/Raw.hs b/evdev/src/Evdev/Raw.hs index 5c4c3e6..a61e8d5 100644 --- a/evdev/src/Evdev/Raw.hs +++ b/evdev/src/Evdev/Raw.hs @@ -33,5 +33,5 @@ do hashInclude "libevdev/libevdev.h" hashInclude "libevdev/libevdev-uinput.h" -foreign import ccall "&libevdev_hs_close" libevdev_hs_close :: FunPtr (Ptr Libevdev -> IO ()) +foreign import ccall "&libevdev_hs_close" libevdev_hs_close :: FinalizerPtr Libevdev foreign import ccall "&libevdev_uinput_destroy" finalizer_libevdev_uinput_destroy :: FunPtr (Ptr Libevdev_uinput -> IO ()) From c461c2f960c22cabde9599824e1f4fea1e6b691c Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 21:01:17 +0100 Subject: [PATCH 31/55] rename foreign import --- evdev/src/Evdev/Raw.hs | 2 +- evdev/src/Evdev/Uinput.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/evdev/src/Evdev/Raw.hs b/evdev/src/Evdev/Raw.hs index a61e8d5..37aa0f6 100644 --- a/evdev/src/Evdev/Raw.hs +++ b/evdev/src/Evdev/Raw.hs @@ -34,4 +34,4 @@ do hashInclude "libevdev/libevdev-uinput.h" foreign import ccall "&libevdev_hs_close" libevdev_hs_close :: FinalizerPtr Libevdev -foreign import ccall "&libevdev_uinput_destroy" finalizer_libevdev_uinput_destroy :: FunPtr (Ptr Libevdev_uinput -> IO ()) +foreign import ccall "&libevdev_uinput_destroy" libevdev_uinput_destroy_funptr :: FunPtr (Ptr Libevdev_uinput -> IO ()) diff --git a/evdev/src/Evdev/Uinput.hs b/evdev/src/Evdev/Uinput.hs index 23aa162..ee546e4 100644 --- a/evdev/src/Evdev/Uinput.hs +++ b/evdev/src/Evdev/Uinput.hs @@ -99,7 +99,7 @@ newDevice name DeviceOpts{..} = do (ConstPtr devPtr) (coerce (Raw.LIBEVDEV_UINPUT_OPEN_MANAGED).unwrap) pp - fmap Device . newForeignPtr Raw.finalizer_libevdev_uinput_destroy =<< peek pp + fmap Device . newForeignPtr Raw.libevdev_uinput_destroy_funptr =<< peek pp where cec :: CErrCall a => IO a -> IO (CErrCallRes a) cec = cErrCall "newDevice" mempty From f2671b2576a0d6bfa3e9aa410fee8e7a1c693b2e Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 21:43:30 +0100 Subject: [PATCH 32/55] restore exact c2hs codes output --- evdev/src/Evdev/Codes.hs | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) diff --git a/evdev/src/Evdev/Codes.hs b/evdev/src/Evdev/Codes.hs index a0c0bc9..6a0f3c6 100644 --- a/evdev/src/Evdev/Codes.hs +++ b/evdev/src/Evdev/Codes.hs @@ -1,4 +1,16 @@ -{-# LANGUAGE PatternSynonyms #-} +-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell) +-- Edit the ORIGNAL .chs file instead! + + +{-# LINE 1 "evdev/src/Evdev/Codes.chs" #-} +{- +TODO haddock doesn't quite work correctly with LINE pragmas + https://github.com/haskell/haddock/issues/441 + for now we can work around this by deleting the pragmas before upload to hackage + +seems to be on its way to being fixed with `.hie` files (enable `-fwrite-ide-info`) + https://github.com/haskell/haddock/commit/8bc3c2990475a254e168fbdb005af93f9397b19c +-} -- | 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. @@ -116,6 +128,7 @@ instance Enum EventType where toEnum 23 = EvFfStatus toEnum unmatched = error ("EventType.toEnum: Cannot match " ++ show unmatched) +{-# LINE 60 "evdev/src/Evdev/Codes.chs" #-} -- | Synchronization events @@ -156,6 +169,7 @@ instance Enum SyncEvent where toEnum 3 = SynDropped toEnum unmatched = error ("SyncEvent.toEnum: Cannot match " ++ show unmatched) +{-# LINE 68 "evdev/src/Evdev/Codes.chs" #-} -- | Keys and buttons @@ -2791,6 +2805,7 @@ instance Enum Key where toEnum 743 = BtnTriggerHappy40 toEnum unmatched = error ("Key.toEnum: Cannot match " ++ show unmatched) +{-# LINE 612 "evdev/src/Evdev/Codes.chs" #-} pattern KeyHanguel :: Key @@ -2927,6 +2942,7 @@ instance Enum RelativeAxis where toEnum 12 = RelHWheelHiRes toEnum unmatched = error ("RelativeAxis.toEnum: Cannot match " ++ show unmatched) +{-# LINE 696 "evdev/src/Evdev/Codes.chs" #-} -- | Absolute changes @@ -3157,6 +3173,7 @@ instance Enum AbsoluteAxis where toEnum 61 = AbsMtToolY toEnum unmatched = error ("AbsoluteAxis.toEnum: Cannot match " ++ show unmatched) +{-# LINE 742 "evdev/src/Evdev/Codes.chs" #-} -- | Stateful binary switches @@ -3256,6 +3273,7 @@ instance Enum SwitchEvent where toEnum 14 = SwMuteDevice toEnum unmatched = error ("SwitchEvent.toEnum: Cannot match " ++ show unmatched) +{-# LINE 762 "evdev/src/Evdev/Codes.chs" #-} -- | Miscellaneous @@ -3306,6 +3324,7 @@ instance Enum MiscEvent where toEnum 5 = MscTimestamp toEnum unmatched = error ("MiscEvent.toEnum: Cannot match " ++ show unmatched) +{-# LINE 772 "evdev/src/Evdev/Codes.chs" #-} -- | LEDs @@ -3381,6 +3400,7 @@ instance Enum LEDEvent where toEnum 10 = LedCharging toEnum unmatched = error ("LEDEvent.toEnum: Cannot match " ++ show unmatched) +{-# LINE 787 "evdev/src/Evdev/Codes.chs" #-} -- | Specifying autorepeating events @@ -3411,6 +3431,7 @@ instance Enum RepeatEvent where toEnum 1 = RepPeriod toEnum unmatched = error ("RepeatEvent.toEnum: Cannot match " ++ show unmatched) +{-# LINE 793 "evdev/src/Evdev/Codes.chs" #-} -- | For simple sound output devices @@ -3446,6 +3467,7 @@ instance Enum SoundEvent where toEnum 2 = SndTone toEnum unmatched = error ("SoundEvent.toEnum: Cannot match " ++ show unmatched) +{-# LINE 800 "evdev/src/Evdev/Codes.chs" #-} -- | Device properties @@ -3501,4 +3523,5 @@ instance Enum DeviceProperty where toEnum 6 = InputPropAccelerometer toEnum unmatched = error ("DeviceProperty.toEnum: Cannot match " ++ show unmatched) +{-# LINE 811 "evdev/src/Evdev/Codes.chs" #-} From 2742037f5ab518940a040c71b44f39d927841848 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 21:43:43 +0100 Subject: [PATCH 33/55] Revert "restore exact c2hs codes output" This reverts commit f2671b2576a0d6bfa3e9aa410fee8e7a1c693b2e. --- evdev/src/Evdev/Codes.hs | 25 +------------------------ 1 file changed, 1 insertion(+), 24 deletions(-) diff --git a/evdev/src/Evdev/Codes.hs b/evdev/src/Evdev/Codes.hs index 6a0f3c6..a0c0bc9 100644 --- a/evdev/src/Evdev/Codes.hs +++ b/evdev/src/Evdev/Codes.hs @@ -1,16 +1,4 @@ --- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell) --- Edit the ORIGNAL .chs file instead! - - -{-# LINE 1 "evdev/src/Evdev/Codes.chs" #-} -{- -TODO haddock doesn't quite work correctly with LINE pragmas - https://github.com/haskell/haddock/issues/441 - for now we can work around this by deleting the pragmas before upload to hackage - -seems to be on its way to being fixed with `.hie` files (enable `-fwrite-ide-info`) - https://github.com/haskell/haddock/commit/8bc3c2990475a254e168fbdb005af93f9397b19c --} +{-# LANGUAGE PatternSynonyms #-} -- | 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. @@ -128,7 +116,6 @@ instance Enum EventType where toEnum 23 = EvFfStatus toEnum unmatched = error ("EventType.toEnum: Cannot match " ++ show unmatched) -{-# LINE 60 "evdev/src/Evdev/Codes.chs" #-} -- | Synchronization events @@ -169,7 +156,6 @@ instance Enum SyncEvent where toEnum 3 = SynDropped toEnum unmatched = error ("SyncEvent.toEnum: Cannot match " ++ show unmatched) -{-# LINE 68 "evdev/src/Evdev/Codes.chs" #-} -- | Keys and buttons @@ -2805,7 +2791,6 @@ instance Enum Key where toEnum 743 = BtnTriggerHappy40 toEnum unmatched = error ("Key.toEnum: Cannot match " ++ show unmatched) -{-# LINE 612 "evdev/src/Evdev/Codes.chs" #-} pattern KeyHanguel :: Key @@ -2942,7 +2927,6 @@ instance Enum RelativeAxis where toEnum 12 = RelHWheelHiRes toEnum unmatched = error ("RelativeAxis.toEnum: Cannot match " ++ show unmatched) -{-# LINE 696 "evdev/src/Evdev/Codes.chs" #-} -- | Absolute changes @@ -3173,7 +3157,6 @@ instance Enum AbsoluteAxis where toEnum 61 = AbsMtToolY toEnum unmatched = error ("AbsoluteAxis.toEnum: Cannot match " ++ show unmatched) -{-# LINE 742 "evdev/src/Evdev/Codes.chs" #-} -- | Stateful binary switches @@ -3273,7 +3256,6 @@ instance Enum SwitchEvent where toEnum 14 = SwMuteDevice toEnum unmatched = error ("SwitchEvent.toEnum: Cannot match " ++ show unmatched) -{-# LINE 762 "evdev/src/Evdev/Codes.chs" #-} -- | Miscellaneous @@ -3324,7 +3306,6 @@ instance Enum MiscEvent where toEnum 5 = MscTimestamp toEnum unmatched = error ("MiscEvent.toEnum: Cannot match " ++ show unmatched) -{-# LINE 772 "evdev/src/Evdev/Codes.chs" #-} -- | LEDs @@ -3400,7 +3381,6 @@ instance Enum LEDEvent where toEnum 10 = LedCharging toEnum unmatched = error ("LEDEvent.toEnum: Cannot match " ++ show unmatched) -{-# LINE 787 "evdev/src/Evdev/Codes.chs" #-} -- | Specifying autorepeating events @@ -3431,7 +3411,6 @@ instance Enum RepeatEvent where toEnum 1 = RepPeriod toEnum unmatched = error ("RepeatEvent.toEnum: Cannot match " ++ show unmatched) -{-# LINE 793 "evdev/src/Evdev/Codes.chs" #-} -- | For simple sound output devices @@ -3467,7 +3446,6 @@ instance Enum SoundEvent where toEnum 2 = SndTone toEnum unmatched = error ("SoundEvent.toEnum: Cannot match " ++ show unmatched) -{-# LINE 800 "evdev/src/Evdev/Codes.chs" #-} -- | Device properties @@ -3523,5 +3501,4 @@ instance Enum DeviceProperty where toEnum 6 = InputPropAccelerometer toEnum unmatched = error ("DeviceProperty.toEnum: Cannot match " ++ show unmatched) -{-# LINE 811 "evdev/src/Evdev/Codes.chs" #-} From bf86b3cde021daeb376a11a6809c76881fa0668e Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 22:03:44 +0100 Subject: [PATCH 34/55] use type synonym --- evdev/src/Evdev/Raw.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/evdev/src/Evdev/Raw.hs b/evdev/src/Evdev/Raw.hs index 37aa0f6..a27f072 100644 --- a/evdev/src/Evdev/Raw.hs +++ b/evdev/src/Evdev/Raw.hs @@ -34,4 +34,4 @@ do hashInclude "libevdev/libevdev-uinput.h" foreign import ccall "&libevdev_hs_close" libevdev_hs_close :: FinalizerPtr Libevdev -foreign import ccall "&libevdev_uinput_destroy" libevdev_uinput_destroy_funptr :: FunPtr (Ptr Libevdev_uinput -> IO ()) +foreign import ccall "&libevdev_uinput_destroy" libevdev_uinput_destroy_funptr :: FinalizerPtr Libevdev_uinput From 299cd2b60731c5fe6d9d2a1c589683249c652eeb Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 23:14:24 +0100 Subject: [PATCH 35/55] fix EvRep pointer type --- evdev/src/Evdev/Uinput.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/evdev/src/Evdev/Uinput.hs b/evdev/src/Evdev/Uinput.hs index ee546e4..bcc2249 100644 --- a/evdev/src/Evdev/Uinput.hs +++ b/evdev/src/Evdev/Uinput.hs @@ -58,7 +58,7 @@ newDevice name DeviceOpts{..} = do for_ idBustype \x -> withForeignPtr dev \p -> Raw.libevdev_set_id_bustype p $ fromIntegral x for_ idVersion \x -> withForeignPtr dev \p -> Raw.libevdev_set_id_version p $ fromIntegral x - let enable (dataPtr :: Maybe (Either (Ptr Raw.Input_absinfo) (Ptr Int))) t cs = do + let enable (dataPtr :: Maybe (Either (Ptr Raw.Input_absinfo) (Ptr CInt))) t cs = do unless (null cs) $ cec $ withForeignPtr dev \devPtr -> Errno <$> Raw.libevdev_enable_event_type devPtr t' forM_ cs $ \c -> cec $ withForeignPtr dev \devPtr -> @@ -80,7 +80,7 @@ newDevice name DeviceOpts{..} = do , (EvFfStatus, map fromEnum' ffStats) ] - forM_ reps \(rep, n) -> with n \p -> + forM_ reps \(rep, n) -> with (fromIntegral n) \p -> enable (Just $ Right p) EvRep [fromEnum' rep] forM_ absAxes \(axis, AbsInfo{..}) -> From 331575716925e8801097a077c830489f1d78d37a Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 23:26:41 +0100 Subject: [PATCH 36/55] more temporary exposition --- evdev/evdev.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/evdev/evdev.cabal b/evdev/evdev.cabal index 9c1c4c8..b84437f 100644 --- a/evdev/evdev.cabal +++ b/evdev/evdev.cabal @@ -52,8 +52,8 @@ library Evdev.Codes Evdev.Uinput Evdev.Raw - other-modules: Util + other-modules: hs-source-dirs: src c-sources: src-c/evdev-hs.c From 3aba5a7477b12aedbedd6e3f56d350f93d2c9a02 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 31 Mar 2026 23:52:36 +0100 Subject: [PATCH 37/55] add sanity check for key list length --- evdev/test/Test.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/evdev/test/Test.hs b/evdev/test/Test.hs index ea912fb..458d1c8 100644 --- a/evdev/test/Test.hs +++ b/evdev/test/Test.hs @@ -32,6 +32,7 @@ smoke = testCase "Smoke" do let duName = "evdev-test-device" keys = [Key1 .. Key0] evs = concatMap ((<$> [Pressed, Released]) . KeyEvent) keys + assertEqual "10 keys" 10 $ length keys du <- Uinput.newDevice duName Uinput.defaultDeviceOpts{Uinput.keys} void $ forkIO do takeMVar start -- wait until reading device is initialised From e2bbef9ec04536d77cbb0eaddde179041dbe699f Mon Sep 17 00:00:00 2001 From: George Thomas Date: Wed, 1 Apr 2026 01:16:38 +0100 Subject: [PATCH 38/55] code/enum improvements - note vibey Generator.hs --- evdev/evdev.cabal | 1 + evdev/src/Evdev.hs | 75 +- evdev/src/Evdev/Codes.hs | 3505 +--------------------------- evdev/src/Evdev/Codes/Generator.hs | 230 ++ evdev/src/Evdev/Raw.hs | 1 + evdev/src/Evdev/Uinput.hs | 24 +- evdev/src/Util.hs | 13 +- evdev/test/Test.hs | 6 +- 8 files changed, 289 insertions(+), 3566 deletions(-) create mode 100644 evdev/src/Evdev/Codes/Generator.hs diff --git a/evdev/evdev.cabal b/evdev/evdev.cabal index b84437f..17caa44 100644 --- a/evdev/evdev.cabal +++ b/evdev/evdev.cabal @@ -54,6 +54,7 @@ library Evdev.Raw Util other-modules: + Evdev.Codes.Generator hs-source-dirs: src c-sources: src-c/evdev-hs.c diff --git a/evdev/src/Evdev.hs b/evdev/src/Evdev.hs index c27810c..0edf112 100644 --- a/evdev/src/Evdev.hs +++ b/evdev/src/Evdev.hs @@ -1,6 +1,5 @@ {-# LANGUAGE LexicalNegation #-} {-# LANGUAGE OverloadedRecordDot #-} -{-# OPTIONS_GHC -fno-state-hack #-} -- | The main module for working with devices and events. module Evdev ( @@ -53,7 +52,6 @@ module Evdev ( fromCTimeVal, ) where -import Control.Arrow ((&&&)) import Control.Monad (filterM, join) import Data.ByteString (packCString) import Data.ByteString.Char8 (ByteString, pack) @@ -61,9 +59,6 @@ import Data.Coerce (coerce) import Data.Function ((&)) import Data.Functor ((<&>)) import Data.Int (Int32) -import Data.List.Extra (enumerate) -import Data.Map ((!?), Map) -import qualified Data.Map as Map import Data.Maybe (fromMaybe) import Data.Ratio ((%)) import Data.Set (Set) @@ -188,16 +183,16 @@ fromCEvent Raw.Input_event{type', code, value, time} = (fromCTimeVal time) fromCEventData :: (Word16, Word16, Int32) -> EventData -fromCEventData (t, EventCode -> c, EventValue -> v) = fromMaybe (UnknownEvent t c v) $ toEnum' t >>= \case - EvSyn -> SyncEvent <$> toEnum' c - EvKey -> KeyEvent <$> toEnum' c <*> toEnum' v - EvRel -> RelativeEvent <$> toEnum' c <*> pure v - EvAbs -> AbsoluteEvent <$> toEnum' c <*> pure v - EvMsc -> MiscEvent <$> toEnum' c <*> pure v - EvSw -> SwitchEvent <$> toEnum' c <*> pure v - EvLed -> LEDEvent <$> toEnum' c <*> pure v - EvSnd -> SoundEvent <$> toEnum' c <*> pure v - EvRep -> RepeatEvent <$> toEnum' c <*> pure v +fromCEventData (t, c'@(EventCode -> c), v'@(EventValue -> v)) = fromMaybe (UnknownEvent t c v) $ toEnum' t >>= \case + EvSyn -> SyncEvent <$> toEnum' c' + EvKey -> KeyEvent <$> toEnum' c' <*> case v' of 0 -> Just Released; 1-> Just Pressed; 2-> Just Repeated; _-> Nothing + EvRel -> RelativeEvent <$> toEnum' c' <*> pure v + EvAbs -> AbsoluteEvent <$> toEnum' c' <*> pure v + EvMsc -> MiscEvent <$> toEnum' c' <*> pure v + EvSw -> SwitchEvent <$> toEnum' c' <*> pure v + EvLed -> LEDEvent <$> toEnum' c' <*> pure v + EvSnd -> SoundEvent <$> toEnum' c' <*> pure v + EvRep -> RepeatEvent <$> toEnum' c' <*> pure v EvFf -> Just $ ForceFeedbackEvent c v EvPwr -> Just $ PowerEvent c v EvFfStatus -> Just $ ForceFeedbackStatusEvent c v @@ -209,18 +204,18 @@ toCEventData :: EventData -> (Word16, Word16, Int32) toCEventData = \case -- from kernel docs, 'EV_SYN event values are undefined' - we always seem to see 0, so may as well use that SyncEvent (fromEnum' -> c) -> (fromEnum' EvSyn, c, 0) - KeyEvent (fromEnum' -> c) (fromEnum' -> v) -> (fromEnum' EvKey, c, v) - RelativeEvent (fromEnum' -> c) (fromEnum' -> v) -> (fromEnum' EvRel, c, v) - AbsoluteEvent (fromEnum' -> c) (fromEnum' -> v) -> (fromEnum' EvAbs, c, v) - MiscEvent (fromEnum' -> c) (fromEnum' -> v) -> (fromEnum' EvMsc, c, v) - SwitchEvent (fromEnum' -> c) (fromEnum' -> v) -> (fromEnum' EvSw, c, v) - LEDEvent (fromEnum' -> c) (fromEnum' -> v) -> (fromEnum' EvLed, c, v) - SoundEvent (fromEnum' -> c) (fromEnum' -> v) -> (fromEnum' EvSnd, c, v) - RepeatEvent (fromEnum' -> c) (fromEnum' -> v) -> (fromEnum' EvRep, c, v) - ForceFeedbackEvent (fromEnum' -> c) (fromEnum' -> v) -> (fromEnum' EvFf, c, v) - PowerEvent (fromEnum' -> c) (fromEnum' -> v) -> (fromEnum' EvPwr, c, v) - ForceFeedbackStatusEvent (fromEnum' -> c) (fromEnum' -> v) -> (fromEnum' EvFfStatus, c, v) - UnknownEvent (fromEnum' -> t) (fromEnum' -> c) (fromEnum' -> v) -> (t, c, v) + KeyEvent (fromEnum' -> c) (fromIntegral . fromEnum -> v) -> (fromEnum' EvKey, c, v) + RelativeEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvRel, c, v) + AbsoluteEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvAbs, c, v) + MiscEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvMsc, c, v) + SwitchEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvSw, c, v) + LEDEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvLed, c, v) + SoundEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvSnd, c, v) + RepeatEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvRep, c, v) + ForceFeedbackEvent (coerce -> c) (coerce -> v) -> (fromEnum' EvFf, c, v) + PowerEvent (coerce -> c) (coerce -> v) -> (fromEnum' EvPwr, c, v) + ForceFeedbackStatusEvent (coerce -> c) (coerce -> v) -> (fromEnum' EvFfStatus, c, v) + UnknownEvent t (coerce -> c) (coerce -> v) -> (t, c, v) fromCTimeVal :: Raw.Timeval -> DiffTime fromCTimeVal Raw.Timeval{tv_sec = s, tv_usec = us} = @@ -278,11 +273,11 @@ deviceVersion :: Device -> IO Int deviceVersion = flip withForeignPtr (fmap fromIntegral . Raw.libevdev_get_id_version . ConstPtr) . cDevice deviceProperties :: Device -> IO [DeviceProperty] -deviceProperties (Device dev _) = enumerate & filterM \prop -> withForeignPtr dev \p -> +deviceProperties (Device dev _) = enumerate' & filterM \prop -> withForeignPtr dev \p -> toBool <$> Raw.libevdev_has_property (ConstPtr p) (fromEnum' prop) deviceEventTypes :: Device -> IO [EventType] -deviceEventTypes (Device dev _) = enumerate & filterM \et -> withForeignPtr dev \p -> +deviceEventTypes (Device dev _) = enumerate' & filterM \et -> withForeignPtr dev \p -> toBool <$> Raw.libevdev_has_event_type (ConstPtr p) (fromEnum' et) --TODO this is an imperfect API since '_val' is ignored entirely @@ -333,27 +328,5 @@ grabDevice' :: Raw.Libevdev_grab_mode -> Device -> IO () grabDevice' mode dev = cErrCallDev "grabDevice" dev $ withForeignPtr (cDevice dev) $ fmap Errno . flip Raw.libevdev_grab mode -{- -TODO this is a workaround until c2hs has a better story for enum conversions - when we remove it we can get rid of '-fno-state-hack' - -based on profiling, and Debug.Trace, it seems that 'enumMap' is computed no more times than necessary - (6 - number of combinations of a and k that it is called with) - but based on https://www.reddit.com/r/haskell/comments/grskne/help_reasoning_about_performance_memoization/, - it's possible that behaviour is worse without profiling on (argh...) - -open c2hs issue - we perhaps essentially want the `CEnum` class proposed at: https://github.com/haskell/c2hs/issues/78 - but perhaps belonging (at least initially) in c2hs rather than base, for expediency - this doesn't necessarily consider enum defines though - discussion is around capturing the semantics of actual C enums - alternatively, monomorphic functions for each type, as with c2hs's with* functions --} -toEnum' :: forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a -toEnum' = (enumMap !?) - where - --TODO HashMap, IntMap? - enumMap :: Map k a - enumMap = Map.fromList $ map (toEnum . fromEnum &&& id) enumerate - cErrCallDev :: CErrCall a => String -> Device -> IO a -> IO (CErrCallRes a) cErrCallDev f = cErrCall f . return . Just . devicePath diff --git a/evdev/src/Evdev/Codes.hs b/evdev/src/Evdev/Codes.hs index a0c0bc9..ef64814 100644 --- a/evdev/src/Evdev/Codes.hs +++ b/evdev/src/Evdev/Codes.hs @@ -1,3504 +1,11 @@ -{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TemplateHaskell #-} -- | 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 - ( 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 - - - - - --- | Each of these corresponds to one of the contructors of 'Evdev.EventData'. So you're unlikely to need to use these directly (C doesn't have ADTs - we do). -data EventType = EvSyn - | EvKey - | EvRel - | EvAbs - | EvMsc - | EvSw - | EvLed - | EvSnd - | EvRep - | EvFf - | EvPwr - | EvFfStatus - deriving (Bounded,Eq,Ord,Read,Show) -instance Enum EventType where - succ EvSyn = EvKey - succ EvKey = EvRel - succ EvRel = EvAbs - succ EvAbs = EvMsc - succ EvMsc = EvSw - succ EvSw = EvLed - succ EvLed = EvSnd - succ EvSnd = EvRep - succ EvRep = EvFf - succ EvFf = EvPwr - succ EvPwr = EvFfStatus - succ EvFfStatus = error "EventType.succ: EvFfStatus has no successor" - - pred EvKey = EvSyn - pred EvRel = EvKey - pred EvAbs = EvRel - pred EvMsc = EvAbs - pred EvSw = EvMsc - pred EvLed = EvSw - pred EvSnd = EvLed - pred EvRep = EvSnd - pred EvFf = EvRep - pred EvPwr = EvFf - pred EvFfStatus = EvPwr - pred EvSyn = error "EventType.pred: EvSyn has no predecessor" - - enumFromTo from to = go from - where - end = fromEnum to - go v = case compare (fromEnum v) end of - LT -> v : go (succ v) - EQ -> [v] - GT -> [] - - enumFrom from = enumFromTo from EvFfStatus - - fromEnum EvSyn = 0 - fromEnum EvKey = 1 - fromEnum EvRel = 2 - fromEnum EvAbs = 3 - fromEnum EvMsc = 4 - fromEnum EvSw = 5 - fromEnum EvLed = 17 - fromEnum EvSnd = 18 - fromEnum EvRep = 20 - fromEnum EvFf = 21 - fromEnum EvPwr = 22 - fromEnum EvFfStatus = 23 - - toEnum 0 = EvSyn - toEnum 1 = EvKey - toEnum 2 = EvRel - toEnum 3 = EvAbs - toEnum 4 = EvMsc - toEnum 5 = EvSw - toEnum 17 = EvLed - toEnum 18 = EvSnd - toEnum 20 = EvRep - toEnum 21 = EvFf - toEnum 22 = EvPwr - toEnum 23 = EvFfStatus - toEnum unmatched = error ("EventType.toEnum: Cannot match " ++ show unmatched) - - - --- | Synchronization events -data SyncEvent = SynReport - | SynConfig - | SynMtReport - | SynDropped - deriving (Bounded,Eq,Ord,Read,Show) -instance Enum SyncEvent where - succ SynReport = SynConfig - succ SynConfig = SynMtReport - succ SynMtReport = SynDropped - succ SynDropped = error "SyncEvent.succ: SynDropped has no successor" - - pred SynConfig = SynReport - pred SynMtReport = SynConfig - pred SynDropped = SynMtReport - pred SynReport = error "SyncEvent.pred: SynReport has no predecessor" - - enumFromTo from to = go from - where - end = fromEnum to - go v = case compare (fromEnum v) end of - LT -> v : go (succ v) - EQ -> [v] - GT -> [] - - enumFrom from = enumFromTo from SynDropped - - fromEnum SynReport = 0 - fromEnum SynConfig = 1 - fromEnum SynMtReport = 2 - fromEnum SynDropped = 3 - - toEnum 0 = SynReport - toEnum 1 = SynConfig - toEnum 2 = SynMtReport - toEnum 3 = SynDropped - toEnum unmatched = error ("SyncEvent.toEnum: Cannot match " ++ show unmatched) - - - --- | Keys and buttons -data Key = KeyReserved - | KeyEsc - | Key1 - | Key2 - | Key3 - | Key4 - | Key5 - | Key6 - | Key7 - | Key8 - | Key9 - | Key0 - | KeyMinus - | KeyEqual - | KeyBackspace - | KeyTab - | KeyQ - | KeyW - | KeyE - | KeyR - | KeyT - | KeyY - | KeyU - | KeyI - | KeyO - | KeyP - | KeyLeftbrace - | KeyRightbrace - | KeyEnter - | KeyLeftctrl - | KeyA - | KeyS - | KeyD - | KeyF - | KeyG - | KeyH - | KeyJ - | KeyK - | KeyL - | KeySemicolon - | KeyApostrophe - | KeyGrave - | KeyLeftshift - | KeyBackslash - | KeyZ - | KeyX - | KeyC - | KeyV - | KeyB - | KeyN - | KeyM - | KeyComma - | KeyDot - | KeySlash - | KeyRightshift - | KeyKpasterisk - | KeyLeftalt - | KeySpace - | KeyCapslock - | KeyF1 - | KeyF2 - | KeyF3 - | KeyF4 - | KeyF5 - | KeyF6 - | KeyF7 - | KeyF8 - | KeyF9 - | KeyF10 - | KeyNumlock - | KeyScrolllock - | KeyKp7 - | KeyKp8 - | KeyKp9 - | KeyKpminus - | KeyKp4 - | KeyKp5 - | KeyKp6 - | KeyKpplus - | KeyKp1 - | KeyKp2 - | KeyKp3 - | KeyKp0 - | KeyKpdot - | KeyZenkakuhankaku - | Key102nd - | KeyF11 - | KeyF12 - | KeyRo - | KeyKatakana - | KeyHiragana - | KeyHenkan - | KeyKatakanahiragana - | KeyMuhenkan - | KeyKpjpcomma - | KeyKpenter - | KeyRightctrl - | KeyKpslash - | KeySysrq - | KeyRightalt - | KeyLinefeed - | KeyHome - | KeyUp - | KeyPageup - | KeyLeft - | KeyRight - | KeyEnd - | KeyDown - | KeyPagedown - | KeyInsert - | KeyDelete - | KeyMacro - | KeyMute - | KeyVolumedown - | KeyVolumeup - | KeyPower - | KeyKpequal - | KeyKpplusminus - | KeyPause - | KeyScale - | KeyKpcomma - | KeyHangeul - | KeyHanja - | KeyYen - | KeyLeftmeta - | KeyRightmeta - | KeyCompose - | KeyStop - | KeyAgain - | KeyProps - | KeyUndo - | KeyFront - | KeyCopy - | KeyOpen - | KeyPaste - | KeyFind - | KeyCut - | KeyHelp - | KeyMenu - | KeyCalc - | KeySetup - | KeySleep - | KeyWakeup - | KeyFile - | KeySendfile - | KeyDeletefile - | KeyXfer - | KeyProg1 - | KeyProg2 - | KeyWww - | KeyMsdos - | KeyScreenlock - | KeyRotateDisplay - | KeyCyclewindows - | KeyMail - | KeyBookmarks - | KeyComputer - | KeyBack - | KeyForward - | KeyClosecd - | KeyEjectcd - | KeyEjectclosecd - | KeyNextsong - | KeyPlaypause - | KeyPrevioussong - | KeyStopcd - | KeyRecord - | KeyRewind - | KeyPhone - | KeyIso - | KeyConfig - | KeyHomepage - | KeyRefresh - | KeyExit - | KeyMove - | KeyEdit - | KeyScrollup - | KeyScrolldown - | KeyKpleftparen - | KeyKprightparen - | KeyNew - | KeyRedo - | KeyF13 - | KeyF14 - | KeyF15 - | KeyF16 - | KeyF17 - | KeyF18 - | KeyF19 - | KeyF20 - | KeyF21 - | KeyF22 - | KeyF23 - | KeyF24 - | KeyPlaycd - | KeyPausecd - | KeyProg3 - | KeyProg4 - | KeyDashboard - | KeySuspend - | KeyClose - | KeyPlay - | KeyFastforward - | KeyBassboost - | KeyPrint - | KeyHp - | KeyCamera - | KeySound - | KeyQuestion - | KeyEmail - | KeyChat - | KeySearch - | KeyConnect - | KeyFinance - | KeySport - | KeyShop - | KeyAlterase - | KeyCancel - | KeyBrightnessdown - | KeyBrightnessup - | KeyMedia - | KeySwitchvideomode - | KeyKbdillumtoggle - | KeyKbdillumdown - | KeyKbdillumup - | KeySend - | KeyReply - | KeyForwardmail - | KeySave - | KeyDocuments - | KeyBattery - | KeyBluetooth - | KeyWlan - | KeyUwb - | KeyUnknown - | KeyVideoNext - | KeyVideoPrev - | KeyBrightnessCycle - | KeyBrightnessAuto - | KeyDisplayOff - | KeyWwan - | KeyRfkill - | KeyMicmute - | Btn0 - | Btn1 - | Btn2 - | Btn3 - | Btn4 - | Btn5 - | Btn6 - | Btn7 - | Btn8 - | Btn9 - | BtnLeft - | BtnRight - | BtnMiddle - | BtnSide - | BtnExtra - | BtnForward - | BtnBack - | BtnTask - | BtnJoystick - | BtnThumb - | BtnThumb2 - | BtnTop - | BtnTop2 - | BtnPinkie - | BtnBase - | BtnBase2 - | BtnBase3 - | BtnBase4 - | BtnBase5 - | BtnBase6 - | BtnDead - | BtnA - | BtnB - | BtnC - | BtnX - | BtnY - | BtnZ - | BtnTl - | BtnTr - | BtnTl2 - | BtnTr2 - | BtnSelect - | BtnStart - | BtnMode - | BtnThumbl - | BtnThumbr - | BtnToolPen - | BtnToolRubber - | BtnToolBrush - | BtnToolPencil - | BtnToolAirbrush - | BtnToolFinger - | BtnToolMouse - | BtnToolLens - | BtnToolQuinttap - | BtnTouch - | BtnStylus - | BtnStylus2 - | BtnToolDoubletap - | BtnToolTripletap - | BtnToolQuadtap - | BtnGearDown - | BtnGearUp - | KeyOk - | KeySelect - | KeyGoto - | KeyClear - | KeyPower2 - | KeyOption - | KeyInfo - | KeyTime - | KeyVendor - | KeyArchive - | KeyProgram - | KeyChannel - | KeyFavorites - | KeyEpg - | KeyPvr - | KeyMhp - | KeyLanguage - | KeyTitle - | KeySubtitle - | KeyAngle - | KeyZoom - | KeyMode - | KeyKeyboard - | KeyScreen - | KeyPc - | KeyTv - | KeyTv2 - | KeyVcr - | KeyVcr2 - | KeySat - | KeySat2 - | KeyCd - | KeyTape - | KeyRadio - | KeyTuner - | KeyPlayer - | KeyText - | KeyDvd - | KeyAux - | KeyMp3 - | KeyAudio - | KeyVideo - | KeyDirectory - | KeyList - | KeyMemo - | KeyCalendar - | KeyRed - | KeyGreen - | KeyYellow - | KeyBlue - | KeyChannelup - | KeyChanneldown - | KeyFirst - | KeyLast - | KeyAb - | KeyNext - | KeyRestart - | KeySlow - | KeyShuffle - | KeyBreak - | KeyPrevious - | KeyDigits - | KeyTeen - | KeyTwen - | KeyVideophone - | KeyGames - | KeyZoomin - | KeyZoomout - | KeyZoomreset - | KeyWordprocessor - | KeyEditor - | KeySpreadsheet - | KeyGraphicseditor - | KeyPresentation - | KeyDatabase - | KeyNews - | KeyVoicemail - | KeyAddressbook - | KeyMessenger - | KeyDisplaytoggle - | KeySpellcheck - | KeyLogoff - | KeyDollar - | KeyEuro - | KeyFrameback - | KeyFrameforward - | KeyContextMenu - | KeyMediaRepeat - | Key10channelsup - | Key10channelsdown - | KeyImages - | KeyDelEol - | KeyDelEos - | KeyInsLine - | KeyDelLine - | KeyFn - | KeyFnEsc - | KeyFnF1 - | KeyFnF2 - | KeyFnF3 - | KeyFnF4 - | KeyFnF5 - | KeyFnF6 - | KeyFnF7 - | KeyFnF8 - | KeyFnF9 - | KeyFnF10 - | KeyFnF11 - | KeyFnF12 - | KeyFn1 - | KeyFn2 - | KeyFnD - | KeyFnE - | KeyFnF - | KeyFnS - | KeyFnB - | KeyBrlDot1 - | KeyBrlDot2 - | KeyBrlDot3 - | KeyBrlDot4 - | KeyBrlDot5 - | KeyBrlDot6 - | KeyBrlDot7 - | KeyBrlDot8 - | KeyBrlDot9 - | KeyBrlDot10 - | KeyNumeric0 - | KeyNumeric1 - | KeyNumeric2 - | KeyNumeric3 - | KeyNumeric4 - | KeyNumeric5 - | KeyNumeric6 - | KeyNumeric7 - | KeyNumeric8 - | KeyNumeric9 - | KeyNumericStar - | KeyNumericPound - | KeyNumericA - | KeyNumericB - | KeyNumericC - | KeyNumericD - | KeyCameraFocus - | KeyWpsButton - | KeyTouchpadToggle - | KeyTouchpadOn - | KeyTouchpadOff - | KeyCameraZoomin - | KeyCameraZoomout - | KeyCameraUp - | KeyCameraDown - | KeyCameraLeft - | KeyCameraRight - | KeyAttendantOn - | KeyAttendantOff - | KeyAttendantToggle - | KeyLightsToggle - | BtnDpadUp - | BtnDpadDown - | BtnDpadLeft - | BtnDpadRight - | KeyAlsToggle - | KeyButtonconfig - | KeyTaskmanager - | KeyJournal - | KeyControlpanel - | KeyAppselect - | KeyScreensaver - | KeyVoicecommand - | KeyBrightnessMin - | KeyBrightnessMax - | KeyKbdinputassistPrev - | KeyKbdinputassistNext - | KeyKbdinputassistPrevgroup - | KeyKbdinputassistNextgroup - | KeyKbdinputassistAccept - | KeyKbdinputassistCancel - | BtnTriggerHappy1 - | BtnTriggerHappy2 - | BtnTriggerHappy3 - | BtnTriggerHappy4 - | BtnTriggerHappy5 - | BtnTriggerHappy6 - | BtnTriggerHappy7 - | BtnTriggerHappy8 - | BtnTriggerHappy9 - | BtnTriggerHappy10 - | BtnTriggerHappy11 - | BtnTriggerHappy12 - | BtnTriggerHappy13 - | BtnTriggerHappy14 - | BtnTriggerHappy15 - | BtnTriggerHappy16 - | BtnTriggerHappy17 - | BtnTriggerHappy18 - | BtnTriggerHappy19 - | BtnTriggerHappy20 - | BtnTriggerHappy21 - | BtnTriggerHappy22 - | BtnTriggerHappy23 - | BtnTriggerHappy24 - | BtnTriggerHappy25 - | BtnTriggerHappy26 - | BtnTriggerHappy27 - | BtnTriggerHappy28 - | BtnTriggerHappy29 - | BtnTriggerHappy30 - | BtnTriggerHappy31 - | BtnTriggerHappy32 - | BtnTriggerHappy33 - | BtnTriggerHappy34 - | BtnTriggerHappy35 - | BtnTriggerHappy36 - | BtnTriggerHappy37 - | BtnTriggerHappy38 - | BtnTriggerHappy39 - | BtnTriggerHappy40 - deriving (Bounded,Eq,Ord,Read,Show) -instance Enum Key where - succ KeyReserved = KeyEsc - succ KeyEsc = Key1 - succ Key1 = Key2 - succ Key2 = Key3 - succ Key3 = Key4 - succ Key4 = Key5 - succ Key5 = Key6 - succ Key6 = Key7 - succ Key7 = Key8 - succ Key8 = Key9 - succ Key9 = Key0 - succ Key0 = KeyMinus - succ KeyMinus = KeyEqual - succ KeyEqual = KeyBackspace - succ KeyBackspace = KeyTab - succ KeyTab = KeyQ - succ KeyQ = KeyW - succ KeyW = KeyE - succ KeyE = KeyR - succ KeyR = KeyT - succ KeyT = KeyY - succ KeyY = KeyU - succ KeyU = KeyI - succ KeyI = KeyO - succ KeyO = KeyP - succ KeyP = KeyLeftbrace - succ KeyLeftbrace = KeyRightbrace - succ KeyRightbrace = KeyEnter - succ KeyEnter = KeyLeftctrl - succ KeyLeftctrl = KeyA - succ KeyA = KeyS - succ KeyS = KeyD - succ KeyD = KeyF - succ KeyF = KeyG - succ KeyG = KeyH - succ KeyH = KeyJ - succ KeyJ = KeyK - succ KeyK = KeyL - succ KeyL = KeySemicolon - succ KeySemicolon = KeyApostrophe - succ KeyApostrophe = KeyGrave - succ KeyGrave = KeyLeftshift - succ KeyLeftshift = KeyBackslash - succ KeyBackslash = KeyZ - succ KeyZ = KeyX - succ KeyX = KeyC - succ KeyC = KeyV - succ KeyV = KeyB - succ KeyB = KeyN - succ KeyN = KeyM - succ KeyM = KeyComma - succ KeyComma = KeyDot - succ KeyDot = KeySlash - succ KeySlash = KeyRightshift - succ KeyRightshift = KeyKpasterisk - succ KeyKpasterisk = KeyLeftalt - succ KeyLeftalt = KeySpace - succ KeySpace = KeyCapslock - succ KeyCapslock = KeyF1 - succ KeyF1 = KeyF2 - succ KeyF2 = KeyF3 - succ KeyF3 = KeyF4 - succ KeyF4 = KeyF5 - succ KeyF5 = KeyF6 - succ KeyF6 = KeyF7 - succ KeyF7 = KeyF8 - succ KeyF8 = KeyF9 - succ KeyF9 = KeyF10 - succ KeyF10 = KeyNumlock - succ KeyNumlock = KeyScrolllock - succ KeyScrolllock = KeyKp7 - succ KeyKp7 = KeyKp8 - succ KeyKp8 = KeyKp9 - succ KeyKp9 = KeyKpminus - succ KeyKpminus = KeyKp4 - succ KeyKp4 = KeyKp5 - succ KeyKp5 = KeyKp6 - succ KeyKp6 = KeyKpplus - succ KeyKpplus = KeyKp1 - succ KeyKp1 = KeyKp2 - succ KeyKp2 = KeyKp3 - succ KeyKp3 = KeyKp0 - succ KeyKp0 = KeyKpdot - succ KeyKpdot = KeyZenkakuhankaku - succ KeyZenkakuhankaku = Key102nd - succ Key102nd = KeyF11 - succ KeyF11 = KeyF12 - succ KeyF12 = KeyRo - succ KeyRo = KeyKatakana - succ KeyKatakana = KeyHiragana - succ KeyHiragana = KeyHenkan - succ KeyHenkan = KeyKatakanahiragana - succ KeyKatakanahiragana = KeyMuhenkan - succ KeyMuhenkan = KeyKpjpcomma - succ KeyKpjpcomma = KeyKpenter - succ KeyKpenter = KeyRightctrl - succ KeyRightctrl = KeyKpslash - succ KeyKpslash = KeySysrq - succ KeySysrq = KeyRightalt - succ KeyRightalt = KeyLinefeed - succ KeyLinefeed = KeyHome - succ KeyHome = KeyUp - succ KeyUp = KeyPageup - succ KeyPageup = KeyLeft - succ KeyLeft = KeyRight - succ KeyRight = KeyEnd - succ KeyEnd = KeyDown - succ KeyDown = KeyPagedown - succ KeyPagedown = KeyInsert - succ KeyInsert = KeyDelete - succ KeyDelete = KeyMacro - succ KeyMacro = KeyMute - succ KeyMute = KeyVolumedown - succ KeyVolumedown = KeyVolumeup - succ KeyVolumeup = KeyPower - succ KeyPower = KeyKpequal - succ KeyKpequal = KeyKpplusminus - succ KeyKpplusminus = KeyPause - succ KeyPause = KeyScale - succ KeyScale = KeyKpcomma - succ KeyKpcomma = KeyHangeul - succ KeyHangeul = KeyHanja - succ KeyHanja = KeyYen - succ KeyYen = KeyLeftmeta - succ KeyLeftmeta = KeyRightmeta - succ KeyRightmeta = KeyCompose - succ KeyCompose = KeyStop - succ KeyStop = KeyAgain - succ KeyAgain = KeyProps - succ KeyProps = KeyUndo - succ KeyUndo = KeyFront - succ KeyFront = KeyCopy - succ KeyCopy = KeyOpen - succ KeyOpen = KeyPaste - succ KeyPaste = KeyFind - succ KeyFind = KeyCut - succ KeyCut = KeyHelp - succ KeyHelp = KeyMenu - succ KeyMenu = KeyCalc - succ KeyCalc = KeySetup - succ KeySetup = KeySleep - succ KeySleep = KeyWakeup - succ KeyWakeup = KeyFile - succ KeyFile = KeySendfile - succ KeySendfile = KeyDeletefile - succ KeyDeletefile = KeyXfer - succ KeyXfer = KeyProg1 - succ KeyProg1 = KeyProg2 - succ KeyProg2 = KeyWww - succ KeyWww = KeyMsdos - succ KeyMsdos = KeyScreenlock - succ KeyScreenlock = KeyRotateDisplay - succ KeyRotateDisplay = KeyCyclewindows - succ KeyCyclewindows = KeyMail - succ KeyMail = KeyBookmarks - succ KeyBookmarks = KeyComputer - succ KeyComputer = KeyBack - succ KeyBack = KeyForward - succ KeyForward = KeyClosecd - succ KeyClosecd = KeyEjectcd - succ KeyEjectcd = KeyEjectclosecd - succ KeyEjectclosecd = KeyNextsong - succ KeyNextsong = KeyPlaypause - succ KeyPlaypause = KeyPrevioussong - succ KeyPrevioussong = KeyStopcd - succ KeyStopcd = KeyRecord - succ KeyRecord = KeyRewind - succ KeyRewind = KeyPhone - succ KeyPhone = KeyIso - succ KeyIso = KeyConfig - succ KeyConfig = KeyHomepage - succ KeyHomepage = KeyRefresh - succ KeyRefresh = KeyExit - succ KeyExit = KeyMove - succ KeyMove = KeyEdit - succ KeyEdit = KeyScrollup - succ KeyScrollup = KeyScrolldown - succ KeyScrolldown = KeyKpleftparen - succ KeyKpleftparen = KeyKprightparen - succ KeyKprightparen = KeyNew - succ KeyNew = KeyRedo - succ KeyRedo = KeyF13 - succ KeyF13 = KeyF14 - succ KeyF14 = KeyF15 - succ KeyF15 = KeyF16 - succ KeyF16 = KeyF17 - succ KeyF17 = KeyF18 - succ KeyF18 = KeyF19 - succ KeyF19 = KeyF20 - succ KeyF20 = KeyF21 - succ KeyF21 = KeyF22 - succ KeyF22 = KeyF23 - succ KeyF23 = KeyF24 - succ KeyF24 = KeyPlaycd - succ KeyPlaycd = KeyPausecd - succ KeyPausecd = KeyProg3 - succ KeyProg3 = KeyProg4 - succ KeyProg4 = KeyDashboard - succ KeyDashboard = KeySuspend - succ KeySuspend = KeyClose - succ KeyClose = KeyPlay - succ KeyPlay = KeyFastforward - succ KeyFastforward = KeyBassboost - succ KeyBassboost = KeyPrint - succ KeyPrint = KeyHp - succ KeyHp = KeyCamera - succ KeyCamera = KeySound - succ KeySound = KeyQuestion - succ KeyQuestion = KeyEmail - succ KeyEmail = KeyChat - succ KeyChat = KeySearch - succ KeySearch = KeyConnect - succ KeyConnect = KeyFinance - succ KeyFinance = KeySport - succ KeySport = KeyShop - succ KeyShop = KeyAlterase - succ KeyAlterase = KeyCancel - succ KeyCancel = KeyBrightnessdown - succ KeyBrightnessdown = KeyBrightnessup - succ KeyBrightnessup = KeyMedia - succ KeyMedia = KeySwitchvideomode - succ KeySwitchvideomode = KeyKbdillumtoggle - succ KeyKbdillumtoggle = KeyKbdillumdown - succ KeyKbdillumdown = KeyKbdillumup - succ KeyKbdillumup = KeySend - succ KeySend = KeyReply - succ KeyReply = KeyForwardmail - succ KeyForwardmail = KeySave - succ KeySave = KeyDocuments - succ KeyDocuments = KeyBattery - succ KeyBattery = KeyBluetooth - succ KeyBluetooth = KeyWlan - succ KeyWlan = KeyUwb - succ KeyUwb = KeyUnknown - succ KeyUnknown = KeyVideoNext - succ KeyVideoNext = KeyVideoPrev - succ KeyVideoPrev = KeyBrightnessCycle - succ KeyBrightnessCycle = KeyBrightnessAuto - succ KeyBrightnessAuto = KeyDisplayOff - succ KeyDisplayOff = KeyWwan - succ KeyWwan = KeyRfkill - succ KeyRfkill = KeyMicmute - succ KeyMicmute = Btn0 - succ Btn0 = Btn1 - succ Btn1 = Btn2 - succ Btn2 = Btn3 - succ Btn3 = Btn4 - succ Btn4 = Btn5 - succ Btn5 = Btn6 - succ Btn6 = Btn7 - succ Btn7 = Btn8 - succ Btn8 = Btn9 - succ Btn9 = BtnLeft - succ BtnLeft = BtnRight - succ BtnRight = BtnMiddle - succ BtnMiddle = BtnSide - succ BtnSide = BtnExtra - succ BtnExtra = BtnForward - succ BtnForward = BtnBack - succ BtnBack = BtnTask - succ BtnTask = BtnJoystick - succ BtnJoystick = BtnThumb - succ BtnThumb = BtnThumb2 - succ BtnThumb2 = BtnTop - succ BtnTop = BtnTop2 - succ BtnTop2 = BtnPinkie - succ BtnPinkie = BtnBase - succ BtnBase = BtnBase2 - succ BtnBase2 = BtnBase3 - succ BtnBase3 = BtnBase4 - succ BtnBase4 = BtnBase5 - succ BtnBase5 = BtnBase6 - succ BtnBase6 = BtnDead - succ BtnDead = BtnA - succ BtnA = BtnB - succ BtnB = BtnC - succ BtnC = BtnX - succ BtnX = BtnY - succ BtnY = BtnZ - succ BtnZ = BtnTl - succ BtnTl = BtnTr - succ BtnTr = BtnTl2 - succ BtnTl2 = BtnTr2 - succ BtnTr2 = BtnSelect - succ BtnSelect = BtnStart - succ BtnStart = BtnMode - succ BtnMode = BtnThumbl - succ BtnThumbl = BtnThumbr - succ BtnThumbr = BtnToolPen - succ BtnToolPen = BtnToolRubber - succ BtnToolRubber = BtnToolBrush - succ BtnToolBrush = BtnToolPencil - succ BtnToolPencil = BtnToolAirbrush - succ BtnToolAirbrush = BtnToolFinger - succ BtnToolFinger = BtnToolMouse - succ BtnToolMouse = BtnToolLens - succ BtnToolLens = BtnToolQuinttap - succ BtnToolQuinttap = BtnTouch - succ BtnTouch = BtnStylus - succ BtnStylus = BtnStylus2 - succ BtnStylus2 = BtnToolDoubletap - succ BtnToolDoubletap = BtnToolTripletap - succ BtnToolTripletap = BtnToolQuadtap - succ BtnToolQuadtap = BtnGearDown - succ BtnGearDown = BtnGearUp - succ BtnGearUp = KeyOk - succ KeyOk = KeySelect - succ KeySelect = KeyGoto - succ KeyGoto = KeyClear - succ KeyClear = KeyPower2 - succ KeyPower2 = KeyOption - succ KeyOption = KeyInfo - succ KeyInfo = KeyTime - succ KeyTime = KeyVendor - succ KeyVendor = KeyArchive - succ KeyArchive = KeyProgram - succ KeyProgram = KeyChannel - succ KeyChannel = KeyFavorites - succ KeyFavorites = KeyEpg - succ KeyEpg = KeyPvr - succ KeyPvr = KeyMhp - succ KeyMhp = KeyLanguage - succ KeyLanguage = KeyTitle - succ KeyTitle = KeySubtitle - succ KeySubtitle = KeyAngle - succ KeyAngle = KeyZoom - succ KeyZoom = KeyMode - succ KeyMode = KeyKeyboard - succ KeyKeyboard = KeyScreen - succ KeyScreen = KeyPc - succ KeyPc = KeyTv - succ KeyTv = KeyTv2 - succ KeyTv2 = KeyVcr - succ KeyVcr = KeyVcr2 - succ KeyVcr2 = KeySat - succ KeySat = KeySat2 - succ KeySat2 = KeyCd - succ KeyCd = KeyTape - succ KeyTape = KeyRadio - succ KeyRadio = KeyTuner - succ KeyTuner = KeyPlayer - succ KeyPlayer = KeyText - succ KeyText = KeyDvd - succ KeyDvd = KeyAux - succ KeyAux = KeyMp3 - succ KeyMp3 = KeyAudio - succ KeyAudio = KeyVideo - succ KeyVideo = KeyDirectory - succ KeyDirectory = KeyList - succ KeyList = KeyMemo - succ KeyMemo = KeyCalendar - succ KeyCalendar = KeyRed - succ KeyRed = KeyGreen - succ KeyGreen = KeyYellow - succ KeyYellow = KeyBlue - succ KeyBlue = KeyChannelup - succ KeyChannelup = KeyChanneldown - succ KeyChanneldown = KeyFirst - succ KeyFirst = KeyLast - succ KeyLast = KeyAb - succ KeyAb = KeyNext - succ KeyNext = KeyRestart - succ KeyRestart = KeySlow - succ KeySlow = KeyShuffle - succ KeyShuffle = KeyBreak - succ KeyBreak = KeyPrevious - succ KeyPrevious = KeyDigits - succ KeyDigits = KeyTeen - succ KeyTeen = KeyTwen - succ KeyTwen = KeyVideophone - succ KeyVideophone = KeyGames - succ KeyGames = KeyZoomin - succ KeyZoomin = KeyZoomout - succ KeyZoomout = KeyZoomreset - succ KeyZoomreset = KeyWordprocessor - succ KeyWordprocessor = KeyEditor - succ KeyEditor = KeySpreadsheet - succ KeySpreadsheet = KeyGraphicseditor - succ KeyGraphicseditor = KeyPresentation - succ KeyPresentation = KeyDatabase - succ KeyDatabase = KeyNews - succ KeyNews = KeyVoicemail - succ KeyVoicemail = KeyAddressbook - succ KeyAddressbook = KeyMessenger - succ KeyMessenger = KeyDisplaytoggle - succ KeyDisplaytoggle = KeySpellcheck - succ KeySpellcheck = KeyLogoff - succ KeyLogoff = KeyDollar - succ KeyDollar = KeyEuro - succ KeyEuro = KeyFrameback - succ KeyFrameback = KeyFrameforward - succ KeyFrameforward = KeyContextMenu - succ KeyContextMenu = KeyMediaRepeat - succ KeyMediaRepeat = Key10channelsup - succ Key10channelsup = Key10channelsdown - succ Key10channelsdown = KeyImages - succ KeyImages = KeyDelEol - succ KeyDelEol = KeyDelEos - succ KeyDelEos = KeyInsLine - succ KeyInsLine = KeyDelLine - succ KeyDelLine = KeyFn - succ KeyFn = KeyFnEsc - succ KeyFnEsc = KeyFnF1 - succ KeyFnF1 = KeyFnF2 - succ KeyFnF2 = KeyFnF3 - succ KeyFnF3 = KeyFnF4 - succ KeyFnF4 = KeyFnF5 - succ KeyFnF5 = KeyFnF6 - succ KeyFnF6 = KeyFnF7 - succ KeyFnF7 = KeyFnF8 - succ KeyFnF8 = KeyFnF9 - succ KeyFnF9 = KeyFnF10 - succ KeyFnF10 = KeyFnF11 - succ KeyFnF11 = KeyFnF12 - succ KeyFnF12 = KeyFn1 - succ KeyFn1 = KeyFn2 - succ KeyFn2 = KeyFnD - succ KeyFnD = KeyFnE - succ KeyFnE = KeyFnF - succ KeyFnF = KeyFnS - succ KeyFnS = KeyFnB - succ KeyFnB = KeyBrlDot1 - succ KeyBrlDot1 = KeyBrlDot2 - succ KeyBrlDot2 = KeyBrlDot3 - succ KeyBrlDot3 = KeyBrlDot4 - succ KeyBrlDot4 = KeyBrlDot5 - succ KeyBrlDot5 = KeyBrlDot6 - succ KeyBrlDot6 = KeyBrlDot7 - succ KeyBrlDot7 = KeyBrlDot8 - succ KeyBrlDot8 = KeyBrlDot9 - succ KeyBrlDot9 = KeyBrlDot10 - succ KeyBrlDot10 = KeyNumeric0 - succ KeyNumeric0 = KeyNumeric1 - succ KeyNumeric1 = KeyNumeric2 - succ KeyNumeric2 = KeyNumeric3 - succ KeyNumeric3 = KeyNumeric4 - succ KeyNumeric4 = KeyNumeric5 - succ KeyNumeric5 = KeyNumeric6 - succ KeyNumeric6 = KeyNumeric7 - succ KeyNumeric7 = KeyNumeric8 - succ KeyNumeric8 = KeyNumeric9 - succ KeyNumeric9 = KeyNumericStar - succ KeyNumericStar = KeyNumericPound - succ KeyNumericPound = KeyNumericA - succ KeyNumericA = KeyNumericB - succ KeyNumericB = KeyNumericC - succ KeyNumericC = KeyNumericD - succ KeyNumericD = KeyCameraFocus - succ KeyCameraFocus = KeyWpsButton - succ KeyWpsButton = KeyTouchpadToggle - succ KeyTouchpadToggle = KeyTouchpadOn - succ KeyTouchpadOn = KeyTouchpadOff - succ KeyTouchpadOff = KeyCameraZoomin - succ KeyCameraZoomin = KeyCameraZoomout - succ KeyCameraZoomout = KeyCameraUp - succ KeyCameraUp = KeyCameraDown - succ KeyCameraDown = KeyCameraLeft - succ KeyCameraLeft = KeyCameraRight - succ KeyCameraRight = KeyAttendantOn - succ KeyAttendantOn = KeyAttendantOff - succ KeyAttendantOff = KeyAttendantToggle - succ KeyAttendantToggle = KeyLightsToggle - succ KeyLightsToggle = BtnDpadUp - succ BtnDpadUp = BtnDpadDown - succ BtnDpadDown = BtnDpadLeft - succ BtnDpadLeft = BtnDpadRight - succ BtnDpadRight = KeyAlsToggle - succ KeyAlsToggle = KeyButtonconfig - succ KeyButtonconfig = KeyTaskmanager - succ KeyTaskmanager = KeyJournal - succ KeyJournal = KeyControlpanel - succ KeyControlpanel = KeyAppselect - succ KeyAppselect = KeyScreensaver - succ KeyScreensaver = KeyVoicecommand - succ KeyVoicecommand = KeyBrightnessMin - succ KeyBrightnessMin = KeyBrightnessMax - succ KeyBrightnessMax = KeyKbdinputassistPrev - succ KeyKbdinputassistPrev = KeyKbdinputassistNext - succ KeyKbdinputassistNext = KeyKbdinputassistPrevgroup - succ KeyKbdinputassistPrevgroup = KeyKbdinputassistNextgroup - succ KeyKbdinputassistNextgroup = KeyKbdinputassistAccept - succ KeyKbdinputassistAccept = KeyKbdinputassistCancel - succ KeyKbdinputassistCancel = BtnTriggerHappy1 - succ BtnTriggerHappy1 = BtnTriggerHappy2 - succ BtnTriggerHappy2 = BtnTriggerHappy3 - succ BtnTriggerHappy3 = BtnTriggerHappy4 - succ BtnTriggerHappy4 = BtnTriggerHappy5 - succ BtnTriggerHappy5 = BtnTriggerHappy6 - succ BtnTriggerHappy6 = BtnTriggerHappy7 - succ BtnTriggerHappy7 = BtnTriggerHappy8 - succ BtnTriggerHappy8 = BtnTriggerHappy9 - succ BtnTriggerHappy9 = BtnTriggerHappy10 - succ BtnTriggerHappy10 = BtnTriggerHappy11 - succ BtnTriggerHappy11 = BtnTriggerHappy12 - succ BtnTriggerHappy12 = BtnTriggerHappy13 - succ BtnTriggerHappy13 = BtnTriggerHappy14 - succ BtnTriggerHappy14 = BtnTriggerHappy15 - succ BtnTriggerHappy15 = BtnTriggerHappy16 - succ BtnTriggerHappy16 = BtnTriggerHappy17 - succ BtnTriggerHappy17 = BtnTriggerHappy18 - succ BtnTriggerHappy18 = BtnTriggerHappy19 - succ BtnTriggerHappy19 = BtnTriggerHappy20 - succ BtnTriggerHappy20 = BtnTriggerHappy21 - succ BtnTriggerHappy21 = BtnTriggerHappy22 - succ BtnTriggerHappy22 = BtnTriggerHappy23 - succ BtnTriggerHappy23 = BtnTriggerHappy24 - succ BtnTriggerHappy24 = BtnTriggerHappy25 - succ BtnTriggerHappy25 = BtnTriggerHappy26 - succ BtnTriggerHappy26 = BtnTriggerHappy27 - succ BtnTriggerHappy27 = BtnTriggerHappy28 - succ BtnTriggerHappy28 = BtnTriggerHappy29 - succ BtnTriggerHappy29 = BtnTriggerHappy30 - succ BtnTriggerHappy30 = BtnTriggerHappy31 - succ BtnTriggerHappy31 = BtnTriggerHappy32 - succ BtnTriggerHappy32 = BtnTriggerHappy33 - succ BtnTriggerHappy33 = BtnTriggerHappy34 - succ BtnTriggerHappy34 = BtnTriggerHappy35 - succ BtnTriggerHappy35 = BtnTriggerHappy36 - succ BtnTriggerHappy36 = BtnTriggerHappy37 - succ BtnTriggerHappy37 = BtnTriggerHappy38 - succ BtnTriggerHappy38 = BtnTriggerHappy39 - succ BtnTriggerHappy39 = BtnTriggerHappy40 - succ BtnTriggerHappy40 = error "Key.succ: BtnTriggerHappy40 has no successor" - - pred KeyEsc = KeyReserved - pred Key1 = KeyEsc - pred Key2 = Key1 - pred Key3 = Key2 - pred Key4 = Key3 - pred Key5 = Key4 - pred Key6 = Key5 - pred Key7 = Key6 - pred Key8 = Key7 - pred Key9 = Key8 - pred Key0 = Key9 - pred KeyMinus = Key0 - pred KeyEqual = KeyMinus - pred KeyBackspace = KeyEqual - pred KeyTab = KeyBackspace - pred KeyQ = KeyTab - pred KeyW = KeyQ - pred KeyE = KeyW - pred KeyR = KeyE - pred KeyT = KeyR - pred KeyY = KeyT - pred KeyU = KeyY - pred KeyI = KeyU - pred KeyO = KeyI - pred KeyP = KeyO - pred KeyLeftbrace = KeyP - pred KeyRightbrace = KeyLeftbrace - pred KeyEnter = KeyRightbrace - pred KeyLeftctrl = KeyEnter - pred KeyA = KeyLeftctrl - pred KeyS = KeyA - pred KeyD = KeyS - pred KeyF = KeyD - pred KeyG = KeyF - pred KeyH = KeyG - pred KeyJ = KeyH - pred KeyK = KeyJ - pred KeyL = KeyK - pred KeySemicolon = KeyL - pred KeyApostrophe = KeySemicolon - pred KeyGrave = KeyApostrophe - pred KeyLeftshift = KeyGrave - pred KeyBackslash = KeyLeftshift - pred KeyZ = KeyBackslash - pred KeyX = KeyZ - pred KeyC = KeyX - pred KeyV = KeyC - pred KeyB = KeyV - pred KeyN = KeyB - pred KeyM = KeyN - pred KeyComma = KeyM - pred KeyDot = KeyComma - pred KeySlash = KeyDot - pred KeyRightshift = KeySlash - pred KeyKpasterisk = KeyRightshift - pred KeyLeftalt = KeyKpasterisk - pred KeySpace = KeyLeftalt - pred KeyCapslock = KeySpace - pred KeyF1 = KeyCapslock - pred KeyF2 = KeyF1 - pred KeyF3 = KeyF2 - pred KeyF4 = KeyF3 - pred KeyF5 = KeyF4 - pred KeyF6 = KeyF5 - pred KeyF7 = KeyF6 - pred KeyF8 = KeyF7 - pred KeyF9 = KeyF8 - pred KeyF10 = KeyF9 - pred KeyNumlock = KeyF10 - pred KeyScrolllock = KeyNumlock - pred KeyKp7 = KeyScrolllock - pred KeyKp8 = KeyKp7 - pred KeyKp9 = KeyKp8 - pred KeyKpminus = KeyKp9 - pred KeyKp4 = KeyKpminus - pred KeyKp5 = KeyKp4 - pred KeyKp6 = KeyKp5 - pred KeyKpplus = KeyKp6 - pred KeyKp1 = KeyKpplus - pred KeyKp2 = KeyKp1 - pred KeyKp3 = KeyKp2 - pred KeyKp0 = KeyKp3 - pred KeyKpdot = KeyKp0 - pred KeyZenkakuhankaku = KeyKpdot - pred Key102nd = KeyZenkakuhankaku - pred KeyF11 = Key102nd - pred KeyF12 = KeyF11 - pred KeyRo = KeyF12 - pred KeyKatakana = KeyRo - pred KeyHiragana = KeyKatakana - pred KeyHenkan = KeyHiragana - pred KeyKatakanahiragana = KeyHenkan - pred KeyMuhenkan = KeyKatakanahiragana - pred KeyKpjpcomma = KeyMuhenkan - pred KeyKpenter = KeyKpjpcomma - pred KeyRightctrl = KeyKpenter - pred KeyKpslash = KeyRightctrl - pred KeySysrq = KeyKpslash - pred KeyRightalt = KeySysrq - pred KeyLinefeed = KeyRightalt - pred KeyHome = KeyLinefeed - pred KeyUp = KeyHome - pred KeyPageup = KeyUp - pred KeyLeft = KeyPageup - pred KeyRight = KeyLeft - pred KeyEnd = KeyRight - pred KeyDown = KeyEnd - pred KeyPagedown = KeyDown - pred KeyInsert = KeyPagedown - pred KeyDelete = KeyInsert - pred KeyMacro = KeyDelete - pred KeyMute = KeyMacro - pred KeyVolumedown = KeyMute - pred KeyVolumeup = KeyVolumedown - pred KeyPower = KeyVolumeup - pred KeyKpequal = KeyPower - pred KeyKpplusminus = KeyKpequal - pred KeyPause = KeyKpplusminus - pred KeyScale = KeyPause - pred KeyKpcomma = KeyScale - pred KeyHangeul = KeyKpcomma - pred KeyHanja = KeyHangeul - pred KeyYen = KeyHanja - pred KeyLeftmeta = KeyYen - pred KeyRightmeta = KeyLeftmeta - pred KeyCompose = KeyRightmeta - pred KeyStop = KeyCompose - pred KeyAgain = KeyStop - pred KeyProps = KeyAgain - pred KeyUndo = KeyProps - pred KeyFront = KeyUndo - pred KeyCopy = KeyFront - pred KeyOpen = KeyCopy - pred KeyPaste = KeyOpen - pred KeyFind = KeyPaste - pred KeyCut = KeyFind - pred KeyHelp = KeyCut - pred KeyMenu = KeyHelp - pred KeyCalc = KeyMenu - pred KeySetup = KeyCalc - pred KeySleep = KeySetup - pred KeyWakeup = KeySleep - pred KeyFile = KeyWakeup - pred KeySendfile = KeyFile - pred KeyDeletefile = KeySendfile - pred KeyXfer = KeyDeletefile - pred KeyProg1 = KeyXfer - pred KeyProg2 = KeyProg1 - pred KeyWww = KeyProg2 - pred KeyMsdos = KeyWww - pred KeyScreenlock = KeyMsdos - pred KeyRotateDisplay = KeyScreenlock - pred KeyCyclewindows = KeyRotateDisplay - pred KeyMail = KeyCyclewindows - pred KeyBookmarks = KeyMail - pred KeyComputer = KeyBookmarks - pred KeyBack = KeyComputer - pred KeyForward = KeyBack - pred KeyClosecd = KeyForward - pred KeyEjectcd = KeyClosecd - pred KeyEjectclosecd = KeyEjectcd - pred KeyNextsong = KeyEjectclosecd - pred KeyPlaypause = KeyNextsong - pred KeyPrevioussong = KeyPlaypause - pred KeyStopcd = KeyPrevioussong - pred KeyRecord = KeyStopcd - pred KeyRewind = KeyRecord - pred KeyPhone = KeyRewind - pred KeyIso = KeyPhone - pred KeyConfig = KeyIso - pred KeyHomepage = KeyConfig - pred KeyRefresh = KeyHomepage - pred KeyExit = KeyRefresh - pred KeyMove = KeyExit - pred KeyEdit = KeyMove - pred KeyScrollup = KeyEdit - pred KeyScrolldown = KeyScrollup - pred KeyKpleftparen = KeyScrolldown - pred KeyKprightparen = KeyKpleftparen - pred KeyNew = KeyKprightparen - pred KeyRedo = KeyNew - pred KeyF13 = KeyRedo - pred KeyF14 = KeyF13 - pred KeyF15 = KeyF14 - pred KeyF16 = KeyF15 - pred KeyF17 = KeyF16 - pred KeyF18 = KeyF17 - pred KeyF19 = KeyF18 - pred KeyF20 = KeyF19 - pred KeyF21 = KeyF20 - pred KeyF22 = KeyF21 - pred KeyF23 = KeyF22 - pred KeyF24 = KeyF23 - pred KeyPlaycd = KeyF24 - pred KeyPausecd = KeyPlaycd - pred KeyProg3 = KeyPausecd - pred KeyProg4 = KeyProg3 - pred KeyDashboard = KeyProg4 - pred KeySuspend = KeyDashboard - pred KeyClose = KeySuspend - pred KeyPlay = KeyClose - pred KeyFastforward = KeyPlay - pred KeyBassboost = KeyFastforward - pred KeyPrint = KeyBassboost - pred KeyHp = KeyPrint - pred KeyCamera = KeyHp - pred KeySound = KeyCamera - pred KeyQuestion = KeySound - pred KeyEmail = KeyQuestion - pred KeyChat = KeyEmail - pred KeySearch = KeyChat - pred KeyConnect = KeySearch - pred KeyFinance = KeyConnect - pred KeySport = KeyFinance - pred KeyShop = KeySport - pred KeyAlterase = KeyShop - pred KeyCancel = KeyAlterase - pred KeyBrightnessdown = KeyCancel - pred KeyBrightnessup = KeyBrightnessdown - pred KeyMedia = KeyBrightnessup - pred KeySwitchvideomode = KeyMedia - pred KeyKbdillumtoggle = KeySwitchvideomode - pred KeyKbdillumdown = KeyKbdillumtoggle - pred KeyKbdillumup = KeyKbdillumdown - pred KeySend = KeyKbdillumup - pred KeyReply = KeySend - pred KeyForwardmail = KeyReply - pred KeySave = KeyForwardmail - pred KeyDocuments = KeySave - pred KeyBattery = KeyDocuments - pred KeyBluetooth = KeyBattery - pred KeyWlan = KeyBluetooth - pred KeyUwb = KeyWlan - pred KeyUnknown = KeyUwb - pred KeyVideoNext = KeyUnknown - pred KeyVideoPrev = KeyVideoNext - pred KeyBrightnessCycle = KeyVideoPrev - pred KeyBrightnessAuto = KeyBrightnessCycle - pred KeyDisplayOff = KeyBrightnessAuto - pred KeyWwan = KeyDisplayOff - pred KeyRfkill = KeyWwan - pred KeyMicmute = KeyRfkill - pred Btn0 = KeyMicmute - pred Btn1 = Btn0 - pred Btn2 = Btn1 - pred Btn3 = Btn2 - pred Btn4 = Btn3 - pred Btn5 = Btn4 - pred Btn6 = Btn5 - pred Btn7 = Btn6 - pred Btn8 = Btn7 - pred Btn9 = Btn8 - pred BtnLeft = Btn9 - pred BtnRight = BtnLeft - pred BtnMiddle = BtnRight - pred BtnSide = BtnMiddle - pred BtnExtra = BtnSide - pred BtnForward = BtnExtra - pred BtnBack = BtnForward - pred BtnTask = BtnBack - pred BtnJoystick = BtnTask - pred BtnThumb = BtnJoystick - pred BtnThumb2 = BtnThumb - pred BtnTop = BtnThumb2 - pred BtnTop2 = BtnTop - pred BtnPinkie = BtnTop2 - pred BtnBase = BtnPinkie - pred BtnBase2 = BtnBase - pred BtnBase3 = BtnBase2 - pred BtnBase4 = BtnBase3 - pred BtnBase5 = BtnBase4 - pred BtnBase6 = BtnBase5 - pred BtnDead = BtnBase6 - pred BtnA = BtnDead - pred BtnB = BtnA - pred BtnC = BtnB - pred BtnX = BtnC - pred BtnY = BtnX - pred BtnZ = BtnY - pred BtnTl = BtnZ - pred BtnTr = BtnTl - pred BtnTl2 = BtnTr - pred BtnTr2 = BtnTl2 - pred BtnSelect = BtnTr2 - pred BtnStart = BtnSelect - pred BtnMode = BtnStart - pred BtnThumbl = BtnMode - pred BtnThumbr = BtnThumbl - pred BtnToolPen = BtnThumbr - pred BtnToolRubber = BtnToolPen - pred BtnToolBrush = BtnToolRubber - pred BtnToolPencil = BtnToolBrush - pred BtnToolAirbrush = BtnToolPencil - pred BtnToolFinger = BtnToolAirbrush - pred BtnToolMouse = BtnToolFinger - pred BtnToolLens = BtnToolMouse - pred BtnToolQuinttap = BtnToolLens - pred BtnTouch = BtnToolQuinttap - pred BtnStylus = BtnTouch - pred BtnStylus2 = BtnStylus - pred BtnToolDoubletap = BtnStylus2 - pred BtnToolTripletap = BtnToolDoubletap - pred BtnToolQuadtap = BtnToolTripletap - pred BtnGearDown = BtnToolQuadtap - pred BtnGearUp = BtnGearDown - pred KeyOk = BtnGearUp - pred KeySelect = KeyOk - pred KeyGoto = KeySelect - pred KeyClear = KeyGoto - pred KeyPower2 = KeyClear - pred KeyOption = KeyPower2 - pred KeyInfo = KeyOption - pred KeyTime = KeyInfo - pred KeyVendor = KeyTime - pred KeyArchive = KeyVendor - pred KeyProgram = KeyArchive - pred KeyChannel = KeyProgram - pred KeyFavorites = KeyChannel - pred KeyEpg = KeyFavorites - pred KeyPvr = KeyEpg - pred KeyMhp = KeyPvr - pred KeyLanguage = KeyMhp - pred KeyTitle = KeyLanguage - pred KeySubtitle = KeyTitle - pred KeyAngle = KeySubtitle - pred KeyZoom = KeyAngle - pred KeyMode = KeyZoom - pred KeyKeyboard = KeyMode - pred KeyScreen = KeyKeyboard - pred KeyPc = KeyScreen - pred KeyTv = KeyPc - pred KeyTv2 = KeyTv - pred KeyVcr = KeyTv2 - pred KeyVcr2 = KeyVcr - pred KeySat = KeyVcr2 - pred KeySat2 = KeySat - pred KeyCd = KeySat2 - pred KeyTape = KeyCd - pred KeyRadio = KeyTape - pred KeyTuner = KeyRadio - pred KeyPlayer = KeyTuner - pred KeyText = KeyPlayer - pred KeyDvd = KeyText - pred KeyAux = KeyDvd - pred KeyMp3 = KeyAux - pred KeyAudio = KeyMp3 - pred KeyVideo = KeyAudio - pred KeyDirectory = KeyVideo - pred KeyList = KeyDirectory - pred KeyMemo = KeyList - pred KeyCalendar = KeyMemo - pred KeyRed = KeyCalendar - pred KeyGreen = KeyRed - pred KeyYellow = KeyGreen - pred KeyBlue = KeyYellow - pred KeyChannelup = KeyBlue - pred KeyChanneldown = KeyChannelup - pred KeyFirst = KeyChanneldown - pred KeyLast = KeyFirst - pred KeyAb = KeyLast - pred KeyNext = KeyAb - pred KeyRestart = KeyNext - pred KeySlow = KeyRestart - pred KeyShuffle = KeySlow - pred KeyBreak = KeyShuffle - pred KeyPrevious = KeyBreak - pred KeyDigits = KeyPrevious - pred KeyTeen = KeyDigits - pred KeyTwen = KeyTeen - pred KeyVideophone = KeyTwen - pred KeyGames = KeyVideophone - pred KeyZoomin = KeyGames - pred KeyZoomout = KeyZoomin - pred KeyZoomreset = KeyZoomout - pred KeyWordprocessor = KeyZoomreset - pred KeyEditor = KeyWordprocessor - pred KeySpreadsheet = KeyEditor - pred KeyGraphicseditor = KeySpreadsheet - pred KeyPresentation = KeyGraphicseditor - pred KeyDatabase = KeyPresentation - pred KeyNews = KeyDatabase - pred KeyVoicemail = KeyNews - pred KeyAddressbook = KeyVoicemail - pred KeyMessenger = KeyAddressbook - pred KeyDisplaytoggle = KeyMessenger - pred KeySpellcheck = KeyDisplaytoggle - pred KeyLogoff = KeySpellcheck - pred KeyDollar = KeyLogoff - pred KeyEuro = KeyDollar - pred KeyFrameback = KeyEuro - pred KeyFrameforward = KeyFrameback - pred KeyContextMenu = KeyFrameforward - pred KeyMediaRepeat = KeyContextMenu - pred Key10channelsup = KeyMediaRepeat - pred Key10channelsdown = Key10channelsup - pred KeyImages = Key10channelsdown - pred KeyDelEol = KeyImages - pred KeyDelEos = KeyDelEol - pred KeyInsLine = KeyDelEos - pred KeyDelLine = KeyInsLine - pred KeyFn = KeyDelLine - pred KeyFnEsc = KeyFn - pred KeyFnF1 = KeyFnEsc - pred KeyFnF2 = KeyFnF1 - pred KeyFnF3 = KeyFnF2 - pred KeyFnF4 = KeyFnF3 - pred KeyFnF5 = KeyFnF4 - pred KeyFnF6 = KeyFnF5 - pred KeyFnF7 = KeyFnF6 - pred KeyFnF8 = KeyFnF7 - pred KeyFnF9 = KeyFnF8 - pred KeyFnF10 = KeyFnF9 - pred KeyFnF11 = KeyFnF10 - pred KeyFnF12 = KeyFnF11 - pred KeyFn1 = KeyFnF12 - pred KeyFn2 = KeyFn1 - pred KeyFnD = KeyFn2 - pred KeyFnE = KeyFnD - pred KeyFnF = KeyFnE - pred KeyFnS = KeyFnF - pred KeyFnB = KeyFnS - pred KeyBrlDot1 = KeyFnB - pred KeyBrlDot2 = KeyBrlDot1 - pred KeyBrlDot3 = KeyBrlDot2 - pred KeyBrlDot4 = KeyBrlDot3 - pred KeyBrlDot5 = KeyBrlDot4 - pred KeyBrlDot6 = KeyBrlDot5 - pred KeyBrlDot7 = KeyBrlDot6 - pred KeyBrlDot8 = KeyBrlDot7 - pred KeyBrlDot9 = KeyBrlDot8 - pred KeyBrlDot10 = KeyBrlDot9 - pred KeyNumeric0 = KeyBrlDot10 - pred KeyNumeric1 = KeyNumeric0 - pred KeyNumeric2 = KeyNumeric1 - pred KeyNumeric3 = KeyNumeric2 - pred KeyNumeric4 = KeyNumeric3 - pred KeyNumeric5 = KeyNumeric4 - pred KeyNumeric6 = KeyNumeric5 - pred KeyNumeric7 = KeyNumeric6 - pred KeyNumeric8 = KeyNumeric7 - pred KeyNumeric9 = KeyNumeric8 - pred KeyNumericStar = KeyNumeric9 - pred KeyNumericPound = KeyNumericStar - pred KeyNumericA = KeyNumericPound - pred KeyNumericB = KeyNumericA - pred KeyNumericC = KeyNumericB - pred KeyNumericD = KeyNumericC - pred KeyCameraFocus = KeyNumericD - pred KeyWpsButton = KeyCameraFocus - pred KeyTouchpadToggle = KeyWpsButton - pred KeyTouchpadOn = KeyTouchpadToggle - pred KeyTouchpadOff = KeyTouchpadOn - pred KeyCameraZoomin = KeyTouchpadOff - pred KeyCameraZoomout = KeyCameraZoomin - pred KeyCameraUp = KeyCameraZoomout - pred KeyCameraDown = KeyCameraUp - pred KeyCameraLeft = KeyCameraDown - pred KeyCameraRight = KeyCameraLeft - pred KeyAttendantOn = KeyCameraRight - pred KeyAttendantOff = KeyAttendantOn - pred KeyAttendantToggle = KeyAttendantOff - pred KeyLightsToggle = KeyAttendantToggle - pred BtnDpadUp = KeyLightsToggle - pred BtnDpadDown = BtnDpadUp - pred BtnDpadLeft = BtnDpadDown - pred BtnDpadRight = BtnDpadLeft - pred KeyAlsToggle = BtnDpadRight - pred KeyButtonconfig = KeyAlsToggle - pred KeyTaskmanager = KeyButtonconfig - pred KeyJournal = KeyTaskmanager - pred KeyControlpanel = KeyJournal - pred KeyAppselect = KeyControlpanel - pred KeyScreensaver = KeyAppselect - pred KeyVoicecommand = KeyScreensaver - pred KeyBrightnessMin = KeyVoicecommand - pred KeyBrightnessMax = KeyBrightnessMin - pred KeyKbdinputassistPrev = KeyBrightnessMax - pred KeyKbdinputassistNext = KeyKbdinputassistPrev - pred KeyKbdinputassistPrevgroup = KeyKbdinputassistNext - pred KeyKbdinputassistNextgroup = KeyKbdinputassistPrevgroup - pred KeyKbdinputassistAccept = KeyKbdinputassistNextgroup - pred KeyKbdinputassistCancel = KeyKbdinputassistAccept - pred BtnTriggerHappy1 = KeyKbdinputassistCancel - pred BtnTriggerHappy2 = BtnTriggerHappy1 - pred BtnTriggerHappy3 = BtnTriggerHappy2 - pred BtnTriggerHappy4 = BtnTriggerHappy3 - pred BtnTriggerHappy5 = BtnTriggerHappy4 - pred BtnTriggerHappy6 = BtnTriggerHappy5 - pred BtnTriggerHappy7 = BtnTriggerHappy6 - pred BtnTriggerHappy8 = BtnTriggerHappy7 - pred BtnTriggerHappy9 = BtnTriggerHappy8 - pred BtnTriggerHappy10 = BtnTriggerHappy9 - pred BtnTriggerHappy11 = BtnTriggerHappy10 - pred BtnTriggerHappy12 = BtnTriggerHappy11 - pred BtnTriggerHappy13 = BtnTriggerHappy12 - pred BtnTriggerHappy14 = BtnTriggerHappy13 - pred BtnTriggerHappy15 = BtnTriggerHappy14 - pred BtnTriggerHappy16 = BtnTriggerHappy15 - pred BtnTriggerHappy17 = BtnTriggerHappy16 - pred BtnTriggerHappy18 = BtnTriggerHappy17 - pred BtnTriggerHappy19 = BtnTriggerHappy18 - pred BtnTriggerHappy20 = BtnTriggerHappy19 - pred BtnTriggerHappy21 = BtnTriggerHappy20 - pred BtnTriggerHappy22 = BtnTriggerHappy21 - pred BtnTriggerHappy23 = BtnTriggerHappy22 - pred BtnTriggerHappy24 = BtnTriggerHappy23 - pred BtnTriggerHappy25 = BtnTriggerHappy24 - pred BtnTriggerHappy26 = BtnTriggerHappy25 - pred BtnTriggerHappy27 = BtnTriggerHappy26 - pred BtnTriggerHappy28 = BtnTriggerHappy27 - pred BtnTriggerHappy29 = BtnTriggerHappy28 - pred BtnTriggerHappy30 = BtnTriggerHappy29 - pred BtnTriggerHappy31 = BtnTriggerHappy30 - pred BtnTriggerHappy32 = BtnTriggerHappy31 - pred BtnTriggerHappy33 = BtnTriggerHappy32 - pred BtnTriggerHappy34 = BtnTriggerHappy33 - pred BtnTriggerHappy35 = BtnTriggerHappy34 - pred BtnTriggerHappy36 = BtnTriggerHappy35 - pred BtnTriggerHappy37 = BtnTriggerHappy36 - pred BtnTriggerHappy38 = BtnTriggerHappy37 - pred BtnTriggerHappy39 = BtnTriggerHappy38 - pred BtnTriggerHappy40 = BtnTriggerHappy39 - pred KeyReserved = error "Key.pred: KeyReserved has no predecessor" - - enumFromTo from to = go from - where - end = fromEnum to - go v = case compare (fromEnum v) end of - LT -> v : go (succ v) - EQ -> [v] - GT -> [] - - enumFrom from = enumFromTo from BtnTriggerHappy40 - - fromEnum KeyReserved = 0 - fromEnum KeyEsc = 1 - fromEnum Key1 = 2 - fromEnum Key2 = 3 - fromEnum Key3 = 4 - fromEnum Key4 = 5 - fromEnum Key5 = 6 - fromEnum Key6 = 7 - fromEnum Key7 = 8 - fromEnum Key8 = 9 - fromEnum Key9 = 10 - fromEnum Key0 = 11 - fromEnum KeyMinus = 12 - fromEnum KeyEqual = 13 - fromEnum KeyBackspace = 14 - fromEnum KeyTab = 15 - fromEnum KeyQ = 16 - fromEnum KeyW = 17 - fromEnum KeyE = 18 - fromEnum KeyR = 19 - fromEnum KeyT = 20 - fromEnum KeyY = 21 - fromEnum KeyU = 22 - fromEnum KeyI = 23 - fromEnum KeyO = 24 - fromEnum KeyP = 25 - fromEnum KeyLeftbrace = 26 - fromEnum KeyRightbrace = 27 - fromEnum KeyEnter = 28 - fromEnum KeyLeftctrl = 29 - fromEnum KeyA = 30 - fromEnum KeyS = 31 - fromEnum KeyD = 32 - fromEnum KeyF = 33 - fromEnum KeyG = 34 - fromEnum KeyH = 35 - fromEnum KeyJ = 36 - fromEnum KeyK = 37 - fromEnum KeyL = 38 - fromEnum KeySemicolon = 39 - fromEnum KeyApostrophe = 40 - fromEnum KeyGrave = 41 - fromEnum KeyLeftshift = 42 - fromEnum KeyBackslash = 43 - fromEnum KeyZ = 44 - fromEnum KeyX = 45 - fromEnum KeyC = 46 - fromEnum KeyV = 47 - fromEnum KeyB = 48 - fromEnum KeyN = 49 - fromEnum KeyM = 50 - fromEnum KeyComma = 51 - fromEnum KeyDot = 52 - fromEnum KeySlash = 53 - fromEnum KeyRightshift = 54 - fromEnum KeyKpasterisk = 55 - fromEnum KeyLeftalt = 56 - fromEnum KeySpace = 57 - fromEnum KeyCapslock = 58 - fromEnum KeyF1 = 59 - fromEnum KeyF2 = 60 - fromEnum KeyF3 = 61 - fromEnum KeyF4 = 62 - fromEnum KeyF5 = 63 - fromEnum KeyF6 = 64 - fromEnum KeyF7 = 65 - fromEnum KeyF8 = 66 - fromEnum KeyF9 = 67 - fromEnum KeyF10 = 68 - fromEnum KeyNumlock = 69 - fromEnum KeyScrolllock = 70 - fromEnum KeyKp7 = 71 - fromEnum KeyKp8 = 72 - fromEnum KeyKp9 = 73 - fromEnum KeyKpminus = 74 - fromEnum KeyKp4 = 75 - fromEnum KeyKp5 = 76 - fromEnum KeyKp6 = 77 - fromEnum KeyKpplus = 78 - fromEnum KeyKp1 = 79 - fromEnum KeyKp2 = 80 - fromEnum KeyKp3 = 81 - fromEnum KeyKp0 = 82 - fromEnum KeyKpdot = 83 - fromEnum KeyZenkakuhankaku = 85 - fromEnum Key102nd = 86 - fromEnum KeyF11 = 87 - fromEnum KeyF12 = 88 - fromEnum KeyRo = 89 - fromEnum KeyKatakana = 90 - fromEnum KeyHiragana = 91 - fromEnum KeyHenkan = 92 - fromEnum KeyKatakanahiragana = 93 - fromEnum KeyMuhenkan = 94 - fromEnum KeyKpjpcomma = 95 - fromEnum KeyKpenter = 96 - fromEnum KeyRightctrl = 97 - fromEnum KeyKpslash = 98 - fromEnum KeySysrq = 99 - fromEnum KeyRightalt = 100 - fromEnum KeyLinefeed = 101 - fromEnum KeyHome = 102 - fromEnum KeyUp = 103 - fromEnum KeyPageup = 104 - fromEnum KeyLeft = 105 - fromEnum KeyRight = 106 - fromEnum KeyEnd = 107 - fromEnum KeyDown = 108 - fromEnum KeyPagedown = 109 - fromEnum KeyInsert = 110 - fromEnum KeyDelete = 111 - fromEnum KeyMacro = 112 - fromEnum KeyMute = 113 - fromEnum KeyVolumedown = 114 - fromEnum KeyVolumeup = 115 - fromEnum KeyPower = 116 - fromEnum KeyKpequal = 117 - fromEnum KeyKpplusminus = 118 - fromEnum KeyPause = 119 - fromEnum KeyScale = 120 - fromEnum KeyKpcomma = 121 - fromEnum KeyHangeul = 122 - fromEnum KeyHanja = 123 - fromEnum KeyYen = 124 - fromEnum KeyLeftmeta = 125 - fromEnum KeyRightmeta = 126 - fromEnum KeyCompose = 127 - fromEnum KeyStop = 128 - fromEnum KeyAgain = 129 - fromEnum KeyProps = 130 - fromEnum KeyUndo = 131 - fromEnum KeyFront = 132 - fromEnum KeyCopy = 133 - fromEnum KeyOpen = 134 - fromEnum KeyPaste = 135 - fromEnum KeyFind = 136 - fromEnum KeyCut = 137 - fromEnum KeyHelp = 138 - fromEnum KeyMenu = 139 - fromEnum KeyCalc = 140 - fromEnum KeySetup = 141 - fromEnum KeySleep = 142 - fromEnum KeyWakeup = 143 - fromEnum KeyFile = 144 - fromEnum KeySendfile = 145 - fromEnum KeyDeletefile = 146 - fromEnum KeyXfer = 147 - fromEnum KeyProg1 = 148 - fromEnum KeyProg2 = 149 - fromEnum KeyWww = 150 - fromEnum KeyMsdos = 151 - fromEnum KeyScreenlock = 152 - fromEnum KeyRotateDisplay = 153 - fromEnum KeyCyclewindows = 154 - fromEnum KeyMail = 155 - fromEnum KeyBookmarks = 156 - fromEnum KeyComputer = 157 - fromEnum KeyBack = 158 - fromEnum KeyForward = 159 - fromEnum KeyClosecd = 160 - fromEnum KeyEjectcd = 161 - fromEnum KeyEjectclosecd = 162 - fromEnum KeyNextsong = 163 - fromEnum KeyPlaypause = 164 - fromEnum KeyPrevioussong = 165 - fromEnum KeyStopcd = 166 - fromEnum KeyRecord = 167 - fromEnum KeyRewind = 168 - fromEnum KeyPhone = 169 - fromEnum KeyIso = 170 - fromEnum KeyConfig = 171 - fromEnum KeyHomepage = 172 - fromEnum KeyRefresh = 173 - fromEnum KeyExit = 174 - fromEnum KeyMove = 175 - fromEnum KeyEdit = 176 - fromEnum KeyScrollup = 177 - fromEnum KeyScrolldown = 178 - fromEnum KeyKpleftparen = 179 - fromEnum KeyKprightparen = 180 - fromEnum KeyNew = 181 - fromEnum KeyRedo = 182 - fromEnum KeyF13 = 183 - fromEnum KeyF14 = 184 - fromEnum KeyF15 = 185 - fromEnum KeyF16 = 186 - fromEnum KeyF17 = 187 - fromEnum KeyF18 = 188 - fromEnum KeyF19 = 189 - fromEnum KeyF20 = 190 - fromEnum KeyF21 = 191 - fromEnum KeyF22 = 192 - fromEnum KeyF23 = 193 - fromEnum KeyF24 = 194 - fromEnum KeyPlaycd = 200 - fromEnum KeyPausecd = 201 - fromEnum KeyProg3 = 202 - fromEnum KeyProg4 = 203 - fromEnum KeyDashboard = 204 - fromEnum KeySuspend = 205 - fromEnum KeyClose = 206 - fromEnum KeyPlay = 207 - fromEnum KeyFastforward = 208 - fromEnum KeyBassboost = 209 - fromEnum KeyPrint = 210 - fromEnum KeyHp = 211 - fromEnum KeyCamera = 212 - fromEnum KeySound = 213 - fromEnum KeyQuestion = 214 - fromEnum KeyEmail = 215 - fromEnum KeyChat = 216 - fromEnum KeySearch = 217 - fromEnum KeyConnect = 218 - fromEnum KeyFinance = 219 - fromEnum KeySport = 220 - fromEnum KeyShop = 221 - fromEnum KeyAlterase = 222 - fromEnum KeyCancel = 223 - fromEnum KeyBrightnessdown = 224 - fromEnum KeyBrightnessup = 225 - fromEnum KeyMedia = 226 - fromEnum KeySwitchvideomode = 227 - fromEnum KeyKbdillumtoggle = 228 - fromEnum KeyKbdillumdown = 229 - fromEnum KeyKbdillumup = 230 - fromEnum KeySend = 231 - fromEnum KeyReply = 232 - fromEnum KeyForwardmail = 233 - fromEnum KeySave = 234 - fromEnum KeyDocuments = 235 - fromEnum KeyBattery = 236 - fromEnum KeyBluetooth = 237 - fromEnum KeyWlan = 238 - fromEnum KeyUwb = 239 - fromEnum KeyUnknown = 240 - fromEnum KeyVideoNext = 241 - fromEnum KeyVideoPrev = 242 - fromEnum KeyBrightnessCycle = 243 - fromEnum KeyBrightnessAuto = 244 - fromEnum KeyDisplayOff = 245 - fromEnum KeyWwan = 246 - fromEnum KeyRfkill = 247 - fromEnum KeyMicmute = 248 - fromEnum Btn0 = 256 - fromEnum Btn1 = 257 - fromEnum Btn2 = 258 - fromEnum Btn3 = 259 - fromEnum Btn4 = 260 - fromEnum Btn5 = 261 - fromEnum Btn6 = 262 - fromEnum Btn7 = 263 - fromEnum Btn8 = 264 - fromEnum Btn9 = 265 - fromEnum BtnLeft = 272 - fromEnum BtnRight = 273 - fromEnum BtnMiddle = 274 - fromEnum BtnSide = 275 - fromEnum BtnExtra = 276 - fromEnum BtnForward = 277 - fromEnum BtnBack = 278 - fromEnum BtnTask = 279 - fromEnum BtnJoystick = 288 - fromEnum BtnThumb = 289 - fromEnum BtnThumb2 = 290 - fromEnum BtnTop = 291 - fromEnum BtnTop2 = 292 - fromEnum BtnPinkie = 293 - fromEnum BtnBase = 294 - fromEnum BtnBase2 = 295 - fromEnum BtnBase3 = 296 - fromEnum BtnBase4 = 297 - fromEnum BtnBase5 = 298 - fromEnum BtnBase6 = 299 - fromEnum BtnDead = 303 - fromEnum BtnA = 304 - fromEnum BtnB = 305 - fromEnum BtnC = 306 - fromEnum BtnX = 307 - fromEnum BtnY = 308 - fromEnum BtnZ = 309 - fromEnum BtnTl = 310 - fromEnum BtnTr = 311 - fromEnum BtnTl2 = 312 - fromEnum BtnTr2 = 313 - fromEnum BtnSelect = 314 - fromEnum BtnStart = 315 - fromEnum BtnMode = 316 - fromEnum BtnThumbl = 317 - fromEnum BtnThumbr = 318 - fromEnum BtnToolPen = 320 - fromEnum BtnToolRubber = 321 - fromEnum BtnToolBrush = 322 - fromEnum BtnToolPencil = 323 - fromEnum BtnToolAirbrush = 324 - fromEnum BtnToolFinger = 325 - fromEnum BtnToolMouse = 326 - fromEnum BtnToolLens = 327 - fromEnum BtnToolQuinttap = 328 - fromEnum BtnTouch = 330 - fromEnum BtnStylus = 331 - fromEnum BtnStylus2 = 332 - fromEnum BtnToolDoubletap = 333 - fromEnum BtnToolTripletap = 334 - fromEnum BtnToolQuadtap = 335 - fromEnum BtnGearDown = 336 - fromEnum BtnGearUp = 337 - fromEnum KeyOk = 352 - fromEnum KeySelect = 353 - fromEnum KeyGoto = 354 - fromEnum KeyClear = 355 - fromEnum KeyPower2 = 356 - fromEnum KeyOption = 357 - fromEnum KeyInfo = 358 - fromEnum KeyTime = 359 - fromEnum KeyVendor = 360 - fromEnum KeyArchive = 361 - fromEnum KeyProgram = 362 - fromEnum KeyChannel = 363 - fromEnum KeyFavorites = 364 - fromEnum KeyEpg = 365 - fromEnum KeyPvr = 366 - fromEnum KeyMhp = 367 - fromEnum KeyLanguage = 368 - fromEnum KeyTitle = 369 - fromEnum KeySubtitle = 370 - fromEnum KeyAngle = 371 - fromEnum KeyZoom = 372 - fromEnum KeyMode = 373 - fromEnum KeyKeyboard = 374 - fromEnum KeyScreen = 375 - fromEnum KeyPc = 376 - fromEnum KeyTv = 377 - fromEnum KeyTv2 = 378 - fromEnum KeyVcr = 379 - fromEnum KeyVcr2 = 380 - fromEnum KeySat = 381 - fromEnum KeySat2 = 382 - fromEnum KeyCd = 383 - fromEnum KeyTape = 384 - fromEnum KeyRadio = 385 - fromEnum KeyTuner = 386 - fromEnum KeyPlayer = 387 - fromEnum KeyText = 388 - fromEnum KeyDvd = 389 - fromEnum KeyAux = 390 - fromEnum KeyMp3 = 391 - fromEnum KeyAudio = 392 - fromEnum KeyVideo = 393 - fromEnum KeyDirectory = 394 - fromEnum KeyList = 395 - fromEnum KeyMemo = 396 - fromEnum KeyCalendar = 397 - fromEnum KeyRed = 398 - fromEnum KeyGreen = 399 - fromEnum KeyYellow = 400 - fromEnum KeyBlue = 401 - fromEnum KeyChannelup = 402 - fromEnum KeyChanneldown = 403 - fromEnum KeyFirst = 404 - fromEnum KeyLast = 405 - fromEnum KeyAb = 406 - fromEnum KeyNext = 407 - fromEnum KeyRestart = 408 - fromEnum KeySlow = 409 - fromEnum KeyShuffle = 410 - fromEnum KeyBreak = 411 - fromEnum KeyPrevious = 412 - fromEnum KeyDigits = 413 - fromEnum KeyTeen = 414 - fromEnum KeyTwen = 415 - fromEnum KeyVideophone = 416 - fromEnum KeyGames = 417 - fromEnum KeyZoomin = 418 - fromEnum KeyZoomout = 419 - fromEnum KeyZoomreset = 420 - fromEnum KeyWordprocessor = 421 - fromEnum KeyEditor = 422 - fromEnum KeySpreadsheet = 423 - fromEnum KeyGraphicseditor = 424 - fromEnum KeyPresentation = 425 - fromEnum KeyDatabase = 426 - fromEnum KeyNews = 427 - fromEnum KeyVoicemail = 428 - fromEnum KeyAddressbook = 429 - fromEnum KeyMessenger = 430 - fromEnum KeyDisplaytoggle = 431 - fromEnum KeySpellcheck = 432 - fromEnum KeyLogoff = 433 - fromEnum KeyDollar = 434 - fromEnum KeyEuro = 435 - fromEnum KeyFrameback = 436 - fromEnum KeyFrameforward = 437 - fromEnum KeyContextMenu = 438 - fromEnum KeyMediaRepeat = 439 - fromEnum Key10channelsup = 440 - fromEnum Key10channelsdown = 441 - fromEnum KeyImages = 442 - fromEnum KeyDelEol = 448 - fromEnum KeyDelEos = 449 - fromEnum KeyInsLine = 450 - fromEnum KeyDelLine = 451 - fromEnum KeyFn = 464 - fromEnum KeyFnEsc = 465 - fromEnum KeyFnF1 = 466 - fromEnum KeyFnF2 = 467 - fromEnum KeyFnF3 = 468 - fromEnum KeyFnF4 = 469 - fromEnum KeyFnF5 = 470 - fromEnum KeyFnF6 = 471 - fromEnum KeyFnF7 = 472 - fromEnum KeyFnF8 = 473 - fromEnum KeyFnF9 = 474 - fromEnum KeyFnF10 = 475 - fromEnum KeyFnF11 = 476 - fromEnum KeyFnF12 = 477 - fromEnum KeyFn1 = 478 - fromEnum KeyFn2 = 479 - fromEnum KeyFnD = 480 - fromEnum KeyFnE = 481 - fromEnum KeyFnF = 482 - fromEnum KeyFnS = 483 - fromEnum KeyFnB = 484 - fromEnum KeyBrlDot1 = 497 - fromEnum KeyBrlDot2 = 498 - fromEnum KeyBrlDot3 = 499 - fromEnum KeyBrlDot4 = 500 - fromEnum KeyBrlDot5 = 501 - fromEnum KeyBrlDot6 = 502 - fromEnum KeyBrlDot7 = 503 - fromEnum KeyBrlDot8 = 504 - fromEnum KeyBrlDot9 = 505 - fromEnum KeyBrlDot10 = 506 - fromEnum KeyNumeric0 = 512 - fromEnum KeyNumeric1 = 513 - fromEnum KeyNumeric2 = 514 - fromEnum KeyNumeric3 = 515 - fromEnum KeyNumeric4 = 516 - fromEnum KeyNumeric5 = 517 - fromEnum KeyNumeric6 = 518 - fromEnum KeyNumeric7 = 519 - fromEnum KeyNumeric8 = 520 - fromEnum KeyNumeric9 = 521 - fromEnum KeyNumericStar = 522 - fromEnum KeyNumericPound = 523 - fromEnum KeyNumericA = 524 - fromEnum KeyNumericB = 525 - fromEnum KeyNumericC = 526 - fromEnum KeyNumericD = 527 - fromEnum KeyCameraFocus = 528 - fromEnum KeyWpsButton = 529 - fromEnum KeyTouchpadToggle = 530 - fromEnum KeyTouchpadOn = 531 - fromEnum KeyTouchpadOff = 532 - fromEnum KeyCameraZoomin = 533 - fromEnum KeyCameraZoomout = 534 - fromEnum KeyCameraUp = 535 - fromEnum KeyCameraDown = 536 - fromEnum KeyCameraLeft = 537 - fromEnum KeyCameraRight = 538 - fromEnum KeyAttendantOn = 539 - fromEnum KeyAttendantOff = 540 - fromEnum KeyAttendantToggle = 541 - fromEnum KeyLightsToggle = 542 - fromEnum BtnDpadUp = 544 - fromEnum BtnDpadDown = 545 - fromEnum BtnDpadLeft = 546 - fromEnum BtnDpadRight = 547 - fromEnum KeyAlsToggle = 560 - fromEnum KeyButtonconfig = 576 - fromEnum KeyTaskmanager = 577 - fromEnum KeyJournal = 578 - fromEnum KeyControlpanel = 579 - fromEnum KeyAppselect = 580 - fromEnum KeyScreensaver = 581 - fromEnum KeyVoicecommand = 582 - fromEnum KeyBrightnessMin = 592 - fromEnum KeyBrightnessMax = 593 - fromEnum KeyKbdinputassistPrev = 608 - fromEnum KeyKbdinputassistNext = 609 - fromEnum KeyKbdinputassistPrevgroup = 610 - fromEnum KeyKbdinputassistNextgroup = 611 - fromEnum KeyKbdinputassistAccept = 612 - fromEnum KeyKbdinputassistCancel = 613 - fromEnum BtnTriggerHappy1 = 704 - fromEnum BtnTriggerHappy2 = 705 - fromEnum BtnTriggerHappy3 = 706 - fromEnum BtnTriggerHappy4 = 707 - fromEnum BtnTriggerHappy5 = 708 - fromEnum BtnTriggerHappy6 = 709 - fromEnum BtnTriggerHappy7 = 710 - fromEnum BtnTriggerHappy8 = 711 - fromEnum BtnTriggerHappy9 = 712 - fromEnum BtnTriggerHappy10 = 713 - fromEnum BtnTriggerHappy11 = 714 - fromEnum BtnTriggerHappy12 = 715 - fromEnum BtnTriggerHappy13 = 716 - fromEnum BtnTriggerHappy14 = 717 - fromEnum BtnTriggerHappy15 = 718 - fromEnum BtnTriggerHappy16 = 719 - fromEnum BtnTriggerHappy17 = 720 - fromEnum BtnTriggerHappy18 = 721 - fromEnum BtnTriggerHappy19 = 722 - fromEnum BtnTriggerHappy20 = 723 - fromEnum BtnTriggerHappy21 = 724 - fromEnum BtnTriggerHappy22 = 725 - fromEnum BtnTriggerHappy23 = 726 - fromEnum BtnTriggerHappy24 = 727 - fromEnum BtnTriggerHappy25 = 728 - fromEnum BtnTriggerHappy26 = 729 - fromEnum BtnTriggerHappy27 = 730 - fromEnum BtnTriggerHappy28 = 731 - fromEnum BtnTriggerHappy29 = 732 - fromEnum BtnTriggerHappy30 = 733 - fromEnum BtnTriggerHappy31 = 734 - fromEnum BtnTriggerHappy32 = 735 - fromEnum BtnTriggerHappy33 = 736 - fromEnum BtnTriggerHappy34 = 737 - fromEnum BtnTriggerHappy35 = 738 - fromEnum BtnTriggerHappy36 = 739 - fromEnum BtnTriggerHappy37 = 740 - fromEnum BtnTriggerHappy38 = 741 - fromEnum BtnTriggerHappy39 = 742 - fromEnum BtnTriggerHappy40 = 743 - - toEnum 0 = KeyReserved - toEnum 1 = KeyEsc - toEnum 2 = Key1 - toEnum 3 = Key2 - toEnum 4 = Key3 - toEnum 5 = Key4 - toEnum 6 = Key5 - toEnum 7 = Key6 - toEnum 8 = Key7 - toEnum 9 = Key8 - toEnum 10 = Key9 - toEnum 11 = Key0 - toEnum 12 = KeyMinus - toEnum 13 = KeyEqual - toEnum 14 = KeyBackspace - toEnum 15 = KeyTab - toEnum 16 = KeyQ - toEnum 17 = KeyW - toEnum 18 = KeyE - toEnum 19 = KeyR - toEnum 20 = KeyT - toEnum 21 = KeyY - toEnum 22 = KeyU - toEnum 23 = KeyI - toEnum 24 = KeyO - toEnum 25 = KeyP - toEnum 26 = KeyLeftbrace - toEnum 27 = KeyRightbrace - toEnum 28 = KeyEnter - toEnum 29 = KeyLeftctrl - toEnum 30 = KeyA - toEnum 31 = KeyS - toEnum 32 = KeyD - toEnum 33 = KeyF - toEnum 34 = KeyG - toEnum 35 = KeyH - toEnum 36 = KeyJ - toEnum 37 = KeyK - toEnum 38 = KeyL - toEnum 39 = KeySemicolon - toEnum 40 = KeyApostrophe - toEnum 41 = KeyGrave - toEnum 42 = KeyLeftshift - toEnum 43 = KeyBackslash - toEnum 44 = KeyZ - toEnum 45 = KeyX - toEnum 46 = KeyC - toEnum 47 = KeyV - toEnum 48 = KeyB - toEnum 49 = KeyN - toEnum 50 = KeyM - toEnum 51 = KeyComma - toEnum 52 = KeyDot - toEnum 53 = KeySlash - toEnum 54 = KeyRightshift - toEnum 55 = KeyKpasterisk - toEnum 56 = KeyLeftalt - toEnum 57 = KeySpace - toEnum 58 = KeyCapslock - toEnum 59 = KeyF1 - toEnum 60 = KeyF2 - toEnum 61 = KeyF3 - toEnum 62 = KeyF4 - toEnum 63 = KeyF5 - toEnum 64 = KeyF6 - toEnum 65 = KeyF7 - toEnum 66 = KeyF8 - toEnum 67 = KeyF9 - toEnum 68 = KeyF10 - toEnum 69 = KeyNumlock - toEnum 70 = KeyScrolllock - toEnum 71 = KeyKp7 - toEnum 72 = KeyKp8 - toEnum 73 = KeyKp9 - toEnum 74 = KeyKpminus - toEnum 75 = KeyKp4 - toEnum 76 = KeyKp5 - toEnum 77 = KeyKp6 - toEnum 78 = KeyKpplus - toEnum 79 = KeyKp1 - toEnum 80 = KeyKp2 - toEnum 81 = KeyKp3 - toEnum 82 = KeyKp0 - toEnum 83 = KeyKpdot - toEnum 85 = KeyZenkakuhankaku - toEnum 86 = Key102nd - toEnum 87 = KeyF11 - toEnum 88 = KeyF12 - toEnum 89 = KeyRo - toEnum 90 = KeyKatakana - toEnum 91 = KeyHiragana - toEnum 92 = KeyHenkan - toEnum 93 = KeyKatakanahiragana - toEnum 94 = KeyMuhenkan - toEnum 95 = KeyKpjpcomma - toEnum 96 = KeyKpenter - toEnum 97 = KeyRightctrl - toEnum 98 = KeyKpslash - toEnum 99 = KeySysrq - toEnum 100 = KeyRightalt - toEnum 101 = KeyLinefeed - toEnum 102 = KeyHome - toEnum 103 = KeyUp - toEnum 104 = KeyPageup - toEnum 105 = KeyLeft - toEnum 106 = KeyRight - toEnum 107 = KeyEnd - toEnum 108 = KeyDown - toEnum 109 = KeyPagedown - toEnum 110 = KeyInsert - toEnum 111 = KeyDelete - toEnum 112 = KeyMacro - toEnum 113 = KeyMute - toEnum 114 = KeyVolumedown - toEnum 115 = KeyVolumeup - toEnum 116 = KeyPower - toEnum 117 = KeyKpequal - toEnum 118 = KeyKpplusminus - toEnum 119 = KeyPause - toEnum 120 = KeyScale - toEnum 121 = KeyKpcomma - toEnum 122 = KeyHangeul - toEnum 123 = KeyHanja - toEnum 124 = KeyYen - toEnum 125 = KeyLeftmeta - toEnum 126 = KeyRightmeta - toEnum 127 = KeyCompose - toEnum 128 = KeyStop - toEnum 129 = KeyAgain - toEnum 130 = KeyProps - toEnum 131 = KeyUndo - toEnum 132 = KeyFront - toEnum 133 = KeyCopy - toEnum 134 = KeyOpen - toEnum 135 = KeyPaste - toEnum 136 = KeyFind - toEnum 137 = KeyCut - toEnum 138 = KeyHelp - toEnum 139 = KeyMenu - toEnum 140 = KeyCalc - toEnum 141 = KeySetup - toEnum 142 = KeySleep - toEnum 143 = KeyWakeup - toEnum 144 = KeyFile - toEnum 145 = KeySendfile - toEnum 146 = KeyDeletefile - toEnum 147 = KeyXfer - toEnum 148 = KeyProg1 - toEnum 149 = KeyProg2 - toEnum 150 = KeyWww - toEnum 151 = KeyMsdos - toEnum 152 = KeyScreenlock - toEnum 153 = KeyRotateDisplay - toEnum 154 = KeyCyclewindows - toEnum 155 = KeyMail - toEnum 156 = KeyBookmarks - toEnum 157 = KeyComputer - toEnum 158 = KeyBack - toEnum 159 = KeyForward - toEnum 160 = KeyClosecd - toEnum 161 = KeyEjectcd - toEnum 162 = KeyEjectclosecd - toEnum 163 = KeyNextsong - toEnum 164 = KeyPlaypause - toEnum 165 = KeyPrevioussong - toEnum 166 = KeyStopcd - toEnum 167 = KeyRecord - toEnum 168 = KeyRewind - toEnum 169 = KeyPhone - toEnum 170 = KeyIso - toEnum 171 = KeyConfig - toEnum 172 = KeyHomepage - toEnum 173 = KeyRefresh - toEnum 174 = KeyExit - toEnum 175 = KeyMove - toEnum 176 = KeyEdit - toEnum 177 = KeyScrollup - toEnum 178 = KeyScrolldown - toEnum 179 = KeyKpleftparen - toEnum 180 = KeyKprightparen - toEnum 181 = KeyNew - toEnum 182 = KeyRedo - toEnum 183 = KeyF13 - toEnum 184 = KeyF14 - toEnum 185 = KeyF15 - toEnum 186 = KeyF16 - toEnum 187 = KeyF17 - toEnum 188 = KeyF18 - toEnum 189 = KeyF19 - toEnum 190 = KeyF20 - toEnum 191 = KeyF21 - toEnum 192 = KeyF22 - toEnum 193 = KeyF23 - toEnum 194 = KeyF24 - toEnum 200 = KeyPlaycd - toEnum 201 = KeyPausecd - toEnum 202 = KeyProg3 - toEnum 203 = KeyProg4 - toEnum 204 = KeyDashboard - toEnum 205 = KeySuspend - toEnum 206 = KeyClose - toEnum 207 = KeyPlay - toEnum 208 = KeyFastforward - toEnum 209 = KeyBassboost - toEnum 210 = KeyPrint - toEnum 211 = KeyHp - toEnum 212 = KeyCamera - toEnum 213 = KeySound - toEnum 214 = KeyQuestion - toEnum 215 = KeyEmail - toEnum 216 = KeyChat - toEnum 217 = KeySearch - toEnum 218 = KeyConnect - toEnum 219 = KeyFinance - toEnum 220 = KeySport - toEnum 221 = KeyShop - toEnum 222 = KeyAlterase - toEnum 223 = KeyCancel - toEnum 224 = KeyBrightnessdown - toEnum 225 = KeyBrightnessup - toEnum 226 = KeyMedia - toEnum 227 = KeySwitchvideomode - toEnum 228 = KeyKbdillumtoggle - toEnum 229 = KeyKbdillumdown - toEnum 230 = KeyKbdillumup - toEnum 231 = KeySend - toEnum 232 = KeyReply - toEnum 233 = KeyForwardmail - toEnum 234 = KeySave - toEnum 235 = KeyDocuments - toEnum 236 = KeyBattery - toEnum 237 = KeyBluetooth - toEnum 238 = KeyWlan - toEnum 239 = KeyUwb - toEnum 240 = KeyUnknown - toEnum 241 = KeyVideoNext - toEnum 242 = KeyVideoPrev - toEnum 243 = KeyBrightnessCycle - toEnum 244 = KeyBrightnessAuto - toEnum 245 = KeyDisplayOff - toEnum 246 = KeyWwan - toEnum 247 = KeyRfkill - toEnum 248 = KeyMicmute - toEnum 256 = Btn0 - toEnum 257 = Btn1 - toEnum 258 = Btn2 - toEnum 259 = Btn3 - toEnum 260 = Btn4 - toEnum 261 = Btn5 - toEnum 262 = Btn6 - toEnum 263 = Btn7 - toEnum 264 = Btn8 - toEnum 265 = Btn9 - toEnum 272 = BtnLeft - toEnum 273 = BtnRight - toEnum 274 = BtnMiddle - toEnum 275 = BtnSide - toEnum 276 = BtnExtra - toEnum 277 = BtnForward - toEnum 278 = BtnBack - toEnum 279 = BtnTask - toEnum 288 = BtnJoystick - toEnum 289 = BtnThumb - toEnum 290 = BtnThumb2 - toEnum 291 = BtnTop - toEnum 292 = BtnTop2 - toEnum 293 = BtnPinkie - toEnum 294 = BtnBase - toEnum 295 = BtnBase2 - toEnum 296 = BtnBase3 - toEnum 297 = BtnBase4 - toEnum 298 = BtnBase5 - toEnum 299 = BtnBase6 - toEnum 303 = BtnDead - toEnum 304 = BtnA - toEnum 305 = BtnB - toEnum 306 = BtnC - toEnum 307 = BtnX - toEnum 308 = BtnY - toEnum 309 = BtnZ - toEnum 310 = BtnTl - toEnum 311 = BtnTr - toEnum 312 = BtnTl2 - toEnum 313 = BtnTr2 - toEnum 314 = BtnSelect - toEnum 315 = BtnStart - toEnum 316 = BtnMode - toEnum 317 = BtnThumbl - toEnum 318 = BtnThumbr - toEnum 320 = BtnToolPen - toEnum 321 = BtnToolRubber - toEnum 322 = BtnToolBrush - toEnum 323 = BtnToolPencil - toEnum 324 = BtnToolAirbrush - toEnum 325 = BtnToolFinger - toEnum 326 = BtnToolMouse - toEnum 327 = BtnToolLens - toEnum 328 = BtnToolQuinttap - toEnum 330 = BtnTouch - toEnum 331 = BtnStylus - toEnum 332 = BtnStylus2 - toEnum 333 = BtnToolDoubletap - toEnum 334 = BtnToolTripletap - toEnum 335 = BtnToolQuadtap - toEnum 336 = BtnGearDown - toEnum 337 = BtnGearUp - toEnum 352 = KeyOk - toEnum 353 = KeySelect - toEnum 354 = KeyGoto - toEnum 355 = KeyClear - toEnum 356 = KeyPower2 - toEnum 357 = KeyOption - toEnum 358 = KeyInfo - toEnum 359 = KeyTime - toEnum 360 = KeyVendor - toEnum 361 = KeyArchive - toEnum 362 = KeyProgram - toEnum 363 = KeyChannel - toEnum 364 = KeyFavorites - toEnum 365 = KeyEpg - toEnum 366 = KeyPvr - toEnum 367 = KeyMhp - toEnum 368 = KeyLanguage - toEnum 369 = KeyTitle - toEnum 370 = KeySubtitle - toEnum 371 = KeyAngle - toEnum 372 = KeyZoom - toEnum 373 = KeyMode - toEnum 374 = KeyKeyboard - toEnum 375 = KeyScreen - toEnum 376 = KeyPc - toEnum 377 = KeyTv - toEnum 378 = KeyTv2 - toEnum 379 = KeyVcr - toEnum 380 = KeyVcr2 - toEnum 381 = KeySat - toEnum 382 = KeySat2 - toEnum 383 = KeyCd - toEnum 384 = KeyTape - toEnum 385 = KeyRadio - toEnum 386 = KeyTuner - toEnum 387 = KeyPlayer - toEnum 388 = KeyText - toEnum 389 = KeyDvd - toEnum 390 = KeyAux - toEnum 391 = KeyMp3 - toEnum 392 = KeyAudio - toEnum 393 = KeyVideo - toEnum 394 = KeyDirectory - toEnum 395 = KeyList - toEnum 396 = KeyMemo - toEnum 397 = KeyCalendar - toEnum 398 = KeyRed - toEnum 399 = KeyGreen - toEnum 400 = KeyYellow - toEnum 401 = KeyBlue - toEnum 402 = KeyChannelup - toEnum 403 = KeyChanneldown - toEnum 404 = KeyFirst - toEnum 405 = KeyLast - toEnum 406 = KeyAb - toEnum 407 = KeyNext - toEnum 408 = KeyRestart - toEnum 409 = KeySlow - toEnum 410 = KeyShuffle - toEnum 411 = KeyBreak - toEnum 412 = KeyPrevious - toEnum 413 = KeyDigits - toEnum 414 = KeyTeen - toEnum 415 = KeyTwen - toEnum 416 = KeyVideophone - toEnum 417 = KeyGames - toEnum 418 = KeyZoomin - toEnum 419 = KeyZoomout - toEnum 420 = KeyZoomreset - toEnum 421 = KeyWordprocessor - toEnum 422 = KeyEditor - toEnum 423 = KeySpreadsheet - toEnum 424 = KeyGraphicseditor - toEnum 425 = KeyPresentation - toEnum 426 = KeyDatabase - toEnum 427 = KeyNews - toEnum 428 = KeyVoicemail - toEnum 429 = KeyAddressbook - toEnum 430 = KeyMessenger - toEnum 431 = KeyDisplaytoggle - toEnum 432 = KeySpellcheck - toEnum 433 = KeyLogoff - toEnum 434 = KeyDollar - toEnum 435 = KeyEuro - toEnum 436 = KeyFrameback - toEnum 437 = KeyFrameforward - toEnum 438 = KeyContextMenu - toEnum 439 = KeyMediaRepeat - toEnum 440 = Key10channelsup - toEnum 441 = Key10channelsdown - toEnum 442 = KeyImages - toEnum 448 = KeyDelEol - toEnum 449 = KeyDelEos - toEnum 450 = KeyInsLine - toEnum 451 = KeyDelLine - toEnum 464 = KeyFn - toEnum 465 = KeyFnEsc - toEnum 466 = KeyFnF1 - toEnum 467 = KeyFnF2 - toEnum 468 = KeyFnF3 - toEnum 469 = KeyFnF4 - toEnum 470 = KeyFnF5 - toEnum 471 = KeyFnF6 - toEnum 472 = KeyFnF7 - toEnum 473 = KeyFnF8 - toEnum 474 = KeyFnF9 - toEnum 475 = KeyFnF10 - toEnum 476 = KeyFnF11 - toEnum 477 = KeyFnF12 - toEnum 478 = KeyFn1 - toEnum 479 = KeyFn2 - toEnum 480 = KeyFnD - toEnum 481 = KeyFnE - toEnum 482 = KeyFnF - toEnum 483 = KeyFnS - toEnum 484 = KeyFnB - toEnum 497 = KeyBrlDot1 - toEnum 498 = KeyBrlDot2 - toEnum 499 = KeyBrlDot3 - toEnum 500 = KeyBrlDot4 - toEnum 501 = KeyBrlDot5 - toEnum 502 = KeyBrlDot6 - toEnum 503 = KeyBrlDot7 - toEnum 504 = KeyBrlDot8 - toEnum 505 = KeyBrlDot9 - toEnum 506 = KeyBrlDot10 - toEnum 512 = KeyNumeric0 - toEnum 513 = KeyNumeric1 - toEnum 514 = KeyNumeric2 - toEnum 515 = KeyNumeric3 - toEnum 516 = KeyNumeric4 - toEnum 517 = KeyNumeric5 - toEnum 518 = KeyNumeric6 - toEnum 519 = KeyNumeric7 - toEnum 520 = KeyNumeric8 - toEnum 521 = KeyNumeric9 - toEnum 522 = KeyNumericStar - toEnum 523 = KeyNumericPound - toEnum 524 = KeyNumericA - toEnum 525 = KeyNumericB - toEnum 526 = KeyNumericC - toEnum 527 = KeyNumericD - toEnum 528 = KeyCameraFocus - toEnum 529 = KeyWpsButton - toEnum 530 = KeyTouchpadToggle - toEnum 531 = KeyTouchpadOn - toEnum 532 = KeyTouchpadOff - toEnum 533 = KeyCameraZoomin - toEnum 534 = KeyCameraZoomout - toEnum 535 = KeyCameraUp - toEnum 536 = KeyCameraDown - toEnum 537 = KeyCameraLeft - toEnum 538 = KeyCameraRight - toEnum 539 = KeyAttendantOn - toEnum 540 = KeyAttendantOff - toEnum 541 = KeyAttendantToggle - toEnum 542 = KeyLightsToggle - toEnum 544 = BtnDpadUp - toEnum 545 = BtnDpadDown - toEnum 546 = BtnDpadLeft - toEnum 547 = BtnDpadRight - toEnum 560 = KeyAlsToggle - toEnum 576 = KeyButtonconfig - toEnum 577 = KeyTaskmanager - toEnum 578 = KeyJournal - toEnum 579 = KeyControlpanel - toEnum 580 = KeyAppselect - toEnum 581 = KeyScreensaver - toEnum 582 = KeyVoicecommand - toEnum 592 = KeyBrightnessMin - toEnum 593 = KeyBrightnessMax - toEnum 608 = KeyKbdinputassistPrev - toEnum 609 = KeyKbdinputassistNext - toEnum 610 = KeyKbdinputassistPrevgroup - toEnum 611 = KeyKbdinputassistNextgroup - toEnum 612 = KeyKbdinputassistAccept - toEnum 613 = KeyKbdinputassistCancel - toEnum 704 = BtnTriggerHappy1 - toEnum 705 = BtnTriggerHappy2 - toEnum 706 = BtnTriggerHappy3 - toEnum 707 = BtnTriggerHappy4 - toEnum 708 = BtnTriggerHappy5 - toEnum 709 = BtnTriggerHappy6 - toEnum 710 = BtnTriggerHappy7 - toEnum 711 = BtnTriggerHappy8 - toEnum 712 = BtnTriggerHappy9 - toEnum 713 = BtnTriggerHappy10 - toEnum 714 = BtnTriggerHappy11 - toEnum 715 = BtnTriggerHappy12 - toEnum 716 = BtnTriggerHappy13 - toEnum 717 = BtnTriggerHappy14 - toEnum 718 = BtnTriggerHappy15 - toEnum 719 = BtnTriggerHappy16 - toEnum 720 = BtnTriggerHappy17 - toEnum 721 = BtnTriggerHappy18 - toEnum 722 = BtnTriggerHappy19 - toEnum 723 = BtnTriggerHappy20 - toEnum 724 = BtnTriggerHappy21 - toEnum 725 = BtnTriggerHappy22 - toEnum 726 = BtnTriggerHappy23 - toEnum 727 = BtnTriggerHappy24 - toEnum 728 = BtnTriggerHappy25 - toEnum 729 = BtnTriggerHappy26 - toEnum 730 = BtnTriggerHappy27 - toEnum 731 = BtnTriggerHappy28 - toEnum 732 = BtnTriggerHappy29 - toEnum 733 = BtnTriggerHappy30 - toEnum 734 = BtnTriggerHappy31 - toEnum 735 = BtnTriggerHappy32 - toEnum 736 = BtnTriggerHappy33 - toEnum 737 = BtnTriggerHappy34 - toEnum 738 = BtnTriggerHappy35 - toEnum 739 = BtnTriggerHappy36 - toEnum 740 = BtnTriggerHappy37 - toEnum 741 = BtnTriggerHappy38 - toEnum 742 = BtnTriggerHappy39 - toEnum 743 = BtnTriggerHappy40 - toEnum unmatched = error ("Key.toEnum: Cannot match " ++ show unmatched) - - - -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 -data RelativeAxis = RelX - | RelY - | RelZ - | RelRx - | RelRy - | RelRz - | RelHwheel - | RelDial - | RelWheel - | RelMisc - | RelReserved - | RelWheelHiRes - | RelHWheelHiRes - deriving (Bounded,Eq,Ord,Read,Show) -instance Enum RelativeAxis where - succ RelX = RelY - succ RelY = RelZ - succ RelZ = RelRx - succ RelRx = RelRy - succ RelRy = RelRz - succ RelRz = RelHwheel - succ RelHwheel = RelDial - succ RelDial = RelWheel - succ RelWheel = RelMisc - succ RelMisc = RelReserved - succ RelReserved = RelWheelHiRes - succ RelWheelHiRes = RelHWheelHiRes - succ RelHWheelHiRes = error "RelativeAxis.succ: RelHWheelHiRes has no successor" - - pred RelY = RelX - pred RelZ = RelY - pred RelRx = RelZ - pred RelRy = RelRx - pred RelRz = RelRy - pred RelHwheel = RelRz - pred RelDial = RelHwheel - pred RelWheel = RelDial - pred RelMisc = RelWheel - pred RelReserved = RelMisc - pred RelWheelHiRes = RelReserved - pred RelHWheelHiRes = RelWheelHiRes - pred RelX = error "RelativeAxis.pred: RelX has no predecessor" - - enumFromTo from to = go from - where - end = fromEnum to - go v = case compare (fromEnum v) end of - LT -> v : go (succ v) - EQ -> [v] - GT -> [] - - enumFrom from = enumFromTo from RelHWheelHiRes - - fromEnum RelX = 0 - fromEnum RelY = 1 - fromEnum RelZ = 2 - fromEnum RelRx = 3 - fromEnum RelRy = 4 - fromEnum RelRz = 5 - fromEnum RelHwheel = 6 - fromEnum RelDial = 7 - fromEnum RelWheel = 8 - fromEnum RelMisc = 9 - fromEnum RelReserved = 10 - fromEnum RelWheelHiRes = 11 - fromEnum RelHWheelHiRes = 12 - - toEnum 0 = RelX - toEnum 1 = RelY - toEnum 2 = RelZ - toEnum 3 = RelRx - toEnum 4 = RelRy - toEnum 5 = RelRz - toEnum 6 = RelHwheel - toEnum 7 = RelDial - toEnum 8 = RelWheel - toEnum 9 = RelMisc - toEnum 10 = RelReserved - toEnum 11 = RelWheelHiRes - toEnum 12 = RelHWheelHiRes - toEnum unmatched = error ("RelativeAxis.toEnum: Cannot match " ++ show unmatched) - - - --- | Absolute changes -data AbsoluteAxis = AbsX - | AbsY - | AbsZ - | AbsRx - | AbsRy - | AbsRz - | AbsThrottle - | AbsRudder - | AbsWheel - | AbsGas - | AbsBrake - | AbsHat0x - | AbsHat0y - | AbsHat1x - | AbsHat1y - | AbsHat2x - | AbsHat2y - | AbsHat3x - | AbsHat3y - | AbsPressure - | AbsDistance - | AbsTiltX - | AbsTiltY - | AbsToolWidth - | AbsVolume - | AbsMisc - | AbsReserved - | AbsMtSlot - | AbsMtTouchMajor - | AbsMtTouchMinor - | AbsMtWidthMajor - | AbsMtWidthMinor - | AbsMtOrientation - | AbsMtPositionX - | AbsMtPositionY - | AbsMtToolType - | AbsMtBlobId - | AbsMtTrackingId - | AbsMtPressure - | AbsMtDistance - | AbsMtToolX - | AbsMtToolY - deriving (Bounded,Eq,Ord,Read,Show) -instance Enum AbsoluteAxis where - succ AbsX = AbsY - succ AbsY = AbsZ - succ AbsZ = AbsRx - succ AbsRx = AbsRy - succ AbsRy = AbsRz - succ AbsRz = AbsThrottle - succ AbsThrottle = AbsRudder - succ AbsRudder = AbsWheel - succ AbsWheel = AbsGas - succ AbsGas = AbsBrake - succ AbsBrake = AbsHat0x - succ AbsHat0x = AbsHat0y - succ AbsHat0y = AbsHat1x - succ AbsHat1x = AbsHat1y - succ AbsHat1y = AbsHat2x - succ AbsHat2x = AbsHat2y - succ AbsHat2y = AbsHat3x - succ AbsHat3x = AbsHat3y - succ AbsHat3y = AbsPressure - succ AbsPressure = AbsDistance - succ AbsDistance = AbsTiltX - succ AbsTiltX = AbsTiltY - succ AbsTiltY = AbsToolWidth - succ AbsToolWidth = AbsVolume - succ AbsVolume = AbsMisc - succ AbsMisc = AbsReserved - succ AbsReserved = AbsMtSlot - succ AbsMtSlot = AbsMtTouchMajor - succ AbsMtTouchMajor = AbsMtTouchMinor - succ AbsMtTouchMinor = AbsMtWidthMajor - succ AbsMtWidthMajor = AbsMtWidthMinor - succ AbsMtWidthMinor = AbsMtOrientation - succ AbsMtOrientation = AbsMtPositionX - succ AbsMtPositionX = AbsMtPositionY - succ AbsMtPositionY = AbsMtToolType - succ AbsMtToolType = AbsMtBlobId - succ AbsMtBlobId = AbsMtTrackingId - succ AbsMtTrackingId = AbsMtPressure - succ AbsMtPressure = AbsMtDistance - succ AbsMtDistance = AbsMtToolX - succ AbsMtToolX = AbsMtToolY - succ AbsMtToolY = error "AbsoluteAxis.succ: AbsMtToolY has no successor" - - pred AbsY = AbsX - pred AbsZ = AbsY - pred AbsRx = AbsZ - pred AbsRy = AbsRx - pred AbsRz = AbsRy - pred AbsThrottle = AbsRz - pred AbsRudder = AbsThrottle - pred AbsWheel = AbsRudder - pred AbsGas = AbsWheel - pred AbsBrake = AbsGas - pred AbsHat0x = AbsBrake - pred AbsHat0y = AbsHat0x - pred AbsHat1x = AbsHat0y - pred AbsHat1y = AbsHat1x - pred AbsHat2x = AbsHat1y - pred AbsHat2y = AbsHat2x - pred AbsHat3x = AbsHat2y - pred AbsHat3y = AbsHat3x - pred AbsPressure = AbsHat3y - pred AbsDistance = AbsPressure - pred AbsTiltX = AbsDistance - pred AbsTiltY = AbsTiltX - pred AbsToolWidth = AbsTiltY - pred AbsVolume = AbsToolWidth - pred AbsMisc = AbsVolume - pred AbsReserved = AbsMisc - pred AbsMtSlot = AbsReserved - pred AbsMtTouchMajor = AbsMtSlot - pred AbsMtTouchMinor = AbsMtTouchMajor - pred AbsMtWidthMajor = AbsMtTouchMinor - pred AbsMtWidthMinor = AbsMtWidthMajor - pred AbsMtOrientation = AbsMtWidthMinor - pred AbsMtPositionX = AbsMtOrientation - pred AbsMtPositionY = AbsMtPositionX - pred AbsMtToolType = AbsMtPositionY - pred AbsMtBlobId = AbsMtToolType - pred AbsMtTrackingId = AbsMtBlobId - pred AbsMtPressure = AbsMtTrackingId - pred AbsMtDistance = AbsMtPressure - pred AbsMtToolX = AbsMtDistance - pred AbsMtToolY = AbsMtToolX - pred AbsX = error "AbsoluteAxis.pred: AbsX has no predecessor" - - enumFromTo from to = go from - where - end = fromEnum to - go v = case compare (fromEnum v) end of - LT -> v : go (succ v) - EQ -> [v] - GT -> [] - - enumFrom from = enumFromTo from AbsMtToolY - - fromEnum AbsX = 0 - fromEnum AbsY = 1 - fromEnum AbsZ = 2 - fromEnum AbsRx = 3 - fromEnum AbsRy = 4 - fromEnum AbsRz = 5 - fromEnum AbsThrottle = 6 - fromEnum AbsRudder = 7 - fromEnum AbsWheel = 8 - fromEnum AbsGas = 9 - fromEnum AbsBrake = 10 - fromEnum AbsHat0x = 16 - fromEnum AbsHat0y = 17 - fromEnum AbsHat1x = 18 - fromEnum AbsHat1y = 19 - fromEnum AbsHat2x = 20 - fromEnum AbsHat2y = 21 - fromEnum AbsHat3x = 22 - fromEnum AbsHat3y = 23 - fromEnum AbsPressure = 24 - fromEnum AbsDistance = 25 - fromEnum AbsTiltX = 26 - fromEnum AbsTiltY = 27 - fromEnum AbsToolWidth = 28 - fromEnum AbsVolume = 32 - fromEnum AbsMisc = 40 - fromEnum AbsReserved = 46 - fromEnum AbsMtSlot = 47 - fromEnum AbsMtTouchMajor = 48 - fromEnum AbsMtTouchMinor = 49 - fromEnum AbsMtWidthMajor = 50 - fromEnum AbsMtWidthMinor = 51 - fromEnum AbsMtOrientation = 52 - fromEnum AbsMtPositionX = 53 - fromEnum AbsMtPositionY = 54 - fromEnum AbsMtToolType = 55 - fromEnum AbsMtBlobId = 56 - fromEnum AbsMtTrackingId = 57 - fromEnum AbsMtPressure = 58 - fromEnum AbsMtDistance = 59 - fromEnum AbsMtToolX = 60 - fromEnum AbsMtToolY = 61 - - toEnum 0 = AbsX - toEnum 1 = AbsY - toEnum 2 = AbsZ - toEnum 3 = AbsRx - toEnum 4 = AbsRy - toEnum 5 = AbsRz - toEnum 6 = AbsThrottle - toEnum 7 = AbsRudder - toEnum 8 = AbsWheel - toEnum 9 = AbsGas - toEnum 10 = AbsBrake - toEnum 16 = AbsHat0x - toEnum 17 = AbsHat0y - toEnum 18 = AbsHat1x - toEnum 19 = AbsHat1y - toEnum 20 = AbsHat2x - toEnum 21 = AbsHat2y - toEnum 22 = AbsHat3x - toEnum 23 = AbsHat3y - toEnum 24 = AbsPressure - toEnum 25 = AbsDistance - toEnum 26 = AbsTiltX - toEnum 27 = AbsTiltY - toEnum 28 = AbsToolWidth - toEnum 32 = AbsVolume - toEnum 40 = AbsMisc - toEnum 46 = AbsReserved - toEnum 47 = AbsMtSlot - toEnum 48 = AbsMtTouchMajor - toEnum 49 = AbsMtTouchMinor - toEnum 50 = AbsMtWidthMajor - toEnum 51 = AbsMtWidthMinor - toEnum 52 = AbsMtOrientation - toEnum 53 = AbsMtPositionX - toEnum 54 = AbsMtPositionY - toEnum 55 = AbsMtToolType - toEnum 56 = AbsMtBlobId - toEnum 57 = AbsMtTrackingId - toEnum 58 = AbsMtPressure - toEnum 59 = AbsMtDistance - toEnum 60 = AbsMtToolX - toEnum 61 = AbsMtToolY - toEnum unmatched = error ("AbsoluteAxis.toEnum: Cannot match " ++ show unmatched) - - - --- | Stateful binary switches -data SwitchEvent = SwLid - | SwTabletMode - | SwHeadphoneInsert - | SwRfkillAll - | SwRadio - | SwMicrophoneInsert - | SwDock - | SwLineoutInsert - | SwJackPhysicalInsert - | SwVideooutInsert - | SwCameraLensCover - | SwKeypadSlide - | SwFrontProximity - | SwRotateLock - | SwLineinInsert - | SwMuteDevice - deriving (Bounded,Eq,Ord,Read,Show) -instance Enum SwitchEvent where - succ SwLid = SwTabletMode - succ SwTabletMode = SwHeadphoneInsert - succ SwHeadphoneInsert = SwRfkillAll - succ SwRfkillAll = SwMicrophoneInsert - succ SwRadio = SwMicrophoneInsert - succ SwMicrophoneInsert = SwDock - succ SwDock = SwLineoutInsert - succ SwLineoutInsert = SwJackPhysicalInsert - succ SwJackPhysicalInsert = SwVideooutInsert - succ SwVideooutInsert = SwCameraLensCover - succ SwCameraLensCover = SwKeypadSlide - succ SwKeypadSlide = SwFrontProximity - succ SwFrontProximity = SwRotateLock - succ SwRotateLock = SwLineinInsert - succ SwLineinInsert = SwMuteDevice - succ SwMuteDevice = error "SwitchEvent.succ: SwMuteDevice has no successor" - - pred SwTabletMode = SwLid - pred SwHeadphoneInsert = SwTabletMode - pred SwRfkillAll = SwHeadphoneInsert - pred SwRadio = SwHeadphoneInsert - pred SwMicrophoneInsert = SwRfkillAll - pred SwDock = SwMicrophoneInsert - pred SwLineoutInsert = SwDock - pred SwJackPhysicalInsert = SwLineoutInsert - pred SwVideooutInsert = SwJackPhysicalInsert - pred SwCameraLensCover = SwVideooutInsert - pred SwKeypadSlide = SwCameraLensCover - pred SwFrontProximity = SwKeypadSlide - pred SwRotateLock = SwFrontProximity - pred SwLineinInsert = SwRotateLock - pred SwMuteDevice = SwLineinInsert - pred SwLid = error "SwitchEvent.pred: SwLid has no predecessor" - - enumFromTo from to = go from - where - end = fromEnum to - go v = case compare (fromEnum v) end of - LT -> v : go (succ v) - EQ -> [v] - GT -> [] - - enumFrom from = enumFromTo from SwMuteDevice - - fromEnum SwLid = 0 - fromEnum SwTabletMode = 1 - fromEnum SwHeadphoneInsert = 2 - fromEnum SwRfkillAll = 3 - fromEnum SwRadio = 3 - fromEnum SwMicrophoneInsert = 4 - fromEnum SwDock = 5 - fromEnum SwLineoutInsert = 6 - fromEnum SwJackPhysicalInsert = 7 - fromEnum SwVideooutInsert = 8 - fromEnum SwCameraLensCover = 9 - fromEnum SwKeypadSlide = 10 - fromEnum SwFrontProximity = 11 - fromEnum SwRotateLock = 12 - fromEnum SwLineinInsert = 13 - fromEnum SwMuteDevice = 14 - - toEnum 0 = SwLid - toEnum 1 = SwTabletMode - toEnum 2 = SwHeadphoneInsert - toEnum 3 = SwRfkillAll - toEnum 4 = SwMicrophoneInsert - toEnum 5 = SwDock - toEnum 6 = SwLineoutInsert - toEnum 7 = SwJackPhysicalInsert - toEnum 8 = SwVideooutInsert - toEnum 9 = SwCameraLensCover - toEnum 10 = SwKeypadSlide - toEnum 11 = SwFrontProximity - toEnum 12 = SwRotateLock - toEnum 13 = SwLineinInsert - toEnum 14 = SwMuteDevice - toEnum unmatched = error ("SwitchEvent.toEnum: Cannot match " ++ show unmatched) - - - --- | Miscellaneous -data MiscEvent = MscSerial - | MscPulseled - | MscGesture - | MscRaw - | MscScan - | MscTimestamp - deriving (Bounded,Eq,Ord,Read,Show) -instance Enum MiscEvent where - succ MscSerial = MscPulseled - succ MscPulseled = MscGesture - succ MscGesture = MscRaw - succ MscRaw = MscScan - succ MscScan = MscTimestamp - succ MscTimestamp = error "MiscEvent.succ: MscTimestamp has no successor" - - pred MscPulseled = MscSerial - pred MscGesture = MscPulseled - pred MscRaw = MscGesture - pred MscScan = MscRaw - pred MscTimestamp = MscScan - pred MscSerial = error "MiscEvent.pred: MscSerial has no predecessor" - - enumFromTo from to = go from - where - end = fromEnum to - go v = case compare (fromEnum v) end of - LT -> v : go (succ v) - EQ -> [v] - GT -> [] - - enumFrom from = enumFromTo from MscTimestamp - - fromEnum MscSerial = 0 - fromEnum MscPulseled = 1 - fromEnum MscGesture = 2 - fromEnum MscRaw = 3 - fromEnum MscScan = 4 - fromEnum MscTimestamp = 5 - - toEnum 0 = MscSerial - toEnum 1 = MscPulseled - toEnum 2 = MscGesture - toEnum 3 = MscRaw - toEnum 4 = MscScan - toEnum 5 = MscTimestamp - toEnum unmatched = error ("MiscEvent.toEnum: Cannot match " ++ show unmatched) - - - --- | LEDs -data LEDEvent = LedNuml - | LedCapsl - | LedScrolll - | LedCompose - | LedKana - | LedSleep - | LedSuspend - | LedMute - | LedMisc - | LedMail - | LedCharging - deriving (Bounded,Eq,Ord,Read,Show) -instance Enum LEDEvent where - succ LedNuml = LedCapsl - succ LedCapsl = LedScrolll - succ LedScrolll = LedCompose - succ LedCompose = LedKana - succ LedKana = LedSleep - succ LedSleep = LedSuspend - succ LedSuspend = LedMute - succ LedMute = LedMisc - succ LedMisc = LedMail - succ LedMail = LedCharging - succ LedCharging = error "LEDEvent.succ: LedCharging has no successor" - - pred LedCapsl = LedNuml - pred LedScrolll = LedCapsl - pred LedCompose = LedScrolll - pred LedKana = LedCompose - pred LedSleep = LedKana - pred LedSuspend = LedSleep - pred LedMute = LedSuspend - pred LedMisc = LedMute - pred LedMail = LedMisc - pred LedCharging = LedMail - pred LedNuml = error "LEDEvent.pred: LedNuml has no predecessor" - - enumFromTo from to = go from - where - end = fromEnum to - go v = case compare (fromEnum v) end of - LT -> v : go (succ v) - EQ -> [v] - GT -> [] - - enumFrom from = enumFromTo from LedCharging - - fromEnum LedNuml = 0 - fromEnum LedCapsl = 1 - fromEnum LedScrolll = 2 - fromEnum LedCompose = 3 - fromEnum LedKana = 4 - fromEnum LedSleep = 5 - fromEnum LedSuspend = 6 - fromEnum LedMute = 7 - fromEnum LedMisc = 8 - fromEnum LedMail = 9 - fromEnum LedCharging = 10 - - toEnum 0 = LedNuml - toEnum 1 = LedCapsl - toEnum 2 = LedScrolll - toEnum 3 = LedCompose - toEnum 4 = LedKana - toEnum 5 = LedSleep - toEnum 6 = LedSuspend - toEnum 7 = LedMute - toEnum 8 = LedMisc - toEnum 9 = LedMail - toEnum 10 = LedCharging - toEnum unmatched = error ("LEDEvent.toEnum: Cannot match " ++ show unmatched) - - - --- | Specifying autorepeating events -data RepeatEvent = RepDelay - | RepPeriod - deriving (Bounded,Eq,Ord,Read,Show) -instance Enum RepeatEvent where - succ RepDelay = RepPeriod - succ RepPeriod = error "RepeatEvent.succ: RepPeriod has no successor" - - pred RepPeriod = RepDelay - pred RepDelay = error "RepeatEvent.pred: RepDelay has no predecessor" - - enumFromTo from to = go from - where - end = fromEnum to - go v = case compare (fromEnum v) end of - LT -> v : go (succ v) - EQ -> [v] - GT -> [] - - enumFrom from = enumFromTo from RepPeriod - - fromEnum RepDelay = 0 - fromEnum RepPeriod = 1 - - toEnum 0 = RepDelay - toEnum 1 = RepPeriod - toEnum unmatched = error ("RepeatEvent.toEnum: Cannot match " ++ show unmatched) - - - --- | For simple sound output devices -data SoundEvent = SndClick - | SndBell - | SndTone - deriving (Bounded,Eq,Ord,Read,Show) -instance Enum SoundEvent where - succ SndClick = SndBell - succ SndBell = SndTone - succ SndTone = error "SoundEvent.succ: SndTone has no successor" - - pred SndBell = SndClick - pred SndTone = SndBell - pred SndClick = error "SoundEvent.pred: SndClick has no predecessor" - - enumFromTo from to = go from - where - end = fromEnum to - go v = case compare (fromEnum v) end of - LT -> v : go (succ v) - EQ -> [v] - GT -> [] - - enumFrom from = enumFromTo from SndTone - - fromEnum SndClick = 0 - fromEnum SndBell = 1 - fromEnum SndTone = 2 - - toEnum 0 = SndClick - toEnum 1 = SndBell - toEnum 2 = SndTone - toEnum unmatched = error ("SoundEvent.toEnum: Cannot match " ++ show unmatched) - - - --- | Device properties -data DeviceProperty = InputPropPointer - | InputPropDirect - | InputPropButtonpad - | InputPropSemiMt - | InputPropTopbuttonpad - | InputPropPointingStick - | InputPropAccelerometer - deriving (Bounded,Eq,Ord,Read,Show) -instance Enum DeviceProperty where - succ InputPropPointer = InputPropDirect - succ InputPropDirect = InputPropButtonpad - succ InputPropButtonpad = InputPropSemiMt - succ InputPropSemiMt = InputPropTopbuttonpad - succ InputPropTopbuttonpad = InputPropPointingStick - succ InputPropPointingStick = InputPropAccelerometer - succ InputPropAccelerometer = error "DeviceProperty.succ: InputPropAccelerometer has no successor" - - pred InputPropDirect = InputPropPointer - pred InputPropButtonpad = InputPropDirect - pred InputPropSemiMt = InputPropButtonpad - pred InputPropTopbuttonpad = InputPropSemiMt - pred InputPropPointingStick = InputPropTopbuttonpad - pred InputPropAccelerometer = InputPropPointingStick - pred InputPropPointer = error "DeviceProperty.pred: InputPropPointer has no predecessor" - - enumFromTo from to = go from - where - end = fromEnum to - go v = case compare (fromEnum v) end of - LT -> v : go (succ v) - EQ -> [v] - GT -> [] - - enumFrom from = enumFromTo from InputPropAccelerometer - - fromEnum InputPropPointer = 0 - fromEnum InputPropDirect = 1 - fromEnum InputPropButtonpad = 2 - fromEnum InputPropSemiMt = 3 - fromEnum InputPropTopbuttonpad = 4 - fromEnum InputPropPointingStick = 5 - fromEnum InputPropAccelerometer = 6 - - toEnum 0 = InputPropPointer - toEnum 1 = InputPropDirect - toEnum 2 = InputPropButtonpad - toEnum 3 = InputPropSemiMt - toEnum 4 = InputPropTopbuttonpad - toEnum 5 = InputPropPointingStick - toEnum 6 = InputPropAccelerometer - toEnum unmatched = error ("DeviceProperty.toEnum: Cannot match " ++ show unmatched) +module Evdev.Codes where +import Evdev.Codes.Generator +import Evdev.Raw +import Util +$(generateCodes) diff --git a/evdev/src/Evdev/Codes/Generator.hs b/evdev/src/Evdev/Codes/Generator.hs new file mode 100644 index 0000000..5c82b8b --- /dev/null +++ b/evdev/src/Evdev/Codes/Generator.hs @@ -0,0 +1,230 @@ +-- TODO pure vibes + +{-# LANGUAGE TemplateHaskellQuotes #-} + +module Evdev.Codes.Generator (generateCodes) where + +import Data.Char +import Data.List +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Maybe +import Language.Haskell.TH +import Numeric + +-- | A raw define from the header file. +data RawDefine + = RawPrimary String Int -- ^ Name and numeric value + | RawAlias String String -- ^ Alias name and target name + deriving (Show) + +-- | A processed define, after deduplication. +data Define + = Primary String -- ^ A name that should become a constructor + | Alias String String -- ^ An alias name pointing to a target name + deriving (Show) + +-- | Configuration for a group of defines that map to a single Haskell type. +data Group = Group + { groupTypeName :: String + , groupPrefixes :: [String] + , groupDoc :: String + } + +groups :: [Group] +groups = + [ Group "EventType" ["EV_"] "Each of these corresponds to one of the constructors of 'Evdev.EventData'. So you're unlikely to need to use these directly (C doesn't have ADTs - we do)." + , Group "SyncEvent" ["SYN_"] "Synchronization events" + , Group "Key" ["KEY_", "BTN_"] "Keys and buttons" + , Group "RelativeAxis" ["REL_"] "Relative changes" + , Group "AbsoluteAxis" ["ABS_"] "Absolute changes" + , Group "SwitchEvent" ["SW_"] "Stateful binary switches" + , Group "MiscEvent" ["MSC_"] "Miscellaneous" + , Group "LEDEvent" ["LED_"] "LEDs" + , Group "RepeatEvent" ["REP_"] "Specifying autorepeating events" + , Group "SoundEvent" ["SND_"] "For simple sound output devices" + , Group "DeviceProperty" ["INPUT_PROP_"] "Device properties" + ] + +-- | Names to skip when parsing the header. +skippedNames :: [String] +skippedNames = ["KEY_MIN_INTERESTING"] + +-- | Parse a single @#define@ line. +parseLine :: String -> Maybe RawDefine +parseLine line = case words line of + ("#define" : name : value : _) + | any (`isSuffixOf'` name) ["_MAX", "_CNT"] -> Nothing + | name `elem` skippedNames -> Nothing + | name == "_INPUT_EVENT_CODES_H" -> Nothing + | Just n <- parseNumericValue value -> Just (RawPrimary name n) + | "(" `isPrefixOf` value -> Nothing + | all (\c -> isAlphaNum c || c == '_') value -> Just (RawAlias name value) + | otherwise -> Nothing + _ -> Nothing + where + isSuffixOf' suffix str = drop (length str - length suffix) str == suffix + +-- | Parse a numeric value (decimal or hex). +parseNumericValue :: String -> Maybe Int +parseNumericValue ('0' : 'x' : rest) + | all isHexDigit rest, [(n, "")] <- readHex rest = Just n +parseNumericValue ('0' : 'X' : rest) + | all isHexDigit rest, [(n, "")] <- readHex rest = Just n +parseNumericValue s + | all isDigit s = Just (read s) +parseNumericValue _ = Nothing + +-- | Parse the header file, returning all raw defines. +parseHeader :: String -> [RawDefine] +parseHeader = mapMaybe parseLine . lines + +-- | Get the C name from a 'RawDefine'. +rawDefineName :: RawDefine -> String +rawDefineName (RawPrimary n _) = n +rawDefineName (RawAlias n _) = n + +-- | Check if a define belongs to a group. +defInGroup :: Group -> RawDefine -> Bool +defInGroup grp def = any (`isPrefixOf` rawDefineName def) (groupPrefixes grp) + +-- | Deduplicate primaries: when multiple primaries share a numeric value, +-- keep the last one as the constructor and turn earlier ones into aliases. +-- This handles cases like @BTN_GAMEPAD 0x130@ followed by @BTN_SOUTH 0x130@, +-- where @BTN_SOUTH@ becomes the constructor and @BTN_GAMEPAD@ becomes an alias. +dedup :: [RawDefine] -> [Define] +dedup rawDefs = + let -- First pass: find which name is the "winner" for each value (last one wins) + valueToName :: Map Int String + valueToName = foldl' + (\m rd -> case rd of + RawPrimary name val -> Map.insert val name m + RawAlias _ _ -> m + ) + Map.empty + rawDefs + + -- Second pass: convert, turning losers into aliases + convert :: RawDefine -> Define + convert (RawPrimary name val) = + let winner = valueToName Map.! val + in if name == winner + then Primary name + else Alias name winner + convert (RawAlias name target) = Alias name target + in map convert rawDefs + +-- | Transform a C name like @KEY_LEFT_SHIFT@ into a Haskell constructor name like @KeyLeftShift@. +toCamelCase :: [String] -> String -> String +toCamelCase prefixes cName = + let (haskPrefix, rest) = stripPrefix' prefixes cName + segments = splitOn '_' rest + in haskPrefix ++ concatMap titleCase segments + where + stripPrefix' [] n = ("", n) + stripPrefix' (p : ps) n + | p `isPrefixOf` n = (prefixToCamel p, drop (length p) n) + | otherwise = stripPrefix' ps n + + prefixToCamel p = + let segs = filter (not . null) $ splitOn '_' p + in concatMap titleCase segs + + titleCase [] = [] + titleCase (c : cs) = toUpper c : map toLower cs + +splitOn :: Char -> String -> [String] +splitOn _ [] = [] +splitOn sep s = + let (w, rest) = break (== sep) s + in w : case rest of + [] -> [] + (_ : rest') -> splitOn sep rest' + +-- | Transform a C name like @KEY_ESC@ into the hs-bindgen generated name like @kEY_ESC@. +toRawName :: String -> String +toRawName [] = [] +toRawName (c : cs) = toLower c : cs + +-- | Generate all declarations for all groups. +generateCodes :: Q [Dec] +generateCodes = do + contents <- runIO $ readFile "/nix/store/7iwv8dcgsjmkrnn752hnfdxh3f7wahmd-linux-headers-6.16.7/include/linux/input-event-codes.h" + let rawDefs = parseHeader contents + concat <$> mapM (generateGroup rawDefs) groups + +-- | Generate declarations for a single group: data type, SimpleEnum instance, and pattern synonyms. +generateGroup :: [RawDefine] -> Group -> Q [Dec] +generateGroup allRawDefs grp = do + let myRawDefs = filter (defInGroup grp) allRawDefs + myDefs = dedup myRawDefs + primaries = [n | Primary n <- myDefs] + aliases = [(a, t) | Alias a t <- myDefs] + prefixes = groupPrefixes grp + tyName = mkName (groupTypeName grp) + conNames = map (\n -> mkName (toCamelCase prefixes n)) primaries + + dataDec <- generateDataDec tyName conNames (groupDoc grp) + enumInst <- generateSimpleEnumInst tyName primaries prefixes + patSyns <- concat <$> mapM (generatePatSyn tyName prefixes) aliases + pure $ dataDec ++ enumInst ++ patSyns + +-- | Generate: @data TypeName = Con1 | Con2 | ... deriving (Bounded, Eq, Ord, Read, Show)@ +generateDataDec :: Name -> [Name] -> String -> Q [Dec] +generateDataDec tyName conNames _doc = do + let cons = map (\n -> NormalC n []) conNames + derivs = [DerivClause Nothing (map ConT [''Bounded, ''Eq, ''Ord, ''Read, ''Show])] + pure [DataD [] tyName [] Nothing cons derivs] + +-- | Generate a @SimpleEnum@ instance for the given type. +generateSimpleEnumInst :: Name -> [String] -> [String] -> Q [Dec] +generateSimpleEnumInst tyName primaries prefixes = do + let simpleEnumName = mkName "SimpleEnum" + enumerateBody = + ListE [ConE (mkName (toCamelCase prefixes p)) | p <- primaries] + + nName = mkName "n" + toEnumClauses = + let guardedBody = map + (\p -> + let rawN = mkName (toRawName p) + conN = mkName (toCamelCase prefixes p) + in ( NormalG (InfixE (Just (VarE nName)) + (VarE '(==)) + (Just (AppE (VarE 'fromIntegral) (VarE rawN)))) + , AppE (ConE 'Just) (ConE conN) + ) + ) + primaries + otherwiseGuard = + ( NormalG (VarE 'otherwise) + , ConE 'Nothing + ) + in [Clause [VarP nName] (GuardedB (guardedBody ++ [otherwiseGuard])) []] + + fromEnumMatches = map + (\p -> + let rawN = mkName (toRawName p) + conN = mkName (toCamelCase prefixes p) + in Match (ConP conN [] []) (NormalB (AppE (VarE 'fromIntegral) (VarE rawN))) [] + ) + primaries + fromEnumBody = LamCaseE fromEnumMatches + + pure + [ InstanceD Nothing [] + (AppT (ConT simpleEnumName) (ConT tyName)) + [ FunD (mkName "enumerate'") [Clause [] (NormalB enumerateBody) []] + , FunD (mkName "toEnum'") toEnumClauses + , FunD (mkName "fromEnum'") [Clause [] (NormalB fromEnumBody) []] + ] + ] + +-- | Generate a pattern synonym for an alias. +generatePatSyn :: Name -> [String] -> (String, String) -> Q [Dec] +generatePatSyn tyName prefixes (aliasName, targetName) = do + let aliasConName = mkName (toCamelCase prefixes aliasName) + targetConName = mkName (toCamelCase prefixes targetName) + patSynSig = PatSynSigD aliasConName (ConT tyName) + patSynDec = PatSynD aliasConName (PrefixPatSyn []) ImplBidir (ConP targetConName [] []) + pure [patSynSig, patSynDec] diff --git a/evdev/src/Evdev/Raw.hs b/evdev/src/Evdev/Raw.hs index a27f072..418c16f 100644 --- a/evdev/src/Evdev/Raw.hs +++ b/evdev/src/Evdev/Raw.hs @@ -32,6 +32,7 @@ do do hashInclude "libevdev/libevdev.h" hashInclude "libevdev/libevdev-uinput.h" + hashInclude "linux/input-event-codes.h" foreign import ccall "&libevdev_hs_close" libevdev_hs_close :: FinalizerPtr Libevdev foreign import ccall "&libevdev_uinput_destroy" libevdev_uinput_destroy_funptr :: FinalizerPtr Libevdev_uinput diff --git a/evdev/src/Evdev/Uinput.hs b/evdev/src/Evdev/Uinput.hs index bcc2249..0008ab0 100644 --- a/evdev/src/Evdev/Uinput.hs +++ b/evdev/src/Evdev/Uinput.hs @@ -62,26 +62,26 @@ newDevice name DeviceOpts{..} = do unless (null cs) $ cec $ withForeignPtr dev \devPtr -> Errno <$> Raw.libevdev_enable_event_type devPtr t' forM_ cs $ \c -> cec $ withForeignPtr dev \devPtr -> - Errno <$> Raw.libevdev_enable_event_code devPtr t' c + Errno <$> Raw.libevdev_enable_event_code devPtr t' (fromIntegral @Word16 @CUInt $ coerce c) (ConstPtr $ maybe nullPtr (either castPtr castPtr) dataPtr) where t' = fromEnum' t mapM_ (uncurry $ enable Nothing) - [ (EvKey, map fromEnum' keys) - , (EvRel, map fromEnum' relAxes) - , (EvMsc, map fromEnum' miscs) - , (EvSw, map fromEnum' switchs) - , (EvLed, map fromEnum' leds) - , (EvSnd, map fromEnum' sounds) - , (EvFf, map fromEnum' ffs) - , (EvPwr, map fromEnum' powers) - , (EvFfStatus, map fromEnum' ffStats) + [ (EvKey, map (EventCode . fromEnum') keys) + , (EvRel, map (EventCode . fromEnum') relAxes) + , (EvMsc, map (EventCode . fromEnum') miscs) + , (EvSw, map (EventCode . fromEnum') switchs) + , (EvLed, map (EventCode . fromEnum') leds) + , (EvSnd, map (EventCode . fromEnum') sounds) + , (EvFf, ffs) + , (EvPwr, powers) + , (EvFfStatus, ffStats) ] forM_ reps \(rep, n) -> with (fromIntegral n) \p -> - enable (Just $ Right p) EvRep [fromEnum' rep] + enable (Just $ Right p) EvRep [EventCode $ fromEnum' rep] forM_ absAxes \(axis, AbsInfo{..}) -> Raw.Input_absinfo @@ -92,7 +92,7 @@ newDevice name DeviceOpts{..} = do , flat = coerce absFlat , resolution = coerce absResolution } - & flip with \ptr -> enable (Just $ Left ptr) EvAbs [fromEnum' axis] + & flip with \ptr -> enable (Just $ Left ptr) EvAbs [EventCode $ fromEnum' axis] withForeignPtr dev \devPtr -> alloca \pp -> do cec $ Errno <$> Raw.libevdev_uinput_create_from_device diff --git a/evdev/src/Util.hs b/evdev/src/Util.hs index a7b80e8..6d5f9d8 100644 --- a/evdev/src/Util.hs +++ b/evdev/src/Util.hs @@ -8,8 +8,17 @@ import Foreign.C (CString) import Foreign.C.Error (Errno (Errno), errnoToIOError) import System.Posix.ByteString (RawFilePath) -fromEnum' :: (Num c, Enum a) => a -> c -fromEnum' = fromIntegral . fromEnum +{- | A modified form of `Enum`. +Older versions of this library had some odd c2hs-based `Enum` instances. +This was introduced to avoid silently breaking code which used those old versions. +This type class is also easier to write instances for, particularly via code generation. +-} +class SimpleEnum a where + enumerate' :: [a] + -- | Returns `Nothing` when input is out of bounds. + toEnum' :: (Integral n) => n -> Maybe a + -- | Instances will typically use `fromInteger`, so e.g. will wrap around when converting a large enum to a `Word8`. + fromEnum' :: (Num n) => a -> n handleNull :: b -> (Ptr a -> b) -> Ptr a -> b handleNull def f p = if p == nullPtr then def else f p diff --git a/evdev/test/Test.hs b/evdev/test/Test.hs index 458d1c8..b17e872 100644 --- a/evdev/test/Test.hs +++ b/evdev/test/Test.hs @@ -11,6 +11,7 @@ import Data.Maybe import Data.Time import Evdev import Evdev.Codes +import Evdev.Raw import qualified Evdev.Uinput as Uinput import Foreign.C import RawFilePath @@ -19,6 +20,7 @@ import System.IO.Error import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck +import Util main :: IO () main = defaultMain $ testGroup "Tests" [smoke, inverses] @@ -30,7 +32,7 @@ smoke :: TestTree smoke = testCase "Smoke" do start <- newEmptyMVar let duName = "evdev-test-device" - keys = [Key1 .. Key0] + keys = mapMaybe toEnum' [kEY_1 .. kEY_0] evs = concatMap ((<$> [Pressed, Released]) . KeyEvent) keys assertEqual "10 keys" 10 $ length keys du <- Uinput.newDevice duName Uinput.defaultDeviceOpts{Uinput.keys} @@ -70,7 +72,7 @@ inverses = -- 'toCEventData' takes all values for sync events to 0 - fine as they don't mean anything and [ t == t' - , fromEnum t == fromEnum EvSyn + , t == fromEnum' EvSyn , c == c' , v' == 0 ] From cc2144d88f3b67de9f08f0a7944aa71cfde941b1 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Wed, 1 Apr 2026 01:25:30 +0100 Subject: [PATCH 39/55] simplify codes generator a bit --- evdev/src/Evdev/Codes/Generator.hs | 87 ++++++++++++------------------ 1 file changed, 34 insertions(+), 53 deletions(-) diff --git a/evdev/src/Evdev/Codes/Generator.hs b/evdev/src/Evdev/Codes/Generator.hs index 5c82b8b..dc7604b 100644 --- a/evdev/src/Evdev/Codes/Generator.hs +++ b/evdev/src/Evdev/Codes/Generator.hs @@ -10,18 +10,11 @@ import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Maybe import Language.Haskell.TH -import Numeric --- | A raw define from the header file. -data RawDefine - = RawPrimary String Int -- ^ Name and numeric value - | RawAlias String String -- ^ Alias name and target name - deriving (Show) - --- | A processed define, after deduplication. +-- | A define from the header file: either a primary (value is a number) or an alias (value is another name). data Define - = Primary String -- ^ A name that should become a constructor - | Alias String String -- ^ An alias name pointing to a target name + = Primary String String -- ^ Name and raw value string (for dedup grouping) + | Alias String String -- ^ Alias name and target name deriving (Show) -- | Configuration for a group of defines that map to a single Haskell type. @@ -51,68 +44,57 @@ skippedNames :: [String] skippedNames = ["KEY_MIN_INTERESTING"] -- | Parse a single @#define@ line. -parseLine :: String -> Maybe RawDefine +parseLine :: String -> Maybe Define parseLine line = case words line of ("#define" : name : value : _) | any (`isSuffixOf'` name) ["_MAX", "_CNT"] -> Nothing | name `elem` skippedNames -> Nothing | name == "_INPUT_EVENT_CODES_H" -> Nothing - | Just n <- parseNumericValue value -> Just (RawPrimary name n) - | "(" `isPrefixOf` value -> Nothing - | all (\c -> isAlphaNum c || c == '_') value -> Just (RawAlias name value) + | isDigit (head value) -> Just (Primary name value) + | isAlpha (head value) -> Just (Alias name value) | otherwise -> Nothing _ -> Nothing where isSuffixOf' suffix str = drop (length str - length suffix) str == suffix --- | Parse a numeric value (decimal or hex). -parseNumericValue :: String -> Maybe Int -parseNumericValue ('0' : 'x' : rest) - | all isHexDigit rest, [(n, "")] <- readHex rest = Just n -parseNumericValue ('0' : 'X' : rest) - | all isHexDigit rest, [(n, "")] <- readHex rest = Just n -parseNumericValue s - | all isDigit s = Just (read s) -parseNumericValue _ = Nothing - --- | Parse the header file, returning all raw defines. -parseHeader :: String -> [RawDefine] +-- | Parse the header file, returning all defines. +parseHeader :: String -> [Define] parseHeader = mapMaybe parseLine . lines --- | Get the C name from a 'RawDefine'. -rawDefineName :: RawDefine -> String -rawDefineName (RawPrimary n _) = n -rawDefineName (RawAlias n _) = n +-- | Get the C name from a 'Define'. +defineName :: Define -> String +defineName (Primary n _) = n +defineName (Alias n _) = n -- | Check if a define belongs to a group. -defInGroup :: Group -> RawDefine -> Bool -defInGroup grp def = any (`isPrefixOf` rawDefineName def) (groupPrefixes grp) +defInGroup :: Group -> Define -> Bool +defInGroup grp def = any (`isPrefixOf` defineName def) (groupPrefixes grp) --- | Deduplicate primaries: when multiple primaries share a numeric value, +-- | Deduplicate primaries: when multiple primaries share a value string, -- keep the last one as the constructor and turn earlier ones into aliases. -- This handles cases like @BTN_GAMEPAD 0x130@ followed by @BTN_SOUTH 0x130@, -- where @BTN_SOUTH@ becomes the constructor and @BTN_GAMEPAD@ becomes an alias. -dedup :: [RawDefine] -> [Define] -dedup rawDefs = +dedup :: [Define] -> [Define] +dedup defs = let -- First pass: find which name is the "winner" for each value (last one wins) - valueToName :: Map Int String + valueToName :: Map String String valueToName = foldl' - (\m rd -> case rd of - RawPrimary name val -> Map.insert val name m - RawAlias _ _ -> m + (\m d -> case d of + Primary name val -> Map.insert val name m + Alias _ _ -> m ) Map.empty - rawDefs + defs - -- Second pass: convert, turning losers into aliases - convert :: RawDefine -> Define - convert (RawPrimary name val) = + -- Second pass: convert losers into aliases pointing to the winner + convert :: Define -> Define + convert (Primary name val) = let winner = valueToName Map.! val in if name == winner - then Primary name + then Primary name val else Alias name winner - convert (RawAlias name target) = Alias name target - in map convert rawDefs + convert a@Alias{} = a + in map convert defs -- | Transform a C name like @KEY_LEFT_SHIFT@ into a Haskell constructor name like @KeyLeftShift@. toCamelCase :: [String] -> String -> String @@ -150,15 +132,14 @@ toRawName (c : cs) = toLower c : cs generateCodes :: Q [Dec] generateCodes = do contents <- runIO $ readFile "/nix/store/7iwv8dcgsjmkrnn752hnfdxh3f7wahmd-linux-headers-6.16.7/include/linux/input-event-codes.h" - let rawDefs = parseHeader contents - concat <$> mapM (generateGroup rawDefs) groups + let defs = parseHeader contents + concat <$> mapM (generateGroup defs) groups -- | Generate declarations for a single group: data type, SimpleEnum instance, and pattern synonyms. -generateGroup :: [RawDefine] -> Group -> Q [Dec] -generateGroup allRawDefs grp = do - let myRawDefs = filter (defInGroup grp) allRawDefs - myDefs = dedup myRawDefs - primaries = [n | Primary n <- myDefs] +generateGroup :: [Define] -> Group -> Q [Dec] +generateGroup allDefs grp = do + let myDefs = dedup $ filter (defInGroup grp) allDefs + primaries = [n | Primary n _ <- myDefs] aliases = [(a, t) | Alias a t <- myDefs] prefixes = groupPrefixes grp tyName = mkName (groupTypeName grp) From 23e4d26a5d1a08a015064be1959d895d9f18930a Mon Sep 17 00:00:00 2001 From: George Thomas Date: Wed, 1 Apr 2026 01:31:07 +0100 Subject: [PATCH 40/55] avoid head --- evdev/src/Evdev/Codes/Generator.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/evdev/src/Evdev/Codes/Generator.hs b/evdev/src/Evdev/Codes/Generator.hs index dc7604b..61ce8a3 100644 --- a/evdev/src/Evdev/Codes/Generator.hs +++ b/evdev/src/Evdev/Codes/Generator.hs @@ -46,12 +46,12 @@ skippedNames = ["KEY_MIN_INTERESTING"] -- | Parse a single @#define@ line. parseLine :: String -> Maybe Define parseLine line = case words line of - ("#define" : name : value : _) + ("#define" : name : value@(v : _) : _) | any (`isSuffixOf'` name) ["_MAX", "_CNT"] -> Nothing | name `elem` skippedNames -> Nothing | name == "_INPUT_EVENT_CODES_H" -> Nothing - | isDigit (head value) -> Just (Primary name value) - | isAlpha (head value) -> Just (Alias name value) + | isDigit v -> Just (Primary name value) + | isAlpha v -> Just (Alias name value) | otherwise -> Nothing _ -> Nothing where From e096903ec492a291f721b02538b4069a165b5ba8 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Wed, 1 Apr 2026 10:53:56 +0100 Subject: [PATCH 41/55] clean up code generation more - generateCodes and the parsing stuff above it still needs review --- evdev/src/Evdev/Codes/Generator.hs | 413 ++++++++++++++++++----------- evdev/test/Test.hs | 2 +- 2 files changed, 253 insertions(+), 162 deletions(-) diff --git a/evdev/src/Evdev/Codes/Generator.hs b/evdev/src/Evdev/Codes/Generator.hs index 61ce8a3..e5c7476 100644 --- a/evdev/src/Evdev/Codes/Generator.hs +++ b/evdev/src/Evdev/Codes/Generator.hs @@ -1,43 +1,131 @@ --- TODO pure vibes - +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE MultilineStrings #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE TemplateHaskellQuotes #-} +{-# LANGUAGE NoFieldSelectors #-} module Evdev.Codes.Generator (generateCodes) where import Data.Char +import Data.Either +import Data.Foldable +import Data.Functor import Data.List +import Data.List.Extra import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Maybe +import Data.Tuple.Extra import Language.Haskell.TH +groups :: [Group] +groups = + [ Group + { typeName = mkName "EventType" + , prefixes = ["EV"] + , doc = + """ + Each of these corresponds to one of the constructors of 'Evdev.EventData'. + So you're unlikely to need to use these directly (C doesn't have ADTs - we do). + """ + } + , Group + { typeName = mkName "SyncEvent" + , prefixes = ["SYN"] + , doc = + """ + Synchronization events + """ + } + , Group + { typeName = mkName "Key" + , prefixes = ["KEY", "BTN"] + , doc = + """ + Keys and buttons + """ + } + , Group + { typeName = mkName "RelativeAxis" + , prefixes = ["REL"] + , doc = + """ + Relative changes + """ + } + , Group + { typeName = mkName "AbsoluteAxis" + , prefixes = ["ABS"] + , doc = + """ + Absolute changes + """ + } + , Group + { typeName = mkName "SwitchEvent" + , prefixes = ["SW"] + , doc = + """ + Stateful binary switches + """ + } + , Group + { typeName = mkName "MiscEvent" + , prefixes = ["MSC"] + , doc = + """ + Miscellaneous + """ + } + , Group + { typeName = mkName "LEDEvent" + , prefixes = ["LED"] + , doc = + """ + LEDs + """ + } + , Group + { typeName = mkName "RepeatEvent" + , prefixes = ["REP"] + , doc = + """ + Specifying autorepeating events + """ + } + , Group + { typeName = mkName "SoundEvent" + , prefixes = ["SND"] + , doc = + """ + For simple sound output devices + """ + } + , Group + { typeName = mkName "DeviceProperty" + , prefixes = ["INPUT_PROP"] + , doc = + """ + Device properties + """ + } + ] + -- | A define from the header file: either a primary (value is a number) or an alias (value is another name). data Define - = Primary String String -- ^ Name and raw value string (for dedup grouping) - | Alias String String -- ^ Alias name and target name + = Primary {grp :: Name, name :: String, val :: String} + | Alias {grp :: Name, name :: String, target :: String} deriving (Show) -- | Configuration for a group of defines that map to a single Haskell type. data Group = Group - { groupTypeName :: String - , groupPrefixes :: [String] - , groupDoc :: String + { typeName :: Name + , prefixes :: [String] + , doc :: String } -groups :: [Group] -groups = - [ Group "EventType" ["EV_"] "Each of these corresponds to one of the constructors of 'Evdev.EventData'. So you're unlikely to need to use these directly (C doesn't have ADTs - we do)." - , Group "SyncEvent" ["SYN_"] "Synchronization events" - , Group "Key" ["KEY_", "BTN_"] "Keys and buttons" - , Group "RelativeAxis" ["REL_"] "Relative changes" - , Group "AbsoluteAxis" ["ABS_"] "Absolute changes" - , Group "SwitchEvent" ["SW_"] "Stateful binary switches" - , Group "MiscEvent" ["MSC_"] "Miscellaneous" - , Group "LEDEvent" ["LED_"] "LEDs" - , Group "RepeatEvent" ["REP_"] "Specifying autorepeating events" - , Group "SoundEvent" ["SND_"] "For simple sound output devices" - , Group "DeviceProperty" ["INPUT_PROP_"] "Device properties" - ] +groupMap :: Map Name Group +groupMap = Map.fromList $ ((.typeName) &&& id) <$> groups -- | Names to skip when parsing the header. skippedNames :: [String] @@ -47,165 +135,168 @@ skippedNames = ["KEY_MIN_INTERESTING"] parseLine :: String -> Maybe Define parseLine line = case words line of ("#define" : name : value@(v : _) : _) - | any (`isSuffixOf'` name) ["_MAX", "_CNT"] -> Nothing + | any (`isSuffixOf` name) ["_MAX", "_CNT"] -> Nothing | name `elem` skippedNames -> Nothing | name == "_INPUT_EVENT_CODES_H" -> Nothing - | isDigit v -> Just (Primary name value) - | isAlpha v -> Just (Alias name value) + | isDigit v -> Just (Primary (getGroup name) name value) + | isAlpha v -> Just (Alias (getGroup name) name value) | otherwise -> Nothing _ -> Nothing where - isSuffixOf' suffix str = drop (length str - length suffix) str == suffix + getGroup s = + snd + . fromMaybe (error $ "no prefix matched: " <> s) + . find ((`isPrefixOf` s) . fst) + $ concatMap (\g -> (,g.typeName) <$> g.prefixes) groups -- | Parse the header file, returning all defines. -parseHeader :: String -> [Define] -parseHeader = mapMaybe parseLine . lines - --- | Get the C name from a 'Define'. -defineName :: Define -> String -defineName (Primary n _) = n -defineName (Alias n _) = n - --- | Check if a define belongs to a group. -defInGroup :: Group -> Define -> Bool -defInGroup grp def = any (`isPrefixOf` defineName def) (groupPrefixes grp) - --- | Deduplicate primaries: when multiple primaries share a value string, --- keep the last one as the constructor and turn earlier ones into aliases. --- This handles cases like @BTN_GAMEPAD 0x130@ followed by @BTN_SOUTH 0x130@, --- where @BTN_SOUTH@ becomes the constructor and @BTN_GAMEPAD@ becomes an alias. +parseHeader :: String -> [(Name, (Group, [Define]))] +parseHeader input = + Map.toList + . Map.fromListWith (\(g, a) (_, b) -> (g, a <> b)) + . map (\d -> (d.grp, (fromMaybe (error "group not found") $ Map.lookup d.grp groupMap, [d]))) + . mapMaybe parseLine + $ lines input + +{- | Deduplicate primaries: when multiple primaries share a value string, +keep the last one as the constructor and turn earlier ones into aliases. +This handles cases like @BTN_GAMEPAD 0x130@ followed by @BTN_SOUTH 0x130@, +where @BTN_SOUTH@ becomes the constructor and @BTN_GAMEPAD@ becomes an alias. +-} dedup :: [Define] -> [Define] dedup defs = - let -- First pass: find which name is the "winner" for each value (last one wins) + let + -- First pass: find which name is the "winner" for each value (last one wins) valueToName :: Map String String - valueToName = foldl' - (\m d -> case d of - Primary name val -> Map.insert val name m - Alias _ _ -> m - ) - Map.empty - defs - + valueToName = + foldl' + ( \m d -> case d of + Primary _ name val -> Map.insert val name m + Alias _ _ _ -> m + ) + Map.empty + defs -- Second pass: convert losers into aliases pointing to the winner convert :: Define -> Define - convert (Primary name val) = + convert (Primary grp name val) = let winner = valueToName Map.! val - in if name == winner - then Primary name val - else Alias name winner + in if name == winner + then Primary grp name val + else Alias grp name winner convert a@Alias{} = a - in map convert defs - --- | Transform a C name like @KEY_LEFT_SHIFT@ into a Haskell constructor name like @KeyLeftShift@. -toCamelCase :: [String] -> String -> String -toCamelCase prefixes cName = - let (haskPrefix, rest) = stripPrefix' prefixes cName - segments = splitOn '_' rest - in haskPrefix ++ concatMap titleCase segments - where - stripPrefix' [] n = ("", n) - stripPrefix' (p : ps) n - | p `isPrefixOf` n = (prefixToCamel p, drop (length p) n) - | otherwise = stripPrefix' ps n - - prefixToCamel p = - let segs = filter (not . null) $ splitOn '_' p - in concatMap titleCase segs - - titleCase [] = [] - titleCase (c : cs) = toUpper c : map toLower cs - -splitOn :: Char -> String -> [String] -splitOn _ [] = [] -splitOn sep s = - let (w, rest) = break (== sep) s - in w : case rest of - [] -> [] - (_ : rest') -> splitOn sep rest' - --- | Transform a C name like @KEY_ESC@ into the hs-bindgen generated name like @kEY_ESC@. -toRawName :: String -> String -toRawName [] = [] -toRawName (c : cs) = toLower c : cs + in + map convert defs --- | Generate all declarations for all groups. generateCodes :: Q [Dec] generateCodes = do - contents <- runIO $ readFile "/nix/store/7iwv8dcgsjmkrnn752hnfdxh3f7wahmd-linux-headers-6.16.7/include/linux/input-event-codes.h" - let defs = parseHeader contents - concat <$> mapM (generateGroup defs) groups - --- | Generate declarations for a single group: data type, SimpleEnum instance, and pattern synonyms. -generateGroup :: [Define] -> Group -> Q [Dec] -generateGroup allDefs grp = do - let myDefs = dedup $ filter (defInGroup grp) allDefs - primaries = [n | Primary n _ <- myDefs] - aliases = [(a, t) | Alias a t <- myDefs] - prefixes = groupPrefixes grp - tyName = mkName (groupTypeName grp) - conNames = map (\n -> mkName (toCamelCase prefixes n)) primaries - - dataDec <- generateDataDec tyName conNames (groupDoc grp) - enumInst <- generateSimpleEnumInst tyName primaries prefixes - patSyns <- concat <$> mapM (generatePatSyn tyName prefixes) aliases - pure $ dataDec ++ enumInst ++ patSyns - --- | Generate: @data TypeName = Con1 | Con2 | ... deriving (Bounded, Eq, Ord, Read, Show)@ -generateDataDec :: Name -> [Name] -> String -> Q [Dec] -generateDataDec tyName conNames _doc = do - let cons = map (\n -> NormalC n []) conNames - derivs = [DerivClause Nothing (map ConT [''Bounded, ''Eq, ''Ord, ''Read, ''Show])] - pure [DataD [] tyName [] Nothing cons derivs] - --- | Generate a @SimpleEnum@ instance for the given type. -generateSimpleEnumInst :: Name -> [String] -> [String] -> Q [Dec] -generateSimpleEnumInst tyName primaries prefixes = do - let simpleEnumName = mkName "SimpleEnum" - enumerateBody = - ListE [ConE (mkName (toCamelCase prefixes p)) | p <- primaries] - - nName = mkName "n" - toEnumClauses = - let guardedBody = map - (\p -> - let rawN = mkName (toRawName p) - conN = mkName (toCamelCase prefixes p) - in ( NormalG (InfixE (Just (VarE nName)) - (VarE '(==)) - (Just (AppE (VarE 'fromIntegral) (VarE rawN)))) - , AppE (ConE 'Just) (ConE conN) - ) + -- oh yeah, this doesn't do anything unless it's in the cabal file + -- addDependentFile file + contents <- runIO $ readFile file + -- for_ groups \grp -> putDoc (DeclDoc grp.typeName) grp.doc + pure $ concatMap (uncurry generateGroup . snd) $ parseHeader contents + where + -- cp /nix/store/7iwv8dcgsjmkrnn752hnfdxh3f7wahmd-linux-headers-6.16.7/include/linux/input-event-codes.h codes.h + -- file = "codes.h" + file = "/nix/store/7iwv8dcgsjmkrnn752hnfdxh3f7wahmd-linux-headers-6.16.7/include/linux/input-event-codes.h" + +generateGroup :: Group -> [Define] -> [Dec] +generateGroup grp defs = + [ dataType grp.typeName primaries + , simpleEnumInstance grp.typeName primaries + ] + <> concatMap (aliasPatternSynonym grp.typeName) aliases + where + (primaries, aliases) = + partitionEithers $ + dedup defs <&> \case + Primary _ n _ -> + Left (mkName $ toBindgenName n, mkName $ toConstructorName n) + Alias _ a t -> + Right (mkName $ toConstructorName a, mkName $ toConstructorName t) + +dataType :: Name -> [(Name, Name)] -> Dec +dataType tyName conNames = + DataD + [] + tyName + [] + Nothing + (map (flip NormalC [] . snd) conNames) + [DerivClause Nothing (map ConT [''Eq, ''Ord, ''Read, ''Show])] + +simpleEnumInstance :: Name -> [(Name, Name)] -> Dec +simpleEnumInstance tyName conNames = + InstanceD + Nothing + [] + (AppT (ConT (mkName "SimpleEnum")) (ConT tyName)) + [ FunD + (mkName "enumerate'") + [ Clause + [] + (NormalB (ListE $ map (ConE . snd) conNames)) + [] + ] + , FunD + (mkName "toEnum'") + [ let nName = mkName "n" + in Clause + [VarP nName] + ( GuardedB + ( map + ( \(raw, camel) -> + ( NormalG + ( InfixE + (Just (VarE nName)) + (VarE '(==)) + (Just (AppE (VarE 'fromIntegral) (VarE raw))) + ) + , AppE (ConE 'Just) (ConE camel) + ) + ) + conNames + <> [(NormalG (VarE 'otherwise), ConE 'Nothing)] + ) ) - primaries - otherwiseGuard = - ( NormalG (VarE 'otherwise) - , ConE 'Nothing + [] + ] + , FunD + (mkName "fromEnum'") + [ Clause + [] + ( NormalB + ( LamCaseE + ( map + ( \(raw, camel) -> + Match + (ConP camel [] []) + (NormalB (AppE (VarE 'fromIntegral) (VarE raw))) + [] + ) + conNames + ) ) - in [Clause [VarP nName] (GuardedB (guardedBody ++ [otherwiseGuard])) []] - - fromEnumMatches = map - (\p -> - let rawN = mkName (toRawName p) - conN = mkName (toCamelCase prefixes p) - in Match (ConP conN [] []) (NormalB (AppE (VarE 'fromIntegral) (VarE rawN))) [] - ) - primaries - fromEnumBody = LamCaseE fromEnumMatches - - pure - [ InstanceD Nothing [] - (AppT (ConT simpleEnumName) (ConT tyName)) - [ FunD (mkName "enumerate'") [Clause [] (NormalB enumerateBody) []] - , FunD (mkName "toEnum'") toEnumClauses - , FunD (mkName "fromEnum'") [Clause [] (NormalB fromEnumBody) []] + ) + [] ] ] --- | Generate a pattern synonym for an alias. -generatePatSyn :: Name -> [String] -> (String, String) -> Q [Dec] -generatePatSyn tyName prefixes (aliasName, targetName) = do - let aliasConName = mkName (toCamelCase prefixes aliasName) - targetConName = mkName (toCamelCase prefixes targetName) - patSynSig = PatSynSigD aliasConName (ConT tyName) - patSynDec = PatSynD aliasConName (PrefixPatSyn []) ImplBidir (ConP targetConName [] []) - pure [patSynSig, patSynDec] +aliasPatternSynonym :: Name -> (Name, Name) -> [Dec] +aliasPatternSynonym tyName (aliasName, targetName) = + [ PatSynSigD aliasName (ConT tyName) + , PatSynD aliasName (PrefixPatSyn []) ImplBidir (ConP targetName [] []) + ] + +-- KEY_LEFT_SHIFT -> KeyLeftShift +toConstructorName :: String -> String +toConstructorName = concatMap titleCase . splitOn "_" + where + titleCase = \case + [] -> [] + c : cs -> toUpper c : map toLower cs + +-- KEY_LEFT_SHIFT -> kEY_LEFT_SHIFT +toBindgenName :: String -> String +toBindgenName = \case + [] -> [] + (c : cs) -> toLower c : cs diff --git a/evdev/test/Test.hs b/evdev/test/Test.hs index b17e872..f2833ee 100644 --- a/evdev/test/Test.hs +++ b/evdev/test/Test.hs @@ -48,7 +48,7 @@ smoke = testCase "Smoke" do putMVar start () (@?= Nothing) =<< devicePhys d (@?= Nothing) =<< deviceUniq d - (@?= [EvSyn, EvKey]) =<< deviceEventTypes d + (@?= [EvKey, EvSyn]) =<< deviceEventTypes d evs' <- whileJust ((\x -> guard (x /= last evs) $> x) . eventData <$> nextEvent d) pure filter (/= SyncEvent SynReport) evs' @?= init evs From 3b2f0f10e74dd6a29d31a194608f6a13e5337311 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Wed, 1 Apr 2026 11:07:53 +0100 Subject: [PATCH 42/55] use category choice to avoid manual funptr import --- evdev/src/Evdev/Raw.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/evdev/src/Evdev/Raw.hs b/evdev/src/Evdev/Raw.hs index 418c16f..0da7d7d 100644 --- a/evdev/src/Evdev/Raw.hs +++ b/evdev/src/Evdev/Raw.hs @@ -29,10 +29,15 @@ do , programSlicing = EnableProgramSlicing } def + { categoryChoice = + def + { cUnsafe = ExcludeCategory + , cFunPtr = IncludeTermCategory $ RenameTerm (<> "_funptr") + } + } do hashInclude "libevdev/libevdev.h" hashInclude "libevdev/libevdev-uinput.h" hashInclude "linux/input-event-codes.h" foreign import ccall "&libevdev_hs_close" libevdev_hs_close :: FinalizerPtr Libevdev -foreign import ccall "&libevdev_uinput_destroy" libevdev_uinput_destroy_funptr :: FinalizerPtr Libevdev_uinput From 8943ed5446419a5420788b9ad94b21cbac93cb94 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Wed, 1 Apr 2026 12:39:11 +0100 Subject: [PATCH 43/55] more TH cleanup --- evdev/src/Evdev/Codes/Generator.hs | 199 +++++++++++++++-------------- 1 file changed, 103 insertions(+), 96 deletions(-) diff --git a/evdev/src/Evdev/Codes/Generator.hs b/evdev/src/Evdev/Codes/Generator.hs index e5c7476..c9a8916 100644 --- a/evdev/src/Evdev/Codes/Generator.hs +++ b/evdev/src/Evdev/Codes/Generator.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE MultilineStrings #-} {-# LANGUAGE OverloadedRecordDot #-} @@ -15,13 +16,13 @@ import Data.List.Extra import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Maybe -import Data.Tuple.Extra import Language.Haskell.TH +import Text.Read -groups :: [Group] +groups :: [TypeInfo] groups = - [ Group - { typeName = mkName "EventType" + [ TypeInfo + { name = TypeName $ mkName "EventType" , prefixes = ["EV"] , doc = """ @@ -29,80 +30,80 @@ groups = So you're unlikely to need to use these directly (C doesn't have ADTs - we do). """ } - , Group - { typeName = mkName "SyncEvent" + , TypeInfo + { name = TypeName $ mkName "SyncEvent" , prefixes = ["SYN"] , doc = """ Synchronization events """ } - , Group - { typeName = mkName "Key" + , TypeInfo + { name = TypeName $ mkName "Key" , prefixes = ["KEY", "BTN"] , doc = """ Keys and buttons """ } - , Group - { typeName = mkName "RelativeAxis" + , TypeInfo + { name = TypeName $ mkName "RelativeAxis" , prefixes = ["REL"] , doc = """ Relative changes """ } - , Group - { typeName = mkName "AbsoluteAxis" + , TypeInfo + { name = TypeName $ mkName "AbsoluteAxis" , prefixes = ["ABS"] , doc = """ Absolute changes """ } - , Group - { typeName = mkName "SwitchEvent" + , TypeInfo + { name = TypeName $ mkName "SwitchEvent" , prefixes = ["SW"] , doc = """ Stateful binary switches """ } - , Group - { typeName = mkName "MiscEvent" + , TypeInfo + { name = TypeName $ mkName "MiscEvent" , prefixes = ["MSC"] , doc = """ Miscellaneous """ } - , Group - { typeName = mkName "LEDEvent" + , TypeInfo + { name = TypeName $ mkName "LEDEvent" , prefixes = ["LED"] , doc = """ LEDs """ } - , Group - { typeName = mkName "RepeatEvent" + , TypeInfo + { name = TypeName $ mkName "RepeatEvent" , prefixes = ["REP"] , doc = """ Specifying autorepeating events """ } - , Group - { typeName = mkName "SoundEvent" + , TypeInfo + { name = TypeName $ mkName "SoundEvent" , prefixes = ["SND"] , doc = """ For simple sound output devices """ } - , Group - { typeName = mkName "DeviceProperty" + , TypeInfo + { name = TypeName $ mkName "DeviceProperty" , prefixes = ["INPUT_PROP"] , doc = """ @@ -111,52 +112,52 @@ groups = } ] --- | A define from the header file: either a primary (value is a number) or an alias (value is another name). -data Define - = Primary {grp :: Name, name :: String, val :: String} - | Alias {grp :: Name, name :: String, target :: String} - deriving (Show) - --- | Configuration for a group of defines that map to a single Haskell type. -data Group = Group - { typeName :: Name +data TypeInfo = TypeInfo + { name :: TypeName , prefixes :: [String] , doc :: String } -groupMap :: Map Name Group -groupMap = Map.fromList $ ((.typeName) &&& id) <$> groups - --- | Names to skip when parsing the header. -skippedNames :: [String] -skippedNames = ["KEY_MIN_INTERESTING"] +data Define + = Primary {name :: MacroName, value :: Int} + | Alias {name :: MacroName, target :: MacroName} + deriving (Show) -- | Parse a single @#define@ line. parseLine :: String -> Maybe Define parseLine line = case words line of - ("#define" : name : value@(v : _) : _) - | any (`isSuffixOf` name) ["_MAX", "_CNT"] -> Nothing - | name `elem` skippedNames -> Nothing - | name == "_INPUT_EVENT_CODES_H" -> Nothing - | isDigit v -> Just (Primary (getGroup name) name value) - | isAlpha v -> Just (Alias (getGroup name) name value) - | otherwise -> Nothing + ("#define" : k@(MacroName -> name) : v : _) + | any (`isSuffixOf` k) metaSuffices -> Nothing + | Just value <- readMaybe v -> Just Primary{name, value} + | otherwise -> Just Alias{name, target = MacroName v} _ -> Nothing where - getGroup s = - snd - . fromMaybe (error $ "no prefix matched: " <> s) - . find ((`isPrefixOf` s) . fst) - $ concatMap (\g -> (,g.typeName) <$> g.prefixes) groups + metaSuffices = + [ "_MAX" + , "_CNT" + , "_MIN_INTERESTING" + ] --- | Parse the header file, returning all defines. -parseHeader :: String -> [(Name, (Group, [Define]))] +parseHeader :: String -> [(TypeInfo, [Define])] parseHeader input = - Map.toList - . Map.fromListWith (\(g, a) (_, b) -> (g, a <> b)) - . map (\d -> (d.grp, (fromMaybe (error "group not found") $ Map.lookup d.grp groupMap, [d]))) + map snd + . Map.toList + . Map.fromListWith (\(t, a) (_, b) -> (t, a <> b)) + . map + ( \d -> + let + MacroName s = d.name + ty = + snd + . fromMaybe (error $ "no prefix matched: " <> show d.name) + $ find (\(p, _) -> p `isPrefixOf` s) prefixes + in + (ty.name, (ty, [d])) + ) . mapMaybe parseLine $ lines input + where + prefixes = concatMap (\g -> (,g) <$> g.prefixes) groups {- | Deduplicate primaries: when multiple primaries share a value string, keep the last one as the constructor and turn earlier ones into aliases. @@ -167,65 +168,69 @@ dedup :: [Define] -> [Define] dedup defs = let -- First pass: find which name is the "winner" for each value (last one wins) - valueToName :: Map String String + valueToName :: Map Int MacroName valueToName = foldl' ( \m d -> case d of - Primary _ name val -> Map.insert val name m - Alias _ _ _ -> m + Primary name val -> Map.insert val name m + Alias _ _ -> m ) Map.empty defs -- Second pass: convert losers into aliases pointing to the winner convert :: Define -> Define - convert (Primary grp name val) = + convert (Primary name val) = let winner = valueToName Map.! val in if name == winner - then Primary grp name val - else Alias grp name winner + then Primary name val + else Alias name winner convert a@Alias{} = a in map convert defs +newtype MacroName = MacroName String deriving newtype (Eq, Ord, Show) +newtype TypeName = TypeName Name deriving newtype (Eq, Ord, Show) +newtype BindgenName = BindgenName Name deriving newtype (Eq, Ord, Show) +newtype ConstructorName = ConstructorName Name deriving newtype (Eq, Ord, Show) +newtype PatternName = PatternName Name deriving newtype (Eq, Ord, Show) + generateCodes :: Q [Dec] generateCodes = do -- oh yeah, this doesn't do anything unless it's in the cabal file -- addDependentFile file contents <- runIO $ readFile file - -- for_ groups \grp -> putDoc (DeclDoc grp.typeName) grp.doc - pure $ concatMap (uncurry generateGroup . snd) $ parseHeader contents + -- for_ groups \TypeInfo{name = TypeName name, doc} -> putDoc (DeclDoc name) doc + pure $ concatMap (uncurry generateType) $ parseHeader contents where -- cp /nix/store/7iwv8dcgsjmkrnn752hnfdxh3f7wahmd-linux-headers-6.16.7/include/linux/input-event-codes.h codes.h -- file = "codes.h" file = "/nix/store/7iwv8dcgsjmkrnn752hnfdxh3f7wahmd-linux-headers-6.16.7/include/linux/input-event-codes.h" -generateGroup :: Group -> [Define] -> [Dec] -generateGroup grp defs = - [ dataType grp.typeName primaries - , simpleEnumInstance grp.typeName primaries +generateType :: TypeInfo -> [Define] -> [Dec] +generateType ty defs = + [ dataType ty.name $ map snd primaries + , simpleEnumInstance ty.name primaries ] - <> concatMap (aliasPatternSynonym grp.typeName) aliases + <> concatMap (patternSynonym ty.name) aliases where (primaries, aliases) = partitionEithers $ dedup defs <&> \case - Primary _ n _ -> - Left (mkName $ toBindgenName n, mkName $ toConstructorName n) - Alias _ a t -> - Right (mkName $ toConstructorName a, mkName $ toConstructorName t) + Primary n _ -> Left (toBindgenName n, toConstructorName n) + Alias a t -> Right (toPatternName a, toConstructorName t) -dataType :: Name -> [(Name, Name)] -> Dec -dataType tyName conNames = +dataType :: TypeName -> [ConstructorName] -> Dec +dataType (TypeName tyName) conNames = DataD [] tyName [] Nothing - (map (flip NormalC [] . snd) conNames) + (conNames <&> \(ConstructorName s) -> NormalC s []) [DerivClause Nothing (map ConT [''Eq, ''Ord, ''Read, ''Show])] -simpleEnumInstance :: Name -> [(Name, Name)] -> Dec -simpleEnumInstance tyName conNames = +simpleEnumInstance :: TypeName -> [(BindgenName, ConstructorName)] -> Dec +simpleEnumInstance (TypeName tyName) conNames = InstanceD Nothing [] @@ -234,24 +239,24 @@ simpleEnumInstance tyName conNames = (mkName "enumerate'") [ Clause [] - (NormalB (ListE $ map (ConE . snd) conNames)) + (NormalB (ListE $ conNames <&> \(_, ConstructorName s) -> ConE s)) [] ] , FunD (mkName "toEnum'") - [ let nName = mkName "n" + [ let n = mkName "n" in Clause - [VarP nName] + [VarP n] ( GuardedB ( map - ( \(raw, camel) -> + ( \(BindgenName val, ConstructorName con) -> ( NormalG ( InfixE - (Just (VarE nName)) + (Just (VarE n)) (VarE '(==)) - (Just (AppE (VarE 'fromIntegral) (VarE raw))) + (Just (AppE (VarE 'fromIntegral) (VarE val))) ) - , AppE (ConE 'Just) (ConE camel) + , AppE (ConE 'Just) (ConE con) ) ) conNames @@ -267,10 +272,10 @@ simpleEnumInstance tyName conNames = ( NormalB ( LamCaseE ( map - ( \(raw, camel) -> + ( \(BindgenName val, ConstructorName con) -> Match - (ConP camel [] []) - (NormalB (AppE (VarE 'fromIntegral) (VarE raw))) + (ConP con [] []) + (NormalB (AppE (VarE 'fromIntegral) (VarE val))) [] ) conNames @@ -281,22 +286,24 @@ simpleEnumInstance tyName conNames = ] ] -aliasPatternSynonym :: Name -> (Name, Name) -> [Dec] -aliasPatternSynonym tyName (aliasName, targetName) = - [ PatSynSigD aliasName (ConT tyName) - , PatSynD aliasName (PrefixPatSyn []) ImplBidir (ConP targetName [] []) +patternSynonym :: TypeName -> (PatternName, ConstructorName) -> [Dec] +patternSynonym (TypeName tyName) (PatternName pat, ConstructorName con) = + [ PatSynSigD pat (ConT tyName) + , PatSynD pat (PrefixPatSyn []) ImplBidir (ConP con [] []) ] -- KEY_LEFT_SHIFT -> KeyLeftShift -toConstructorName :: String -> String -toConstructorName = concatMap titleCase . splitOn "_" +toConstructorName :: MacroName -> ConstructorName +toPatternName :: MacroName -> PatternName +(toConstructorName, toPatternName) = (f ConstructorName, f PatternName) where + f c (MacroName s) = c . mkName . concatMap titleCase . splitOn "_" $ s titleCase = \case [] -> [] c : cs -> toUpper c : map toLower cs -- KEY_LEFT_SHIFT -> kEY_LEFT_SHIFT -toBindgenName :: String -> String -toBindgenName = \case +toBindgenName :: MacroName -> BindgenName +toBindgenName (MacroName s) = BindgenName $ mkName case s of [] -> [] (c : cs) -> toLower c : cs From 0d78de8f86225d23402b624a1544a4971ce85edd Mon Sep 17 00:00:00 2001 From: George Thomas Date: Thu, 2 Apr 2026 23:57:39 +0100 Subject: [PATCH 44/55] avoid aligning pattern matches --- evdev/src/Evdev.hs | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/evdev/src/Evdev.hs b/evdev/src/Evdev.hs index 0edf112..0d32ec3 100644 --- a/evdev/src/Evdev.hs +++ b/evdev/src/Evdev.hs @@ -184,15 +184,15 @@ fromCEvent Raw.Input_event{type', code, value, time} = fromCEventData :: (Word16, Word16, Int32) -> EventData fromCEventData (t, c'@(EventCode -> c), v'@(EventValue -> v)) = fromMaybe (UnknownEvent t c v) $ toEnum' t >>= \case - EvSyn -> SyncEvent <$> toEnum' c' - EvKey -> KeyEvent <$> toEnum' c' <*> case v' of 0 -> Just Released; 1-> Just Pressed; 2-> Just Repeated; _-> Nothing + EvSyn -> SyncEvent <$> toEnum' c' + EvKey -> KeyEvent <$> toEnum' c' <*> case v' of 0 -> Just Released; 1-> Just Pressed; 2-> Just Repeated; _-> Nothing EvRel -> RelativeEvent <$> toEnum' c' <*> pure v EvAbs -> AbsoluteEvent <$> toEnum' c' <*> pure v - EvMsc -> MiscEvent <$> toEnum' c' <*> pure v - EvSw -> SwitchEvent <$> toEnum' c' <*> pure v - EvLed -> LEDEvent <$> toEnum' c' <*> pure v - EvSnd -> SoundEvent <$> toEnum' c' <*> pure v - EvRep -> RepeatEvent <$> toEnum' c' <*> pure v + EvMsc -> MiscEvent <$> toEnum' c' <*> pure v + EvSw -> SwitchEvent <$> toEnum' c' <*> pure v + EvLed -> LEDEvent <$> toEnum' c' <*> pure v + EvSnd -> SoundEvent <$> toEnum' c' <*> pure v + EvRep -> RepeatEvent <$> toEnum' c' <*> pure v EvFf -> Just $ ForceFeedbackEvent c v EvPwr -> Just $ PowerEvent c v EvFfStatus -> Just $ ForceFeedbackStatusEvent c v @@ -203,19 +203,19 @@ toCEvent (Event e time) = uncurry3 (Raw.Input_event $ toCTimeVal time) (coerce $ toCEventData :: EventData -> (Word16, Word16, Int32) toCEventData = \case -- from kernel docs, 'EV_SYN event values are undefined' - we always seem to see 0, so may as well use that - SyncEvent (fromEnum' -> c) -> (fromEnum' EvSyn, c, 0) - KeyEvent (fromEnum' -> c) (fromIntegral . fromEnum -> v) -> (fromEnum' EvKey, c, v) - RelativeEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvRel, c, v) - AbsoluteEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvAbs, c, v) - MiscEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvMsc, c, v) - SwitchEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvSw, c, v) - LEDEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvLed, c, v) - SoundEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvSnd, c, v) - RepeatEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvRep, c, v) - ForceFeedbackEvent (coerce -> c) (coerce -> v) -> (fromEnum' EvFf, c, v) - PowerEvent (coerce -> c) (coerce -> v) -> (fromEnum' EvPwr, c, v) + SyncEvent (fromEnum' -> c) -> (fromEnum' EvSyn, c, 0) + KeyEvent (fromEnum' -> c) (fromIntegral . fromEnum -> v) -> (fromEnum' EvKey, c, v) + RelativeEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvRel, c, v) + AbsoluteEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvAbs, c, v) + MiscEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvMsc, c, v) + SwitchEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvSw, c, v) + LEDEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvLed, c, v) + SoundEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvSnd, c, v) + RepeatEvent (fromEnum' -> c) (coerce -> v) -> (fromEnum' EvRep, c, v) + ForceFeedbackEvent (coerce -> c) (coerce -> v) -> (fromEnum' EvFf, c, v) + PowerEvent (coerce -> c) (coerce -> v) -> (fromEnum' EvPwr, c, v) ForceFeedbackStatusEvent (coerce -> c) (coerce -> v) -> (fromEnum' EvFfStatus, c, v) - UnknownEvent t (coerce -> c) (coerce -> v) -> (t, c, v) + UnknownEvent t (coerce -> c) (coerce -> v) -> (t, c, v) fromCTimeVal :: Raw.Timeval -> DiffTime fromCTimeVal Raw.Timeval{tv_sec = s, tv_usec = us} = From 0b39f87519e691a749510ca0955a0edc827afbdb Mon Sep 17 00:00:00 2001 From: George Thomas Date: Thu, 9 Apr 2026 19:40:06 +0100 Subject: [PATCH 45/55] format --- evdev/src/Evdev/Codes.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/evdev/src/Evdev/Codes.hs b/evdev/src/Evdev/Codes.hs index ef64814..1daf7ee 100644 --- a/evdev/src/Evdev/Codes.hs +++ b/evdev/src/Evdev/Codes.hs @@ -1,7 +1,8 @@ {-# LANGUAGE TemplateHaskell #-} --- | 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. +{- | 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 import Evdev.Codes.Generator From 3c12bfea258addcdb520c176537a252004d88c26 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Thu, 9 Apr 2026 20:11:30 +0100 Subject: [PATCH 46/55] avoid hardcoding header paths --- evdev/evdev.cabal | 1 + evdev/src/Evdev/Codes.hs | 18 +++++++++++++++++- evdev/src/Evdev/Codes/Generator.hs | 11 ++--------- evdev/src/Evdev/Raw.hs | 28 +++++++++++++++++++++------- 4 files changed, 41 insertions(+), 17 deletions(-) diff --git a/evdev/evdev.cabal b/evdev/evdev.cabal index 17caa44..6b74a24 100644 --- a/evdev/evdev.cabal +++ b/evdev/evdev.cabal @@ -28,6 +28,7 @@ common common hs-bindgen-runtime ^>= {0.1}, monad-loops ^>= 0.4.3, mtl ^>= {2.2, 2.3}, + process ^>= 1.6, rawfilepath ^>= {1.0, 1.1}, template-haskell ^>= {2.21, 2.22, 2.23}, time ^>= {1.9.3, 1.10, 1.11, 1.12, 1.13, 1.14, 1.15}, diff --git a/evdev/src/Evdev/Codes.hs b/evdev/src/Evdev/Codes.hs index 1daf7ee..a1abb4d 100644 --- a/evdev/src/Evdev/Codes.hs +++ b/evdev/src/Evdev/Codes.hs @@ -5,8 +5,24 @@ See [the Linux Kernel documentation](https://www.kernel.org/doc/html/latest/inpu -} module Evdev.Codes where +import Data.Char +import Data.List +import Data.Maybe +import Data.Tuple.Extra import Evdev.Codes.Generator import Evdev.Raw +import Language.Haskell.TH +import System.Process import Util -$(generateCodes) +$( do + libc <- + dropWhile isSpace + . fromMaybe (error "bad cpp response") + . find ("libc" `isInfixOf`) + . dropWhile (not . ("#include" `isPrefixOf`)) + . lines + . thd3 + <$> runIO (readProcessWithExitCode "cpp" ["-v"] "") + generateCodes $ libc <> "/linux/input-event-codes.h" + ) diff --git a/evdev/src/Evdev/Codes/Generator.hs b/evdev/src/Evdev/Codes/Generator.hs index c9a8916..56d100d 100644 --- a/evdev/src/Evdev/Codes/Generator.hs +++ b/evdev/src/Evdev/Codes/Generator.hs @@ -194,17 +194,10 @@ newtype BindgenName = BindgenName Name deriving newtype (Eq, Ord, Show) newtype ConstructorName = ConstructorName Name deriving newtype (Eq, Ord, Show) newtype PatternName = PatternName Name deriving newtype (Eq, Ord, Show) -generateCodes :: Q [Dec] -generateCodes = do - -- oh yeah, this doesn't do anything unless it's in the cabal file - -- addDependentFile file +generateCodes :: FilePath -> Q [Dec] +generateCodes file = do contents <- runIO $ readFile file - -- for_ groups \TypeInfo{name = TypeName name, doc} -> putDoc (DeclDoc name) doc pure $ concatMap (uncurry generateType) $ parseHeader contents - where - -- cp /nix/store/7iwv8dcgsjmkrnn752hnfdxh3f7wahmd-linux-headers-6.16.7/include/linux/input-event-codes.h codes.h - -- file = "codes.h" - file = "/nix/store/7iwv8dcgsjmkrnn752hnfdxh3f7wahmd-linux-headers-6.16.7/include/linux/input-event-codes.h" generateType :: TypeInfo -> [Define] -> [Dec] generateType ty defs = diff --git a/evdev/src/Evdev/Raw.hs b/evdev/src/Evdev/Raw.hs index 0da7d7d..2825366 100644 --- a/evdev/src/Evdev/Raw.hs +++ b/evdev/src/Evdev/Raw.hs @@ -11,20 +11,34 @@ module Evdev.Raw where +import Data.Char +import Data.List +import Data.Maybe +import Data.Tuple.Extra import Foreign import HsBindgen.Runtime.LibC qualified import HsBindgen.TH +import Language.Haskell.TH +import System.Process do + libevdev <- + dropWhileEnd isSpace + . fromMaybe (error "bad pkg-config response") + . stripPrefix "-I" + <$> runIO (readProcess "pkg-config" ["--cflags-only-I", "libevdev"] "") + -- TODO put this code in another file so we can reuse it for `Codes.hs` without hitting stage restriction + libc <- + dropWhile isSpace + . fromMaybe (error "bad cpp response") + . find ("libc" `isInfixOf`) + . dropWhile (not . ("#include" `isPrefixOf`)) + . lines + . thd3 + <$> runIO (readProcessWithExitCode "cpp" ["-v"] "") withHsBindgen def - { clang = - def - { extraIncludeDirs = - [ Dir "/nix/store/iqs23in0fqnf44vnb8l98x7bai77jiv3-libevdev-1.13.4/include/libevdev-1.0" - , Dir "/nix/store/gi4cz4ir3zlwhf1azqfgxqdnczfrwsr7-glibc-2.40-66-dev/include" - ] - } + { clang = def{extraIncludeDirs = [Dir libevdev, Dir libc]} , fieldNamingStrategy = OmitFieldPrefixes , programSlicing = EnableProgramSlicing } From d4f279b32f928dd7e90221f238e685ea4c65221b Mon Sep 17 00:00:00 2001 From: George Thomas Date: Thu, 9 Apr 2026 20:44:37 +0100 Subject: [PATCH 47/55] vibey use of hs-bindgen Nix hook - works but hard to see how it would work for NixOS users to just get the library straight from Hackage, without adding special support to Haskell.nix etc. --- evdev/evdev.cabal | 3 ++- evdev/src/Evdev/Codes.hs | 38 ++++++++++++++++++++++++++------------ evdev/src/Evdev/Raw.hs | 28 ++++++++++++++++------------ flake.nix | 22 ++++++++++++++++++++++ 4 files changed, 66 insertions(+), 25 deletions(-) diff --git a/evdev/evdev.cabal b/evdev/evdev.cabal index 6b74a24..972345f 100644 --- a/evdev/evdev.cabal +++ b/evdev/evdev.cabal @@ -28,7 +28,8 @@ common common hs-bindgen-runtime ^>= {0.1}, monad-loops ^>= 0.4.3, mtl ^>= {2.2, 2.3}, - process ^>= 1.6, + directory, + process, rawfilepath ^>= {1.0, 1.1}, template-haskell ^>= {2.21, 2.22, 2.23}, time ^>= {1.9.3, 1.10, 1.11, 1.12, 1.13, 1.14, 1.15}, diff --git a/evdev/src/Evdev/Codes.hs b/evdev/src/Evdev/Codes.hs index a1abb4d..d90619e 100644 --- a/evdev/src/Evdev/Codes.hs +++ b/evdev/src/Evdev/Codes.hs @@ -5,24 +5,38 @@ See [the Linux Kernel documentation](https://www.kernel.org/doc/html/latest/inpu -} module Evdev.Codes where -import Data.Char +import Control.Applicative +import Control.Monad import Data.List import Data.Maybe -import Data.Tuple.Extra import Evdev.Codes.Generator import Evdev.Raw import Language.Haskell.TH -import System.Process +import System.Directory +import System.Environment import Util $( do - libc <- - dropWhile isSpace - . fromMaybe (error "bad cpp response") - . find ("libc" `isInfixOf`) - . dropWhile (not . ("#include" `isPrefixOf`)) - . lines - . thd3 - <$> runIO (readProcessWithExitCode "cpp" ["-v"] "") - generateCodes $ libc <> "/linux/input-event-codes.h" + -- Find linux/input-event-codes.h. On Nix, we search the include dirs from + -- BINDGEN_EXTRA_CLANG_ARGS. On non-Nix, it's in /usr/include. + let header = "linux/input-event-codes.h" + -- Parse -I, -isystem, and -idirafter flags from clang args. + -- These can appear as "-isystem/path" or "-isystem /path" (two tokens). + includeDirs = go . words + where + twoPartFlags = ["-isystem", "-idirafter", "-iprefix", "-iwithprefix"] + go [] = [] + go (flag : dir : rest) | flag `elem` twoPartFlags = dir : go rest + go (w : rest) + | Just dir <- stripPrefix "-isystem" w <|> stripPrefix "-idirafter" w <|> stripPrefix "-I" w = dir : go rest + | otherwise = go rest + findHeader dirs = runIO $ listToMaybe <$> filterM (\d -> doesFileExist $ d <> "/" <> header) dirs + result <- + runIO (lookupEnv "BINDGEN_EXTRA_CLANG_ARGS") >>= \case + Just args -> findHeader $ includeDirs args + Nothing -> findHeader ["/usr/include"] + incDir <- case result of + Just d -> pure d + Nothing -> error $ "Could not find " <> header <> ". Set BINDGEN_EXTRA_CLANG_ARGS or install linux headers." + generateCodes $ incDir <> "/" <> header ) diff --git a/evdev/src/Evdev/Raw.hs b/evdev/src/Evdev/Raw.hs index 2825366..2931c9e 100644 --- a/evdev/src/Evdev/Raw.hs +++ b/evdev/src/Evdev/Raw.hs @@ -14,7 +14,6 @@ module Evdev.Raw where import Data.Char import Data.List import Data.Maybe -import Data.Tuple.Extra import Foreign import HsBindgen.Runtime.LibC qualified import HsBindgen.TH @@ -22,23 +21,28 @@ import Language.Haskell.TH import System.Process do + -- hs-bindgen uses its own libclang to parse C headers, which is entirely + -- separate from Cabal's C compilation pipeline. Cabal's `pkgconfig-depends` + -- feeds into GHC/cc but NOT into hs-bindgen's libclang. So we must provide + -- include paths explicitly. + -- + -- System headers (libc, linux): On non-Nix systems, libclang finds these + -- via its default search paths (e.g. /usr/include). On Nix, the + -- `hsBindgenHook` setup hook populates `BINDGEN_EXTRA_CLANG_ARGS` with the + -- necessary `-isystem` flags. + -- See: https://github.com/well-typed/hs-bindgen/tree/main/nix/ + -- + -- libevdev headers: These live in a versioned subdirectory (e.g. + -- include/libevdev-1.0/) that neither libclang's defaults nor the Nix hook + -- cover, so we always need pkg-config to locate them. libevdev <- dropWhileEnd isSpace - . fromMaybe (error "bad pkg-config response") + . fromMaybe (error "pkg-config failed to locate libevdev") . stripPrefix "-I" <$> runIO (readProcess "pkg-config" ["--cflags-only-I", "libevdev"] "") - -- TODO put this code in another file so we can reuse it for `Codes.hs` without hitting stage restriction - libc <- - dropWhile isSpace - . fromMaybe (error "bad cpp response") - . find ("libc" `isInfixOf`) - . dropWhile (not . ("#include" `isPrefixOf`)) - . lines - . thd3 - <$> runIO (readProcessWithExitCode "cpp" ["-v"] "") withHsBindgen def - { clang = def{extraIncludeDirs = [Dir libevdev, Dir libc]} + { clang = def{extraIncludeDirs = [Dir libevdev]} , fieldNamingStrategy = OmitFieldPrefixes , programSlicing = EnableProgramSlicing } diff --git a/flake.nix b/flake.nix index 1df4757..9af0c86 100644 --- a/flake.nix +++ b/flake.nix @@ -23,11 +23,33 @@ build-tools = [ pkgs.llvmPackages.llvm ]; libs = [ pkgs.llvmPackages.libclang ]; }; + packages.evdev.components.library = { + build-tools = [ hsBindgenHook ]; + }; }]; }; }) ]; pkgs = import nixpkgs { inherit system overlays; inherit (haskell-nix) config; }; + # hs-bindgen's libclang is separate from Cabal's C compilation pipeline, + # so it needs explicit include paths. This hook (modelled on hs-bindgen's + # own hsBindgenHook) sets BINDGEN_EXTRA_CLANG_ARGS so that libclang can + # find system and library headers in the Nix store. + # See: https://github.com/well-typed/hs-bindgen/tree/main/nix/ + hsBindgenHook = pkgs.makeSetupHook { + name = "hs-bindgen-hook"; + substitutions = { + clang = pkgs.llvmPackages.clang; + }; + } (pkgs.writeText "hs-bindgen-hook.sh" '' + populateHsBindgenEnv() { + BINDGEN_EXTRA_CLANG_ARGS="$(<@clang@/nix-support/cc-cflags) $(<@clang@/nix-support/libc-cflags) $NIX_CFLAGS_COMPILE" + export BINDGEN_EXTRA_CLANG_ARGS + BINDGEN_BUILTIN_INCLUDE_DIR=disable + export BINDGEN_BUILTIN_INCLUDE_DIR + } + postHook="''${postHook:-}"$'\n'"populateHsBindgenEnv"$'\n' + ''); flake = pkgs.myHaskellProject.flake { }; in flake // { From 013f515a30929c64432871a364c3998670ba795a Mon Sep 17 00:00:00 2001 From: George Thomas Date: Thu, 9 Apr 2026 21:10:03 +0100 Subject: [PATCH 48/55] Revert "vibey use of hs-bindgen Nix hook - works but hard to see how it would work for NixOS users to just get the library straight from Hackage, without adding special support to Haskell.nix etc." This reverts commit d4f279b32f928dd7e90221f238e685ea4c65221b. --- evdev/evdev.cabal | 3 +-- evdev/src/Evdev/Codes.hs | 38 ++++++++++++-------------------------- evdev/src/Evdev/Raw.hs | 28 ++++++++++++---------------- flake.nix | 22 ---------------------- 4 files changed, 25 insertions(+), 66 deletions(-) diff --git a/evdev/evdev.cabal b/evdev/evdev.cabal index 972345f..6b74a24 100644 --- a/evdev/evdev.cabal +++ b/evdev/evdev.cabal @@ -28,8 +28,7 @@ common common hs-bindgen-runtime ^>= {0.1}, monad-loops ^>= 0.4.3, mtl ^>= {2.2, 2.3}, - directory, - process, + process ^>= 1.6, rawfilepath ^>= {1.0, 1.1}, template-haskell ^>= {2.21, 2.22, 2.23}, time ^>= {1.9.3, 1.10, 1.11, 1.12, 1.13, 1.14, 1.15}, diff --git a/evdev/src/Evdev/Codes.hs b/evdev/src/Evdev/Codes.hs index d90619e..a1abb4d 100644 --- a/evdev/src/Evdev/Codes.hs +++ b/evdev/src/Evdev/Codes.hs @@ -5,38 +5,24 @@ See [the Linux Kernel documentation](https://www.kernel.org/doc/html/latest/inpu -} module Evdev.Codes where -import Control.Applicative -import Control.Monad +import Data.Char import Data.List import Data.Maybe +import Data.Tuple.Extra import Evdev.Codes.Generator import Evdev.Raw import Language.Haskell.TH -import System.Directory -import System.Environment +import System.Process import Util $( do - -- Find linux/input-event-codes.h. On Nix, we search the include dirs from - -- BINDGEN_EXTRA_CLANG_ARGS. On non-Nix, it's in /usr/include. - let header = "linux/input-event-codes.h" - -- Parse -I, -isystem, and -idirafter flags from clang args. - -- These can appear as "-isystem/path" or "-isystem /path" (two tokens). - includeDirs = go . words - where - twoPartFlags = ["-isystem", "-idirafter", "-iprefix", "-iwithprefix"] - go [] = [] - go (flag : dir : rest) | flag `elem` twoPartFlags = dir : go rest - go (w : rest) - | Just dir <- stripPrefix "-isystem" w <|> stripPrefix "-idirafter" w <|> stripPrefix "-I" w = dir : go rest - | otherwise = go rest - findHeader dirs = runIO $ listToMaybe <$> filterM (\d -> doesFileExist $ d <> "/" <> header) dirs - result <- - runIO (lookupEnv "BINDGEN_EXTRA_CLANG_ARGS") >>= \case - Just args -> findHeader $ includeDirs args - Nothing -> findHeader ["/usr/include"] - incDir <- case result of - Just d -> pure d - Nothing -> error $ "Could not find " <> header <> ". Set BINDGEN_EXTRA_CLANG_ARGS or install linux headers." - generateCodes $ incDir <> "/" <> header + libc <- + dropWhile isSpace + . fromMaybe (error "bad cpp response") + . find ("libc" `isInfixOf`) + . dropWhile (not . ("#include" `isPrefixOf`)) + . lines + . thd3 + <$> runIO (readProcessWithExitCode "cpp" ["-v"] "") + generateCodes $ libc <> "/linux/input-event-codes.h" ) diff --git a/evdev/src/Evdev/Raw.hs b/evdev/src/Evdev/Raw.hs index 2931c9e..2825366 100644 --- a/evdev/src/Evdev/Raw.hs +++ b/evdev/src/Evdev/Raw.hs @@ -14,6 +14,7 @@ module Evdev.Raw where import Data.Char import Data.List import Data.Maybe +import Data.Tuple.Extra import Foreign import HsBindgen.Runtime.LibC qualified import HsBindgen.TH @@ -21,28 +22,23 @@ import Language.Haskell.TH import System.Process do - -- hs-bindgen uses its own libclang to parse C headers, which is entirely - -- separate from Cabal's C compilation pipeline. Cabal's `pkgconfig-depends` - -- feeds into GHC/cc but NOT into hs-bindgen's libclang. So we must provide - -- include paths explicitly. - -- - -- System headers (libc, linux): On non-Nix systems, libclang finds these - -- via its default search paths (e.g. /usr/include). On Nix, the - -- `hsBindgenHook` setup hook populates `BINDGEN_EXTRA_CLANG_ARGS` with the - -- necessary `-isystem` flags. - -- See: https://github.com/well-typed/hs-bindgen/tree/main/nix/ - -- - -- libevdev headers: These live in a versioned subdirectory (e.g. - -- include/libevdev-1.0/) that neither libclang's defaults nor the Nix hook - -- cover, so we always need pkg-config to locate them. libevdev <- dropWhileEnd isSpace - . fromMaybe (error "pkg-config failed to locate libevdev") + . fromMaybe (error "bad pkg-config response") . stripPrefix "-I" <$> runIO (readProcess "pkg-config" ["--cflags-only-I", "libevdev"] "") + -- TODO put this code in another file so we can reuse it for `Codes.hs` without hitting stage restriction + libc <- + dropWhile isSpace + . fromMaybe (error "bad cpp response") + . find ("libc" `isInfixOf`) + . dropWhile (not . ("#include" `isPrefixOf`)) + . lines + . thd3 + <$> runIO (readProcessWithExitCode "cpp" ["-v"] "") withHsBindgen def - { clang = def{extraIncludeDirs = [Dir libevdev]} + { clang = def{extraIncludeDirs = [Dir libevdev, Dir libc]} , fieldNamingStrategy = OmitFieldPrefixes , programSlicing = EnableProgramSlicing } diff --git a/flake.nix b/flake.nix index 9af0c86..1df4757 100644 --- a/flake.nix +++ b/flake.nix @@ -23,33 +23,11 @@ build-tools = [ pkgs.llvmPackages.llvm ]; libs = [ pkgs.llvmPackages.libclang ]; }; - packages.evdev.components.library = { - build-tools = [ hsBindgenHook ]; - }; }]; }; }) ]; pkgs = import nixpkgs { inherit system overlays; inherit (haskell-nix) config; }; - # hs-bindgen's libclang is separate from Cabal's C compilation pipeline, - # so it needs explicit include paths. This hook (modelled on hs-bindgen's - # own hsBindgenHook) sets BINDGEN_EXTRA_CLANG_ARGS so that libclang can - # find system and library headers in the Nix store. - # See: https://github.com/well-typed/hs-bindgen/tree/main/nix/ - hsBindgenHook = pkgs.makeSetupHook { - name = "hs-bindgen-hook"; - substitutions = { - clang = pkgs.llvmPackages.clang; - }; - } (pkgs.writeText "hs-bindgen-hook.sh" '' - populateHsBindgenEnv() { - BINDGEN_EXTRA_CLANG_ARGS="$(<@clang@/nix-support/cc-cflags) $(<@clang@/nix-support/libc-cflags) $NIX_CFLAGS_COMPILE" - export BINDGEN_EXTRA_CLANG_ARGS - BINDGEN_BUILTIN_INCLUDE_DIR=disable - export BINDGEN_BUILTIN_INCLUDE_DIR - } - postHook="''${postHook:-}"$'\n'"populateHsBindgenEnv"$'\n' - ''); flake = pkgs.myHaskellProject.flake { }; in flake // { From 7e582c5e60d6347b20547de89859c0709a822582 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Thu, 9 Apr 2026 21:57:32 +0100 Subject: [PATCH 49/55] use C_INCLUDE_PATH for system headers instead of cpp -v hack... on non-Nix, libclang finds system headers via /usr/include by default on Nix, a setup hook sets C_INCLUDE_PATH to the glibc include dir, which libclang reads natively and Codes.hs reads for locating linux/input-event-codes.h --- evdev/evdev.cabal | 2 ++ evdev/src/Evdev/Codes.hs | 27 +++++++++++++-------------- evdev/src/Evdev/Raw.hs | 12 +----------- flake.nix | 8 ++++++++ 4 files changed, 24 insertions(+), 25 deletions(-) diff --git a/evdev/evdev.cabal b/evdev/evdev.cabal index 6b74a24..aa3e84d 100644 --- a/evdev/evdev.cabal +++ b/evdev/evdev.cabal @@ -22,7 +22,9 @@ common common base >= 4.11 && < 5, bytestring ^>= {0.10, 0.11, 0.12}, containers ^>= {0.6.2, 0.7, 0.8}, + directory ^>= 1.3, extra ^>= {1.6.18, 1.7, 1.8}, + filepath ^>= 1.5, filepath-bytestring ^>= {1.4.2, 1.5}, hs-bindgen ^>= {0.1}, hs-bindgen-runtime ^>= {0.1}, diff --git a/evdev/src/Evdev/Codes.hs b/evdev/src/Evdev/Codes.hs index a1abb4d..cfe7a4c 100644 --- a/evdev/src/Evdev/Codes.hs +++ b/evdev/src/Evdev/Codes.hs @@ -5,24 +5,23 @@ See [the Linux Kernel documentation](https://www.kernel.org/doc/html/latest/inpu -} module Evdev.Codes where -import Data.Char -import Data.List -import Data.Maybe -import Data.Tuple.Extra +import Control.Monad import Evdev.Codes.Generator import Evdev.Raw import Language.Haskell.TH -import System.Process +import System.Directory +import System.Environment +import System.FilePath import Util $( do - libc <- - dropWhile isSpace - . fromMaybe (error "bad cpp response") - . find ("libc" `isInfixOf`) - . dropWhile (not . ("#include" `isPrefixOf`)) - . lines - . thd3 - <$> runIO (readProcessWithExitCode "cpp" ["-v"] "") - generateCodes $ libc <> "/linux/input-event-codes.h" + candidates <- + runIO $ + map (<> "/linux/input-event-codes.h") + . (<> ["/usr/include"]) + . maybe [] splitSearchPath + <$> lookupEnv "C_INCLUDE_PATH" + runIO (filterM doesFileExist candidates) >>= \case + d : _ -> generateCodes d + [] -> error $ "Could not find input-event-codes.h. Install Linux headers or try setting C_INCLUDE_PATH." ) diff --git a/evdev/src/Evdev/Raw.hs b/evdev/src/Evdev/Raw.hs index 2825366..afb2aca 100644 --- a/evdev/src/Evdev/Raw.hs +++ b/evdev/src/Evdev/Raw.hs @@ -14,7 +14,6 @@ module Evdev.Raw where import Data.Char import Data.List import Data.Maybe -import Data.Tuple.Extra import Foreign import HsBindgen.Runtime.LibC qualified import HsBindgen.TH @@ -27,18 +26,9 @@ do . fromMaybe (error "bad pkg-config response") . stripPrefix "-I" <$> runIO (readProcess "pkg-config" ["--cflags-only-I", "libevdev"] "") - -- TODO put this code in another file so we can reuse it for `Codes.hs` without hitting stage restriction - libc <- - dropWhile isSpace - . fromMaybe (error "bad cpp response") - . find ("libc" `isInfixOf`) - . dropWhile (not . ("#include" `isPrefixOf`)) - . lines - . thd3 - <$> runIO (readProcessWithExitCode "cpp" ["-v"] "") withHsBindgen def - { clang = def{extraIncludeDirs = [Dir libevdev, Dir libc]} + { clang = def{extraIncludeDirs = [Dir libevdev]} , fieldNamingStrategy = OmitFieldPrefixes , programSlicing = EnableProgramSlicing } diff --git a/flake.nix b/flake.nix index 1df4757..121c8e0 100644 --- a/flake.nix +++ b/flake.nix @@ -10,6 +10,12 @@ haskell-nix.overlay (final: prev: { myHaskellProject = + let + addIncludeDir = + '' + export C_INCLUDE_PATH="${final.stdenv.cc.libc.dev}/include''${C_INCLUDE_PATH:+:$C_INCLUDE_PATH}" + ''; + in final.haskell-nix.hix.project { src = ./.; compiler-nix-name = "ghc912"; @@ -18,11 +24,13 @@ shell.tools.cabal = "latest"; shell.tools.haskell-language-server = "latest"; shell.withHoogle = false; + shell.shellHook = addIncludeDir; modules = [{ packages.libclang-bindings.components.library = { build-tools = [ pkgs.llvmPackages.llvm ]; libs = [ pkgs.llvmPackages.libclang ]; }; + packages.evdev.components.library.preBuild = addIncludeDir; }]; }; }) From 0789bf5471b6feaea1d28b32c072a56063baef4c Mon Sep 17 00:00:00 2001 From: George Thomas Date: Thu, 9 Apr 2026 21:58:24 +0100 Subject: [PATCH 50/55] avoid unnecessary complex recursion --- flake.nix | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/flake.nix b/flake.nix index 121c8e0..6f2c575 100644 --- a/flake.nix +++ b/flake.nix @@ -27,8 +27,8 @@ shell.shellHook = addIncludeDir; modules = [{ packages.libclang-bindings.components.library = { - build-tools = [ pkgs.llvmPackages.llvm ]; - libs = [ pkgs.llvmPackages.libclang ]; + build-tools = [ final.llvmPackages.llvm ]; + libs = [ final.llvmPackages.libclang ]; }; packages.evdev.components.library.preBuild = addIncludeDir; }]; From 314adb4122847b395ab245dc6e8174b966c7ec1a Mon Sep 17 00:00:00 2001 From: George Thomas Date: Thu, 9 Apr 2026 22:47:33 +0100 Subject: [PATCH 51/55] simplify generateCodes --- evdev/src/Evdev/Codes/Generator.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/evdev/src/Evdev/Codes/Generator.hs b/evdev/src/Evdev/Codes/Generator.hs index 56d100d..0d7c538 100644 --- a/evdev/src/Evdev/Codes/Generator.hs +++ b/evdev/src/Evdev/Codes/Generator.hs @@ -195,9 +195,7 @@ newtype ConstructorName = ConstructorName Name deriving newtype (Eq, Ord, Show) newtype PatternName = PatternName Name deriving newtype (Eq, Ord, Show) generateCodes :: FilePath -> Q [Dec] -generateCodes file = do - contents <- runIO $ readFile file - pure $ concatMap (uncurry generateType) $ parseHeader contents +generateCodes = fmap (concatMap (uncurry generateType) . parseHeader) . runIO . readFile generateType :: TypeInfo -> [Define] -> [Dec] generateType ty defs = From f51b3e9387191275741d234b1baa13694bb05f90 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Fri, 10 Apr 2026 17:46:39 +0100 Subject: [PATCH 52/55] final codes generator cleanup --- evdev/evdev.cabal | 1 + evdev/src/Evdev/Codes.hs | 3 +- evdev/src/Evdev/Codes/Generator.hs | 278 ++++++++++------------------- evdev/src/Evdev/Raw.hs | 1 - evdev/test/Test.hs | 15 +- 5 files changed, 108 insertions(+), 190 deletions(-) diff --git a/evdev/evdev.cabal b/evdev/evdev.cabal index aa3e84d..5977389 100644 --- a/evdev/evdev.cabal +++ b/evdev/evdev.cabal @@ -30,6 +30,7 @@ common common hs-bindgen-runtime ^>= {0.1}, monad-loops ^>= 0.4.3, mtl ^>= {2.2, 2.3}, + ordered-containers ^>= 0.2.4, process ^>= 1.6, rawfilepath ^>= {1.0, 1.1}, template-haskell ^>= {2.21, 2.22, 2.23}, diff --git a/evdev/src/Evdev/Codes.hs b/evdev/src/Evdev/Codes.hs index cfe7a4c..28f216a 100644 --- a/evdev/src/Evdev/Codes.hs +++ b/evdev/src/Evdev/Codes.hs @@ -7,13 +7,14 @@ module Evdev.Codes where import Control.Monad import Evdev.Codes.Generator -import Evdev.Raw import Language.Haskell.TH import System.Directory import System.Environment import System.FilePath import Util +-- TODO `hs-bindgen` has no support for macro-based enums like `c2hs` does +-- ideally we'd just add `hashInclude "linux/input-event-codes.h"` to our `hs-bindgen` invocation and totally avoid this $( do candidates <- runIO $ diff --git a/evdev/src/Evdev/Codes/Generator.hs b/evdev/src/Evdev/Codes/Generator.hs index 0d7c538..3395964 100644 --- a/evdev/src/Evdev/Codes/Generator.hs +++ b/evdev/src/Evdev/Codes/Generator.hs @@ -7,129 +7,75 @@ module Evdev.Codes.Generator (generateCodes) where +import Data.Bifunctor import Data.Char import Data.Either import Data.Foldable import Data.Functor import Data.List import Data.List.Extra -import Data.Map.Strict (Map) +import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.Map.Ordered qualified as OMap import Data.Map.Strict qualified as Map import Data.Maybe import Language.Haskell.TH import Text.Read -groups :: [TypeInfo] -groups = - [ TypeInfo - { name = TypeName $ mkName "EventType" - , prefixes = ["EV"] - , doc = - """ - Each of these corresponds to one of the constructors of 'Evdev.EventData'. - So you're unlikely to need to use these directly (C doesn't have ADTs - we do). - """ - } - , TypeInfo - { name = TypeName $ mkName "SyncEvent" - , prefixes = ["SYN"] - , doc = - """ - Synchronization events - """ - } - , TypeInfo - { name = TypeName $ mkName "Key" - , prefixes = ["KEY", "BTN"] - , doc = - """ - Keys and buttons - """ - } - , TypeInfo - { name = TypeName $ mkName "RelativeAxis" - , prefixes = ["REL"] - , doc = - """ - Relative changes - """ - } - , TypeInfo - { name = TypeName $ mkName "AbsoluteAxis" - , prefixes = ["ABS"] - , doc = - """ - Absolute changes - """ - } - , TypeInfo - { name = TypeName $ mkName "SwitchEvent" - , prefixes = ["SW"] - , doc = - """ - Stateful binary switches - """ - } - , TypeInfo - { name = TypeName $ mkName "MiscEvent" - , prefixes = ["MSC"] - , doc = - """ - Miscellaneous - """ - } - , TypeInfo - { name = TypeName $ mkName "LEDEvent" - , prefixes = ["LED"] - , doc = - """ - LEDs - """ - } - , TypeInfo - { name = TypeName $ mkName "RepeatEvent" - , prefixes = ["REP"] - , doc = - """ - Specifying autorepeating events - """ - } - , TypeInfo - { name = TypeName $ mkName "SoundEvent" - , prefixes = ["SND"] - , doc = - """ - For simple sound output devices - """ - } - , TypeInfo - { name = TypeName $ mkName "DeviceProperty" - , prefixes = ["INPUT_PROP"] - , doc = - """ - Device properties - """ - } - ] - -data TypeInfo = TypeInfo - { name :: TypeName - , prefixes :: [String] - , doc :: String +data CodeType + = EventType + | SyncEvent + | Key + | RelativeAxis + | AbsoluteAxis + | SwitchEvent + | MiscEvent + | LEDEvent + | RepeatEvent + | SoundEvent + | DeviceProperty + deriving (Eq, Ord, Show, Enum, Bounded) +codeTypePrefixes :: CodeType -> [String] +codeTypePrefixes = \case + EventType -> ["EV"] + SyncEvent -> ["SYN"] + Key -> ["KEY", "BTN"] + RelativeAxis -> ["REL"] + AbsoluteAxis -> ["ABS"] + SwitchEvent -> ["SW"] + MiscEvent -> ["MSC"] + LEDEvent -> ["LED"] + RepeatEvent -> ["REP"] + SoundEvent -> ["SND"] + DeviceProperty -> ["INPUT_PROP"] +codeTypeDoc :: CodeType -> String +codeTypeDoc = \case + EventType -> + """ + Each of these corresponds to one of the constructors of 'Evdev.EventData'. + So you're unlikely to need to use these directly (C doesn't have ADTs - we do). + """ + SyncEvent -> "Synchronization events" + Key -> "Keys and buttons" + RelativeAxis -> "Relative changes" + AbsoluteAxis -> "Absolute changes" + SwitchEvent -> "Stateful binary switches" + MiscEvent -> "Miscellaneous" + LEDEvent -> "LEDs" + RepeatEvent -> "Specifying autorepeating events" + SoundEvent -> "For simple sound output devices" + DeviceProperty -> "Device properties" + +data Define = Define + { name :: MacroName + , value :: Either Integer MacroName } -data Define - = Primary {name :: MacroName, value :: Int} - | Alias {name :: MacroName, target :: MacroName} - deriving (Show) - --- | Parse a single @#define@ line. -parseLine :: String -> Maybe Define -parseLine line = case words line of +parseDefineLine :: String -> Maybe Define +parseDefineLine line = case words line of ("#define" : k@(MacroName -> name) : v : _) | any (`isSuffixOf` k) metaSuffices -> Nothing - | Just value <- readMaybe v -> Just Primary{name, value} - | otherwise -> Just Alias{name, target = MacroName v} + | Just n <- readMaybe v -> Just Define{name, value = Left n} + | otherwise -> Just Define{name, value = Right $ MacroName v} _ -> Nothing where metaSuffices = @@ -138,77 +84,53 @@ parseLine line = case words line of , "_MIN_INTERESTING" ] -parseHeader :: String -> [(TypeInfo, [Define])] +parseHeader :: String -> [(CodeType, [Define])] parseHeader input = - map snd - . Map.toList - . Map.fromListWith (\(t, a) (_, b) -> (t, a <> b)) - . map - ( \d -> - let - MacroName s = d.name - ty = - snd - . fromMaybe (error $ "no prefix matched: " <> show d.name) - $ find (\(p, _) -> p `isPrefixOf` s) prefixes - in - (ty.name, (ty, [d])) - ) - . mapMaybe parseLine + Map.toList + . foldr (uncurry $ Map.adjust . (:)) (Map.fromList $ map (,[]) enumerate) + . map (\d@Define{name = MacroName name} -> (d, snd . unwrap name $ find ((`isPrefixOf` name) . fst) prefixes)) + . mapMaybe parseDefineLine $ lines input where - prefixes = concatMap (\g -> (,g) <$> g.prefixes) groups - -{- | Deduplicate primaries: when multiple primaries share a value string, -keep the last one as the constructor and turn earlier ones into aliases. -This handles cases like @BTN_GAMEPAD 0x130@ followed by @BTN_SOUTH 0x130@, -where @BTN_SOUTH@ becomes the constructor and @BTN_GAMEPAD@ becomes an alias. --} -dedup :: [Define] -> [Define] -dedup defs = - let - -- First pass: find which name is the "winner" for each value (last one wins) - valueToName :: Map Int MacroName - valueToName = - foldl' - ( \m d -> case d of - Primary name val -> Map.insert val name m - Alias _ _ -> m - ) - Map.empty - defs - -- Second pass: convert losers into aliases pointing to the winner - convert :: Define -> Define - convert (Primary name val) = - let winner = valueToName Map.! val - in if name == winner - then Primary name val - else Alias name winner - convert a@Alias{} = a - in - map convert defs + unwrap name = fromMaybe (error $ "no prefix matched: " <> show name) + prefixes = concatMap (\t -> (,t) <$> codeTypePrefixes t) enumerate + +processType :: [Define] -> [(ConstructorName, (Integer, [PatternName]))] +processType defs = + map (first toConstructorName) . OMap.assocs $ + foldl' + (flip \(alias, target) -> OMap.alter (fmap $ second (toPatternName alias :)) target) + litsByPrimary + aliasMacros + where + (litMacros, aliasMacros) = partitionEithers $ defs <&> \Define{name, value} -> bimap (name,) (name,) value + litsByValue = foldl' (flip \(name, value) -> Map.insertWith ((<>)) value (pure name)) Map.empty litMacros + -- when multiple literal macros point to the same value, turn all but the first in to pattern synonyms + litsByPrimary = OMap.fromList . map (\(n, k :| as) -> (k, (n, map toPatternName as))) $ Map.toList litsByValue newtype MacroName = MacroName String deriving newtype (Eq, Ord, Show) newtype TypeName = TypeName Name deriving newtype (Eq, Ord, Show) -newtype BindgenName = BindgenName Name deriving newtype (Eq, Ord, Show) newtype ConstructorName = ConstructorName Name deriving newtype (Eq, Ord, Show) newtype PatternName = PatternName Name deriving newtype (Eq, Ord, Show) generateCodes :: FilePath -> Q [Dec] -generateCodes = fmap (concatMap (uncurry generateType) . parseHeader) . runIO . readFile +generateCodes path = do + contents <- runIO $ readFile path + pure + . concatMap + ( uncurry (uncurry . generateType) + . bimap + (TypeName . mkName . show) + (foldMap (\(k, (n, as)) -> (([(k, n)], map (,k) as))) . processType) + ) + $ parseHeader contents -generateType :: TypeInfo -> [Define] -> [Dec] -generateType ty defs = - [ dataType ty.name $ map snd primaries - , simpleEnumInstance ty.name primaries +generateType :: TypeName -> [(ConstructorName, Integer)] -> [(PatternName, ConstructorName)] -> [Dec] +generateType name constructors patterns = + [ dataType name $ map fst constructors + , simpleEnumInstance name constructors ] - <> concatMap (patternSynonym ty.name) aliases - where - (primaries, aliases) = - partitionEithers $ - dedup defs <&> \case - Primary n _ -> Left (toBindgenName n, toConstructorName n) - Alias a t -> Right (toPatternName a, toConstructorName t) + <> concatMap (uncurry $ patternSynonym name) patterns dataType :: TypeName -> [ConstructorName] -> Dec dataType (TypeName tyName) conNames = @@ -220,7 +142,7 @@ dataType (TypeName tyName) conNames = (conNames <&> \(ConstructorName s) -> NormalC s []) [DerivClause Nothing (map ConT [''Eq, ''Ord, ''Read, ''Show])] -simpleEnumInstance :: TypeName -> [(BindgenName, ConstructorName)] -> Dec +simpleEnumInstance :: TypeName -> [(ConstructorName, Integer)] -> Dec simpleEnumInstance (TypeName tyName) conNames = InstanceD Nothing @@ -230,7 +152,7 @@ simpleEnumInstance (TypeName tyName) conNames = (mkName "enumerate'") [ Clause [] - (NormalB (ListE $ conNames <&> \(_, ConstructorName s) -> ConE s)) + (NormalB (ListE $ conNames <&> \(ConstructorName s, _) -> ConE s)) [] ] , FunD @@ -240,12 +162,12 @@ simpleEnumInstance (TypeName tyName) conNames = [VarP n] ( GuardedB ( map - ( \(BindgenName val, ConstructorName con) -> + ( \(ConstructorName con, val) -> ( NormalG ( InfixE (Just (VarE n)) (VarE '(==)) - (Just (AppE (VarE 'fromIntegral) (VarE val))) + (Just (LitE (IntegerL val))) ) , AppE (ConE 'Just) (ConE con) ) @@ -263,10 +185,10 @@ simpleEnumInstance (TypeName tyName) conNames = ( NormalB ( LamCaseE ( map - ( \(BindgenName val, ConstructorName con) -> + ( \(ConstructorName con, val) -> Match (ConP con [] []) - (NormalB (AppE (VarE 'fromIntegral) (VarE val))) + (NormalB (LitE (IntegerL val))) [] ) conNames @@ -277,8 +199,8 @@ simpleEnumInstance (TypeName tyName) conNames = ] ] -patternSynonym :: TypeName -> (PatternName, ConstructorName) -> [Dec] -patternSynonym (TypeName tyName) (PatternName pat, ConstructorName con) = +patternSynonym :: TypeName -> PatternName -> ConstructorName -> [Dec] +patternSynonym (TypeName tyName) (PatternName pat) (ConstructorName con) = [ PatSynSigD pat (ConT tyName) , PatSynD pat (PrefixPatSyn []) ImplBidir (ConP con [] []) ] @@ -292,9 +214,3 @@ toPatternName :: MacroName -> PatternName titleCase = \case [] -> [] c : cs -> toUpper c : map toLower cs - --- KEY_LEFT_SHIFT -> kEY_LEFT_SHIFT -toBindgenName :: MacroName -> BindgenName -toBindgenName (MacroName s) = BindgenName $ mkName case s of - [] -> [] - (c : cs) -> toLower c : cs diff --git a/evdev/src/Evdev/Raw.hs b/evdev/src/Evdev/Raw.hs index afb2aca..7d2a4e0 100644 --- a/evdev/src/Evdev/Raw.hs +++ b/evdev/src/Evdev/Raw.hs @@ -42,6 +42,5 @@ do do hashInclude "libevdev/libevdev.h" hashInclude "libevdev/libevdev-uinput.h" - hashInclude "linux/input-event-codes.h" foreign import ccall "&libevdev_hs_close" libevdev_hs_close :: FinalizerPtr Libevdev diff --git a/evdev/test/Test.hs b/evdev/test/Test.hs index f2833ee..2fb5773 100644 --- a/evdev/test/Test.hs +++ b/evdev/test/Test.hs @@ -11,8 +11,7 @@ import Data.Maybe import Data.Time import Evdev import Evdev.Codes -import Evdev.Raw -import qualified Evdev.Uinput as Uinput +import Evdev.Uinput qualified as Uinput import Foreign.C import RawFilePath import System.FilePath.ByteString @@ -32,7 +31,7 @@ smoke :: TestTree smoke = testCase "Smoke" do start <- newEmptyMVar let duName = "evdev-test-device" - keys = mapMaybe toEnum' [kEY_1 .. kEY_0] + keys = mapMaybe (toEnum' @_ @Integer) [fromEnum' Key1 .. fromEnum' Key0] evs = concatMap ((<$> [Pressed, Released]) . KeyEvent) keys assertEqual "10 keys" 10 $ length keys du <- Uinput.newDevice duName Uinput.defaultDeviceOpts{Uinput.keys} @@ -61,9 +60,11 @@ inverses = let tv = Timeval (fromIntegral @CLong s) (fromIntegral @CLong us) in s < 0 || us < 0 || us >= 1_000_000 || toCTimeVal (fromCTimeVal tv) == tv , testProperty "2" \n -> - let -- 'toCTimeVal' goes from picoseconds to microseconds + let + -- 'toCTimeVal' goes from picoseconds to microseconds resolutionFactor = 1_000_000 - in abs (diffTimeToPicoseconds (fromCTimeVal . toCTimeVal $ picosecondsToDiffTime n) - n) + in + abs (diffTimeToPicoseconds (fromCTimeVal . toCTimeVal $ picosecondsToDiffTime n) - n) < resolutionFactor ] , testProperty "EventData" \x@(t, c, _v) -> @@ -79,8 +80,8 @@ inverses = in x' == x || syncValueZero ] ---TODO make delay and max retries configurable, add to library? -retryIf :: forall a e. Exception e => (e -> Bool) -> IO a -> IO a +-- TODO make delay and max retries configurable, add to library? +retryIf :: forall a e. (Exception e) => (e -> Bool) -> IO a -> IO a retryIf p x = go 100 where go :: Word -> IO a From 809165784378a9a2faad8df760d7637e3d36f11b Mon Sep 17 00:00:00 2001 From: George Thomas Date: Sun, 12 Apr 2026 00:16:05 +0100 Subject: [PATCH 53/55] revert accidental formatting --- evdev/test/Test.hs | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/evdev/test/Test.hs b/evdev/test/Test.hs index 2fb5773..5a07add 100644 --- a/evdev/test/Test.hs +++ b/evdev/test/Test.hs @@ -11,7 +11,7 @@ import Data.Maybe import Data.Time import Evdev import Evdev.Codes -import Evdev.Uinput qualified as Uinput +import qualified Evdev.Uinput as Uinput import Foreign.C import RawFilePath import System.FilePath.ByteString @@ -60,11 +60,9 @@ inverses = let tv = Timeval (fromIntegral @CLong s) (fromIntegral @CLong us) in s < 0 || us < 0 || us >= 1_000_000 || toCTimeVal (fromCTimeVal tv) == tv , testProperty "2" \n -> - let - -- 'toCTimeVal' goes from picoseconds to microseconds + let -- 'toCTimeVal' goes from picoseconds to microseconds resolutionFactor = 1_000_000 - in - abs (diffTimeToPicoseconds (fromCTimeVal . toCTimeVal $ picosecondsToDiffTime n) - n) + in abs (diffTimeToPicoseconds (fromCTimeVal . toCTimeVal $ picosecondsToDiffTime n) - n) < resolutionFactor ] , testProperty "EventData" \x@(t, c, _v) -> @@ -80,8 +78,8 @@ inverses = in x' == x || syncValueZero ] --- TODO make delay and max retries configurable, add to library? -retryIf :: forall a e. (Exception e) => (e -> Bool) -> IO a -> IO a +--TODO make delay and max retries configurable, add to library? +retryIf :: forall a e. Exception e => (e -> Bool) -> IO a -> IO a retryIf p x = go 100 where go :: Word -> IO a From 9b3b93f982922ba9e407b12d7dbc04afec447cd8 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Sun, 12 Apr 2026 00:18:01 +0100 Subject: [PATCH 54/55] revert order to fix test --- evdev/test/Test.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/evdev/test/Test.hs b/evdev/test/Test.hs index 5a07add..c084fed 100644 --- a/evdev/test/Test.hs +++ b/evdev/test/Test.hs @@ -47,7 +47,7 @@ smoke = testCase "Smoke" do putMVar start () (@?= Nothing) =<< devicePhys d (@?= Nothing) =<< deviceUniq d - (@?= [EvKey, EvSyn]) =<< deviceEventTypes d + (@?= [EvSyn, EvKey]) =<< deviceEventTypes d evs' <- whileJust ((\x -> guard (x /= last evs) $> x) . eventData <$> nextEvent d) pure filter (/= SyncEvent SynReport) evs' @?= init evs From 1c8743aa63b07dc70141b44749686154908525d7 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Sun, 12 Apr 2026 00:44:58 +0100 Subject: [PATCH 55/55] add docs --- evdev/src/Evdev/Codes/Generator.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/evdev/src/Evdev/Codes/Generator.hs b/evdev/src/Evdev/Codes/Generator.hs index 3395964..454d81c 100644 --- a/evdev/src/Evdev/Codes/Generator.hs +++ b/evdev/src/Evdev/Codes/Generator.hs @@ -19,6 +19,7 @@ import Data.Map.Ordered qualified as OMap import Data.Map.Strict qualified as Map import Data.Maybe import Language.Haskell.TH +import Language.Haskell.TH.Syntax import Text.Read data CodeType @@ -116,6 +117,7 @@ newtype PatternName = PatternName Name deriving newtype (Eq, Ord, Show) generateCodes :: FilePath -> Q [Dec] generateCodes path = do contents <- runIO $ readFile path + addModFinalizer $ for_ enumerate \ct -> putDoc (DeclDoc $ mkName (show ct)) $ codeTypeDoc ct pure . concatMap ( uncurry (uncurry . generateType)