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

module SDL.Input.GameController
  ( ControllerDevice (..)
  , availableControllers

  , openController
  , closeController
  , controllerAttached

  , getControllerID

  , controllerMapping
  , addControllerMapping
  , addControllerMappingsFromFile

  , ControllerButton (..)
  , ControllerButtonState (..)
  , controllerButton

  , ControllerAxis (..)
  , controllerAxis
  
  , ControllerDeviceConnection (..)
  ) where

import Control.Monad (filterM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Data (Data)
import Data.Int
import Data.Text (Text)
import Data.Traversable (for)
import Data.Typeable
import Data.Word
import Foreign.C (withCString)
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import GHC.Generics (Generic)
import GHC.Int (Int32)
import SDL.Input.Joystick (numJoysticks)
import SDL.Internal.Exception
import SDL.Internal.Numbered
import SDL.Internal.Types
import SDL.Vect
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BSI
import qualified SDL.Raw as Raw
import qualified Data.Text.Encoding as Text
import qualified Data.Vector as V

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif

{- | A description of game controller that can be opened using 'openController'.
 To retrieve a list of connected game controllers, use 'availableControllers'.
-}
data ControllerDevice = ControllerDevice
  { ControllerDevice -> Text
gameControllerDeviceName :: Text
  , ControllerDevice -> CInt
gameControllerDeviceId :: CInt
  }
  deriving (ControllerDevice -> ControllerDevice -> Bool
(ControllerDevice -> ControllerDevice -> Bool)
-> (ControllerDevice -> ControllerDevice -> Bool)
-> Eq ControllerDevice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ControllerDevice -> ControllerDevice -> Bool
== :: ControllerDevice -> ControllerDevice -> Bool
$c/= :: ControllerDevice -> ControllerDevice -> Bool
/= :: ControllerDevice -> ControllerDevice -> Bool
Eq, (forall x. ControllerDevice -> Rep ControllerDevice x)
-> (forall x. Rep ControllerDevice x -> ControllerDevice)
-> Generic ControllerDevice
forall x. Rep ControllerDevice x -> ControllerDevice
forall x. ControllerDevice -> Rep ControllerDevice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ControllerDevice -> Rep ControllerDevice x
from :: forall x. ControllerDevice -> Rep ControllerDevice x
$cto :: forall x. Rep ControllerDevice x -> ControllerDevice
to :: forall x. Rep ControllerDevice x -> ControllerDevice
Generic, ReadPrec [ControllerDevice]
ReadPrec ControllerDevice
Int -> ReadS ControllerDevice
ReadS [ControllerDevice]
(Int -> ReadS ControllerDevice)
-> ReadS [ControllerDevice]
-> ReadPrec ControllerDevice
-> ReadPrec [ControllerDevice]
-> Read ControllerDevice
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ControllerDevice
readsPrec :: Int -> ReadS ControllerDevice
$creadList :: ReadS [ControllerDevice]
readList :: ReadS [ControllerDevice]
$creadPrec :: ReadPrec ControllerDevice
readPrec :: ReadPrec ControllerDevice
$creadListPrec :: ReadPrec [ControllerDevice]
readListPrec :: ReadPrec [ControllerDevice]
Read, Eq ControllerDevice
Eq ControllerDevice =>
(ControllerDevice -> ControllerDevice -> Ordering)
-> (ControllerDevice -> ControllerDevice -> Bool)
-> (ControllerDevice -> ControllerDevice -> Bool)
-> (ControllerDevice -> ControllerDevice -> Bool)
-> (ControllerDevice -> ControllerDevice -> Bool)
-> (ControllerDevice -> ControllerDevice -> ControllerDevice)
-> (ControllerDevice -> ControllerDevice -> ControllerDevice)
-> Ord ControllerDevice
ControllerDevice -> ControllerDevice -> Bool
ControllerDevice -> ControllerDevice -> Ordering
ControllerDevice -> ControllerDevice -> ControllerDevice
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ControllerDevice -> ControllerDevice -> Ordering
compare :: ControllerDevice -> ControllerDevice -> Ordering
$c< :: ControllerDevice -> ControllerDevice -> Bool
< :: ControllerDevice -> ControllerDevice -> Bool
$c<= :: ControllerDevice -> ControllerDevice -> Bool
<= :: ControllerDevice -> ControllerDevice -> Bool
$c> :: ControllerDevice -> ControllerDevice -> Bool
> :: ControllerDevice -> ControllerDevice -> Bool
$c>= :: ControllerDevice -> ControllerDevice -> Bool
>= :: ControllerDevice -> ControllerDevice -> Bool
$cmax :: ControllerDevice -> ControllerDevice -> ControllerDevice
max :: ControllerDevice -> ControllerDevice -> ControllerDevice
$cmin :: ControllerDevice -> ControllerDevice -> ControllerDevice
min :: ControllerDevice -> ControllerDevice -> ControllerDevice
Ord, Int -> ControllerDevice -> ShowS
[ControllerDevice] -> ShowS
ControllerDevice -> String
(Int -> ControllerDevice -> ShowS)
-> (ControllerDevice -> String)
-> ([ControllerDevice] -> ShowS)
-> Show ControllerDevice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ControllerDevice -> ShowS
showsPrec :: Int -> ControllerDevice -> ShowS
$cshow :: ControllerDevice -> String
show :: ControllerDevice -> String
$cshowList :: [ControllerDevice] -> ShowS
showList :: [ControllerDevice] -> ShowS
Show, Typeable)

-- | Enumerate all connected Controllers, retrieving a description of each.
availableControllers :: MonadIO m => m (V.Vector ControllerDevice)
availableControllers :: forall (m :: Type -> Type).
MonadIO m =>
m (Vector ControllerDevice)
availableControllers = IO (Vector ControllerDevice) -> m (Vector ControllerDevice)
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Vector ControllerDevice) -> m (Vector ControllerDevice))
-> IO (Vector ControllerDevice) -> m (Vector ControllerDevice)
forall a b. (a -> b) -> a -> b
$ do
  CInt
