module KMonad.Keyboard.Ops
  ( switch
  , keycode
  , mkKeyEvent
  , mkPress
  , mkRelease

    -- * Predicates
  , isPress
  , isRelease
  , isKeycode
  , isPressOf
  , isReleaseOf
  )
where

import KMonad.Prelude
import KMonad.Keyboard.Types
import KMonad.Keyboard.Keycode



-- | Create a 'KeyEvent' that represents pressing a key
mkPress :: Keycode -> KeyEvent
mkPress :: Keycode -> KeyEvent
mkPress = Switch -> Keycode -> KeyEvent
mkKeyEvent Switch
Press

-- | Create a 'KeyEvent' that represents releaseing a key
mkRelease :: Keycode -> KeyEvent
mkRelease :: Keycode -> KeyEvent
mkRelease = Switch -> Keycode -> KeyEvent
mkKeyEvent Switch
Release

-- | Return whether the provided KeyEvent is a Press
isPress :: KeyPred
isPress :: KeyPred
isPress = (Switch -> Switch -> Bool
forall a. Eq a => a -> a -> Bool
== Switch
Press) (Switch -> Bool) -> (KeyEvent -> Switch) -> KeyPred
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Switch KeyEvent Switch -> KeyEvent -> Switch
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Switch KeyEvent Switch
forall c. HasKeyEvent c => Lens' c Switch
Lens' KeyEvent Switch
switch

-- | Return whether the provided KeyEvent is a Release
isRelease :: KeyPred
isRelease :: KeyPred
isRelease = Bool -> Bool
not (Bool -> Bool) -> KeyPred -> KeyPred
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPred
isPress

-- | Return whether the provided KeyEvent matches a particular Keycode
isKeycode :: Keycode -> KeyPred
isKeycode :: Keycode -> KeyPred
isKeycode Keycode
c = (Keycode -> Keycode -> Bool
forall a. Eq a => a -> a -> Bool
== Keycode
c) (Keycode -> Bool) -> (KeyEvent -> Keycode) -> KeyPred
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Keycode KeyEvent Keycode -> KeyEvent -> Keycode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Keycode KeyEvent Keycode
forall c. HasKeyEvent c => Lens' c Keycode
Lens' KeyEvent Keycode
keycode

-- | Returth whether the provided KeyEvent matches the release of the Keycode
isReleaseOf :: Keycode -> KeyPred
isReleaseOf :: Keycode -> KeyPred
isReleaseOf = KeyEvent -> KeyPred
forall a. Eq a => a -> a -> Bool
(==) (KeyEvent -> KeyPred)
-> (Keycode -> KeyEvent) -> Keycode -> KeyPred
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Keycode -> KeyEvent
mkRelease

-- | Return whether the provided KeyEvent matches the press of the Keycode
isPressOf :: Keycode -> KeyPred
isPressOf :: Keycode -> KeyPred
isPressOf = KeyEvent -> KeyPred
forall a. Eq a => a -> a -> Bool
(==) (KeyEvent -> KeyPred)
-> (Keycode -> KeyEvent) -> Keycode -> KeyPred
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Keycode -> KeyEvent
mkPress