{-# LANGUAGE DeriveAnyClass #-}
module KMonad.Keyboard.Types
  (
    Switch(..)
  , KeyEvent
  , mkKeyEvent
  , HasKeyEvent(..)
  , KeyPred
  , LayerTag
  , LMap
  )
where

import KMonad.Prelude
import KMonad.Keyboard.Keycode

import qualified KMonad.Util.LayerStack as Ls

--------------------------------------------------------------------------------
-- $event
--
-- An 'KeyEvent' in KMonad is either the 'Press' or 'Release' of a particular
-- 'Keycode'. A complete list of keycodes can be found in
-- "KMonad.Keyboard.Keycode".

-- | KMonad recognizes 2 different types of actions: presses and releases. Note
-- that we do not handle repeat events at all.
data Switch
  = Press
  | Release
  deriving (Switch -> Switch -> Bool
(Switch -> Switch -> Bool)
-> (Switch -> Switch -> Bool) -> Eq Switch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Switch -> Switch -> Bool
== :: Switch -> Switch -> Bool
$c/= :: Switch -> Switch -> Bool
/= :: Switch -> Switch -> Bool
Eq, Eq Switch
Eq Switch
-> (Switch -> Switch -> Ordering)
-> (Switch -> Switch -> Bool)
-> (Switch -> Switch -> Bool)
-> (Switch -> Switch -> Bool)
-> (Switch -> Switch -> Bool)
-> (Switch -> Switch -> Switch)
-> (Switch -> Switch -> Switch)
-> Ord Switch
Switch -> Switch -> Bool
Switch -> Switch -> Ordering
Switch -> Switch -> Switch
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Switch -> Switch -> Ordering
compare :: Switch -> Switch -> Ordering
$c< :: Switch -> Switch -> Bool
< :: Switch -> Switch -> Bool
$c<= :: Switch -> Switch -> Bool
<= :: Switch -> Switch -> Bool
$c> :: Switch -> Switch -> Bool
> :: Switch -> Switch -> Bool
$c>= :: Switch -> Switch -> Bool
>= :: Switch -> Switch -> Bool
$cmax :: Switch -> Switch -> Switch
max :: Switch -> Switch -> Switch
$cmin :: Switch -> Switch -> Switch
min :: Switch -> Switch -> Switch
Ord, Int -> Switch -> ShowS
[Switch] -> ShowS
Switch -> String
(Int -> Switch -> ShowS)
-> (Switch -> String) -> ([Switch] -> ShowS) -> Show Switch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Switch -> ShowS
showsPrec :: Int -> Switch -> ShowS
$cshow :: Switch -> String
show :: Switch -> String
$cshowList :: [Switch] -> ShowS
showList :: [Switch] -> ShowS
Show, Int -> Switch
Switch -> Int
Switch -> [Switch]
Switch -> Switch
Switch -> Switch -> [Switch]
Switch -> Switch -> Switch -> [Switch]
(Switch -> Switch)
-> (Switch -> Switch)
-> (Int -> Switch)
-> (Switch -> Int)
-> (Switch -> [Switch])
-> (Switch -> Switch -> [Switch])
-> (Switch -> Switch -> [Switch])
-> (Switch -> Switch -> Switch -> [Switch])
-> Enum Switch
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Switch -> Switch
succ :: Switch -> Switch
$cpred :: Switch -> Switch
pred :: Switch -> Switch
$ctoEnum :: Int -> Switch
toEnum :: Int -> Switch
$cfromEnum :: Switch -> Int
fromEnum :: Switch -> Int
$cenumFrom :: Switch -> [Switch]
enumFrom :: Switch -> [Switch]
$cenumFromThen :: Switch -> Switch -> [Switch]
enumFromThen :: Switch -> Switch -> [Switch]
$cenumFromTo :: Switch -> Switch -> [Switch]
enumFromTo :: Switch -> Switch -> [Switch]
$cenumFromThenTo :: Switch -> Switch -> Switch -> [Switch]
enumFromThenTo :: Switch -> Switch -> Switch -> [Switch]
Enum, (forall x. Switch -> Rep Switch x)
-> (forall x. Rep Switch x -> Switch) -> Generic Switch
forall x. Rep Switch x -> Switch
forall x. Switch -> Rep Switch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Switch -> Rep Switch x
from :: forall x. Switch -> Rep Switch x
$cto :: forall x. Rep Switch x -> Switch
to :: forall x. Rep Switch x -> Switch
Generic, Eq Switch
Eq Switch
-> (Int -> Switch -> Int) -> (Switch -> Int) -> Hashable Switch
Int -> Switch -> Int
Switch -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Switch -> Int
hashWithSalt :: Int -> Switch -> Int
$chash :: Switch -> Int
hash :: Switch -> Int
Hashable)

-- | An 'KeyEvent' is a 'Switch' on a particular 'Keycode'
data KeyEvent = KeyEvent
  { KeyEvent -> Switch
_switch  :: Switch  -- ^ Whether the 'KeyEvent' was a 'Press' or 'Release'
  , KeyEvent -> Keycode
_keycode :: Keycode -- ^ The 'Keycode' mapped to this 'KeyEvent'
  } deriving (KeyEvent -> KeyEvent -> Bool
(KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> Bool) -> Eq KeyEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyEvent -> KeyEvent -> Bool
== :: KeyEvent -> KeyEvent -> Bool
$c/= :: KeyEvent -> KeyEvent -> Bool
/= :: KeyEvent -> KeyEvent -> Bool
Eq, Int -> KeyEvent -> ShowS
[KeyEvent] -> ShowS
KeyEvent -> String
(Int -> KeyEvent -> ShowS)
-> (KeyEvent -> String) -> ([KeyEvent] -> ShowS) -> Show KeyEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyEvent -> ShowS
showsPrec :: Int -> KeyEvent -> ShowS
$cshow :: KeyEvent -> String
show :: KeyEvent -> String
$cshowList :: [KeyEvent] -> ShowS
showList :: [KeyEvent] -> ShowS
Show, (forall x. KeyEvent -> Rep KeyEvent x)
-> (forall x. Rep KeyEvent x -> KeyEvent) -> Generic KeyEvent
forall x. Rep KeyEvent x -> KeyEvent
forall x. KeyEvent -> Rep KeyEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. KeyEvent -> Rep KeyEvent x
from :: forall x. KeyEvent -> Rep KeyEvent x
$cto :: forall x. Rep KeyEvent x -> KeyEvent
to :: forall x. Rep KeyEvent x -> KeyEvent
Generic, Eq KeyEvent
Eq KeyEvent
-> (Int -> KeyEvent -> Int)
-> (KeyEvent -> Int)
-> Hashable KeyEvent
Int -> KeyEvent -> Int
KeyEvent -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> KeyEvent -> Int
hashWithSalt :: Int -> KeyEvent -> Int
$chash :: KeyEvent -> Int
hash :: KeyEvent -> Int
Hashable)
makeClassy ''KeyEvent

-- | Create a new 'KeyEvent' from a 'Switch' and a 'Keycode'
mkKeyEvent :: Switch -> Keycode -> KeyEvent
mkKeyEvent :: Switch -> Keycode -> KeyEvent
mkKeyEvent = Switch -> Keycode -> KeyEvent
KeyEvent

-- | A 'Display' instance for 'KeyEvent's that prints them out nicely.
instance Display KeyEvent where
  textDisplay :: KeyEvent -> Text
textDisplay KeyEvent
a = Switch -> Text
forall a. Show a => a -> Text
tshow (KeyEvent
aKeyEvent -> Getting Switch KeyEvent Switch -> Switch
forall s a. s -> Getting a s a -> a
^.Getting Switch KeyEvent Switch
forall c. HasKeyEvent c => Lens' c Switch
Lens' KeyEvent Switch
switch) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Keycode -> Text
forall a. Display a => a -> Text
textDisplay (KeyEvent
aKeyEvent -> 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)

-- | An 'Ord' instance, where Press > Release, and otherwise we 'Ord' on the
-- 'Keycode'
instance Ord KeyEvent where
  KeyEvent
a compare :: KeyEvent -> KeyEvent -> Ordering
`compare` KeyEvent
b = case (KeyEvent
aKeyEvent -> Getting Switch KeyEvent Switch -> Switch
forall s a. s -> Getting a s a -> a
^.Getting Switch KeyEvent Switch
forall c. HasKeyEvent c => Lens' c Switch
Lens' KeyEvent Switch
switch) Switch -> Switch -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (KeyEvent
bKeyEvent -> Getting Switch KeyEvent Switch -> Switch
forall s a. s -> Getting a s a -> a
^.Getting Switch KeyEvent Switch
forall c. HasKeyEvent c => Lens' c Switch
Lens' KeyEvent Switch
switch) of
    Ordering
EQ -> (KeyEvent
aKeyEvent -> 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 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (KeyEvent
bKeyEvent -> 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)
    Ordering
x  -> Ordering
x


-- | Predicate on KeyEvent's
type KeyPred = KeyEvent -> Bool

--------------------------------------------------------------------------------
-- $lmap
--
-- Type aliases for specifying stacked-layer mappings

-- | Layers are identified by a tag that is simply a 'Text' value.
type LayerTag = Text

-- | 'LMap's are mappings from 'LayerTag'd maps from 'Keycode' to things.
type LMap a = Ls.LayerStack LayerTag Keycode a