{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}

module SDL.Input.GameController
  ( ControllerButton(..)
  , ControllerButtonState(..)
  , ControllerDeviceConnection(..)
  ) where

import Data.Data (Data)
import Data.Typeable
import Data.Word
import GHC.Generics (Generic)
import GHC.Int (Int32)
import SDL.Internal.Numbered
import qualified SDL.Raw as Raw

-- | Identifies a gamepad button.
data ControllerButton
  = ControllerButtonInvalid
  | ControllerButtonA
  | ControllerButtonB
  | ControllerButtonX
  | ControllerButtonY
  | ControllerButtonBack
  | ControllerButtonGuide
  | ControllerButtonStart
  | ControllerButtonLeftStick
  | ControllerButtonRightStick
  | ControllerButtonLeftShoulder
  | ControllerButtonRightShoulder
  | ControllerButtonDpadUp
  | ControllerButtonDpadDown
  | ControllerButtonDpadLeft
  | ControllerButtonDpadRight
  deriving (Typeable ControllerButton
DataType
Constr
Typeable ControllerButton =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ControllerButton -> c ControllerButton)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ControllerButton)
-> (ControllerButton -> Constr)
-> (ControllerButton -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ControllerButton))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ControllerButton))
-> ((forall b. Data b => b -> b)
    -> ControllerButton -> ControllerButton)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ControllerButton -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ControllerButton -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ControllerButton -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ControllerButton -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ControllerButton -> m ControllerButton)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ControllerButton -> m ControllerButton)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ControllerButton -> m ControllerButton)