n <- IO CInt
forall (m :: Type -> Type). MonadIO m => m CInt
numJoysticks
  [CInt]
indices <- (CInt -> IO Bool) -> [CInt] -> IO [CInt]
forall (m :: Type -> Type) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM CInt -> IO Bool
forall (m :: Type -> Type). MonadIO m => CInt -> m Bool
Raw.isGameController [CInt
0 .. (CInt
n CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1)]
  ([ControllerDevice] -> Vector ControllerDevice)
-> IO [ControllerDevice] -> IO (Vector ControllerDevice)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [ControllerDevice] -> Vector ControllerDevice
forall a. [a] -> Vector a
V.fromList (IO [ControllerDevice] -> IO (Vector ControllerDevice))
-> IO [ControllerDevice] -> IO (Vector ControllerDevice)
forall a b. (a -> b) -> a -> b
$ [CInt] -> (CInt -> IO ControllerDevice) -> IO [ControllerDevice]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CInt]
indices ((CInt -> IO ControllerDevice) -> IO [ControllerDevice])
-> (CInt -> IO ControllerDevice) -> IO [ControllerDevice]
forall a b. (a -> b) -> a -> b
$ \CInt
i -> do
    Ptr CChar
cstr <-
      Text -> Text -> IO (Ptr CChar) -> IO (Ptr CChar)
forall (m :: Type -> Type) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull Text
"SDL.Input.Controller.availableGameControllers" Text
"SDL_GameControllerNameForIndex" (IO (Ptr CChar) -> IO (Ptr CChar))
-> IO (Ptr CChar) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$
        CInt -> IO (Ptr CChar)
forall (m :: Type -> Type). MonadIO m => CInt -> m (Ptr CChar)
Raw.gameControllerNameForIndex CInt
i
    Text
name <- ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO ByteString
BS.packCString Ptr CChar
cstr
    ControllerDevice -> IO ControllerDevice
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> CInt -> ControllerDevice
ControllerDevice Text
name CInt
i)

