{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}

{-|
Module:      Web.KeyCode
Copyright:   (C) 2015-2017 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Experimental
Portability: Portable

Keyboard events in web browsers are often represented as keycodes, which (1) are
difficult to remember, and (2) sometimes vary from browser to browser. This module
allows one to look up a key press's 'KeyCode' and get a plain English description
of the 'Key' that was pressed, to reduce confusion.

/Since: 0.1/
-}
module Web.KeyCode (Key(..), KeyCode, keyCodeLookup, keyCodeMap, isKeyCode) where

import Data.Data (Data)
import Data.IntMap (IntMap, findWithDefault, fromAscList)
import Data.Ix (Ix)
import GHC.Generics (Generic)
import Language.Haskell.TH.Syntax (Lift)

-- | A numeric code representing the value of a pressed 'Key'. Note that a particular
-- 'Key' may not uniquely map to a particular 'KeyCode', as the implementation of
-- key codes is browser-dependent.
--
-- /Since: 0.1/
type KeyCode = Int

-- | Represents a typical keyboard's keys. The lowercase and uppercase variants of any
-- particular key have the same 'KeyCode', so there are not separate constructors for
-- them. There is also an 'UnknownKey' constructor for keys without a particular
-- 'KeyCode'.
--
-- Note that the 'Enum' instance does not correspond to the 'KeyCode's, but is simply
-- provided for convenience.
--
-- /Since: 0.1/
data Key = Backspace
         | Tab
         | NumLock
         | Enter
         | Shift
         | Control
         | Alt
         | Pause
         | CapsLock
         | Escape
         | Space
         | PageUp
         | PageDown
         | End
         | Home
         | ArrowLeft
         | ArrowUp
         | ArrowRight
         | ArrowDown
         | PrintScreen
         | Insert
         | Delete
         | Digit0  -- ^ Without Shift: @0@. With Shift: @)@.
         | Digit1  -- ^ Without Shift: @1@. With Shift: @!@.
         | Digit2  -- ^ Without Shift: @2@. With Shift: @\@@.
         | Digit3  -- ^ Without Shift: @3@. With Shift: @#@.
         | Digit4  -- ^ Without Shift: @4@. With Shift: @$@.
         | Digit5  -- ^ Without Shift: @5@. With Shift: @%@.
         | Digit6  -- ^ Without Shift: @6@. With Shift: @^@.
         | Digit7  -- ^ Without Shift: @7@. With Shift: @&@.
         | Digit8  -- ^ Without Shift: @8@. With Shift: @*@.
         | Digit9  -- ^ Without Shift: @9@. With Shift: @(@.
         | KeyA    -- ^ Without Shift: @a@. With Shift: @A@.
         | KeyB    -- ^ Without Shift: @b@. With Shift: @B@.
         | KeyC    -- ^ Without Shift: @c@. With Shift: @C@.
         | KeyD    -- ^ Without Shift: @d@. With Shift: @D@.
         | KeyE    -- ^ Without Shift: @e@. With Shift: @E@.
         | KeyF    -- ^ Without Shift: @f@. With Shift: @F@.
         | KeyG    -- ^ Without Shift: @g@. With Shift: @G@.
         | KeyH    -- ^ Without Shift: @h@. With Shift: @H@.
         | KeyI    -- ^ Without Shift: @i@. With Shift: @I@.
         | KeyJ    -- ^ Without Shift: @j@. With Shift: @J@.
         | KeyK    -- ^ Without Shift: @k@. With Shift: @K@.
         | KeyL    -- ^ Without Shift: @l@. With Shift: @L@.
         | KeyM    -- ^ Without Shift: @m@. With Shift: @M@.
         | KeyN    -- ^ Without Shift: @n@. With Shift: @N@.
         | KeyO    -- ^ Without Shift: @o@. With Shift: @O@.
         | KeyP    -- ^ Without Shift: @p@. With Shift: @P@.
         | KeyQ    -- ^ Without Shift: @q@. With Shift: @Q@.
         | KeyR    -- ^ Without Shift: @r@. With Shift: @R@.
         | KeyS    -- ^ Without Shift: @s@. With Shift: @S@.
         | KeyT    -- ^ Without Shift: @t@. With Shift: @T@.
         | KeyU    -- ^ Without Shift: @u@. With Shift: @U@.
         | KeyV    -- ^ Without Shift: @v@. With Shift: @V@.
         | KeyW    -- ^ Without Shift: @w@. With Shift: @W@.
         | KeyX    -- ^ Without Shift: @x@. With Shift: @X@.
         | KeyY    -- ^ Without Shift: @y@. With Shift: @Y@.
         | KeyZ    -- ^ Without Shift: @z@. With Shift: @Z@.
         | Command -- ^ Might also be the Windows key or the Super key
         | Numpad0
         | Numpad1
         | Numpad2
         | Numpad3
         | Numpad4
         | Numpad5
         | Numpad6
         | Numpad7
         | Numpad8
         | Numpad9
         | NumpadMultiply
         | NumpadAdd
         | NumpadEnter
         | NumpadSubtract
         | NumpadDecimal
         | NumpadDivide
         | F1
         | F2
         | F3
         | F4
         | F5
         | F6
         | F7
         | F8
         | F9
         | F10
         | F11
         | F12
         | ScrollLock
         | Semicolon    -- ^ Without Shift: @;@. With Shift: @:@.
         | Equals       -- ^ Without Shift: @=@. With Shift: @+@.
         | Comma        -- ^ Without Shift: @,@. With Shift: @<@.
         | Subtract     -- ^ Without Shift: @-@. With Shift: @_@.
         | Period       -- ^ Without Shift: @.@. With Shift: @>@.
         | ForwardSlash -- ^ Without Shift: @/@. With Shift: @?@.
         | Backquote    -- ^ Without Shift: @`@. With Shift: @~@.
         | BracketLeft  -- ^ Without Shift: @[@. With Shift: @{@.
         | Backslash    -- ^ Without Shift: @\\@. With Shift: @|@.
         | BracketRight -- ^ Without Shift: @]@. With Shift: @}@.
         | Apostrophe   -- ^ Without Shift: @\'@. With Shift: @"@.
         | UnknownKey
  deriving ( Key
Key -> Key -> Bounded Key
forall a. a -> a -> Bounded a
$cminBound :: Key
minBound :: Key
$cmaxBound :: Key
maxBound :: Key
Bounded
           , Typeable Key
Typeable Key =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Key -> c Key)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Key)
-> (Key -> Constr)
-> (Key -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Key))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key))
-> ((forall b. Data b => b -> b) -> Key -> Key)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r)
-> (forall u. (forall d. Data d => d -> u) -> Key -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Key -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Key -> m Key)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Key -> m Key)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Key -> m Key)
-> Data Key
Key -> Constr
Key -> DataType
(forall b. Data b => b -> b) -> Key -> Key
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Key -> u
forall u. (forall d. Data d => d -> u) -> Key -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Key -> m Key
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Key)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
$ctoConstr :: Key -> Constr
toConstr :: Key -> Constr
$cdataTypeOf :: Key -> DataType
dataTypeOf :: Key -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Key)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Key)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key)
$cgmapT :: (forall b. Data b => b -> b) -> Key -> Key
gmapT :: (forall b. Data b => b -> b) -> Key -> Key
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Key -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Key -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Key -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Key -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Key -> m Key
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Key -> m Key
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
Data
           , Int -> Key
Key -> Int
Key -> [Key]
Key -> Key
Key -> Key -> [Key]
Key -> Key -> Key -> [Key]
(Key -> Key)
-> (Key -> Key)
-> (Int -> Key)
-> (Key -> Int)
-> (Key -> [Key])
-> (Key -> Key -> [Key])
-> (Key -> Key -> [Key])
-> (Key -> Key -> Key -> [Key])
-> Enum Key
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 :: Key -> Key
succ :: Key -> Key
$cpred :: Key -> Key
pred :: Key -> Key
$ctoEnum :: Int -> Key
toEnum :: Int -> Key
$cfromEnum :: Key -> Int
fromEnum :: Key -> Int
$cenumFrom :: Key -> [Key]
enumFrom :: Key -> [Key]
$cenumFromThen :: Key -> Key -> [Key]
enumFromThen :: Key -> Key -> [Key]
$cenumFromTo :: Key -> Key -> [Key]
enumFromTo :: Key -> Key -> [Key]
$cenumFromThenTo :: Key -> Key -> Key -> [Key]
enumFromThenTo :: Key -> Key -> Key -> [Key]
Enum
           , Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: Key -> Key -> Bool
Eq
           , (forall x. Key -> Rep Key x)
-> (forall x. Rep Key x -> Key) -> Generic Key
forall x. Rep Key x -> Key
forall x. Key -> Rep Key x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Key -> Rep Key x
from :: forall x. Key -> Rep Key x
$cto :: forall x. Rep Key x -> Key
to :: forall x. Rep Key x -> Key
Generic
           , Ord Key
Ord Key =>
((Key, Key) -> [Key])
-> ((Key, Key) -> Key -> Int)
-> ((Key, Key) -> Key -> Int)
-> ((Key, Key) -> Key -> Bool)
-> ((Key, Key) -> Int)
-> ((Key, Key) -> Int)
-> Ix Key
(Key, Key) -> Int
(Key, Key) -> [Key]
(Key, Key) -> Key -> Bool
(Key, Key) -> Key -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (Key, Key) -> [Key]
range :: (Key, Key) -> [Key]
$cindex :: (Key, Key) -> Key -> Int
index :: (Key, Key) -> Key -> Int
$cunsafeIndex :: (Key, Key) -> Key -> Int
unsafeIndex :: (Key, Key) -> Key -> Int
$cinRange :: (Key, Key) -> Key -> Bool
inRange :: (Key, Key) -> Key -> Bool
$crangeSize :: (Key, Key) -> Int
rangeSize :: (Key, Key) -> Int
$cunsafeRangeSize :: (Key, Key) -> Int
unsafeRangeSize :: (Key, Key) -> Int
Ix
           , (forall (m :: * -> *). Quote m => Key -> m Exp)
-> (forall (m :: * -> *). Quote m => Key -> Code m Key) -> Lift Key
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Key -> m Exp
forall (m :: * -> *). Quote m => Key -> Code m Key
$clift :: forall (m :: * -> *). Quote m => Key -> m Exp
lift :: forall (m :: * -> *). Quote m => Key -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Key -> Code m Key
liftTyped :: forall (m :: * -> *). Quote m => Key -> Code m Key
Lift
           , Eq Key
Eq Key =>
(Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
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 :: Key -> Key -> Ordering
compare :: Key -> Key -> Ordering
$c< :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
>= :: Key -> Key -> Bool
$cmax :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
min :: Key -> Key -> Key
Ord
           , ReadPrec [Key]
ReadPrec Key
Int -> ReadS Key
ReadS [Key]
(Int -> ReadS Key)
-> ReadS [Key] -> ReadPrec Key -> ReadPrec [Key] -> Read Key
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Key
readsPrec :: Int -> ReadS Key
$creadList :: ReadS [Key]
readList :: ReadS [Key]
$creadPrec :: ReadPrec Key
readPrec :: ReadPrec Key
$creadListPrec :: ReadPrec [Key]
readListPrec :: ReadPrec [Key]
Read
           , Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Key -> ShowS
showsPrec :: Int -> Key -> ShowS
$cshow :: Key -> String
show :: Key -> String
$cshowList :: [Key] -> ShowS
showList :: [Key] -> ShowS
Show
           )

-- | Determine the 'Key' that a 'KeyCode' represents. If one cannot be found,
-- 'UnknownKey' is returned.
--
-- /Since: 0.1/
keyCodeLookup :: KeyCode -> Key
keyCodeLookup :: Int -> Key
keyCodeLookup Int
key = Key -> Int -> IntMap Key -> Key
forall a. a -> Int -> IntMap a -> a
findWithDefault Key
UnknownKey Int
key IntMap Key
keyCodeMap

-- | An map of known 'KeyCode's to 'Key's.
--
-- /Since: 0.1/
keyCodeMap :: IntMap Key
keyCodeMap :: IntMap Key
keyCodeMap = [(Int, Key)] -> IntMap Key
forall a. [(Int, a)] -> IntMap a
fromAscList [
      -- Thanks to David Mauro for his keyCode mapping from the Keypress library
      -- (https://github.com/dmauro/Keypress/blob/e5e95070d81b998b02b2d7f096267b114a3771d7/keypress.coffee#L802-L916)
      -- Licensed under the Apache License, version 2.0
      (  Int
8, Key
Backspace     )
    , (  Int
9, Key
Tab           )
    , ( Int
12, Key
NumLock       )
    , ( Int
13, Key
Enter         )
    , ( Int
16, Key
Shift         )
    , ( Int
17, Key
Control       )
    , ( Int
18, Key
Alt           )
    , ( Int
19, Key
Pause         )
    , ( Int
20, Key
CapsLock      )
    , ( Int
27, Key
Escape        )
    , ( Int
32, Key
Space         )
    , ( Int
33, Key
PageUp        )
    , ( Int
34, Key
PageDown      )
    , ( Int
35, Key
End           )
    , ( Int
36, Key
Home          )
    , ( Int
37, Key
ArrowLeft     )
    , ( Int
38, Key
ArrowUp       )
    , ( Int
39, Key
ArrowRight    )
    , ( Int
40, Key
ArrowDown     )
    , ( Int
44, Key
PrintScreen   )
    , ( Int
45, Key
Insert        )
    , ( Int
46, Key
Delete        )
    , ( Int
48, Key
Digit0        )
    , ( Int
49, Key
Digit1        )
    , ( Int
50, Key
Digit2        )
    , ( Int
51, Key
Digit3        )
    , ( Int
52, Key
Digit4        )
    , ( Int
53, Key
Digit5        )
    , ( Int
54, Key
Digit6        )
    , ( Int
55, Key
Digit7        )
    , ( Int
56, Key
Digit8        )
    , ( Int
57, Key
Digit9        )
    , ( Int
59, Key
Semicolon     ) -- Firefox oddity
    , ( Int
61, Key
Equals        ) -- Firefox oddity
    , ( Int
65, Key
KeyA          )
    , ( Int
66, Key
KeyB          )
    , ( Int
67, Key
KeyC          )
    , ( Int
68, Key
KeyD          )
    , ( Int
69, Key
KeyE          )
    , ( Int
70, Key
KeyF          )
    , ( Int
71, Key
KeyG          )
    , ( Int
72, Key
KeyH          )
    , ( Int
73, Key
KeyI          )
    , ( Int
74, Key
KeyJ          )
    , ( Int
75, Key
KeyK          )
    , ( Int
76, Key
KeyL          )
    , ( Int
77, Key
KeyM          )
    , ( Int
78, Key
KeyN          )
    , ( Int
79, Key
KeyO          )
    , ( Int
80, Key
KeyP          )
    , ( Int
81, Key
KeyQ          )
    , ( Int
82, Key
KeyR          )
    , ( Int
83, Key
KeyS          )
    , ( Int
84, Key
KeyT          )
    , ( Int
85, Key
KeyU          )
    , ( Int
86, Key
KeyV          )
    , ( Int
87, Key
KeyW          )
    , ( Int
88, Key
KeyX          )
    , ( Int
89, Key
KeyY          )
    , ( Int
90, Key
KeyZ          )
    , ( Int
91, Key
Command       )
    , ( Int
92, Key
Command       )
    , ( Int
93, Key
Command       )
    , ( Int
96, Key
Numpad0       )
    , ( Int
97, Key
Numpad1       )
    , ( Int
98, Key
Numpad2       )
    , ( Int
99, Key
Numpad3       )
    , (Int
100, Key
Numpad4       )
    , (Int
101, Key
Numpad5       )
    , (Int
102, Key
Numpad6       )
    , (Int
103, Key
Numpad7       )
    , (Int
104, Key
Numpad8       )
    , (Int
105, Key
Numpad9       )
    , (Int
106, Key
NumpadMultiply)
    , (Int
107, Key
NumpadAdd     )
    , (Int
108, Key
NumpadEnter   )
    , (Int
109, Key
NumpadSubtract)
    , (Int
110, Key
NumpadDecimal )
    , (Int
111, Key
NumpadDivide  )
    , (Int
112, Key
F1            )
    , (Int
113, Key
F2            )
    , (Int
114, Key
F3            )
    , (Int
115, Key
F4            )
    , (Int
116, Key
F5            )
    , (Int
117, Key
F6            )
    , (Int
118, Key
F7            )
    , (Int
119, Key
F8            )
    , (Int
120, Key
F9            )
    , (Int
121, Key
F10           )
    , (Int
122, Key
F11           )
    , (Int
123, Key
F12           )
    , (Int
124, Key
PrintScreen   )
    , (Int
144, Key
NumLock       )
    , (Int
145, Key
ScrollLock    )
    , (Int
173, Key
Subtract      ) -- Firefox oddity
    , (Int
186, Key
Semicolon     )
    , (Int
187, Key
Equals        )
    , (Int
188, Key
Comma         )
    , (Int
189, Key
Subtract      )
    , (Int
190, Key
Period        )
    , (Int
191, Key
ForwardSlash  )
    , (Int
192, Key
Backquote     )
    , (Int
219, Key
BracketLeft   )
    , (Int
220, Key
Backslash     )
    , (Int
221, Key
BracketRight  )
    , (Int
222, Key
Apostrophe    )
    , (Int
223, Key
Backquote     )
    , (Int
224, Key
Command       )
    , (Int
225, Key
Alt           )
    ]

-- | Return 'True' if the given 'KeyCode' matches the given 'Key'.
--
-- /Since: 0.2.2/
isKeyCode :: Key -> KeyCode -> Bool
isKeyCode :: Key -> Int -> Bool
isKeyCode Key
key Int
code = Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Key
keyCodeLookup Int
code