-> Data ControllerButton
ControllerButton -> DataType
ControllerButton -> Constr
(forall b. Data b => b -> b)
-> ControllerButton -> ControllerButton
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ControllerButton -> c ControllerButton
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerButton
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ControllerButton -> u
forall u. (forall d. Data d => d -> u) -> ControllerButton -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButton -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButton -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerButton
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ControllerButton -> c ControllerButton
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ControllerButton)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerButton)
$cControllerButtonDpadRight :: Constr
$cControllerButtonDpadLeft :: Constr
$cControllerButtonDpadDown :: Constr
$cControllerButtonDpadUp :: Constr
$cControllerButtonRightShoulder :: Constr
$cControllerButtonLeftShoulder :: Constr
$cControllerButtonRightStick :: Constr
$cControllerButtonLeftStick :: Constr
$cControllerButtonStart :: Constr
$cControllerButtonGuide :: Constr
$cControllerButtonBack :: Constr
$cControllerButtonY :: Constr
$cControllerButtonX :: Constr
$cControllerButtonB :: Constr
$cControllerButtonA :: Constr
$cControllerButtonInvalid :: Constr
$tControllerButton :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
gmapMp :: (forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
gmapM :: (forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
gmapQi :: Int -> (forall d. Data d => d -> u) -> ControllerButton -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ControllerButton -> u
gmapQ :: (forall d. Data d => d -> u) -> ControllerButton -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ControllerButton -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButton -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButton -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButton -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButton -> r
gmapT :: (forall b. Data b => b -> b)
-> ControllerButton -> ControllerButton
$cgmapT :: (forall b. Data b => b -> b)
-> ControllerButton -> ControllerButton
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerButton)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerButton)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ControllerButton)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ControllerButton)
dataTypeOf :: ControllerButton -> DataType
$cdataTypeOf :: ControllerButton -> DataType
toConstr :: ControllerButton -> Constr
$ctoConstr :: ControllerButton -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerButton
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerButton
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ControllerButton -> c ControllerButton
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ControllerButton -> c ControllerButton
$cp1Data :: Typeable ControllerButton
Data, ControllerButton -> ControllerButton -> Bool
(ControllerButton -> ControllerButton -> Bool)
-> (ControllerButton -> ControllerButton -> Bool)
-> Eq ControllerButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControllerButton -> ControllerButton -> Bool
$c/= :: ControllerButton -> ControllerButton -> Bool
== :: ControllerButton -> ControllerButton -> Bool
$c== :: ControllerButton -> ControllerButton -> Bool
Eq, (forall x. ControllerButton -> Rep ControllerButton x)
-> (forall x. Rep ControllerButton x -> ControllerButton)
-> Generic ControllerButton
forall x. Rep ControllerButton x -> ControllerButton
forall x. ControllerButton -> Rep ControllerButton x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ControllerButton x -> ControllerButton
$cfrom :: forall x. ControllerButton -> Rep ControllerButton x
Generic, Eq ControllerButton
Eq ControllerButton =>
(ControllerButton -> ControllerButton -> Ordering)
-> (ControllerButton -> ControllerButton -> Bool)
-> (ControllerButton -> ControllerButton -> Bool)
-> (ControllerButton -> ControllerButton -> Bool)
-> (ControllerButton -> ControllerButton -> Bool)
-> (ControllerButton -> ControllerButton -> ControllerButton)
-> (ControllerButton -> ControllerButton -> ControllerButton)
-> Ord ControllerButton
ControllerButton -> ControllerButton -> Bool
ControllerButton -> ControllerButton -> Ordering
ControllerButton -> ControllerButton -> ControllerButton
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 :: ControllerButton -> ControllerButton -> ControllerButton
$cmin :: ControllerButton -> ControllerButton -> ControllerButton
max :: ControllerButton -> ControllerButton -> ControllerButton
$cmax :: ControllerButton -> ControllerButton -> ControllerButton
>= :: ControllerButton -> ControllerButton -> Bool
$c>= :: ControllerButton -> ControllerButton -> Bool
> :: ControllerButton -> ControllerButton -> Bool
$c> :: ControllerButton -> ControllerButton -> Bool
<= :: ControllerButton -> ControllerButton -> Bool
$c<= :: ControllerButton -> ControllerButton -> Bool
< :: ControllerButton -> ControllerButton -> Bool
$c< :: ControllerButton -> ControllerButton -> Bool
compare :: ControllerButton -> ControllerButton -> Ordering
$ccompare :: ControllerButton -> ControllerButton -> Ordering
$cp1Ord :: Eq ControllerButton
Ord, ReadPrec [ControllerButton]
ReadPrec ControllerButton
Int -> ReadS ControllerButton
ReadS [ControllerButton]
(Int -> ReadS ControllerButton)
-> ReadS [ControllerButton]
-> ReadPrec ControllerButton
-> ReadPrec [ControllerButton]
-> Read ControllerButton
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ControllerButton]
$creadListPrec :: ReadPrec [ControllerButton]
readPrec :: ReadPrec ControllerButton
$creadPrec :: ReadPrec ControllerButton
readList :: ReadS [ControllerButton]
$creadList :: ReadS [ControllerButton]
readsPrec :: Int -> ReadS ControllerButton
$creadsPrec :: Int -> ReadS ControllerButton
Read, Int -> ControllerButton -> ShowS
[ControllerButton] -> ShowS
ControllerButton -> String
(Int -> ControllerButton -> ShowS)
-> (ControllerButton -> String)
-> ([ControllerButton] -> ShowS)
-> Show ControllerButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControllerButton] -> ShowS
$cshowList :: [ControllerButton] -> ShowS
show :: ControllerButton -> String
$cshow :: ControllerButton -> String
showsPrec :: Int -> ControllerButton -> ShowS
$cshowsPrec :: Int -> ControllerButton -> ShowS
Show, Typeable)

instance FromNumber ControllerButton Int32 where
  fromNumber :: Int32 -> ControllerButton
fromNumber n :: Int32
n = case Int32
n of
    Raw.SDL_CONTROLLER_BUTTON_A -> ControllerButton
ControllerButtonA
    Raw.SDL_CONTROLLER_BUTTON_B -> ControllerButton
ControllerButtonB
    Raw.SDL_CONTROLLER_BUTTON_X -> ControllerButton
ControllerButtonX
    Raw.SDL_CONTROLLER_BUTTON_Y -> ControllerButton