{- | Open a controller so that you can start receiving events from interaction with this controller.

 See @<https://wiki.libsdl.org/SDL_GameControllerOpen SDL_GameControllerOpen>@ for C documentation.
-}
openController
  :: (Functor m, MonadIO m)
  => ControllerDevice
  -- ^ The device to open. Use 'availableControllers' to find 'JoystickDevices's
  -> m GameController
openController :: forall (m :: Type -> Type).
(Functor m, MonadIO m) =>
ControllerDevice -> m GameController
openController (ControllerDevice Text
_ CInt
x) =
  (GameController -> GameController)
-> m GameController -> m GameController
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap GameController -> GameController
GameController (m GameController -> m GameController)
-> m GameController -> m GameController
forall a b. (a -> b) -> a -> b
$
    Text -> Text -> m GameController -> m GameController
forall (m :: Type -> Type) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull Text
"SDL.Input.GameController.openController" Text
"SDL_GameControllerOpen" (m GameController -> m GameController)
-> m GameController -> m GameController
forall a b. (a -> b) -> a -> b
$
      CInt -> m GameController
forall (m :: Type -> Type). MonadIO m => CInt -> m GameController
Raw.gameControllerOpen CInt
x

{- | Close a controller previously opened with 'openController'.

 See @<https://wiki.libsdl.org/SDL_GameControllerClose SDL_GameControllerClose>@ for C documentation.
-}
closeController :: MonadIO m => GameController -> m ()
closeController :: forall (m :: Type -> Type). MonadIO m => GameController -> m ()
closeController (GameController GameController
j) = GameController -> m ()
forall (m :: Type -> Type). MonadIO m => GameController -> m ()
Raw.gameControllerClose GameController
j

{- | Check if a controller has been opened and is currently connected.

 See @<https://wiki.libsdl.org/SDL_GameControllerGetAttached SDL_GameControllerGetAttached>@ for C documentation.
-}
controllerAttached :: MonadIO m => GameController -> m Bool
controllerAttached :: forall (m :: Type -> Type). MonadIO m => GameController -> m Bool
controllerAttached (GameController GameController
c) = GameController -> m Bool
forall (m :: Type -> Type). MonadIO m => GameController -> m Bool
Raw.gameControllerGetAttached GameController
c

{- | Get the instance ID of an opened controller. The instance ID is used to identify the controller
 in future SDL events.

 See @<https://wiki.libsdl.org/SDL_GameControllerInstanceID SDL_GameControllerInstanceID>@ for C documentation.
-}
getControllerID :: MonadIO m => GameController -> m Int32
getControllerID :: forall (m :: Type -> Type). MonadIO m => GameController -> m Int32
getControllerID (GameController GameController
c) =
  Text -> Text -> m Int32 -> m Int32
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m a
throwIfNeg Text
"SDL.Input.GameController.getControllerID" Text
"SDL_JoystickInstanceID" (m Int32 -> m Int32) -> m Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$
    GameController -> m Int32
forall (m :: Type -> Type). MonadIO m => GameController -> m Int32
Raw.joystickInstanceID GameController
c

{- | Get the current mapping of a Game Controller.

 See @<https://wiki.libsdl.org/SDL_GameControllerMapping SDL_GameControllerMapping>@ for C documentation.
-}
controllerMapping :: MonadIO m => GameController -> m Text
controllerMapping :: forall (m :: Type -> Type). MonadIO m => GameController -> m Text
controllerMapping (GameController GameController
c) = IO Text -> m Text
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
  Ptr CChar
mapping <-
    Text -> Text -> IO (Ptr CChar) -> IO (Ptr CChar)
forall (m :: Type -> Type) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull Text
"SDL.Input.GameController.getControllerMapping" Text
"SDL_GameControllerMapping" (IO (Ptr CChar) -> IO (Ptr CChar))
-> IO (Ptr CChar) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$
      GameController -> IO (Ptr CChar)
forall (m :: Type -> Type).
MonadIO m =>
GameController -> m (Ptr CChar)
Raw.gameControllerMapping GameController
c
  ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO ByteString
BS.packCString Ptr CChar
mapping

