{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module: WildBind.Input.NumPad
-- Description: Types about number pads
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- Input types for number pad keys.
module WildBind.Input.NumPad
       ( -- * NumLock disabled
         NumPadUnlocked(..),
         -- * NumLock enabled
         NumPadLocked(..),
       ) where

import WildBind.Description (Describable(describe))

-- | Number pad key input with NumLock disabled.
data NumPadUnlocked
  = NumInsert
  | NumEnd
  | NumDown
  | NumPageDown
  | NumLeft
  | NumCenter
  | NumRight
  | NumHome
  | NumUp
  | NumPageUp
  | NumDivide
  | NumMulti
  | NumMinus
  | NumPlus
  | NumEnter
  | NumDelete
  deriving (NumPadUnlocked -> NumPadUnlocked -> Bool
(NumPadUnlocked -> NumPadUnlocked -> Bool)
-> (NumPadUnlocked -> NumPadUnlocked -> Bool) -> Eq NumPadUnlocked
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumPadUnlocked -> NumPadUnlocked -> Bool
$c/= :: NumPadUnlocked -> NumPadUnlocked -> Bool
== :: NumPadUnlocked -> NumPadUnlocked -> Bool
$c== :: NumPadUnlocked -> NumPadUnlocked -> Bool
Eq,Eq NumPadUnlocked
Eq NumPadUnlocked
-> (NumPadUnlocked -> NumPadUnlocked -> Ordering)
-> (NumPadUnlocked -> NumPadUnlocked -> Bool)
-> (NumPadUnlocked -> NumPadUnlocked -> Bool)
-> (NumPadUnlocked -> NumPadUnlocked -> Bool)
-> (NumPadUnlocked -> NumPadUnlocked -> Bool)
-> (NumPadUnlocked -> NumPadUnlocked -> NumPadUnlocked)
-> (NumPadUnlocked -> NumPadUnlocked -> NumPadUnlocked)
-> Ord NumPadUnlocked
NumPadUnlocked -> NumPadUnlocked -> Bool
NumPadUnlocked -> NumPadUnlocked -> Ordering
NumPadUnlocked -> NumPadUnlocked -> NumPadUnlocked
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 :: NumPadUnlocked -> NumPadUnlocked -> NumPadUnlocked
$cmin :: NumPadUnlocked -> NumPadUnlocked -> NumPadUnlocked
max :: NumPadUnlocked -> NumPadUnlocked -> NumPadUnlocked
$cmax :: NumPadUnlocked -> NumPadUnlocked -> NumPadUnlocked
>= :: NumPadUnlocked -> NumPadUnlocked -> Bool
$c>= :: NumPadUnlocked -> NumPadUnlocked -> Bool
> :: NumPadUnlocked -> NumPadUnlocked -> Bool
$c> :: NumPadUnlocked -> NumPadUnlocked -> Bool
<= :: NumPadUnlocked -> NumPadUnlocked -> Bool
$c<= :: NumPadUnlocked -> NumPadUnlocked -> Bool
< :: NumPadUnlocked -> NumPadUnlocked -> Bool
$c< :: NumPadUnlocked -> NumPadUnlocked -> Bool
compare :: NumPadUnlocked -> NumPadUnlocked -> Ordering
$ccompare :: NumPadUnlocked -> NumPadUnlocked -> Ordering
$cp1Ord :: Eq NumPadUnlocked
Ord,Int -> NumPadUnlocked -> ShowS
[NumPadUnlocked] -> ShowS
NumPadUnlocked -> String
(Int -> NumPadUnlocked -> ShowS)
-> (NumPadUnlocked -> String)
-> ([NumPadUnlocked] -> ShowS)
-> Show NumPadUnlocked
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumPadUnlocked] -> ShowS
$cshowList :: [NumPadUnlocked] -> ShowS
show :: NumPadUnlocked -> String
$cshow :: NumPadUnlocked -> String
showsPrec :: Int -> NumPadUnlocked -> ShowS
$cshowsPrec :: Int -> NumPadUnlocked -> ShowS
Show,NumPadUnlocked
NumPadUnlocked -> NumPadUnlocked -> Bounded NumPadUnlocked
forall a. a -> a -> Bounded a
maxBound :: NumPadUnlocked
$cmaxBound :: NumPadUnlocked
minBound :: NumPadUnlocked
$cminBound :: NumPadUnlocked
Bounded,Int -> NumPadUnlocked
NumPadUnlocked -> Int
NumPadUnlocked -> [NumPadUnlocked]
NumPadUnlocked -> NumPadUnlocked
NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked]
NumPadUnlocked
-> NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked]
(NumPadUnlocked -> NumPadUnlocked)
-> (NumPadUnlocked -> NumPadUnlocked)
-> (Int -> NumPadUnlocked)
-> (NumPadUnlocked -> Int)
-> (NumPadUnlocked -> [NumPadUnlocked])
-> (NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked])
-> (NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked])
-> (NumPadUnlocked
    -> NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked])