ControllerButtonY
    Raw.SDL_CONTROLLER_BUTTON_BACK -> ControllerButton
ControllerButtonBack
    Raw.SDL_CONTROLLER_BUTTON_GUIDE -> ControllerButton
ControllerButtonGuide
    Raw.SDL_CONTROLLER_BUTTON_START -> ControllerButton
ControllerButtonStart
    Raw.SDL_CONTROLLER_BUTTON_LEFTSTICK -> ControllerButton
ControllerButtonLeftStick
    Raw.SDL_CONTROLLER_BUTTON_RIGHTSTICK -> ControllerButton
ControllerButtonRightStick
    Raw.SDL_CONTROLLER_BUTTON_LEFTSHOULDER -> ControllerButton
ControllerButtonLeftShoulder
    Raw.SDL_CONTROLLER_BUTTON_RIGHTSHOULDER -> ControllerButton
ControllerButtonRightShoulder
    Raw.SDL_CONTROLLER_BUTTON_DPAD_UP -> ControllerButton
ControllerButtonDpadUp
    Raw.SDL_CONTROLLER_BUTTON_DPAD_DOWN -> ControllerButton
ControllerButtonDpadDown
    Raw.SDL_CONTROLLER_BUTTON_DPAD_LEFT -> ControllerButton
ControllerButtonDpadLeft
    Raw.SDL_CONTROLLER_BUTTON_DPAD_RIGHT -> ControllerButton
ControllerButtonDpadRight
    _ -> ControllerButton
ControllerButtonInvalid

instance ToNumber ControllerButton Int32 where
  toNumber :: ControllerButton -> Int32
toNumber c :: ControllerButton
c = case ControllerButton
c of
    ControllerButtonA -> Int32
Raw.SDL_CONTROLLER_BUTTON_A
    ControllerButtonB -> Int32
Raw.SDL_CONTROLLER_BUTTON_B
    ControllerButtonX -> Int32
Raw.SDL_CONTROLLER_BUTTON_X
    ControllerButtonY -> Int32
Raw.SDL_CONTROLLER_BUTTON_Y
    ControllerButtonBack -> Int32
Raw.SDL_CONTROLLER_BUTTON_BACK
    ControllerButtonGuide -> Int32
Raw.SDL_CONTROLLER_BUTTON_GUIDE
    ControllerButtonStart -> Int32
Raw.SDL_CONTROLLER_BUTTON_START
    ControllerButtonLeftStick -> Int32
Raw.SDL_CONTROLLER_BUTTON_LEFTSTICK
    ControllerButtonRightStick -> Int32
Raw.SDL_CONTROLLER_BUTTON_RIGHTSTICK
    ControllerButtonLeftShoulder -> Int32
Raw.SDL_CONTROLLER_BUTTON_LEFTSHOULDER
    ControllerButtonRightShoulder -> Int32
Raw.SDL_CONTROLLER_BUTTON_RIGHTSHOULDER
    ControllerButtonDpadUp -> Int32
Raw.SDL_CONTROLLER_BUTTON_DPAD_UP
    ControllerButtonDpadDown -> Int32
Raw.SDL_CONTROLLER_BUTTON_DPAD_DOWN
    ControllerButtonDpadLeft -> Int32
Raw.SDL_CONTROLLER_BUTTON_DPAD_LEFT
    ControllerButtonDpadRight -> Int32
Raw.SDL_CONTROLLER_BUTTON_DPAD_RIGHT
    ControllerButtonInvalid -> Int32
Raw.SDL_CONTROLLER_BUTTON_INVALID

-- | Identifies the state of a controller button.
data ControllerButtonState
  = ControllerButtonPressed
  | ControllerButtonReleased
  | ControllerButtonInvalidState
  deriving (Typeable ControllerButtonState
DataType
Constr
Typeable ControllerButtonState =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ControllerButtonState
 -> c ControllerButtonState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ControllerButtonState)