{- | Add support for controllers that SDL is unaware of or to cause an existing controller to
 have a different binding.

 See @<https://wiki.libsdl.org/SDL_GameControllerAddMapping SDL_GameControllerAddMapping>@ for C documentation.
-}
addControllerMapping :: MonadIO m => BS.ByteString -> m ()
addControllerMapping :: forall (m :: Type -> Type). MonadIO m => ByteString -> m ()
addControllerMapping ByteString
mapping =
  IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    Text -> Text -> IO CInt -> IO ()
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m ()
throwIfNeg_ Text
"SDL.Input.GameController.addControllerMapping" Text
"SDL_GameControllerAddMapping" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
      let (ForeignPtr Word8
mappingForeign, Int
_, Int
_) = ByteString -> (ForeignPtr Word8, Int, Int)
BSI.toForeignPtr ByteString
mapping
       in ForeignPtr Word8 -> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
mappingForeign ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
mappingPtr ->
            Ptr CChar -> IO CInt
forall (m :: Type -> Type). MonadIO m => Ptr CChar -> m CInt
Raw.gameControllerAddMapping (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
mappingPtr)

{- | Use this function to load a set of Game Controller mappings from a file, filtered by the
 current SDL_GetPlatform(). A community sourced database of controllers is available
 @<https://raw.githubusercontent.com/gabomdq/SDL_GameControllerDB/master/gamecontrollerdb.txt here>@
 (on GitHub).

 See @<https://wiki.libsdl.org/SDL_GameControllerAddMappingsFromFile SDL_GameControllerAddMappingsFromFile>@ for C documentation.
-}
addControllerMappingsFromFile :: MonadIO m => FilePath -> m ()
addControllerMappingsFromFile :: forall (m :: Type -> Type). MonadIO m => String -> m ()
addControllerMappingsFromFile String
mappingFile =
  IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    Text -> Text -> IO CInt -> IO ()
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m ()
throwIfNeg_ Text
"SDL.Input.GameController.addControllerMappingsFromFile" Text
"SDL_GameControllerAddMappingsFromFile" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> (Ptr CChar -> IO CInt) -> IO CInt
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
mappingFile Ptr CChar -> IO CInt
forall (m :: Type -> Type). MonadIO m => Ptr CChar -> m CInt
Raw.gameControllerAddMappingsFromFile

{- | Get the current state of an axis control on a game controller.

 See @<https://wiki.libsdl.org/SDL_GameControllerGetAxis SDL_GameControllerGetAxis>@ for C documentation.
-}
controllerAxis :: MonadIO m => GameController -> ControllerAxis -> m Int16
controllerAxis :: forall (m :: Type -> Type).
MonadIO m =>
GameController -> ControllerAxis -> m Int16
controllerAxis (GameController GameController
c) ControllerAxis
axis =
  GameController -> Int32 -> m Int16
forall (m :: Type -> Type).
MonadIO m =>
GameController -> Int32 -> m Int16
Raw.gameControllerGetAxis GameController
c (ControllerAxis -> Int32
forall a b. ToNumber a b => a -> b
toNumber ControllerAxis
axis)

{- | Get the current state of a button on a game controller.

 See @<https://wiki.libsdl.org/SDL_GameControllerGetButton SDL_GameControllerGetButton>@ for C documentation.
-}
controllerButton :: MonadIO m => GameController -> ControllerButton -> m ControllerButtonState
controllerButton :: forall (m :: Type -> Type).
MonadIO m =>
GameController -> ControllerButton -> m ControllerButtonState
controllerButton (GameController GameController
c) ControllerButton
button =
  Word32 -> ControllerButtonState
forall a b. FromNumber a b => b -> a
fromNumber (Word32 -> ControllerButtonState)
-> (Word8 -> Word32) -> Word8 -> ControllerButtonState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> ControllerButtonState)
-> m Word8 -> m ControllerButtonState
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> GameController -> Int32 -> m Word8
forall (m :: Type -> Type).
MonadIO m =>
GameController -> Int32 -> m Word8
Raw.gameControllerGetButton GameController
c (ControllerButton -> Int32
forall a b. ToNumber a b => a -> b
toNumber ControllerButton
button)

