-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Evdev/Codes.chs" #-}
module Evdev.Codes where





data DeviceProperty = InputPropPointer
                    | InputPropDirect
                    | InputPropButtonpad
                    | InputPropSemiMt
                    | InputPropTopbuttonpad
                    | InputPropPointingStick
                    | InputPropAccelerometer
  deriving (DeviceProperty
DeviceProperty -> DeviceProperty -> Bounded DeviceProperty
forall a. a -> a -> Bounded a
maxBound :: DeviceProperty
$cmaxBound :: DeviceProperty
minBound :: DeviceProperty
$cminBound :: DeviceProperty
Bounded,DeviceProperty -> DeviceProperty -> Bool
(DeviceProperty -> DeviceProperty -> Bool)
-> (DeviceProperty -> DeviceProperty -> Bool) -> Eq DeviceProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeviceProperty -> DeviceProperty -> Bool
$c/= :: DeviceProperty -> DeviceProperty -> Bool
== :: DeviceProperty -> DeviceProperty -> Bool
$c== :: DeviceProperty -> DeviceProperty -> Bool
Eq,Eq DeviceProperty
Eq DeviceProperty =>
(DeviceProperty -> DeviceProperty -> Ordering)
-> (DeviceProperty -> DeviceProperty -> Bool)
-> (DeviceProperty -> DeviceProperty -> Bool)
-> (DeviceProperty -> DeviceProperty -> Bool)
-> (DeviceProperty -> DeviceProperty -> Bool)
-> (DeviceProperty -> DeviceProperty -> DeviceProperty)
-> (DeviceProperty -> DeviceProperty -> DeviceProperty)
-> Ord DeviceProperty
DeviceProperty -> DeviceProperty -> Bool
DeviceProperty -> DeviceProperty -> Ordering
DeviceProperty -> DeviceProperty -> DeviceProperty
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
min :: DeviceProperty -> DeviceProperty -> DeviceProperty
$cmin :: DeviceProperty -> DeviceProperty -> DeviceProperty
max :: DeviceProperty -> DeviceProperty -> DeviceProperty
$cmax :: DeviceProperty -> DeviceProperty -> DeviceProperty
>= :: DeviceProperty -> DeviceProperty -> Bool
$c>= :: DeviceProperty -> DeviceProperty -> Bool
> :: DeviceProperty -> DeviceProperty -> Bool
$c> :: DeviceProperty -> DeviceProperty -> Bool
<= :: DeviceProperty -> DeviceProperty -> Bool
$c<= :: DeviceProperty -> DeviceProperty -> Bool
< :: DeviceProperty -> DeviceProperty -> Bool
$c< :: DeviceProperty -> DeviceProperty -> Bool
compare :: DeviceProperty -> DeviceProperty -> Ordering
$ccompare :: DeviceProperty -> DeviceProperty -> Ordering
$cp1Ord :: Eq DeviceProperty
Ord,ReadPrec [DeviceProperty]
ReadPrec DeviceProperty
Int -> ReadS DeviceProperty
ReadS [DeviceProperty]
(Int -> ReadS DeviceProperty)
-> ReadS [DeviceProperty]
-> ReadPrec DeviceProperty
-> ReadPrec [DeviceProperty]
-> Read DeviceProperty
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeviceProperty]
$creadListPrec :: ReadPrec [DeviceProperty]
readPrec :: ReadPrec DeviceProperty
$creadPrec :: ReadPrec DeviceProperty
readList :: ReadS [DeviceProperty]
$creadList :: ReadS [DeviceProperty]
readsPrec :: Int -> ReadS DeviceProperty
$creadsPrec :: Int -> ReadS DeviceProperty
Read,Int -> DeviceProperty -> ShowS
[DeviceProperty] -> ShowS
DeviceProperty -> String
(Int -> DeviceProperty -> ShowS)
-> (DeviceProperty -> String)
-> ([DeviceProperty] -> ShowS)
-> Show DeviceProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeviceProperty] -> ShowS
$cshowList :: [DeviceProperty] -> ShowS
show :: DeviceProperty -> String
$cshow :: DeviceProperty -> String
showsPrec :: Int -> DeviceProperty -> ShowS
$cshowsPrec :: Int -> DeviceProperty -> ShowS
Show)
instance Enum DeviceProperty where
  succ :: DeviceProperty -> DeviceProperty
succ InputPropPointer = DeviceProperty
InputPropDirect
  succ InputPropDirect = DeviceProperty
InputPropButtonpad
  succ InputPropButtonpad = DeviceProperty
InputPropSemiMt
  succ InputPropSemiMt = DeviceProperty
InputPropTopbuttonpad
  succ InputPropTopbuttonpad = DeviceProperty
InputPropPointingStick
  succ InputPropPointingStick = DeviceProperty
InputPropAccelerometer
  succ InputPropAccelerometer = String -> DeviceProperty
forall a. HasCallStack => String -> a
error "DeviceProperty.succ: InputPropAccelerometer has no successor"

  pred InputPropDirect = InputPropPointer
  pred InputPropButtonpad = InputPropDirect
  pred InputPropSemiMt = InputPropButtonpad
  pred InputPropTopbuttonpad = DeviceProperty
InputPropSemiMt
  pred InputPropPointingStick = DeviceProperty
InputPropTopbuttonpad
  pred InputPropAccelerometer = DeviceProperty
InputPropPointingStick
  pred InputPropPointer = String -> DeviceProperty
forall a. HasCallStack => String -> a
error "DeviceProperty.pred: InputPropPointer has no predecessor"

  enumFromTo :: DeviceProperty -> DeviceProperty -> [DeviceProperty]
enumFromTo from :: DeviceProperty
from to :: DeviceProperty
to = DeviceProperty -> [DeviceProperty]
forall t. Enum t => t -> [t]
go DeviceProperty
from
    where
      end :: Int
end = DeviceProperty -> Int
forall a. Enum a => a -> Int
fromEnum DeviceProperty
to
      go :: t -> [t]
go v :: t
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (t -> Int
forall a. Enum a => a -> Int
fromEnum t
v) Int
end of
                 LT -> t
v t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t]
go (t -> t
forall a. Enum a => a -> a
succ t
v)
                 EQ -> [t
Item [t]
v]
                 GT -> []

  enumFrom :: DeviceProperty -> [DeviceProperty]
enumFrom from :: DeviceProperty
from = DeviceProperty -> DeviceProperty -> [DeviceProperty]
forall a. Enum a => a -> a -> [a]
enumFromTo DeviceProperty
from DeviceProperty
InputPropAccelerometer

  fromEnum :: DeviceProperty -> Int
fromEnum InputPropPointer = 0
  fromEnum InputPropDirect = 1
  fromEnum InputPropButtonpad = 2
  fromEnum InputPropSemiMt = 3
  fromEnum InputPropTopbuttonpad = 4
  fromEnum InputPropPointingStick = 5
  fromEnum InputPropAccelerometer = 6

  toEnum :: Int -> DeviceProperty
toEnum 0 = DeviceProperty
InputPropPointer
  toEnum 1 = DeviceProperty
InputPropDirect
  toEnum 2 = DeviceProperty
InputPropButtonpad
  toEnum 3 = DeviceProperty
InputPropSemiMt
  toEnum 4 = DeviceProperty
InputPropTopbuttonpad
  toEnum 5 = DeviceProperty
InputPropPointingStick
  toEnum 6 = DeviceProperty
InputPropAccelerometer
  toEnum unmatched :: Int
unmatched = String -> DeviceProperty
forall a. HasCallStack => String -> a
error ("DeviceProperty.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
unmatched)