-> (ControllerButtonState -> Constr)
-> (ControllerButtonState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ControllerButtonState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ControllerButtonState))
-> ((forall b. Data b => b -> b)
    -> ControllerButtonState -> ControllerButtonState)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ControllerButtonState
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ControllerButtonState
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ControllerButtonState -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ControllerButtonState -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ControllerButtonState -> m ControllerButtonState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ControllerButtonState -> m ControllerButtonState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ControllerButtonState -> m ControllerButtonState)
-> Data ControllerButtonState
ControllerButtonState -> DataType
ControllerButtonState -> Constr
(forall b. Data b => b -> b)
-> ControllerButtonState -> ControllerButtonState
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ControllerButtonState
-> c ControllerButtonState
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerButtonState
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ControllerButtonState -> u
forall u.
(forall d. Data d => d -> u) -> ControllerButtonState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButtonState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButtonState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerButtonState -> m ControllerButtonState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerButtonState -> m ControllerButtonState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerButtonState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ControllerButtonState
-> c ControllerButtonState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ControllerButtonState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerButtonState)
$cControllerButtonInvalidState :: Constr
$cControllerButtonReleased :: Constr
$cControllerButtonPressed :: Constr
$tControllerButtonState :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ControllerButtonState -> m ControllerButtonState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerButtonState -> m ControllerButtonState
gmapMp :: (forall d. Data d => d -> m d)
-> ControllerButtonState -> m ControllerButtonState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerButtonState -> m ControllerButtonState
gmapM :: (forall d. Data d => d -> m d)
-> ControllerButtonState -> m ControllerButtonState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerButtonState -> m ControllerButtonState
gmapQi :: Int -> (forall d. Data d => d -> u) -> ControllerButtonState -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ControllerButtonState -> u
gmapQ :: (forall d. Data d => d -> u) -> ControllerButtonState -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ControllerButtonState -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButtonState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButtonState -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButtonState -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButtonState -> r
gmapT :: (forall b. Data b => b -> b)
-> ControllerButtonState -> ControllerButtonState
$cgmapT :: (forall b. Data b => b -> b)
-> ControllerButtonState -> ControllerButtonState
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerButtonState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerButtonState)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ControllerButtonState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ControllerButtonState)
dataTypeOf :: ControllerButtonState -> DataType
$cdataTypeOf :: ControllerButtonState -> DataType
toConstr :: ControllerButtonState -> Constr
$ctoConstr :: ControllerButtonState -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerButtonState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerButtonState
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ControllerButtonState
-> c ControllerButtonState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ControllerButtonState
-> c ControllerButtonState
$cp1Data :: Typeable ControllerButtonState
Data, ControllerButtonState -> ControllerButtonState -> Bool
(ControllerButtonState -> ControllerButtonState -> Bool)
-> (ControllerButtonState -> ControllerButtonState -> Bool)
-> Eq ControllerButtonState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControllerButtonState -> ControllerButtonState -> Bool
$c/= :: ControllerButtonState -> ControllerButtonState -> Bool
== :: ControllerButtonState -> ControllerButtonState -> Bool
$c== :: ControllerButtonState -> ControllerButtonState -> Bool
Eq, (forall x. ControllerButtonState -> Rep ControllerButtonState x)
-> (forall x. Rep ControllerButtonState x -> ControllerButtonState)
-> Generic ControllerButtonState
forall x. Rep ControllerButtonState x -> ControllerButtonState
forall x. ControllerButtonState -> Rep ControllerButtonState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ControllerButtonState x -> ControllerButtonState
$cfrom :: forall x. ControllerButtonState -> Rep ControllerButtonState x
Generic, Eq ControllerButtonState
Eq ControllerButtonState =>
(ControllerButtonState -> ControllerButtonState -> Ordering)
-> (ControllerButtonState -> ControllerButtonState -> Bool)
-> (ControllerButtonState -> ControllerButtonState -> Bool)
-> (ControllerButtonState -> ControllerButtonState -> Bool)
-> (ControllerButtonState -> ControllerButtonState -> Bool)
-> (ControllerButtonState
    -> ControllerButtonState -> ControllerButtonState)