-- | 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
Typeable ControllerButton =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ControllerButton -> c ControllerButton)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ControllerButton)
-> (ControllerButton -> Constr)
-> (ControllerButton -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ControllerButton))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    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 :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ControllerButton -> m ControllerButton)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ControllerButton -> m ControllerButton)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ControllerButton -> m ControllerButton)
-> Data ControllerButton
ControllerButton -> Constr
ControllerButton -> DataType
(forall b. Data b => b -> b)
-> ControllerButton -> ControllerButton
forall a.
Typeable a =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    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 :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    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 :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerButton
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ControllerButton -> c ControllerButton
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ControllerButton)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerButton)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ControllerButton -> c ControllerButton
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ControllerButton -> c ControllerButton
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerButton
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerButton
$ctoConstr :: ControllerButton -> Constr
toConstr :: ControllerButton -> Constr
$cdataTypeOf :: ControllerButton -> DataType
dataTypeOf :: ControllerButton -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ControllerButton)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ControllerButton)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerButton)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerButton)
$cgmapT :: (forall b. Data b => b -> b)
-> ControllerButton -> ControllerButton
gmapT :: (forall b. Data b => b -> b)
-> ControllerButton -> ControllerButton
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButton -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButton -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ControllerButton -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ControllerButton -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ControllerButton -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ControllerButton -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
Data, ControllerButton -> ControllerButton -> Bool
(ControllerButton -> ControllerButton -> Bool)
-> (ControllerButton -> ControllerButton -> Bool)
-> Eq ControllerButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ControllerButton -> ControllerButton -> Bool
== :: ControllerButton -> ControllerButton -> Bool
$c/= :: ControllerButton -> ControllerButton -> Bool
/= :: 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
$cfrom :: forall x. ControllerButton -> Rep ControllerButton x
from :: forall x. ControllerButton -> Rep ControllerButton x
$cto :: forall x. Rep ControllerButton x -> ControllerButton
to :: forall x. Rep ControllerButton x -> ControllerButton
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
$ccompare :: ControllerButton -> ControllerButton -> Ordering
compare :: ControllerButton -> ControllerButton -> Ordering
$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
>= :: ControllerButton -> ControllerButton -> Bool
$cmax :: ControllerButton -> ControllerButton -> ControllerButton
max :: ControllerButton -> ControllerButton -> ControllerButton
$cmin :: ControllerButton -> ControllerButton -> ControllerButton
min :: ControllerButton -> ControllerButton -> 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
$creadsPrec :: Int -> ReadS ControllerButton
readsPrec :: Int -> ReadS ControllerButton
$creadList :: ReadS [ControllerButton]
readList :: ReadS [ControllerButton]
$creadPrec :: ReadPrec ControllerButton
readPrec :: ReadPrec ControllerButton
$creadListPrec :: ReadPrec [ControllerButton]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> ControllerButton -> ShowS
showsPrec :: Int -> ControllerButton -> ShowS
$cshow :: ControllerButton -> String
show :: ControllerButton -> String
$cshowList :: [ControllerButton] -> ShowS
showList :: [ControllerButton] -> ShowS
Show, Typeable)

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

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

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

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

data ControllerAxis
  = ControllerAxisInvalid
  | ControllerAxisLeftX
  | ControllerAxisLeftY
  | ControllerAxisRightX
  | ControllerAxisRightY
  | ControllerAxisTriggerLeft
  | ControllerAxisTriggerRight
  | ControllerAxisMax
  deriving (Typeable ControllerAxis
Typeable ControllerAxis =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ControllerAxis -> c ControllerAxis)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ControllerAxis)
-> (ControllerAxis -> Constr)
-> (ControllerAxis -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ControllerAxis))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ControllerAxis))
-> ((forall b. Data b => b -> b)
    -> ControllerAxis -> ControllerAxis)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ControllerAxis -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ControllerAxis -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ControllerAxis -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ControllerAxis -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ControllerAxis -> m ControllerAxis)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ControllerAxis -> m ControllerAxis)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ControllerAxis -> m ControllerAxis)
