{-|
Module      : KMonad.Model.Button
Description : How buttons work
Copyright   : (c) David Janssen, 2019
License     : MIT
Maintainer  : janssen.dhj@gmail.com
Stability   : experimental
Portability : portable

A button contains 2 actions, one to perform on press, and another to perform on
release. This module contains that definition, and some helper code that helps
combine buttons. It is here that most of the complicated` buttons are
implemented (like TapHold).

-}
module KMonad.Model.Button
  ( -- * Button basics
    -- $but
    Button
  , HasButton(..)
  , onPress
  , onRelease
  , onTap
  , mkButton
  , around
  , tapOn

  -- * Simple buttons
  -- $simple
  , emitB
  , pressOnly
  , releaseOnly
  , modded
  , layerToggle
  , layerSwitch
  , layerAdd
  , layerRem
  , pass
  , cmdButton

  -- * Button combinators
  -- $combinators
  , aroundOnly
  , aroundWhenAlone
  , aroundNext
  , aroundNextTimeout
  , aroundNextSingle
  , beforeAfterNext
  , layerDelay
  , layerNext
  , tapHold
  , multiTap
  , tapNext
  , tapHoldNext
  , tapNextRelease
  , tapHoldNextRelease
  , tapNextPress
  , tapHoldNextPress
  , tapMacro
  , tapMacroRelease
  , steppedButton
  , stickyKey
  )
where

import KMonad.Prelude

import KMonad.Model.Action
import KMonad.Keyboard
import KMonad.Util

import qualified RIO.HashSet as S

--------------------------------------------------------------------------------
-- $but
--
-- This section contains the basic definition of KMonad's 'Button' datatype. A
-- 'Button' is essentially a collection of 2 different actions, 1 to perform on
-- 'Press' and another on 'Release'.

-- | A 'Button' consists of three 'MonadK' actions, one to take when a press is
-- registered from the OS, and another when a release is registered.
-- With a third when both should happen in sequence. This will only be used
-- by other button such as `tap-macro`.
-- Use 'mkButton' instead of this constructor.
data Button = Button
  { Button -> Action
_pressAction   :: !Action -- ^ Action to take when pressed
  , Button -> Action
_releaseAction :: !Action -- ^ Action to take when released
  , Button -> Action
_tapAction     :: !Action -- ^ Action to take when tapped as a sub button
  }
makeClassy ''Button

-- | Create a 'Button' out of a press and release action
--
-- NOTE: Since 'AnyK' is an existentially qualified 'MonadK', the monadic
-- actions specified must be runnable by all implementations of 'MonadK', and
-- therefore can only rely on functionality from 'MonadK'. I.e. the actions must
-- be pure 'MonadK'.
mkButton :: AnyK () -> AnyK () -> Button
mkButton :: AnyK () -> AnyK () -> Button
mkButton AnyK ()
a AnyK ()
b = AnyK () -> AnyK () -> AnyK () -> Button
mkButton' m ()
AnyK ()
a m ()
AnyK ()
b (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ m ()
AnyK ()
a m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
AnyK ()
b

-- | Create a 'Button' out of a press, release action and tap action
--
-- The non standard tap action is useful when inside other buttons
-- like `tap-macro`
mkButton' :: AnyK () -> AnyK () -> AnyK () -> Button
mkButton' :: AnyK () -> AnyK () -> AnyK () -> Button
mkButton' AnyK ()
a AnyK ()
b AnyK ()
c = Action -> Action -> Action -> Button
Button (AnyK () -> Action
Action m ()
AnyK ()
a) (AnyK () -> Action
Action m ()
AnyK ()
b) (AnyK () -> Action
Action m ()
AnyK ()
c)

-- | Create a new button with only a 'Press' action
onPress :: AnyK () -> Button
onPress :: AnyK () -> Button
onPress AnyK ()
p = AnyK () -> AnyK () -> Button
mkButton m ()
AnyK ()
p (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

onRelease :: AnyK () -> Button
onRelease :: AnyK () -> Button
onRelease = AnyK () -> AnyK () -> Button
mkButton (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

onTap :: AnyK () -> Button
onTap :: AnyK () -> Button
onTap = AnyK () -> AnyK () -> AnyK () -> Button
mkButton' (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Like 'onPress' but with an alternative button to use for tapping
onPress' :: Button -> AnyK () -> Button
onPress' :: Button -> AnyK () -> Button
onPress' (Button{_tapAction :: Button -> Action
_tapAction = Action AnyK ()
t}) AnyK ()
p = AnyK () -> AnyK () -> AnyK () -> Button
mkButton' m ()
AnyK ()
p (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) m ()
AnyK ()
t

--------------------------------------------------------------------------------
-- $running
--
-- Triggering the actions stored in a 'Button'.

-- | Perform both the press and release of a button immediately
tap :: MonadK m => Button -> m ()
tap :: forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
b = Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
tapAction

-- | Perform the press action of a Button and register its release callback.
--
-- This performs the action stored in the 'pressAction' field and registers a
-- callback that will trigger the 'releaseAction' when the release is detected.
press :: MonadK m => Button -> m ()
press :: forall (m :: * -> *). MonadK m => Button -> m ()
press Button
b = do
  Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
pressAction
  Switch -> m Catch -> m ()
forall (m :: * -> *). MonadK m => Switch -> m Catch -> m ()
awaitMy Switch
Release (m Catch -> m ()) -> m Catch -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
releaseAction
    Catch -> m Catch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch

--------------------------------------------------------------------------------
-- $simple
--
-- A collection of simple buttons. These are basically almost direct wrappings
-- around 'MonadK' functionality.

-- | A button that emits a Press of a keycode when pressed, and a release when
-- released.
emitB :: Keycode -> Button
emitB :: Keycode -> Button
emitB Keycode
c = AnyK () -> AnyK () -> Button
mkButton
  (KeyEvent -> m ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
emit (KeyEvent -> m ()) -> KeyEvent -> m ()
forall a b. (a -> b) -> a -> b
$ Keycode -> KeyEvent
mkPress Keycode
c)
  (KeyEvent -> m ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
emit (KeyEvent -> m ()) -> KeyEvent -> m ()
forall a b. (a -> b) -> a -> b
$ Keycode -> KeyEvent
mkRelease Keycode
c)

-- | A button that emits only a Press of a keycode.
pressOnly :: Keycode -> Button
pressOnly :: Keycode -> Button
pressOnly Keycode
c = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ KeyEvent -> m ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
emit (KeyEvent -> m ()) -> KeyEvent -> m ()
forall a b. (a -> b) -> a -> b
$ Keycode -> KeyEvent
mkPress Keycode
c

-- | A button that emits only a Release of a keycode.
releaseOnly :: Keycode -> Button
releaseOnly :: Keycode -> Button
releaseOnly Keycode
c = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ KeyEvent -> m ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
emit (KeyEvent -> m ()) -> KeyEvent -> m ()
forall a b. (a -> b) -> a -> b
$ Keycode -> KeyEvent
mkRelease Keycode
c

-- | Create a new button that first presses a 'Keycode' before running an inner
-- button, releasing the 'Keycode' again after the inner 'Button' is released.
modded ::
     Keycode -- ^ The 'Keycode' to `wrap around` the inner button
  -> Button  -- ^ The button to nest inside `being modded`
  -> Button
modded :: Keycode -> Button -> Button
modded Keycode
modder = Button -> Button -> Button
around (Keycode -> Button
emitB Keycode
modder)

-- | Create a button that toggles a layer on and off
layerToggle :: LayerTag -> Button
layerToggle :: LayerTag -> Button
layerToggle LayerTag
t = AnyK () -> AnyK () -> AnyK () -> Button
mkButton'
  (LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerOp -> m ()) -> LayerOp -> m ()
forall a b. (a -> b) -> a -> b
$ LayerTag -> LayerOp
PushLayer LayerTag
t)
  (LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerOp -> m ()) -> LayerOp -> m ()
forall a b. (a -> b) -> a -> b
$ LayerTag -> LayerOp
PopLayer  LayerTag
t)
  (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Create a button that switches the base-layer on a press
layerSwitch :: LayerTag -> Button
layerSwitch :: LayerTag -> Button
layerSwitch LayerTag
t = AnyK () -> Button
onPress (LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerOp -> m ()) -> LayerOp -> m ()
forall a b. (a -> b) -> a -> b
$ LayerTag -> LayerOp
SetBaseLayer LayerTag
t)

-- | Create a button that adds a layer on a press
layerAdd :: LayerTag -> Button
layerAdd :: LayerTag -> Button
layerAdd LayerTag
t = AnyK () -> Button
onPress (LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerOp -> m ()) -> LayerOp -> m ()
forall a b. (a -> b) -> a -> b
$ LayerTag -> LayerOp
PushLayer LayerTag
t)

-- | Create a button that removes the top instance of a layer on a press
layerRem :: LayerTag -> Button
layerRem :: LayerTag -> Button
layerRem LayerTag
t = AnyK () -> Button
onPress (LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerOp -> m ()) -> LayerOp -> m ()
forall a b. (a -> b) -> a -> b
$ LayerTag -> LayerOp
PopLayer LayerTag
t)

-- | Create a button that does nothing (but captures the input)
pass :: Button
pass :: Button
pass = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Create a button that executes a shell command on press and possibly on
-- release
cmdButton :: Text -> Maybe Text -> Button
cmdButton :: LayerTag -> Maybe LayerTag -> Button
cmdButton LayerTag
pr Maybe LayerTag
mbR = AnyK () -> AnyK () -> Button
mkButton (LayerTag -> m ()
forall (m :: * -> *). MonadKIO m => LayerTag -> m ()
shellCmd LayerTag
pr) (m () -> (LayerTag -> m ()) -> Maybe LayerTag -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) LayerTag -> m ()
forall (m :: * -> *). MonadKIO m => LayerTag -> m ()
shellCmd Maybe LayerTag
mbR)

--------------------------------------------------------------------------------
-- $combinators
--
-- Functions that take 'Button's and combine them to form new 'Button's.

-- | Create a new button from 2 buttons, an inner and an outer. When the new
-- button is pressed, first the outer is pressed, then the inner. On release,
-- the inner is released first, and then the outer.
around ::
     Button -- ^ The outer 'Button'
  -> Button -- ^ The inner 'Button'
  -> Button -- ^ The resulting nested 'Button'
around :: Button -> Button -> Button
around Button
outer Button
inner = AnyK () -> AnyK () -> Button
mkButton
  (Action -> AnyK ()
runAction (Button
outerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
pressAction)   m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Action -> AnyK ()
runAction (Button
innerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
pressAction))
  (Action -> AnyK ()
runAction (Button
innerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
releaseAction) m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Action -> AnyK ()
runAction (Button
outerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
releaseAction))

-- | A variant of `around`, which releases its outer button when another key
-- is pressed.
aroundOnly ::
     Button -- ^ The outer 'Button'
  -> Button -- ^ The inner 'Button'
  -> Button -- ^ The resulting nested 'Button'
aroundOnly :: Button -> Button -> Button
aroundOnly Button
outer Button
inner = Button -> AnyK () -> Button
onPress' (Button -> Button -> Button
around Button
outer Button
inner) (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ do
  Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
outerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
pressAction
  Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
innerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
pressAction
  KeyPred -> m ()
forall (m :: * -> *). MonadK m => KeyPred -> m ()
go (KeyPred -> m ()) -> m KeyPred -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release
 where
  go :: MonadK m => KeyPred -> m ()
  go :: forall (m :: * -> *). MonadK m => KeyPred -> m ()
go KeyPred
isMyRelease = HookLocation -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
HookLocation -> (KeyEvent -> m Catch) -> m ()
hookF HookLocation
InputHook ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \KeyEvent
e ->
    if
      | KeyPred
isMyRelease KeyEvent
e -> do
        Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
innerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
releaseAction
        Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
outerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
releaseAction
        Catch -> m Catch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch
      -- Another key is pressed, so release the modifier immediately.
      | KeyPred
isPress KeyEvent
e -> do
        Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
outerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
releaseAction
        KeyPred -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
KeyPred -> (KeyEvent -> m Catch) -> m ()
await KeyPred
isMyRelease ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \KeyEvent
_ -> do
          Action -> AnyK ()
runAction (Button
innerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
releaseAction)
          Catch -> m Catch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch
        Catch -> m Catch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch
      | Bool
otherwise ->
        KeyPred -> m ()
forall (m :: * -> *). MonadK m => KeyPred -> m ()
go KeyPred
isMyRelease m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
NoCatch

-- | A variant of `around-only` that represses its outer button when all other
-- keys after it have been released.
aroundWhenAlone ::
     Button -- ^ The outer 'Button'
  -> Button -- ^ The inner 'Button'
  -> Button -- ^ The resulting nested 'Button'
aroundWhenAlone :: Button -> Button -> Button
aroundWhenAlone Button
outer Button
inner = Button -> AnyK () -> Button
onPress' (Button -> Button -> Button
around Button
outer Button
inner) (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ do
  Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
outerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
pressAction
  Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
innerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
pressAction
  HashSet Keycode -> KeyPred -> m ()
forall (m :: * -> *).
MonadK m =>
HashSet Keycode -> KeyPred -> m ()
go HashSet Keycode
forall a. HashSet a
S.empty (KeyPred -> m ()) -> m KeyPred -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release
 where
  go :: MonadK m => HashSet Keycode -> KeyPred -> m ()
  go :: forall (m :: * -> *).
MonadK m =>
HashSet Keycode -> KeyPred -> m ()
go HashSet Keycode
pressed KeyPred
isMyRelease = HookLocation -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
HookLocation -> (KeyEvent -> m Catch) -> m ()
hookF HookLocation
InputHook ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \KeyEvent
e ->
    if
      | KeyPred
isMyRelease KeyEvent
e -> do
        Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
innerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
releaseAction
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HashSet Keycode -> Bool
forall a. HashSet a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashSet Keycode
pressed) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
outerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
releaseAction
        Catch -> m Catch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch
      | KeyPred
isPress KeyEvent
e -> do
        let pressed' :: HashSet Keycode
pressed' = Keycode -> HashSet Keycode -> HashSet Keycode
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
S.insert (KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
forall c. HasKeyEvent c => Lens' c Keycode
Lens' KeyEvent Keycode
keycode) HashSet Keycode
pressed
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HashSet Keycode -> Bool
forall a. HashSet a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashSet Keycode
pressed) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
outerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
releaseAction
        HashSet Keycode -> KeyPred -> m ()
forall (m :: * -> *).
MonadK m =>
HashSet Keycode -> KeyPred -> m ()
go HashSet Keycode
pressed' KeyPred
isMyRelease
        Catch -> m Catch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch
      | Bool
otherwise -> do -- some release
        let pressed' :: HashSet Keycode
pressed' = Keycode -> HashSet Keycode -> HashSet Keycode
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
S.delete (KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
forall c. HasKeyEvent c => Lens' c Keycode
Lens' KeyEvent Keycode
keycode) HashSet Keycode
pressed
        let shouldPressOuter :: Bool
shouldPressOuter = Keycode -> HashSet Keycode -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
S.member (KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
forall c. HasKeyEvent c => Lens' c Keycode
Lens' KeyEvent Keycode
keycode) HashSet Keycode
pressed Bool -> Bool -> Bool
&& HashSet Keycode -> Bool
forall a. HashSet a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashSet Keycode
pressed'
        KeyEvent -> m ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
inject KeyEvent
e
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldPressOuter (m () -> m ()) -> (m () -> m ()) -> m () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Milliseconds -> m () -> m ()
forall (m :: * -> *). MonadK m => Milliseconds -> m () -> m ()
after Milliseconds
3 (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
outerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
pressAction
        KeyPred -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
KeyPred -> (KeyEvent -> m Catch) -> m ()
await KeyPred
isRelease ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \KeyEvent
_ -> HashSet Keycode -> KeyPred -> m ()
forall (m :: * -> *).
MonadK m =>
HashSet Keycode -> KeyPred -> m ()
go HashSet Keycode
pressed' KeyPred
isMyRelease m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
NoCatch
        Catch -> m Catch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch

-- | A 'Button' that, once pressed, will surround the next button with another.
--
-- Think of this as, essentially, a tappable mod. For example, an 'aroundNext
-- KeyCtrl' would, once tapped, then make the next keypress C-<whatever>.
aroundNext ::
     Button -- ^ The outer 'Button'
  -> Button -- ^ The resulting 'Button'
aroundNext :: Button -> Button
aroundNext Button
b = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ KeyPred -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
KeyPred -> (KeyEvent -> m Catch) -> m ()
await KeyPred
isPress ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \KeyEvent
e -> do
  Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
pressAction
  KeyPred -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
KeyPred -> (KeyEvent -> m Catch) -> m ()
await (Keycode -> KeyPred
isReleaseOf (Keycode -> KeyPred) -> Keycode -> KeyPred
forall a b. (a -> b) -> a -> b
$ KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
forall c. HasKeyEvent c => Lens' c Keycode
Lens' KeyEvent Keycode
keycode) ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \KeyEvent
_ -> do
    Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
releaseAction
    Catch -> m Catch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch
  Catch -> m Catch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch

-- | A 'Button' that, once pressed, will surround the next button within some timeout with another.
--
-- If some other key is not pressed within an interval another button will be triggered as a tap.
aroundNextTimeout ::
     Milliseconds -- ^ How long before we tap
  -> Button       -- ^ The 'Button' to use to surround next
  -> Button       -- ^ The 'Button' to tap on timeout
  -> Button       -- ^ The resulting button
aroundNextTimeout :: Milliseconds -> Button -> Button -> Button
aroundNextTimeout Milliseconds
d Button
b Button
t = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ Milliseconds -> m KeyPred -> m () -> (Trigger -> m Catch) -> m ()
forall (m :: * -> *).
MonadK m =>
Milliseconds -> m KeyPred -> m () -> (Trigger -> m Catch) -> m ()
within Milliseconds
d (KeyPred -> m KeyPred
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyPred
isPress) (Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
t) ((Trigger -> m Catch) -> m ()) -> (Trigger -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \Trigger
trig -> do
  Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
pressAction
  KeyPred -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
KeyPred -> (KeyEvent -> m Catch) -> m ()
await (Keycode -> KeyPred
isReleaseOf (Keycode -> KeyPred) -> Keycode -> KeyPred
forall a b. (a -> b) -> a -> b
$ Trigger
trigTrigger -> Getting Keycode Trigger Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.(KeyEvent -> Const Keycode KeyEvent)
-> Trigger -> Const Keycode Trigger
forall c. HasTrigger c => Lens' c KeyEvent
Lens' Trigger KeyEvent
event((KeyEvent -> Const Keycode KeyEvent)
 -> Trigger -> Const Keycode Trigger)
-> Getting Keycode KeyEvent Keycode
-> Getting Keycode Trigger Keycode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Keycode KeyEvent Keycode
forall c. HasKeyEvent c => Lens' c Keycode
Lens' KeyEvent Keycode
keycode) ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \KeyEvent
_ -> do
    Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
releaseAction
    Catch -> m Catch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch
  Catch -> m Catch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch

-- | A 'Button' that, once pressed, will surround the next button with another.
--
-- Think of this as, essentially, a tappable mod. For example, an 'aroundNext
-- KeyCtrl' would, once tapped, then make the next keypress C-<whatever>.
--
-- This differs from 'aroundNext' in that it explicitly releases the modifier
-- immediately after the first event, where `aroundSingle` waits around for the
-- original key that was modified to be released itself.
aroundNextSingle ::
     Button -- ^ The outer 'Button'
  -> Button -- ^ The resulting 'Button'
aroundNextSingle :: Button -> Button
aroundNextSingle Button
b = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ KeyPred -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
KeyPred -> (KeyEvent -> m Catch) -> m ()
await KeyPred
isPress ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \KeyEvent
_ -> do
  Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
pressAction
  -- Wait for the next *event*, regardless of what it is
  KeyPred -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
KeyPred -> (KeyEvent -> m Catch) -> m ()
await (Bool -> KeyPred
forall a. a -> KeyEvent -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \KeyEvent
_ -> do
    Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
releaseAction
    Catch -> m Catch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch
  Catch -> m Catch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch

-- | Create a new button that performs both a press and release of the input
-- button on just a press or release
tapOn ::
     Switch -- ^ Which 'Switch' should trigger the tap
  -> Button -- ^ The 'Button' to tap
  -> Button -- ^ The tapping 'Button'
tapOn :: Switch -> Button -> Button
tapOn Switch
Press   Button
b = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
b
tapOn Switch
Release Button
b = AnyK () -> Button
onRelease (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
b

-- | Create a 'Button' that performs a tap of one button if it is released
-- within an interval. If the interval is exceeded, press the other button (and
-- release it when a release is detected).
tapHold :: Milliseconds -> Button -> Button -> Button
tapHold :: Milliseconds -> Button -> Button -> Button
tapHold Milliseconds
ms Button
t Button
h = Button -> AnyK () -> Button
onPress' Button
t (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ Milliseconds -> m KeyPred -> m () -> (Trigger -> m Catch) -> m ()
forall (m :: * -> *).
MonadK m =>
Milliseconds -> m KeyPred -> m () -> (Trigger -> m Catch) -> m ()
withinHeld Milliseconds
ms (Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release)
  (Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
h)                     -- If we catch timeout before release
  (m Catch -> Trigger -> m Catch
forall a b. a -> b -> a
const (m Catch -> Trigger -> m Catch) -> m Catch -> Trigger -> m Catch
forall a b. (a -> b) -> a -> b
$ Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
t m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
Catch) -- If we catch release before timeout

-- | Create a 'Button' that performs a tap of 1 button if the next event is its
-- own release, or else switches to holding some other button if the next event
-- is a different keypress.
tapNext :: Button -> Button -> Button
tapNext :: Button -> Button -> Button
tapNext Button
t Button
h = Button -> AnyK () -> Button
onPress' Button
t (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ HookLocation -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
HookLocation -> (KeyEvent -> m Catch) -> m ()
hookF HookLocation
InputHook ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \KeyEvent
e -> do
  KeyPred
p <- Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release
  if KeyPred
p KeyEvent
e
    then Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
t   m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
Catch
    else Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
h m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
NoCatch

-- | Like 'tapNext', except that after some interval it switches anyways
tapHoldNext :: Milliseconds -> Button -> Button -> Maybe Button -> Button
tapHoldNext :: Milliseconds -> Button -> Button -> Maybe Button -> Button
tapHoldNext Milliseconds
ms Button
t Button
h Maybe Button
mtb = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ Milliseconds -> m KeyPred -> m () -> (Trigger -> m Catch) -> m ()
forall (m :: * -> *).
MonadK m =>
Milliseconds -> m KeyPred -> m () -> (Trigger -> m Catch) -> m ()
within Milliseconds
ms (KeyPred -> m KeyPred
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyPred -> m KeyPred) -> KeyPred -> m KeyPred
forall a b. (a -> b) -> a -> b
$ Bool -> KeyPred
forall a b. a -> b -> a
const Bool
True) m ()
AnyK ()
onTimeout ((Trigger -> m Catch) -> m ()) -> (Trigger -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \Trigger
tr -> do
  KeyPred
p <- Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release
  if KeyPred
p KeyPred -> KeyPred
forall a b. (a -> b) -> a -> b
$ Trigger
trTrigger -> Getting KeyEvent Trigger KeyEvent -> KeyEvent
forall s a. s -> Getting a s a -> a
^.Getting KeyEvent Trigger KeyEvent
forall c. HasTrigger c => Lens' c KeyEvent
Lens' Trigger KeyEvent
event
    then Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
t   m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
Catch
    else Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
h m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
NoCatch
  where
    onTimeout :: MonadK m =>  m ()
    onTimeout :: AnyK ()
onTimeout = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press (Button -> m ()) -> Button -> m ()
forall a b. (a -> b) -> a -> b
$ Button -> Maybe Button -> Button
forall a. a -> Maybe a -> a
fromMaybe Button
h Maybe Button
mtb

-- | Surround some future button with a before and after tap
beforeAfterNext :: Button -> Button -> Button
beforeAfterNext :: Button -> Button -> Button
beforeAfterNext Button
b Button
a = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ do
  Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
b
  KeyPred -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
KeyPred -> (KeyEvent -> m Catch) -> m ()
await KeyPred
isPress ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \KeyEvent
e -> do
    KeyPred -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
KeyPred -> (KeyEvent -> m Catch) -> m ()
await (Keycode -> KeyPred
isReleaseOf (Keycode -> KeyPred) -> Keycode -> KeyPred
forall a b. (a -> b) -> a -> b
$ KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
forall c. HasKeyEvent c => Lens' c Keycode
Lens' KeyEvent Keycode
keycode) ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \KeyEvent
_ -> do
      Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
a
      Catch -> m Catch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch
    Catch -> m Catch
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch


-- | Create a tap-hold style button that makes its decision based on the next
-- detected release in the following manner:
-- 1. It is the release of this button: We are tapping
-- 2. It is of some other button that was pressed *before* this one, ignore.
-- 3. It is of some other button that was pressed *after* this one, we hold.
--
-- It does all of this while holding processing of other buttons, so time will
-- get rolled back like a TapHold button.
tapNextRelease :: Button -> Button -> Button
tapNextRelease :: Button -> Button -> Button
tapNextRelease Button
t Button
h = Button -> AnyK () -> Button
onPress' Button
t (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ do
  Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
True
  [Keycode] -> m ()
forall (m :: * -> *). MonadK m => [Keycode] -> m ()
go []
  where
    go :: MonadK m => [Keycode] ->  m ()
    go :: forall (m :: * -> *). MonadK m => [Keycode] -> m ()
go [Keycode]
ks = HookLocation -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
HookLocation -> (KeyEvent -> m Catch) -> m ()
hookF HookLocation
InputHook ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \KeyEvent
e -> do
      KeyPred
p <- Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release
      let isRel :: Bool
isRel = KeyPred
isRelease KeyEvent
e
      if
        -- If the next event is my own release: we act as if we were tapped
        | KeyPred
p KeyEvent
e -> m Catch
forall (m :: * -> *). MonadK m => m Catch
doTap
        -- If the next event is the release of some button that was held after me
        -- we act as if we were held
        | Bool
isRel Bool -> Bool -> Bool
&& (KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
forall c. HasKeyEvent c => Lens' c Keycode
Lens' KeyEvent Keycode
keycode Keycode -> [Keycode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Keycode]
ks) -> KeyEvent -> m Catch
forall (m :: * -> *). MonadK m => KeyEvent -> m Catch
doHold KeyEvent
e
        -- Else, if it is a press, store the keycode and wait again
        | Bool -> Bool
not Bool
isRel                       -> [Keycode] -> m ()
forall (m :: * -> *). MonadK m => [Keycode] -> m ()
go ((KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
forall c. HasKeyEvent c => Lens' c Keycode
Lens' KeyEvent Keycode
keycode)Keycode -> [Keycode] -> [Keycode]
forall a. a -> [a] -> [a]
:[Keycode]
ks) m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
NoCatch
        -- Else, if it is a release of some button held before me, just ignore
        | Bool
otherwise                       -> [Keycode] -> m ()
forall (m :: * -> *). MonadK m => [Keycode] -> m ()
go [Keycode]
ks m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
NoCatch

    -- Behave like a tap is simple: tap the button `t` and release processing
    doTap :: MonadK m => m Catch
    doTap :: forall (m :: * -> *). MonadK m => m Catch
doTap = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
t m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
False m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
Catch

    -- Behave like a hold is not simple: first we release the processing hold,
    -- then we catch the release of ButtonX that triggered this action, and then
    -- we rethrow this release.
    doHold :: MonadK m => KeyEvent -> m Catch
    doHold :: forall (m :: * -> *). MonadK m => KeyEvent -> m Catch
doHold KeyEvent
e = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
h m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
False m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> KeyEvent -> m ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
inject KeyEvent
e m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
Catch



-- | Create a tap-hold style button that makes its decision based on the next
-- detected release in the following manner:
-- 1. It is the release of this button: We are tapping
-- 2. It is of some other button that was pressed *before* this one, ignore.
-- 3. It is of some other button that was pressed *after* this one, we hold.
--
-- If we encounter the timeout before any other release, we switch to the
-- specified timeout button, or to the hold button if none is specified.
--
-- 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 :: Milliseconds -> Button -> Button -> Maybe Button -> Button
tapHoldNextRelease Milliseconds
ms Button
t Button
h Maybe Button
mtb = Button -> AnyK () -> Button
onPress' Button
t (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ do
  Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
True
  Milliseconds -> [Keycode] -> m ()
forall (m :: * -> *). MonadK m => Milliseconds -> [Keycode] -> m ()
go Milliseconds
ms []
  where

    go :: MonadK m => Milliseconds -> [Keycode] ->  m ()
    go :: forall (m :: * -> *). MonadK m => Milliseconds -> [Keycode] -> m ()
go Milliseconds
ms' [Keycode]
ks = HookLocation
-> Milliseconds -> m () -> (Trigger -> m Catch) -> m ()
forall (m :: * -> *).
MonadK m =>
HookLocation
-> Milliseconds -> m () -> (Trigger -> m Catch) -> m ()
tHookF HookLocation
InputHook Milliseconds
ms' m ()
AnyK ()
onTimeout ((Trigger -> m Catch) -> m ()) -> (Trigger -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \Trigger
r -> do
      KeyPred
p <- Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release
      let e :: KeyEvent
e = Trigger
rTrigger -> Getting KeyEvent Trigger KeyEvent -> KeyEvent
forall s a. s -> Getting a s a -> a
^.Getting KeyEvent Trigger KeyEvent
forall c. HasTrigger c => Lens' c KeyEvent
Lens' Trigger KeyEvent
event
      let isRel :: Bool
isRel = KeyPred
isRelease KeyEvent
e
      if
        -- If the next event is my own release: act like tapped
        | KeyPred
p KeyEvent
e -> m Catch
forall (m :: * -> *). MonadK m => m Catch
onRelSelf
        -- If the next event is another release that was pressed after me
        | Bool
isRel Bool -> Bool -> Bool
&& (KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
forall c. HasKeyEvent c => Lens' c Keycode
Lens' KeyEvent Keycode
keycode Keycode -> [Keycode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Keycode]
ks) -> KeyEvent -> m Catch
forall (m :: * -> *). MonadK m => KeyEvent -> m Catch
onRelOther KeyEvent
e
        -- If the next event is a press, store and recurse
        | Bool -> Bool
not Bool
isRel -> Milliseconds -> [Keycode] -> m ()
forall (m :: * -> *). MonadK m => Milliseconds -> [Keycode] -> m ()
go (Milliseconds
ms' Milliseconds -> Milliseconds -> Milliseconds
forall a. Num a => a -> a -> a
- Trigger
rTrigger
-> Getting Milliseconds Trigger Milliseconds -> Milliseconds
forall s a. s -> Getting a s a -> a
^.Getting Milliseconds Trigger Milliseconds
forall c. HasTrigger c => Lens' c Milliseconds
Lens' Trigger Milliseconds
elapsed) (KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
forall c. HasKeyEvent c => Lens' c Keycode
Lens' KeyEvent Keycode
keycode Keycode -> [Keycode] -> [Keycode]
forall a. a -> [a] -> [a]
: [Keycode]
ks) m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
NoCatch
        -- If the next event is a release of some button pressed before me, recurse
        | Bool
otherwise -> Milliseconds -> [Keycode] -> m ()
forall (m :: * -> *). MonadK m => Milliseconds -> [Keycode] -> m ()
go (Milliseconds
ms' Milliseconds -> Milliseconds -> Milliseconds
forall a. Num a => a -> a -> a
- Trigger
rTrigger
-> Getting Milliseconds Trigger Milliseconds -> Milliseconds
forall s a. s -> Getting a s a -> a
^.Getting Milliseconds Trigger Milliseconds
forall c. HasTrigger c => Lens' c Milliseconds
Lens' Trigger Milliseconds
elapsed) [Keycode]
ks m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
NoCatch

    onTimeout :: MonadK m =>  m ()
    onTimeout :: AnyK ()
onTimeout = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press (Button -> Maybe Button -> Button
forall a. a -> Maybe a -> a
fromMaybe Button
h Maybe Button
mtb) m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
False

    onRelSelf :: MonadK m => m Catch
    onRelSelf :: forall (m :: * -> *). MonadK m => m Catch
onRelSelf = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
t m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
False m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
Catch

    onRelOther :: MonadK m => KeyEvent -> m Catch
    onRelOther :: forall (m :: * -> *). MonadK m => KeyEvent -> m Catch
onRelOther KeyEvent
e = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
h m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
False m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> KeyEvent -> m ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
inject KeyEvent
e m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
Catch

-- | Create a button just like tap-release, but also trigger a hold on presses:
-- 1. It is the release of this button: We are tapping
-- 2. It is the press of some other button, we hold
-- 3. It is the release of some other button, ignore.
tapNextPress :: Button -> Button -> Button
tapNextPress :: Button -> Button -> Button
tapNextPress Button
t Button
h = Button -> AnyK () -> Button
onPress' Button
t m ()
AnyK ()
go
  where
    go :: MonadK m => m ()
    go :: AnyK ()
go = HookLocation -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
HookLocation -> (KeyEvent -> m Catch) -> m ()
hookF HookLocation
InputHook ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \KeyEvent
e -> do
      KeyPred
p <- Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release
      if
        -- If the next event is my own release: we act as if we were tapped
        | KeyPred
p KeyEvent
e -> m Catch
forall (m :: * -> *). MonadK m => m Catch
doTap
        -- If the next event is a press: we act as if we were held
        | KeyPred
isPress KeyEvent
e -> KeyEvent -> m Catch
forall (m :: * -> *). MonadK m => KeyEvent -> m Catch
doHold KeyEvent
e
        -- Else, if it is a release of some other button, just ignore
        | Bool
otherwise -> m ()
AnyK ()
go m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
NoCatch

    -- Behave like a tap
    doTap :: MonadK m => m Catch
    doTap :: forall (m :: * -> *). MonadK m => m Catch
doTap = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
t m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
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 :: forall (m :: * -> *). MonadK m => KeyEvent -> m Catch
doHold KeyEvent
e = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
h m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> KeyEvent -> m ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
inject KeyEvent
e m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
Catch

-- | This button is to 'tap-next-press' what 'tap-hold-next' is to 'tap-next'
tapHoldNextPress :: Milliseconds -> Button -> Button -> Maybe Button -> Button
tapHoldNextPress :: Milliseconds -> Button -> Button -> Maybe Button -> Button
tapHoldNextPress Milliseconds
ms Button
t Button
h Maybe Button
mtb = Button -> AnyK () -> Button
onPress' Button
t (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ do
  Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
True
  Milliseconds -> m ()
forall (m :: * -> *). MonadK m => Milliseconds -> m ()
go Milliseconds
ms
  where
    go :: MonadK m => Milliseconds -> m ()
    go :: forall (m :: * -> *). MonadK m => Milliseconds -> m ()
go Milliseconds
ms' = HookLocation
-> Milliseconds -> m () -> (Trigger -> m Catch) -> m ()
forall (m :: * -> *).
MonadK m =>
HookLocation
-> Milliseconds -> m () -> (Trigger -> m Catch) -> m ()
tHookF HookLocation
InputHook Milliseconds
ms' m ()
AnyK ()
onTimeout ((Trigger -> m Catch) -> m ()) -> (Trigger -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \Trigger
r -> do
      KeyPred
p <- Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release
      let e :: KeyEvent
e = Trigger
rTrigger -> Getting KeyEvent Trigger KeyEvent -> KeyEvent
forall s a. s -> Getting a s a -> a
^.Getting KeyEvent Trigger KeyEvent
forall c. HasTrigger c => Lens' c KeyEvent
Lens' Trigger KeyEvent
event
      if
        -- If the next event is my own release: we act as if we were tapped
        | KeyPred
p KeyEvent
e -> m Catch
forall (m :: * -> *). MonadK m => m Catch
doTap
        -- If the next event is a press: we act as if we were held
        | KeyPred
isPress KeyEvent
e -> KeyEvent -> m Catch
forall (m :: * -> *). MonadK m => KeyEvent -> m Catch
doHold KeyEvent
e
        -- Else, if it is a release of some other button, just ignore
        | Bool
otherwise -> Milliseconds -> m ()
forall (m :: * -> *). MonadK m => Milliseconds -> m ()
go (Milliseconds
ms' Milliseconds -> Milliseconds -> Milliseconds
forall a. Num a => a -> a -> a
- Trigger
rTrigger
-> Getting Milliseconds Trigger Milliseconds -> Milliseconds
forall s a. s -> Getting a s a -> a
^.Getting Milliseconds Trigger Milliseconds
forall c. HasTrigger c => Lens' c Milliseconds
Lens' Trigger Milliseconds
elapsed) m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
NoCatch

    onTimeout :: MonadK m =>  m ()
    onTimeout :: AnyK ()
onTimeout = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press (Button -> Maybe Button -> Button
forall a. a -> Maybe a -> a
fromMaybe Button
h Maybe Button
mtb) m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
False

    -- Behave like a tap
    doTap :: MonadK m => m Catch
    doTap :: forall (m :: * -> *). MonadK m => m Catch
doTap = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
t m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
False m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
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 :: forall (m :: * -> *). MonadK m => KeyEvent -> m Catch
doHold KeyEvent
e = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
h m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
False m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> KeyEvent -> m ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
inject KeyEvent
e m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
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 :: Button -> [(Milliseconds, Button)] -> Button
multiTap Button
l [(Milliseconds, Button)]
bs = Button -> AnyK () -> Button
onPress' Button
tap' (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
True m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [(Milliseconds, Button)] -> m ()
forall (m :: * -> *). MonadK m => [(Milliseconds, Button)] -> m ()
go [(Milliseconds, Button)]
bs
  where
    tap' :: Button
tap' = case [(Milliseconds, Button)]
bs of
      []           -> Button
l
      ((Milliseconds
_, Button
b) : [(Milliseconds, Button)]
_) -> Button
b

    go :: MonadK m => [(Milliseconds, Button)] -> m ()
    go :: forall (m :: * -> *). MonadK m => [(Milliseconds, Button)] -> m ()
go []            = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
l m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
False
    go ((Milliseconds
ms, Button
b):[(Milliseconds, Button)]
bs') = do
      -- This is a bit complicated. What we do is:
      -- 1.  We wait for an event
      -- 2A. If it doesn't occur in the interval we press the button from the
      --     list and we are done.
      -- 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 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.
      -- 3B. If we detect another press of the same key, then the user is
      --     descending into the buttons tied to this multi-tap, so we recurse
      --     on the remaining buttons.
      -- 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.
      -- 3D. If we detect a release event, we also cancel the multi-tap sequence.
      let doNext :: m KeyPred
-> m ()
-> (Milliseconds -> m a)
-> (Milliseconds -> m a)
-> Milliseconds
-> m ()
doNext m KeyPred
pred m ()
onTimeout Milliseconds -> m a
next Milliseconds -> m a
cancel Milliseconds
ms = HookLocation
-> Milliseconds -> m () -> (Trigger -> m Catch) -> m ()
forall (m :: * -> *).
MonadK m =>
HookLocation
-> Milliseconds -> m () -> (Trigger -> m Catch) -> m ()
tHookF HookLocation
InputHook Milliseconds
ms m ()
onTimeout ((Trigger -> m Catch) -> m ()) -> (Trigger -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \Trigger
t -> do
            KeyPred
pr <- m KeyPred
pred
            if | KeyPred
pr (Trigger
tTrigger -> Getting KeyEvent Trigger KeyEvent -> KeyEvent
forall s a. s -> Getting a s a -> a
^.Getting KeyEvent Trigger KeyEvent
forall c. HasTrigger c => Lens' c KeyEvent
Lens' Trigger KeyEvent
event)      -> Milliseconds -> m a
next (Milliseconds
ms Milliseconds -> Milliseconds -> Milliseconds
forall a. Num a => a -> a -> a
- Trigger
tTrigger
-> Getting Milliseconds Trigger Milliseconds -> Milliseconds
forall s a. s -> Getting a s a -> a
^.Getting Milliseconds Trigger Milliseconds
forall c. HasTrigger c => Lens' c Milliseconds
Lens' Trigger Milliseconds
elapsed) m a -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
Catch
               | KeyPred
isPress (Trigger
tTrigger -> Getting KeyEvent Trigger KeyEvent -> KeyEvent
forall s a. s -> Getting a s a -> a
^.Getting KeyEvent Trigger KeyEvent
forall c. HasTrigger c => Lens' c KeyEvent
Lens' Trigger KeyEvent
event) -> m ()
onTimeout              m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
NoCatch
               | Bool
otherwise          -> Milliseconds -> m a
cancel (Milliseconds
ms Milliseconds -> Milliseconds -> Milliseconds
forall a. Num a => a -> a -> a
- Trigger
tTrigger
-> Getting Milliseconds Trigger Milliseconds -> Milliseconds
forall s a. s -> Getting a s a -> a
^.Getting Milliseconds Trigger Milliseconds
forall c. HasTrigger c => Lens' c Milliseconds
Lens' Trigger Milliseconds
elapsed) m a -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
NoCatch
      let cancel :: m ()
cancel = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
b m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
False
      let doHold :: m ()
doHold = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
b m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
False
      let whileReleased :: Milliseconds -> m ()
whileReleased = m KeyPred
-> m ()
-> (Milliseconds -> m ())
-> (Milliseconds -> m ())
-> Milliseconds
-> m ()
forall {m :: * -> *} {a} {a}.
MonadK m =>
m KeyPred
-> m ()
-> (Milliseconds -> m a)
-> (Milliseconds -> m a)
-> Milliseconds
-> m ()
doNext (Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Press) m ()
cancel (\Milliseconds
_ -> [(Milliseconds, Button)] -> m ()
forall (m :: * -> *). MonadK m => [(Milliseconds, Button)] -> m ()
go [(Milliseconds, Button)]
bs') (m () -> Milliseconds -> m ()
forall a b. a -> b -> a
const m ()
cancel)
      let whilePressed :: Milliseconds -> m ()
whilePressed = m KeyPred
-> m ()
-> (Milliseconds -> m ())
-> (Milliseconds -> m ())
-> Milliseconds
-> m ()
forall {m :: * -> *} {a} {a}.
MonadK m =>
m KeyPred
-> m ()
-> (Milliseconds -> m a)
-> (Milliseconds -> m a)
-> Milliseconds
-> m ()
doNext (Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release) m ()
doHold Milliseconds -> m ()
whileReleased Milliseconds -> m ()
whilePressed

      Milliseconds -> m ()
whilePressed Milliseconds
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 :: [Button] -> Button
tapMacro [Button]
bs = AnyK () -> AnyK () -> AnyK () -> Button
mkButton' (Bool -> [Button] -> m ()
forall {f :: * -> *}. MonadK f => Bool -> [Button] -> f ()
go Bool
False [Button]
bs) (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Bool -> [Button] -> m ()
forall {f :: * -> *}. MonadK f => Bool -> [Button] -> f ()
go Bool
True [Button]
bs)
  where
    go :: Bool -> [Button] -> f ()
go Bool
_ []      = () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    go Bool
False [Button
b]     = Button -> f ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
b
    go Bool
True [Button
b] = Button -> f ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
b
    go Bool
forceTap (Button
b:[Button]
rst) = Button -> f ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
b f () -> f () -> f ()
forall a b. f a -> f b -> f b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> [Button] -> f ()
go Bool
forceTap [Button]
rst

-- | 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 :: [Button] -> Button
tapMacroRelease [Button]
bs = AnyK () -> AnyK () -> AnyK () -> Button
mkButton' (Bool -> [Button] -> m ()
forall {f :: * -> *}. MonadK f => Bool -> [Button] -> f ()
go Bool
False [Button]
bs) (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Bool -> [Button] -> m ()
forall {f :: * -> *}. MonadK f => Bool -> [Button] -> f ()
go Bool
True [Button]
bs)
  where
    go :: Bool -> [Button] -> f ()
go Bool
_ []      = () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    go Bool
False [Button
b]     = Switch -> f Catch -> f ()
forall (m :: * -> *). MonadK m => Switch -> m Catch -> m ()
awaitMy Switch
Release (f Catch -> f ()) -> f Catch -> f ()
forall a b. (a -> b) -> a -> b
$ Button -> f ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
b f () -> f Catch -> f Catch
forall a b. f a -> f b -> f b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Catch -> f Catch
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch
    go Bool
True [Button
b] = Button -> f ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
b
    go Bool
forceTap (Button
b:[Button]
rst) = Button -> f ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
b f () -> f () -> f ()
forall a b. f a -> f b -> f b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> [Button] -> f ()
go Bool
forceTap [Button]
rst

-- | Switch to a layer for a period of time, then automatically switch back
layerDelay :: Milliseconds -> LayerTag -> Button
layerDelay :: Milliseconds -> LayerTag -> Button
layerDelay Milliseconds
d LayerTag
t = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ do
  LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerTag -> LayerOp
PushLayer LayerTag
t)
  Milliseconds -> m () -> m ()
forall (m :: * -> *). MonadK m => Milliseconds -> m () -> m ()
after Milliseconds
d (LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerOp -> m ()) -> LayerOp -> m ()
forall a b. (a -> b) -> a -> b
$ LayerTag -> LayerOp
PopLayer LayerTag
t)

-- | Switch to a layer for the next button-press and switch back automaically.
--
-- NOTE: liable to change, this is essentially just `aroundNext` and
-- `layerToggle` combined.
layerNext :: LayerTag -> Button
layerNext :: LayerTag -> Button
layerNext LayerTag
t = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ do
  LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerTag -> LayerOp
PushLayer LayerTag
t)
  KeyPred -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
KeyPred -> (KeyEvent -> m Catch) -> m ()
await KeyPred
isPress (\KeyEvent
_ -> m () -> m ()
forall (m :: * -> *). MonadK m => m () -> m ()
whenDone (LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerOp -> m ()) -> LayerOp -> m ()
forall a b. (a -> b) -> a -> b
$ LayerTag -> LayerOp
PopLayer LayerTag
t) m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
NoCatch)

-- | Make a button into a sticky-key, i.e. a key that acts like it is
-- pressed for the button after it if that button was pressed in the
-- given timeframe.
stickyKey :: Milliseconds -> Button -> Button
stickyKey :: Milliseconds -> Button -> Button
stickyKey Milliseconds
ms Button
b = AnyK () -> Button
onPress m ()
AnyK ()
go
 where
  go :: MonadK m => m ()
  go :: AnyK ()
go = HookLocation -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
HookLocation -> (KeyEvent -> m Catch) -> m ()
hookF HookLocation
InputHook ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \KeyEvent
e -> do
    KeyPred
p <- Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release
    if | KeyPred
p KeyEvent
e               -> m ()
AnyK ()
doTap    m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
Catch
         -- My own release; we act as if we were tapped
       | Bool -> Bool
not (KeyPred
isRelease KeyEvent
e) -> KeyEvent -> m ()
forall (m :: * -> *). MonadK m => KeyEvent -> m ()
doHold KeyEvent
e m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
Catch
         -- The press of another button; act like we are held down
       | Bool
otherwise         -> m ()
AnyK ()
go       m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
NoCatch
         -- The release of some other button; ignore these

  doHold :: MonadK m => KeyEvent -> m ()
  doHold :: forall (m :: * -> *). MonadK m => KeyEvent -> m ()
doHold KeyEvent
e = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
b m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> KeyEvent -> m ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
inject KeyEvent
e

  doTap :: MonadK m => m ()
  doTap :: AnyK ()
doTap =
    Milliseconds -> m KeyPred -> m () -> (Trigger -> m Catch) -> m ()
forall (m :: * -> *).
MonadK m =>
Milliseconds -> m KeyPred -> m () -> (Trigger -> m Catch) -> m ()
within Milliseconds
ms
           (KeyPred -> m KeyPred
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyPred
isPress)  -- presses definitely happen after us
           (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
           (\Trigger
t -> Action -> AnyK ()
runAction (Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
pressAction)
               m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> KeyEvent -> m ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
inject (Trigger
tTrigger -> Getting KeyEvent Trigger KeyEvent -> KeyEvent
forall s a. s -> Getting a s a -> a
^.Getting KeyEvent Trigger KeyEvent
forall c. HasTrigger c => Lens' c KeyEvent
Lens' Trigger KeyEvent
event)
               m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Milliseconds -> m () -> m ()
forall (m :: * -> *). MonadK m => Milliseconds -> m () -> m ()
after Milliseconds
3 (Action -> AnyK ()
runAction (Action -> AnyK ()) -> Action -> AnyK ()
forall a b. (a -> b) -> a -> b
$ Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
Lens' Button Action
releaseAction)
               m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
Catch)

-- | Create a button that functions as a different button everything it is pushed
--
-- I.e: first it acts as the first button, then as the second, then as the
-- third, and when finished rotates back to being the first button.
steppedButton :: [Button] -> Button
steppedButton :: [Button] -> Button
steppedButton [Button]
bs = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ [Button] -> m ()
forall {m :: * -> *}. MonadK m => [Button] -> m ()
go [Button]
bs
  where
    go :: [Button] -> m ()
go [] = m ()
forall a. HasCallStack => a
undefined
    go [Button
b] = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
b
    go (Button
b:[Button]
bs') = do
      Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
b
      Switch -> m Catch -> m ()
forall (m :: * -> *). MonadK m => Switch -> m Catch -> m ()
awaitMy Switch
Press (m Catch -> m ()) -> m Catch -> m ()
forall a b. (a -> b) -> a -> b
$ [Button] -> m ()
go [Button]
bs' m () -> Catch -> m Catch
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Catch
Catch