-> (ControllerButtonState
    -> ControllerButtonState -> ControllerButtonState)
-> Ord ControllerButtonState
ControllerButtonState -> ControllerButtonState -> Bool
ControllerButtonState -> ControllerButtonState -> Ordering
ControllerButtonState
-> ControllerButtonState -> ControllerButtonState
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 :: ControllerButtonState
-> ControllerButtonState -> ControllerButtonState
$cmin :: ControllerButtonState
-> ControllerButtonState -> ControllerButtonState
max :: ControllerButtonState
-> ControllerButtonState -> ControllerButtonState
$cmax :: ControllerButtonState
-> ControllerButtonState -> ControllerButtonState
>= :: ControllerButtonState -> ControllerButtonState -> Bool
$c>= :: ControllerButtonState -> ControllerButtonState -> Bool
> :: ControllerButtonState -> ControllerButtonState -> Bool
$c> :: ControllerButtonState -> ControllerButtonState -> Bool
<= :: ControllerButtonState -> ControllerButtonState -> Bool
$c<= :: ControllerButtonState -> ControllerButtonState -> Bool
< :: ControllerButtonState -> ControllerButtonState -> Bool
$c< :: ControllerButtonState -> ControllerButtonState -> Bool
compare :: ControllerButtonState -> ControllerButtonState -> Ordering
$ccompare :: ControllerButtonState -> ControllerButtonState -> Ordering
$cp1Ord :: Eq ControllerButtonState
Ord, ReadPrec [ControllerButtonState]
ReadPrec ControllerButtonState
Int -> ReadS ControllerButtonState
ReadS [ControllerButtonState]
(Int -> ReadS ControllerButtonState)
-> ReadS [ControllerButtonState]
-> ReadPrec ControllerButtonState
-> ReadPrec [ControllerButtonState]
-> Read ControllerButtonState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ControllerButtonState]
$creadListPrec :: ReadPrec [ControllerButtonState]
readPrec :: ReadPrec ControllerButtonState
$creadPrec :: ReadPrec ControllerButtonState
readList :: ReadS [ControllerButtonState]
$creadList :: ReadS [ControllerButtonState]
readsPrec :: Int -> ReadS ControllerButtonState
$creadsPrec :: Int -> ReadS ControllerButtonState
Read, Int -> ControllerButtonState -> ShowS
[ControllerButtonState] -> ShowS
ControllerButtonState -> String
(Int -> ControllerButtonState -> ShowS)
-> (ControllerButtonState -> String)
-> ([ControllerButtonState] -> ShowS)
-> Show ControllerButtonState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControllerButtonState] -> ShowS
$cshowList :: [ControllerButtonState] -> ShowS
show :: ControllerButtonState -> String
$cshow :: ControllerButtonState -> String
showsPrec :: Int -> ControllerButtonState -> ShowS
$cshowsPrec :: Int -> ControllerButtonState -> ShowS
Show, Typeable)

instance FromNumber ControllerButtonState Word32 where
  fromNumber :: Word32 -> ControllerButtonState
fromNumber n :: Word32
n = case Word32
n of
    Raw.SDL_CONTROLLERBUTTONDOWN -> ControllerButtonState
ControllerButtonPressed
    Raw.SDL_CONTROLLERBUTTONUP -> ControllerButtonState
ControllerButtonReleased
    _ -> ControllerButtonState
ControllerButtonInvalidState

-- | Identified whether the game controller was added, removed, or remapped.
data ControllerDeviceConnection
  = ControllerDeviceAdded
  | ControllerDeviceRemoved
  | ControllerDeviceRemapped
  deriving (Typeable ControllerDeviceConnection
DataType
Constr
Typeable ControllerDeviceConnection =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ControllerDeviceConnection
 -> c ControllerDeviceConnection)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ControllerDeviceConnection)