-> Enum NumPadUnlocked
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NumPadUnlocked
-> NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked]
$cenumFromThenTo :: NumPadUnlocked
-> NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked]
enumFromTo :: NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked]
$cenumFromTo :: NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked]
enumFromThen :: NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked]
$cenumFromThen :: NumPadUnlocked -> NumPadUnlocked -> [NumPadUnlocked]
enumFrom :: NumPadUnlocked -> [NumPadUnlocked]
$cenumFrom :: NumPadUnlocked -> [NumPadUnlocked]
fromEnum :: NumPadUnlocked -> Int
$cfromEnum :: NumPadUnlocked -> Int
toEnum :: Int -> NumPadUnlocked
$ctoEnum :: Int -> NumPadUnlocked
pred :: NumPadUnlocked -> NumPadUnlocked
$cpred :: NumPadUnlocked -> NumPadUnlocked
succ :: NumPadUnlocked -> NumPadUnlocked
$csucc :: NumPadUnlocked -> NumPadUnlocked
Enum)

instance Describable NumPadUnlocked where
  describe :: NumPadUnlocked -> ActionDescription
describe NumPadUnlocked
input = case NumPadUnlocked
input of
    NumPadUnlocked
NumHome -> ActionDescription
"Home"
    NumPadUnlocked
NumUp -> ActionDescription
"↑"
    NumPadUnlocked
NumPageUp -> ActionDescription
"PageUp"
    NumPadUnlocked
NumLeft -> ActionDescription
"←"
    NumPadUnlocked
NumCenter -> ActionDescription
""
    NumPadUnlocked
NumRight -> ActionDescription
"→"
    NumPadUnlocked
NumEnd -> ActionDescription
"End"
    NumPadUnlocked
NumDown -> ActionDescription
"↓"
    NumPadUnlocked
NumPageDown -> ActionDescription
"PageDown"
    NumPadUnlocked
NumDivide -> ActionDescription
"/"
    NumPadUnlocked
NumMulti -> ActionDescription
"*"
    NumPadUnlocked
NumMinus -> ActionDescription
"-"
    NumPadUnlocked
NumPlus -> ActionDescription
"+"
    NumPadUnlocked
NumEnter -> ActionDescription
"Enter"
    NumPadUnlocked
NumInsert -> ActionDescription
"Insert"
    NumPadUnlocked
NumDelete -> ActionDescription
"Delete"