{-# LINE 13 "src/Evdev/Codes.chs" #-}


data EventType = EvSyn
               | EvKey
               | EvRel
               | EvAbs
               | EvMsc
               | EvSw
               | EvLed
               | EvSnd
               | EvRep
               | EvFf
               | EvPwr
               | EvFfStatus
  deriving (Bounded,Eq,Ord,Read,Show)
instance Enum EventType where
  succ EvSyn = EvKey
  succ EvKey = EvRel
  succ EvRel = EvAbs
  succ EvAbs = EvMsc
  succ EvMsc = EvSw
  succ EvSw = EvLed
  succ EvLed = EvSnd
  succ EvSnd = EvRep
  succ EvRep = EvFf
  succ EvFf = EvPwr
  succ EvPwr = EvFfStatus
  succ EvFfStatus = error "EventType.succ: EvFfStatus has no successor"

  pred EvKey = EvSyn
  pred EvRel = EvKey
  pred EvAbs = EvRel
  pred EvMsc = EvAbs
  pred EvSw = EvMsc
  pred EvLed = EvSw
  pred EvSnd = EvLed
  pred EvRep = EvSnd
  pred EvFf = EvRep
  pred EvPwr = EvFf
  pred EvFfStatus = EvPwr
  pred EvSyn = error "EventType.pred: EvSyn has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from EvFfStatus

  fromEnum EvSyn = 0
  fromEnum EvKey = 1
  fromEnum EvRel = 2
  fromEnum EvAbs = 3
  fromEnum EvMsc = 4
  fromEnum EvSw = 5
  fromEnum EvLed = 17
  fromEnum EvSnd = 18
  fromEnum EvRep = 20
  fromEnum EvFf = 21
  fromEnum EvPwr = 22
  fromEnum EvFfStatus = 23

  toEnum :: Int -> EventType
toEnum 0 = EventType
EvSyn
  toEnum 1 = EventType
EvKey
  toEnum 2 = EventType
EvRel
  toEnum 3 = EventType
EvAbs
  toEnum 4 = EventType
EvMsc
  toEnum 5 = EventType
EvSw
  toEnum 17 = EventType
EvLed
  toEnum 18 = EventType
EvSnd
  toEnum 20 = EventType
EvRep
  toEnum 21 = EventType
EvFf
  toEnum 22 = EventType
EvPwr
  toEnum 23 = EventType
EvFfStatus
  toEnum unmatched :: Int
unmatched = String -> EventType
forall a. HasCallStack => String -> a
error ("EventType.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
unmatched)

{-# LINE 28 "src/Evdev/Codes.chs" #-}


data SyncEventType = SynReport
                   | SynConfig
                   | SynMtReport
                   | SynDropped
  deriving (Bounded,Eq,Ord,Read,Show)
instance Enum SyncEventType where
  succ SynReport = SynConfig
  succ SynConfig = SynMtReport
  succ SynMtReport = SynDropped
  succ SynDropped = error "SyncEventType.succ: SynDropped has no successor"

  pred SynConfig = SynReport
  pred SynMtReport = SynConfig
  pred SynDropped = SynMtReport
  pred SynReport = error "SyncEventType.pred: SynReport has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from SynDropped

  fromEnum SynReport = 0
  fromEnum SynConfig = 1
  fromEnum SynMtReport = 2
  fromEnum SynDropped = 3

  toEnum 0 = SynReport
  toEnum 1 = SynConfig
  toEnum 2 = SynMtReport
  toEnum 3 = SynDropped
  toEnum unmatched = error ("SyncEventType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 35 "src/Evdev/Codes.chs" #-}


data Key = KeyReserved
         | KeyEsc
         | Key1
         | Key2
         | Key3
         | Key4
         | Key5
         | Key6
         | Key7
         | Key8
         | Key9
         | Key0
         | KeyMinus
         | KeyEqual
         | KeyBackspace
         | KeyTab
         | KeyQ
         | KeyW
         | KeyE
         | KeyR
         | KeyT
         | KeyY
         | KeyU
         | KeyI
         | KeyO
         | KeyP
         | KeyLeftbrace
         | KeyRightbrace
         | KeyEnter
         | KeyLeftctrl
         | KeyA
         | KeyS
         | KeyD
         | KeyF
         | KeyG
         | KeyH
         | KeyJ
         | KeyK
         | KeyL
         | KeySemicolon
         | KeyApostrophe
         | KeyGrave
         | KeyLeftshift
         | KeyBackslash
         | KeyZ
         | KeyX
         | KeyC
         | KeyV
         | KeyB
         | KeyN
         | KeyM
         | KeyComma
         | KeyDot
         | KeySlash
         | KeyRightshift
         | KeyKpasterisk
         | KeyLeftalt
         | KeySpace
         | KeyCapslock
         | KeyF1
         | KeyF2
         | KeyF3
         | KeyF4
         | KeyF5
         | KeyF6
         | KeyF7
         | KeyF8
         | KeyF9
         | KeyF10
         | KeyNumlock
         | KeyScrolllock
         | KeyKp7
         | KeyKp8
         | KeyKp9
         | KeyKpminus
         | KeyKp4
         | KeyKp5
         | KeyKp6
         | KeyKpplus
         | KeyKp1
         | KeyKp2
         | KeyKp3
         | KeyKp0
         | KeyKpdot
         | KeyZenkakuhankaku
         | Key102nd
         | KeyF11
         | KeyF12
         | KeyRo
         | KeyKatakana
         | KeyHiragana
         | KeyHenkan
         | KeyKatakanahiragana
         | KeyMuhenkan
         | KeyKpjpcomma
         | KeyKpenter
         | KeyRightctrl
         | KeyKpslash
         | KeySysrq
         | KeyRightalt
         | KeyLinefeed
         | KeyHome
         | KeyUp
         | KeyPageup
         | KeyLeft
         | KeyRight
         | KeyEnd
         | KeyDown
         | KeyPagedown
         | KeyInsert
         | KeyDelete
         | KeyMacro
         | KeyMute
         | KeyVolumedown
         | KeyVolumeup
         | KeyPower
         | KeyKpequal
         | KeyKpplusminus
         | KeyPause
         | KeyScale
         | KeyKpcomma
         | KeyHangeul
         | KeyHanguel
         | KeyHanja
         | KeyYen
         | KeyLeftmeta
         | KeyRightmeta
         | KeyCompose
         | KeyStop
         | KeyAgain
         | KeyProps
         | KeyUndo
         | KeyFront
         | KeyCopy
         | KeyOpen
         | KeyPaste
         | KeyFind
         | KeyCut
         | KeyHelp
         | KeyMenu
         | KeyCalc
         | KeySetup
         | KeySleep
         | KeyWakeup
         | KeyFile
         | KeySendfile
         | KeyDeletefile
         | KeyXfer
         | KeyProg1
         | KeyProg2
         | KeyWww
         | KeyMsdos
         | KeyCoffee
         | KeyScreenlock
         | KeyRotateDisplay
         | KeyDirection
         | KeyCyclewindows
         | KeyMail
         | KeyBookmarks
         | KeyComputer
         | KeyBack
         | KeyForward
         | KeyClosecd
         | KeyEjectcd
         | KeyEjectclosecd
         | KeyNextsong
         | KeyPlaypause
         | KeyPrevioussong
         | KeyStopcd
         | KeyRecord
         | KeyRewind
         | KeyPhone
         | KeyIso
         | KeyConfig
         | KeyHomepage
         | KeyRefresh
         | KeyExit
         | KeyMove
         | KeyEdit
         | KeyScrollup
         | KeyScrolldown
         | KeyKpleftparen
         | KeyKprightparen
         | KeyNew
         | KeyRedo
         | KeyF13
         | KeyF14
         | KeyF15
         | KeyF16
         | KeyF17
         | KeyF18
         | KeyF19
         | KeyF20
         | KeyF21
         | KeyF22
         | KeyF23
         | KeyF24
         | KeyPlaycd
         | KeyPausecd
         | KeyProg3
         | KeyProg4
         | KeyDashboard
         | KeySuspend
         | KeyClose
         | KeyPlay
         | KeyFastforward
         | KeyBassboost
         | KeyPrint
         | KeyHp
         | KeyCamera
         | KeySound
         | KeyQuestion
         | KeyEmail
         | KeyChat
         | KeySearch
         | KeyConnect
         | KeyFinance
         | KeySport
         | KeyShop
         | KeyAlterase
         | KeyCancel
         | KeyBrightnessdown
         | KeyBrightnessup
         | KeyMedia
         | KeySwitchvideomode
         | KeyKbdillumtoggle
         | KeyKbdillumdown
         | KeyKbdillumup
         | KeySend
         | KeyReply
         | KeyForwardmail
         | KeySave
         | KeyDocuments
         | KeyBattery
         | KeyBluetooth
         | KeyWlan
         | KeyUwb
         | KeyUnknown
         | KeyVideoNext
         | KeyVideoPrev
         | KeyBrightnessCycle
         | KeyBrightnessAuto
         | KeyBrightnessZero
         | KeyDisplayOff
         | KeyWwan
         | KeyWimax
         | KeyRfkill
         | KeyMicmute
         | BtnMisc
         | Btn0
         | Btn1
         | Btn2
         | Btn3
         | Btn4
         | Btn5
         | Btn6
         | Btn7
         | Btn8
         | Btn9
         | BtnMouse
         | BtnLeft
         | BtnRight
         | BtnMiddle
         | BtnSide
         | BtnExtra
         | BtnForward
         | BtnBack
         | BtnTask
         | BtnJoystick
         | BtnTrigger
         | BtnThumb
         | BtnThumb2
         | BtnTop
         | BtnTop2
         | BtnPinkie
         | BtnBase
         | BtnBase2
         | BtnBase3
         | BtnBase4
         | BtnBase5
         | BtnBase6
         | BtnDead
         | BtnGamepad
         | BtnSouth
         | BtnA
         | BtnEast
         | BtnB
         | BtnC
         | BtnNorth
         | BtnX
         | BtnWest
         | BtnY
         | BtnZ
         | BtnTl
         | BtnTr
         | BtnTl2
         | BtnTr2
         | BtnSelect
         | BtnStart
         | BtnMode
         | BtnThumbl
         | BtnThumbr
         | BtnDigi
         | BtnToolPen
         | BtnToolRubber
         | BtnToolBrush
         | BtnToolPencil
         | BtnToolAirbrush
         | BtnToolFinger
         | BtnToolMouse
         | BtnToolLens
         | BtnToolQuinttap
         | BtnTouch
         | BtnStylus
         | BtnStylus2
         | BtnToolDoubletap
         | BtnToolTripletap
         | BtnToolQuadtap
         | BtnWheel
         | BtnGearDown
         | BtnGearUp
         | KeyOk
         | KeySelect
         | KeyGoto
         | KeyClear
         | KeyPower2
         | KeyOption
         | KeyInfo
         | KeyTime
         | KeyVendor
         | KeyArchive
         | KeyProgram
         | KeyChannel
         | KeyFavorites
         | KeyEpg
         | KeyPvr
         | KeyMhp
         | KeyLanguage
         | KeyTitle
         | KeySubtitle
         | KeyAngle
         | KeyZoom
         | KeyMode
         | KeyKeyboard
         | KeyScreen
         | KeyPc
         | KeyTv
         | KeyTv2
         | KeyVcr
         | KeyVcr2
         | KeySat
         | KeySat2
         | KeyCd
         | KeyTape
         | KeyRadio
         | KeyTuner
         | KeyPlayer
         | KeyText
         | KeyDvd
         | KeyAux
         | KeyMp3
         | KeyAudio
         | KeyVideo
         | KeyDirectory
         | KeyList
         | KeyMemo
         | KeyCalendar
         | KeyRed
         | KeyGreen
         | KeyYellow
         | KeyBlue
         | KeyChannelup
         | KeyChanneldown
         | KeyFirst
         | KeyLast
         | KeyAb
         | KeyNext
         | KeyRestart
         | KeySlow
         | KeyShuffle
         | KeyBreak
         | KeyPrevious
         | KeyDigits
         | KeyTeen
         | KeyTwen
         | KeyVideophone
         | KeyGames
         | KeyZoomin
         | KeyZoomout
         | KeyZoomreset
         | KeyWordprocessor
         | KeyEditor
         | KeySpreadsheet
         | KeyGraphicseditor
         | KeyPresentation
         | KeyDatabase
         | KeyNews
         | KeyVoicemail
         | KeyAddressbook
         | KeyMessenger
         | KeyDisplaytoggle
         | KeyBrightnessToggle
         | KeySpellcheck
         | KeyLogoff
         | KeyDollar
         | KeyEuro
         | KeyFrameback
         | KeyFrameforward
         | KeyContextMenu
         | KeyMediaRepeat
         | Key10channelsup
         | Key10channelsdown
         | KeyImages
         | KeyDelEol
         | KeyDelEos
         | KeyInsLine
         | KeyDelLine
         | KeyFn
         | KeyFnEsc
         | KeyFnF1
         | KeyFnF2
         | KeyFnF3
         | KeyFnF4
         | KeyFnF5
         | KeyFnF6
         | KeyFnF7
         | KeyFnF8
         | KeyFnF9
         | KeyFnF10
         | KeyFnF11
         | KeyFnF12
         | KeyFn1
         | KeyFn2
         | KeyFnD
         | KeyFnE
         | KeyFnF
         | KeyFnS
         | KeyFnB
         | KeyBrlDot1
         | KeyBrlDot2
         | KeyBrlDot3
         | KeyBrlDot4
         | KeyBrlDot5
         | KeyBrlDot6
         | KeyBrlDot7
         | KeyBrlDot8
         | KeyBrlDot9
         | KeyBrlDot10
         | KeyNumeric0
         | KeyNumeric1
         | KeyNumeric2
         | KeyNumeric3
         | KeyNumeric4
         | KeyNumeric5
         | KeyNumeric6
         | KeyNumeric7
         | KeyNumeric8
         | KeyNumeric9
         | KeyNumericStar
         | KeyNumericPound
         | KeyNumericA
         | KeyNumericB
         | KeyNumericC
         | KeyNumericD
         | KeyCameraFocus
         | KeyWpsButton
         | KeyTouchpadToggle
         | KeyTouchpadOn
         | KeyTouchpadOff
         | KeyCameraZoomin
         | KeyCameraZoomout
         | KeyCameraUp
         | KeyCameraDown
         | KeyCameraLeft
         | KeyCameraRight
         | KeyAttendantOn
         | KeyAttendantOff
         | KeyAttendantToggle
         | KeyLightsToggle
         | BtnDpadUp
         | BtnDpadDown
         | BtnDpadLeft
         | BtnDpadRight
         | KeyAlsToggle
         | KeyButtonconfig
         | KeyTaskmanager
         | KeyJournal
         | KeyControlpanel
         | KeyAppselect
         | KeyScreensaver
         | KeyVoicecommand
         | KeyBrightnessMin
         | KeyBrightnessMax
         | KeyKbdinputassistPrev
         | KeyKbdinputassistNext
         | KeyKbdinputassistPrevgroup
         | KeyKbdinputassistNextgroup
         | KeyKbdinputassistAccept
         | KeyKbdinputassistCancel
         | BtnTriggerHappy
         | BtnTriggerHappy1
         | BtnTriggerHappy2
         | BtnTriggerHappy3
         | BtnTriggerHappy4
         | BtnTriggerHappy5
         | BtnTriggerHappy6
         | BtnTriggerHappy7
         | BtnTriggerHappy8
         | BtnTriggerHappy9
         | BtnTriggerHappy10
         | BtnTriggerHappy11
         | BtnTriggerHappy12
         | BtnTriggerHappy13
         | BtnTriggerHappy14
         | BtnTriggerHappy15
         | BtnTriggerHappy16
         | BtnTriggerHappy17
         | BtnTriggerHappy18
         | BtnTriggerHappy19
         | BtnTriggerHappy20
         | BtnTriggerHappy21
         | BtnTriggerHappy22
         | BtnTriggerHappy23
         | BtnTriggerHappy24
         | BtnTriggerHappy25
         | BtnTriggerHappy26
         | BtnTriggerHappy27
         | BtnTriggerHappy28
         | BtnTriggerHappy29
         | BtnTriggerHappy30
         | BtnTriggerHappy31
         | BtnTriggerHappy32
         | BtnTriggerHappy33
         | BtnTriggerHappy34
         | BtnTriggerHappy35
         | BtnTriggerHappy36
         | BtnTriggerHappy37
         | BtnTriggerHappy38
         | BtnTriggerHappy39
         | BtnTriggerHappy40
  deriving (Key
Key -> Key -> Bounded Key
forall a. a -> a -> Bounded a
maxBound :: Key
$cmaxBound :: Key
minBound :: Key
$cminBound :: Key
Bounded,Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq,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
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$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
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [Key]
$creadListPrec :: ReadPrec [Key]
readPrec :: ReadPrec Key
$creadPrec :: ReadPrec Key
readList :: ReadS [Key]
$creadList :: ReadS [Key]
readsPrec :: Int -> ReadS Key
$creadsPrec :: Int -> ReadS 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
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show)
instance Enum Key where
  succ :: Key -> Key
succ KeyReserved = Key
KeyEsc
  succ KeyEsc = Key1
  succ Key1 = Key2
  succ Key2 = Key3
  succ Key3 = Key4
  succ Key4 = Key5
  succ Key5 = Key6
  succ Key6 = Key7
  succ Key7 = Key8
  succ Key8 = Key9
  succ Key9 = Key0
  succ Key0 = KeyMinus
  succ KeyMinus = KeyEqual
  succ KeyEqual = KeyBackspace
  succ KeyBackspace = KeyTab
  succ KeyTab = KeyQ
  succ KeyQ = KeyW
  succ KeyW = KeyE
  succ KeyE = KeyR
  succ KeyR = KeyT
  succ KeyT = KeyY
  succ KeyY = KeyU
  succ KeyU = KeyI
  succ KeyI = KeyO
  succ KeyO = KeyP
  succ KeyP = KeyLeftbrace
  succ KeyLeftbrace = KeyRightbrace
  succ KeyRightbrace = KeyEnter
  succ KeyEnter = KeyLeftctrl
  succ KeyLeftctrl = KeyA
  succ KeyA = KeyS
  succ KeyS = KeyD
  succ KeyD = KeyF
  succ KeyF = KeyG
  succ KeyG = KeyH
  succ KeyH = KeyJ
  succ KeyJ = KeyK
  succ KeyK = KeyL
  succ KeyL = KeySemicolon
  succ KeySemicolon = KeyApostrophe
  succ KeyApostrophe = KeyGrave
  succ KeyGrave = KeyLeftshift
  succ KeyLeftshift = KeyBackslash
  succ KeyBackslash = KeyZ
  succ KeyZ = KeyX
  succ KeyX = KeyC
  succ KeyC = KeyV
  succ KeyV = KeyB
  succ KeyB = KeyN
  succ KeyN = KeyM
  succ KeyM = KeyComma
  succ KeyComma = KeyDot
  succ KeyDot = KeySlash
  succ KeySlash = KeyRightshift
  succ KeyRightshift = KeyKpasterisk
  succ KeyKpasterisk = KeyLeftalt
  succ KeyLeftalt = KeySpace
  succ KeySpace = KeyCapslock
  succ KeyCapslock = KeyF1
  succ KeyF1 = KeyF2
  succ KeyF2 = KeyF3
  succ KeyF3 = KeyF4
  succ KeyF4 = KeyF5
  succ KeyF5 = KeyF6
  succ KeyF6 = KeyF7
  succ KeyF7 = KeyF8
  succ KeyF8 = KeyF9
  succ KeyF9 = Key
KeyF10
  succ KeyF10 = Key
KeyNumlock
  succ KeyNumlock = Key
KeyScrolllock
  succ KeyScrolllock = Key
KeyKp7
  succ KeyKp7 = Key
KeyKp8
  succ KeyKp8 = Key
KeyKp9
  succ KeyKp9 = Key
KeyKpminus
  succ KeyKpminus = Key
KeyKp4
  succ KeyKp4 = KeyKp5
  succ KeyKp5 = KeyKp6
  succ KeyKp6 = KeyKpplus
  succ KeyKpplus = KeyKp1
  succ KeyKp1 = KeyKp2
  succ KeyKp2 = KeyKp3
  succ KeyKp3 = KeyKp0
  succ KeyKp0 = KeyKpdot
  succ KeyKpdot = KeyZenkakuhankaku
  succ KeyZenkakuhankaku = Key102nd
  succ Key102nd = KeyF11
  succ KeyF11 = KeyF12
  succ KeyF12 = KeyRo
  succ KeyRo = KeyKatakana
  succ KeyKatakana = KeyHiragana
  succ KeyHiragana = KeyHenkan
  succ KeyHenkan = KeyKatakanahiragana
  succ KeyKatakanahiragana = KeyMuhenkan
  succ KeyMuhenkan = KeyKpjpcomma
  succ KeyKpjpcomma = KeyKpenter
  succ KeyKpenter = KeyRightctrl
  succ KeyRightctrl = KeyKpslash
  succ KeyKpslash = KeySysrq
  succ KeySysrq = KeyRightalt
  succ KeyRightalt = KeyLinefeed
  succ KeyLinefeed = KeyHome
  succ KeyHome = KeyUp
  succ KeyUp = KeyPageup
  succ KeyPageup = KeyLeft
  succ KeyLeft = KeyRight
  succ KeyRight = KeyEnd
  succ KeyEnd = KeyDown
  succ KeyDown = KeyPagedown
  succ KeyPagedown = KeyInsert
  succ KeyInsert = KeyDelete
  succ KeyDelete = KeyMacro
  succ KeyMacro = KeyMute
  succ KeyMute = KeyVolumedown
  succ KeyVolumedown = KeyVolumeup
  succ KeyVolumeup = KeyPower
  succ KeyPower = KeyKpequal
  succ KeyKpequal = KeyKpplusminus
  succ KeyKpplusminus = KeyPause
  succ KeyPause = KeyScale
  succ KeyScale = KeyKpcomma
  succ KeyKpcomma = KeyHangeul
  succ KeyHangeul = KeyHanja
  succ KeyHanguel = KeyHanja
  succ KeyHanja = KeyYen
  succ KeyYen = KeyLeftmeta
  succ KeyLeftmeta = KeyRightmeta
  succ KeyRightmeta = KeyCompose
  succ KeyCompose = KeyStop
  succ KeyStop = KeyAgain
  succ KeyAgain = KeyProps
  succ KeyProps = KeyUndo
  succ KeyUndo = KeyFront
  succ KeyFront = KeyCopy
  succ KeyCopy = KeyOpen
  succ KeyOpen = KeyPaste
  succ KeyPaste = KeyFind
  succ KeyFind = KeyCut
  succ KeyCut = KeyHelp
  succ KeyHelp = KeyMenu
  succ KeyMenu = KeyCalc
  succ KeyCalc = KeySetup
  succ KeySetup = KeySleep
  succ KeySleep = KeyWakeup
  succ KeyWakeup = KeyFile
  succ KeyFile = KeySendfile
  succ KeySendfile = KeyDeletefile
  succ KeyDeletefile = KeyXfer
  succ KeyXfer = KeyProg1
  succ KeyProg1 = KeyProg2
  succ KeyProg2 = KeyWww
  succ KeyWww = KeyMsdos
  succ KeyMsdos = KeyCoffee
  succ KeyCoffee = KeyRotateDisplay
  succ KeyScreenlock = KeyRotateDisplay
  succ KeyRotateDisplay = Key
KeyCyclewindows
  succ KeyDirection = Key
KeyCyclewindows
  succ KeyCyclewindows = Key
KeyMail
  succ KeyMail = KeyBookmarks
  succ KeyBookmarks = Key
KeyComputer
  succ KeyComputer = KeyBack
  succ KeyBack = KeyForward
  succ KeyForward = KeyClosecd
  succ KeyClosecd = KeyEjectcd
  succ KeyEjectcd = KeyEjectclosecd
  succ KeyEjectclosecd = KeyNextsong
  succ KeyNextsong = KeyPlaypause
  succ KeyPlaypause = KeyPrevioussong
  succ KeyPrevioussong = KeyStopcd
  succ KeyStopcd = KeyRecord
  succ KeyRecord = KeyRewind
  succ KeyRewind = KeyPhone
  succ KeyPhone = KeyIso
  succ KeyIso = KeyConfig
  succ KeyConfig = KeyHomepage
  succ KeyHomepage = KeyRefresh
  succ KeyRefresh = KeyExit
  succ KeyExit = KeyMove
  succ KeyMove = Key
KeyEdit
  succ KeyEdit = KeyScrollup
  succ KeyScrollup = KeyScrolldown
  succ KeyScrolldown = KeyKpleftparen
  succ KeyKpleftparen = KeyKprightparen
  succ KeyKprightparen = KeyNew
  succ KeyNew = Key
KeyRedo
  succ KeyRedo = Key
KeyF13
  succ KeyF13 = Key
KeyF14
  succ KeyF14 = Key
KeyF15
  succ KeyF15 = Key
KeyF16
  succ KeyF16 = Key
KeyF17
  succ KeyF17 = Key
KeyF18
  succ KeyF18 = Key
KeyF19
  succ KeyF19 = Key
KeyF20
  succ KeyF20 = Key
KeyF21
  succ KeyF21 = Key
KeyF22
  succ KeyF22 = Key
KeyF23
  succ KeyF23 = Key
KeyF24
  succ KeyF24 = Key
KeyPlaycd
  succ KeyPlaycd = Key
KeyPausecd
  succ KeyPausecd = Key
KeyProg3
  succ KeyProg3 = Key
KeyProg4
  succ KeyProg4 = Key
KeyDashboard
  succ KeyDashboard = Key
KeySuspend
  succ KeySuspend = Key
KeyClose
  succ KeyClose = Key
KeyPlay
  succ KeyPlay = Key
KeyFastforward
  succ KeyFastforward = Key
KeyBassboost
  succ KeyBassboost = Key
KeyPrint
  succ KeyPrint = Key
KeyHp
  succ KeyHp = Key
KeyCamera
  succ KeyCamera = Key
KeySound
  succ KeySound = Key
KeyQuestion
  succ KeyQuestion = Key
KeyEmail
  succ KeyEmail = Key
KeyChat
  succ KeyChat = Key
KeySearch
  succ KeySearch = Key
KeyConnect
  succ KeyConnect = Key
KeyFinance
  succ KeyFinance = Key
KeySport
  succ KeySport = KeyShop
  succ KeyShop = Key
KeyAlterase
  succ KeyAlterase = Key
KeyCancel
  succ KeyCancel = Key
KeyBrightnessdown
  succ KeyBrightnessdown = Key
KeyBrightnessup
  succ KeyBrightnessup = Key
KeyMedia
  succ KeyMedia = Key
KeySwitchvideomode
  succ KeySwitchvideomode = Key
KeyKbdillumtoggle
  succ KeyKbdillumtoggle = Key
KeyKbdillumdown
  succ KeyKbdillumdown = Key
KeyKbdillumup
  succ KeyKbdillumup = Key
KeySend
  succ KeySend = Key
KeyReply
  succ KeyReply = Key
KeyForwardmail
  succ KeyForwardmail = Key
KeySave
  succ KeySave = Key
KeyDocuments
  succ KeyDocuments = Key
KeyBattery
  succ KeyBattery = Key
KeyBluetooth
  succ KeyBluetooth = KeyWlan
  succ KeyWlan = Key
KeyUwb
  succ KeyUwb = Key
KeyUnknown
  succ KeyUnknown = Key
KeyVideoNext
  succ KeyVideoNext = Key
KeyVideoPrev
  succ KeyVideoPrev = Key
KeyBrightnessCycle
  succ KeyBrightnessCycle = Key
KeyBrightnessAuto
  succ KeyBrightnessAuto = Key
KeyDisplayOff
  succ KeyBrightnessZero = Key
KeyDisplayOff
  succ KeyDisplayOff = Key
KeyWwan
  succ KeyWwan = Key
KeyRfkill
  succ KeyWimax = Key
KeyRfkill
  succ KeyRfkill = Key
KeyMicmute
  succ KeyMicmute = Key
BtnMisc
  succ BtnMisc = Key
Btn1
  succ Btn0 = Key
Btn1
  succ Btn1 = Key
Btn2
  succ Btn2 = Key
Btn3
  succ Btn3 = Key
Btn4
  succ Btn4 = Key
Btn5
  succ Btn5 = Key
Btn6
  succ Btn6 = Key
Btn7
  succ Btn7 = Key
Btn8
  succ Btn8 = Key
Btn9
  succ Btn9 = Key
BtnMouse
  succ BtnMouse = Key
BtnRight
  succ BtnLeft = Key
BtnRight
  succ BtnRight = Key
BtnMiddle
  succ BtnMiddle = Key
BtnSide
  succ BtnSide = Key
BtnExtra
  succ BtnExtra = Key
BtnForward
  succ BtnForward = Key
BtnBack
  succ BtnBack = Key
BtnTask
  succ BtnTask = Key
BtnJoystick
  succ BtnJoystick = Key
BtnThumb
  succ BtnTrigger = Key
BtnThumb
  succ BtnThumb = Key
BtnThumb2
  succ BtnThumb2 = Key
BtnTop
  succ BtnTop = Key
BtnTop2
  succ BtnTop2 = Key
BtnPinkie
  succ BtnPinkie = Key
BtnBase
  succ BtnBase = Key
BtnBase2
  succ BtnBase2 = Key
BtnBase3
  succ BtnBase3 = Key
BtnBase4
  succ BtnBase4 = Key
BtnBase5
  succ BtnBase5 = Key
BtnBase6
  succ BtnBase6 = Key
BtnDead
  succ BtnDead = Key
BtnGamepad
  succ BtnGamepad = Key
BtnEast
  succ BtnSouth = Key
BtnEast
  succ BtnA = Key
BtnEast
  succ BtnEast = Key
BtnC
  succ BtnB = Key
BtnC
  succ BtnC = Key
BtnNorth
  succ BtnNorth = Key
BtnWest
  succ BtnX = Key
BtnWest
  succ BtnWest = Key
BtnZ
  succ BtnY = Key
BtnZ
  succ BtnZ = Key
BtnTl
  succ BtnTl = Key
BtnTr
  succ BtnTr = Key
BtnTl2
  succ BtnTl2 = Key
BtnTr2
  succ BtnTr2 = Key
BtnSelect
  succ BtnSelect = Key
BtnStart
  succ BtnStart = Key
BtnMode
  succ BtnMode = Key
BtnThumbl
  succ BtnThumbl = Key
BtnThumbr
  succ BtnThumbr = Key
BtnDigi
  succ BtnDigi = Key
BtnToolRubber
  succ BtnToolPen = Key
BtnToolRubber
  succ BtnToolRubber = Key
BtnToolBrush
  succ BtnToolBrush = Key
BtnToolPencil
  succ BtnToolPencil = Key
BtnToolAirbrush
  succ BtnToolAirbrush = Key
BtnToolFinger
  succ BtnToolFinger = Key
BtnToolMouse
  succ BtnToolMouse = Key
BtnToolLens
  succ BtnToolLens = Key
BtnToolQuinttap
  succ BtnToolQuinttap = Key
BtnTouch
  succ BtnTouch = Key
BtnStylus
  succ BtnStylus = Key
BtnStylus2
  succ BtnStylus2 = Key
BtnToolDoubletap
  succ BtnToolDoubletap = Key
BtnToolTripletap
  succ BtnToolTripletap = Key
BtnToolQuadtap
  succ BtnToolQuadtap = Key
BtnWheel
  succ BtnWheel = Key
BtnGearUp
  succ BtnGearDown = Key
BtnGearUp
  succ BtnGearUp = Key
KeyOk
  succ KeyOk = Key
KeySelect
  succ KeySelect = Key
KeyGoto
  succ KeyGoto = Key
KeyClear
  succ KeyClear = Key
KeyPower2
  succ KeyPower2 = Key
KeyOption
  succ KeyOption = Key
KeyInfo
  succ KeyInfo = Key
KeyTime
  succ KeyTime = Key
KeyVendor
  succ KeyVendor = Key
KeyArchive
  succ KeyArchive = Key
KeyProgram
  succ KeyProgram = Key
KeyChannel
  succ KeyChannel = Key
KeyFavorites
  succ KeyFavorites = Key
KeyEpg
  succ KeyEpg = Key
KeyPvr
  succ KeyPvr = Key
KeyMhp
  succ KeyMhp = Key
KeyLanguage
  succ KeyLanguage = Key
KeyTitle
  succ KeyTitle = Key
KeySubtitle
  succ KeySubtitle = Key
KeyAngle
  succ KeyAngle = Key
KeyZoom
  succ KeyZoom = Key
KeyMode
  succ KeyMode = Key
KeyKeyboard
  succ KeyKeyboard = Key
KeyScreen
  succ KeyScreen = Key
KeyPc
  succ KeyPc = Key
KeyTv
  succ KeyTv = Key
KeyTv2
  succ KeyTv2 = Key
KeyVcr
  succ KeyVcr = Key
KeyVcr2
  succ KeyVcr2 = Key
KeySat
  succ KeySat = Key
KeySat2
  succ KeySat2 = Key
KeyCd
  succ KeyCd = Key
KeyTape
  succ KeyTape = Key
KeyRadio
  succ KeyRadio = Key
KeyTuner
  succ KeyTuner = Key
KeyPlayer
  succ KeyPlayer = Key
KeyText
  succ KeyText = Key
KeyDvd
  succ KeyDvd = Key
KeyAux
  succ KeyAux = Key
KeyMp3
  succ KeyMp3 = Key
KeyAudio
  succ KeyAudio = Key
KeyVideo
  succ KeyVideo = Key
KeyDirectory
  succ KeyDirectory = Key
KeyList
  succ KeyList = Key
KeyMemo
  succ KeyMemo = Key
KeyCalendar
  succ KeyCalendar = Key
KeyRed
  succ KeyRed = Key
KeyGreen
  succ KeyGreen = Key
KeyYellow
  succ KeyYellow = Key
KeyBlue
  succ KeyBlue = Key
KeyChannelup
  succ KeyChannelup = Key
KeyChanneldown
  succ KeyChanneldown = Key
KeyFirst
  succ KeyFirst = Key
KeyLast
  succ KeyLast = Key
KeyAb
  succ KeyAb = Key
KeyNext
  succ KeyNext = Key
KeyRestart
  succ KeyRestart = Key
KeySlow
  succ KeySlow = Key
KeyShuffle
  succ KeyShuffle = Key
KeyBreak
  succ KeyBreak = Key
KeyPrevious
  succ KeyPrevious = Key
KeyDigits
  succ KeyDigits = Key
KeyTeen
  succ KeyTeen = Key
KeyTwen
  succ KeyTwen = Key
KeyVideophone
  succ KeyVideophone = Key
KeyGames
  succ KeyGames = Key
KeyZoomin
  succ KeyZoomin = Key
KeyZoomout
  succ KeyZoomout = Key
KeyZoomreset
  succ KeyZoomreset = Key
KeyWordprocessor
  succ KeyWordprocessor = Key
KeyEditor
  succ KeyEditor = Key
KeySpreadsheet
  succ KeySpreadsheet = Key
KeyGraphicseditor
  succ KeyGraphicseditor = Key
KeyPresentation
  succ KeyPresentation = Key
KeyDatabase
  succ KeyDatabase = Key
KeyNews
  succ KeyNews = Key
KeyVoicemail
  succ KeyVoicemail = Key
KeyAddressbook
  succ KeyAddressbook = Key
KeyMessenger
  succ KeyMessenger = Key
KeyDisplaytoggle
  succ KeyDisplaytoggle = Key
KeySpellcheck
  succ KeyBrightnessToggle = Key
KeySpellcheck
  succ KeySpellcheck = Key
KeyLogoff
  succ KeyLogoff = Key
KeyDollar
  succ KeyDollar = Key
KeyEuro
  succ KeyEuro = Key
KeyFrameback
  succ KeyFrameback = Key
KeyFrameforward
  succ KeyFrameforward = Key
KeyContextMenu
  succ KeyContextMenu = Key
KeyMediaRepeat
  succ KeyMediaRepeat = Key
Key10channelsup
  succ Key10channelsup = Key
Key10channelsdown
  succ Key10channelsdown = Key
KeyImages
  succ KeyImages = Key
KeyDelEol
  succ KeyDelEol = Key
KeyDelEos
  succ KeyDelEos = Key
KeyInsLine
  succ KeyInsLine = Key
KeyDelLine
  succ KeyDelLine = Key
KeyFn
  succ KeyFn = Key
KeyFnEsc
  succ KeyFnEsc = Key
KeyFnF1
  succ KeyFnF1 = Key
KeyFnF2
  succ KeyFnF2 = Key
KeyFnF3
  succ KeyFnF3 = Key
KeyFnF4
  succ KeyFnF4 = Key
KeyFnF5
  succ KeyFnF5 = Key
KeyFnF6
  succ KeyFnF6 = Key
KeyFnF7
  succ KeyFnF7 = Key
KeyFnF8
  succ KeyFnF8 = Key
KeyFnF9
  succ KeyFnF9 = Key
KeyFnF10
  succ KeyFnF10 = Key
KeyFnF11
  succ KeyFnF11 = Key
KeyFnF12
  succ KeyFnF12 = Key
KeyFn1
  succ KeyFn1 = Key
KeyFn2
  succ KeyFn2 = Key
KeyFnD
  succ KeyFnD = Key
KeyFnE
  succ KeyFnE = Key
KeyFnF
  succ KeyFnF = Key
KeyFnS
  succ KeyFnS = Key
KeyFnB
  succ KeyFnB = Key
KeyBrlDot1
  succ KeyBrlDot1 = Key
KeyBrlDot2
  succ KeyBrlDot2 = Key
KeyBrlDot3
  succ KeyBrlDot3 = Key
KeyBrlDot4
  succ KeyBrlDot4 = Key
KeyBrlDot5
  succ KeyBrlDot5 = Key
KeyBrlDot6
  succ KeyBrlDot6 = Key
KeyBrlDot7
  succ KeyBrlDot7 = Key
KeyBrlDot8
  succ KeyBrlDot8 = Key
KeyBrlDot9
  succ KeyBrlDot9 = Key
KeyBrlDot10
  succ KeyBrlDot10 = Key
KeyNumeric0
  succ KeyNumeric0 = Key
KeyNumeric1
  succ KeyNumeric1 = Key
KeyNumeric2
  succ KeyNumeric2 = Key
KeyNumeric3
  succ KeyNumeric3 = Key
KeyNumeric4
  succ KeyNumeric4 = Key
KeyNumeric5
  succ KeyNumeric5 = Key
KeyNumeric6
  succ KeyNumeric6 = Key
KeyNumeric7
  succ KeyNumeric7 = Key
KeyNumeric8
  succ KeyNumeric8 = Key
KeyNumeric9
  succ KeyNumeric9 = Key
KeyNumericStar
  succ KeyNumericStar = Key
KeyNumericPound
  succ KeyNumericPound = Key
KeyNumericA
  succ KeyNumericA = Key
KeyNumericB
  succ KeyNumericB = Key
KeyNumericC
  succ KeyNumericC = Key
KeyNumericD
  succ KeyNumericD = Key
KeyCameraFocus
  succ KeyCameraFocus = Key
KeyWpsButton
  succ KeyWpsButton = Key
KeyTouchpadToggle
  succ KeyTouchpadToggle = Key
KeyTouchpadOn
  succ KeyTouchpadOn = Key
KeyTouchpadOff
  succ KeyTouchpadOff = Key
KeyCameraZoomin
  succ KeyCameraZoomin = Key
KeyCameraZoomout
  succ KeyCameraZoomout = Key
KeyCameraUp
  succ KeyCameraUp = Key
KeyCameraDown
  succ KeyCameraDown = Key
KeyCameraLeft
  succ KeyCameraLeft = Key
KeyCameraRight
  succ KeyCameraRight = Key
KeyAttendantOn
  succ KeyAttendantOn = Key
KeyAttendantOff
  succ KeyAttendantOff = Key
KeyAttendantToggle
  succ KeyAttendantToggle = Key
KeyLightsToggle
  succ KeyLightsToggle = Key
BtnDpadUp
  succ BtnDpadUp = Key
BtnDpadDown
  succ BtnDpadDown = Key
BtnDpadLeft
  succ BtnDpadLeft = Key
BtnDpadRight
  succ BtnDpadRight = Key
KeyAlsToggle
  succ KeyAlsToggle = Key
KeyButtonconfig
  succ KeyButtonconfig = Key
KeyTaskmanager
  succ KeyTaskmanager = Key
KeyJournal
  succ KeyJournal = Key
KeyControlpanel
  succ KeyControlpanel = Key
KeyAppselect
  succ KeyAppselect = Key
KeyScreensaver
  succ KeyScreensaver = Key
KeyVoicecommand
  succ KeyVoicecommand = Key
KeyBrightnessMin
  succ KeyBrightnessMin = Key
KeyBrightnessMax
  succ KeyBrightnessMax = Key
KeyKbdinputassistPrev
  succ KeyKbdinputassistPrev = Key
KeyKbdinputassistNext
  succ KeyKbdinputassistNext = Key
KeyKbdinputassistPrevgroup
  succ KeyKbdinputassistPrevgroup = Key
KeyKbdinputassistNextgroup
  succ KeyKbdinputassistNextgroup = Key
KeyKbdinputassistAccept
  succ KeyKbdinputassistAccept = Key
KeyKbdinputassistCancel
  succ KeyKbdinputassistCancel = Key
BtnTriggerHappy
  succ BtnTriggerHappy = Key
BtnTriggerHappy2
  succ BtnTriggerHappy1 = Key
BtnTriggerHappy2
  succ BtnTriggerHappy2 = Key
BtnTriggerHappy3
  succ BtnTriggerHappy3 = Key
BtnTriggerHappy4
  succ BtnTriggerHappy4 = Key
BtnTriggerHappy5
  succ BtnTriggerHappy5 = Key
BtnTriggerHappy6
  succ BtnTriggerHappy6 = Key
BtnTriggerHappy7
  succ BtnTriggerHappy7 = Key
BtnTriggerHappy8
  succ BtnTriggerHappy8 = Key
BtnTriggerHappy9
  succ BtnTriggerHappy9 = Key
BtnTriggerHappy10
  succ BtnTriggerHappy10 = Key
BtnTriggerHappy11
  succ BtnTriggerHappy11 = Key
BtnTriggerHappy12
  succ BtnTriggerHappy12 = Key
BtnTriggerHappy13
  succ BtnTriggerHappy13 = Key
BtnTriggerHappy14
  succ BtnTriggerHappy14 = Key
BtnTriggerHappy15
  succ BtnTriggerHappy15 = Key
BtnTriggerHappy16
  succ BtnTriggerHappy16 = Key
BtnTriggerHappy17
  succ BtnTriggerHappy17 = Key
BtnTriggerHappy18
  succ BtnTriggerHappy18 = Key
BtnTriggerHappy19
  succ BtnTriggerHappy19 = Key
BtnTriggerHappy20
  succ BtnTriggerHappy20 = Key
BtnTriggerHappy21
  succ BtnTriggerHappy21 = Key
BtnTriggerHappy22
  succ BtnTriggerHappy22 = Key
BtnTriggerHappy23
  succ BtnTriggerHappy23 = Key
BtnTriggerHappy24
  succ BtnTriggerHappy24 = Key
BtnTriggerHappy25
  succ BtnTriggerHappy25 = Key
BtnTriggerHappy26
  succ BtnTriggerHappy26 = Key
BtnTriggerHappy27
  succ BtnTriggerHappy27 = Key
BtnTriggerHappy28
  succ BtnTriggerHappy28 = Key
BtnTriggerHappy29
  succ BtnTriggerHappy29 = Key
BtnTriggerHappy30
  succ BtnTriggerHappy30 = Key
BtnTriggerHappy31
  succ BtnTriggerHappy31 = Key
BtnTriggerHappy32
  succ BtnTriggerHappy32 = Key
BtnTriggerHappy33
  succ BtnTriggerHappy33 = Key
BtnTriggerHappy34
  succ BtnTriggerHappy34 = Key
BtnTriggerHappy35
  succ BtnTriggerHappy35 = Key
BtnTriggerHappy36
  succ BtnTriggerHappy36 = Key
BtnTriggerHappy37
  succ BtnTriggerHappy37 = Key
BtnTriggerHappy38
  succ BtnTriggerHappy38 = Key
BtnTriggerHappy39
  succ BtnTriggerHappy39 = Key
BtnTriggerHappy40
  succ BtnTriggerHappy40 = String -> Key
forall a. HasCallStack => String -> a
error "Key.succ: BtnTriggerHappy40 has no successor"

  pred :: Key -> Key
pred KeyEsc = Key
KeyReserved
  pred Key1 = Key
KeyEsc
  pred Key2 = Key
Key1
  pred Key3 = Key
Key2
  pred Key4 = Key
Key3
  pred Key5 = Key
Key4
  pred Key6 = Key
Key5
  pred Key7 = Key
Key6
  pred Key8 = Key
Key7
  pred Key9 = Key
Key8
  pred Key0 = Key
Key9
  pred KeyMinus = Key
Key0
  pred KeyEqual = Key
KeyMinus
  pred KeyBackspace = Key
KeyEqual
  pred KeyTab = Key
KeyBackspace
  pred KeyQ = Key
KeyTab
  pred KeyW = Key
KeyQ
  pred KeyE = Key
KeyW
  pred KeyR = Key
KeyE
  pred KeyT = Key
KeyR
  pred KeyY = Key
KeyT
  pred KeyU = Key
KeyY
  pred KeyI = Key
KeyU
  pred KeyO = Key
KeyI
  pred KeyP = Key
KeyO
  pred KeyLeftbrace = Key
KeyP
  pred KeyRightbrace = Key
KeyLeftbrace
  pred KeyEnter = Key
KeyRightbrace
  pred KeyLeftctrl = Key
KeyEnter
  pred KeyA = Key
KeyLeftctrl
  pred KeyS = Key
KeyA
  pred KeyD = Key
KeyS
  pred KeyF = Key
KeyD
  pred KeyG = Key
KeyF
  pred KeyH = Key
KeyG
  pred KeyJ = Key
KeyH
  pred KeyK = Key
KeyJ
  pred KeyL = Key
KeyK
  pred KeySemicolon = Key
KeyL
  pred KeyApostrophe = Key
KeySemicolon
  pred KeyGrave = Key
KeyApostrophe
  pred KeyLeftshift = Key
KeyGrave
  pred KeyBackslash = Key
KeyLeftshift
  pred KeyZ = Key
KeyBackslash
  pred KeyX = Key
KeyZ
  pred KeyC = Key
KeyX
  pred KeyV = Key
KeyC
  pred KeyB = Key
KeyV
  pred KeyN = Key
KeyB
  pred KeyM = Key
KeyN
  pred KeyComma = Key
KeyM
  pred KeyDot = Key
KeyComma
  pred KeySlash = Key
KeyDot
  pred KeyRightshift = Key
KeySlash
  pred KeyKpasterisk = Key
KeyRightshift
  pred KeyLeftalt = Key
KeyKpasterisk
  pred KeySpace = Key
KeyLeftalt
  pred KeyCapslock = Key
KeySpace
  pred KeyF1 = Key
KeyCapslock
  pred KeyF2 = Key
KeyF1
  pred KeyF3 = Key
KeyF2
  pred KeyF4 = Key
KeyF3
  pred KeyF5 = Key
KeyF4
  pred KeyF6 = Key
KeyF5
  pred KeyF7 = Key
KeyF6
  pred KeyF8 = Key
KeyF7
  pred KeyF9 = Key
KeyF8
  pred KeyF10 = Key
KeyF9
  pred KeyNumlock = Key
KeyF10
  pred KeyScrolllock = Key
KeyNumlock
  pred KeyKp7 = Key
KeyScrolllock
  pred KeyKp8 = Key
KeyKp7
  pred KeyKp9 = Key
KeyKp8
  pred KeyKpminus = Key
KeyKp9
  pred KeyKp4 = Key
KeyKpminus
  pred KeyKp5 = Key
KeyKp4
  pred KeyKp6 = Key
KeyKp5
  pred KeyKpplus = Key
KeyKp6
  pred KeyKp1 = Key
KeyKpplus
  pred KeyKp2 = Key
KeyKp1
  pred KeyKp3 = Key
KeyKp2
  pred KeyKp0 = Key
KeyKp3
  pred KeyKpdot = Key
KeyKp0
  pred KeyZenkakuhankaku = Key
KeyKpdot
  pred Key102nd = Key
KeyZenkakuhankaku
  pred KeyF11 = Key
Key102nd
  pred KeyF12 = Key
KeyF11
  pred KeyRo = Key
KeyF12
  pred KeyKatakana = Key
KeyRo
  pred KeyHiragana = Key
KeyKatakana
  pred KeyHenkan = Key
KeyHiragana
  pred KeyKatakanahiragana = Key
KeyHenkan
  pred KeyMuhenkan = Key
KeyKatakanahiragana
  pred KeyKpjpcomma = Key
KeyMuhenkan
  pred KeyKpenter = Key
KeyKpjpcomma
  pred KeyRightctrl = Key
KeyKpenter
  pred KeyKpslash = Key
KeyRightctrl
  pred KeySysrq = Key
KeyKpslash
  pred KeyRightalt = Key
KeySysrq
  pred KeyLinefeed = Key
KeyRightalt
  pred KeyHome = Key
KeyLinefeed
  pred KeyUp = Key
KeyHome
  pred KeyPageup = Key
KeyUp
  pred KeyLeft = Key
KeyPageup
  pred KeyRight = Key
KeyLeft
  pred KeyEnd = Key
KeyRight
  pred KeyDown = Key
KeyEnd
  pred KeyPagedown = Key
KeyDown
  pred KeyInsert = Key
KeyPagedown
  pred KeyDelete = Key
KeyInsert
  pred KeyMacro = Key
KeyDelete
  pred KeyMute = Key
KeyMacro
  pred KeyVolumedown = Key
KeyMute
  pred KeyVolumeup = Key
KeyVolumedown
  pred KeyPower = Key
KeyVolumeup
  pred KeyKpequal = Key
KeyPower
  pred KeyKpplusminus = Key
KeyKpequal
  pred KeyPause = Key
KeyKpplusminus
  pred KeyScale = Key
KeyPause
  pred KeyKpcomma = Key
KeyScale
  pred KeyHangeul = Key
KeyKpcomma
  pred KeyHanguel = Key
KeyKpcomma
  pred KeyHanja = Key
KeyHangeul
  pred KeyYen = Key
KeyHanja
  pred KeyLeftmeta = Key
KeyYen
  pred KeyRightmeta = Key
KeyLeftmeta
  pred KeyCompose = Key
KeyRightmeta
  pred KeyStop = Key
KeyCompose
  pred KeyAgain = Key
KeyStop
  pred KeyProps = Key
KeyAgain
  pred KeyUndo = Key
KeyProps
  pred KeyFront = Key
KeyUndo
  pred KeyCopy = Key
KeyFront
  pred KeyOpen = Key
KeyCopy
  pred KeyPaste = Key
KeyOpen
  pred KeyFind = Key
KeyPaste
  pred KeyCut = Key
KeyFind
  pred KeyHelp = Key
KeyCut
  pred KeyMenu = Key
KeyHelp
  pred KeyCalc = Key
KeyMenu
  pred KeySetup = Key
KeyCalc
  pred KeySleep = Key
KeySetup
  pred KeyWakeup = Key
KeySleep
  pred KeyFile = Key
KeyWakeup
  pred KeySendfile = Key
KeyFile
  pred KeyDeletefile = Key
KeySendfile
  pred KeyXfer = Key
KeyDeletefile
  pred KeyProg1 = Key
KeyXfer
  pred KeyProg2 = Key
KeyProg1
  pred KeyWww = Key
KeyProg2
  pred KeyMsdos = Key
KeyWww
  pred KeyCoffee = Key
KeyMsdos
  pred KeyScreenlock = Key
KeyMsdos
  pred KeyRotateDisplay = Key
KeyCoffee
  pred KeyDirection = Key
KeyCoffee
  pred KeyCyclewindows = Key
KeyRotateDisplay
  pred KeyMail = Key
KeyCyclewindows
  pred KeyBookmarks = Key
KeyMail
  pred KeyComputer = Key
KeyBookmarks
  pred KeyBack = Key
KeyComputer
  pred KeyForward = Key
KeyBack
  pred KeyClosecd = Key
KeyForward
  pred KeyEjectcd = Key
KeyClosecd
  pred KeyEjectclosecd = Key
KeyEjectcd
  pred KeyNextsong = Key
KeyEjectclosecd
  pred KeyPlaypause = Key
KeyNextsong
  pred KeyPrevioussong = Key
KeyPlaypause
  pred KeyStopcd = Key
KeyPrevioussong
  pred KeyRecord = Key
KeyStopcd
  pred KeyRewind = Key
KeyRecord
  pred KeyPhone = Key
KeyRewind
  pred KeyIso = Key
KeyPhone
  pred KeyConfig = Key
KeyIso
  pred KeyHomepage = Key
KeyConfig
  pred KeyRefresh = Key
KeyHomepage
  pred KeyExit = Key
KeyRefresh
  pred KeyMove = Key
KeyExit
  pred KeyEdit = Key
KeyMove
  pred KeyScrollup = Key
KeyEdit
  pred KeyScrolldown = Key
KeyScrollup
  pred KeyKpleftparen = Key
KeyScrolldown
  pred KeyKprightparen = Key
KeyKpleftparen
  pred KeyNew = Key
KeyKprightparen
  pred KeyRedo = Key
KeyNew
  pred KeyF13 = Key
KeyRedo
  pred KeyF14 = Key
KeyF13
  pred KeyF15 = Key
KeyF14
  pred KeyF16 = Key
KeyF15
  pred KeyF17 = Key
KeyF16
  pred KeyF18 = Key
KeyF17
  pred KeyF19 = Key
KeyF18
  pred KeyF20 = Key
KeyF19
  pred KeyF21 = Key
KeyF20
  pred KeyF22 = Key
KeyF21
  pred KeyF23 = Key
KeyF22
  pred KeyF24 = Key
KeyF23
  pred KeyPlaycd = Key
KeyF24
  pred KeyPausecd = Key
KeyPlaycd
  pred KeyProg3 = Key
KeyPausecd
  pred KeyProg4 = Key
KeyProg3
  pred KeyDashboard = Key
KeyProg4
  pred KeySuspend = Key
KeyDashboard
  pred KeyClose = Key
KeySuspend
  pred KeyPlay = Key
KeyClose
  pred KeyFastforward = Key
KeyPlay
  pred KeyBassboost = Key
KeyFastforward
  pred KeyPrint = Key
KeyBassboost
  pred KeyHp = Key
KeyPrint
  pred KeyCamera = Key
KeyHp
  pred KeySound = Key
KeyCamera
  pred KeyQuestion = Key
KeySound
  pred KeyEmail = Key
KeyQuestion
  pred KeyChat = Key
KeyEmail
  pred KeySearch = Key
KeyChat
  pred KeyConnect = Key
KeySearch
  pred KeyFinance = Key
KeyConnect
  pred KeySport = Key
KeyFinance
  pred KeyShop = Key
KeySport
  pred KeyAlterase = Key
KeyShop
  pred KeyCancel = Key
KeyAlterase
  pred KeyBrightnessdown = Key
KeyCancel
  pred KeyBrightnessup = Key
KeyBrightnessdown
  pred KeyMedia = Key
KeyBrightnessup
  pred KeySwitchvideomode = Key
KeyMedia
  pred KeyKbdillumtoggle = Key
KeySwitchvideomode
  pred KeyKbdillumdown = Key
KeyKbdillumtoggle
  pred KeyKbdillumup = Key
KeyKbdillumdown
  pred KeySend = Key
KeyKbdillumup
  pred KeyReply = Key
KeySend
  pred KeyForwardmail = Key
KeyReply
  pred KeySave = Key
KeyForwardmail
  pred KeyDocuments = Key
KeySave
  pred KeyBattery = Key
KeyDocuments
  pred KeyBluetooth = Key
KeyBattery
  pred KeyWlan = Key
KeyBluetooth
  pred KeyUwb = Key
KeyWlan
  pred KeyUnknown = Key
KeyUwb
  pred KeyVideoNext = Key
KeyUnknown
  pred KeyVideoPrev = Key
KeyVideoNext
  pred KeyBrightnessCycle = Key
KeyVideoPrev
  pred KeyBrightnessAuto = Key
KeyBrightnessCycle
  pred KeyBrightnessZero = Key
KeyBrightnessCycle
  pred KeyDisplayOff = Key
KeyBrightnessAuto
  pred KeyWwan = Key
KeyDisplayOff
  pred KeyWimax = Key
KeyDisplayOff
  pred KeyRfkill = Key
KeyWwan
  pred KeyMicmute = Key
KeyRfkill
  pred BtnMisc = Key
KeyMicmute
  pred Btn0 = Key
KeyMicmute
  pred Btn1 = Key
BtnMisc
  pred Btn2 = Key
Btn1
  pred Btn3 = Key
Btn2
  pred Btn4 = Key
Btn3
  pred Btn5 = Key
Btn4
  pred Btn6 = Key
Btn5
  pred Btn7 = Key
Btn6
  pred Btn8 = Key
Btn7
  pred Btn9 = Key
Btn8
  pred BtnMouse = Key
Btn9
  pred BtnLeft = Key
Btn9
  pred BtnRight = Key
BtnMouse
  pred BtnMiddle = Key
BtnRight
  pred BtnSide = Key
BtnMiddle
  pred BtnExtra = Key
BtnSide
  pred BtnForward = Key
BtnExtra
  pred BtnBack = Key
BtnForward
  pred BtnTask = Key
BtnBack
  pred BtnJoystick = Key
BtnTask
  pred BtnTrigger = Key
BtnTask
  pred BtnThumb = Key
BtnJoystick
  pred BtnThumb2 = Key
BtnThumb
  pred BtnTop = Key
BtnThumb2
  pred BtnTop2 = Key
BtnTop
  pred BtnPinkie = Key
BtnTop2
  pred BtnBase = Key
BtnPinkie
  pred BtnBase2 = Key
BtnBase
  pred BtnBase3 = Key
BtnBase2
  pred BtnBase4 = Key
BtnBase3
  pred BtnBase5 = Key
BtnBase4
  pred BtnBase6 = Key
BtnBase5
  pred BtnDead = Key
BtnBase6
  pred BtnGamepad = Key
BtnDead
  pred BtnSouth = Key
BtnDead
  pred BtnA = Key
BtnDead
  pred BtnEast = Key
BtnGamepad
  pred BtnB = Key
BtnGamepad
  pred BtnC = Key
BtnEast
  pred BtnNorth = Key
BtnC
  pred BtnX = Key
BtnC
  pred BtnWest = Key
BtnNorth
  pred BtnY = Key
BtnNorth
  pred BtnZ = Key
BtnWest
  pred BtnTl = Key
BtnZ
  pred BtnTr = Key
BtnTl
  pred BtnTl2 = Key
BtnTr
  pred BtnTr2 = Key
BtnTl2
  pred BtnSelect = Key
BtnTr2
  pred BtnStart = Key
BtnSelect
  pred BtnMode = Key
BtnStart
  pred BtnThumbl = Key
BtnMode
  pred BtnThumbr = Key
BtnThumbl
  pred BtnDigi = Key
BtnThumbr
  pred BtnToolPen = Key
BtnThumbr
  pred BtnToolRubber = Key
BtnDigi
  pred BtnToolBrush = Key
BtnToolRubber
  pred BtnToolPencil = Key
BtnToolBrush
  pred BtnToolAirbrush = Key
BtnToolPencil
  pred BtnToolFinger = Key
BtnToolAirbrush
  pred BtnToolMouse = Key
BtnToolFinger
  pred BtnToolLens = Key
BtnToolMouse
  pred BtnToolQuinttap = Key
BtnToolLens
  pred BtnTouch = Key
BtnToolQuinttap
  pred BtnStylus = Key
BtnTouch
  pred BtnStylus2 = Key
BtnStylus
  pred BtnToolDoubletap = Key
BtnStylus2
  pred BtnToolTripletap = Key
BtnToolDoubletap
  pred BtnToolQuadtap = Key
BtnToolTripletap
  pred BtnWheel = Key
BtnToolQuadtap
  pred BtnGearDown = Key
BtnToolQuadtap
  pred BtnGearUp = Key
BtnWheel
  pred KeyOk = Key
BtnGearUp
  pred KeySelect = Key
KeyOk
  pred KeyGoto = Key
KeySelect
  pred KeyClear = Key
KeyGoto
  pred KeyPower2 = Key
KeyClear
  pred KeyOption = Key
KeyPower2
  pred KeyInfo = Key
KeyOption
  pred KeyTime = Key
KeyInfo
  pred KeyVendor = Key
KeyTime
  pred KeyArchive = Key
KeyVendor
  pred KeyProgram = Key
KeyArchive
  pred KeyChannel = Key
KeyProgram
  pred KeyFavorites = Key
KeyChannel
  pred KeyEpg = Key
KeyFavorites
  pred KeyPvr = Key
KeyEpg
  pred KeyMhp = Key
KeyPvr
  pred KeyLanguage = Key
KeyMhp
  pred KeyTitle = Key
KeyLanguage
  pred KeySubtitle = Key
KeyTitle
  pred KeyAngle = Key
KeySubtitle
  pred KeyZoom = Key
KeyAngle
  pred KeyMode = Key
KeyZoom
  pred KeyKeyboard = Key
KeyMode
  pred KeyScreen = Key
KeyKeyboard
  pred KeyPc = Key
KeyScreen
  pred KeyTv = Key
KeyPc
  pred KeyTv2 = Key
KeyTv
  pred KeyVcr = Key
KeyTv2
  pred KeyVcr2 = Key
KeyVcr
  pred KeySat = Key
KeyVcr2
  pred KeySat2 = Key
KeySat
  pred KeyCd = Key
KeySat2
  pred KeyTape = Key
KeyCd
  pred KeyRadio = Key
KeyTape
  pred KeyTuner = Key
KeyRadio
  pred KeyPlayer = Key
KeyTuner
  pred KeyText = Key
KeyPlayer
  pred KeyDvd = Key
KeyText
  pred KeyAux = Key
KeyDvd
  pred KeyMp3 = Key
KeyAux
  pred KeyAudio = Key
KeyMp3
  pred KeyVideo = Key
KeyAudio
  pred KeyDirectory = Key
KeyVideo
  pred KeyList = Key
KeyDirectory
  pred KeyMemo = Key
KeyList
  pred KeyCalendar = Key
KeyMemo
  pred KeyRed = Key
KeyCalendar
  pred KeyGreen = Key
KeyRed
  pred KeyYellow = Key
KeyGreen
  pred KeyBlue = Key
KeyYellow
  pred KeyChannelup = Key
KeyBlue
  pred KeyChanneldown = Key
KeyChannelup
  pred KeyFirst = Key
KeyChanneldown
  pred KeyLast = Key
KeyFirst
  pred KeyAb = Key
KeyLast
  pred KeyNext = Key
KeyAb
  pred KeyRestart = Key
KeyNext
  pred KeySlow = Key
KeyRestart
  pred KeyShuffle = Key
KeySlow
  pred KeyBreak = Key
KeyShuffle
  pred KeyPrevious = Key
KeyBreak
  pred KeyDigits = Key
KeyPrevious
  pred KeyTeen = Key
KeyDigits
  pred KeyTwen = Key
KeyTeen
  pred KeyVideophone = Key
KeyTwen
  pred KeyGames = Key
KeyVideophone
  pred KeyZoomin = Key
KeyGames
  pred KeyZoomout = Key
KeyZoomin
  pred KeyZoomreset = Key
KeyZoomout
  pred KeyWordprocessor = Key
KeyZoomreset
  pred KeyEditor = Key
KeyWordprocessor
  pred KeySpreadsheet = Key
KeyEditor
  pred KeyGraphicseditor = Key
KeySpreadsheet
  pred KeyPresentation = Key
KeyGraphicseditor
  pred KeyDatabase = Key
KeyPresentation
  pred KeyNews = Key
KeyDatabase
  pred KeyVoicemail = Key
KeyNews
  pred KeyAddressbook = Key
KeyVoicemail
  pred KeyMessenger = Key
KeyAddressbook
  pred KeyDisplaytoggle = Key
KeyMessenger
  pred KeyBrightnessToggle = Key
KeyMessenger
  pred KeySpellcheck = Key
KeyDisplaytoggle
  pred KeyLogoff = Key
KeySpellcheck
  pred KeyDollar = Key
KeyLogoff
  pred KeyEuro = Key
KeyDollar
  pred KeyFrameback = Key
KeyEuro
  pred KeyFrameforward = Key
KeyFrameback
  pred KeyContextMenu = Key
KeyFrameforward
  pred KeyMediaRepeat = Key
KeyContextMenu
  pred Key10channelsup = Key
KeyMediaRepeat
  pred Key10channelsdown = Key
Key10channelsup
  pred KeyImages = Key
Key10channelsdown
  pred KeyDelEol = Key
KeyImages
  pred KeyDelEos = Key
KeyDelEol
  pred KeyInsLine = Key
KeyDelEos
  pred KeyDelLine = Key
KeyInsLine
  pred KeyFn = Key
KeyDelLine
  pred KeyFnEsc = Key
KeyFn
  pred KeyFnF1 = Key
KeyFnEsc
  pred KeyFnF2 = Key
KeyFnF1
  pred KeyFnF3 = Key
KeyFnF2
  pred KeyFnF4 = Key
KeyFnF3
  pred KeyFnF5 = Key
KeyFnF4
  pred KeyFnF6 = Key
KeyFnF5
  pred KeyFnF7 = Key
KeyFnF6
  pred KeyFnF8 = Key
KeyFnF7
  pred KeyFnF9 = Key
KeyFnF8
  pred KeyFnF10 = Key
KeyFnF9
  pred KeyFnF11 = Key
KeyFnF10
  pred KeyFnF12 = Key
KeyFnF11
  pred KeyFn1 = Key
KeyFnF12
  pred KeyFn2 = Key
KeyFn1
  pred KeyFnD = Key
KeyFn2
  pred KeyFnE = Key
KeyFnD
  pred KeyFnF = Key
KeyFnE
  pred KeyFnS = Key
KeyFnF
  pred KeyFnB = Key
KeyFnS
  pred KeyBrlDot1 = Key
KeyFnB
  pred KeyBrlDot2 = Key
KeyBrlDot1
  pred KeyBrlDot3 = Key
KeyBrlDot2
  pred KeyBrlDot4 = Key
KeyBrlDot3
  pred KeyBrlDot5 = Key
KeyBrlDot4
  pred KeyBrlDot6 = Key
KeyBrlDot5
  pred KeyBrlDot7 = Key
KeyBrlDot6
  pred KeyBrlDot8 = Key
KeyBrlDot7
  pred KeyBrlDot9 = Key
KeyBrlDot8
  pred KeyBrlDot10 = Key
KeyBrlDot9
  pred KeyNumeric0 = Key
KeyBrlDot10
  pred KeyNumeric1 = Key
KeyNumeric0
  pred KeyNumeric2 = Key
KeyNumeric1
  pred KeyNumeric3 = Key
KeyNumeric2
  pred KeyNumeric4 = Key
KeyNumeric3
  pred KeyNumeric5 = Key
KeyNumeric4
  pred KeyNumeric6 = Key
KeyNumeric5
  pred KeyNumeric7 = Key
KeyNumeric6
  pred KeyNumeric8 = Key
KeyNumeric7
  pred KeyNumeric9 = Key
KeyNumeric8
  pred KeyNumericStar = Key
KeyNumeric9
  pred KeyNumericPound = Key
KeyNumericStar
  pred KeyNumericA = Key
KeyNumericPound
  pred KeyNumericB = Key
KeyNumericA
  pred KeyNumericC = Key
KeyNumericB
  pred KeyNumericD = Key
KeyNumericC
  pred KeyCameraFocus = Key
KeyNumericD
  pred KeyWpsButton = Key
KeyCameraFocus
  pred KeyTouchpadToggle = Key
KeyWpsButton
  pred KeyTouchpadOn = Key
KeyTouchpadToggle
  pred KeyTouchpadOff = Key
KeyTouchpadOn
  pred KeyCameraZoomin = Key
KeyTouchpadOff
  pred KeyCameraZoomout = Key
KeyCameraZoomin
  pred KeyCameraUp = Key
KeyCameraZoomout
  pred KeyCameraDown = Key
KeyCameraUp
  pred KeyCameraLeft = Key
KeyCameraDown
  pred KeyCameraRight = Key
KeyCameraLeft
  pred KeyAttendantOn = Key
KeyCameraRight
  pred KeyAttendantOff = Key
KeyAttendantOn
  pred KeyAttendantToggle = Key
KeyAttendantOff
  pred KeyLightsToggle = Key
KeyAttendantToggle
  pred BtnDpadUp = Key
KeyLightsToggle
  pred BtnDpadDown = Key
BtnDpadUp
  pred BtnDpadLeft = Key
BtnDpadDown
  pred BtnDpadRight = Key
BtnDpadLeft
  pred KeyAlsToggle = Key
BtnDpadRight
  pred KeyButtonconfig = Key
KeyAlsToggle
  pred KeyTaskmanager = Key
KeyButtonconfig
  pred KeyJournal = Key
KeyTaskmanager
  pred KeyControlpanel = Key
KeyJournal
  pred KeyAppselect = Key
KeyControlpanel
  pred KeyScreensaver = Key
KeyAppselect
  pred KeyVoicecommand = Key
KeyScreensaver
  pred KeyBrightnessMin = Key
KeyVoicecommand
  pred KeyBrightnessMax = Key
KeyBrightnessMin
  pred KeyKbdinputassistPrev = Key
KeyBrightnessMax
  pred KeyKbdinputassistNext = Key
KeyKbdinputassistPrev
  pred KeyKbdinputassistPrevgroup = Key
KeyKbdinputassistNext
  pred KeyKbdinputassistNextgroup = Key
KeyKbdinputassistPrevgroup
  pred KeyKbdinputassistAccept = Key
KeyKbdinputassistNextgroup
  pred KeyKbdinputassistCancel = Key
KeyKbdinputassistAccept
  pred BtnTriggerHappy = Key
KeyKbdinputassistCancel
  pred BtnTriggerHappy1 = Key
KeyKbdinputassistCancel
  pred BtnTriggerHappy2 = Key
BtnTriggerHappy
  pred BtnTriggerHappy3 = Key
BtnTriggerHappy2
  pred BtnTriggerHappy4 = Key
BtnTriggerHappy3
  pred BtnTriggerHappy5 = Key
BtnTriggerHappy4
  pred BtnTriggerHappy6 = Key
BtnTriggerHappy5
  pred BtnTriggerHappy7 = Key
BtnTriggerHappy6
  pred BtnTriggerHappy8 = Key
BtnTriggerHappy7
  pred BtnTriggerHappy9 = Key
BtnTriggerHappy8
  pred BtnTriggerHappy10 = Key
BtnTriggerHappy9
  pred BtnTriggerHappy11 = Key
BtnTriggerHappy10
  pred BtnTriggerHappy12 = Key
BtnTriggerHappy11
  pred BtnTriggerHappy13 = Key
BtnTriggerHappy12
  pred BtnTriggerHappy14 = Key
BtnTriggerHappy13
  pred BtnTriggerHappy15 = Key
BtnTriggerHappy14
  pred BtnTriggerHappy16 = Key
BtnTriggerHappy15
  pred BtnTriggerHappy17 = Key
BtnTriggerHappy16
  pred BtnTriggerHappy18 = Key
BtnTriggerHappy17
  pred BtnTriggerHappy19 = Key
BtnTriggerHappy18
  pred BtnTriggerHappy20 = Key
BtnTriggerHappy19
  pred BtnTriggerHappy21 = Key
BtnTriggerHappy20
  pred BtnTriggerHappy22 = Key
BtnTriggerHappy21
  pred BtnTriggerHappy23 = Key
BtnTriggerHappy22
  pred BtnTriggerHappy24 = Key
BtnTriggerHappy23
  pred BtnTriggerHappy25 = Key
BtnTriggerHappy24
  pred BtnTriggerHappy26 = Key
BtnTriggerHappy25
  pred BtnTriggerHappy27 = Key
BtnTriggerHappy26
  pred BtnTriggerHappy28 = Key
BtnTriggerHappy27
  pred BtnTriggerHappy29 = Key
BtnTriggerHappy28
  pred BtnTriggerHappy30 = Key
BtnTriggerHappy29
  pred BtnTriggerHappy31 = Key
BtnTriggerHappy30
  pred BtnTriggerHappy32 = Key
BtnTriggerHappy31
  pred BtnTriggerHappy33 = Key
BtnTriggerHappy32
  pred BtnTriggerHappy34 = Key
BtnTriggerHappy33
  pred BtnTriggerHappy35 = Key
BtnTriggerHappy34
  pred BtnTriggerHappy36 = Key
BtnTriggerHappy35
  pred BtnTriggerHappy37 = Key
BtnTriggerHappy36
  pred BtnTriggerHappy38 = Key
BtnTriggerHappy37
  pred BtnTriggerHappy39 = Key
BtnTriggerHappy38
  pred BtnTriggerHappy40 = Key
BtnTriggerHappy39
  pred KeyReserved = String -> Key
forall a. HasCallStack => String -> a
error "Key.pred: KeyReserved has no predecessor"

  enumFromTo :: Key -> Key -> [Key]
enumFromTo from :: Key
from to :: Key
to = Key -> [Key]
forall t. Enum t => t -> [t]
go Key
from
    where
      end :: Int
end = Key -> Int
forall a. Enum a => a -> Int
fromEnum Key
to
      go :: t -> [t]
go v :: t
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (t -> Int
forall a. Enum a => a -> Int
fromEnum t
v) Int
end of
                 LT -> t
v t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t]
go (t -> t
forall a. Enum a => a -> a
succ t
v)
                 EQ -> [t
Item [t]
v]
                 GT -> []

  enumFrom :: Key -> [Key]
enumFrom from :: Key
from = Key -> Key -> [Key]
forall a. Enum a => a -> a -> [a]
enumFromTo Key
from Key
BtnTriggerHappy40

  fromEnum :: Key -> Int
fromEnum KeyReserved = 0
  fromEnum KeyEsc = 1
  fromEnum Key1 = 2
  fromEnum Key2 = 3
  fromEnum Key3 = 4
  fromEnum Key4 = 5
  fromEnum Key5 = 6
  fromEnum Key6 = 7
  fromEnum Key7 = 8
  fromEnum Key8 = 9
  fromEnum Key9 = 10
  fromEnum Key0 = 11
  fromEnum KeyMinus = 12
  fromEnum KeyEqual = 13
  fromEnum KeyBackspace = 14
  fromEnum KeyTab = 15
  fromEnum KeyQ = 16
  fromEnum KeyW = 17
  fromEnum KeyE = 18
  fromEnum KeyR = 19
  fromEnum KeyT = 20
  fromEnum KeyY = 21
  fromEnum KeyU = 22
  fromEnum KeyI = 23
  fromEnum KeyO = 24
  fromEnum KeyP = 25
  fromEnum KeyLeftbrace = 26
  fromEnum KeyRightbrace = 27
  fromEnum KeyEnter = 28
  fromEnum KeyLeftctrl = 29
  fromEnum KeyA = 30
  fromEnum KeyS = 31
  fromEnum KeyD = 32
  fromEnum KeyF = 33
  fromEnum KeyG = 34
  fromEnum KeyH = 35
  fromEnum KeyJ = 36
  fromEnum KeyK = 37
  fromEnum KeyL = 38
  fromEnum KeySemicolon = 39
  fromEnum KeyApostrophe = 40
  fromEnum KeyGrave = 41
  fromEnum KeyLeftshift = 42
  fromEnum KeyBackslash = 43
  fromEnum KeyZ = 44
  fromEnum KeyX = 45
  fromEnum KeyC = 46
  fromEnum KeyV = 47
  fromEnum KeyB = 48
  fromEnum KeyN = 49
  fromEnum KeyM = 50
  fromEnum KeyComma = 51
  fromEnum KeyDot = 52
  fromEnum KeySlash = 53
  fromEnum KeyRightshift = 54
  fromEnum KeyKpasterisk = 55
  fromEnum KeyLeftalt = 56
  fromEnum KeySpace = 57
  fromEnum KeyCapslock = 58
  fromEnum KeyF1 = 59
  fromEnum KeyF2 = 60
  fromEnum KeyF3 = 61
  fromEnum KeyF4 = 62
  fromEnum KeyF5 = 63
  fromEnum KeyF6 = 64
  fromEnum KeyF7 = 65
  fromEnum KeyF8 = 66
  fromEnum KeyF9 = 67
  fromEnum KeyF10 = 68
  fromEnum KeyNumlock = 69
  fromEnum KeyScrolllock = 70
  fromEnum KeyKp7 = 71
  fromEnum KeyKp8 = 72
  fromEnum KeyKp9 = 73
  fromEnum KeyKpminus = 74
  fromEnum KeyKp4 = 75
  fromEnum KeyKp5 = 76
  fromEnum KeyKp6 = 77
  fromEnum KeyKpplus = 78
  fromEnum KeyKp1 = 79
  fromEnum KeyKp2 = 80
  fromEnum KeyKp3 = 81
  fromEnum KeyKp0 = 82
  fromEnum KeyKpdot = 83
  fromEnum KeyZenkakuhankaku = 85
  fromEnum Key102nd = 86
  fromEnum KeyF11 = 87
  fromEnum KeyF12 = 88
  fromEnum KeyRo = 89
  fromEnum KeyKatakana = 90
  fromEnum KeyHiragana = 91
  fromEnum KeyHenkan = 92
  fromEnum KeyKatakanahiragana = 93
  fromEnum KeyMuhenkan = 94
  fromEnum KeyKpjpcomma = 95
  fromEnum KeyKpenter = 96
  fromEnum KeyRightctrl = 97
  fromEnum KeyKpslash = 98
  fromEnum KeySysrq = 99
  fromEnum KeyRightalt = 100
  fromEnum KeyLinefeed = 101
  fromEnum KeyHome = 102
  fromEnum KeyUp = 103
  fromEnum KeyPageup = 104
  fromEnum KeyLeft = 105
  fromEnum KeyRight = 106
  fromEnum KeyEnd = 107
  fromEnum KeyDown = 108
  fromEnum KeyPagedown = 109
  fromEnum KeyInsert = 110
  fromEnum KeyDelete = 111
  fromEnum KeyMacro = 112
  fromEnum KeyMute = 113
  fromEnum KeyVolumedown = 114
  fromEnum KeyVolumeup = 115
  fromEnum KeyPower = 116
  fromEnum KeyKpequal = 117
  fromEnum KeyKpplusminus = 118
  fromEnum KeyPause = 119
  fromEnum KeyScale = 120
  fromEnum KeyKpcomma = 121
  fromEnum KeyHangeul = 122
  fromEnum KeyHanguel = 122
  fromEnum KeyHanja = 123
  fromEnum KeyYen = 124
  fromEnum KeyLeftmeta = 125
  fromEnum KeyRightmeta = 126
  fromEnum KeyCompose = 127
  fromEnum KeyStop = 128
  fromEnum KeyAgain = 129
  fromEnum KeyProps = 130
  fromEnum KeyUndo = 131
  fromEnum KeyFront = 132
  fromEnum KeyCopy = 133
  fromEnum KeyOpen = 134
  fromEnum KeyPaste = 135
  fromEnum KeyFind = 136
  fromEnum KeyCut = 137
  fromEnum KeyHelp = 138
  fromEnum KeyMenu = 139
  fromEnum KeyCalc = 140
  fromEnum KeySetup = 141
  fromEnum KeySleep = 142
  fromEnum KeyWakeup = 143
  fromEnum KeyFile = 144
  fromEnum KeySendfile = 145
  fromEnum KeyDeletefile = 146
  fromEnum KeyXfer = 147
  fromEnum KeyProg1 = 148
  fromEnum KeyProg2 = 149
  fromEnum KeyWww = 150
  fromEnum KeyMsdos = 151
  fromEnum KeyCoffee = 152
  fromEnum KeyScreenlock = 152
  fromEnum KeyRotateDisplay = 153
  fromEnum KeyDirection = 153
  fromEnum KeyCyclewindows = 154
  fromEnum KeyMail = 155
  fromEnum KeyBookmarks = 156
  fromEnum KeyComputer = 157
  fromEnum KeyBack = 158
  fromEnum KeyForward = 159
  fromEnum KeyClosecd = 160
  fromEnum KeyEjectcd = 161
  fromEnum KeyEjectclosecd = 162
  fromEnum KeyNextsong = 163
  fromEnum KeyPlaypause = 164
  fromEnum KeyPrevioussong = 165
  fromEnum KeyStopcd = 166
  fromEnum KeyRecord = 167
  fromEnum KeyRewind = 168
  fromEnum KeyPhone = 169
  fromEnum KeyIso = 170
  fromEnum KeyConfig = 171
  fromEnum KeyHomepage = 172
  fromEnum KeyRefresh = 173
  fromEnum KeyExit = 174
  fromEnum KeyMove = 175
  fromEnum KeyEdit = 176
  fromEnum KeyScrollup = 177
  fromEnum KeyScrolldown = 178
  fromEnum KeyKpleftparen = 179
  fromEnum KeyKprightparen = 180
  fromEnum KeyNew = 181
  fromEnum KeyRedo = 182
  fromEnum KeyF13 = 183
  fromEnum KeyF14 = 184
  fromEnum KeyF15 = 185
  fromEnum KeyF16 = 186
  fromEnum KeyF17 = 187
  fromEnum KeyF18 = 188
  fromEnum KeyF19 = 189
  fromEnum KeyF20 = 190
  fromEnum KeyF21 = 191
  fromEnum KeyF22 = 192
  fromEnum KeyF23 = 193
  fromEnum KeyF24 = 194
  fromEnum KeyPlaycd = 200
  fromEnum KeyPausecd = 201
  fromEnum KeyProg3 = 202
  fromEnum KeyProg4 = 203
  fromEnum KeyDashboard = 204
  fromEnum KeySuspend = 205
  fromEnum KeyClose = 206
  fromEnum KeyPlay = 207
  fromEnum KeyFastforward = 208
  fromEnum KeyBassboost = 209
  fromEnum KeyPrint = 210
  fromEnum KeyHp = 211
  fromEnum KeyCamera = 212
  fromEnum KeySound = 213
  fromEnum KeyQuestion = 214
  fromEnum KeyEmail = 215
  fromEnum KeyChat = 216
  fromEnum KeySearch = 217
  fromEnum KeyConnect = 218
  fromEnum KeyFinance = 219
  fromEnum KeySport = 220
  fromEnum KeyShop = 221
  fromEnum KeyAlterase = 222
  fromEnum KeyCancel = 223
  fromEnum KeyBrightnessdown = 224
  fromEnum KeyBrightnessup = 225
  fromEnum KeyMedia = 226
  fromEnum KeySwitchvideomode = 227
  fromEnum KeyKbdillumtoggle = 228
  fromEnum KeyKbdillumdown = 229
  fromEnum KeyKbdillumup = 230
  fromEnum KeySend = 231
  fromEnum KeyReply = 232
  fromEnum KeyForwardmail = 233
  fromEnum KeySave = 234
  fromEnum KeyDocuments = 235
  fromEnum KeyBattery = 236
  fromEnum KeyBluetooth = 237
  fromEnum KeyWlan = 238
  fromEnum KeyUwb = 239
  fromEnum KeyUnknown = 240
  fromEnum KeyVideoNext = 241
  fromEnum KeyVideoPrev = 242
  fromEnum KeyBrightnessCycle = 243
  fromEnum KeyBrightnessAuto = 244
  fromEnum KeyBrightnessZero = 244
  fromEnum KeyDisplayOff = 245
  fromEnum KeyWwan = 246
  fromEnum KeyWimax = 246
  fromEnum KeyRfkill = 247
  fromEnum KeyMicmute = 248
  fromEnum BtnMisc = 256
  fromEnum Btn0 = 256
  fromEnum Btn1 = 257
  fromEnum Btn2 = 258
  fromEnum Btn3 = 259
  fromEnum Btn4 = 260
  fromEnum Btn5 = 261
  fromEnum Btn6 = 262
  fromEnum Btn7 = 263
  fromEnum Btn8 = 264
  fromEnum Btn9 = 265
  fromEnum BtnMouse = 272
  fromEnum BtnLeft = 272
  fromEnum BtnRight = 273
  fromEnum BtnMiddle = 274
  fromEnum BtnSide = 275
  fromEnum BtnExtra = 276
  fromEnum BtnForward = 277
  fromEnum BtnBack = 278
  fromEnum BtnTask = 279
  fromEnum BtnJoystick = 288
  fromEnum BtnTrigger = 288
  fromEnum BtnThumb = 289
  fromEnum BtnThumb2 = 290
  fromEnum BtnTop = 291
  fromEnum BtnTop2 = 292
  fromEnum BtnPinkie = 293
  fromEnum BtnBase = 294
  fromEnum BtnBase2 = 295
  fromEnum BtnBase3 = 296
  fromEnum BtnBase4 = 297
  fromEnum BtnBase5 = 298
  fromEnum BtnBase6 = 299
  fromEnum BtnDead = 303
  fromEnum BtnGamepad = 304
  fromEnum BtnSouth = 304
  fromEnum BtnA = 304
  fromEnum BtnEast = 305
  fromEnum BtnB = 305
  fromEnum BtnC = 306
  fromEnum BtnNorth = 307
  fromEnum BtnX = 307
  fromEnum BtnWest = 308
  fromEnum BtnY = 308
  fromEnum BtnZ = 309
  fromEnum BtnTl = 310
  fromEnum BtnTr = 311
  fromEnum BtnTl2 = 312
  fromEnum BtnTr2 = 313
  fromEnum BtnSelect = 314
  fromEnum BtnStart = 315
  fromEnum BtnMode = 316
  fromEnum BtnThumbl = 317
  fromEnum BtnThumbr = 318
  fromEnum BtnDigi = 320
  fromEnum BtnToolPen = 320
  fromEnum BtnToolRubber = 321
  fromEnum BtnToolBrush = 322
  fromEnum BtnToolPencil = 323
  fromEnum BtnToolAirbrush = 324
  fromEnum BtnToolFinger = 325
  fromEnum BtnToolMouse = 326
  fromEnum BtnToolLens = 327
  fromEnum BtnToolQuinttap = 328
  fromEnum BtnTouch = 330
  fromEnum BtnStylus = 331
  fromEnum BtnStylus2 = 332
  fromEnum BtnToolDoubletap = 333
  fromEnum BtnToolTripletap = 334
  fromEnum BtnToolQuadtap = 335
  fromEnum BtnWheel = 336
  fromEnum BtnGearDown = 336
  fromEnum BtnGearUp = 337
  fromEnum KeyOk = 352
  fromEnum KeySelect = 353
  fromEnum KeyGoto = 354
  fromEnum KeyClear = 355
  fromEnum KeyPower2 = 356
  fromEnum KeyOption = 357
  fromEnum KeyInfo = 358
  fromEnum KeyTime = 359
  fromEnum KeyVendor = 360
  fromEnum KeyArchive = 361
  fromEnum KeyProgram = 362
  fromEnum KeyChannel = 363
  fromEnum KeyFavorites = 364
  fromEnum KeyEpg = 365
  fromEnum KeyPvr = 366
  fromEnum KeyMhp = 367
  fromEnum KeyLanguage = 368
  fromEnum KeyTitle = 369
  fromEnum KeySubtitle = 370
  fromEnum KeyAngle = 371
  fromEnum KeyZoom = 372
  fromEnum KeyMode = 373
  fromEnum KeyKeyboard = 374
  fromEnum KeyScreen = 375
  fromEnum KeyPc = 376
  fromEnum KeyTv = 377
  fromEnum KeyTv2 = 378
  fromEnum KeyVcr = 379
  fromEnum KeyVcr2 = 380
  fromEnum KeySat = 381
  fromEnum KeySat2 = 382
  fromEnum KeyCd = 383
  fromEnum KeyTape = 384
  fromEnum KeyRadio = 385
  fromEnum KeyTuner = 386
  fromEnum KeyPlayer = 387
  fromEnum KeyText = 388
  fromEnum KeyDvd = 389
  fromEnum KeyAux = 390
  fromEnum KeyMp3 = 391
  fromEnum KeyAudio = 392
  fromEnum KeyVideo = 393
  fromEnum KeyDirectory = 394
  fromEnum KeyList = 395
  fromEnum KeyMemo = 396
  fromEnum KeyCalendar = 397
  fromEnum KeyRed = 398
  fromEnum KeyGreen = 399
  fromEnum KeyYellow = 400
  fromEnum KeyBlue = 401
  fromEnum KeyChannelup = 402
  fromEnum KeyChanneldown = 403
  fromEnum KeyFirst = 404
  fromEnum KeyLast = 405
  fromEnum KeyAb = 406
  fromEnum KeyNext = 407
  fromEnum KeyRestart = 408
  fromEnum KeySlow = 409
  fromEnum KeyShuffle = 410
  fromEnum KeyBreak = 411
  fromEnum KeyPrevious = 412
  fromEnum KeyDigits = 413
  fromEnum KeyTeen = 414
  fromEnum KeyTwen = 415
  fromEnum KeyVideophone = 416
  fromEnum KeyGames = 417
  fromEnum KeyZoomin = 418
  fromEnum KeyZoomout = 419
  fromEnum KeyZoomreset = 420
  fromEnum KeyWordprocessor = 421
  fromEnum KeyEditor = 422
  fromEnum KeySpreadsheet = 423
  fromEnum KeyGraphicseditor = 424
  fromEnum KeyPresentation = 425
  fromEnum KeyDatabase = 426
  fromEnum KeyNews = 427
  fromEnum KeyVoicemail = 428
  fromEnum KeyAddressbook = 429
  fromEnum KeyMessenger = 430
  fromEnum KeyDisplaytoggle = 431
  fromEnum KeyBrightnessToggle = 431
  fromEnum KeySpellcheck = 432
  fromEnum KeyLogoff = 433
  fromEnum KeyDollar = 434
  fromEnum KeyEuro = 435
  fromEnum KeyFrameback = 436
  fromEnum KeyFrameforward = 437
  fromEnum KeyContextMenu = 438
  fromEnum KeyMediaRepeat = 439
  fromEnum Key10channelsup = 440
  fromEnum Key10channelsdown = 441
  fromEnum KeyImages = 442
  fromEnum KeyDelEol = 448
  fromEnum KeyDelEos = 449
  fromEnum KeyInsLine = 450
  fromEnum KeyDelLine = 451
  fromEnum KeyFn = 464
  fromEnum KeyFnEsc = 465
  fromEnum KeyFnF1 = 466
  fromEnum KeyFnF2 = 467
  fromEnum KeyFnF3 = 468
  fromEnum KeyFnF4 = 469
  fromEnum KeyFnF5 = 470
  fromEnum KeyFnF6 = 471
  fromEnum KeyFnF7 = 472
  fromEnum KeyFnF8 = 473
  fromEnum KeyFnF9 = 474
  fromEnum KeyFnF10 = 475
  fromEnum KeyFnF11 = 476
  fromEnum KeyFnF12 = 477
  fromEnum KeyFn1 = 478
  fromEnum KeyFn2 = 479
  fromEnum KeyFnD = 480
  fromEnum KeyFnE = 481
  fromEnum KeyFnF = 482
  fromEnum KeyFnS = 483
  fromEnum KeyFnB = 484
  fromEnum KeyBrlDot1 = 497
  fromEnum KeyBrlDot2 = 498
  fromEnum KeyBrlDot3 = 499
  fromEnum KeyBrlDot4 = 500
  fromEnum KeyBrlDot5 = 501
  fromEnum KeyBrlDot6 = 502
  fromEnum KeyBrlDot7 = 503
  fromEnum KeyBrlDot8 = 504
  fromEnum KeyBrlDot9 = 505
  fromEnum KeyBrlDot10 = 506
  fromEnum KeyNumeric0 = 512
  fromEnum KeyNumeric1 = 513
  fromEnum KeyNumeric2 = 514
  fromEnum KeyNumeric3 = 515
  fromEnum KeyNumeric4 = 516
  fromEnum KeyNumeric5 = 517
  fromEnum KeyNumeric6 = 518
  fromEnum KeyNumeric7 = 519
  fromEnum KeyNumeric8 = 520
  fromEnum KeyNumeric9 = 521
  fromEnum KeyNumericStar = 522
  fromEnum KeyNumericPound = 523
  fromEnum KeyNumericA = 524
  fromEnum KeyNumericB = 525
  fromEnum KeyNumericC = 526
  fromEnum KeyNumericD = 527
  fromEnum KeyCameraFocus = 528
  fromEnum KeyWpsButton = 529
  fromEnum KeyTouchpadToggle = 530
  fromEnum KeyTouchpadOn = 531
  fromEnum KeyTouchpadOff = 532
  fromEnum KeyCameraZoomin = 533
  fromEnum KeyCameraZoomout = 534
  fromEnum KeyCameraUp = 535
  fromEnum KeyCameraDown = 536
  fromEnum KeyCameraLeft = 537
  fromEnum KeyCameraRight = 538
  fromEnum KeyAttendantOn = 539
  fromEnum KeyAttendantOff = 540
  fromEnum KeyAttendantToggle = 541
  fromEnum KeyLightsToggle = 542
  fromEnum BtnDpadUp = 544
  fromEnum BtnDpadDown = 545
  fromEnum BtnDpadLeft = 546
  fromEnum BtnDpadRight = 547
  fromEnum KeyAlsToggle = 560
  fromEnum KeyButtonconfig = 576
  fromEnum KeyTaskmanager = 577
  fromEnum KeyJournal = 578
  fromEnum KeyControlpanel = 579
  fromEnum KeyAppselect = 580
  fromEnum KeyScreensaver = 581
  fromEnum KeyVoicecommand = 582
  fromEnum KeyBrightnessMin = 592
  fromEnum KeyBrightnessMax = 593
  fromEnum KeyKbdinputassistPrev = 608
  fromEnum KeyKbdinputassistNext = 609
  fromEnum KeyKbdinputassistPrevgroup = 610
  fromEnum KeyKbdinputassistNextgroup = 611
  fromEnum KeyKbdinputassistAccept = 612
  fromEnum KeyKbdinputassistCancel = 613
  fromEnum BtnTriggerHappy = 704
  fromEnum BtnTriggerHappy1 = 704
  fromEnum BtnTriggerHappy2 = 705
  fromEnum BtnTriggerHappy3 = 706
  fromEnum BtnTriggerHappy4 = 707
  fromEnum BtnTriggerHappy5 = 708
  fromEnum BtnTriggerHappy6 = 709
  fromEnum BtnTriggerHappy7 = 710
  fromEnum BtnTriggerHappy8 = 711
  fromEnum BtnTriggerHappy9 = 712
  fromEnum BtnTriggerHappy10 = 713
  fromEnum BtnTriggerHappy11 = 714
  fromEnum BtnTriggerHappy12 = 715
  fromEnum BtnTriggerHappy13 = 716
  fromEnum BtnTriggerHappy14 = 717
  fromEnum BtnTriggerHappy15 = 718
  fromEnum BtnTriggerHappy16 = 719
  fromEnum BtnTriggerHappy17 = 720
  fromEnum BtnTriggerHappy18 = 721
  fromEnum BtnTriggerHappy19 = 722
  fromEnum BtnTriggerHappy20 = 723
  fromEnum BtnTriggerHappy21 = 724
  fromEnum BtnTriggerHappy22 = 725
  fromEnum BtnTriggerHappy23 = 726
  fromEnum BtnTriggerHappy24 = 727
  fromEnum BtnTriggerHappy25 = 728
  fromEnum BtnTriggerHappy26 = 729
  fromEnum BtnTriggerHappy27 = 730
  fromEnum BtnTriggerHappy28 = 731
  fromEnum BtnTriggerHappy29 = 732
  fromEnum BtnTriggerHappy30 = 733
  fromEnum BtnTriggerHappy31 = 734
  fromEnum BtnTriggerHappy32 = 735
  fromEnum BtnTriggerHappy33 = 736
  fromEnum BtnTriggerHappy34 = 737
  fromEnum BtnTriggerHappy35 = 738
  fromEnum BtnTriggerHappy36 = 739
  fromEnum BtnTriggerHappy37 = 740
  fromEnum BtnTriggerHappy38 = 741
  fromEnum BtnTriggerHappy39 = 742
  fromEnum BtnTriggerHappy40 = 743

  toEnum :: Int -> Key
toEnum 0 = Key
KeyReserved
  toEnum 1 = Key
KeyEsc
  toEnum 2 = Key
Key1
  toEnum 3 = Key
Key2
  toEnum 4 = Key
Key3
  toEnum 5 = Key
Key4
  toEnum 6 = Key
Key5
  toEnum 7 = Key
Key6
  toEnum 8 = Key
Key7
  toEnum 9 = Key
Key8
  toEnum 10 = Key
Key9
  toEnum 11 = Key
Key0
  toEnum 12 = Key
KeyMinus
  toEnum 13 = Key
KeyEqual
  toEnum 14 = Key
KeyBackspace
  toEnum 15 = Key
KeyTab
  toEnum 16 = Key
KeyQ
  toEnum 17 = Key
KeyW
  toEnum 18 = Key
KeyE
  toEnum 19 = Key
KeyR
  toEnum 20 = Key
KeyT
  toEnum 21 = Key
KeyY
  toEnum 22 = Key
KeyU
  toEnum 23 = Key
KeyI
  toEnum 24 = Key
KeyO
  toEnum 25 = Key
KeyP
  toEnum 26 = Key
KeyLeftbrace
  toEnum 27 = Key
KeyRightbrace
  toEnum 28 = Key
KeyEnter
  toEnum 29 = Key
KeyLeftctrl
  toEnum 30 = Key
KeyA
  toEnum 31 = Key
KeyS
  toEnum 32 = Key
KeyD
  toEnum 33 = Key
KeyF
  toEnum 34 = Key
KeyG
  toEnum 35 = Key
KeyH
  toEnum 36 = Key
KeyJ
  toEnum 37 = Key
KeyK
  toEnum 38 = Key
KeyL
  toEnum 39 = Key
KeySemicolon
  toEnum 40 = Key
KeyApostrophe
  toEnum 41 = Key
KeyGrave
  toEnum 42 = Key
KeyLeftshift
  toEnum 43 = Key
KeyBackslash
  toEnum 44 = Key
KeyZ
  toEnum 45 = Key
KeyX
  toEnum 46 = Key
KeyC
  toEnum 47 = Key
KeyV
  toEnum 48 = Key
KeyB
  toEnum 49 = Key
KeyN
  toEnum 50 = Key
KeyM
  toEnum 51 = Key
KeyComma
  toEnum 52 = Key
KeyDot
  toEnum 53 = Key
KeySlash
  toEnum 54 = Key
KeyRightshift
  toEnum 55 = Key
KeyKpasterisk
  toEnum 56 = Key
KeyLeftalt
  toEnum 57 = Key
KeySpace
  toEnum 58 = Key
KeyCapslock
  toEnum 59 = Key
KeyF1
  toEnum 60 = Key
KeyF2
  toEnum 61 = Key
KeyF3
  toEnum 62 = Key
KeyF4
  toEnum 63 = Key
KeyF5
  toEnum 64 = Key
KeyF6
  toEnum 65 = Key
KeyF7
  toEnum 66 = Key
KeyF8
  toEnum 67 = Key
KeyF9
  toEnum 68 = Key
KeyF10
  toEnum 69 = Key
KeyNumlock
  toEnum 70 = Key
KeyScrolllock
  toEnum 71 = Key
KeyKp7
  toEnum 72 = Key
KeyKp8
  toEnum 73 = Key
KeyKp9
  toEnum 74 = Key
KeyKpminus
  toEnum 75 = Key
KeyKp4
  toEnum 76 = Key
KeyKp5
  toEnum 77 = Key
KeyKp6
  toEnum 78 = Key
KeyKpplus
  toEnum 79 = Key
KeyKp1
  toEnum 80 = Key
KeyKp2
  toEnum 81 = Key
KeyKp3
  toEnum 82 = Key
KeyKp0
  toEnum 83 = Key
KeyKpdot
  toEnum 85 = Key
KeyZenkakuhankaku
  toEnum 86 = Key
Key102nd
  toEnum 87 = Key
KeyF11
  toEnum 88 = Key
KeyF12
  toEnum 89 = Key
KeyRo
  toEnum 90 = Key
KeyKatakana
  toEnum 91 = Key
KeyHiragana
  toEnum 92 = Key
KeyHenkan
  toEnum 93 = Key
KeyKatakanahiragana
  toEnum 94 = Key
KeyMuhenkan
  toEnum 95 = Key
KeyKpjpcomma
  toEnum 96 = Key
KeyKpenter
  toEnum 97 = Key
KeyRightctrl
  toEnum 98 = Key
KeyKpslash
  toEnum 99 = Key
KeySysrq
  toEnum 100 = Key
KeyRightalt
  toEnum 101 = Key
KeyLinefeed
  toEnum 102 = Key
KeyHome
  toEnum 103 = Key
KeyUp
  toEnum 104 = Key
KeyPageup
  toEnum 105 = Key
KeyLeft
  toEnum 106 = Key
KeyRight
  toEnum 107 = Key
KeyEnd
  toEnum 108 = Key
KeyDown
  toEnum 109 = Key
KeyPagedown
  toEnum 110 = Key
KeyInsert
  toEnum 111 = Key
KeyDelete
  toEnum 112 = Key
KeyMacro
  toEnum 113 = Key
KeyMute
  toEnum 114 = Key
KeyVolumedown
  toEnum 115 = Key
KeyVolumeup
  toEnum 116 = Key
KeyPower
  toEnum 117 = Key
KeyKpequal
  toEnum 118 = Key
KeyKpplusminus
  toEnum 119 = Key
KeyPause
  toEnum 120 = Key
KeyScale
  toEnum 121 = Key
KeyKpcomma
  toEnum 122 = Key
KeyHangeul
  toEnum 123 = Key
KeyHanja
  toEnum 124 = Key
KeyYen
  toEnum 125 = Key
KeyLeftmeta
  toEnum 126 = Key
KeyRightmeta
  toEnum 127 = Key
KeyCompose
  toEnum 128 = Key
KeyStop
  toEnum 129 = Key
KeyAgain
  toEnum 130 = Key
KeyProps
  toEnum 131 = Key
KeyUndo
  toEnum 132 = Key
KeyFront
  toEnum 133 = Key
KeyCopy
  toEnum 134 = Key
KeyOpen
  toEnum 135 = Key
KeyPaste
  toEnum 136 = Key
KeyFind
  toEnum 137 = Key
KeyCut
  toEnum 138 = Key
KeyHelp
  toEnum 139 = Key
KeyMenu
  toEnum 140 = Key
KeyCalc
  toEnum 141 = Key
KeySetup
  toEnum 142 = Key
KeySleep
  toEnum 143 = Key
KeyWakeup
  toEnum 144 = Key
KeyFile
  toEnum 145 = Key
KeySendfile
  toEnum 146 = Key
KeyDeletefile
  toEnum 147 = Key
KeyXfer
  toEnum 148 = Key
KeyProg1
  toEnum 149 = Key
KeyProg2
  toEnum 150 = Key
KeyWww
  toEnum 151 = Key
KeyMsdos
  toEnum 152 = Key
KeyCoffee
  toEnum 153 = Key
KeyRotateDisplay
  toEnum 154 = Key
KeyCyclewindows
  toEnum 155 = Key
KeyMail
  toEnum 156 = Key
KeyBookmarks
  toEnum 157 = Key
KeyComputer
  toEnum 158 = Key
KeyBack
  toEnum 159 = Key
KeyForward
  toEnum 160 = Key
KeyClosecd
  toEnum 161 = Key
KeyEjectcd
  toEnum 162 = Key
KeyEjectclosecd
  toEnum 163 = Key
KeyNextsong
  toEnum 164 = Key
KeyPlaypause
  toEnum 165 = Key
KeyPrevioussong
  toEnum 166 = Key
KeyStopcd
  toEnum 167 = Key
KeyRecord
  toEnum 168 = Key
KeyRewind
  toEnum 169 = Key
KeyPhone
  toEnum 170 = Key
KeyIso
  toEnum 171 = Key
KeyConfig
  toEnum 172 = Key
KeyHomepage
  toEnum 173 = Key
KeyRefresh
  toEnum 174 = Key
KeyExit
  toEnum 175 = Key
KeyMove
  toEnum 176 = Key
KeyEdit
  toEnum 177 = Key
KeyScrollup
  toEnum 178 = Key
KeyScrolldown
  toEnum 179 = Key
KeyKpleftparen
  toEnum 180 = Key
KeyKprightparen
  toEnum 181 = Key
KeyNew
  toEnum 182 = Key
KeyRedo
  toEnum 183 = Key
KeyF13
  toEnum 184 = Key
KeyF14
  toEnum 185 = Key
KeyF15
  toEnum 186 = Key
KeyF16
  toEnum 187 = Key
KeyF17
  toEnum 188 = Key
KeyF18
  toEnum 189 = Key
KeyF19
  toEnum 190 = Key
KeyF20
  toEnum 191 = Key
KeyF21
  toEnum 192 = Key
KeyF22
  toEnum 193 = Key
KeyF23
  toEnum 194 = Key
KeyF24
  toEnum 200 = Key
KeyPlaycd
  toEnum 201 = Key
KeyPausecd
  toEnum 202 = Key
KeyProg3
  toEnum 203 = Key
KeyProg4
  toEnum 204 = Key
KeyDashboard
  toEnum 205 = Key
KeySuspend
  toEnum 206 = Key
KeyClose
  toEnum 207 = Key
KeyPlay
  toEnum 208 = Key
KeyFastforward
  toEnum 209 = Key
KeyBassboost
  toEnum 210 = Key
KeyPrint
  toEnum 211 = Key
KeyHp
  toEnum 212 = Key
KeyCamera
  toEnum 213 = Key
KeySound
  toEnum 214 = Key
KeyQuestion
  toEnum 215 = Key
KeyEmail
  toEnum 216 = Key
KeyChat
  toEnum 217 = Key
KeySearch
  toEnum 218 = Key
KeyConnect
  toEnum 219 = Key
KeyFinance
  toEnum 220 = Key
KeySport
  toEnum 221 = Key
KeyShop
  toEnum 222 = Key
KeyAlterase
  toEnum 223 = Key
KeyCancel
  toEnum 224 = Key
KeyBrightnessdown
  toEnum 225 = Key
KeyBrightnessup
  toEnum 226 = Key
KeyMedia
  toEnum 227 = Key
KeySwitchvideomode
  toEnum 228 = Key
KeyKbdillumtoggle
  toEnum 229 = Key
KeyKbdillumdown
  toEnum 230 = Key
KeyKbdillumup
  toEnum 231 = Key
KeySend
  toEnum 232 = Key
KeyReply
  toEnum 233 = Key
KeyForwardmail
  toEnum 234 = Key
KeySave
  toEnum 235 = Key
KeyDocuments
  toEnum 236 = Key
KeyBattery
  toEnum 237 = Key
KeyBluetooth
  toEnum 238 = Key
KeyWlan
  toEnum 239 = Key
KeyUwb
  toEnum 240 = Key
KeyUnknown
  toEnum 241 = Key
KeyVideoNext
  toEnum 242 = Key
KeyVideoPrev
  toEnum 243 = Key
KeyBrightnessCycle
  toEnum 244 = Key
KeyBrightnessAuto
  toEnum 245 = Key
KeyDisplayOff
  toEnum 246 = Key
KeyWwan
  toEnum 247 = Key
KeyRfkill
  toEnum 248 = Key
KeyMicmute
  toEnum 256 = Key
BtnMisc
  toEnum 257 = Key
Btn1
  toEnum 258 = Key
Btn2
  toEnum 259 = Key
Btn3
  toEnum 260 = Key
Btn4
  toEnum 261 = Key
Btn5
  toEnum 262 = Key
Btn6
  toEnum 263 = Key
Btn7
  toEnum 264 = Key
Btn8
  toEnum 265 = Key
Btn9
  toEnum 272 = Key
BtnMouse
  toEnum 273 = Key
BtnRight
  toEnum 274 = Key
BtnMiddle
  toEnum 275 = Key
BtnSide
  toEnum 276 = Key
BtnExtra
  toEnum 277 = Key
BtnForward
  toEnum 278 = Key
BtnBack
  toEnum 279 = Key
BtnTask
  toEnum 288 = Key
BtnJoystick
  toEnum 289 = Key
BtnThumb
  toEnum 290 = Key
BtnThumb2
  toEnum 291 = Key
BtnTop
  toEnum 292 = Key
BtnTop2
  toEnum 293 = Key
BtnPinkie
  toEnum 294 = Key
BtnBase
  toEnum 295 = Key
BtnBase2
  toEnum 296 = Key
BtnBase3
  toEnum 297 = Key
BtnBase4
  toEnum 298 = Key
BtnBase5
  toEnum 299 = Key
BtnBase6
  toEnum 303 = Key
BtnDead
  toEnum 304 = Key
BtnGamepad
  toEnum 305 = Key
BtnEast
  toEnum 306 = Key
BtnC
  toEnum 307 = Key
BtnNorth
  toEnum 308 = Key
BtnWest
  toEnum 309 = Key
BtnZ
  toEnum 310 = Key
BtnTl
  toEnum 311 = Key
BtnTr
  toEnum 312 = Key
BtnTl2
  toEnum 313 = Key
BtnTr2
  toEnum 314 = Key
BtnSelect
  toEnum 315 = Key
BtnStart
  toEnum 316 = Key
BtnMode
  toEnum 317 = Key
BtnThumbl
  toEnum 318 = Key
BtnThumbr
  toEnum 320 = Key
BtnDigi
  toEnum 321 = Key
BtnToolRubber
  toEnum 322 = Key
BtnToolBrush
  toEnum 323 = Key
BtnToolPencil
  toEnum 324 = Key
BtnToolAirbrush
  toEnum 325 = Key
BtnToolFinger
  toEnum 326 = Key
BtnToolMouse
  toEnum 327 = Key
BtnToolLens
  toEnum 328 = Key
BtnToolQuinttap
  toEnum 330 = Key
BtnTouch
  toEnum 331 = Key
BtnStylus
  toEnum 332 = Key
BtnStylus2
  toEnum 333 = Key
BtnToolDoubletap
  toEnum 334 = Key
BtnToolTripletap
  toEnum 335 = Key
BtnToolQuadtap
  toEnum 336 = Key
BtnWheel
  toEnum 337 = Key
BtnGearUp
  toEnum 352 = Key
KeyOk
  toEnum 353 = Key
KeySelect
  toEnum 354 = Key
KeyGoto
  toEnum 355 = Key
KeyClear
  toEnum 356 = Key
KeyPower2
  toEnum 357 = Key
KeyOption
  toEnum 358 = Key
KeyInfo
  toEnum 359 = Key
KeyTime
  toEnum 360 = Key
KeyVendor
  toEnum 361 = Key
KeyArchive
  toEnum 362 = Key
KeyProgram
  toEnum 363 = Key
KeyChannel
  toEnum 364 = Key
KeyFavorites
  toEnum 365 = Key
KeyEpg
  toEnum 366 = Key
KeyPvr
  toEnum 367 = Key
KeyMhp
  toEnum 368 = Key
KeyLanguage
  toEnum 369 = Key
KeyTitle
  toEnum 370 = Key
KeySubtitle
  toEnum 371 = Key
KeyAngle
  toEnum 372 = Key
KeyZoom
  toEnum 373 = Key
KeyMode
  toEnum 374 = Key
KeyKeyboard
  toEnum 375 = Key
KeyScreen
  toEnum 376 = Key
KeyPc
  toEnum 377 = Key
KeyTv
  toEnum 378 = Key
KeyTv2
  toEnum 379 = Key
KeyVcr
  toEnum 380 = Key
KeyVcr2
  toEnum 381 = Key
KeySat
  toEnum 382 = Key
KeySat2
  toEnum 383 = Key
KeyCd
  toEnum 384 = Key
KeyTape
  toEnum 385 = Key
KeyRadio
  toEnum 386 = Key
KeyTuner
  toEnum 387 = Key
KeyPlayer
  toEnum 388 = Key
KeyText
  toEnum 389 = Key
KeyDvd
  toEnum 390 = Key
KeyAux
  toEnum 391 = Key
KeyMp3
  toEnum 392 = Key
KeyAudio
  toEnum 393 = Key
KeyVideo
  toEnum 394 = Key
KeyDirectory
  toEnum 395 = Key
KeyList
  toEnum 396 = Key
KeyMemo
  toEnum 397 = Key
KeyCalendar
  toEnum 398 = Key
KeyRed
  toEnum 399 = Key
KeyGreen
  toEnum 400 = Key
KeyYellow
  toEnum 401 = Key
KeyBlue
  toEnum 402 = Key
KeyChannelup
  toEnum 403 = Key
KeyChanneldown
  toEnum 404 = Key
KeyFirst
  toEnum 405 = Key
KeyLast
  toEnum 406 = Key
KeyAb
  toEnum 407 = Key
KeyNext
  toEnum 408 = Key
KeyRestart
  toEnum 409 = Key
KeySlow
  toEnum 410 = Key
KeyShuffle
  toEnum 411 = Key
KeyBreak
  toEnum 412 = Key
KeyPrevious
  toEnum 413 = Key
KeyDigits
  toEnum 414 = Key
KeyTeen
  toEnum 415 = Key
KeyTwen
  toEnum 416 = Key
KeyVideophone
  toEnum 417 = Key
KeyGames
  toEnum 418 = Key
KeyZoomin
  toEnum 419 = Key
KeyZoomout
  toEnum 420 = Key
KeyZoomreset
  toEnum 421 = Key
KeyWordprocessor
  toEnum 422 = Key
KeyEditor
  toEnum 423 = Key
KeySpreadsheet
  toEnum 424 = Key
KeyGraphicseditor
  toEnum 425 = Key
KeyPresentation
  toEnum 426 = Key
KeyDatabase
  toEnum 427 = Key
KeyNews
  toEnum 428 = Key
KeyVoicemail
  toEnum 429 = Key
KeyAddressbook
  toEnum 430 = Key
KeyMessenger
  toEnum 431 = Key
KeyDisplaytoggle
  toEnum 432 = Key
KeySpellcheck
  toEnum 433 = Key
KeyLogoff
  toEnum 434 = Key
KeyDollar
  toEnum 435 = Key
KeyEuro
  toEnum 436 = Key
KeyFrameback
  toEnum 437 = Key
KeyFrameforward
  toEnum 438 = Key
KeyContextMenu
  toEnum 439 = Key
KeyMediaRepeat
  toEnum 440 = Key
Key10channelsup
  toEnum 441 = Key
Key10channelsdown
  toEnum 442 = Key
KeyImages
  toEnum 448 = Key
KeyDelEol
  toEnum 449 = Key
KeyDelEos
  toEnum 450 = Key
KeyInsLine
  toEnum 451 = Key
KeyDelLine
  toEnum 464 = Key
KeyFn
  toEnum 465 = Key
KeyFnEsc
  toEnum 466 = Key
KeyFnF1
  toEnum 467 = Key
KeyFnF2
  toEnum 468 = Key
KeyFnF3
  toEnum 469 = Key
KeyFnF4
  toEnum 470 = Key
KeyFnF5
  toEnum 471 = Key
KeyFnF6
  toEnum 472 = Key
KeyFnF7
  toEnum 473 = Key
KeyFnF8
  toEnum 474 = Key
KeyFnF9
  toEnum 475 = Key
KeyFnF10
  toEnum 476 = Key
KeyFnF11
  toEnum 477 = Key
KeyFnF12
  toEnum 478 = Key
KeyFn1
  toEnum 479 = Key
KeyFn2
  toEnum 480 = Key
KeyFnD
  toEnum 481 = Key
KeyFnE
  toEnum 482 = Key
KeyFnF
  toEnum 483 = Key
KeyFnS
  toEnum 484 = Key
KeyFnB
  toEnum 497 = Key
KeyBrlDot1
  toEnum 498 = Key
KeyBrlDot2
  toEnum 499 = Key
KeyBrlDot3
  toEnum 500 = Key
KeyBrlDot4
  toEnum 501 = Key
KeyBrlDot5
  toEnum 502 = Key
KeyBrlDot6
  toEnum 503 = Key
KeyBrlDot7
  toEnum 504 = Key
KeyBrlDot8
  toEnum 505 = Key
KeyBrlDot9
  toEnum 506 = Key
KeyBrlDot10
  toEnum 512 = Key
KeyNumeric0
  toEnum 513 = Key
KeyNumeric1
  toEnum 514 = Key
KeyNumeric2
  toEnum 515 = Key
KeyNumeric3
  toEnum 516 = Key
KeyNumeric4
  toEnum 517 = Key
KeyNumeric5
  toEnum 518 = Key
KeyNumeric6
  toEnum 519 = Key
KeyNumeric7
  toEnum 520 = Key
KeyNumeric8
  toEnum 521 = Key
KeyNumeric9
  toEnum 522 = Key
KeyNumericStar
  toEnum 523 = Key
KeyNumericPound
  toEnum 524 = Key
KeyNumericA
  toEnum 525 = Key
KeyNumericB
  toEnum 526 = Key
KeyNumericC
  toEnum 527 = Key
KeyNumericD
  toEnum 528 = Key
KeyCameraFocus
  toEnum 529 = Key
KeyWpsButton
  toEnum 530 = Key
KeyTouchpadToggle
  toEnum 531 = Key
KeyTouchpadOn
  toEnum 532 = Key
KeyTouchpadOff
  toEnum 533 = Key
KeyCameraZoomin
  toEnum 534 = Key
KeyCameraZoomout
  toEnum 535 = Key
KeyCameraUp
  toEnum 536 = Key
KeyCameraDown
  toEnum 537 = Key
KeyCameraLeft
  toEnum 538 = Key
KeyCameraRight
  toEnum 539 = Key
KeyAttendantOn
  toEnum 540 = Key
KeyAttendantOff
  toEnum 541 = Key
KeyAttendantToggle
  toEnum 542 = Key
KeyLightsToggle
  toEnum 544 = Key
BtnDpadUp
  toEnum 545 = Key
BtnDpadDown
  toEnum 546 = Key
BtnDpadLeft
  toEnum 547 = Key
BtnDpadRight
  toEnum 560 = Key
KeyAlsToggle
  toEnum 576 = Key
KeyButtonconfig
  toEnum 577 = Key
KeyTaskmanager
  toEnum 578 = Key
KeyJournal
  toEnum 579 = Key
KeyControlpanel
  toEnum 580 = Key
KeyAppselect
  toEnum 581 = Key
KeyScreensaver
  toEnum 582 = Key
KeyVoicecommand
  toEnum 592 = Key
KeyBrightnessMin
  toEnum 593 = Key
KeyBrightnessMax
  toEnum 608 = Key
KeyKbdinputassistPrev
  toEnum 609 = Key
KeyKbdinputassistNext
  toEnum 610 = Key
KeyKbdinputassistPrevgroup
  toEnum 611 = Key
KeyKbdinputassistNextgroup
  toEnum 612 = Key
KeyKbdinputassistAccept
  toEnum 613 = Key
KeyKbdinputassistCancel
  toEnum 704 = Key
BtnTriggerHappy
  toEnum 705 = Key
BtnTriggerHappy2
  toEnum 706 = Key
BtnTriggerHappy3
  toEnum 707 = Key
BtnTriggerHappy4
  toEnum 708 = Key
BtnTriggerHappy5
  toEnum 709 = Key
BtnTriggerHappy6
  toEnum 710 = Key
BtnTriggerHappy7
  toEnum 711 = Key
BtnTriggerHappy8
  toEnum 712 = Key
BtnTriggerHappy9
  toEnum 713 = Key
BtnTriggerHappy10
  toEnum 714 = Key
BtnTriggerHappy11
  toEnum 715 = Key
BtnTriggerHappy12
  toEnum 716 = Key
BtnTriggerHappy13
  toEnum 717 = Key
BtnTriggerHappy14
  toEnum 718 = Key
BtnTriggerHappy15
  toEnum 719 = Key
BtnTriggerHappy16
  toEnum 720 = Key
BtnTriggerHappy17
  toEnum 721 = Key
BtnTriggerHappy18
  toEnum 722 = Key
BtnTriggerHappy19
  toEnum 723 = Key
BtnTriggerHappy20
  toEnum 724 = Key
BtnTriggerHappy21
  toEnum 725 = Key
BtnTriggerHappy22
  toEnum 726 = Key
BtnTriggerHappy23
  toEnum 727 = Key
BtnTriggerHappy24
  toEnum 728 = Key
BtnTriggerHappy25
  toEnum 729 = Key
BtnTriggerHappy26
  toEnum 730 = Key
BtnTriggerHappy27
  toEnum 731 = Key
BtnTriggerHappy28
  toEnum 732 = Key
BtnTriggerHappy29
  toEnum 733 = Key
BtnTriggerHappy30
  toEnum 734 = Key
BtnTriggerHappy31
  toEnum 735 = Key
BtnTriggerHappy32
  toEnum 736 = Key
BtnTriggerHappy33
  toEnum 737 = Key
BtnTriggerHappy34
  toEnum 738 = Key
BtnTriggerHappy35
  toEnum 739 = Key
BtnTriggerHappy36
  toEnum 740 = Key
BtnTriggerHappy37
  toEnum 741 = Key
BtnTriggerHappy38
  toEnum 742 = Key
BtnTriggerHappy39
  toEnum 743 = Key
BtnTriggerHappy40
  toEnum unmatched :: Int
unmatched = String -> Key
forall a. HasCallStack => String -> a
error ("Key.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
unmatched)

{-# LINE 578 "src/Evdev/Codes.chs" #-}


data RelativeAxis = RelX
                  | RelY
                  | RelZ
                  | RelRx
                  | RelRy
                  | RelRz
                  | RelHwheel
                  | RelDial
                  | RelWheel
                  | RelMisc
  deriving (Bounded,Eq,Ord,Read,Show)
instance Enum RelativeAxis where
  succ RelX = RelY
  succ RelY = RelZ
  succ RelZ = RelRx
  succ RelRx = RelRy
  succ RelRy = RelRz
  succ RelRz = RelHwheel
  succ RelHwheel = RelDial
  succ RelDial = RelWheel
  succ RelWheel = RelMisc
  succ RelMisc = error "RelativeAxis.succ: RelMisc has no successor"

  pred RelY = RelX
  pred RelZ = RelY
  pred RelRx = RelZ
  pred RelRy = RelRx
  pred RelRz = RelRy
  pred RelHwheel = RelRz
  pred RelDial = RelHwheel
  pred RelWheel = RelDial
  pred RelMisc = RelWheel
  pred RelX = error "RelativeAxis.pred: RelX has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from RelMisc

  fromEnum RelX = 0
  fromEnum RelY = 1
  fromEnum RelZ = 2
  fromEnum RelRx = 3
  fromEnum RelRy = 4
  fromEnum RelRz = 5
  fromEnum RelHwheel = 6
  fromEnum RelDial = 7
  fromEnum RelWheel = 8
  fromEnum RelMisc = 9

  toEnum 0 = RelX
  toEnum 1 = RelY
  toEnum 2 = RelZ
  toEnum 3 = RelRx
  toEnum 4 = RelRy
  toEnum 5 = RelRz
  toEnum 6 = RelHwheel
  toEnum 7 = RelDial
  toEnum 8 = RelWheel
  toEnum 9 = RelMisc
  toEnum unmatched = error ("RelativeAxis.toEnum: Cannot match " ++ show unmatched)

{-# LINE 591 "src/Evdev/Codes.chs" #-}


data AbsoluteAxis = AbsX
                  | AbsY
                  | AbsZ
                  | AbsRx
                  | AbsRy
                  | AbsRz
                  | AbsThrottle
                  | AbsRudder
                  | AbsWheel
                  | AbsGas
                  | AbsBrake
                  | AbsHat0x
                  | AbsHat0y
                  | AbsHat1x
                  | AbsHat1y
                  | AbsHat2x
                  | AbsHat2y
                  | AbsHat3x
                  | AbsHat3y
                  | AbsPressure
                  | AbsDistance
                  | AbsTiltX
                  | AbsTiltY
                  | AbsToolWidth
                  | AbsVolume
                  | AbsMisc
                  | AbsReserved
                  | AbsMtSlot
                  | AbsMtTouchMajor
                  | AbsMtTouchMinor
                  | AbsMtWidthMajor
                  | AbsMtWidthMinor
                  | AbsMtOrientation
                  | AbsMtPositionX
                  | AbsMtPositionY
                  | AbsMtToolType
                  | AbsMtBlobId
                  | AbsMtTrackingId
                  | AbsMtPressure
                  | AbsMtDistance
                  | AbsMtToolX
                  | AbsMtToolY
  deriving (Bounded,Eq,Ord,Read,Show)
instance Enum AbsoluteAxis where
  succ AbsX = AbsY
  succ AbsY = AbsZ
  succ AbsZ = AbsRx
  succ AbsRx = AbsRy
  succ AbsRy = AbsRz
  succ AbsRz = AbsThrottle
  succ AbsThrottle = AbsRudder
  succ AbsRudder = AbsWheel
  succ AbsWheel = AbsGas
  succ AbsGas = AbsBrake
  succ AbsBrake = AbsHat0x
  succ AbsHat0x = AbsHat0y
  succ AbsHat0y = AbsHat1x
  succ AbsHat1x = AbsHat1y
  succ AbsHat1y = AbsHat2x
  succ AbsHat2x = AbsHat2y
  succ AbsHat2y = AbsHat3x
  succ AbsHat3x = AbsHat3y
  succ AbsHat3y = AbsPressure
  succ AbsPressure = AbsDistance
  succ AbsDistance = AbsTiltX
  succ AbsTiltX = AbsTiltY
  succ AbsTiltY = AbsToolWidth
  succ AbsToolWidth = AbsVolume
  succ AbsVolume = AbsMisc
  succ AbsMisc = AbsReserved
  succ AbsReserved = AbsMtSlot
  succ AbsMtSlot = AbsMtTouchMajor
  succ AbsMtTouchMajor = AbsMtTouchMinor
  succ AbsMtTouchMinor = AbsMtWidthMajor
  succ AbsMtWidthMajor = AbsMtWidthMinor
  succ AbsMtWidthMinor = AbsMtOrientation
  succ AbsMtOrientation = AbsMtPositionX
  succ AbsMtPositionX = AbsMtPositionY
  succ AbsMtPositionY = AbsMtToolType
  succ AbsMtToolType = AbsMtBlobId
  succ AbsMtBlobId = AbsMtTrackingId
  succ AbsMtTrackingId = AbsMtPressure
  succ AbsMtPressure = AbsMtDistance
  succ AbsMtDistance = AbsMtToolX
  succ AbsMtToolX = AbsMtToolY
  succ AbsMtToolY = error "AbsoluteAxis.succ: AbsMtToolY has no successor"

  pred AbsY = AbsX
  pred AbsZ = AbsY
  pred AbsRx = AbsZ
  pred AbsRy = AbsRx
  pred AbsRz = AbsRy
  pred AbsThrottle = AbsRz
  pred AbsRudder = AbsThrottle
  pred AbsWheel = AbsRudder
  pred AbsGas = AbsWheel
  pred AbsBrake = AbsGas
  pred AbsHat0x = AbsBrake
  pred AbsHat0y = AbsHat0x
  pred AbsHat1x = AbsHat0y
  pred AbsHat1y = AbsHat1x
  pred AbsHat2x = AbsHat1y
  pred AbsHat2y = AbsHat2x
  pred AbsHat3x = AbsHat2y
  pred AbsHat3y = AbsHat3x
  pred AbsPressure = AbsHat3y
  pred AbsDistance = AbsPressure
  pred AbsTiltX = AbsDistance
  pred AbsTiltY = AbsTiltX
  pred AbsToolWidth = AbsTiltY
  pred AbsVolume = AbsToolWidth
  pred AbsMisc = AbsVolume
  pred AbsReserved = AbsMisc
  pred AbsMtSlot = AbsReserved
  pred AbsMtTouchMajor = AbsMtSlot
  pred AbsMtTouchMinor = AbsMtTouchMajor
  pred AbsMtWidthMajor = AbsMtTouchMinor
  pred AbsMtWidthMinor = AbsMtWidthMajor
  pred AbsMtOrientation = AbsMtWidthMinor
  pred AbsMtPositionX = AbsMtOrientation
  pred AbsMtPositionY = AbsMtPositionX
  pred AbsMtToolType = AbsMtPositionY
  pred AbsMtBlobId = AbsMtToolType
  pred AbsMtTrackingId = AbsMtBlobId
  pred AbsMtPressure = AbsMtTrackingId
  pred AbsMtDistance = AbsMtPressure
  pred AbsMtToolX = AbsMtDistance
  pred AbsMtToolY = AbsMtToolX
  pred AbsX = error "AbsoluteAxis.pred: AbsX has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from AbsMtToolY

  fromEnum AbsX = 0
  fromEnum AbsY = 1
  fromEnum AbsZ = 2
  fromEnum AbsRx = 3
  fromEnum AbsRy = 4
  fromEnum AbsRz = 5
  fromEnum AbsThrottle = 6
  fromEnum AbsRudder = 7
  fromEnum AbsWheel = 8
  fromEnum AbsGas = 9
  fromEnum AbsBrake = 10
  fromEnum AbsHat0x = 16
  fromEnum AbsHat0y = 17
  fromEnum AbsHat1x = 18
  fromEnum AbsHat1y = 19
  fromEnum AbsHat2x = 20
  fromEnum AbsHat2y = 21
  fromEnum AbsHat3x = 22
  fromEnum AbsHat3y = 23
  fromEnum AbsPressure = 24
  fromEnum AbsDistance = 25
  fromEnum AbsTiltX = 26
  fromEnum AbsTiltY = 27
  fromEnum AbsToolWidth = 28
  fromEnum AbsVolume = 32
  fromEnum AbsMisc = 40
  fromEnum AbsReserved = 46
  fromEnum AbsMtSlot = 47
  fromEnum AbsMtTouchMajor = 48
  fromEnum AbsMtTouchMinor = 49
  fromEnum AbsMtWidthMajor = 50
  fromEnum AbsMtWidthMinor = 51
  fromEnum AbsMtOrientation = 52
  fromEnum AbsMtPositionX = 53
  fromEnum AbsMtPositionY = 54
  fromEnum AbsMtToolType = 55
  fromEnum AbsMtBlobId = 56
  fromEnum AbsMtTrackingId = 57
  fromEnum AbsMtPressure = 58
  fromEnum AbsMtDistance = 59
  fromEnum AbsMtToolX = 60
  fromEnum AbsMtToolY = 61

  toEnum 0 = AbsX
  toEnum 1 = AbsY
  toEnum 2 = AbsZ
  toEnum 3 = AbsRx
  toEnum 4 = AbsRy
  toEnum 5 = AbsRz
  toEnum 6 = AbsThrottle
  toEnum 7 = AbsRudder
  toEnum 8 = AbsWheel
  toEnum 9 = AbsGas
  toEnum 10 = AbsBrake
  toEnum 16 = AbsHat0x
  toEnum 17 = AbsHat0y
  toEnum 18 = AbsHat1x
  toEnum 19 = AbsHat1y
  toEnum 20 = AbsHat2x
  toEnum 21 = AbsHat2y
  toEnum 22 = AbsHat3x
  toEnum 23 = AbsHat3y
  toEnum 24 = AbsPressure
  toEnum 25 = AbsDistance
  toEnum 26 = AbsTiltX
  toEnum 27 = AbsTiltY
  toEnum 28 = AbsToolWidth
  toEnum 32 = AbsVolume
  toEnum 40 = AbsMisc
  toEnum 46 = AbsReserved
  toEnum 47 = AbsMtSlot
  toEnum 48 = AbsMtTouchMajor
  toEnum 49 = AbsMtTouchMinor
  toEnum 50 = AbsMtWidthMajor
  toEnum 51 = AbsMtWidthMinor
  toEnum 52 = AbsMtOrientation
  toEnum 53 = AbsMtPositionX
  toEnum 54 = AbsMtPositionY
  toEnum 55 = AbsMtToolType
  toEnum 56 = AbsMtBlobId
  toEnum 57 = AbsMtTrackingId
  toEnum 58 = AbsMtPressure
  toEnum 59 = AbsMtDistance
  toEnum 60 = AbsMtToolX
  toEnum 61 = AbsMtToolY
  toEnum unmatched = error ("AbsoluteAxis.toEnum: Cannot match " ++ show unmatched)

{-# LINE 636 "src/Evdev/Codes.chs" #-}


data SwitchEventType = SwLid
                     | SwTabletMode
                     | SwHeadphoneInsert
                     | SwRfkillAll
                     | SwRadio
                     | SwMicrophoneInsert
                     | SwDock
                     | SwLineoutInsert
                     | SwJackPhysicalInsert
                     | SwVideooutInsert
                     | SwCameraLensCover
                     | SwKeypadSlide
                     | SwFrontProximity
                     | SwRotateLock
                     | SwLineinInsert
                     | SwMuteDevice
  deriving (Bounded,Eq,Ord,Read,Show)
instance Enum SwitchEventType where
  succ SwLid = SwTabletMode
  succ SwTabletMode = SwHeadphoneInsert
  succ SwHeadphoneInsert = SwRfkillAll
  succ SwRfkillAll = SwMicrophoneInsert
  succ SwRadio = SwMicrophoneInsert
  succ SwMicrophoneInsert = SwDock
  succ SwDock = SwLineoutInsert
  succ SwLineoutInsert = SwJackPhysicalInsert
  succ SwJackPhysicalInsert = SwVideooutInsert
  succ SwVideooutInsert = SwCameraLensCover
  succ SwCameraLensCover = SwKeypadSlide
  succ SwKeypadSlide = SwFrontProximity
  succ SwFrontProximity = SwRotateLock
  succ SwRotateLock = SwLineinInsert
  succ SwLineinInsert = SwMuteDevice
  succ SwMuteDevice = error "SwitchEventType.succ: SwMuteDevice has no successor"

  pred SwTabletMode = SwLid
  pred SwHeadphoneInsert = SwTabletMode
  pred SwRfkillAll = SwHeadphoneInsert
  pred SwRadio = SwHeadphoneInsert
  pred SwMicrophoneInsert = SwRfkillAll
  pred SwDock = SwMicrophoneInsert
  pred SwLineoutInsert = SwDock
  pred SwJackPhysicalInsert = SwLineoutInsert
  pred SwVideooutInsert = SwJackPhysicalInsert
  pred SwCameraLensCover = SwVideooutInsert
  pred SwKeypadSlide = SwCameraLensCover
  pred SwFrontProximity = SwKeypadSlide
  pred SwRotateLock = SwFrontProximity
  pred SwLineinInsert = SwRotateLock
  pred SwMuteDevice = SwLineinInsert
  pred SwLid = error "SwitchEventType.pred: SwLid has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from SwMuteDevice

  fromEnum SwLid = 0
  fromEnum SwTabletMode = 1
  fromEnum SwHeadphoneInsert = 2
  fromEnum SwRfkillAll = 3
  fromEnum SwRadio = 3
  fromEnum SwMicrophoneInsert = 4
  fromEnum SwDock = 5
  fromEnum SwLineoutInsert = 6
  fromEnum SwJackPhysicalInsert = 7
  fromEnum SwVideooutInsert = 8
  fromEnum SwCameraLensCover = 9
  fromEnum SwKeypadSlide = 10
  fromEnum SwFrontProximity = 11
  fromEnum SwRotateLock = 12
  fromEnum SwLineinInsert = 13
  fromEnum SwMuteDevice = 14

  toEnum 0 = SwLid
  toEnum 1 = SwTabletMode
  toEnum 2 = SwHeadphoneInsert
  toEnum 3 = SwRfkillAll
  toEnum 4 = SwMicrophoneInsert
  toEnum 5 = SwDock
  toEnum 6 = SwLineoutInsert
  toEnum 7 = SwJackPhysicalInsert
  toEnum 8 = SwVideooutInsert
  toEnum 9 = SwCameraLensCover
  toEnum 10 = SwKeypadSlide
  toEnum 11 = SwFrontProximity
  toEnum 12 = SwRotateLock
  toEnum 13 = SwLineinInsert
  toEnum 14 = SwMuteDevice
  toEnum unmatched = error ("SwitchEventType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 655 "src/Evdev/Codes.chs" #-}


data MiscEventType = MscSerial
                   | MscPulseled
                   | MscGesture
                   | MscRaw
                   | MscScan
                   | MscTimestamp
  deriving (Bounded,Eq,Ord,Read,Show)
instance Enum MiscEventType where
  succ MscSerial = MscPulseled
  succ MscPulseled = MscGesture
  succ MscGesture = MscRaw
  succ MscRaw = MscScan
  succ MscScan = MscTimestamp
  succ MscTimestamp = error "MiscEventType.succ: MscTimestamp has no successor"

  pred MscPulseled = MscSerial
  pred MscGesture = MscPulseled
  pred MscRaw = MscGesture
  pred MscScan = MscRaw
  pred MscTimestamp = MscScan
  pred MscSerial = error "MiscEventType.pred: MscSerial has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from MscTimestamp

  fromEnum MscSerial = 0
  fromEnum MscPulseled = 1
  fromEnum MscGesture = 2
  fromEnum MscRaw = 3
  fromEnum MscScan = 4
  fromEnum MscTimestamp = 5

  toEnum 0 = MscSerial
  toEnum 1 = MscPulseled
  toEnum 2 = MscGesture
  toEnum 3 = MscRaw
  toEnum 4 = MscScan
  toEnum 5 = MscTimestamp
  toEnum unmatched = error ("MiscEventType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 664 "src/Evdev/Codes.chs" #-}


data LEDEventType = LedNuml
                  | LedCapsl
                  | LedScrolll
                  | LedCompose
                  | LedKana
                  | LedSleep
                  | LedSuspend
                  | LedMute
                  | LedMisc
                  | LedMail
                  | LedCharging
  deriving (Bounded,Eq,Ord,Read,Show)
instance Enum LEDEventType where
  succ LedNuml = LedCapsl
  succ LedCapsl = LedScrolll
  succ LedScrolll = LedCompose
  succ LedCompose = LedKana
  succ LedKana = LedSleep
  succ LedSleep = LedSuspend
  succ LedSuspend = LedMute
  succ LedMute = LedMisc
  succ LedMisc = LedMail
  succ LedMail = LedCharging
  succ LedCharging = error "LEDEventType.succ: LedCharging has no successor"

  pred LedCapsl = LedNuml
  pred LedScrolll = LedCapsl
  pred LedCompose = LedScrolll
  pred LedKana = LedCompose
  pred LedSleep = LedKana
  pred LedSuspend = LedSleep
  pred LedMute = LedSuspend
  pred LedMisc = LedMute
  pred LedMail = LedMisc
  pred LedCharging = LedMail
  pred LedNuml = error "LEDEventType.pred: LedNuml has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from LedCharging

  fromEnum LedNuml = 0
  fromEnum LedCapsl = 1
  fromEnum LedScrolll = 2
  fromEnum LedCompose = 3
  fromEnum LedKana = 4
  fromEnum LedSleep = 5
  fromEnum LedSuspend = 6
  fromEnum LedMute = 7
  fromEnum LedMisc = 8
  fromEnum LedMail = 9
  fromEnum LedCharging = 10

  toEnum 0 = LedNuml
  toEnum 1 = LedCapsl
  toEnum 2 = LedScrolll
  toEnum 3 = LedCompose
  toEnum 4 = LedKana
  toEnum 5 = LedSleep
  toEnum 6 = LedSuspend
  toEnum 7 = LedMute
  toEnum 8 = LedMisc
  toEnum 9 = LedMail
  toEnum 10 = LedCharging
  toEnum unmatched = error ("LEDEventType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 678 "src/Evdev/Codes.chs" #-}


data RepeatEventType = RepDelay
                     | RepPeriod
  deriving (Bounded,Eq,Ord,Read,Show)
instance Enum RepeatEventType where
  succ RepDelay = RepPeriod
  succ RepPeriod = error "RepeatEventType.succ: RepPeriod has no successor"

  pred RepPeriod = RepDelay
  pred RepDelay = error "RepeatEventType.pred: RepDelay has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from RepPeriod

  fromEnum RepDelay = 0
  fromEnum RepPeriod = 1

  toEnum 0 = RepDelay
  toEnum 1 = RepPeriod
  toEnum unmatched = error ("RepeatEventType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 683 "src/Evdev/Codes.chs" #-}


data SoundEventType = SndClick
                    | SndBell
                    | SndTone
  deriving (Bounded,Eq,Ord,Read,Show)
instance Enum SoundEventType where
  succ SndClick = SndBell
  succ SndBell = SndTone
  succ SndTone = error "SoundEventType.succ: SndTone has no successor"

  pred SndBell = SndClick
  pred SndTone = SndBell
  pred SndClick = error "SoundEventType.pred: SndClick has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from SndTone

  fromEnum SndClick = 0
  fromEnum SndBell = 1
  fromEnum SndTone = 2

  toEnum 0 = SndClick
  toEnum 1 = SndBell
  toEnum 2 = SndTone
  toEnum unmatched = error ("SoundEventType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 689 "src/Evdev/Codes.chs" #-}