-> (ControllerDeviceConnection -> Constr)
-> (ControllerDeviceConnection -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ControllerDeviceConnection))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ControllerDeviceConnection))
-> ((forall b. Data b => b -> b)
    -> ControllerDeviceConnection -> ControllerDeviceConnection)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ControllerDeviceConnection
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ControllerDeviceConnection
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ControllerDeviceConnection -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> ControllerDeviceConnection -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ControllerDeviceConnection -> m ControllerDeviceConnection)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ControllerDeviceConnection -> m ControllerDeviceConnection)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ControllerDeviceConnection -> m ControllerDeviceConnection)
-> Data ControllerDeviceConnection
ControllerDeviceConnection -> DataType
ControllerDeviceConnection -> Constr
(forall b. Data b => b -> b)
-> ControllerDeviceConnection -> ControllerDeviceConnection
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ControllerDeviceConnection
-> c ControllerDeviceConnection
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerDeviceConnection
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> ControllerDeviceConnection -> u
forall u.
(forall d. Data d => d -> u) -> ControllerDeviceConnection -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ControllerDeviceConnection
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ControllerDeviceConnection
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerDeviceConnection -> m ControllerDeviceConnection
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerDeviceConnection -> m ControllerDeviceConnection
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerDeviceConnection
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ControllerDeviceConnection
-> c ControllerDeviceConnection
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ControllerDeviceConnection)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerDeviceConnection)
$cControllerDeviceRemapped :: Constr
$cControllerDeviceRemoved :: Constr
$cControllerDeviceAdded :: Constr
$tControllerDeviceConnection :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ControllerDeviceConnection -> m ControllerDeviceConnection
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerDeviceConnection -> m ControllerDeviceConnection
gmapMp :: (forall d. Data d => d -> m d)
-> ControllerDeviceConnection -> m ControllerDeviceConnection
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerDeviceConnection -> m ControllerDeviceConnection
gmapM :: (forall d. Data d => d -> m d)
-> ControllerDeviceConnection -> m ControllerDeviceConnection
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerDeviceConnection -> m ControllerDeviceConnection
gmapQi :: Int
-> (forall d. Data d => d -> u) -> ControllerDeviceConnection -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ControllerDeviceConnection -> u
gmapQ :: (forall d. Data d => d -> u) -> ControllerDeviceConnection -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ControllerDeviceConnection -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ControllerDeviceConnection
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ControllerDeviceConnection
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ControllerDeviceConnection
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ControllerDeviceConnection
-> r
gmapT :: (forall b. Data b => b -> b)
-> ControllerDeviceConnection -> ControllerDeviceConnection
$cgmapT :: (forall b. Data b => b -> b)
-> ControllerDeviceConnection -> ControllerDeviceConnection
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerDeviceConnection)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerDeviceConnection)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c ControllerDeviceConnection)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ControllerDeviceConnection)
dataTypeOf :: ControllerDeviceConnection -> DataType
$cdataTypeOf :: ControllerDeviceConnection -> DataType
toConstr :: ControllerDeviceConnection -> Constr
$ctoConstr :: ControllerDeviceConnection -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerDeviceConnection
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerDeviceConnection
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ControllerDeviceConnection
-> c ControllerDeviceConnection
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ControllerDeviceConnection
-> c ControllerDeviceConnection
$cp1Data :: Typeable ControllerDeviceConnection
Data, ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
(ControllerDeviceConnection -> ControllerDeviceConnection -> Bool)
-> (ControllerDeviceConnection
    -> ControllerDeviceConnection -> Bool)
-> Eq ControllerDeviceConnection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
$c/= :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
== :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
$c== :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
Eq, (forall x.
 ControllerDeviceConnection -> Rep ControllerDeviceConnection x)
-> (forall x.
    Rep ControllerDeviceConnection x -> ControllerDeviceConnection)
-> Generic ControllerDeviceConnection
forall x.
Rep ControllerDeviceConnection x -> ControllerDeviceConnection
forall x.
ControllerDeviceConnection -> Rep ControllerDeviceConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ControllerDeviceConnection x -> ControllerDeviceConnection
$cfrom :: forall x.
ControllerDeviceConnection -> Rep ControllerDeviceConnection x
Generic, Eq ControllerDeviceConnection
Eq ControllerDeviceConnection =>
(ControllerDeviceConnection
 -> ControllerDeviceConnection -> Ordering)