-- | Number pad key input with NumLock enabled.
data NumPadLocked
  = NumL0
  | NumL1
  | NumL2
  | NumL3
  | NumL4
  | NumL5
  | NumL6
  | NumL7
  | NumL8
  | NumL9
  | NumLDivide
  | NumLMulti
  | NumLMinus
  | NumLPlus
  | NumLEnter
  | NumLPeriod
  deriving (NumPadLocked -> NumPadLocked -> Bool
(NumPadLocked -> NumPadLocked -> Bool)
-> (NumPadLocked -> NumPadLocked -> Bool) -> Eq NumPadLocked
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumPadLocked -> NumPadLocked -> Bool
$c/= :: NumPadLocked -> NumPadLocked -> Bool
== :: NumPadLocked -> NumPadLocked -> Bool
$c== :: NumPadLocked -> NumPadLocked -> Bool
Eq,Eq NumPadLocked
Eq NumPadLocked
-> (NumPadLocked -> NumPadLocked -> Ordering)
-> (NumPadLocked -> NumPadLocked -> Bool)
-> (NumPadLocked -> NumPadLocked -> Bool)
-> (NumPadLocked -> NumPadLocked -> Bool)
-> (NumPadLocked -> NumPadLocked -> Bool)
-> (NumPadLocked -> NumPadLocked -> NumPadLocked)
-> (NumPadLocked -> NumPadLocked -> NumPadLocked)
-> Ord NumPadLocked
NumPadLocked -> NumPadLocked -> Bool
NumPadLocked -> NumPadLocked -> Ordering
NumPadLocked -> NumPadLocked -> NumPadLocked
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 :: NumPadLocked -> NumPadLocked -> NumPadLocked
$cmin :: NumPadLocked -> NumPadLocked -> NumPadLocked
max :: NumPadLocked -> NumPadLocked -> NumPadLocked
$cmax :: NumPadLocked -> NumPadLocked -> NumPadLocked
>= :: NumPadLocked -> NumPadLocked -> Bool
$c>= :: NumPadLocked -> NumPadLocked -> Bool
> :: NumPadLocked -> NumPadLocked -> Bool
$c> :: NumPadLocked -> NumPadLocked -> Bool
<= :: NumPadLocked -> NumPadLocked -> Bool
$c<= :: NumPadLocked -> NumPadLocked -> Bool
< :: NumPadLocked -> NumPadLocked -> Bool
$c< :: NumPadLocked -> NumPadLocked -> Bool
compare :: NumPadLocked -> NumPadLocked -> Ordering
$ccompare :: NumPadLocked -> NumPadLocked -> Ordering
$cp1Ord :: Eq NumPadLocked
Ord,Int -> NumPadLocked -> ShowS
[NumPadLocked] -> ShowS
NumPadLocked -> String
(Int -> NumPadLocked -> ShowS)
-> (NumPadLocked -> String)
-> ([NumPadLocked] -> ShowS)
-> Show NumPadLocked
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumPadLocked] -> ShowS
$cshowList :: [NumPadLocked] -> ShowS
show :: NumPadLocked -> String
$cshow :: NumPadLocked -> String
showsPrec :: Int -> NumPadLocked -> ShowS
$cshowsPrec :: Int -> NumPadLocked -> ShowS
Show,NumPadLocked
NumPadLocked -> NumPadLocked -> Bounded NumPadLocked
forall a. a -> a -> Bounded a
maxBound :: NumPadLocked
$cmaxBound :: NumPadLocked
minBound :: NumPadLocked
$cminBound :: NumPadLocked
Bounded,Int -> NumPadLocked
NumPadLocked -> Int
NumPadLocked -> [NumPadLocked]
NumPadLocked -> NumPadLocked
NumPadLocked -> NumPadLocked -> [NumPadLocked]
NumPadLocked -> NumPadLocked -> NumPadLocked -> [NumPadLocked]
(NumPadLocked -> NumPadLocked)
-> (NumPadLocked -> NumPadLocked)
-> (Int -> NumPadLocked)
-> (NumPadLocked -> Int)
-> (NumPadLocked -> [NumPadLocked])
-> (NumPadLocked -> NumPadLocked -> [NumPadLocked])
-> (NumPadLocked -> NumPadLocked -> [NumPadLocked])
-> (NumPadLocked -> NumPadLocked -> NumPadLocked -> [NumPadLocked])
-> Enum NumPadLocked
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NumPadLocked -> NumPadLocked -> NumPadLocked -> [NumPadLocked]
$cenumFromThenTo :: NumPadLocked -> NumPadLocked -> NumPadLocked -> [NumPadLocked]
enumFromTo :: NumPadLocked -> NumPadLocked -> [NumPadLocked]
$cenumFromTo :: NumPadLocked -> NumPadLocked -> [NumPadLocked]
enumFromThen :: NumPadLocked -> NumPadLocked -> [NumPadLocked]
$cenumFromThen :: NumPadLocked -> NumPadLocked -> [NumPadLocked]
enumFrom :: NumPadLocked -> [NumPadLocked]
$cenumFrom :: NumPadLocked -> [NumPadLocked]
fromEnum :: NumPadLocked -> Int
$cfromEnum :: NumPadLocked -> Int
toEnum :: Int -> NumPadLocked
$ctoEnum :: Int -> NumPadLocked
pred :: NumPadLocked -> NumPadLocked
$cpred :: NumPadLocked -> NumPadLocked
succ :: NumPadLocked -> NumPadLocked
$csucc :: NumPadLocked -> NumPadLocked
Enum)

instance Describable NumPadLocked where
  describe :: NumPadLocked -> ActionDescription
describe NumPadLocked
input = case NumPadLocked
input of
    NumPadLocked
NumL0 -> ActionDescription
"0"
    NumPadLocked
NumL1 -> ActionDescription
"1"
    NumPadLocked
NumL2 -> ActionDescription
"2"
    NumPadLocked
NumL3 -> ActionDescription
"3"
    NumPadLocked
NumL4 -> ActionDescription
"4"
    NumPadLocked
NumL5 -> ActionDescription
"5"
    NumPadLocked
NumL6 -> ActionDescription
"6"
    NumPadLocked
NumL7 -> ActionDescription
"7"
    NumPadLocked
NumL8 -> ActionDescription
"8"
    NumPadLocked
NumL9 -> ActionDescription
"9"
    NumPadLocked
NumLDivide -> ActionDescription
"/"
    NumPadLocked
NumLMulti -> ActionDescription
"*"
    NumPadLocked
NumLMinus -> ActionDescription
"-"
    NumPadLocked
NumLPlus -> ActionDescription
"+"
    NumPadLocked
NumLEnter -> ActionDescription
"Enter"
    NumPadLocked
NumLPeriod -> ActionDescription
"."