diff --git a/c_src/keyio.c b/c_src/keyio.c --- a/c_src/keyio.c +++ b/c_src/keyio.c @@ -18,9 +18,11 @@ // Designate fd as a keyboard of all keys ioctl(fd, UI_SET_EVBIT, EV_KEY); int i; - for (i=0; i < 256; i++) { + for (i=0; i < 0x2ff; i++) { ioctl(fd, UI_SET_KEYBIT, i); } + // Enable key repeat for output keyboard + ioctl(fd, UI_SET_EVBIT, EV_REP); // Set the vendor details struct uinput_setup usetup; diff --git a/c_src/keyio_win.c b/c_src/keyio_win.c --- a/c_src/keyio_win.c +++ b/c_src/keyio_win.c @@ -80,6 +80,7 @@ // Write the event to the pipe DWORD dwWritten; WriteFile(writePipe, &ev, sizeof(ev), &dwWritten, NULL); + return 1; // Block others from handeling. Since they should only use KMonad output } // Read an event from the pipe and write it to the provided pointer @@ -92,7 +93,7 @@ } // Insert the keyboard hook and start the monitoring process -int grab_kb() +void grab_kb() { // Insert the hook, error on failure hookHandle = SetWindowsHookEx(WH_KEYBOARD_LL, keyHandler, NULL, 0); diff --git a/c_src/mac/kext.cpp b/c_src/mac/kext.cpp --- a/c_src/mac/kext.cpp +++ b/c_src/mac/kext.cpp @@ -41,7 +41,7 @@ int init_sink() { kern_return_t kr; connect = IO_OBJECT_NULL; - service = IOServiceGetMatchingService(kIOMasterPortDefault, IOServiceNameMatching(pqrs::karabiner_virtual_hid_device::get_virtual_hid_root_name())); + service = IOServiceGetMatchingService(kIOMainPortDefault, IOServiceNameMatching(pqrs::karabiner_virtual_hid_device::get_virtual_hid_root_name())); if (!service) { print_iokit_error("IOServiceGetMatchingService"); return 1; diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -12,6 +12,36 @@ ### Fixed +## 0.4.4 – 2025-04-11 + +### Added + +- Added names for the keys `rfkill` and `micmute` (#883). + If you previously used the buttons `missing247` and `missing248`, please update to the new names. +- Added more MacOS keys (#936) +- Added keycodes above 255. If you are on linux you can use them now. (#935) +- Added `boot.initrd.services.kmonad.enable` NixOS option to use KMonad in the initrd (#941). +- Added `key-seq-delay`, a more general version of `cmp-seq-delay`, which enforces a minimum delay + after each key event. (#908) +- Added `tap-hold-next-press` which is like `tap-next-press` but with an additional timeout. (#971) +- Set unknown keyboard names to "Unknown External Keyboard" on Macos. (#980) + +### Changed + +- `multi-tap` now holds when interrupted by another key while held. (#897) +- `key-seq-delay` defaults to 1ms (#975). + If this slowdown in e.g. `tap-macro`s bothers you, you may want to set it to 0. + If you used `cmp-seq-delay`, you probably no longer have to, + as `key-seq-delay` effectivly already implies a `cmp-seq-delay`. + +### Fixed + +- Fixed `tapMacro` and `tapMacroRelease` behaviour which was slightly broken in #873 (#906) +- Fixed keycode translation problem on windows (#894) +- Fixed keyrepeat not working in tty on linux (#913) +- Fixed `multi-tap` not holding (#958, #976) +- Fixed `multi-tap` cancelling on release of other keys (#974) + ## 0.4.3 – 2024-09-11 ### Added diff --git a/doc/quick-reference.md b/doc/quick-reference.md --- a/doc/quick-reference.md +++ b/doc/quick-reference.md @@ -83,9 +83,13 @@ + `cmp-seq` (key, defaults to `RightAlt`): compose key for Unicode input (X11 specific). -+ `cmp-seq-delay` (natural number): delay between each pressed key in a ++ `cmp-seq-delay` (natural number, defaults to `0`): delay between each pressed key in a compose-key sequence. ++ `key-seq-delay` (natural number, defaults to `1`): delay after each outputted key event. + Since it's more general than `cmp-seq-delay`, it implies a minimum `cmp-seq-delay`. + Be careful with this option: larger values are easily noticeable in `tap-macro`s. + + `implicit-around` (around variant, defaults to `around`): Specifies the variant of `around` to use in implicit around constructs like `A` or `S-a`. @@ -305,7 +309,7 @@ + `tap-next`: combine 2 buttons, one for when the button is tapped and one for when it is held. The decision of what to execute is based upon - whether the next button is the buttons own release or not. + whether the next event (keypress or release) is the buttons own release or not. ```clojure (defalias tan (tap-next a sft)) @@ -340,8 +344,16 @@ (defalias tnp (tap-next-press a sft)) ``` ++ `tap-hold-next-press`: like `tap-next-press` but with an + additional timeout. This is just like `tap-hold-next`, but with + `tap-next` swapped out for `tap-next-press`. + + ```clojure + (defalias thp (tap-hold-next-press 1000 a sft)) + ``` + + `tap-hold-next-release`: like `tap-next-release` but with an - additional timeout. This is just like `tap-next-release`, but with + additional timeout. This is just like `tap-hold-next`, but with `tap-next` swapped out for `tap-next-release`. ```clojure diff --git a/keymap/tutorial.kbd b/keymap/tutorial.kbd --- a/keymap/tutorial.kbd +++ b/keymap/tutorial.kbd @@ -101,13 +101,23 @@ as a workaround to also make this work on windows, see the section on Compose-key sequences below. - - `cmp-seq-delay': NUMBER (in milliseconds) + - `cmp-seq-delay': NUMBER, defaults to `0` (in milliseconds) - This sets a delay between each pressed key in a compose-key sequence. Some - environments may have troubles recognizing the key sequence if it's pressed - too rapidly; if you experience any problems in this direction, you can try - setting this value to `5' or `10' and see if that helps. + This sets a delay between each pressed key in a compose-key sequence. + This is mostly not needed, as `key-seq-delay` already implies a small delay. + If you still have issues, with some environments failing to recognize + the key sequence due to its speed, you may want to increase this value + to `5` or `10` and see if that helps. Alternatively, take a look at + the `key-seq-delay` option for a more general approach. + - `key-seq-delay': NUMBER, defaults to `1` (in milliseconds) + + This sets a delay after each outputted key event globally. Similarly to + `cmp-seq-delay` this may fix problems with keys being ignored when pressed + too rapidly. You probably won't need to specify both `cmp-seq-delay` and + `key-seq-delay`. Be careful with this option, as larger values are easily + noticeable in `tap-macro`s. + Secondly, let's go over how to specify the `input` and `output` fields of a `defcfg` block. This differs between OSes, and so do the capabilities of these interfaces. @@ -124,6 +134,8 @@ NOTE: Any valid path to a device-file will work, but it is recommended to use the 'by-id' directory, since these names will not change if you replug the device. + If the '/dev/input' directory does for any reason not exists (i.e. maybe in the + initramfs) it could be due to the 'evdev' kernel module not being loaded. We deal with output by creating a 'uinput' device. This requires that the 'uinput' kernel module is loaded. The easiest way to ensure this is by calling @@ -183,9 +195,10 @@ output (uinput-sink "My KMonad output" ;; To understand the importance of the following line, see the section on ;; Compose-key sequences at the near-bottom of this file. - "/run/current-system/sw/bin/sleep 1 && /run/current-system/sw/bin/setxkbmap -option compose:ralt") + "sleep 1 && setxkbmap -option compose:ralt") cmp-seq ralt ;; Set the compose key to `RightAlt' cmp-seq-delay 5 ;; 5ms delay between each compose-key sequence press + key-seq-delay 5 ;; 5ms delay between each outputted key event ;; For Windows ;; input (low-level-hook) @@ -603,6 +616,14 @@ (tap-macro K P5 M P5 o P5 n P5 a P5 d) + Alternatively, you could use the more general approach and change the + value for `key-seq-delay` in `defcfg`. Also notice that the values + don't add up: due to the difference in where the delay is applied, the + maximum takes effect. (`key-seq-delay` works on outputted events, and + `:delay` is while handling the button) If you use really long + `tap-macro`s (like storing your email), you may experiment with a + delay of `0` to have a more "paste-like" experience. + The `tap-macro-release` is like `tap-macro`, except that it waits to press the last button when the `tap-macro-release` gets released. It might be useful when combined with a @@ -826,11 +847,11 @@ So, again with the mini-language, we set foo to: (tap-hold 200 x lsft) ;; Like tap-next, but with a 200ms timeout Then: - Tesc -> x - Tesc Ta -> xa - Pesc 300 a -> A (the moment you press a) - Pesc a 300 -> A (after 200 ms) - Pesc a 100 Resc -> xa (both happening immediately on Resc) + Tesc -> x + Tesc Ta -> xa + Pesc 300 Ta -> A (the moment you press a) + Pesc Ta 300 -> A (after 200 ms) + Pesc Ta 100 Resc -> xa (both happening immediately on Resc) The `tap-hold-next` button is a combination of the previous 2. Essentially, think of it as a `tap-next` button, but it also switches to held after a @@ -849,7 +870,7 @@ (tap-hold-next 200 x lsft :timeout-button x) Then: Tesc -> Tx - Pesc 100 a -> A (the moment you press a) + Pesc 100 Ta -> A (the moment you press a) Pesc 5000 Resc -> xxxxxxx (some number of auto-repeated x's) Note that KMonad does not itself auto-repeat the key. In this last example, @@ -899,13 +920,18 @@ Pesc Pa Resc Ra -> A (because a is pressed before esc is released) Pesc Ta Resc -> A (a is pressed before esc is released here as well) + It also has a hold variant named `tap-hold-next-press` (notice a trend?). + It works just like `tap-next-press` except that after the timeout it will + jump into holding-mode. The holding button for the timeout case can be swapped + out just like `tap-hold-next` via a `:timeout-button ...` as the last argument. + These increasingly stranger buttons are, I think, coming from the stubborn drive of some of my more eccentric (and I mean that in the most positive way) users to make typing with modifiers on the home-row more comfortable. Especially layouts that encourage a lot of rolling motions are nicer to use with the `release` style buttons. - The `tap-hold-next-release` (notice a trend?) is just like `tap-next-release`, + The `tap-hold-next-release` is just like `tap-next-release`, but it comes with an additional timeout that, just like `tap-hold-next` will jump into holding-mode after a timeout. @@ -922,6 +948,7 @@ thn (tap-hold-next 400 x lsft) tnr (tap-next-release x lsft) tnp (tap-next-press x lsft) + thp (tap-hold-next-press 2000 x lsft) tnh (tap-hold-next-release 2000 x lsft) ;; Used it the colemak layer @@ -933,7 +960,7 @@ @mt _ _ _ _ _ _ _ _ _ _ _ @rem _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ @thn _ _ _ _ _ _ _ _ _ _ _ _ - @xtn _ _ _ _ _ _ _ _ _ _ @xth + @xtn @thp _ _ _ _ _ _ _ _ _ @xth @tnr @tnp _ _ _ _ _ @tnh ) diff --git a/kmonad.cabal b/kmonad.cabal --- a/kmonad.cabal +++ b/kmonad.cabal @@ -2,7 +2,7 @@ name: kmonad category: Application -version: 0.4.3 +version: 0.4.4 synopsis: Advanced keyboard remapping utility author: David Janssen maintainer: janssen.dhj@gmail.com @@ -16,7 +16,7 @@ overlays, tap-mod buttons, multi-tap buttons, leader-key style buttons, and keyboard macros. Functionality heavily inspired by the QMK-firmware. -extra-source-files: +extra-doc-files: changelog.md doc/quick-reference.md keymap/tutorial.kbd @@ -45,6 +45,7 @@ , lens , megaparsec , mtl + , transformers , optparse-applicative , resourcet , rio @@ -97,6 +98,10 @@ KMonad.Keyboard KMonad.Keyboard.ComposeSeq KMonad.Keyboard.IO + -- We always export them, so we can test them + KMonad.Keyboard.IO.Linux.Types + KMonad.Keyboard.IO.Mac.Types + KMonad.Keyboard.IO.Windows.Types KMonad.Keyboard.Keycode KMonad.Keyboard.Ops KMonad.Keyboard.Types @@ -112,7 +117,6 @@ if os(linux) exposed-modules: KMonad.Keyboard.IO.Linux.DeviceSource - KMonad.Keyboard.IO.Linux.Types KMonad.Keyboard.IO.Linux.UinputSink c-sources: c_src/keyio.c @@ -123,7 +127,6 @@ exposed-modules: KMonad.Keyboard.IO.Windows.LowLevelHookSource KMonad.Keyboard.IO.Windows.SendEventSink - KMonad.Keyboard.IO.Windows.Types c-sources: c_src/keyio_win.c build-depends: @@ -133,7 +136,6 @@ exposed-modules: KMonad.Keyboard.IO.Mac.IOKitSource KMonad.Keyboard.IO.Mac.KextSink - KMonad.Keyboard.IO.Mac.Types if flag(kext) cxx-sources: c_src/mac/kext.cpp @@ -183,6 +185,7 @@ KMonad.ButtonDocSpec KMonad.GestureSpec KMonad.ComposeSeqSpec + KMonad.KeycodeSpec default-language: Haskell2010 build-tool-depends: hspec-discover:hspec-discover == 2.* diff --git a/src/KMonad/App/Main.hs b/src/KMonad/App/Main.hs --- a/src/KMonad/App/Main.hs +++ b/src/KMonad/App/Main.hs @@ -100,6 +100,8 @@ launch_ "emitter_proc" $ do e <- atomically . takeTMVar $ otv emitKey snk e + -- If delay is specified, wait for it + for_ (cfg^.keyOutDelay) $ threadDelay . (*1000) . fromIntegral -- emit e = view keySink >>= flip emitKey e pure $ AppEnv { _keAppCfg = cfg diff --git a/src/KMonad/App/Types.hs b/src/KMonad/App/Types.hs --- a/src/KMonad/App/Types.hs +++ b/src/KMonad/App/Types.hs @@ -51,6 +51,7 @@ , _fallThrough :: Bool -- ^ Whether uncaught events should be emitted or not , _allowCmd :: Bool -- ^ Whether shell-commands are allowed , _startDelay :: Milliseconds -- ^ How long to wait before acquiring the input keyboard + , _keyOutDelay :: Maybe Milliseconds -- ^ How long to wait after each key event outputted } makeClassy ''AppCfg diff --git a/src/KMonad/Args.hs b/src/KMonad/Args.hs --- a/src/KMonad/Args.hs +++ b/src/KMonad/Args.hs @@ -46,6 +46,7 @@ , _fallThrough = _flt cgt , _allowCmd = _allow cgt , _startDelay = _strtDel cmd + , _keyOutDelay = fromIntegral <$> _ksd cgt } @@ -60,7 +61,7 @@ cliList :: DefSettings cliList = catMaybes $ map flagToMaybe [cmd^.cmdAllow, cmd^.fallThrgh] - <> [cmd^.iToken, cmd^.oToken, cmd^.cmpSeq, cmd^.implArnd] + <> [cmd^.iToken, cmd^.oToken, cmd^.cmpSeq, cmd^.cmpSeqDelay, cmd^.keySeqDelay, cmd^.implArnd] -- | Convert command line flags to a 'Maybe' type, where the non-presence, as -- well as the default value of a flag will be interpreted as @Nothing@ diff --git a/src/KMonad/Args/Cmd.hs b/src/KMonad/Args/Cmd.hs --- a/src/KMonad/Args/Cmd.hs +++ b/src/KMonad/Args/Cmd.hs @@ -45,6 +45,8 @@ , _cmdAllow :: DefSetting -- ^ Allow execution of arbitrary shell-commands? , _fallThrgh :: DefSetting -- ^ Re-emit unhandled events? , _cmpSeq :: Maybe DefSetting -- ^ Key to use for compose-key sequences + , _cmpSeqDelay :: Maybe DefSetting -- ^ Specify compose sequence key delays + , _keySeqDelay :: Maybe DefSetting -- ^ Specify key event output delays , _implArnd :: Maybe DefSetting -- ^ How to handle implicit `around`s , _oToken :: Maybe DefSetting -- ^ How to emit the output , _iToken :: Maybe DefSetting -- ^ How to capture the input @@ -63,7 +65,7 @@ -- | Equip a parser with version information about the program versioner :: Parser (a -> a) -versioner = infoOption (showVersion version <> ", commit " <> $(gitHash)) +versioner = infoOption (showVersion version <> ", commit " <> fromMaybe "?" $(gitHash)) ( long "version" <> short 'V' <> help "Show version" @@ -84,6 +86,8 @@ <*> cmdAllowP <*> fallThrghP <*> cmpSeqP + <*> cmpSeqDelayP + <*> keySeqDelayP <*> implArndP <*> oTokenP <*> iTokenP @@ -141,6 +145,22 @@ <> help "Which key to use to emit compose-key sequences" ) +-- | Specify compose sequence key delays. +cmpSeqDelayP :: Parser (Maybe DefSetting) +cmpSeqDelayP = optional $ SCmpSeqDelay <$> option (fromIntegral <$> megaReadM numP) + ( long "cmp-seq-delay" + <> metavar "TIME" + <> help "How many ms to wait between each key of a compose sequence" + ) + +-- | Specify key event output delays. +keySeqDelayP :: Parser (Maybe DefSetting) +keySeqDelayP = optional $ SKeySeqDelay <$> option (fromIntegral <$> megaReadM numP) + ( long "key-seq-delay" + <> metavar "TIME" + <> help "How many ms to wait between each key event outputted" + ) + -- | How to handle implicit `around`s implArndP :: Parser (Maybe DefSetting) implArndP = optional $ SImplArnd <$> option @@ -175,6 +195,7 @@ ( long "start-delay" <> short 'w' <> value 300 + <> metavar "TIME" <> showDefaultWith (show . unMS ) <> help "How many ms to wait before grabbing the input keyboard (time to release enter if launching from terminal)") diff --git a/src/KMonad/Args/Joiner.hs b/src/KMonad/Args/Joiner.hs --- a/src/KMonad/Args/Joiner.hs +++ b/src/KMonad/Args/Joiner.hs @@ -182,6 +182,7 @@ o <- getO ft <- getFT al <- getAllow + ksd <- getKeySeqDelay -- Extract the other blocks and join them into a keymap let als = extract _KDefAlias es @@ -196,6 +197,7 @@ , _fstL = fl , _flt = ft , _allow = al + , _ksd = ksd } -------------------------------------------------------------------------------- @@ -263,10 +265,21 @@ getCmpSeqDelay = do cfg <- oneBlock "defcfg" _KDefCfg case onlyOne . extract _SCmpSeqDelay $ cfg of + Right 0 -> pure Nothing Right b -> pure (Just b) Left None -> pure Nothing Left Duplicate -> throwError $ DuplicateSetting "cmp-seq-delay" +-- | Extract the key-seq-delay setting +getKeySeqDelay :: J (Maybe Int) +getKeySeqDelay = do + cfg <- oneBlock "defcfg" _KDefCfg + case onlyOne . extract _SKeySeqDelay $ cfg of + Right 0 -> pure Nothing + Right b -> pure (Just b) + Left None -> pure (Just 1) + Left Duplicate -> throwError $ DuplicateSetting "key-seq-delay" + #ifdef linux_HOST_OS -- | The Linux correspondence between IToken and actual code @@ -389,7 +402,8 @@ -- Various compound buttons KComposeSeq bs -> do csd <- getCmpSeqDelay c <- view cmpKey - jst $ tapMacro . (c:) <$> isps bs csd + csd' <- for csd $ go . KPause . fi + jst $ tapMacro . (c:) . maybe id (:) csd' <$> isps bs csd KTapMacro bs mbD -> jst $ tapMacro <$> isps bs mbD KBeforeAfterNext b a -> jst $ beforeAfterNext <$> go b <*> go a KTapMacroRelease bs mbD -> @@ -403,6 +417,8 @@ KTapHoldNextRelease ms t h mtb -> jst $ tapHoldNextRelease (fi ms) <$> go t <*> go h <*> traverse go mtb KTapNextPress t h -> jst $ tapNextPress <$> go t <*> go h + KTapHoldNextPress ms t h mtb + -> jst $ tapHoldNextPress (fi ms) <$> go t <*> go h <*> traverse go mtb KAroundOnly o i -> jst $ aroundOnly <$> go o <*> go i KAroundWhenAlone o i -> jst $ aroundWhenAlone <$> go o <*> go i KAroundImplicit o i -> joinButton ns als =<< fromImplArnd o i =<< view implArnd diff --git a/src/KMonad/Args/Parser.hs b/src/KMonad/Args/Parser.hs --- a/src/KMonad/Args/Parser.hs +++ b/src/KMonad/Args/Parser.hs @@ -281,6 +281,9 @@ <*> optional (keywordP "timeout-button" buttonP)) , ("tap-next-press" , KTapNextPress <$> buttonP <*> buttonP) + , ("tap-hold-next-press" + , KTapHoldNextPress <$> lexeme numP <*> buttonP <*> buttonP + <*> optional (keywordP "timeout-button" buttonP)) , ("tap-next" , KTapNext <$> buttonP <*> buttonP) , ("layer-toggle" , KLayerToggle <$> lexeme word) , ("momentary-layer" , KLayerToggle <$> lexeme word) @@ -372,6 +375,7 @@ , SFallThrough <$> f "fallthrough" bool , SAllowCmd <$> f "allow-cmd" bool , SCmpSeqDelay <$> f "cmp-seq-delay" numP + , SKeySeqDelay <$> f "key-seq-delay" numP , SImplArnd <$> f "implicit-around" implArndP ]) diff --git a/src/KMonad/Args/TH.hs b/src/KMonad/Args/TH.hs --- a/src/KMonad/Args/TH.hs +++ b/src/KMonad/Args/TH.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BlockArguments #-} {-| Module : KMonad.Args.TH Description : Template Haskell to use in the CLI @@ -14,20 +13,18 @@ import KMonad.Prelude -import Language.Haskell.TH (Exp, Q) -import Language.Haskell.TH.Syntax (runIO) +import Control.Monad.Trans.Maybe +import Language.Haskell.TH (Exp, Q, runIO) import UnliftIO.Directory (findExecutable) import UnliftIO.Process (readProcessWithExitCode) -- | Get the git hash of the current commit at compile time. gitHash :: Q Exp gitHash = do - str <- runIO do - findExecutable "git" >>= \case - Nothing -> pure "" -- Git not present - Just git -> do - (exitCode, hash, _) <- readProcessWithExitCode git ["rev-parse", "HEAD"] "" - pure case exitCode of - ExitSuccess -> takeWhile (/= '\n') hash - _ -> "" -- Not in a git repo - [| fromString str |] + -- This makes use of the `MonadFail` instance for `MaybeT`, + -- which simply returns `Nothing` on failure. + hash <- runIO . runMaybeT $ do + Just git <- lift $ findExecutable "git" + (ExitSuccess, hash, _) <- lift $ readProcessWithExitCode git ["rev-parse", "HEAD"] "" + pure $ takeWhile (/= '\n') hash + [| fromString <$> hash |] diff --git a/src/KMonad/Args/Types.hs b/src/KMonad/Args/Types.hs --- a/src/KMonad/Args/Types.hs +++ b/src/KMonad/Args/Types.hs @@ -72,6 +72,8 @@ | KTapHoldNextRelease Int DefButton DefButton (Maybe DefButton) -- ^ Like KTapNextRelease but with a timeout | KTapNextPress DefButton DefButton -- ^ Like KTapNextRelease but also hold on presses + | KTapHoldNextPress Int DefButton DefButton (Maybe DefButton) + -- ^ Like KTapNextPress but with a timeout | KAroundNext DefButton -- ^ Surround a future button | KAroundNextSingle DefButton -- ^ Surround a future button | KMultiTap [(Int, DefButton)] DefButton -- ^ Do things depending on tap-count @@ -123,6 +125,7 @@ , _fstL :: LayerTag -- ^ Name of initial layer , _flt :: Bool -- ^ How to deal with unhandled events , _allow :: Bool -- ^ Whether to allow shell commands + , _ksd :: Maybe Int -- ^ Output delay between keys } makeClassy ''CfgToken @@ -187,6 +190,7 @@ | SFallThrough Bool | SAllowCmd Bool | SCmpSeqDelay Int + | SKeySeqDelay Int | SImplArnd ImplArnd deriving (Show) makeClassyPrisms ''DefSetting @@ -201,6 +205,8 @@ SFallThrough{} == SFallThrough{} = True SAllowCmd{} == SAllowCmd{} = True SImplArnd{} == SImplArnd{} = True + SCmpSeqDelay{} == SCmpSeqDelay{} = True + SKeySeqDelay{} == SKeySeqDelay{} = True _ == _ = False -- | A list of different 'DefSetting' values diff --git a/src/KMonad/Gesture.hs b/src/KMonad/Gesture.hs --- a/src/KMonad/Gesture.hs +++ b/src/KMonad/Gesture.hs @@ -11,7 +11,6 @@ import Control.Monad.State import Data.Char -import RIO.List.Partial (head) import RIO.Seq (Seq(..)) import qualified RIO.List as L @@ -67,8 +66,9 @@ fromList :: Ord a => [Toggle a] -> Either (GestureError a) (Gesture a) fromList as = case (`runState` S.empty) . runExceptT . foldM f Q.empty $ as of (Left e, _) -> Left e - (Right g, s) | S.null s -> Right $ Gesture g - | otherwise -> Left $ OnWithoutOff (head . S.elems $ s) + (Right g, s) -> case S.lookupMin s of + Just toggle -> Left $ OnWithoutOff toggle + Nothing -> Right $ Gesture g where f s x = do pressed <- get diff --git a/src/KMonad/Keyboard/ComposeSeq.hs b/src/KMonad/Keyboard/ComposeSeq.hs --- a/src/KMonad/Keyboard/ComposeSeq.hs +++ b/src/KMonad/Keyboard/ComposeSeq.hs @@ -734,8 +734,6 @@ , ("_ '" , '⍘' , "U2358") , ("0 ~" , '⍬' , "U236c") , ("| ~" , '⍭' , "U236d") - , ("< _" , '≤' , "U2264") - , ("> _" , '≥' , "U2265") -- Sequences that should exist but do not work --, ("` spc" , '`' , "grave") -- recursive and incorrect. It's and is not mapped in en_US diff --git a/src/KMonad/Keyboard/IO/Linux/Types.hs b/src/KMonad/Keyboard/IO/Linux/Types.hs --- a/src/KMonad/Keyboard/IO/Linux/Types.hs +++ b/src/KMonad/Keyboard/IO/Linux/Types.hs @@ -106,7 +106,7 @@ -- | Translate a 'LinuxKeyEvent' to a KMonad 'KeyEvent' fromLinuxKeyEvent :: LinuxKeyEvent -> Maybe KeyEvent fromLinuxKeyEvent (LinuxKeyEvent (_, _, typ, c, val)) - | c > 255 = Nothing + | c >= 0x2ff = Nothing | typ == 1 && val == 0 = Just . mkRelease $ kc | typ == 1 && val == 1 = Just . mkPress $ kc | otherwise = Nothing diff --git a/src/KMonad/Keyboard/IO/Mac/Types.hs b/src/KMonad/Keyboard/IO/Mac/Types.hs --- a/src/KMonad/Keyboard/IO/Mac/Types.hs +++ b/src/KMonad/Keyboard/IO/Mac/Types.hs @@ -3,6 +3,7 @@ , MacKeyEvent , toMacKeyEvent , fromMacKeyEvent + , kcMapRaw ) where @@ -13,6 +14,7 @@ import KMonad.Keyboard import qualified RIO.HashMap as M +import RIO.List (sortOn) ---------------------------------------------------------------------------- @@ -83,7 +85,8 @@ -- | Lookup the correspondig 'MacKeycode' for this 'Keycode' toMacKeycode :: Keycode -> Maybe MacKeycode toMacKeycode = flip M.lookup revMap - where revMap = M.fromList $ M.toList kcMap ^.. folded . swapped + -- We sort the reversed list, since some keycodes are duplicates (e.g.: KeyBackslash) and the later takes precedence + where revMap = M.fromList . sortOn (Down . snd) $ M.toList kcMap ^.. folded . swapped -- | Convert a 'KeyEvent' to a 'MacKeyEvent' -- @@ -112,12 +115,18 @@ -------------------------------------------------------------------------------- -- $kc --- | Mac does not use the same keycodes as Linux, so we need to translate. +-- | Mac mostly uses the HID names instead. Since Linux doesn't we need to translate. -- --- See https://opensource.apple.com/source/IOHIDFamily/IOHIDFamily-315.7.16/IOHIDFamily/IOHIDUsageTables.h --- See https://opensource.apple.com/source/IOHIDFamily/IOHIDFamily-700/IOHIDFamily/AppleHIDUsageTables.h.auto.html +-- For Mac keycodes see https://github.com/apple-opensource/IOHIDFamily/blob/master/IOHIDFamily/IOHIDUsageTables.h +-- +-- For HID to Linux mappings: +-- - See the source code where it's defined at https://github.com/torvalds/linux/blob/master/drivers/hid/hid-input.c +-- - See the table provided by the android docs at https://source.android.com/docs/core/interaction/input/keyboard-devices kcMap :: M.HashMap MacKeycode Keycode -kcMap = M.fromList +kcMap = M.fromList kcMapRaw + +kcMapRaw :: [(MacKeycode, Keycode)] +kcMapRaw = [ ((0x7,0x4), KeyA) , ((0x7,0x5), KeyB) , ((0x7,0x6), KeyC) @@ -164,7 +173,7 @@ , ((0x7,0x2F), KeyLeftBrace) , ((0x7,0x30), KeyRightBrace) , ((0x7,0x31), KeyBackslash) - -- , ((0x7,0x32), KeyNonUSPound) + , ((0x7,0x32), KeyBackslash) -- NonUsPound , ((0x7,0x33), KeySemicolon) , ((0x7,0x34), KeyApostrophe) , ((0x7,0x35), KeyGrave) @@ -184,7 +193,7 @@ , ((0x7,0x43), KeyF10) , ((0x7,0x44), KeyF11) , ((0x7,0x45), KeyF12) - , ((0x7,0x46), KeyPrint) + , ((0x7,0x46), KeyPrint) -- KeySysRq , ((0x7,0x47), KeyScrollLock) , ((0x7,0x48), KeyPause) , ((0x7,0x49), KeyInsert) @@ -215,7 +224,7 @@ , ((0x7,0x62), KeyKp0) , ((0x7,0x63), KeyKpDot) , ((0x7,0x64), Key102nd) - -- , ((0x7,0x65), KeyApplication) + , ((0x7,0x65), KeyCompose) , ((0x7,0x66), KeyPower) , ((0x7,0x67), KeyKpEqual) , ((0x7,0x68), KeyF13) @@ -230,10 +239,10 @@ , ((0x7,0x71), KeyF22) , ((0x7,0x72), KeyF23) , ((0x7,0x73), KeyF24) - -- , ((0x7,0x74), KeyExecute) + , ((0x7,0x74), KeyOpen) , ((0x7,0x75), KeyHelp) - , ((0x7,0x76), KeyMenu) - -- , ((0x7,0x77), KeySelect) + , ((0x7,0x76), KeyMenu) -- KeyProps + , ((0x7,0x77), KeyFront) , ((0x7,0x78), KeyStop) , ((0x7,0x79), KeyAgain) , ((0x7,0x7A), KeyUndo) @@ -249,27 +258,27 @@ -- , ((0x7,0x84), KeyLockingScrollLock) , ((0x7,0x85), KeyKpComma) -- , ((0x7,0x86), KeyKpEqualSignAS400) - -- , ((0x7,0x87), KeyInternational1) - -- , ((0x7,0x88), KeyInternational2) - -- , ((0x7,0x89), KeyInternational3) - -- , ((0x7,0x8A), KeyInternational4) - -- , ((0x7,0x8B), KeyInternational5) - -- , ((0x7,0x8C), KeyInternational6) + , ((0x7,0x87), KeyRo) + , ((0x7,0x88), KeyKatakanaHiragana) + , ((0x7,0x89), KeyYen) + , ((0x7,0x8A), KeyHenkan) + , ((0x7,0x8B), KeyMuhenkan) + , ((0x7,0x8C), KeyKpjpcomma) -- , ((0x7,0x8D), KeyInternational7) -- , ((0x7,0x8E), KeyInternational8) -- , ((0x7,0x8F), KeyInternational9) - -- , ((0x7,0x90), KeyLANG1) - -- , ((0x7,0x91), KeyLANG2) - -- , ((0x7,0x92), KeyLANG3) - -- , ((0x7,0x93), KeyLANG4) - -- , ((0x7,0x94), KeyLANG5) + , ((0x7,0x90), KeyHangeul) + , ((0x7,0x91), KeyHanja) + , ((0x7,0x92), KeyKatakana) + , ((0x7,0x93), KeyHiragana) + , ((0x7,0x94), KeyZenkakuHankaku) -- , ((0x7,0x95), KeyLANG6) -- , ((0x7,0x96), KeyLANG7) -- , ((0x7,0x97), KeyLANG8) -- , ((0x7,0x98), KeyLANG9) -- , ((0x7,0x99), KeyAlternateErase) -- , ((0x7,0x9A), KeySysReqOrAttention) - , ((0x7,0x9B), KeyCancel) + , ((0x7,0x9B), KeyCancel) -- Does not exists in Linux -- , ((0x7,0x9C), KeyClear) -- , ((0x7,0x9D), KeyPrior) -- , ((0x7,0x9E), KeyReturn) @@ -289,10 +298,390 @@ , ((0x7,0xE6), KeyRightAlt) , ((0x7,0xE7), KeyRightMeta) -- (0x7,0xE8) - (0x7,0xFFFF) Reserved + , ((0xC,0x34), KeySleep) + , ((0xC,0x40), KeyMenu) + , ((0xC,0x45), KeyRight) + , ((0xC,0x61), KeySubtitle) + , ((0xC,0x69), KeyRed) + , ((0xC,0x6A), KeyGreen) + , ((0xC,0x6B), KeyBlue) + , ((0xC,0x6C), KeyYellow) + , ((0xC,0x83), KeyLast) + -- , ((0xC,0x84), Key???) -- Enter Channel + -- , ((0xC,0x85), Key???) -- Order Movie + , ((0xC,0x88), KeyPc) + , ((0xC,0x89), KeyTv) + , ((0xC,0x8A), KeyWww) + , ((0xC,0x8B), KeyDvd) + , ((0xC,0x8C), KeyPhone) + , ((0xC,0x8D), KeyProgram) + , ((0xC,0x8E), KeyVideoPhone) + , ((0xC,0x8F), KeyGames) + , ((0xC,0x90), KeyMemo) + , ((0xC,0x91), KeyCd) + , ((0xC,0x92), KeyVcr) + , ((0xC,0x93), KeyTuner) + , ((0xC,0x94), KeyExit) + , ((0xC,0x95), KeyHelp) + , ((0xC,0x96), KeyTape) + , ((0xC,0x97), KeyTv2) + , ((0xC,0x98), KeySat) + -- , ((0xC,0x99), Key???) -- Media Select Security + , ((0xC,0x9A), KeyPvr) + -- , ((0xC,0x9B), Key???) -- MediaSelectCall + , ((0xC,0x9C), KeyChannelUp) + , ((0xC,0x9D), KeyChannelDown) + -- , ((0xC,0x9E), Key???) -- Media Select SAP (MacOS: Media) + , ((0xC,0xA0), KeyVcr2) + -- , ((0xC,0xA1), Key???) -- Once + -- , ((0xC,0xA2), Key???) -- Daily + -- , ((0xC,0xA3), Key???) -- Weekly + -- , ((0xC,0xA4), Key???) -- Monthly + , ((0xC,0xB0), KeyPlay) + , ((0xC,0xB1), KeyPause) + , ((0xC,0xB2), KeyRecord) + , ((0xC,0xB3), KeyFastForward) + , ((0xC,0xB4), KeyRewind) , ((0xC,0xB5), KeyNextSong) , ((0xC,0xB6), KeyPreviousSong) + , ((0xC,0xB7), KeyStopCd) + , ((0xC,0xB8), KeyEjectCd) + -- , ((0xC,0xB9), Key???) -- Random Play + -- , ((0xC,0xBA), Key???) -- Select Disc + -- , ((0xC,0xBB), Key???) -- Enter Disc + , ((0xC,0xBC), KeyMediaRepeat) + -- , ((0xC,0xBD), Key???) -- MacOS: Tracking + -- , ((0xC,0xBE), Key???) -- Track Normal + -- , ((0xC,0xBF), Key???) -- MacOS: SlowTraciking + -- , ((0xC,0xC0), Key???) -- Frame Forward + -- , ((0xC,0xC1), Key???) -- Frame Back + -- , ((0xC,0xC2), Key???) -- Mark + -- , ((0xC,0xC3), Key???) -- Clear Mark + -- , ((0xC,0xC4), Key???) -- Repeat From Mark + -- , ((0xC,0xC5), Key???) -- Return To Mark + -- , ((0xC,0xC6), Key???) -- Search Mark Forward + -- , ((0xC,0xC7), Key???) -- Search Mark Backwards + -- , ((0xC,0xC8), Key???) -- Counter Reset + -- , ((0xC,0xC9), Key???) -- Show Counter + -- , ((0xC,0xCA), Key???) -- Tracking Increment + -- , ((0xC,0xCB), Key???) -- Tracking Decrement + -- , ((0xC,0xCC), Key???) -- Stop / Eject , ((0xC,0xCD), KeyPlayPause) - , ((0xC,0xCF), KeyDictation) + -- , ((0xC,0xCE), Key???) -- Play / Skip + , ((0xC,0xCF), KeyDictation) -- No HID + -- , ((0xC,0xE0), Key???) -- MacOS: Volume (linear control) + -- , ((0xC,0xE1), Key???) -- MacOS: Balance (linear control) + , ((0xC,0xE2), KeyPlayPause) + -- , ((0xC,0xE3), Key???) -- MacOS: Bass (linear control) + -- , ((0xC,0xE4), Key???) -- MacOS: Treble (linear control) + , ((0xC,0xE5), KeyBassBoost) + -- , ((0xC,0xE6), Key???) -- Surround Mode + -- , ((0xC,0xE7), Key???) -- Loudness + -- , ((0xC,0xE8), Key???) -- MPX + , ((0xC,0xE9), KeyVolumeUp) -- VolumeIncrement + , ((0xC,0xEA), KeyVolumeDown) -- VolumentDecrement + -- , ((0xC,0x100), KeyFanEnable) + -- , ((0xC,0x101), KeyFanSpeed) -- (linear control) + -- , ((0xC,0x102), KeyLightEnable) + -- , ((0xC,0x103), KeyLightIlluminationLevel) -- (linear control) + -- , ((0xC,0x104), KeyClimateControlEnable) + -- , ((0xC,0x105), KeyRoomTemperature) -- (linear control) + -- , ((0xC,0x106), KeySecurityEnable) + -- , ((0xC,0x107), KeyFireAlarm) + -- , ((0xC,0x108), KeyPoliceAlarm) + -- , ((0xC,0x109), KeyProximity) -- (linear control) + -- , ((0xC,0x10A), KeyMotion) + -- , ((0xC,0x10B), KeyDuressAlarm) + -- , ((0xC,0x10C), KeyHoldupAlarm) + -- , ((0xC,0x10D), KeyMedicalAlarm) + -- 0x10E - 0x14F Reserved + -- , ((0xC,0x150), KeyBalanceRight) + -- , ((0xC,0x151), KeyBalanceLeft) + -- , ((0xC,0x152), KeyBassIncrement) + -- , ((0xC,0x153), KeyBassDecrement) + -- , ((0xC,0x154), KeyTrebleIncrement) + -- , ((0xC,0x155), KeyTrebleDecrement) + -- 0x156 - 0x15F Reserved + -- , ((0xC,0x160), KeySpeakerSystem) + -- , ((0xC,0x161), KeyChannelLeft) + -- , ((0xC,0x162), KeyChannelRight) + -- , ((0xC,0x163), KeyChannelCenter) + -- , ((0xC,0x164), KeyChannelFront) + -- , ((0xC,0x165), KeyChannelCenterFront) + -- , ((0xC,0x166), KeyChannelSide) + -- , ((0xC,0x167), KeyChannelSurround) + -- , ((0xC,0x168), KeyChannelLowFrequencyEnhancement) + -- , ((0xC,0x169), KeyChannelTop) + -- , ((0xC,0x16A), KeyChannelUnknown) + -- 0x16B - 0x16F Reserved + -- , ((0xC,0x170), KeySubChannel) -- (linear control) + -- , ((0xC,0x171), KeySubChannelIncrement) + -- , ((0xC,0x172), KeySubChannelDecrement) + -- , ((0xC,0x173), KeyAlternateAudioIncrement) + -- , ((0xC,0x174), KeyAlternateAudioDecrement) + -- 0x175 - 0x17F Reserved + -- , ((0xC,0x180), KeyApplicationLaunchButtons) + -- , ((0xC,0x181), KeyALLaunchButtonConfigurationTool) + , ((0xC,0x182), KeyBookmarks) -- KeyALProgrammableButtonConfiguration + , ((0xC,0x183), KeyConfig) -- KeyALConsumerControlConfiguration + , ((0xC,0x184), KeyWordProcessor) + , ((0xC,0x185), KeyEditor) + , ((0xC,0x186), KeySpreadSheet) + , ((0xC,0x187), KeyGraphicsEditor) + , ((0xC,0x188), KeyPresentation) + , ((0xC,0x189), KeyDatabase) + , ((0xC,0x18A), KeyMail) + , ((0xC,0x18B), KeyNews) + , ((0xC,0x18C), KeyVoicemail) + , ((0xC,0x18D), KeyAddressBook) + , ((0xC,0x18E), KeyCalendar) + -- , ((0xC,0x18F), KeyALTaskOrProjectManager) + -- , ((0xC,0x190), KeyALLogOrJournalOrTimecard) + , ((0xC,0x191), KeyFinance) + , ((0xC,0x192), KeyCalc) + -- , ((0xC,0x193), KeyALAOrVCaptureOrPlayback) + , ((0xC,0x194), KeyFile) + -- , ((0xC,0x195), KeyALLANOrWANBrowser) + , ((0xC,0x196), KeyWww) + -- , ((0xC,0x197), KeyALRemoteNetworkingOrISPConnect) + -- , ((0xC,0x198), KeyALNetworkConference) + , ((0xC,0x199), KeyChat) + -- , ((0xC,0x19A), KeyALTelephonyOrDialer) + -- , ((0xC,0x19B), KeyALLogon) + , ((0xC,0x19C), KeyLogoff) + -- , ((0xC,0x19D), KeyALLogonOrLogoff) + , ((0xC,0x19E), KeyCoffee) + -- , ((0xC,0x19F), KeyALControlPanel) + -- , ((0xC,0x1A0), KeyALCommandLineProcessorOrRun) + -- , ((0xC,0x1A1), KeyALProcessOrTaskManager) + -- , ((0xC,0x1A2), KeyAL) + -- , ((0xC,0x1A3), KeyALNextTaskOrApplication) + -- , ((0xC,0x1A4), KeyALPreviousTaskOrApplication) + -- , ((0xC,0x1A5), KeyALPreemptiveHaltTaskOrApplication) + , ((0xC,0x1A6), KeyHelp) -- KeyALIntegratedHelpCenter + , ((0xC,0x1A7), KeyDocuments) + -- , ((0xC,0x1A8), KeyALThesaurus) + -- , ((0xC,0x1A9), KeyALDictionary) + -- , ((0xC,0x1AA), KeyALDesktop) + , ((0xC,0x1AB), KeySpellCheck) + -- , ((0xC,0x1AC), KeyALGrammerCheck) + -- , ((0xC,0x1AD), KeyALWirelessStatus) + -- , ((0xC,0x1AE), KeyALKeyboardLayout) + -- , ((0xC,0x1AF), KeyALVirusProtection) + -- , ((0xC,0x1B0), KeyALEncryption) + -- , ((0xC,0x1B1), KeyALScreenSaver) + -- , ((0xC,0x1B2), KeyALAlarms) + -- , ((0xC,0x1B3), KeyALClock) + -- , ((0xC,0x1B4), KeyALFileBrowser) + -- , ((0xC,0x1B5), KeyALPowerStatus) + , ((0xC,0x1B6), KeyMedia) + , ((0xC,0x1B7), KeySound) + -- , ((0xC,0x1B8), KeyALMovieBrowser) + -- , ((0xC,0x1B9), KeyALDigitalRightsManager) + -- , ((0xC,0x1BA), KeyALDigitalWallet) + -- 0x1BB Reserved + , ((0xC,0x1BC), KeyMessenger) + , ((0xC,0x1BD), KeyInfo) + -- , ((0xC,0x1BE), KeyALOEMHelp) + -- , ((0xC,0x1BF), KeyALOnlineCommunity) + -- , ((0xC,0x1C0), KeyALEntertainmentContentBrowser) + -- , ((0xC,0x1C1), KeyALOnlineShoppingBrowswer) + -- , ((0xC,0x1C2), KeyALSmartCardInformationOrHelp) + -- , ((0xC,0x1C3), KeyALMarketMonitorOrFinanceBrowser) + -- , ((0xC,0x1C4), KeyALCustomizedCorporateNewsBrowser) + -- , ((0xC,0x1C5), KeyALOnlineActivityBrowswer) + -- , ((0xC,0x1C6), KeyALResearchOrSearchBrowswer) + -- , ((0xC,0x1C7), KeyALAudioPlayer) + -- , ((0xC,0x1C8), KeyALMessageStatus) + -- , ((0xC,0x1C9), KeyALContactSync) + -- , ((0xC,0x1CA), KeyALNavigation) + -- , ((0xC,0x1CB), KeyALContextawareDesktopAssistant) + -- 0x1CC - 0x1FF Reserved + -- , ((0xC,0x200), KeyGenericGUIApplicationControls) + , ((0xC,0x201), KeyNew) + , ((0xC,0x202), KeyOpen) + , ((0xC,0x203), KeyClose) + , ((0xC,0x204), KeyExit) + -- , ((0xC,0x205), KeyACMaximize) + -- , ((0xC,0x206), KeyACMinimize) + , ((0xC,0x207), KeySave) + , ((0xC,0x208), KeyPrint) + , ((0xC,0x209), KeyProps) + , ((0xC,0x21A), KeyUndo) + , ((0xC,0x21B), KeyCopy) + , ((0xC,0x21C), KeyCut) + , ((0xC,0x21D), KeyPaste) + -- , ((0xC,0x21E), KeyAC) -- AC Select All + , ((0xC,0x21F), KeyFind) + -- , ((0xC,0x220), KeyACFindandReplace) + , ((0xC,0x221), KeySearch) + , ((0xC,0x222), KeyGoTo) + , ((0xC,0x223), KeyHomepage) + , ((0xC,0x224), KeyBack) + , ((0xC,0x225), KeyForward) + , ((0xC,0x226), KeyStop) + , ((0xC,0x227), KeyRefresh) + -- , ((0xC,0x228), KeyACPreviousLink) + -- , ((0xC,0x229), KeyACNextLink) + , ((0xC,0x22A), KeyBookmarks) + -- , ((0xC,0x22B), KeyACHistory) + -- , ((0xC,0x22C), KeyACSubscriptions) + , ((0xC,0x22D), KeyZoomIn) + , ((0xC,0x22E), KeyZoomOut) + , ((0xC,0x22F), KeyZoomReset) + -- , ((0xC,0x230), KeyACFullScreenView) + -- , ((0xC,0x231), KeyACNormalView) + -- , ((0xC,0x232), KeyACViewToggle) + , ((0xC,0x233), KeyScrollUp) + , ((0xC,0x234), KeyScrollDown) + -- , ((0xC,0x235), KeyACScroll) + -- , ((0xC,0x236), KeyACPanLeft) + -- , ((0xC,0x237), KeyACPanRight) + -- , ((0xC,0x238), KeyACPan) + -- , ((0xC,0x239), KeyACNewWindow) + -- , ((0xC,0x23A), KeyACTileHorizontally) + -- , ((0xC,0x23B), KeyACTileVertically) + -- , ((0xC,0x23C), KeyACFormat) + -- , ((0xC,0x23D), KeyACEdit) + -- , ((0xC,0x23E), KeyACBold) + -- , ((0xC,0x23F), KeyACItalics) + -- , ((0xC,0x240), KeyACUnderline) + -- , ((0xC,0x241), KeyACStrikethrough) + -- , ((0xC,0x242), KeyACSubscript) + -- , ((0xC,0x243), KeyACSuperscript) + -- , ((0xC,0x244), KeyACAllCaps) + -- , ((0xC,0x245), KeyACRotate) + -- , ((0xC,0x246), KeyACResize) + -- , ((0xC,0x247), KeyACFlipHorizontal) + -- , ((0xC,0x248), KeyACFlipVertical) + -- , ((0xC,0x249), KeyACMirrorHorizontal) + -- , ((0xC,0x24A), KeyACMirrorVertical) + -- , ((0xC,0x24B), KeyACFontSelect) + -- , ((0xC,0x24C), KeyACFontColor) + -- , ((0xC,0x24D), KeyACFontSize) + -- , ((0xC,0x24E), KeyACJustifyLeft) + -- , ((0xC,0x24F), KeyACJustifyCenterH) + -- , ((0xC,0x250), KeyACJustifyRight) + -- , ((0xC,0x251), KeyACJustifyBlockH) + -- , ((0xC,0x252), KeyACJustifyTop) + -- , ((0xC,0x253), KeyACJustifyCenterV) + -- , ((0xC,0x254), KeyACJustifyBottom) + -- , ((0xC,0x255), KeyACJustifyBlockV) + -- , ((0xC,0x256), KeyACIndentyDecrease) + -- , ((0xC,0x257), KeyACIndentyIncrease) + -- , ((0xC,0x258), KeyACNumberedList) + -- , ((0xC,0x259), KeyACRestartNumbering) + -- , ((0xC,0x25A), KeyACBulletedList) + -- , ((0xC,0x25B), KeyACPromote) + -- , ((0xC,0x25C), KeyACDemote) + -- , ((0xC,0x25D), KeyACYes) + -- , ((0xC,0x25E), KeyACNo) + , ((0xC,0x25F), KeyCancel) -- AC Cancel + -- , ((0xC,0x260), KeyACCatalog) + -- , ((0xC,0x261), KeyACBuyOrCheckout) + -- , ((0xC,0x262), KeyACAddToCart) + -- , ((0xC,0x263), KeyACExpand) + -- , ((0xC,0x264), KeyACExpandAll) + -- , ((0xC,0x265), KeyACCollapse) + -- , ((0xC,0x266), KeyACCollapseAll) + -- , ((0xC,0x267), KeyACPrintPreview) + -- , ((0xC,0x268), KeyACPasteSpecial) + -- , ((0xC,0x269), KeyACInsertMode) + -- , ((0xC,0x26A), KeyACDelete) + -- , ((0xC,0x26B), KeyACLock) + -- , ((0xC,0x26C), KeyACUnlock) + -- , ((0xC,0x26D), KeyACProtect) + -- , ((0xC,0x26E), KeyACUnprotect) + -- , ((0xC,0x26F), KeyACAttachComment) + -- , ((0xC,0x270), KeyACDetachComment) + -- , ((0xC,0x271), KeyACViewComment) + -- , ((0xC,0x272), KeyACSelectWord) + -- , ((0xC,0x273), KeyACSelectSentence) + -- , ((0xC,0x274), KeyACSelectParagraph) + -- , ((0xC,0x275), KeyACSelectColumn) + -- , ((0xC,0x276), KeyACSelectRow) + -- , ((0xC,0x277), KeyACSelectTable) + -- , ((0xC,0x278), KeyACSelectObject) + , ((0xC,0x279), KeyRedo) + -- , ((0xC,0x27A), KeyACSort) + -- , ((0xC,0x27B), KeyACSortAscending) + -- , ((0xC,0x27C), KeyACSortDescending) + -- , ((0xC,0x27D), KeyACFilter) + -- , ((0xC,0x27E), KeyACSetClock) + -- , ((0xC,0x27F), KeyACViewClock) + -- , ((0xC,0x280), KeyACSelectTimeZone) + -- , ((0xC,0x281), KeyACEditTimeZones) + -- , ((0xC,0x282), KeyACSetAlarm) + -- , ((0xC,0x283), KeyACClearAlarm) + -- , ((0xC,0x284), KeyACSnoozeAlarm) + -- , ((0xC,0x285), KeyACResetAlarm) + -- , ((0xC,0x286), KeyACSynchronize) + -- , ((0xC,0x287), KeyACSendOrReceive) + -- , ((0xC,0x288), KeyACSendTo) + , ((0xC,0x289), KeyReply) + -- , ((0xC,0x28A), KeyACReplyAll) + , ((0xC,0x28B), KeyForwardMail) + , ((0xC,0x28C), KeySend) + -- , ((0xC,0x28D), KeyACAttachFile) + -- , ((0xC,0x28E), KeyACUpload) + -- , ((0xC,0x28F), KeyACDownload) + -- , ((0xC,0x290), KeyACSetBorders) + -- , ((0xC,0x291), KeyACInsertRow) + -- , ((0xC,0x292), KeyACInsertColumn) + -- , ((0xC,0x293), KeyACInsertFile) + -- , ((0xC,0x294), KeyACInsertPicture) + -- , ((0xC,0x295), KeyACInsertObject) + -- , ((0xC,0x296), KeyACInsertSymbol) + -- , ((0xC,0x297), KeyACSaveAndClose) + -- , ((0xC,0x298), KeyACRename) + -- , ((0xC,0x299), KeyACMerge) + -- , ((0xC,0x29A), KeyACSplit) + -- , ((0xC,0x29B), KeyACDistributeH) + -- , ((0xC,0x29C), KeyACDistributeV) + -- , ((0xC,0x29D), KeyACKeyboardLayoutSelect) + -- , ((0xC,0x29E), KeyACNavigationGuidance) + -- , ((0xC,0x29F), KeyACDesktopShowAllWindows) + -- , ((0xC,0x2A0), KeyACSoftKeyLeft) + -- , ((0xC,0x2A1), KeyACSoftKeyRight) + -- , ((0xC,0x2A2), KeyACDesktopShowAllApplications) + -- 0x02A3 - 0x02AF Reserved + -- , ((0xC,0x2B0), KeyACIdleKeepAlive) + -- 0x02B1 - 0x02BF Reserved + -- , ((0xC,0x2C0), KeyExtendedKeyboardAttributesCollection) + -- , ((0xC,0x2C1), KeyKeyboardFormFactor) + -- , ((0xC,0x2C2), KeyKeyboardKeyType) + -- , ((0xC,0x2C3), KeyKeyboardPhysicalLayout) + -- , ((0xC,0x2C4), KeyVendorSpecificKeyboardPhysicalLayout) + -- , ((0xC,0x2C5), KeyKeyboardIETFLanguageTagIndex) + -- , ((0xC,0x2C6), KeyImplementedKeyboardInputAssistControls) + -- , ((0xC,0x2C7), KeyKeyboardInputAssistPrevious) + -- , ((0xC,0x2C8), KeyKeyboardInputAssistNext) + -- , ((0xC,0x2C9), KeyKeyboardInputAssistPreviousGroup) + -- , ((0xC,0x2CA), KeyKeyboardInputAssistNextGroup) + -- , ((0xC,0x2CB), KeyKeyboardInputAssistAccept) + -- , ((0xC,0x2CC), KeyKeyboardInputAssistCancel) + -- 0x02CD - 0x04FF Reserved + -- , ((0xC,0x500), KeyContactEdited) + -- , ((0xC,0x501), KeyContactAdded) + -- , ((0xC,0x502), KeyContactRecordActive) + -- , ((0xC,0x503), KeyContactIndex) + -- , ((0xC,0x504), KeyContactNickname) + -- , ((0xC,0x505), KeyContactFirstName) + -- , ((0xC,0x506), KeyContactLastName) + -- , ((0xC,0x507), KeyContactFullName) + -- , ((0xC,0x508), KeyContactPhoneNumberPersonal) + -- , ((0xC,0x509), KeyContactPhoneNumberBusiness) + -- , ((0xC,0x50A), KeyContactPhoneNumberMobile) + -- , ((0xC,0x50B), KeyContactPhoneNumberPager) + -- , ((0xC,0x50C), KeyContactPhoneNumberFax) + -- , ((0xC,0x50D), KeyContactPhoneNumberOther) + -- , ((0xC,0x50E), KeyContactEmailPersonal) + -- , ((0xC,0x50F), KeyContactEmailBusiness) + -- , ((0xC,0x510), KeyContactEmailOther) + -- , ((0xC,0x511), KeyContactEmailMain) + -- , ((0xC,0x512), KeyContactSpeedDialNumber) + -- , ((0xC,0x513), KeyContactStatusFlag) + -- , ((0xC,0x514), KeyContactMisc) , ((0xFF,0x3), KeyFn) , ((0xFF,0x4), KeyBrightnessUp) , ((0xFF,0x5), KeyBrightnessDown) diff --git a/src/KMonad/Keyboard/IO/Windows/LowLevelHookSource.hs b/src/KMonad/Keyboard/IO/Windows/LowLevelHookSource.hs --- a/src/KMonad/Keyboard/IO/Windows/LowLevelHookSource.hs +++ b/src/KMonad/Keyboard/IO/Windows/LowLevelHookSource.hs @@ -27,7 +27,7 @@ -- | Use the windows c-api to `grab` a keyboard foreign import ccall "grab_kb" - grab_kb :: IO Word8 + grab_kb :: IO () -- | Release the keyboard hook foreign import ccall "release_kb" @@ -43,7 +43,7 @@ -- | Data used to track `connection` to windows process data LLHook = LLHook - { _thread :: !(Async Word8) -- ^ The thread-id of the listen-process + { _thread :: !(Async ()) -- ^ The thread-id of the listen-process , _buffer :: !(Ptr WinKeyEvent) -- ^ Buffer used to communicate with process } makeLenses ''LLHook diff --git a/src/KMonad/Keyboard/IO/Windows/Types.hs b/src/KMonad/Keyboard/IO/Windows/Types.hs --- a/src/KMonad/Keyboard/IO/Windows/Types.hs +++ b/src/KMonad/Keyboard/IO/Windows/Types.hs @@ -17,6 +17,7 @@ , mkWinKeyEvent , toWinKeyEvent , fromWinKeyEvent + , winCodeKeyCodeMapping ) where @@ -26,8 +27,11 @@ import Foreign.Storable import KMonad.Keyboard +import Data.Tuple (swap) import qualified RIO.HashMap as M - +import qualified RIO.NonEmpty as NE (groupAllWith) +-- TODO: use `Data.Foldable1` instead when `base` >= 4.18.0.0 +import qualified Data.Foldable as NE (minimumBy, maximumBy) ---------------------------------------------------------------------------- -- $err @@ -124,7 +128,24 @@ -- FIXME: There are loads of missing correspondences, mostly for rare-keys. How -- do these line up? Ideally this mapping would be total. winCodeToKeyCode :: M.HashMap WinKeycode Keycode -winCodeToKeyCode = M.fromList +winCodeToKeyCode = M.fromList $ NE.minimumBy (compare `on` snd) <$> NE.groupAllWith fst winCodeKeyCodeMapping + +-- | Translate a KMonad KeyCode to the corresponding Windows virtual-key code +-- +-- We cannot simply reverse the above map for the opposite direction, because +-- there will be duplicates where more than one virtual-key code produces the +-- same KMonad KeyCode. See https://github.com/kmonad/kmonad/issues/326 +keyCodeToWinCode :: M.HashMap Keycode WinKeycode +keyCodeToWinCode = M.fromList $ swap . NE.maximumBy (compare `on` fst) <$> NE.groupAllWith snd winCodeKeyCodeMapping + +-- | A table of which virtual-key code from Windows +-- correspond to which KMonad KeyCode. +-- This table may have the same virtual-key code from Windows multiple times +-- and also may have the same KMonad KeyCode multiple times. +-- +-- It is essentially a merge of 'winCodeToKeyCode' and 'keyCodeToWinCode'. +winCodeKeyCodeMapping :: [(WinKeycode, Keycode)] +winCodeKeyCodeMapping = [ (0x00, Missing254) -- Not documented, but happens often. Why?? -- , (0x01, ???) -- Defined as VK_LBUTTON -- , (0x02, ???) -- Defined as VK_RBUTTON @@ -136,12 +157,15 @@ , (0x09, KeyTab) , (0x0C, KeyDelete) -- Defined as VK_CLEAR , (0x0D, KeyEnter) + , (0x0D, KeyKpEnter) , (0x10, KeyLeftShift) -- No 'sidedness'?? , (0x11, KeyLeftCtrl) -- No 'sidedness'?? , (0x12, KeyLeftAlt) -- No 'sidedness'?? , (0x13, KeyPause) , (0x14, KeyCapsLock) - , (0x15, KeyKatakana) -- Also: KeyHangul + , (0x15, KeyKatakana) + , (0x15, KeyKatakanaHiragana) + , (0x15, KeyHangeul) -- , (0x16, ???) -- Defined as VK_IME_ON -- , (0x17, ???) -- Defined as VK_JUNJA -- , (0x18, ???) -- Defined as VK_FINAL @@ -207,6 +231,7 @@ , (0x5B, KeyLeftMeta) -- Defined as Left Windows key (Natural Keyboard) , (0x5C, KeyRightMeta) -- Defined as Right Windows key (Natural Keyboard) , (0x5D, KeyCompose) -- Defined as Applications key (Natural Keyboard) + , (0x5D, KeyMenu) , (0x5F, KeySleep) , (0x60, KeyKp0) , (0x61, KeyKp1) @@ -267,10 +292,13 @@ , (0xAE, KeyVolumeDown) , (0xAF, KeyVolumeUp) , (0xB0, KeyNextSong) + , (0xB0, KeyVideoNext) , (0xB1, KeyPreviousSong) + , (0xB1, KeyVideoPrev) , (0xB2, KeyStopCd) , (0xB3, KeyPlayPause) , (0xB4, KeyMail) + , (0xB4, KeyEmail) , (0xB5, KeyMedia) , (0xB6, KeyProg1) -- Defined as VK_LAUNCH_APP1 , (0xB7, KeyProg2) -- Defined as VK_LAUNCH_APP2 @@ -316,269 +344,4 @@ -- , (0xFC, ???) -- Defined as VK_NONAME -- , (0xFD, ???) -- Defined as VK_PA1 -- , (0xFE, KeyDelete) -- Defined as VK_OEM_CLEAR - ] - --- | Translate a KMonad KeyCode to the corresponding Windows virtual-key code --- --- We cannot simply reverse the above map for the opposite direction, because --- there will be duplicates where more than one virtual-key code produces the --- same KMonad KeyCode. See https://github.com/kmonad/kmonad/issues/326 -keyCodeToWinCode :: M.HashMap Keycode WinKeycode -keyCodeToWinCode = M.fromList - [ -- (KeyReserved, ???) - (KeyEsc, 0x1B) - , (Key1, 0x31) - , (Key2, 0x32) - , (Key3, 0x33) - , (Key4, 0x34) - , (Key5, 0x35) - , (Key6, 0x36) - , (Key7, 0x37) - , (Key8, 0x38) - , (Key9, 0x39) - , (Key0, 0x30) - , (KeyMinus, 0xBD) - , (KeyEqual, 0xBB) - , (KeyBackspace, 0x08) - , (KeyTab, 0x09) - , (KeyQ, 0x51) - , (KeyW, 0x57) - , (KeyE, 0x45) - , (KeyR, 0x52) - , (KeyT, 0x54) - , (KeyY, 0x59) - , (KeyU, 0x55) - , (KeyI, 0x49) - , (KeyO, 0x4F) - , (KeyP, 0x50) - , (KeyLeftBrace, 0xDB) - , (KeyRightBrace, 0xDD) - , (KeyEnter, 0x0D) - , (KeyLeftCtrl, 0xA2) - , (KeyA, 0x41) - , (KeyS, 0x53) - , (KeyD, 0x44) - , (KeyF, 0x46) - , (KeyG, 0x47) - , (KeyH, 0x48) - , (KeyJ, 0x4A) - , (KeyK, 0x4B) - , (KeyL, 0x4C) - , (KeySemicolon, 0xBA) - , (KeyApostrophe, 0xDE) - , (KeyGrave, 0xC0) - , (KeyLeftShift, 0xA0) - , (KeyBackslash, 0xDC) - , (KeyZ, 0x5A) - , (KeyX, 0x58) - , (KeyC, 0x43) - , (KeyV, 0x56) - , (KeyB, 0x42) - , (KeyN, 0x4E) - , (KeyM, 0x4D) - , (KeyComma, 0xBC) - , (KeyDot, 0xBE) - , (KeySlash, 0xBF) - , (KeyRightShift, 0xA1) - , (KeyKpAsterisk, 0x6A) - , (KeyLeftAlt, 0xA4) - , (KeySpace, 0x20) - , (KeyCapsLock, 0x14) - , (KeyF1, 0x70) - , (KeyF2, 0x71) - , (KeyF3, 0x72) - , (KeyF4, 0x73) - , (KeyF5, 0x74) - , (KeyF6, 0x75) - , (KeyF7, 0x76) - , (KeyF8, 0x77) - , (KeyF9, 0x78) - , (KeyF10, 0x79) - , (KeyNumLock, 0x90) - , (KeyScrollLock, 0x91) - , (KeyKp7, 0x67) - , (KeyKp8, 0x68) - , (KeyKp9, 0x69) - , (KeyKpMinus, 0x6D) - , (KeyKp4, 0x64) - , (KeyKp5, 0x65) - , (KeyKp6, 0x66) - , (KeyKpPlus, 0x6B) - , (KeyKp1, 0x61) - , (KeyKp2, 0x62) - , (KeyKp3, 0x63) - , (KeyKp0, 0x60) - , (KeyKpDot, 0x6E) - -- , (Missing84, ???) - -- , (KeyZenkakuHankaku, ???) - , (Key102nd, 0xE2) - , (KeyF11, 0x7A) - , (KeyF12, 0x7B) - , (KeyRo, 0xC1) - , (KeyKatakana, 0x15) - -- , (KeyHiragana, ???) - , (KeyHenkan, 0x1C) - , (KeyKatakanaHiragana, 0x15) - , (KeyMuhenkan, 0x1D) - -- , (KeyKpjpcomma, ???) - , (KeyKpEnter, 0x0D) - , (KeyRightCtrl, 0xA3) - , (KeyKpSlash, 0x6F) - -- , (KeySysRq, ???) - , (KeyRightAlt, 0xA5) - -- , (KeyLinefeed, ???) - , (KeyHome, 0x24) - , (KeyUp, 0x26) - , (KeyPageUp, 0x21) - , (KeyLeft, 0x25) - , (KeyRight, 0x27) - , (KeyEnd, 0x23) - , (KeyDown, 0x28) - , (KeyPageDown, 0x22) - , (KeyInsert, 0x2D) - , (KeyDelete, 0x2E) - -- , (KeyMacro, ???) - , (KeyMute, 0xAD) - , (KeyVolumeDown, 0xAE) - , (KeyVolumeUp, 0xAF) - -- , (KeyPower, ???) - -- , (KeyKpEqual, ???) - -- , (KeyKpPlusMinus, ???) - , (KeyPause, 0x13) - -- , (KeyScale, ???) - -- , (KeyKpComma, ???) - , (KeyHangeul, 0x15) - , (KeyHanja, 0x19) - -- , (KeyYen, ???) - , (KeyLeftMeta, 0x5B) - , (KeyRightMeta, 0x5C) - , (KeyCompose, 0x5D) - , (KeyStop, 0xA9) - -- , (KeyAgain, ???) - -- , (KeyProps, ???) - -- , (KeyUndo, ???) - -- , (KeyFront, ???) - -- , (KeyCopy, ???) - -- , (KeyOpen, ???) - -- , (KeyPaste, ???) - -- , (KeyFind, ???) - -- , (KeyCut, ???) - , (KeyHelp, 0x2F) - , (KeyMenu, 0x5D) - -- , (KeyCalc, ???) - -- , (KeySetup, ???) - , (KeySleep, 0x5F) - -- , (KeyWakeUp, ???) - -- , (KeyFile, ???) - -- , (KeySendFile, ???) - -- , (KeyDeleteFile, ???) - -- , (KeyXfer, ???) - -- , (KeyProg1, ???) - -- , (KeyProg2, ???) - -- , (KeyWww, ???) - -- , (KeyMsDos, ???) - -- , (KeyCoffee, ???) - -- , (KeyDirection, ???) - -- , (KeyCycleWindows, ???) - , (KeyMail, 0xB4) - -- , (KeyBookmarks, ???) - -- , (KeyComputer, ???) - , (KeyBack, 0xA6) - , (KeyForward, 0xA7) - -- , (KeyCloseCd, ???) - -- , (KeyEjectCd, ???) - -- , (KeyEjectCloseCd, ???) - , (KeyNextSong, 0xB0) - , (KeyPlayPause, 0xB3) - , (KeyPreviousSong, 0xB1) - , (KeyStopCd, 0xB2) - -- , (KeyRecord, ???) - -- , (KeyRewind, ???) - -- , (KeyPhone, ???) - -- , (KeyIso, ???) - -- , (KeyConfig, ???) - , (KeyHomepage, 0xAC) - , (KeyRefresh, 0xA8) - -- , (KeyExit, ???) - -- , (KeyMove, ???) - -- , (KeyEdit, ???) - -- , (KeyScrollUp, ???) - -- , (KeyScrollDown, ???) - -- , (KeyKpLeftParen, ???) - -- , (KeyKpRightParen, ???) - -- , (KeyNew, ???) - -- , (KeyRedo, ???) - , (KeyF13, 0x7C) - , (KeyF14, 0x7D) - , (KeyF15, 0x7E) - , (KeyF16, 0x7F) - , (KeyF17, 0x80) - , (KeyF18, 0x81) - , (KeyF19, 0x82) - , (KeyF20, 0x83) - , (KeyF21, 0x84) - , (KeyF22, 0x85) - , (KeyF23, 0x86) - , (KeyF24, 0x87) - -- , (Missing195, ???) - -- , (Missing196, ???) - -- , (Missing197, ???) - -- , (Missing198, ???) - -- , (Missing199, ???) - -- , (KeyPlayCd, ???) - -- , (KeyPauseCd, ???) - -- , (KeyProg3, ???) - -- , (KeyProg4, ???) - -- , (KeyDashboard, ???) - -- , (KeySuspend, ???) - -- , (KeyClose, ???) - , (KeyPlay, 0xFA) - --, (KeyFastForward, ???) - --, (KeyBassBoost, ???) - , (KeyPrint, 0x2C) - -- , (KeyHp, ???) - -- , (KeyCamera, ???) - -- , (KeySound, ???) - -- , (KeyQuestion, ???) - , (KeyEmail, 0xB4) - -- , (KeyChat, ???) - , (KeySearch, 0xAA) - -- , (KeyConnect, ???) - -- , (KeyFinance, ???) - -- , (KeySport, ???) - -- , (KeyShop, ???) - -- , (KeyAlterase, ???) - , (KeyCancel, 0x03) - -- , (KeyBrightnessDown, ???) - -- , (KeyBrightnessUp, ???) - , (KeyMedia, 0xB5) - -- , (KeySwitchVideoMode, ???) - -- , (KeyKbdIllumToggle, ???) - -- , (KeyKbdIllumDown, ???) - -- , (KeyKbdIllumUp, ???) - -- , (KeySend, ???) - -- , (KeyReply, ???) - -- , (KeyForwardMail, ???) - -- , (KeySave, ???) - -- , (KeyDocuments, ???) - -- , (KeyBattery, ???) - -- , (KeyBluetooth, ???) - -- , (KeyWlan, ???) - -- , (KeyUwb, ???) - -- , (KeyUnknown, ???) - , (KeyVideoNext, 0xB0) - , (KeyVideoPrev, 0xB1) - -- , (KeyBrightnessCycle, ???) - -- , (KeyBrightnessZero, ???) - -- , (KeyDisplayOff, ???) - -- , (KeyWimax, ???) - -- , (Missing247, ???) - -- , (Missing248, ???) - -- , (Missing249, ???) - -- , (Missing250, ???) - -- , (Missing251, ???) - -- , (Missing252, ???) - -- , (Missing253, ???) - -- , (Missing254, ???) - -- , (Missing255, ???) ] diff --git a/src/KMonad/Keyboard/Keycode.hs b/src/KMonad/Keyboard/Keycode.hs --- a/src/KMonad/Keyboard/Keycode.hs +++ b/src/KMonad/Keyboard/Keycode.hs @@ -292,8 +292,8 @@ | KeyBrightnessZero | KeyDisplayOff | KeyWimax - | Missing247 - | Missing248 + | KeyRfkill + | KeyMicmute | Missing249 | Missing250 | Missing251 @@ -301,8 +301,518 @@ | Missing253 | Missing254 | Missing255 - -- Darwin + | Btn0 + | Btn1 + | Btn2 + | Btn3 + | Btn4 + | Btn5 + | Btn6 + | Btn7 + | Btn8 + | Btn9 + | Missing0x10a + | Missing0x10b + | Missing0x10c + | Missing0x10d + | Missing0x10e + | Missing0x10f + | BtnLeft + | BtnRight + | BtnMiddle + | BtnSide + | BtnExtra + | BtnForward + | BtnBack + | BtnTask + | Missing0x118 + | Missing0x119 + | Missing0x11a + | Missing0x11b + | Missing0x11c + | Missing0x11d + | Missing0x11e + | Missing0x11f + | BtnJoystick + | BtnThumb + | BtnThumb2 + | BtnTop + | BtnTop2 + | BtnPinkie + | BtnBase + | BtnBase2 + | BtnBase3 + | BtnBase4 + | BtnBase5 + | BtnBase6 + | Missing0x12c + | Missing0x12d + | Missing0x12e + | BtnDead + | BtnGamepad + | BtnB + | BtnC + | BtnX + | BtnY + | BtnZ + | BtnTL + | BtnTR + | BtnTL2 + | BtnTR2 + | BtnSelect + | BtnStart + | BtnMode + | BtnThumbL + | BtnThumbR + | Missing0x13f + | BtnDigi + | BtnToolRubber + | BtnToolBrush + | BtnToolPencil + | BtnToolAirbrush + | BtnToolFinger + | BtnToolMouse + | BtnToolLens + | BtnToolQuinttap + | BtnStylus3 + | BtnTouch + | BtnStylus + | BtnStylus2 + | BtnToolDoubletap + | BtnToolTripletap + | BtnToolQuadtap + | BtnGearDown + | BtnGearUp + | Missing0x152 + | Missing0x153 + | Missing0x154 + | Missing0x155 + | Missing0x156 + | Missing0x157 + | Missing0x158 + | Missing0x159 + | Missing0x15a + | Missing0x15b + | Missing0x15c + | Missing0x15d + | Missing0x15e + | Missing0x15f + | 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 + | KeyNextTask -- Should be `KeyNext` but conflicts with alias for `KeyNextSong`. So we take the HID Name + | KeyRestart + | KeySlow + | KeyShuffle + | KeyBreak + | KeyPreviousTask -- See `KeyNextTask` + | KeyDigits + | KeyTeen + | KeyTwen + | KeyVideoPhone + | KeyGames + | KeyZoomIn + | KeyZoomOut + | KeyZoomReset + | KeyWordProcessor + | KeyEditor + | KeySpreadSheet + | KeyGraphicsEditor + | KeyPresentation + | KeyDatabase + | KeyNews + | KeyVoicemail + | KeyAddressBook + | KeyMessenger + | KeyBrightnessToggle + | KeySpellCheck + | KeyLogoff + | KeyDollar + | KeyEuro + | KeyFrameBack + | KeyFrameForward + | KeyContextMenu + | KeyMediaRepeat + | Key10channelsUp + | Key10channelsDown + | KeyImages + | Missing0x1bb + | KeyNotificationCenter + | KeyPickupPhone + | KeyHangupPhone + | Missing0x1bf + | KeyDelEol + | KeyDelEos + | KeyInsLine + | KeyDelLine + | Missing0x1c4 + | Missing0x1c5 + | Missing0x1c6 + | Missing0x1c7 + | Missing0x1c8 + | Missing0x1c9 + | Missing0x1ca + | Missing0x1cb + | Missing0x1cc + | Missing0x1cd + | Missing0x1ce + | Missing0x1cf | KeyFn + | KeyFnEsc + | KeyFnF1 + | KeyFnF2 + | KeyFnF3 + | KeyFnF4 + | KeyFnF5 + | KeyFnF6 + | KeyFnF7 + | KeyFnF8 + | KeyFnF9 + | KeyFnF10 + | KeyFnF11 + | KeyFnF12 + | KeyFn1 + | KeyFn2 + | KeyFnD + | KeyFnE + | KeyFnF + | KeyFnS + | KeyFnB + | KeyFnRightShift + | Missing0x1e6 + | Missing0x1e7 + | Missing0x1e8 + | Missing0x1e9 + | Missing0x1ea + | Missing0x1eb + | Missing0x1ec + | Missing0x1ed + | Missing0x1ee + | Missing0x1ef + | Missing0x1f0 + | KeyBrlDot1 + | KeyBrlDot2 + | KeyBrlDot3 + | KeyBrlDot4 + | KeyBrlDot5 + | KeyBrlDot6 + | KeyBrlDot7 + | KeyBrlDot8 + | KeyBrlDot9 + | KeyBrlDot10 + | Missing0x1fb + | Missing0x1fc + | Missing0x1fd + | Missing0x1fe + | Missing0x1ff + | 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 + | Missing0x21f + | BtnDpadUp + | BtnDpadDown + | BtnDpadLeft + | BtnDpadRight + | Missing0x224 + | Missing0x225 + | Missing0x226 + | Missing0x227 + | Missing0x228 + | Missing0x229 + | Missing0x22a + | Missing0x22b + | Missing0x22c + | Missing0x22d + | Missing0x22e + | Missing0x22f + | KeyAlsToggle + | KeyRotateLockToggle + | KeyRefreshRateToggle + | Missing0x233 + | Missing0x234 + | Missing0x235 + | Missing0x236 + | Missing0x237 + | Missing0x238 + | Missing0x239 + | Missing0x23a + | Missing0x23b + | Missing0x23c + | Missing0x23d + | Missing0x23e + | Missing0x23f + | KeyButtonconfig + | KeyTaskmanager + | KeyJournal + | KeyControlPanel + | KeyAppSelect + | KeyScreenSaver + | KeyVoicecommand + | KeyAssistant + | KeyKbdLayoutNext + | KeyEmojiPicker + | KeyDictate + | KeyCameraAccessEnable + | KeyCameraAccessDisable + | KeyCameraAccessToggle + | KeyAccessibility + | KeyDoNotDisturb + | KeyBrightnessMin + | KeyBrightnessMax + | Missing0x252 + | Missing0x253 + | Missing0x254 + | Missing0x255 + | Missing0x256 + | Missing0x257 + | Missing0x258 + | Missing0x259 + | Missing0x25a + | Missing0x25b + | Missing0x25c + | Missing0x25d + | Missing0x25e + | Missing0x25f + | KeyKbdInputAssistPrev + | KeyKbdInputAssistNext + | KeyKbdInputAssistPrevgroup + | KeyKbdInputAssistNextgroup + | KeyKbdInputAssistAccept + | KeyKbdInputAssistCancel + | KeyRightUp + | KeyRightDown + | KeyLeftUp + | KeyLeftDown + | KeyRootMenu + | KeyMediaTopMenu + | KeyNumeric11 + | KeyNumeric12 + | KeyAudioDesc + | Key3dMode + | KeyNextFavorite + | KeyStopRecord + | KeyPauseRecord + | KeyVod + | KeyUnmute + | KeyFastreverse + | KeySlowreverse + | KeyData + | KeyOnScreenKeyboard + | KeyPrivacyScreenToggle + | KeySelectiveScreenshot + | KeyNextElement + | KeyPreviousElement + | KeyAutopilotEngageToggle + | KeyMarkWaypoint + | KeySos + | KeyNavChart + | KeyFishingChart + | KeySingleRangeRadar + | KeyDualRangeRadar + | KeyRadarOverlay + | KeyTraditionalSonar + | KeyClearvuSonar + | KeySidevuSonar + | KeyNavInfo + | KeyBrightnessMenu + | Missing0x28a + | Missing0x28b + | Missing0x28c + | Missing0x28d + | Missing0x28e + | Missing0x28f + | KeyMacro1 + | KeyMacro2 + | KeyMacro3 + | KeyMacro4 + | KeyMacro5 + | KeyMacro6 + | KeyMacro7 + | KeyMacro8 + | KeyMacro9 + | KeyMacro10 + | KeyMacro11 + | KeyMacro12 + | KeyMacro13 + | KeyMacro14 + | KeyMacro15 + | KeyMacro16 + | KeyMacro17 + | KeyMacro18 + | KeyMacro19 + | KeyMacro20 + | KeyMacro21 + | KeyMacro22 + | KeyMacro23 + | KeyMacro24 + | KeyMacro25 + | KeyMacro26 + | KeyMacro27 + | KeyMacro28 + | KeyMacro29 + | KeyMacro30 + | Missing0x2ae + | Missing0x2af + | KeyMacroRecordStart + | KeyMacroRecordStop + | KeyMacroPresetCycle + | KeyMacroPreset1 + | KeyMacroPreset2 + | KeyMacroPreset3 + | Missing0x2b6 + | Missing0x2b7 + | KeyKbdLcdMenu1 + | KeyKbdLcdMenu2 + | KeyKbdLcdMenu3 + | KeyKbdLcdMenu4 + | KeyKbdLcdMenu5 + | Missing0x2bd + | Missing0x2be + | Missing0x2bf + | BtnTriggerHappy + | 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 + | Missing0x2e8 + | Missing0x2e9 + | Missing0x2ea + | Missing0x2eb + | Missing0x2ec + | Missing0x2ed + | Missing0x2ee + | Missing0x2ef + | Missing0x2f0 + | Missing0x2f1 + | Missing0x2f2 + | Missing0x2f3 + | Missing0x2f4 + | Missing0x2f5 + | Missing0x2f6 + | Missing0x2f7 + | Missing0x2f8 + | Missing0x2f9 + | Missing0x2fa + | Missing0x2fb + | Missing0x2fc + | Missing0x2fd + | Missing0x2fe + -- Darwin | KeyLaunchpad | KeyMissionCtrl | KeySpotlight @@ -407,6 +917,8 @@ , (KeyNextSong, ["next"]) , (KeyPlayPause, ["pp"]) , (KeyPreviousSong, ["prev"]) + , (KeyMicmute, ["micm"]) + , (KeyCoffee, ["lock"]) -- Darwin , (KeyLaunchpad, ["lp"]) , (KeyMissionCtrl, ["mctl"]) @@ -417,4 +929,74 @@ , (KeyMuhenkan, ["muh"]) , (KeyHenkan, ["hen"]) , (KeyKatakanaHiragana, ["kah"]) + -- Aliases from `input-event-codes.h` + , (KeyMute, ["mininteresting"]) + , (KeyHangeul, ["hanguel"]) + , (KeyCoffee, ["screenlock"]) + , (KeyDirection, ["rotatedisplay"]) + , (KeyDashboard, ["allapplications"]) + , (KeyBrightnessZero, ["brightnessauto"]) + , (KeyWimax, ["wwan"]) + , (Btn0, ["btnmisc"]) + , (BtnLeft, ["btnmouse"]) + , (BtnJoystick, ["btntrigger"]) + , (BtnGamepad, ["btna", "btnsouth"]) + , (BtnB, ["btneast"]) + , (BtnX, ["btnnorth"]) + , (BtnY, ["btnwest"]) + , (BtnDigi, ["btntoolpen"]) + , (BtnGearDown, ["btnwheel"]) + , (KeyZoom, ["fullscreen"]) + , (KeyScreen, ["aspectratio"]) + , (KeyBrightnessToggle,["displaytoggle"]) + , (BtnTriggerHappy, ["btntriggerhappy1"]) + -- HID Usage Names + , (KeyBackslash, ["nonuspound"]) + , (KeyCompose, ["app", "application"]) + , (KeyOpen, ["exec", "execute"]) + --, (KeyFront, ["sel", "select"]) -- conflict with KeySelect + , (KeyRo, ["i1", "int1", "international1"]) + , (KeyKatakanaHiragana, ["i2", "int2", "international2"]) + , (KeyYen, ["i3", "int3", "international3"]) + , (KeyHenkan, ["i4", "int4", "international4"]) + , (KeyMuhenkan, ["i5", "int5", "international5"]) + , (KeyKpjpcomma, ["i6", "int6", "international6"]) + , (KeyHangeul, ["l1", "lang1"]) + , (KeyHanja, ["l2", "lang2"]) + , (KeyKatakana, ["l3", "lang3"]) + , (KeyHiragana, ["l4", "lang4"]) + , (KeyZenkakuHankaku, ["l5", "lang5"]) + , (KeyExit, ["quit"]) + , (KeyNextSong, ["nexttrack"]) + , (KeyPreviousSong, ["previoustrack"]) + -- , (KeyStopCd, ["stop"]) -- conflict with KeyStop + , (KeyEjectCd, ["eject"]) + , (KeyVolumeUp, ["volumeincrement"]) + , (KeyVolumeDown, ["volumedecrement"]) + , (KeyMail, ["emailreader"]) + , (KeyFinance, ["checkbook"]) + , (KeyCalc, ["calculator"]) + , (KeyFile, ["localmachinebrowser"]) + , (KeyWww, ["internetbrowser"]) + , (KeyCoffee, ["termlock"]) -- conflict with KeyScreenSaver: "screensaver" + , (KeyHelp, ["helpcenter"]) + , (KeyMedia, ["imagebrowser"]) + , (KeySound, ["audiobrowser"]) + , (KeyProps, ["properties"]) + -- , (KeyHomepage, ["home"]) -- conflict with KeyHome + , (KeyForwardMail, ["forwardmessage"]) + , (KeyProgram, ["guide"]) + , (KeyMemo, ["messages"]) + , (KeyTv2, ["cable"]) + -- , (KeyPvr, ["home"]) -- conflict with KeyHome + , (KeySubtitle, ["caption"]) + , (KeyVcr2, ["vcr+"]) + , (KeyMediaRepeat, ["repeat"]) + , (KeyEditor, ["texteditor"]) + , (KeyNews, ["newsreader"]) + , (KeyAddressBook, ["contacts"]) + , (KeyCalendar, ["schedule"]) + , (KeyMessenger, ["instantmessaging"]) + , (KeyInfo, ["featurebrowser", "tipsbrowser"]) + -- , (KeyZoomReset, ["zoom"]) -- conflict with KeyZoom ] diff --git a/src/KMonad/Model/Button.hs b/src/KMonad/Model/Button.hs --- a/src/KMonad/Model/Button.hs +++ b/src/KMonad/Model/Button.hs @@ -55,6 +55,7 @@ , tapNextRelease , tapHoldNextRelease , tapNextPress + , tapHoldNextPress , tapMacro , tapMacroRelease , steppedButton @@ -223,7 +224,7 @@ runAction $ inner^.pressAction go =<< matchMy Release where - go :: KeyPred -> AnyK () + go :: MonadK m => KeyPred -> m () go isMyRelease = hookF InputHook $ \e -> if | isMyRelease e -> do @@ -250,25 +251,24 @@ runAction $ outer^.pressAction runAction $ inner^.pressAction go S.empty =<< matchMy Release - pure () where - go :: HashSet Keycode -> KeyPred -> AnyK () + go :: MonadK m => HashSet Keycode -> KeyPred -> m () go pressed isMyRelease = hookF InputHook $ \e -> if | isMyRelease e -> do runAction $ inner^.releaseAction - when (null pressed) . runAction $ outer^.releaseAction + when (null pressed) $ runAction $ outer^.releaseAction pure Catch | isPress e -> do let pressed' = S.insert (e^.keycode) pressed - when (null pressed) . runAction $ outer^.releaseAction + when (null pressed) $ runAction $ outer^.releaseAction go pressed' isMyRelease pure NoCatch | otherwise -> do -- some release let pressed' = S.delete (e^.keycode) pressed let shouldPressOuter = S.member (e^.keycode) pressed && null pressed' inject e - when shouldPressOuter . after 3 . runAction $ outer^.pressAction + when shouldPressOuter . after 3 $ runAction $ outer^.pressAction await isRelease $ \_ -> go pressed' isMyRelease $> NoCatch pure Catch @@ -421,7 +421,7 @@ -- It does all of this while holding processing of other buttons, so time will -- get rolled back like a TapHold button. tapHoldNextRelease :: Milliseconds -> Button -> Button -> Maybe Button -> Button -tapHoldNextRelease ms t h mtb = onPress $ do +tapHoldNextRelease ms t h mtb = onPress' t $ do hold True go ms [] where @@ -478,19 +478,50 @@ doHold :: MonadK m => KeyEvent -> m Catch doHold e = press h *> inject e $> Catch +-- | This button is to 'tap-next-press' what 'tap-hold-next' is to 'tap-next' +tapHoldNextPress :: Milliseconds -> Button -> Button -> Maybe Button -> Button +tapHoldNextPress ms t h mtb = onPress' t $ do + hold True + go ms + where + go :: MonadK m => Milliseconds -> m () + go ms' = tHookF InputHook ms' onTimeout $ \r -> do + p <- matchMy Release + let e = r^.event + if + -- If the next event is my own release: we act as if we were tapped + | p e -> doTap + -- If the next event is a press: we act as if we were held + | isPress e -> doHold e + -- Else, if it is a release of some other button, just ignore + | otherwise -> go (ms' - r^.elapsed) $> NoCatch + + onTimeout :: MonadK m => m () + onTimeout = press (fromMaybe h mtb) *> hold False + + -- Behave like a tap + doTap :: MonadK m => m Catch + doTap = tap t *> hold False $> Catch + + -- Behave like a hold: + -- We catch the event of ButtonX that triggered this action, and then + -- we rethrow this event after holding. + doHold :: MonadK m => KeyEvent -> m Catch + doHold e = press h *> hold False *> inject e $> Catch + -- | Create a 'Button' that contains a number of delays and 'Button's. As long -- as the next press is registered before the timeout, the multiTap descends -- into its list. The moment a delay is exceeded or immediately upon reaching -- the last button, that button is pressed. multiTap :: Button -> [(Milliseconds, Button)] -> Button -multiTap l bs = onPress' tap' $ go bs +multiTap l bs = onPress' tap' $ hold True *> go bs where tap' = case bs of [] -> l ((_, b) : _) -> b - go :: [(Milliseconds, Button)] -> AnyK () - go [] = press l + go :: MonadK m => [(Milliseconds, Button)] -> m () + go [] = press l *> hold False go ((ms, b):bs') = do -- This is a bit complicated. What we do is: -- 1. We wait for an event @@ -499,8 +530,9 @@ -- 2B. If we do detect the release of the key that triggered this action, -- we must now keep waiting to detect another press. -- 2C. If we detect another (unrelated) press event we cancel the - -- remaining of the multi-tap sequence and trigger a tap on the + -- remaining of the multi-tap sequence and trigger a hold on the -- current button of the sequence. + -- 2D. If we detect a release, we ignore it, and recurse. -- 3A. After 2B, if we do not detect a press before the interval is up, -- we know a tap occurred, so we tap the current button and we are -- done. @@ -510,20 +542,23 @@ -- 3C. If we detect any other (unrelated) press event, then the multi-tap -- sequence is cancelled like in 2C. We trigger a tap of the current -- button of the sequence. - let doNext pred onTimeout next ms = tHookF InputHook ms onTimeout $ \t -> do + -- 3D. If we detect a release event, we also cancel the multi-tap sequence. + let doNext pred onTimeout next cancel ms = tHookF InputHook ms onTimeout $ \t -> do pr <- pred if | pr (t^.event) -> next (ms - t^.elapsed) $> Catch - | isPress (t^.event) -> tap b $> NoCatch - | otherwise -> pure NoCatch - doNext (matchMy Release) - (press b) - (doNext (matchMy Press) (tap b) (\_ -> go bs')) - ms + | isPress (t^.event) -> onTimeout $> NoCatch + | otherwise -> cancel (ms - t^.elapsed) $> NoCatch + let cancel = tap b *> hold False + let doHold = press b *> hold False + let whileReleased = doNext (matchMy Press) cancel (\_ -> go bs') (const cancel) + let whilePressed = doNext (matchMy Release) doHold whileReleased whilePressed + whilePressed ms + -- | Create a 'Button' that performs a series of taps on press. Note that the -- last button is only released when the tapMacro itself is released. tapMacro :: [Button] -> Button -tapMacro bs = mkButton' (go True bs) (pure ()) (go False bs) +tapMacro bs = mkButton' (go False bs) (pure ()) (go True bs) where go _ [] = pure () go False [b] = press b @@ -533,7 +568,7 @@ -- | Create a 'Button' that performs a series of taps on press, -- except for the last Button, which is tapped on release. tapMacroRelease :: [Button] -> Button -tapMacroRelease bs = mkButton' (go True bs) (pure ()) (go False bs) +tapMacroRelease bs = mkButton' (go False bs) (pure ()) (go True bs) where go _ [] = pure () go False [b] = awaitMy Release $ tap b >> pure Catch diff --git a/test/KMonad/ComposeSeqSpec.hs b/test/KMonad/ComposeSeqSpec.hs --- a/test/KMonad/ComposeSeqSpec.hs +++ b/test/KMonad/ComposeSeqSpec.hs @@ -9,11 +9,20 @@ import Test.Hspec +import qualified RIO.NonEmpty as N import qualified RIO.Text as T spec :: Spec -spec = describe "compose-sequences" $ traverse_ checkComposeSeq ssComposed +spec = describe "compose-sequences" $ do + traverse_ checkComposeSeq ssComposed + noDuplicates where + noDuplicates = describe "No duplicate compose sequence definitions" $ do + noDuplicates' _1 "Compose sequences" + noDuplicates' _2 "Characters" + noDuplicates' _3 "Character names" + noDuplicates' field desc = it desc $ duplicates (view field) ssComposed `shouldBe` [] + duplicates field = filter (not . null . N.tail) . N.groupAllWith field checkComposeSeq (expected, c, name) = describe ("Compose sequence for " <> unpack name) $ do let c' = T.singleton c let actualSeq = runParser buttonP "" c' diff --git a/test/KMonad/KeycodeSpec.hs b/test/KMonad/KeycodeSpec.hs new file mode 100644 --- /dev/null +++ b/test/KMonad/KeycodeSpec.hs @@ -0,0 +1,34 @@ +module KMonad.KeycodeSpec (spec) where + +import KMonad.Keyboard.Keycode +import KMonad.Util.MultiMap as Q +import KMonad.Prelude +import RIO.List (sort) + +import qualified KMonad.Keyboard.IO.Mac.Types as Mac (kcMapRaw) +import qualified KMonad.Keyboard.IO.Windows.Types as Win (winCodeKeyCodeMapping) + +import qualified RIO.NonEmpty as N + +import Test.Hspec + +spec :: Spec +spec = do + + it "No duplicate keycode names" $ + dupsWith snd (keyNames ^.. Q.itemed) `shouldBe` [] + + describe "MacOS keycodes" $ checkOsMapping Mac.kcMapRaw + describe "Windows keycodes" $ checkOsMapping Win.winCodeKeyCodeMapping + +checkOsMapping :: (Show a, Ord a) => [(a, Keycode)] -> Spec +checkOsMapping m = do + -- To check for typos, ... + let difference = filter (uncurry (/=)) $ zip <*> sort $ m + let m' = fst <$> difference + let sortedM' = snd <$> difference + it "Raw list is sorted" $ + m' `shouldBe` sortedM' -- Only shows unsorted indexes when failing + +dupsWith :: Ord b => (a -> b) -> [a] -> [NonEmpty a] +dupsWith f = filter (not . null . N.tail) . N.groupAllWith f