-> (ControllerDeviceConnection
    -> ControllerDeviceConnection -> Bool)
-> (ControllerDeviceConnection
    -> ControllerDeviceConnection -> Bool)
-> (ControllerDeviceConnection
    -> ControllerDeviceConnection -> Bool)
-> (ControllerDeviceConnection
    -> ControllerDeviceConnection -> Bool)
-> (ControllerDeviceConnection
    -> ControllerDeviceConnection -> ControllerDeviceConnection)
-> (ControllerDeviceConnection
    -> ControllerDeviceConnection -> ControllerDeviceConnection)
-> Ord ControllerDeviceConnection
ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
ControllerDeviceConnection
-> ControllerDeviceConnection -> Ordering
ControllerDeviceConnection
-> ControllerDeviceConnection -> ControllerDeviceConnection
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 :: ControllerDeviceConnection
-> ControllerDeviceConnection -> ControllerDeviceConnection
$cmin :: ControllerDeviceConnection
-> ControllerDeviceConnection -> ControllerDeviceConnection
max :: ControllerDeviceConnection
-> ControllerDeviceConnection -> ControllerDeviceConnection
$cmax :: ControllerDeviceConnection
-> ControllerDeviceConnection -> ControllerDeviceConnection
>= :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
$c>= :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
> :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
$c> :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
<= :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
$c<= :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
< :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
$c< :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
compare :: ControllerDeviceConnection
-> ControllerDeviceConnection -> Ordering
$ccompare :: ControllerDeviceConnection
-> ControllerDeviceConnection -> Ordering
$cp1Ord :: Eq ControllerDeviceConnection
Ord, ReadPrec [ControllerDeviceConnection]
ReadPrec ControllerDeviceConnection
Int -> ReadS ControllerDeviceConnection
ReadS [ControllerDeviceConnection]
(Int -> ReadS ControllerDeviceConnection)
-> ReadS [ControllerDeviceConnection]
-> ReadPrec ControllerDeviceConnection
-> ReadPrec [ControllerDeviceConnection]
-> Read ControllerDeviceConnection
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ControllerDeviceConnection]
$creadListPrec :: ReadPrec [ControllerDeviceConnection]
readPrec :: ReadPrec ControllerDeviceConnection
$creadPrec :: ReadPrec ControllerDeviceConnection
readList :: ReadS [ControllerDeviceConnection]
$creadList :: ReadS [ControllerDeviceConnection]
readsPrec :: Int -> ReadS ControllerDeviceConnection
$creadsPrec :: Int -> ReadS ControllerDeviceConnection
Read, Int -> ControllerDeviceConnection -> ShowS
[ControllerDeviceConnection] -> ShowS
ControllerDeviceConnection -> String
(Int -> ControllerDeviceConnection -> ShowS)
-> (ControllerDeviceConnection -> String)
-> ([ControllerDeviceConnection] -> ShowS)
-> Show ControllerDeviceConnection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControllerDeviceConnection] -> ShowS
$cshowList :: [ControllerDeviceConnection] -> ShowS
show :: ControllerDeviceConnection -> String
$cshow :: ControllerDeviceConnection -> String
showsPrec :: Int -> ControllerDeviceConnection -> ShowS
$cshowsPrec :: Int -> ControllerDeviceConnection -> ShowS
Show, Typeable)

instance FromNumber ControllerDeviceConnection Word32 where
  fromNumber :: Word32 -> ControllerDeviceConnection
fromNumber n :: Word32
n = case Word32
n of
    Raw.SDL_CONTROLLERDEVICEADDED -> ControllerDeviceConnection
ControllerDeviceAdded
    Raw.SDL_CONTROLLERDEVICEREMOVED -> ControllerDeviceConnection
ControllerDeviceRemoved
    _ -> ControllerDeviceConnection
ControllerDeviceRemapped