-> Data ControllerAxis
ControllerAxis -> Constr
ControllerAxis -> DataType
(forall b. Data b => b -> b) -> ControllerAxis -> ControllerAxis
forall a.
Typeable a =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    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 :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ControllerAxis -> u
forall u. (forall d. Data d => d -> u) -> ControllerAxis -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerAxis -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerAxis -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerAxis -> m ControllerAxis
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerAxis -> m ControllerAxis
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerAxis
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ControllerAxis -> c ControllerAxis
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ControllerAxis)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerAxis)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ControllerAxis -> c ControllerAxis
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ControllerAxis -> c ControllerAxis
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerAxis
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerAxis
$ctoConstr :: ControllerAxis -> Constr
toConstr :: ControllerAxis -> Constr
$cdataTypeOf :: ControllerAxis -> DataType
dataTypeOf :: ControllerAxis -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ControllerAxis)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ControllerAxis)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerAxis)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerAxis)
$cgmapT :: (forall b. Data b => b -> b) -> ControllerAxis -> ControllerAxis
gmapT :: (forall b. Data b => b -> b) -> ControllerAxis -> ControllerAxis
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerAxis -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerAxis -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerAxis -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerAxis -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ControllerAxis -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ControllerAxis -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ControllerAxis -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ControllerAxis -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerAxis -> m ControllerAxis
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerAxis -> m ControllerAxis
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerAxis -> m ControllerAxis
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerAxis -> m ControllerAxis
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerAxis -> m ControllerAxis
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerAxis -> m ControllerAxis
Data, ControllerAxis -> ControllerAxis -> Bool
(ControllerAxis -> ControllerAxis -> Bool)
-> (ControllerAxis -> ControllerAxis -> Bool) -> Eq ControllerAxis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ControllerAxis -> ControllerAxis -> Bool
== :: ControllerAxis -> ControllerAxis -> Bool
$c/= :: ControllerAxis -> ControllerAxis -> Bool
/= :: ControllerAxis -> ControllerAxis -> Bool
Eq, (forall x. ControllerAxis -> Rep ControllerAxis x)
-> (forall x. Rep ControllerAxis x -> ControllerAxis)
-> Generic ControllerAxis
forall x. Rep ControllerAxis x -> ControllerAxis
forall x. ControllerAxis -> Rep ControllerAxis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ControllerAxis -> Rep ControllerAxis x
from :: forall x. ControllerAxis -> Rep ControllerAxis x
$cto :: forall x. Rep ControllerAxis x -> ControllerAxis
to :: forall x. Rep ControllerAxis x -> ControllerAxis
Generic, Eq ControllerAxis
Eq ControllerAxis =>
(ControllerAxis -> ControllerAxis -> Ordering)
-> (ControllerAxis -> ControllerAxis -> Bool)
-> (ControllerAxis -> ControllerAxis -> Bool)
-> (ControllerAxis -> ControllerAxis -> Bool)
-> (ControllerAxis -> ControllerAxis -> Bool)
-> (ControllerAxis -> ControllerAxis -> ControllerAxis)
-> (ControllerAxis -> ControllerAxis -> ControllerAxis)
-> Ord ControllerAxis
ControllerAxis -> ControllerAxis -> Bool
ControllerAxis -> ControllerAxis -> Ordering
ControllerAxis -> ControllerAxis -> ControllerAxis
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ControllerAxis -> ControllerAxis -> Ordering
compare :: ControllerAxis -> ControllerAxis -> Ordering
$c< :: ControllerAxis -> ControllerAxis -> Bool
< :: ControllerAxis -> ControllerAxis -> Bool
$c<= :: ControllerAxis -> ControllerAxis -> Bool
<= :: ControllerAxis -> ControllerAxis -> Bool
$c> :: ControllerAxis -> ControllerAxis -> Bool
> :: ControllerAxis -> ControllerAxis -> Bool
$c>= :: ControllerAxis -> ControllerAxis -> Bool
>= :: ControllerAxis -> ControllerAxis -> Bool
$cmax :: ControllerAxis -> ControllerAxis -> ControllerAxis
max :: ControllerAxis -> ControllerAxis -> ControllerAxis
$cmin :: ControllerAxis -> ControllerAxis -> ControllerAxis
min :: ControllerAxis -> ControllerAxis -> ControllerAxis
Ord, ReadPrec [ControllerAxis]
ReadPrec ControllerAxis
Int -> ReadS ControllerAxis
ReadS [ControllerAxis]
(Int -> ReadS ControllerAxis)
-> ReadS [ControllerAxis]
-> ReadPrec ControllerAxis
-> ReadPrec [ControllerAxis]
-> Read ControllerAxis
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ControllerAxis
readsPrec :: Int -> ReadS ControllerAxis
$creadList :: ReadS [ControllerAxis]
readList :: ReadS [ControllerAxis]
$creadPrec :: ReadPrec ControllerAxis
readPrec :: ReadPrec ControllerAxis
$creadListPrec :: ReadPrec [ControllerAxis]
readListPrec :: ReadPrec [ControllerAxis]
Read, Int -> ControllerAxis -> ShowS
[ControllerAxis] -> ShowS
ControllerAxis -> String
(Int -> ControllerAxis -> ShowS)
-> (ControllerAxis -> String)
-> ([ControllerAxis] -> ShowS)
-> Show ControllerAxis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ControllerAxis -> ShowS
showsPrec :: Int -> ControllerAxis -> ShowS
$cshow :: ControllerAxis -> String
show :: ControllerAxis -> String
$cshowList :: [ControllerAxis] -> ShowS
showList :: [ControllerAxis] -> ShowS
Show, Typeable)

instance ToNumber ControllerAxis Int32 where
  toNumber :: ControllerAxis -> Int32
toNumber ControllerAxis
a = case ControllerAxis
a of
    ControllerAxis
ControllerAxisLeftX -> Int32
Raw.SDL_CONTROLLER_AXIS_LEFTX
    ControllerAxis
ControllerAxisLeftY -> Int32
Raw.SDL_CONTROLLER_AXIS_LEFTY
    ControllerAxis
ControllerAxisRightX -> Int32
Raw.SDL_CONTROLLER_AXIS_RIGHTX
    ControllerAxis
ControllerAxisRightY -> Int32
Raw.SDL_CONTROLLER_AXIS_RIGHTY
    ControllerAxis
ControllerAxisTriggerLeft -> Int32
Raw.SDL_CONTROLLER_AXIS_TRIGGERLEFT
    ControllerAxis
ControllerAxisTriggerRight -> Int32
Raw.SDL_CONTROLLER_AXIS_TRIGGERRIGHT
    ControllerAxis
ControllerAxisMax -> Int32
Raw.SDL_CONTROLLER_AXIS_MAX
    ControllerAxis
ControllerAxisInvalid -> Int32
Raw.SDL_CONTROLLER_AXIS_INVALID

instance FromNumber ControllerAxis Int32 where
  fromNumber :: Int32 -> ControllerAxis
fromNumber Int32
n = case Int32
n of
    Int32
Raw.SDL_CONTROLLER_AXIS_LEFTX -> ControllerAxis
ControllerAxisLeftX
    Int32
Raw.SDL_CONTROLLER_AXIS_LEFTY -> ControllerAxis
ControllerAxisLeftY
    Int32
Raw.SDL_CONTROLLER_AXIS_RIGHTX -> ControllerAxis
ControllerAxisRightX
    Int32
Raw.SDL_CONTROLLER_AXIS_RIGHTY -> ControllerAxis
ControllerAxisRightY
    Int32
Raw.SDL_CONTROLLER_AXIS_TRIGGERLEFT -> ControllerAxis
ControllerAxisTriggerLeft
    Int32
Raw.SDL_CONTROLLER_AXIS_TRIGGERRIGHT -> ControllerAxis
ControllerAxisTriggerRight
    Int32
Raw.SDL_CONTROLLER_AXIS_MAX -> ControllerAxis
ControllerAxisMax
    Int32
_ -> ControllerAxis
ControllerAxisInvalid

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

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