{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | The types of the package. This module is considered "internal", and the

-- types are re-exported from Graphics.UI.GLFW as necessary.

module Graphics.UI.GLFW.Types where

--------------------------------------------------------------------------------


import Control.DeepSeq  (NFData)
import Data.Data        (Data)
import Data.IORef       (IORef)
import Data.Typeable    (Typeable)
import Data.Word        (Word8)
import Foreign.Ptr      (Ptr)
import Foreign.C.Types  (CUChar(..))
import GHC.Generics

import Bindings.GLFW

--------------------------------------------------------------------------------

-- Error handling


-- | An enum for one of the <http://www.glfw.org/docs/3.3/group__errors.html#ga196e125ef261d94184e2b55c05762f14 GLFW error codes>.

data Error =
    Error'NotInitialized -- ^ <http://www.glfw.org/docs/3.3/group__errors.html#ga2374ee02c177f12e1fa76ff3ed15e14a doc>

  | Error'NoCurrentContext -- ^ <http://www.glfw.org/docs/3.3/group__errors.html#gaa8290386e9528ccb9e42a3a4e16fc0d0 doc>

  | Error'InvalidEnum -- ^ <http://www.glfw.org/docs/3.3/group__errors.html#ga76f6bb9c4eea73db675f096b404593ce doc>

  | Error'InvalidValue -- ^ <http://www.glfw.org/docs/3.3/group__errors.html#gaaf2ef9aa8202c2b82ac2d921e554c687 doc>

  | Error'OutOfMemory -- ^ <http://www.glfw.org/docs/3.3/group__errors.html#ga9023953a2bcb98c2906afd071d21ee7f doc>

  | Error'ApiUnavailable -- ^ <http://www.glfw.org/docs/3.3/group__errors.html#ga56882b290db23261cc6c053c40c2d08e doc>

  | Error'VersionUnavailable -- ^ <http://www.glfw.org/docs/3.3/group__errors.html#gad16c5565b4a69f9c2a9ac2c0dbc89462 doc>

  | Error'PlatformError -- ^ <http://www.glfw.org/docs/3.3/group__errors.html#gad44162d78100ea5e87cdd38426b8c7a1 doc>

  | Error'FormatUnavailable -- ^ <http://www.glfw.org/docs/3.3/group__errors.html#ga196e125ef261d94184e2b55c05762f14 doc>

  deriving (Error
Error -> Error -> Bounded Error
forall a. a -> a -> Bounded a
maxBound :: Error
$cmaxBound :: Error
minBound :: Error
$cminBound :: Error
Bounded, Typeable Error
DataType
Constr
Typeable Error =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Error -> c Error)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Error)
-> (Error -> Constr)
-> (Error -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Error))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error))
-> ((forall b. Data b => b -> b) -> Error -> Error)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r)
-> (forall u. (forall d. Data d => d -> u) -> Error -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Error -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Error -> m Error)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Error -> m Error)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Error -> m Error)
-> Data Error
Error -> DataType
Error -> Constr
(forall b. Data b => b -> b) -> Error -> Error
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
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) -> Error -> u
forall u. (forall d. Data d => d -> u) -> Error -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Error -> m Error
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Error)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error)
$cError'FormatUnavailable :: Constr
$cError'PlatformError :: Constr
$cError'VersionUnavailable :: Constr
$cError'ApiUnavailable :: Constr
$cError'OutOfMemory :: Constr
$cError'InvalidValue :: Constr
$cError'InvalidEnum :: Constr
$cError'NoCurrentContext :: Constr
$cError'NotInitialized :: Constr
$tError :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Error -> m Error
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
gmapMp :: (forall d. Data d => d -> m d) -> Error -> m Error
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
gmapM :: (forall d. Data d => d -> m d) -> Error -> m Error
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Error -> m Error
gmapQi :: Int -> (forall d. Data d => d -> u) -> Error -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Error -> u
gmapQ :: (forall d. Data d => d -> u) -> Error -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Error -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
gmapT :: (forall b. Data b => b -> b) -> Error -> Error
$cgmapT :: (forall b. Data b => b -> b) -> Error -> Error
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Error)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Error)
dataTypeOf :: Error -> DataType
$cdataTypeOf :: Error -> DataType
toConstr :: Error -> Constr
$ctoConstr :: Error -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
$cp1Data :: Typeable Error
Data, Int -> Error
Error -> Int
Error -> [Error]
Error -> Error
Error -> Error -> [Error]
Error -> Error -> Error -> [Error]
(Error -> Error)
-> (Error -> Error)
-> (Int -> Error)
-> (Error -> Int)
-> (Error -> [Error])
-> (Error -> Error -> [Error])
-> (Error -> Error -> [Error])
-> (Error -> Error -> Error -> [Error])
-> Enum Error
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Error -> Error -> Error -> [Error]
$cenumFromThenTo :: Error -> Error -> Error -> [Error]
enumFromTo :: Error -> Error -> [Error]
$cenumFromTo :: Error -> Error -> [Error]
enumFromThen :: Error -> Error -> [Error]
$cenumFromThen :: Error -> Error -> [Error]
enumFrom :: Error -> [Error]
$cenumFrom :: Error -> [Error]
fromEnum :: Error -> Int
$cfromEnum :: Error -> Int
toEnum :: Int -> Error
$ctoEnum :: Int -> Error
pred :: Error -> Error
$cpred :: Error -> Error
succ :: Error -> Error
$csucc :: Error -> Error
Enum, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Eq Error
Eq Error =>
(Error -> Error -> Ordering)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Bool)
-> (Error -> Error -> Error)
-> (Error -> Error -> Error)
-> Ord Error
Error -> Error -> Bool
Error -> Error -> Ordering
Error -> Error -> Error
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 :: Error -> Error -> Error
$cmin :: Error -> Error -> Error
max :: Error -> Error -> Error
$cmax :: Error -> Error -> Error
>= :: Error -> Error -> Bool
$c>= :: Error -> Error -> Bool
> :: Error -> Error -> Bool
$c> :: Error -> Error -> Bool
<= :: Error -> Error -> Bool
$c<= :: Error -> Error -> Bool
< :: Error -> Error -> Bool
$c< :: Error -> Error -> Bool
compare :: Error -> Error -> Ordering
$ccompare :: Error -> Error -> Ordering
$cp1Ord :: Eq Error
Ord, ReadPrec [Error]
ReadPrec Error
Int -> ReadS Error
ReadS [Error]
(Int -> ReadS Error)
-> ReadS [Error]
-> ReadPrec Error
-> ReadPrec [Error]
-> Read Error
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Error]
$creadListPrec :: ReadPrec [Error]
readPrec :: ReadPrec Error
$creadPrec :: ReadPrec Error
readList :: ReadS [Error]
$creadList :: ReadS [Error]
readsPrec :: Int -> ReadS Error
$creadsPrec :: Int -> ReadS Error
Read, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show, Typeable, (forall x. Error -> Rep Error x)
-> (forall x. Rep Error x -> Error) -> Generic Error
forall x. Rep Error x -> Error
forall x. Error -> Rep Error x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Error x -> Error
$cfrom :: forall x. Error -> Rep Error x
Generic)

instance NFData Error

--------------------------------------------------------------------------------

-- Initialization and version information


-- | Initialization hints are set before glfwInit and affect how the library

-- behaves until termination. Hints are set with glfwInitHint. See

-- <https://www.glfw.org/docs/3.3/intro_guide.html#init_hints Init Hints>

data InitHint
  = InitHint'JoystickHatButtons
  | InitHint'CocoaChdirResources
  | InitHint'CocoaMenubar
  deriving (InitHint
InitHint -> InitHint -> Bounded InitHint
forall a. a -> a -> Bounded a
maxBound :: InitHint
$cmaxBound :: InitHint
minBound :: InitHint
$cminBound :: InitHint
Bounded, Typeable InitHint
DataType
Constr
Typeable InitHint =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> InitHint -> c InitHint)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InitHint)
-> (InitHint -> Constr)
-> (InitHint -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InitHint))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InitHint))
-> ((forall b. Data b => b -> b) -> InitHint -> InitHint)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InitHint -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InitHint -> r)
-> (forall u. (forall d. Data d => d -> u) -> InitHint -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> InitHint -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> InitHint -> m InitHint)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> InitHint -> m InitHint)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> InitHint -> m InitHint)
-> Data InitHint
InitHint -> DataType
InitHint -> Constr
(forall b. Data b => b -> b) -> InitHint -> InitHint
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InitHint -> c InitHint
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InitHint
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) -> InitHint -> u
forall u. (forall d. Data d => d -> u) -> InitHint -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InitHint -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InitHint -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InitHint -> m InitHint
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InitHint -> m InitHint
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InitHint
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InitHint -> c InitHint
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InitHint)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InitHint)
$cInitHint'CocoaMenubar :: Constr
$cInitHint'CocoaChdirResources :: Constr
$cInitHint'JoystickHatButtons :: Constr
$tInitHint :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> InitHint -> m InitHint
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InitHint -> m InitHint
gmapMp :: (forall d. Data d => d -> m d) -> InitHint -> m InitHint
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InitHint -> m InitHint
gmapM :: (forall d. Data d => d -> m d) -> InitHint -> m InitHint
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InitHint -> m InitHint
gmapQi :: Int -> (forall d. Data d => d -> u) -> InitHint -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InitHint -> u
gmapQ :: (forall d. Data d => d -> u) -> InitHint -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InitHint -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InitHint -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InitHint -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InitHint -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InitHint -> r
gmapT :: (forall b. Data b => b -> b) -> InitHint -> InitHint
$cgmapT :: (forall b. Data b => b -> b) -> InitHint -> InitHint
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InitHint)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InitHint)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c InitHint)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InitHint)
dataTypeOf :: InitHint -> DataType
$cdataTypeOf :: InitHint -> DataType
toConstr :: InitHint -> Constr
$ctoConstr :: InitHint -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InitHint
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InitHint
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InitHint -> c InitHint
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InitHint -> c InitHint
$cp1Data :: Typeable InitHint
Data, Int -> InitHint
InitHint -> Int
InitHint -> [InitHint]
InitHint -> InitHint
InitHint -> InitHint -> [InitHint]
InitHint -> InitHint -> InitHint -> [InitHint]
(InitHint -> InitHint)
-> (InitHint -> InitHint)
-> (Int -> InitHint)
-> (InitHint -> Int)
-> (InitHint -> [InitHint])
-> (InitHint -> InitHint -> [InitHint])
-> (InitHint -> InitHint -> [InitHint])
-> (InitHint -> InitHint -> InitHint -> [InitHint])
-> Enum InitHint
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: InitHint -> InitHint -> InitHint -> [InitHint]
$cenumFromThenTo :: InitHint -> InitHint -> InitHint -> [InitHint]
enumFromTo :: InitHint -> InitHint -> [InitHint]
$cenumFromTo :: InitHint -> InitHint -> [InitHint]
enumFromThen :: InitHint -> InitHint -> [InitHint]
$cenumFromThen :: InitHint -> InitHint -> [InitHint]
enumFrom :: InitHint -> [InitHint]
$cenumFrom :: InitHint -> [InitHint]
fromEnum :: InitHint -> Int
$cfromEnum :: InitHint -> Int
toEnum :: Int -> InitHint
$ctoEnum :: Int -> InitHint
pred :: InitHint -> InitHint
$cpred :: InitHint -> InitHint
succ :: InitHint -> InitHint
$csucc :: InitHint -> InitHint
Enum, InitHint -> InitHint -> Bool
(InitHint -> InitHint -> Bool)
-> (InitHint -> InitHint -> Bool) -> Eq InitHint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitHint -> InitHint -> Bool
$c/= :: InitHint -> InitHint -> Bool
== :: InitHint -> InitHint -> Bool
$c== :: InitHint -> InitHint -> Bool
Eq, Eq InitHint
Eq InitHint =>
(InitHint -> InitHint -> Ordering)
-> (InitHint -> InitHint -> Bool)
-> (InitHint -> InitHint -> Bool)
-> (InitHint -> InitHint -> Bool)
-> (InitHint -> InitHint -> Bool)
-> (InitHint -> InitHint -> InitHint)
-> (InitHint -> InitHint -> InitHint)
-> Ord InitHint
InitHint -> InitHint -> Bool
InitHint -> InitHint -> Ordering
InitHint -> InitHint -> InitHint
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 :: InitHint -> InitHint -> InitHint
$cmin :: InitHint -> InitHint -> InitHint
max :: InitHint -> InitHint -> InitHint
$cmax :: InitHint -> InitHint -> InitHint
>= :: InitHint -> InitHint -> Bool
$c>= :: InitHint -> InitHint -> Bool
> :: InitHint -> InitHint -> Bool
$c> :: InitHint -> InitHint -> Bool
<= :: InitHint -> InitHint -> Bool
$c<= :: InitHint -> InitHint -> Bool
< :: InitHint -> InitHint -> Bool
$c< :: InitHint -> InitHint -> Bool
compare :: InitHint -> InitHint -> Ordering
$ccompare :: InitHint -> InitHint -> Ordering
$cp1Ord :: Eq InitHint
Ord, ReadPrec [InitHint]
ReadPrec InitHint
Int -> ReadS InitHint
ReadS [InitHint]
(Int -> ReadS InitHint)
-> ReadS [InitHint]
-> ReadPrec InitHint
-> ReadPrec [InitHint]
-> Read InitHint
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitHint]
$creadListPrec :: ReadPrec [InitHint]
readPrec :: ReadPrec InitHint
$creadPrec :: ReadPrec InitHint
readList :: ReadS [InitHint]
$creadList :: ReadS [InitHint]
readsPrec :: Int -> ReadS InitHint
$creadsPrec :: Int -> ReadS InitHint
Read, Int -> InitHint -> ShowS
[InitHint] -> ShowS
InitHint -> String
(Int -> InitHint -> ShowS)
-> (InitHint -> String) -> ([InitHint] -> ShowS) -> Show InitHint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitHint] -> ShowS
$cshowList :: [InitHint] -> ShowS
show :: InitHint -> String
$cshow :: InitHint -> String
showsPrec :: Int -> InitHint -> ShowS
$cshowsPrec :: Int -> InitHint -> ShowS
Show, Typeable, (forall x. InitHint -> Rep InitHint x)
-> (forall x. Rep InitHint x -> InitHint) -> Generic InitHint
forall x. Rep InitHint x -> InitHint
forall x. InitHint -> Rep InitHint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InitHint x -> InitHint
$cfrom :: forall x. InitHint -> Rep InitHint x
Generic)

instance NFData InitHint

-- | The library version of the GLFW implementation in use.

-- See <http://www.glfw.org/docs/3.3/intro.html#intro_version Version Management>

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

instance NFData Version

--------------------------------------------------------------------------------

-- Monitor handling


-- | Represents a physical monitor that's currently connected.

-- See the <http://www.glfw.org/docs/3.3/monitor.html Monitor Guide>

newtype Monitor = Monitor
  { Monitor -> Ptr C'GLFWmonitor
unMonitor :: Ptr C'GLFWmonitor
  } deriving (Typeable Monitor
DataType
Constr
Typeable Monitor =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Monitor -> c Monitor)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Monitor)
-> (Monitor -> Constr)
-> (Monitor -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Monitor))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Monitor))
-> ((forall b. Data b => b -> b) -> Monitor -> Monitor)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Monitor -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Monitor -> r)
-> (forall u. (forall d. Data d => d -> u) -> Monitor -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Monitor -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Monitor -> m Monitor)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Monitor -> m Monitor)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Monitor -> m Monitor)
-> Data Monitor
Monitor -> DataType
Monitor -> Constr
(forall b. Data b => b -> b) -> Monitor -> Monitor
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Monitor -> c Monitor
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Monitor
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) -> Monitor -> u
forall u. (forall d. Data d => d -> u) -> Monitor -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Monitor -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Monitor -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Monitor -> m Monitor
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Monitor -> m Monitor
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Monitor
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Monitor -> c Monitor
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Monitor)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Monitor)
$cMonitor :: Constr
$tMonitor :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Monitor -> m Monitor
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Monitor -> m Monitor
gmapMp :: (forall d. Data d => d -> m d) -> Monitor -> m Monitor
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Monitor -> m Monitor
gmapM :: (forall d. Data d => d -> m d) -> Monitor -> m Monitor
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Monitor -> m Monitor
gmapQi :: Int -> (forall d. Data d => d -> u) -> Monitor -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Monitor -> u
gmapQ :: (forall d. Data d => d -> u) -> Monitor -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Monitor -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Monitor -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Monitor -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Monitor -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Monitor -> r
gmapT :: (forall b. Data b => b -> b) -> Monitor -> Monitor
$cgmapT :: (forall b. Data b => b -> b) -> Monitor -> Monitor
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Monitor)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Monitor)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Monitor)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Monitor)
dataTypeOf :: Monitor -> DataType
$cdataTypeOf :: Monitor -> DataType
toConstr :: Monitor -> Constr
$ctoConstr :: Monitor -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Monitor
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Monitor
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Monitor -> c Monitor
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Monitor -> c Monitor
$cp1Data :: Typeable Monitor
Data, Monitor -> Monitor -> Bool
(Monitor -> Monitor -> Bool)
-> (Monitor -> Monitor -> Bool) -> Eq Monitor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Monitor -> Monitor -> Bool
$c/= :: Monitor -> Monitor -> Bool
== :: Monitor -> Monitor -> Bool
$c== :: Monitor -> Monitor -> Bool
Eq, Eq Monitor
Eq Monitor =>
(Monitor -> Monitor -> Ordering)
-> (Monitor -> Monitor -> Bool)
-> (Monitor -> Monitor -> Bool)
-> (Monitor -> Monitor -> Bool)
-> (Monitor -> Monitor -> Bool)
-> (Monitor -> Monitor -> Monitor)
-> (Monitor -> Monitor -> Monitor)
-> Ord Monitor
Monitor -> Monitor -> Bool
Monitor -> Monitor -> Ordering
Monitor -> Monitor -> Monitor
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 :: Monitor -> Monitor -> Monitor
$cmin :: Monitor -> Monitor -> Monitor
max :: Monitor -> Monitor -> Monitor
$cmax :: Monitor -> Monitor -> Monitor
>= :: Monitor -> Monitor -> Bool
$c>= :: Monitor -> Monitor -> Bool
> :: Monitor -> Monitor -> Bool
$c> :: Monitor -> Monitor -> Bool
<= :: Monitor -> Monitor -> Bool
$c<= :: Monitor -> Monitor -> Bool
< :: Monitor -> Monitor -> Bool
$c< :: Monitor -> Monitor -> Bool
compare :: Monitor -> Monitor -> Ordering
$ccompare :: Monitor -> Monitor -> Ordering
$cp1Ord :: Eq Monitor
Ord, Int -> Monitor -> ShowS
[Monitor] -> ShowS
Monitor -> String
(Int -> Monitor -> ShowS)
-> (Monitor -> String) -> ([Monitor] -> ShowS) -> Show Monitor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Monitor] -> ShowS
$cshowList :: [Monitor] -> ShowS
show :: Monitor -> String
$cshow :: Monitor -> String
showsPrec :: Int -> Monitor -> ShowS
$cshowsPrec :: Int -> Monitor -> ShowS
Show, Typeable, (forall x. Monitor -> Rep Monitor x)
-> (forall x. Rep Monitor x -> Monitor) -> Generic Monitor
forall x. Rep Monitor x -> Monitor
forall x. Monitor -> Rep Monitor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Monitor x -> Monitor
$cfrom :: forall x. Monitor -> Rep Monitor x
Generic)

-- | Part of the t'Graphics.UI.GLFW.MonitorCallback', for when a monitor gets

-- connected or disconnected.

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

instance NFData MonitorState

-- | See <http://www.glfw.org/docs/3.3/monitor.html#monitor_modes Video Modes>

data VideoMode = VideoMode
  { VideoMode -> Int
videoModeWidth       :: {-# UNPACK #-} !Int
  , VideoMode -> Int
videoModeHeight      :: {-# UNPACK #-} !Int
  , VideoMode -> Int
videoModeRedBits     :: {-# UNPACK #-} !Int
  , VideoMode -> Int
videoModeGreenBits   :: {-# UNPACK #-} !Int
  , VideoMode -> Int
videoModeBlueBits    :: {-# UNPACK #-} !Int
  , VideoMode -> Int
videoModeRefreshRate :: {-# UNPACK #-} !Int
  } deriving (Typeable VideoMode
DataType
Constr
Typeable VideoMode =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> VideoMode -> c VideoMode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c VideoMode)
-> (VideoMode -> Constr)
-> (VideoMode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c VideoMode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VideoMode))
-> ((forall b. Data b => b -> b) -> VideoMode -> VideoMode)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> VideoMode -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> VideoMode -> r)
-> (forall u. (forall d. Data d => d -> u) -> VideoMode -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> VideoMode -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> VideoMode -> m VideoMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> VideoMode -> m VideoMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> VideoMode -> m VideoMode)
-> Data VideoMode
VideoMode -> DataType
VideoMode -> Constr
(forall b. Data b => b -> b) -> VideoMode -> VideoMode
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VideoMode -> c VideoMode
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VideoMode
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) -> VideoMode -> u
forall u. (forall d. Data d => d -> u) -> VideoMode -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VideoMode -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VideoMode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VideoMode -> m VideoMode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VideoMode -> m VideoMode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VideoMode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VideoMode -> c VideoMode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VideoMode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VideoMode)
$cVideoMode :: Constr
$tVideoMode :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> VideoMode -> m VideoMode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VideoMode -> m VideoMode
gmapMp :: (forall d. Data d => d -> m d) -> VideoMode -> m VideoMode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VideoMode -> m VideoMode
gmapM :: (forall d. Data d => d -> m d) -> VideoMode -> m VideoMode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VideoMode -> m VideoMode
gmapQi :: Int -> (forall d. Data d => d -> u) -> VideoMode -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> VideoMode -> u
gmapQ :: (forall d. Data d => d -> u) -> VideoMode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> VideoMode -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VideoMode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VideoMode -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VideoMode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VideoMode -> r
gmapT :: (forall b. Data b => b -> b) -> VideoMode -> VideoMode
$cgmapT :: (forall b. Data b => b -> b) -> VideoMode -> VideoMode
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VideoMode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VideoMode)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c VideoMode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VideoMode)
dataTypeOf :: VideoMode -> DataType
$cdataTypeOf :: VideoMode -> DataType
toConstr :: VideoMode -> Constr
$ctoConstr :: VideoMode -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VideoMode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VideoMode
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VideoMode -> c VideoMode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VideoMode -> c VideoMode
$cp1Data :: Typeable VideoMode
Data, VideoMode -> VideoMode -> Bool
(VideoMode -> VideoMode -> Bool)
-> (VideoMode -> VideoMode -> Bool) -> Eq VideoMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoMode -> VideoMode -> Bool
$c/= :: VideoMode -> VideoMode -> Bool
== :: VideoMode -> VideoMode -> Bool
$c== :: VideoMode -> VideoMode -> Bool
Eq, Eq VideoMode
Eq VideoMode =>
(VideoMode -> VideoMode -> Ordering)
-> (VideoMode -> VideoMode -> Bool)
-> (VideoMode -> VideoMode -> Bool)
-> (VideoMode -> VideoMode -> Bool)
-> (VideoMode -> VideoMode -> Bool)
-> (VideoMode -> VideoMode -> VideoMode)
-> (VideoMode -> VideoMode -> VideoMode)
-> Ord VideoMode
VideoMode -> VideoMode -> Bool
VideoMode -> VideoMode -> Ordering
VideoMode -> VideoMode -> VideoMode
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 :: VideoMode -> VideoMode -> VideoMode
$cmin :: VideoMode -> VideoMode -> VideoMode
max :: VideoMode -> VideoMode -> VideoMode
$cmax :: VideoMode -> VideoMode -> VideoMode
>= :: VideoMode -> VideoMode -> Bool
$c>= :: VideoMode -> VideoMode -> Bool
> :: VideoMode -> VideoMode -> Bool
$c> :: VideoMode -> VideoMode -> Bool
<= :: VideoMode -> VideoMode -> Bool
$c<= :: VideoMode -> VideoMode -> Bool
< :: VideoMode -> VideoMode -> Bool
$c< :: VideoMode -> VideoMode -> Bool
compare :: VideoMode -> VideoMode -> Ordering
$ccompare :: VideoMode -> VideoMode -> Ordering
$cp1Ord :: Eq VideoMode
Ord, ReadPrec [VideoMode]
ReadPrec VideoMode
Int -> ReadS VideoMode
ReadS [VideoMode]
(Int -> ReadS VideoMode)
-> ReadS [VideoMode]
-> ReadPrec VideoMode
-> ReadPrec [VideoMode]
-> Read VideoMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VideoMode]
$creadListPrec :: ReadPrec [VideoMode]
readPrec :: ReadPrec VideoMode
$creadPrec :: ReadPrec VideoMode
readList :: ReadS [VideoMode]
$creadList :: ReadS [VideoMode]
readsPrec :: Int -> ReadS VideoMode
$creadsPrec :: Int -> ReadS VideoMode
Read, Int -> VideoMode -> ShowS
[VideoMode] -> ShowS
VideoMode -> String
(Int -> VideoMode -> ShowS)
-> (VideoMode -> String)
-> ([VideoMode] -> ShowS)
-> Show VideoMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoMode] -> ShowS
$cshowList :: [VideoMode] -> ShowS
show :: VideoMode -> String
$cshow :: VideoMode -> String
showsPrec :: Int -> VideoMode -> ShowS
$cshowsPrec :: Int -> VideoMode -> ShowS
Show, Typeable, (forall x. VideoMode -> Rep VideoMode x)
-> (forall x. Rep VideoMode x -> VideoMode) -> Generic VideoMode
forall x. Rep VideoMode x -> VideoMode
forall x. VideoMode -> Rep VideoMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VideoMode x -> VideoMode
$cfrom :: forall x. VideoMode -> Rep VideoMode x
Generic)

instance NFData VideoMode

-- | Lets you adjust the gamma of a monitor. To ensure that only valid values are created, use 'makeGammaRamp'.

-- See <http://www.glfw.org/docs/3.3/monitor.html#monitor_gamma Gamma Ramp>.

data GammaRamp = GammaRamp
  -- NOTE: It would be bad to give clients a way to construct invalid gamma ramps

  -- with lists of unequal length, so this constructor should not be exported.

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

instance NFData GammaRamp

-- | Smart constructor for a 'GammaRamp'.

makeGammaRamp :: [Int] -> [Int] -> [Int] -> Maybe GammaRamp
makeGammaRamp :: [Int] -> [Int] -> [Int] -> Maybe GammaRamp
makeGammaRamp rs :: [Int]
rs gs :: [Int]
gs bs :: [Int]
bs
    | Bool
lengthsEqual = GammaRamp -> Maybe GammaRamp
forall a. a -> Maybe a
Just (GammaRamp -> Maybe GammaRamp) -> GammaRamp -> Maybe GammaRamp
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [Int] -> GammaRamp
GammaRamp [Int]
rs [Int]
gs [Int]
bs
    | Bool
otherwise    = Maybe GammaRamp
forall a. Maybe a
Nothing
  where
    lengthsEqual :: Bool
lengthsEqual =
      let rsl :: Int
rsl = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
rs
          gsl :: Int
gsl = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
gs
          bsl :: Int
bsl = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
bs
      in Int
rsl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
gsl Bool -> Bool -> Bool
&& Int
gsl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
bsl

--------------------------------------------------------------------------------

-- Window handling


-- | Collects all the callbacks that can be associated with a Window into a single place.

data WindowCallbacks = WindowCallbacks
  { WindowCallbacks -> IORef C'GLFWcharfun
storedCharFun               :: !(IORef C'GLFWcharfun)
  , WindowCallbacks -> IORef C'GLFWcharmodsfun
storedCharModsFun           :: !(IORef C'GLFWcharmodsfun)
  , WindowCallbacks -> IORef C'GLFWcursorenterfun
storedCursorEnterFun        :: !(IORef C'GLFWcursorenterfun)
  , WindowCallbacks -> IORef C'GLFWcursorposfun
storedCursorPosFun          :: !(IORef C'GLFWcursorposfun)
  , WindowCallbacks -> IORef C'GLFWframebuffersizefun
storedFramebufferSizeFun    :: !(IORef C'GLFWframebuffersizefun)
  , WindowCallbacks -> IORef C'GLFWkeyfun
storedKeyFun                :: !(IORef C'GLFWkeyfun)
  , WindowCallbacks -> IORef C'GLFWmousebuttonfun
storedMouseButtonFun        :: !(IORef C'GLFWmousebuttonfun)
  , WindowCallbacks -> IORef C'GLFWcursorposfun
storedScrollFun             :: !(IORef C'GLFWscrollfun)
  , WindowCallbacks -> IORef C'GLFWwindowclosefun
storedWindowCloseFun        :: !(IORef C'GLFWwindowclosefun)
  , WindowCallbacks -> IORef C'GLFWcursorenterfun
storedWindowFocusFun        :: !(IORef C'GLFWwindowfocusfun)
  , WindowCallbacks -> IORef C'GLFWcursorenterfun
storedWindowIconifyFun      :: !(IORef C'GLFWwindowiconifyfun)
  , WindowCallbacks -> IORef C'GLFWframebuffersizefun
storedWindowPosFun          :: !(IORef C'GLFWwindowposfun)
  , WindowCallbacks -> IORef C'GLFWwindowclosefun
storedWindowRefreshFun      :: !(IORef C'GLFWwindowrefreshfun)
  , WindowCallbacks -> IORef C'GLFWframebuffersizefun
storedWindowSizeFun         :: !(IORef C'GLFWwindowsizefun)
  , WindowCallbacks -> IORef C'GLFWwindowcontentscalefun
storedWindowContentScaleFun :: !(IORef C'GLFWwindowcontentscalefun)
  , WindowCallbacks -> IORef C'GLFWcursorenterfun
storedWindowMaximizeFun     :: !(IORef C'GLFWwindowmaximizefun)
  , WindowCallbacks -> IORef C'GLFWdropfun
storedDropFun               :: !(IORef C'GLFWdropfun)
  }

-- | Represents a GLFW window value.

-- See the <http://www.glfw.org/docs/3.3/window.html Window Guide>

newtype Window = Window
  { Window -> Ptr C'GLFWwindow
unWindow :: Ptr C'GLFWwindow
  } deriving (Typeable Window
DataType
Constr
Typeable Window =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Window -> c Window)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Window)
-> (Window -> Constr)
-> (Window -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Window))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Window))
-> ((forall b. Data b => b -> b) -> Window -> Window)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Window -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Window -> r)
-> (forall u. (forall d. Data d => d -> u) -> Window -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Window -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Window -> m Window)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Window -> m Window)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Window -> m Window)
-> Data Window
Window -> DataType
Window -> Constr
(forall b. Data b => b -> b) -> Window -> Window
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Window -> c Window
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Window
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) -> Window -> u
forall u. (forall d. Data d => d -> u) -> Window -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Window -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Window -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Window -> m Window
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Window -> m Window
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Window
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Window -> c Window
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Window)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Window)
$cWindow :: Constr
$tWindow :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Window -> m Window
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Window -> m Window
gmapMp :: (forall d. Data d => d -> m d) -> Window -> m Window
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Window -> m Window
gmapM :: (forall d. Data d => d -> m d) -> Window -> m Window
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Window -> m Window
gmapQi :: Int -> (forall d. Data d => d -> u) -> Window -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Window -> u
gmapQ :: (forall d. Data d => d -> u) -> Window -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Window -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Window -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Window -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Window -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Window -> r
gmapT :: (forall b. Data b => b -> b) -> Window -> Window
$cgmapT :: (forall b. Data b => b -> b) -> Window -> Window
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Window)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Window)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Window)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Window)
dataTypeOf :: Window -> DataType
$cdataTypeOf :: Window -> DataType
toConstr :: Window -> Constr
$ctoConstr :: Window -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Window
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Window
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Window -> c Window
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Window -> c Window
$cp1Data :: Typeable Window
Data, Window -> Window -> Bool
(Window -> Window -> Bool)
-> (Window -> Window -> Bool) -> Eq Window
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Window -> Window -> Bool
$c/= :: Window -> Window -> Bool
== :: Window -> Window -> Bool
$c== :: Window -> Window -> Bool
Eq, Eq Window
Eq Window =>
(Window -> Window -> Ordering)
-> (Window -> Window -> Bool)
-> (Window -> Window -> Bool)
-> (Window -> Window -> Bool)
-> (Window -> Window -> Bool)
-> (Window -> Window -> Window)
-> (Window -> Window -> Window)
-> Ord Window
Window -> Window -> Bool
Window -> Window -> Ordering
Window -> Window -> Window
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 :: Window -> Window -> Window
$cmin :: Window -> Window -> Window
max :: Window -> Window -> Window
$cmax :: Window -> Window -> Window
>= :: Window -> Window -> Bool
$c>= :: Window -> Window -> Bool
> :: Window -> Window -> Bool
$c> :: Window -> Window -> Bool
<= :: Window -> Window -> Bool
$c<= :: Window -> Window -> Bool
< :: Window -> Window -> Bool
$c< :: Window -> Window -> Bool
compare :: Window -> Window -> Ordering
$ccompare :: Window -> Window -> Ordering
$cp1Ord :: Eq Window
Ord, Int -> Window -> ShowS
[Window] -> ShowS
Window -> String
(Int -> Window -> ShowS)
-> (Window -> String) -> ([Window] -> ShowS) -> Show Window
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Window] -> ShowS
$cshowList :: [Window] -> ShowS
show :: Window -> String
$cshow :: Window -> String
showsPrec :: Int -> Window -> ShowS
$cshowsPrec :: Int -> Window -> ShowS
Show, Typeable, (forall x. Window -> Rep Window x)
-> (forall x. Rep Window x -> Window) -> Generic Window
forall x. Rep Window x -> Window
forall x. Window -> Rep Window x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Window x -> Window
$cfrom :: forall x. Window -> Rep Window x
Generic)

-- | Lets you set various window hints before creating a 'Window'.

-- See <http://www.glfw.org/docs/3.3/window.html#window_hints Window Hints>,

-- particularly <http://www.glfw.org/docs/3.3/window.html#window_hints_values Supported and Default Values>.

data WindowHint =
    WindowHint'Resizable              !Bool
  | WindowHint'Visible                !Bool
  | WindowHint'Decorated              !Bool
  | WindowHint'RedBits                !(Maybe Int)
  | WindowHint'GreenBits              !(Maybe Int)
  | WindowHint'BlueBits               !(Maybe Int)
  | WindowHint'AlphaBits              !(Maybe Int)
  | WindowHint'DepthBits              !(Maybe Int)
  | WindowHint'StencilBits            !(Maybe Int)
  | WindowHint'AccumRedBits           !(Maybe Int)
  | WindowHint'AccumGreenBits         !(Maybe Int)
  | WindowHint'AccumBlueBits          !(Maybe Int)
  | WindowHint'AccumAlphaBits         !(Maybe Int)
  | WindowHint'AuxBuffers             !(Maybe Int)
  | WindowHint'Samples                !(Maybe Int)
  | WindowHint'RefreshRate            !(Maybe Int)
  | WindowHint'DoubleBuffer           !Bool
  | WindowHint'Stereo                 !Bool
  | WindowHint'sRGBCapable            !Bool
  | WindowHint'Floating               !Bool
  | WindowHint'Focused                !Bool
  | WindowHint'Maximized              !Bool
  | WindowHint'AutoIconify            !Bool
  | WindowHint'ClientAPI              !ClientAPI
  | WindowHint'ContextCreationAPI     !ContextCreationAPI
  | WindowHint'ContextVersionMajor    {-# UNPACK #-} !Int
  | WindowHint'ContextVersionMinor    {-# UNPACK #-} !Int
  | WindowHint'ContextRobustness      !ContextRobustness
  | WindowHint'ContextReleaseBehavior !ContextReleaseBehavior
  | WindowHint'ContextNoError         !Bool
  | WindowHint'OpenGLForwardCompat    !Bool
  | WindowHint'OpenGLDebugContext     !Bool
  | WindowHint'OpenGLProfile          !OpenGLProfile
  | WindowHint'TransparentFramebuffer !Bool
  | WindowHint'CenterCursor           !Bool
  | WindowHint'FocusOnShow            !Bool
  | WindowHint'ScaleToMonitor         !Bool
  | WindowHint'CocoaRetinaFramebuffer !Bool
  | WindowHint'CocoaGraphicsSwitching !Bool
  | WindowHint'CocoaFrameName         !String
  | WindowHint'X11ClassName           !String
  | WindowHint'X11InstanceName        !String
  deriving (Typeable WindowHint
DataType
Constr
Typeable WindowHint =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> WindowHint -> c WindowHint)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c WindowHint)
-> (WindowHint -> Constr)
-> (WindowHint -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c WindowHint))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c WindowHint))
-> ((forall b. Data b => b -> b) -> WindowHint -> WindowHint)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> WindowHint -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> WindowHint -> r)
-> (forall u. (forall d. Data d => d -> u) -> WindowHint -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> WindowHint -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> WindowHint -> m WindowHint)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WindowHint -> m WindowHint)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WindowHint -> m WindowHint)
-> Data WindowHint
WindowHint -> DataType
WindowHint -> Constr
(forall b. Data b => b -> b) -> WindowHint -> WindowHint
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowHint -> c WindowHint
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowHint
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) -> WindowHint -> u
forall u. (forall d. Data d => d -> u) -> WindowHint -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowHint -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowHint -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WindowHint -> m WindowHint
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WindowHint -> m WindowHint
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowHint
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowHint -> c WindowHint
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WindowHint)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WindowHint)
$cWindowHint'X11InstanceName :: Constr
$cWindowHint'X11ClassName :: Constr
$cWindowHint'CocoaFrameName :: Constr
$cWindowHint'CocoaGraphicsSwitching :: Constr
$cWindowHint'CocoaRetinaFramebuffer :: Constr
$cWindowHint'ScaleToMonitor :: Constr
$cWindowHint'FocusOnShow :: Constr
$cWindowHint'CenterCursor :: Constr
$cWindowHint'TransparentFramebuffer :: Constr
$cWindowHint'OpenGLProfile :: Constr
$cWindowHint'OpenGLDebugContext :: Constr
$cWindowHint'OpenGLForwardCompat :: Constr
$cWindowHint'ContextNoError :: Constr
$cWindowHint'ContextReleaseBehavior :: Constr
$cWindowHint'ContextRobustness :: Constr
$cWindowHint'ContextVersionMinor :: Constr
$cWindowHint'ContextVersionMajor :: Constr
$cWindowHint'ContextCreationAPI :: Constr
$cWindowHint'ClientAPI :: Constr
$cWindowHint'AutoIconify :: Constr
$cWindowHint'Maximized :: Constr
$cWindowHint'Focused :: Constr
$cWindowHint'Floating :: Constr
$cWindowHint'sRGBCapable :: Constr
$cWindowHint'Stereo :: Constr
$cWindowHint'DoubleBuffer :: Constr
$cWindowHint'RefreshRate :: Constr
$cWindowHint'Samples :: Constr
$cWindowHint'AuxBuffers :: Constr
$cWindowHint'AccumAlphaBits :: Constr
$cWindowHint'AccumBlueBits :: Constr
$cWindowHint'AccumGreenBits :: Constr
$cWindowHint'AccumRedBits :: Constr
$cWindowHint'StencilBits :: Constr
$cWindowHint'DepthBits :: Constr
$cWindowHint'AlphaBits :: Constr
$cWindowHint'BlueBits :: Constr
$cWindowHint'GreenBits :: Constr
$cWindowHint'RedBits :: Constr
$cWindowHint'Decorated :: Constr
$cWindowHint'Visible :: Constr
$cWindowHint'Resizable :: Constr
$tWindowHint :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> WindowHint -> m WindowHint
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WindowHint -> m WindowHint
gmapMp :: (forall d. Data d => d -> m d) -> WindowHint -> m WindowHint
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WindowHint -> m WindowHint
gmapM :: (forall d. Data d => d -> m d) -> WindowHint -> m WindowHint
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WindowHint -> m WindowHint
gmapQi :: Int -> (forall d. Data d => d -> u) -> WindowHint -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WindowHint -> u
gmapQ :: (forall d. Data d => d -> u) -> WindowHint -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WindowHint -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowHint -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowHint -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowHint -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowHint -> r
gmapT :: (forall b. Data b => b -> b) -> WindowHint -> WindowHint
$cgmapT :: (forall b. Data b => b -> b) -> WindowHint -> WindowHint
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WindowHint)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WindowHint)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c WindowHint)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WindowHint)
dataTypeOf :: WindowHint -> DataType
$cdataTypeOf :: WindowHint -> DataType
toConstr :: WindowHint -> Constr
$ctoConstr :: WindowHint -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowHint
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowHint
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowHint -> c WindowHint
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowHint -> c WindowHint
$cp1Data :: Typeable WindowHint
Data, WindowHint -> WindowHint -> Bool
(WindowHint -> WindowHint -> Bool)
-> (WindowHint -> WindowHint -> Bool) -> Eq WindowHint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowHint -> WindowHint -> Bool
$c/= :: WindowHint -> WindowHint -> Bool
== :: WindowHint -> WindowHint -> Bool
$c== :: WindowHint -> WindowHint -> Bool
Eq, Eq WindowHint
Eq WindowHint =>
(WindowHint -> WindowHint -> Ordering)
-> (WindowHint -> WindowHint -> Bool)
-> (WindowHint -> WindowHint -> Bool)
-> (WindowHint -> WindowHint -> Bool)
-> (WindowHint -> WindowHint -> Bool)
-> (WindowHint -> WindowHint -> WindowHint)
-> (WindowHint -> WindowHint -> WindowHint)
-> Ord WindowHint
WindowHint -> WindowHint -> Bool
WindowHint -> WindowHint -> Ordering
WindowHint -> WindowHint -> WindowHint
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 :: WindowHint -> WindowHint -> WindowHint
$cmin :: WindowHint -> WindowHint -> WindowHint
max :: WindowHint -> WindowHint -> WindowHint
$cmax :: WindowHint -> WindowHint -> WindowHint
>= :: WindowHint -> WindowHint -> Bool
$c>= :: WindowHint -> WindowHint -> Bool
> :: WindowHint -> WindowHint -> Bool
$c> :: WindowHint -> WindowHint -> Bool
<= :: WindowHint -> WindowHint -> Bool
$c<= :: WindowHint -> WindowHint -> Bool
< :: WindowHint -> WindowHint -> Bool
$c< :: WindowHint -> WindowHint -> Bool
compare :: WindowHint -> WindowHint -> Ordering
$ccompare :: WindowHint -> WindowHint -> Ordering
$cp1Ord :: Eq WindowHint
Ord, ReadPrec [WindowHint]
ReadPrec WindowHint
Int -> ReadS WindowHint
ReadS [WindowHint]
(Int -> ReadS WindowHint)
-> ReadS [WindowHint]
-> ReadPrec WindowHint
-> ReadPrec [WindowHint]
-> Read WindowHint
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WindowHint]
$creadListPrec :: ReadPrec [WindowHint]
readPrec :: ReadPrec WindowHint
$creadPrec :: ReadPrec WindowHint
readList :: ReadS [WindowHint]
$creadList :: ReadS [WindowHint]
readsPrec :: Int -> ReadS WindowHint
$creadsPrec :: Int -> ReadS WindowHint
Read, Int -> WindowHint -> ShowS
[WindowHint] -> ShowS
WindowHint -> String
(Int -> WindowHint -> ShowS)
-> (WindowHint -> String)
-> ([WindowHint] -> ShowS)
-> Show WindowHint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowHint] -> ShowS
$cshowList :: [WindowHint] -> ShowS
show :: WindowHint -> String
$cshow :: WindowHint -> String
showsPrec :: Int -> WindowHint -> ShowS
$cshowsPrec :: Int -> WindowHint -> ShowS
Show, Typeable, (forall x. WindowHint -> Rep WindowHint x)
-> (forall x. Rep WindowHint x -> WindowHint) -> Generic WindowHint
forall x. Rep WindowHint x -> WindowHint
forall x. WindowHint -> Rep WindowHint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WindowHint x -> WindowHint
$cfrom :: forall x. WindowHint -> Rep WindowHint x
Generic)

instance NFData WindowHint

-- | A window-specific attribute.

-- See <https://www.glfw.org/docs/3.3/window_guide.html#window_attribs Window Attributes>

data WindowAttrib
  = WindowAttrib'Decorated
  | WindowAttrib'Resizable
  | WindowAttrib'Floating
  | WindowAttrib'AutoIconify
  | WindowAttrib'FocusOnShow
  | WindowAttrib'Hovered
  deriving (WindowAttrib
WindowAttrib -> WindowAttrib -> Bounded WindowAttrib
forall a. a -> a -> Bounded a
maxBound :: WindowAttrib
$cmaxBound :: WindowAttrib
minBound :: WindowAttrib
$cminBound :: WindowAttrib
Bounded, Typeable WindowAttrib
DataType
Constr
Typeable WindowAttrib =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> WindowAttrib -> c WindowAttrib)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c WindowAttrib)
-> (WindowAttrib -> Constr)
-> (WindowAttrib -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c WindowAttrib))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c WindowAttrib))
-> ((forall b. Data b => b -> b) -> WindowAttrib -> WindowAttrib)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> WindowAttrib -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> WindowAttrib -> r)
-> (forall u. (forall d. Data d => d -> u) -> WindowAttrib -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> WindowAttrib -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> WindowAttrib -> m WindowAttrib)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WindowAttrib -> m WindowAttrib)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WindowAttrib -> m WindowAttrib)
-> Data WindowAttrib
WindowAttrib -> DataType
WindowAttrib -> Constr
(forall b. Data b => b -> b) -> WindowAttrib -> WindowAttrib
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowAttrib -> c WindowAttrib
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowAttrib
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) -> WindowAttrib -> u
forall u. (forall d. Data d => d -> u) -> WindowAttrib -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowAttrib -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowAttrib -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WindowAttrib -> m WindowAttrib
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WindowAttrib -> m WindowAttrib
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowAttrib
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowAttrib -> c WindowAttrib
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WindowAttrib)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WindowAttrib)
$cWindowAttrib'Hovered :: Constr
$cWindowAttrib'FocusOnShow :: Constr
$cWindowAttrib'AutoIconify :: Constr
$cWindowAttrib'Floating :: Constr
$cWindowAttrib'Resizable :: Constr
$cWindowAttrib'Decorated :: Constr
$tWindowAttrib :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> WindowAttrib -> m WindowAttrib
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WindowAttrib -> m WindowAttrib
gmapMp :: (forall d. Data d => d -> m d) -> WindowAttrib -> m WindowAttrib
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WindowAttrib -> m WindowAttrib
gmapM :: (forall d. Data d => d -> m d) -> WindowAttrib -> m WindowAttrib
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WindowAttrib -> m WindowAttrib
gmapQi :: Int -> (forall d. Data d => d -> u) -> WindowAttrib -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WindowAttrib -> u
gmapQ :: (forall d. Data d => d -> u) -> WindowAttrib -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WindowAttrib -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowAttrib -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WindowAttrib -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowAttrib -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WindowAttrib -> r
gmapT :: (forall b. Data b => b -> b) -> WindowAttrib -> WindowAttrib
$cgmapT :: (forall b. Data b => b -> b) -> WindowAttrib -> WindowAttrib
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WindowAttrib)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WindowAttrib)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c WindowAttrib)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WindowAttrib)
dataTypeOf :: WindowAttrib -> DataType
$cdataTypeOf :: WindowAttrib -> DataType
toConstr :: WindowAttrib -> Constr
$ctoConstr :: WindowAttrib -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowAttrib
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WindowAttrib
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowAttrib -> c WindowAttrib
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WindowAttrib -> c WindowAttrib
$cp1Data :: Typeable WindowAttrib
Data, Int -> WindowAttrib
WindowAttrib -> Int
WindowAttrib -> [WindowAttrib]
WindowAttrib -> WindowAttrib
WindowAttrib -> WindowAttrib -> [WindowAttrib]
WindowAttrib -> WindowAttrib -> WindowAttrib -> [WindowAttrib]
(WindowAttrib -> WindowAttrib)
-> (WindowAttrib -> WindowAttrib)
-> (Int -> WindowAttrib)
-> (WindowAttrib -> Int)
-> (WindowAttrib -> [WindowAttrib])
-> (WindowAttrib -> WindowAttrib -> [WindowAttrib])
-> (WindowAttrib -> WindowAttrib -> [WindowAttrib])
-> (WindowAttrib -> WindowAttrib -> WindowAttrib -> [WindowAttrib])
-> Enum WindowAttrib
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: WindowAttrib -> WindowAttrib -> WindowAttrib -> [WindowAttrib]
$cenumFromThenTo :: WindowAttrib -> WindowAttrib -> WindowAttrib -> [WindowAttrib]
enumFromTo :: WindowAttrib -> WindowAttrib -> [WindowAttrib]
$cenumFromTo :: WindowAttrib -> WindowAttrib -> [WindowAttrib]
enumFromThen :: WindowAttrib -> WindowAttrib -> [WindowAttrib]
$cenumFromThen :: WindowAttrib -> WindowAttrib -> [WindowAttrib]
enumFrom :: WindowAttrib -> [WindowAttrib]
$cenumFrom :: WindowAttrib -> [WindowAttrib]
fromEnum :: WindowAttrib -> Int
$cfromEnum :: WindowAttrib -> Int
toEnum :: Int -> WindowAttrib
$ctoEnum :: Int -> WindowAttrib
pred :: WindowAttrib -> WindowAttrib
$cpred :: WindowAttrib -> WindowAttrib
succ :: WindowAttrib -> WindowAttrib
$csucc :: WindowAttrib -> WindowAttrib
Enum, WindowAttrib -> WindowAttrib -> Bool
(WindowAttrib -> WindowAttrib -> Bool)
-> (WindowAttrib -> WindowAttrib -> Bool) -> Eq WindowAttrib
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowAttrib -> WindowAttrib -> Bool
$c/= :: WindowAttrib -> WindowAttrib -> Bool
== :: WindowAttrib -> WindowAttrib -> Bool
$c== :: WindowAttrib -> WindowAttrib -> Bool
Eq, Eq WindowAttrib
Eq WindowAttrib =>
(WindowAttrib -> WindowAttrib -> Ordering)
-> (WindowAttrib -> WindowAttrib -> Bool)
-> (WindowAttrib -> WindowAttrib -> Bool)
-> (WindowAttrib -> WindowAttrib -> Bool)
-> (WindowAttrib -> WindowAttrib -> Bool)
-> (WindowAttrib -> WindowAttrib -> WindowAttrib)
-> (WindowAttrib -> WindowAttrib -> WindowAttrib)
-> Ord WindowAttrib
WindowAttrib -> WindowAttrib -> Bool
WindowAttrib -> WindowAttrib -> Ordering
WindowAttrib -> WindowAttrib -> WindowAttrib
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 :: WindowAttrib -> WindowAttrib -> WindowAttrib
$cmin :: WindowAttrib -> WindowAttrib -> WindowAttrib
max :: WindowAttrib -> WindowAttrib -> WindowAttrib
$cmax :: WindowAttrib -> WindowAttrib -> WindowAttrib
>= :: WindowAttrib -> WindowAttrib -> Bool
$c>= :: WindowAttrib -> WindowAttrib -> Bool
> :: WindowAttrib -> WindowAttrib -> Bool
$c> :: WindowAttrib -> WindowAttrib -> Bool
<= :: WindowAttrib -> WindowAttrib -> Bool
$c<= :: WindowAttrib -> WindowAttrib -> Bool
< :: WindowAttrib -> WindowAttrib -> Bool
$c< :: WindowAttrib -> WindowAttrib -> Bool
compare :: WindowAttrib -> WindowAttrib -> Ordering
$ccompare :: WindowAttrib -> WindowAttrib -> Ordering
$cp1Ord :: Eq WindowAttrib
Ord, ReadPrec [WindowAttrib]
ReadPrec WindowAttrib
Int -> ReadS WindowAttrib
ReadS [WindowAttrib]
(Int -> ReadS WindowAttrib)
-> ReadS [WindowAttrib]
-> ReadPrec WindowAttrib
-> ReadPrec [WindowAttrib]
-> Read WindowAttrib
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WindowAttrib]
$creadListPrec :: ReadPrec [WindowAttrib]
readPrec :: ReadPrec WindowAttrib
$creadPrec :: ReadPrec WindowAttrib
readList :: ReadS [WindowAttrib]
$creadList :: ReadS [WindowAttrib]
readsPrec :: Int -> ReadS WindowAttrib
$creadsPrec :: Int -> ReadS WindowAttrib
Read, Int -> WindowAttrib -> ShowS
[WindowAttrib] -> ShowS
WindowAttrib -> String
(Int -> WindowAttrib -> ShowS)
-> (WindowAttrib -> String)
-> ([WindowAttrib] -> ShowS)
-> Show WindowAttrib
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowAttrib] -> ShowS
$cshowList :: [WindowAttrib] -> ShowS
show :: WindowAttrib -> String
$cshow :: WindowAttrib -> String
showsPrec :: Int -> WindowAttrib -> ShowS
$cshowsPrec :: Int -> WindowAttrib -> ShowS
Show, Typeable, (forall x. WindowAttrib -> Rep WindowAttrib x)
-> (forall x. Rep WindowAttrib x -> WindowAttrib)
-> Generic WindowAttrib
forall x. Rep WindowAttrib x -> WindowAttrib
forall x. WindowAttrib -> Rep WindowAttrib x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WindowAttrib x -> WindowAttrib
$cfrom :: forall x. WindowAttrib -> Rep WindowAttrib x
Generic)

instance NFData WindowAttrib

-- | The OpenGL robustness strategy.

data ContextRobustness =
    ContextRobustness'NoRobustness
  | ContextRobustness'NoResetNotification
  | ContextRobustness'LoseContextOnReset
  deriving (ContextRobustness
ContextRobustness -> ContextRobustness -> Bounded ContextRobustness
forall a. a -> a -> Bounded a
maxBound :: ContextRobustness
$cmaxBound :: ContextRobustness
minBound :: ContextRobustness
$cminBound :: ContextRobustness
Bounded, Typeable ContextRobustness
DataType
Constr
Typeable ContextRobustness =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ContextRobustness
 -> c ContextRobustness)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ContextRobustness)
-> (ContextRobustness -> Constr)
-> (ContextRobustness -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ContextRobustness))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ContextRobustness))
-> ((forall b. Data b => b -> b)
    -> ContextRobustness -> ContextRobustness)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ContextRobustness -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ContextRobustness -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ContextRobustness -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ContextRobustness -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ContextRobustness -> m ContextRobustness)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ContextRobustness -> m ContextRobustness)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ContextRobustness -> m ContextRobustness)
-> Data ContextRobustness
ContextRobustness -> DataType
ContextRobustness -> Constr
(forall b. Data b => b -> b)
-> ContextRobustness -> ContextRobustness
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContextRobustness -> c ContextRobustness
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContextRobustness
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) -> ContextRobustness -> u
forall u. (forall d. Data d => d -> u) -> ContextRobustness -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContextRobustness -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContextRobustness -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ContextRobustness -> m ContextRobustness
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContextRobustness -> m ContextRobustness
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContextRobustness
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContextRobustness -> c ContextRobustness
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContextRobustness)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContextRobustness)
$cContextRobustness'LoseContextOnReset :: Constr
$cContextRobustness'NoResetNotification :: Constr
$cContextRobustness'NoRobustness :: Constr
$tContextRobustness :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ContextRobustness -> m ContextRobustness
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContextRobustness -> m ContextRobustness
gmapMp :: (forall d. Data d => d -> m d)
-> ContextRobustness -> m ContextRobustness
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContextRobustness -> m ContextRobustness
gmapM :: (forall d. Data d => d -> m d)
-> ContextRobustness -> m ContextRobustness
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ContextRobustness -> m ContextRobustness
gmapQi :: Int -> (forall d. Data d => d -> u) -> ContextRobustness -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ContextRobustness -> u
gmapQ :: (forall d. Data d => d -> u) -> ContextRobustness -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ContextRobustness -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContextRobustness -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContextRobustness -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContextRobustness -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContextRobustness -> r
gmapT :: (forall b. Data b => b -> b)
-> ContextRobustness -> ContextRobustness
$cgmapT :: (forall b. Data b => b -> b)
-> ContextRobustness -> ContextRobustness
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContextRobustness)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContextRobustness)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ContextRobustness)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContextRobustness)
dataTypeOf :: ContextRobustness -> DataType
$cdataTypeOf :: ContextRobustness -> DataType
toConstr :: ContextRobustness -> Constr
$ctoConstr :: ContextRobustness -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContextRobustness
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContextRobustness
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContextRobustness -> c ContextRobustness
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContextRobustness -> c ContextRobustness
$cp1Data :: Typeable ContextRobustness
Data, Int -> ContextRobustness
ContextRobustness -> Int
ContextRobustness -> [ContextRobustness]
ContextRobustness -> ContextRobustness
ContextRobustness -> ContextRobustness -> [ContextRobustness]
ContextRobustness
-> ContextRobustness -> ContextRobustness -> [ContextRobustness]
(ContextRobustness -> ContextRobustness)
-> (ContextRobustness -> ContextRobustness)
-> (Int -> ContextRobustness)
-> (ContextRobustness -> Int)
-> (ContextRobustness -> [ContextRobustness])
-> (ContextRobustness -> ContextRobustness -> [ContextRobustness])
-> (ContextRobustness -> ContextRobustness -> [ContextRobustness])
-> (ContextRobustness
    -> ContextRobustness -> ContextRobustness -> [ContextRobustness])
-> Enum ContextRobustness
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ContextRobustness
-> ContextRobustness -> ContextRobustness -> [ContextRobustness]
$cenumFromThenTo :: ContextRobustness
-> ContextRobustness -> ContextRobustness -> [ContextRobustness]
enumFromTo :: ContextRobustness -> ContextRobustness -> [ContextRobustness]
$cenumFromTo :: ContextRobustness -> ContextRobustness -> [ContextRobustness]
enumFromThen :: ContextRobustness -> ContextRobustness -> [ContextRobustness]
$cenumFromThen :: ContextRobustness -> ContextRobustness -> [ContextRobustness]
enumFrom :: ContextRobustness -> [ContextRobustness]
$cenumFrom :: ContextRobustness -> [ContextRobustness]
fromEnum :: ContextRobustness -> Int
$cfromEnum :: ContextRobustness -> Int
toEnum :: Int -> ContextRobustness
$ctoEnum :: Int -> ContextRobustness
pred :: ContextRobustness -> ContextRobustness
$cpred :: ContextRobustness -> ContextRobustness
succ :: ContextRobustness -> ContextRobustness
$csucc :: ContextRobustness -> ContextRobustness
Enum, ContextRobustness -> ContextRobustness -> Bool
(ContextRobustness -> ContextRobustness -> Bool)
-> (ContextRobustness -> ContextRobustness -> Bool)
-> Eq ContextRobustness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContextRobustness -> ContextRobustness -> Bool
$c/= :: ContextRobustness -> ContextRobustness -> Bool
== :: ContextRobustness -> ContextRobustness -> Bool
$c== :: ContextRobustness -> ContextRobustness -> Bool
Eq, Eq ContextRobustness
Eq ContextRobustness =>
(ContextRobustness -> ContextRobustness -> Ordering)
-> (ContextRobustness -> ContextRobustness -> Bool)
-> (ContextRobustness -> ContextRobustness -> Bool)
-> (ContextRobustness -> ContextRobustness -> Bool)
-> (ContextRobustness -> ContextRobustness -> Bool)
-> (ContextRobustness -> ContextRobustness -> ContextRobustness)
-> (ContextRobustness -> ContextRobustness -> ContextRobustness)
-> Ord ContextRobustness
ContextRobustness -> ContextRobustness -> Bool
ContextRobustness -> ContextRobustness -> Ordering
ContextRobustness -> ContextRobustness -> ContextRobustness
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 :: ContextRobustness -> ContextRobustness -> ContextRobustness
$cmin :: ContextRobustness -> ContextRobustness -> ContextRobustness
max :: ContextRobustness -> ContextRobustness -> ContextRobustness
$cmax :: ContextRobustness -> ContextRobustness -> ContextRobustness
>= :: ContextRobustness -> ContextRobustness -> Bool
$c>= :: ContextRobustness -> ContextRobustness -> Bool
> :: ContextRobustness -> ContextRobustness -> Bool
$c> :: ContextRobustness -> ContextRobustness -> Bool
<= :: ContextRobustness -> ContextRobustness -> Bool
$c<= :: ContextRobustness -> ContextRobustness -> Bool
< :: ContextRobustness -> ContextRobustness -> Bool
$c< :: ContextRobustness -> ContextRobustness -> Bool
compare :: ContextRobustness -> ContextRobustness -> Ordering
$ccompare :: ContextRobustness -> ContextRobustness -> Ordering
$cp1Ord :: Eq ContextRobustness
Ord, ReadPrec [ContextRobustness]
ReadPrec ContextRobustness
Int -> ReadS ContextRobustness
ReadS [ContextRobustness]
(Int -> ReadS ContextRobustness)
-> ReadS [ContextRobustness]
-> ReadPrec ContextRobustness
-> ReadPrec [ContextRobustness]
-> Read ContextRobustness
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContextRobustness]
$creadListPrec :: ReadPrec [ContextRobustness]
readPrec :: ReadPrec ContextRobustness
$creadPrec :: ReadPrec ContextRobustness
readList :: ReadS [ContextRobustness]
$creadList :: ReadS [ContextRobustness]
readsPrec :: Int -> ReadS ContextRobustness
$creadsPrec :: Int -> ReadS ContextRobustness
Read, Int -> ContextRobustness -> ShowS
[ContextRobustness] -> ShowS
ContextRobustness -> String
(Int -> ContextRobustness -> ShowS)
-> (ContextRobustness -> String)
-> ([ContextRobustness] -> ShowS)
-> Show ContextRobustness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContextRobustness] -> ShowS
$cshowList :: [ContextRobustness] -> ShowS
show :: ContextRobustness -> String
$cshow :: ContextRobustness -> String
showsPrec :: Int -> ContextRobustness -> ShowS
$cshowsPrec :: Int -> ContextRobustness -> ShowS
Show, Typeable, (forall x. ContextRobustness -> Rep ContextRobustness x)
-> (forall x. Rep ContextRobustness x -> ContextRobustness)
-> Generic ContextRobustness
forall x. Rep ContextRobustness x -> ContextRobustness
forall x. ContextRobustness -> Rep ContextRobustness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContextRobustness x -> ContextRobustness
$cfrom :: forall x. ContextRobustness -> Rep ContextRobustness x
Generic)

instance NFData ContextRobustness

-- | The OpenGL profile.

data OpenGLProfile =
    OpenGLProfile'Any
  | OpenGLProfile'Compat
  | OpenGLProfile'Core
  deriving (OpenGLProfile
OpenGLProfile -> OpenGLProfile -> Bounded OpenGLProfile
forall a. a -> a -> Bounded a
maxBound :: OpenGLProfile
$cmaxBound :: OpenGLProfile
minBound :: OpenGLProfile
$cminBound :: OpenGLProfile
Bounded, Typeable OpenGLProfile
DataType
Constr
Typeable OpenGLProfile =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> OpenGLProfile -> c OpenGLProfile)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OpenGLProfile)
-> (OpenGLProfile -> Constr)
-> (OpenGLProfile -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OpenGLProfile))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OpenGLProfile))
-> ((forall b. Data b => b -> b) -> OpenGLProfile -> OpenGLProfile)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OpenGLProfile -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OpenGLProfile -> r)
-> (forall u. (forall d. Data d => d -> u) -> OpenGLProfile -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OpenGLProfile -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OpenGLProfile -> m OpenGLProfile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OpenGLProfile -> m OpenGLProfile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OpenGLProfile -> m OpenGLProfile)
-> Data OpenGLProfile
OpenGLProfile -> DataType
OpenGLProfile -> Constr
(forall b. Data b => b -> b) -> OpenGLProfile -> OpenGLProfile
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenGLProfile -> c OpenGLProfile
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenGLProfile
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) -> OpenGLProfile -> u
forall u. (forall d. Data d => d -> u) -> OpenGLProfile -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenGLProfile -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenGLProfile -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenGLProfile -> m OpenGLProfile
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenGLProfile -> m OpenGLProfile
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenGLProfile
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenGLProfile -> c OpenGLProfile
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenGLProfile)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OpenGLProfile)
$cOpenGLProfile'Core :: Constr
$cOpenGLProfile'Compat :: Constr
$cOpenGLProfile'Any :: Constr
$tOpenGLProfile :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> OpenGLProfile -> m OpenGLProfile
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenGLProfile -> m OpenGLProfile
gmapMp :: (forall d. Data d => d -> m d) -> OpenGLProfile -> m OpenGLProfile
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OpenGLProfile -> m OpenGLProfile
gmapM :: (forall d. Data d => d -> m d) -> OpenGLProfile -> m OpenGLProfile
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OpenGLProfile -> m OpenGLProfile
gmapQi :: Int -> (forall d. Data d => d -> u) -> OpenGLProfile -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OpenGLProfile -> u
gmapQ :: (forall d. Data d => d -> u) -> OpenGLProfile -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OpenGLProfile -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenGLProfile -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OpenGLProfile -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenGLProfile -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OpenGLProfile -> r
gmapT :: (forall b. Data b => b -> b) -> OpenGLProfile -> OpenGLProfile
$cgmapT :: (forall b. Data b => b -> b) -> OpenGLProfile -> OpenGLProfile
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OpenGLProfile)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OpenGLProfile)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OpenGLProfile)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OpenGLProfile)
dataTypeOf :: OpenGLProfile -> DataType
$cdataTypeOf :: OpenGLProfile -> DataType
toConstr :: OpenGLProfile -> Constr
$ctoConstr :: OpenGLProfile -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenGLProfile
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OpenGLProfile
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenGLProfile -> c OpenGLProfile
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OpenGLProfile -> c OpenGLProfile
$cp1Data :: Typeable OpenGLProfile
Data, Int -> OpenGLProfile
OpenGLProfile -> Int
OpenGLProfile -> [OpenGLProfile]
OpenGLProfile -> OpenGLProfile
OpenGLProfile -> OpenGLProfile -> [OpenGLProfile]
OpenGLProfile -> OpenGLProfile -> OpenGLProfile -> [OpenGLProfile]
(OpenGLProfile -> OpenGLProfile)
-> (OpenGLProfile -> OpenGLProfile)
-> (Int -> OpenGLProfile)
-> (OpenGLProfile -> Int)
-> (OpenGLProfile -> [OpenGLProfile])
-> (OpenGLProfile -> OpenGLProfile -> [OpenGLProfile])
-> (OpenGLProfile -> OpenGLProfile -> [OpenGLProfile])
-> (OpenGLProfile
    -> OpenGLProfile -> OpenGLProfile -> [OpenGLProfile])
-> Enum OpenGLProfile
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OpenGLProfile -> OpenGLProfile -> OpenGLProfile -> [OpenGLProfile]
$cenumFromThenTo :: OpenGLProfile -> OpenGLProfile -> OpenGLProfile -> [OpenGLProfile]
enumFromTo :: OpenGLProfile -> OpenGLProfile -> [OpenGLProfile]
$cenumFromTo :: OpenGLProfile -> OpenGLProfile -> [OpenGLProfile]
enumFromThen :: OpenGLProfile -> OpenGLProfile -> [OpenGLProfile]
$cenumFromThen :: OpenGLProfile -> OpenGLProfile -> [OpenGLProfile]
enumFrom :: OpenGLProfile -> [OpenGLProfile]
$cenumFrom :: OpenGLProfile -> [OpenGLProfile]
fromEnum :: OpenGLProfile -> Int
$cfromEnum :: OpenGLProfile -> Int
toEnum :: Int -> OpenGLProfile
$ctoEnum :: Int -> OpenGLProfile
pred :: OpenGLProfile -> OpenGLProfile
$cpred :: OpenGLProfile -> OpenGLProfile
succ :: OpenGLProfile -> OpenGLProfile
$csucc :: OpenGLProfile -> OpenGLProfile
Enum, OpenGLProfile -> OpenGLProfile -> Bool
(OpenGLProfile -> OpenGLProfile -> Bool)
-> (OpenGLProfile -> OpenGLProfile -> Bool) -> Eq OpenGLProfile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenGLProfile -> OpenGLProfile -> Bool
$c/= :: OpenGLProfile -> OpenGLProfile -> Bool
== :: OpenGLProfile -> OpenGLProfile -> Bool
$c== :: OpenGLProfile -> OpenGLProfile -> Bool
Eq, Eq OpenGLProfile
Eq OpenGLProfile =>
(OpenGLProfile -> OpenGLProfile -> Ordering)
-> (OpenGLProfile -> OpenGLProfile -> Bool)
-> (OpenGLProfile -> OpenGLProfile -> Bool)
-> (OpenGLProfile -> OpenGLProfile -> Bool)
-> (OpenGLProfile -> OpenGLProfile -> Bool)
-> (OpenGLProfile -> OpenGLProfile -> OpenGLProfile)
-> (OpenGLProfile -> OpenGLProfile -> OpenGLProfile)
-> Ord OpenGLProfile
OpenGLProfile -> OpenGLProfile -> Bool
OpenGLProfile -> OpenGLProfile -> Ordering
OpenGLProfile -> OpenGLProfile -> OpenGLProfile
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 :: OpenGLProfile -> OpenGLProfile -> OpenGLProfile
$cmin :: OpenGLProfile -> OpenGLProfile -> OpenGLProfile
max :: OpenGLProfile -> OpenGLProfile -> OpenGLProfile
$cmax :: OpenGLProfile -> OpenGLProfile -> OpenGLProfile
>= :: OpenGLProfile -> OpenGLProfile -> Bool
$c>= :: OpenGLProfile -> OpenGLProfile -> Bool
> :: OpenGLProfile -> OpenGLProfile -> Bool
$c> :: OpenGLProfile -> OpenGLProfile -> Bool
<= :: OpenGLProfile -> OpenGLProfile -> Bool
$c<= :: OpenGLProfile -> OpenGLProfile -> Bool
< :: OpenGLProfile -> OpenGLProfile -> Bool
$c< :: OpenGLProfile -> OpenGLProfile -> Bool
compare :: OpenGLProfile -> OpenGLProfile -> Ordering
$ccompare :: OpenGLProfile -> OpenGLProfile -> Ordering
$cp1Ord :: Eq OpenGLProfile
Ord, ReadPrec [OpenGLProfile]
ReadPrec OpenGLProfile
Int -> ReadS OpenGLProfile
ReadS [OpenGLProfile]
(Int -> ReadS OpenGLProfile)
-> ReadS [OpenGLProfile]
-> ReadPrec OpenGLProfile
-> ReadPrec [OpenGLProfile]
-> Read OpenGLProfile
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OpenGLProfile]
$creadListPrec :: ReadPrec [OpenGLProfile]
readPrec :: ReadPrec OpenGLProfile
$creadPrec :: ReadPrec OpenGLProfile
readList :: ReadS [OpenGLProfile]
$creadList :: ReadS [OpenGLProfile]
readsPrec :: Int -> ReadS OpenGLProfile
$creadsPrec :: Int -> ReadS OpenGLProfile
Read, Int -> OpenGLProfile -> ShowS
[OpenGLProfile] -> ShowS
OpenGLProfile -> String
(Int -> OpenGLProfile -> ShowS)
-> (OpenGLProfile -> String)
-> ([OpenGLProfile] -> ShowS)
-> Show OpenGLProfile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenGLProfile] -> ShowS
$cshowList :: [OpenGLProfile] -> ShowS
show :: OpenGLProfile -> String
$cshow :: OpenGLProfile -> String
showsPrec :: Int -> OpenGLProfile -> ShowS
$cshowsPrec :: Int -> OpenGLProfile -> ShowS
Show, Typeable, (forall x. OpenGLProfile -> Rep OpenGLProfile x)
-> (forall x. Rep OpenGLProfile x -> OpenGLProfile)
-> Generic OpenGLProfile
forall x. Rep OpenGLProfile x -> OpenGLProfile
forall x. OpenGLProfile -> Rep OpenGLProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OpenGLProfile x -> OpenGLProfile
$cfrom :: forall x. OpenGLProfile -> Rep OpenGLProfile x
Generic)

instance NFData OpenGLProfile

-- | The type of OpenGL to create a context for.

data ClientAPI =
    ClientAPI'NoAPI
  | ClientAPI'OpenGL
  | ClientAPI'OpenGLES
  deriving (ClientAPI
ClientAPI -> ClientAPI -> Bounded ClientAPI
forall a. a -> a -> Bounded a
maxBound :: ClientAPI
$cmaxBound :: ClientAPI
minBound :: ClientAPI
$cminBound :: ClientAPI
Bounded, Typeable ClientAPI
DataType
Constr
Typeable ClientAPI =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ClientAPI -> c ClientAPI)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ClientAPI)
-> (ClientAPI -> Constr)
-> (ClientAPI -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ClientAPI))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ClientAPI))
-> ((forall b. Data b => b -> b) -> ClientAPI -> ClientAPI)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ClientAPI -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ClientAPI -> r)
-> (forall u. (forall d. Data d => d -> u) -> ClientAPI -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ClientAPI -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ClientAPI -> m ClientAPI)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ClientAPI -> m ClientAPI)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ClientAPI -> m ClientAPI)
-> Data ClientAPI
ClientAPI -> DataType
ClientAPI -> Constr
(forall b. Data b => b -> b) -> ClientAPI -> ClientAPI
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ClientAPI -> c ClientAPI
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ClientAPI
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) -> ClientAPI -> u
forall u. (forall d. Data d => d -> u) -> ClientAPI -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ClientAPI -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ClientAPI -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ClientAPI -> m ClientAPI
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ClientAPI -> m ClientAPI
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ClientAPI
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ClientAPI -> c ClientAPI
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ClientAPI)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ClientAPI)
$cClientAPI'OpenGLES :: Constr
$cClientAPI'OpenGL :: Constr
$cClientAPI'NoAPI :: Constr
$tClientAPI :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ClientAPI -> m ClientAPI
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ClientAPI -> m ClientAPI
gmapMp :: (forall d. Data d => d -> m d) -> ClientAPI -> m ClientAPI
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ClientAPI -> m ClientAPI
gmapM :: (forall d. Data d => d -> m d) -> ClientAPI -> m ClientAPI
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ClientAPI -> m ClientAPI
gmapQi :: Int -> (forall d. Data d => d -> u) -> ClientAPI -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ClientAPI -> u
gmapQ :: (forall d. Data d => d -> u) -> ClientAPI -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ClientAPI -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ClientAPI -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ClientAPI -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ClientAPI -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ClientAPI -> r
gmapT :: (forall b. Data b => b -> b) -> ClientAPI -> ClientAPI
$cgmapT :: (forall b. Data b => b -> b) -> ClientAPI -> ClientAPI
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ClientAPI)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ClientAPI)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ClientAPI)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ClientAPI)
dataTypeOf :: ClientAPI -> DataType
$cdataTypeOf :: ClientAPI -> DataType
toConstr :: ClientAPI -> Constr
$ctoConstr :: ClientAPI -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ClientAPI
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ClientAPI
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ClientAPI -> c ClientAPI
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ClientAPI -> c ClientAPI
$cp1Data :: Typeable ClientAPI
Data, Int -> ClientAPI
ClientAPI -> Int
ClientAPI -> [ClientAPI]
ClientAPI -> ClientAPI
ClientAPI -> ClientAPI -> [ClientAPI]
ClientAPI -> ClientAPI -> ClientAPI -> [ClientAPI]
(ClientAPI -> ClientAPI)
-> (ClientAPI -> ClientAPI)
-> (Int -> ClientAPI)
-> (ClientAPI -> Int)
-> (ClientAPI -> [ClientAPI])
-> (ClientAPI -> ClientAPI -> [ClientAPI])
-> (ClientAPI -> ClientAPI -> [ClientAPI])
-> (ClientAPI -> ClientAPI -> ClientAPI -> [ClientAPI])
-> Enum ClientAPI
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ClientAPI -> ClientAPI -> ClientAPI -> [ClientAPI]
$cenumFromThenTo :: ClientAPI -> ClientAPI -> ClientAPI -> [ClientAPI]
enumFromTo :: ClientAPI -> ClientAPI -> [ClientAPI]
$cenumFromTo :: ClientAPI -> ClientAPI -> [ClientAPI]
enumFromThen :: ClientAPI -> ClientAPI -> [ClientAPI]
$cenumFromThen :: ClientAPI -> ClientAPI -> [ClientAPI]
enumFrom :: ClientAPI -> [ClientAPI]
$cenumFrom :: ClientAPI -> [ClientAPI]
fromEnum :: ClientAPI -> Int
$cfromEnum :: ClientAPI -> Int
toEnum :: Int -> ClientAPI
$ctoEnum :: Int -> ClientAPI
pred :: ClientAPI -> ClientAPI
$cpred :: ClientAPI -> ClientAPI
succ :: ClientAPI -> ClientAPI
$csucc :: ClientAPI -> ClientAPI
Enum, ClientAPI -> ClientAPI -> Bool
(ClientAPI -> ClientAPI -> Bool)
-> (ClientAPI -> ClientAPI -> Bool) -> Eq ClientAPI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientAPI -> ClientAPI -> Bool
$c/= :: ClientAPI -> ClientAPI -> Bool
== :: ClientAPI -> ClientAPI -> Bool
$c== :: ClientAPI -> ClientAPI -> Bool
Eq, Eq ClientAPI
Eq ClientAPI =>
(ClientAPI -> ClientAPI -> Ordering)
-> (ClientAPI -> ClientAPI -> Bool)
-> (ClientAPI -> ClientAPI -> Bool)
-> (ClientAPI -> ClientAPI -> Bool)
-> (ClientAPI -> ClientAPI -> Bool)
-> (ClientAPI -> ClientAPI -> ClientAPI)
-> (ClientAPI -> ClientAPI -> ClientAPI)
-> Ord ClientAPI
ClientAPI -> ClientAPI -> Bool
ClientAPI -> ClientAPI -> Ordering
ClientAPI -> ClientAPI -> ClientAPI
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 :: ClientAPI -> ClientAPI -> ClientAPI
$cmin :: ClientAPI -> ClientAPI -> ClientAPI
max :: ClientAPI -> ClientAPI -> ClientAPI
$cmax :: ClientAPI -> ClientAPI -> ClientAPI
>= :: ClientAPI -> ClientAPI -> Bool
$c>= :: ClientAPI -> ClientAPI -> Bool
> :: ClientAPI -> ClientAPI -> Bool
$c> :: ClientAPI -> ClientAPI -> Bool
<= :: ClientAPI -> ClientAPI -> Bool
$c<= :: ClientAPI -> ClientAPI -> Bool
< :: ClientAPI -> ClientAPI -> Bool
$c< :: ClientAPI -> ClientAPI -> Bool
compare :: ClientAPI -> ClientAPI -> Ordering
$ccompare :: ClientAPI -> ClientAPI -> Ordering
$cp1Ord :: Eq ClientAPI
Ord, ReadPrec [ClientAPI]
ReadPrec ClientAPI
Int -> ReadS ClientAPI
ReadS [ClientAPI]
(Int -> ReadS ClientAPI)
-> ReadS [ClientAPI]
-> ReadPrec ClientAPI
-> ReadPrec [ClientAPI]
-> Read ClientAPI
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClientAPI]
$creadListPrec :: ReadPrec [ClientAPI]
readPrec :: ReadPrec ClientAPI
$creadPrec :: ReadPrec ClientAPI
readList :: ReadS [ClientAPI]
$creadList :: ReadS [ClientAPI]
readsPrec :: Int -> ReadS ClientAPI
$creadsPrec :: Int -> ReadS ClientAPI
Read, Int -> ClientAPI -> ShowS
[ClientAPI] -> ShowS
ClientAPI -> String
(Int -> ClientAPI -> ShowS)
-> (ClientAPI -> String)
-> ([ClientAPI] -> ShowS)
-> Show ClientAPI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientAPI] -> ShowS
$cshowList :: [ClientAPI] -> ShowS
show :: ClientAPI -> String
$cshow :: ClientAPI -> String
showsPrec :: Int -> ClientAPI -> ShowS
$cshowsPrec :: Int -> ClientAPI -> ShowS
Show, Typeable, (forall x. ClientAPI -> Rep ClientAPI x)
-> (forall x. Rep ClientAPI x -> ClientAPI) -> Generic ClientAPI
forall x. Rep ClientAPI x -> ClientAPI
forall x. ClientAPI -> Rep ClientAPI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientAPI x -> ClientAPI
$cfrom :: forall x. ClientAPI -> Rep ClientAPI x
Generic)

instance NFData ClientAPI

-- | The type of API to use for context creation.

-- See the <http://www.glfw.org/docs/latest/window_guide.html Window Guide> for

-- more information.

--

-- This is a hard constraint. If no client API is requested, this hint is

-- ignored. Best practice is to stick to one API or the other, otherwise may

-- segfault on Linux. OS X does not support the EGL API and will fail if this

-- hint is used.

data ContextCreationAPI
  = ContextCreationAPI'Native
  | ContextCreationAPI'EGL
  | ContextCreationAPI'OSMesa
  deriving (ContextCreationAPI
ContextCreationAPI
-> ContextCreationAPI -> Bounded ContextCreationAPI
forall a. a -> a -> Bounded a
maxBound :: ContextCreationAPI
$cmaxBound :: ContextCreationAPI
minBound :: ContextCreationAPI
$cminBound :: ContextCreationAPI
Bounded, Typeable ContextCreationAPI
DataType
Constr
Typeable ContextCreationAPI =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ContextCreationAPI
 -> c ContextCreationAPI)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ContextCreationAPI)
-> (ContextCreationAPI -> Constr)
-> (ContextCreationAPI -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ContextCreationAPI))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ContextCreationAPI))
-> ((forall b. Data b => b -> b)
    -> ContextCreationAPI -> ContextCreationAPI)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ContextCreationAPI -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ContextCreationAPI -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ContextCreationAPI -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ContextCreationAPI -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ContextCreationAPI -> m ContextCreationAPI)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ContextCreationAPI -> m ContextCreationAPI)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ContextCreationAPI -> m ContextCreationAPI)
-> Data ContextCreationAPI
ContextCreationAPI -> DataType
ContextCreationAPI -> Constr
(forall b. Data b => b -> b)
-> ContextCreationAPI -> ContextCreationAPI
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ContextCreationAPI
-> c ContextCreationAPI
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContextCreationAPI
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) -> ContextCreationAPI -> u
forall u. (forall d. Data d => d -> u) -> ContextCreationAPI -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContextCreationAPI -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContextCreationAPI -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ContextCreationAPI -> m ContextCreationAPI
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContextCreationAPI -> m ContextCreationAPI
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContextCreationAPI
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ContextCreationAPI
-> c ContextCreationAPI
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContextCreationAPI)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContextCreationAPI)
$cContextCreationAPI'OSMesa :: Constr
$cContextCreationAPI'EGL :: Constr
$cContextCreationAPI'Native :: Constr
$tContextCreationAPI :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ContextCreationAPI -> m ContextCreationAPI
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContextCreationAPI -> m ContextCreationAPI
gmapMp :: (forall d. Data d => d -> m d)
-> ContextCreationAPI -> m ContextCreationAPI
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContextCreationAPI -> m ContextCreationAPI
gmapM :: (forall d. Data d => d -> m d)
-> ContextCreationAPI -> m ContextCreationAPI
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ContextCreationAPI -> m ContextCreationAPI
gmapQi :: Int -> (forall d. Data d => d -> u) -> ContextCreationAPI -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ContextCreationAPI -> u
gmapQ :: (forall d. Data d => d -> u) -> ContextCreationAPI -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ContextCreationAPI -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContextCreationAPI -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContextCreationAPI -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContextCreationAPI -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContextCreationAPI -> r
gmapT :: (forall b. Data b => b -> b)
-> ContextCreationAPI -> ContextCreationAPI
$cgmapT :: (forall b. Data b => b -> b)
-> ContextCreationAPI -> ContextCreationAPI
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContextCreationAPI)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContextCreationAPI)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ContextCreationAPI)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContextCreationAPI)
dataTypeOf :: ContextCreationAPI -> DataType
$cdataTypeOf :: ContextCreationAPI -> DataType
toConstr :: ContextCreationAPI -> Constr
$ctoConstr :: ContextCreationAPI -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContextCreationAPI
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContextCreationAPI
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ContextCreationAPI
-> c ContextCreationAPI
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ContextCreationAPI
-> c ContextCreationAPI
$cp1Data :: Typeable ContextCreationAPI
Data, Int -> ContextCreationAPI
ContextCreationAPI -> Int
ContextCreationAPI -> [ContextCreationAPI]
ContextCreationAPI -> ContextCreationAPI
ContextCreationAPI -> ContextCreationAPI -> [ContextCreationAPI]
ContextCreationAPI
-> ContextCreationAPI -> ContextCreationAPI -> [ContextCreationAPI]
(ContextCreationAPI -> ContextCreationAPI)
-> (ContextCreationAPI -> ContextCreationAPI)
-> (Int -> ContextCreationAPI)
-> (ContextCreationAPI -> Int)
-> (ContextCreationAPI -> [ContextCreationAPI])
-> (ContextCreationAPI
    -> ContextCreationAPI -> [ContextCreationAPI])
-> (ContextCreationAPI
    -> ContextCreationAPI -> [ContextCreationAPI])
-> (ContextCreationAPI
    -> ContextCreationAPI
    -> ContextCreationAPI
    -> [ContextCreationAPI])
-> Enum ContextCreationAPI
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ContextCreationAPI
-> ContextCreationAPI -> ContextCreationAPI -> [ContextCreationAPI]
$cenumFromThenTo :: ContextCreationAPI
-> ContextCreationAPI -> ContextCreationAPI -> [ContextCreationAPI]
enumFromTo :: ContextCreationAPI -> ContextCreationAPI -> [ContextCreationAPI]
$cenumFromTo :: ContextCreationAPI -> ContextCreationAPI -> [ContextCreationAPI]
enumFromThen :: ContextCreationAPI -> ContextCreationAPI -> [ContextCreationAPI]
$cenumFromThen :: ContextCreationAPI -> ContextCreationAPI -> [ContextCreationAPI]
enumFrom :: ContextCreationAPI -> [ContextCreationAPI]
$cenumFrom :: ContextCreationAPI -> [ContextCreationAPI]
fromEnum :: ContextCreationAPI -> Int
$cfromEnum :: ContextCreationAPI -> Int
toEnum :: Int -> ContextCreationAPI
$ctoEnum :: Int -> ContextCreationAPI
pred :: ContextCreationAPI -> ContextCreationAPI
$cpred :: ContextCreationAPI -> ContextCreationAPI
succ :: ContextCreationAPI -> ContextCreationAPI
$csucc :: ContextCreationAPI -> ContextCreationAPI
Enum, ContextCreationAPI -> ContextCreationAPI -> Bool
(ContextCreationAPI -> ContextCreationAPI -> Bool)
-> (ContextCreationAPI -> ContextCreationAPI -> Bool)
-> Eq ContextCreationAPI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContextCreationAPI -> ContextCreationAPI -> Bool
$c/= :: ContextCreationAPI -> ContextCreationAPI -> Bool
== :: ContextCreationAPI -> ContextCreationAPI -> Bool
$c== :: ContextCreationAPI -> ContextCreationAPI -> Bool
Eq, Eq ContextCreationAPI
Eq ContextCreationAPI =>
(ContextCreationAPI -> ContextCreationAPI -> Ordering)
-> (ContextCreationAPI -> ContextCreationAPI -> Bool)
-> (ContextCreationAPI -> ContextCreationAPI -> Bool)
-> (ContextCreationAPI -> ContextCreationAPI -> Bool)
-> (ContextCreationAPI -> ContextCreationAPI -> Bool)
-> (ContextCreationAPI -> ContextCreationAPI -> ContextCreationAPI)
-> (ContextCreationAPI -> ContextCreationAPI -> ContextCreationAPI)
-> Ord ContextCreationAPI
ContextCreationAPI -> ContextCreationAPI -> Bool
ContextCreationAPI -> ContextCreationAPI -> Ordering
ContextCreationAPI -> ContextCreationAPI -> ContextCreationAPI
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 :: ContextCreationAPI -> ContextCreationAPI -> ContextCreationAPI
$cmin :: ContextCreationAPI -> ContextCreationAPI -> ContextCreationAPI
max :: ContextCreationAPI -> ContextCreationAPI -> ContextCreationAPI
$cmax :: ContextCreationAPI -> ContextCreationAPI -> ContextCreationAPI
>= :: ContextCreationAPI -> ContextCreationAPI -> Bool
$c>= :: ContextCreationAPI -> ContextCreationAPI -> Bool
> :: ContextCreationAPI -> ContextCreationAPI -> Bool
$c> :: ContextCreationAPI -> ContextCreationAPI -> Bool
<= :: ContextCreationAPI -> ContextCreationAPI -> Bool
$c<= :: ContextCreationAPI -> ContextCreationAPI -> Bool
< :: ContextCreationAPI -> ContextCreationAPI -> Bool
$c< :: ContextCreationAPI -> ContextCreationAPI -> Bool
compare :: ContextCreationAPI -> ContextCreationAPI -> Ordering
$ccompare :: ContextCreationAPI -> ContextCreationAPI -> Ordering
$cp1Ord :: Eq ContextCreationAPI
Ord, ReadPrec [ContextCreationAPI]
ReadPrec ContextCreationAPI
Int -> ReadS ContextCreationAPI
ReadS [ContextCreationAPI]
(Int -> ReadS ContextCreationAPI)
-> ReadS [ContextCreationAPI]
-> ReadPrec ContextCreationAPI
-> ReadPrec [ContextCreationAPI]
-> Read ContextCreationAPI
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContextCreationAPI]
$creadListPrec :: ReadPrec [ContextCreationAPI]
readPrec :: ReadPrec ContextCreationAPI
$creadPrec :: ReadPrec ContextCreationAPI
readList :: ReadS [ContextCreationAPI]
$creadList :: ReadS [ContextCreationAPI]
readsPrec :: Int -> ReadS ContextCreationAPI
$creadsPrec :: Int -> ReadS ContextCreationAPI
Read, Int -> ContextCreationAPI -> ShowS
[ContextCreationAPI] -> ShowS
ContextCreationAPI -> String
(Int -> ContextCreationAPI -> ShowS)
-> (ContextCreationAPI -> String)
-> ([ContextCreationAPI] -> ShowS)
-> Show ContextCreationAPI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContextCreationAPI] -> ShowS
$cshowList :: [ContextCreationAPI] -> ShowS
show :: ContextCreationAPI -> String
$cshow :: ContextCreationAPI -> String
showsPrec :: Int -> ContextCreationAPI -> ShowS
$cshowsPrec :: Int -> ContextCreationAPI -> ShowS
Show, Typeable, (forall x. ContextCreationAPI -> Rep ContextCreationAPI x)
-> (forall x. Rep ContextCreationAPI x -> ContextCreationAPI)
-> Generic ContextCreationAPI
forall x. Rep ContextCreationAPI x -> ContextCreationAPI
forall x. ContextCreationAPI -> Rep ContextCreationAPI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContextCreationAPI x -> ContextCreationAPI
$cfrom :: forall x. ContextCreationAPI -> Rep ContextCreationAPI x
Generic)

instance NFData ContextCreationAPI

-- | The context release behavior.

-- See the <http://www.glfw.org/docs/latest/window_guide.html Window Guide> for

-- more information.

--

-- Context release behaviors are described in detail by the

-- <https://www.khronos.org/registry/OpenGL/extensions/KHR/KHR_context_flush_control.txt KHR_context_flush_control>

-- extension.

data ContextReleaseBehavior
  = ContextReleaseBehavior'Any
  | ContextReleaseBehavior'None
  | ContextReleaseBehavior'Flush
  deriving (ContextReleaseBehavior
ContextReleaseBehavior
-> ContextReleaseBehavior -> Bounded ContextReleaseBehavior
forall a. a -> a -> Bounded a
maxBound :: ContextReleaseBehavior
$cmaxBound :: ContextReleaseBehavior
minBound :: ContextReleaseBehavior
$cminBound :: ContextReleaseBehavior
Bounded, Typeable ContextReleaseBehavior
DataType
Constr
Typeable ContextReleaseBehavior =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ContextReleaseBehavior
 -> c ContextReleaseBehavior)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ContextReleaseBehavior)
-> (ContextReleaseBehavior -> Constr)
-> (ContextReleaseBehavior -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ContextReleaseBehavior))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ContextReleaseBehavior))
-> ((forall b. Data b => b -> b)
    -> ContextReleaseBehavior -> ContextReleaseBehavior)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ContextReleaseBehavior
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ContextReleaseBehavior
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ContextReleaseBehavior -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ContextReleaseBehavior -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ContextReleaseBehavior -> m ContextReleaseBehavior)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ContextReleaseBehavior -> m ContextReleaseBehavior)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ContextReleaseBehavior -> m ContextReleaseBehavior)
-> Data ContextReleaseBehavior
ContextReleaseBehavior -> DataType
ContextReleaseBehavior -> Constr
(forall b. Data b => b -> b)
-> ContextReleaseBehavior -> ContextReleaseBehavior
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ContextReleaseBehavior
-> c ContextReleaseBehavior
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContextReleaseBehavior
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) -> ContextReleaseBehavior -> u
forall u.
(forall d. Data d => d -> u) -> ContextReleaseBehavior -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ContextReleaseBehavior
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ContextReleaseBehavior
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ContextReleaseBehavior -> m ContextReleaseBehavior
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContextReleaseBehavior -> m ContextReleaseBehavior
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContextReleaseBehavior
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ContextReleaseBehavior
-> c ContextReleaseBehavior
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContextReleaseBehavior)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContextReleaseBehavior)
$cContextReleaseBehavior'Flush :: Constr
$cContextReleaseBehavior'None :: Constr
$cContextReleaseBehavior'Any :: Constr
$tContextReleaseBehavior :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ContextReleaseBehavior -> m ContextReleaseBehavior
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContextReleaseBehavior -> m ContextReleaseBehavior
gmapMp :: (forall d. Data d => d -> m d)
-> ContextReleaseBehavior -> m ContextReleaseBehavior
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContextReleaseBehavior -> m ContextReleaseBehavior
gmapM :: (forall d. Data d => d -> m d)
-> ContextReleaseBehavior -> m ContextReleaseBehavior
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ContextReleaseBehavior -> m ContextReleaseBehavior
gmapQi :: Int -> (forall d. Data d => d -> u) -> ContextReleaseBehavior -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ContextReleaseBehavior -> u
gmapQ :: (forall d. Data d => d -> u) -> ContextReleaseBehavior -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ContextReleaseBehavior -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ContextReleaseBehavior
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ContextReleaseBehavior
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ContextReleaseBehavior
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ContextReleaseBehavior
-> r
gmapT :: (forall b. Data b => b -> b)
-> ContextReleaseBehavior -> ContextReleaseBehavior
$cgmapT :: (forall b. Data b => b -> b)
-> ContextReleaseBehavior -> ContextReleaseBehavior
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContextReleaseBehavior)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContextReleaseBehavior)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ContextReleaseBehavior)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContextReleaseBehavior)
dataTypeOf :: ContextReleaseBehavior -> DataType
$cdataTypeOf :: ContextReleaseBehavior -> DataType
toConstr :: ContextReleaseBehavior -> Constr
$ctoConstr :: ContextReleaseBehavior -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContextReleaseBehavior
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContextReleaseBehavior
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ContextReleaseBehavior
-> c ContextReleaseBehavior
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ContextReleaseBehavior
-> c ContextReleaseBehavior
$cp1Data :: Typeable ContextReleaseBehavior
Data, Int -> ContextReleaseBehavior
ContextReleaseBehavior -> Int
ContextReleaseBehavior -> [ContextReleaseBehavior]
ContextReleaseBehavior -> ContextReleaseBehavior
ContextReleaseBehavior
-> ContextReleaseBehavior -> [ContextReleaseBehavior]
ContextReleaseBehavior
-> ContextReleaseBehavior
-> ContextReleaseBehavior
-> [ContextReleaseBehavior]
(ContextReleaseBehavior -> ContextReleaseBehavior)
-> (ContextReleaseBehavior -> ContextReleaseBehavior)
-> (Int -> ContextReleaseBehavior)
-> (ContextReleaseBehavior -> Int)
-> (ContextReleaseBehavior -> [ContextReleaseBehavior])
-> (ContextReleaseBehavior
    -> ContextReleaseBehavior -> [ContextReleaseBehavior])
-> (ContextReleaseBehavior
    -> ContextReleaseBehavior -> [ContextReleaseBehavior])
-> (ContextReleaseBehavior
    -> ContextReleaseBehavior
    -> ContextReleaseBehavior
    -> [ContextReleaseBehavior])
-> Enum ContextReleaseBehavior
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ContextReleaseBehavior
-> ContextReleaseBehavior
-> ContextReleaseBehavior
-> [ContextReleaseBehavior]
$cenumFromThenTo :: ContextReleaseBehavior
-> ContextReleaseBehavior
-> ContextReleaseBehavior
-> [ContextReleaseBehavior]
enumFromTo :: ContextReleaseBehavior
-> ContextReleaseBehavior -> [ContextReleaseBehavior]
$cenumFromTo :: ContextReleaseBehavior
-> ContextReleaseBehavior -> [ContextReleaseBehavior]
enumFromThen :: ContextReleaseBehavior
-> ContextReleaseBehavior -> [ContextReleaseBehavior]
$cenumFromThen :: ContextReleaseBehavior
-> ContextReleaseBehavior -> [ContextReleaseBehavior]
enumFrom :: ContextReleaseBehavior -> [ContextReleaseBehavior]
$cenumFrom :: ContextReleaseBehavior -> [ContextReleaseBehavior]
fromEnum :: ContextReleaseBehavior -> Int
$cfromEnum :: ContextReleaseBehavior -> Int
toEnum :: Int -> ContextReleaseBehavior
$ctoEnum :: Int -> ContextReleaseBehavior
pred :: ContextReleaseBehavior -> ContextReleaseBehavior
$cpred :: ContextReleaseBehavior -> ContextReleaseBehavior
succ :: ContextReleaseBehavior -> ContextReleaseBehavior
$csucc :: ContextReleaseBehavior -> ContextReleaseBehavior
Enum, ContextReleaseBehavior -> ContextReleaseBehavior -> Bool
(ContextReleaseBehavior -> ContextReleaseBehavior -> Bool)
-> (ContextReleaseBehavior -> ContextReleaseBehavior -> Bool)
-> Eq ContextReleaseBehavior
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContextReleaseBehavior -> ContextReleaseBehavior -> Bool
$c/= :: ContextReleaseBehavior -> ContextReleaseBehavior -> Bool
== :: ContextReleaseBehavior -> ContextReleaseBehavior -> Bool
$c== :: ContextReleaseBehavior -> ContextReleaseBehavior -> Bool
Eq, Eq ContextReleaseBehavior
Eq ContextReleaseBehavior =>
(ContextReleaseBehavior -> ContextReleaseBehavior -> Ordering)
-> (ContextReleaseBehavior -> ContextReleaseBehavior -> Bool)
-> (ContextReleaseBehavior -> ContextReleaseBehavior -> Bool)
-> (ContextReleaseBehavior -> ContextReleaseBehavior -> Bool)
-> (ContextReleaseBehavior -> ContextReleaseBehavior -> Bool)
-> (ContextReleaseBehavior
    -> ContextReleaseBehavior -> ContextReleaseBehavior)
-> (ContextReleaseBehavior
    -> ContextReleaseBehavior -> ContextReleaseBehavior)
-> Ord ContextReleaseBehavior
ContextReleaseBehavior -> ContextReleaseBehavior -> Bool
ContextReleaseBehavior -> ContextReleaseBehavior -> Ordering
ContextReleaseBehavior
-> ContextReleaseBehavior -> ContextReleaseBehavior
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 :: ContextReleaseBehavior
-> ContextReleaseBehavior -> ContextReleaseBehavior
$cmin :: ContextReleaseBehavior
-> ContextReleaseBehavior -> ContextReleaseBehavior
max :: ContextReleaseBehavior
-> ContextReleaseBehavior -> ContextReleaseBehavior
$cmax :: ContextReleaseBehavior
-> ContextReleaseBehavior -> ContextReleaseBehavior
>= :: ContextReleaseBehavior -> ContextReleaseBehavior -> Bool
$c>= :: ContextReleaseBehavior -> ContextReleaseBehavior -> Bool
> :: ContextReleaseBehavior -> ContextReleaseBehavior -> Bool
$c> :: ContextReleaseBehavior -> ContextReleaseBehavior -> Bool
<= :: ContextReleaseBehavior -> ContextReleaseBehavior -> Bool
$c<= :: ContextReleaseBehavior -> ContextReleaseBehavior -> Bool
< :: ContextReleaseBehavior -> ContextReleaseBehavior -> Bool
$c< :: ContextReleaseBehavior -> ContextReleaseBehavior -> Bool
compare :: ContextReleaseBehavior -> ContextReleaseBehavior -> Ordering
$ccompare :: ContextReleaseBehavior -> ContextReleaseBehavior -> Ordering
$cp1Ord :: Eq ContextReleaseBehavior
Ord, ReadPrec [ContextReleaseBehavior]
ReadPrec ContextReleaseBehavior
Int -> ReadS ContextReleaseBehavior
ReadS [ContextReleaseBehavior]
(Int -> ReadS ContextReleaseBehavior)
-> ReadS [ContextReleaseBehavior]
-> ReadPrec ContextReleaseBehavior
-> ReadPrec [ContextReleaseBehavior]
-> Read ContextReleaseBehavior
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContextReleaseBehavior]
$creadListPrec :: ReadPrec [ContextReleaseBehavior]
readPrec :: ReadPrec ContextReleaseBehavior
$creadPrec :: ReadPrec ContextReleaseBehavior
readList :: ReadS [ContextReleaseBehavior]
$creadList :: ReadS [ContextReleaseBehavior]
readsPrec :: Int -> ReadS ContextReleaseBehavior
$creadsPrec :: Int -> ReadS ContextReleaseBehavior
Read, Int -> ContextReleaseBehavior -> ShowS
[ContextReleaseBehavior] -> ShowS
ContextReleaseBehavior -> String
(Int -> ContextReleaseBehavior -> ShowS)
-> (ContextReleaseBehavior -> String)
-> ([ContextReleaseBehavior] -> ShowS)
-> Show ContextReleaseBehavior
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContextReleaseBehavior] -> ShowS
$cshowList :: [ContextReleaseBehavior] -> ShowS
show :: ContextReleaseBehavior -> String
$cshow :: ContextReleaseBehavior -> String
showsPrec :: Int -> ContextReleaseBehavior -> ShowS
$cshowsPrec :: Int -> ContextReleaseBehavior -> ShowS
Show, Typeable, (forall x. ContextReleaseBehavior -> Rep ContextReleaseBehavior x)
-> (forall x.
    Rep ContextReleaseBehavior x -> ContextReleaseBehavior)
-> Generic ContextReleaseBehavior
forall x. Rep ContextReleaseBehavior x -> ContextReleaseBehavior
forall x. ContextReleaseBehavior -> Rep ContextReleaseBehavior x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContextReleaseBehavior x -> ContextReleaseBehavior
$cfrom :: forall x. ContextReleaseBehavior -> Rep ContextReleaseBehavior x
Generic)

instance NFData ContextReleaseBehavior

--------------------------------------------------------------------------------

-- Input handling


-- | Part of the <http://www.glfw.org/docs/3.3/input.html#input_keyboard Keyboard Input> system.

data Key =
    Key'Unknown
  | Key'Space
  | Key'Apostrophe
  | Key'Comma
  | Key'Minus
  | Key'Period
  | Key'Slash
  | Key'0
  | Key'1
  | Key'2
  | Key'3
  | Key'4
  | Key'5
  | Key'6
  | Key'7
  | Key'8
  | Key'9
  | Key'Semicolon
  | Key'Equal
  | Key'A
  | Key'B
  | Key'C
  | Key'D
  | Key'E
  | Key'F
  | Key'G
  | Key'H
  | Key'I
  | Key'J
  | Key'K
  | Key'L
  | Key'M
  | Key'N
  | Key'O
  | Key'P
  | Key'Q
  | Key'R
  | Key'S
  | Key'T
  | Key'U
  | Key'V
  | Key'W
  | Key'X
  | Key'Y
  | Key'Z
  | Key'LeftBracket
  | Key'Backslash
  | Key'RightBracket
  | Key'GraveAccent
  | Key'World1
  | Key'World2
  | Key'Escape
  | Key'Enter
  | Key'Tab
  | Key'Backspace
  | Key'Insert
  | Key'Delete
  | Key'Right
  | Key'Left
  | Key'Down
  | Key'Up
  | Key'PageUp
  | Key'PageDown
  | Key'Home
  | Key'End
  | Key'CapsLock
  | Key'ScrollLock
  | Key'NumLock
  | Key'PrintScreen
  | Key'Pause
  | Key'F1
  | Key'F2
  | Key'F3
  | Key'F4
  | Key'F5
  | Key'F6
  | Key'F7
  | Key'F8
  | Key'F9
  | Key'F10
  | Key'F11
  | Key'F12
  | Key'F13
  | Key'F14
  | Key'F15
  | Key'F16
  | Key'F17
  | Key'F18
  | Key'F19
  | Key'F20
  | Key'F21
  | Key'F22
  | Key'F23
  | Key'F24
  | Key'F25
  | Key'Pad0
  | Key'Pad1
  | Key'Pad2
  | Key'Pad3
  | Key'Pad4
  | Key'Pad5
  | Key'Pad6
  | Key'Pad7
  | Key'Pad8
  | Key'Pad9
  | Key'PadDecimal
  | Key'PadDivide
  | Key'PadMultiply
  | Key'PadSubtract
  | Key'PadAdd
  | Key'PadEnter
  | Key'PadEqual
  | Key'LeftShift
  | Key'LeftControl
  | Key'LeftAlt
  | Key'LeftSuper
  | Key'RightShift
  | Key'RightControl
  | Key'RightAlt
  | Key'RightSuper
  | Key'Menu
  deriving (Key
Key -> Key -> Bounded Key
forall a. a -> a -> Bounded a
maxBound :: Key
$cmaxBound :: Key
minBound :: Key
$cminBound :: Key
Bounded, Typeable Key
DataType
Constr
Typeable Key =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Key -> c Key)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Key)
-> (Key -> Constr)
-> (Key -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Key))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key))
-> ((forall b. Data b => b -> b) -> Key -> Key)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r)
-> (forall u. (forall d. Data d => d -> u) -> Key -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Key -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Key -> m Key)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Key -> m Key)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Key -> m Key)
-> Data Key
Key -> DataType
Key -> Constr
(forall b. Data b => b -> b) -> Key -> Key
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Key -> u
forall u. (forall d. Data d => d -> u) -> Key -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Key -> m Key
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Key)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key)
$cKey'Menu :: Constr
$cKey'RightSuper :: Constr
$cKey'RightAlt :: Constr
$cKey'RightControl :: Constr
$cKey'RightShift :: Constr
$cKey'LeftSuper :: Constr
$cKey'LeftAlt :: Constr
$cKey'LeftControl :: Constr
$cKey'LeftShift :: Constr
$cKey'PadEqual :: Constr
$cKey'PadEnter :: Constr
$cKey'PadAdd :: Constr
$cKey'PadSubtract :: Constr
$cKey'PadMultiply :: Constr
$cKey'PadDivide :: Constr
$cKey'PadDecimal :: Constr
$cKey'Pad9 :: Constr
$cKey'Pad8 :: Constr
$cKey'Pad7 :: Constr
$cKey'Pad6 :: Constr
$cKey'Pad5 :: Constr
$cKey'Pad4 :: Constr
$cKey'Pad3 :: Constr
$cKey'Pad2 :: Constr
$cKey'Pad1 :: Constr
$cKey'Pad0 :: Constr
$cKey'F25 :: Constr
$cKey'F24 :: Constr
$cKey'F23 :: Constr
$cKey'F22 :: Constr
$cKey'F21 :: Constr
$cKey'F20 :: Constr
$cKey'F19 :: Constr
$cKey'F18 :: Constr
$cKey'F17 :: Constr
$cKey'F16 :: Constr
$cKey'F15 :: Constr
$cKey'F14 :: Constr
$cKey'F13 :: Constr
$cKey'F12 :: Constr
$cKey'F11 :: Constr
$cKey'F10 :: Constr
$cKey'F9 :: Constr
$cKey'F8 :: Constr
$cKey'F7 :: Constr
$cKey'F6 :: Constr
$cKey'F5 :: Constr
$cKey'F4 :: Constr
$cKey'F3 :: Constr
$cKey'F2 :: Constr
$cKey'F1 :: Constr
$cKey'Pause :: Constr
$cKey'PrintScreen :: Constr
$cKey'NumLock :: Constr
$cKey'ScrollLock :: Constr
$cKey'CapsLock :: Constr
$cKey'End :: Constr
$cKey'Home :: Constr
$cKey'PageDown :: Constr
$cKey'PageUp :: Constr
$cKey'Up :: Constr
$cKey'Down :: Constr
$cKey'Left :: Constr
$cKey'Right :: Constr
$cKey'Delete :: Constr
$cKey'Insert :: Constr
$cKey'Backspace :: Constr
$cKey'Tab :: Constr
$cKey'Enter :: Constr
$cKey'Escape :: Constr
$cKey'World2 :: Constr
$cKey'World1 :: Constr
$cKey'GraveAccent :: Constr
$cKey'RightBracket :: Constr
$cKey'Backslash :: Constr
$cKey'LeftBracket :: Constr
$cKey'Z :: Constr
$cKey'Y :: Constr
$cKey'X :: Constr
$cKey'W :: Constr
$cKey'V :: Constr
$cKey'U :: Constr
$cKey'T :: Constr
$cKey'S :: Constr
$cKey'R :: Constr
$cKey'Q :: Constr
$cKey'P :: Constr
$cKey'O :: Constr
$cKey'N :: Constr
$cKey'M :: Constr
$cKey'L :: Constr
$cKey'K :: Constr
$cKey'J :: Constr
$cKey'I :: Constr
$cKey'H :: Constr
$cKey'G :: Constr
$cKey'F :: Constr
$cKey'E :: Constr
$cKey'D :: Constr
$cKey'C :: Constr
$cKey'B :: Constr
$cKey'A :: Constr
$cKey'Equal :: Constr
$cKey'Semicolon :: Constr
$cKey'9 :: Constr
$cKey'8 :: Constr
$cKey'7 :: Constr
$cKey'6 :: Constr
$cKey'5 :: Constr
$cKey'4 :: Constr
$cKey'3 :: Constr
$cKey'2 :: Constr
$cKey'1 :: Constr
$cKey'0 :: Constr
$cKey'Slash :: Constr
$cKey'Period :: Constr
$cKey'Minus :: Constr
$cKey'Comma :: Constr
$cKey'Apostrophe :: Constr
$cKey'Space :: Constr
$cKey'Unknown :: Constr
$tKey :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Key -> m Key
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
gmapMp :: (forall d. Data d => d -> m d) -> Key -> m Key
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
gmapM :: (forall d. Data d => d -> m d) -> Key -> m Key
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Key -> m Key
gmapQi :: Int -> (forall d. Data d => d -> u) -> Key -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Key -> u
gmapQ :: (forall d. Data d => d -> u) -> Key -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Key -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
gmapT :: (forall b. Data b => b -> b) -> Key -> Key
$cgmapT :: (forall b. Data b => b -> b) -> Key -> Key
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Key)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Key)
dataTypeOf :: Key -> DataType
$cdataTypeOf :: Key -> DataType
toConstr :: Key -> Constr
$ctoConstr :: Key -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
$cp1Data :: Typeable Key
Data, Int -> Key
Key -> Int
Key -> [Key]
Key -> Key
Key -> Key -> [Key]
Key -> Key -> Key -> [Key]
(Key -> Key)
-> (Key -> Key)
-> (Int -> Key)
-> (Key -> Int)
-> (Key -> [Key])
-> (Key -> Key -> [Key])
-> (Key -> Key -> [Key])
-> (Key -> Key -> Key -> [Key])
-> Enum Key
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Key -> Key -> Key -> [Key]
$cenumFromThenTo :: Key -> Key -> Key -> [Key]
enumFromTo :: Key -> Key -> [Key]
$cenumFromTo :: Key -> Key -> [Key]
enumFromThen :: Key -> Key -> [Key]
$cenumFromThen :: Key -> Key -> [Key]
enumFrom :: Key -> [Key]
$cenumFrom :: Key -> [Key]
fromEnum :: Key -> Int
$cfromEnum :: Key -> Int
toEnum :: Int -> Key
$ctoEnum :: Int -> Key
pred :: Key -> Key
$cpred :: Key -> Key
succ :: Key -> Key
$csucc :: Key -> Key
Enum, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq Key
Eq Key =>
(Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
$cp1Ord :: Eq Key
Ord, ReadPrec [Key]
ReadPrec Key
Int -> ReadS Key
ReadS [Key]
(Int -> ReadS Key)
-> ReadS [Key] -> ReadPrec Key -> ReadPrec [Key] -> Read Key
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Key]
$creadListPrec :: ReadPrec [Key]
readPrec :: ReadPrec Key
$creadPrec :: ReadPrec Key
readList :: ReadS [Key]
$creadList :: ReadS [Key]
readsPrec :: Int -> ReadS Key
$creadsPrec :: Int -> ReadS Key
Read, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show, Typeable, (forall x. Key -> Rep Key x)
-> (forall x. Rep Key x -> Key) -> Generic Key
forall x. Rep Key x -> Key
forall x. Key -> Rep Key x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Key x -> Key
$cfrom :: forall x. Key -> Rep Key x
Generic)

instance NFData Key

-- | The state of an individual key when 'Graphics.UI.GLFW.getKey' is called.

data KeyState =
    KeyState'Pressed
  | KeyState'Released
  | KeyState'Repeating
  deriving (KeyState
KeyState -> KeyState -> Bounded KeyState
forall a. a -> a -> Bounded a
maxBound :: KeyState
$cmaxBound :: KeyState
minBound :: KeyState
$cminBound :: KeyState
Bounded, Typeable KeyState
DataType
Constr
Typeable KeyState =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> KeyState -> c KeyState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c KeyState)
-> (KeyState -> Constr)
-> (KeyState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c KeyState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KeyState))
-> ((forall b. Data b => b -> b) -> KeyState -> KeyState)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> KeyState -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> KeyState -> r)
-> (forall u. (forall d. Data d => d -> u) -> KeyState -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> KeyState -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> KeyState -> m KeyState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> KeyState -> m KeyState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> KeyState -> m KeyState)
-> Data KeyState
KeyState -> DataType
KeyState -> Constr
(forall b. Data b => b -> b) -> KeyState -> KeyState
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeyState -> c KeyState
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeyState
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) -> KeyState -> u
forall u. (forall d. Data d => d -> u) -> KeyState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> KeyState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> KeyState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> KeyState -> m KeyState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeyState -> m KeyState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeyState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeyState -> c KeyState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c KeyState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KeyState)
$cKeyState'Repeating :: Constr
$cKeyState'Released :: Constr
$cKeyState'Pressed :: Constr
$tKeyState :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> KeyState -> m KeyState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeyState -> m KeyState
gmapMp :: (forall d. Data d => d -> m d) -> KeyState -> m KeyState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeyState -> m KeyState
gmapM :: (forall d. Data d => d -> m d) -> KeyState -> m KeyState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> KeyState -> m KeyState
gmapQi :: Int -> (forall d. Data d => d -> u) -> KeyState -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> KeyState -> u
gmapQ :: (forall d. Data d => d -> u) -> KeyState -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> KeyState -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> KeyState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> KeyState -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> KeyState -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> KeyState -> r
gmapT :: (forall b. Data b => b -> b) -> KeyState -> KeyState
$cgmapT :: (forall b. Data b => b -> b) -> KeyState -> KeyState
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KeyState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KeyState)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c KeyState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c KeyState)
dataTypeOf :: KeyState -> DataType
$cdataTypeOf :: KeyState -> DataType
toConstr :: KeyState -> Constr
$ctoConstr :: KeyState -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeyState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeyState
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeyState -> c KeyState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeyState -> c KeyState
$cp1Data :: Typeable KeyState
Data, Int -> KeyState
KeyState -> Int
KeyState -> [KeyState]
KeyState -> KeyState
KeyState -> KeyState -> [KeyState]
KeyState -> KeyState -> KeyState -> [KeyState]
(KeyState -> KeyState)
-> (KeyState -> KeyState)
-> (Int -> KeyState)
-> (KeyState -> Int)
-> (KeyState -> [KeyState])
-> (KeyState -> KeyState -> [KeyState])
-> (KeyState -> KeyState -> [KeyState])
-> (KeyState -> KeyState -> KeyState -> [KeyState])
-> Enum KeyState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: KeyState -> KeyState -> KeyState -> [KeyState]
$cenumFromThenTo :: KeyState -> KeyState -> KeyState -> [KeyState]
enumFromTo :: KeyState -> KeyState -> [KeyState]
$cenumFromTo :: KeyState -> KeyState -> [KeyState]
enumFromThen :: KeyState -> KeyState -> [KeyState]
$cenumFromThen :: KeyState -> KeyState -> [KeyState]
enumFrom :: KeyState -> [KeyState]
$cenumFrom :: KeyState -> [KeyState]
fromEnum :: KeyState -> Int
$cfromEnum :: KeyState -> Int
toEnum :: Int -> KeyState
$ctoEnum :: Int -> KeyState
pred :: KeyState -> KeyState
$cpred :: KeyState -> KeyState
succ :: KeyState -> KeyState
$csucc :: KeyState -> KeyState
Enum, KeyState -> KeyState -> Bool
(KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> Bool) -> Eq KeyState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyState -> KeyState -> Bool
$c/= :: KeyState -> KeyState -> Bool
== :: KeyState -> KeyState -> Bool
$c== :: KeyState -> KeyState -> Bool
Eq, Eq KeyState
Eq KeyState =>
(KeyState -> KeyState -> Ordering)
-> (KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> Bool)
-> (KeyState -> KeyState -> KeyState)
-> (KeyState -> KeyState -> KeyState)
-> Ord KeyState
KeyState -> KeyState -> Bool
KeyState -> KeyState -> Ordering
KeyState -> KeyState -> KeyState
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 :: KeyState -> KeyState -> KeyState
$cmin :: KeyState -> KeyState -> KeyState
max :: KeyState -> KeyState -> KeyState
$cmax :: KeyState -> KeyState -> KeyState
>= :: KeyState -> KeyState -> Bool
$c>= :: KeyState -> KeyState -> Bool
> :: KeyState -> KeyState -> Bool
$c> :: KeyState -> KeyState -> Bool
<= :: KeyState -> KeyState -> Bool
$c<= :: KeyState -> KeyState -> Bool
< :: KeyState -> KeyState -> Bool
$c< :: KeyState -> KeyState -> Bool
compare :: KeyState -> KeyState -> Ordering
$ccompare :: KeyState -> KeyState -> Ordering
$cp1Ord :: Eq KeyState
Ord, ReadPrec [KeyState]
ReadPrec KeyState
Int -> ReadS KeyState
ReadS [KeyState]
(Int -> ReadS KeyState)
-> ReadS [KeyState]
-> ReadPrec KeyState
-> ReadPrec [KeyState]
-> Read KeyState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [KeyState]
$creadListPrec :: ReadPrec [KeyState]
readPrec :: ReadPrec KeyState
$creadPrec :: ReadPrec KeyState
readList :: ReadS [KeyState]
$creadList :: ReadS [KeyState]
readsPrec :: Int -> ReadS KeyState
$creadsPrec :: Int -> ReadS KeyState
Read, Int -> KeyState -> ShowS
[KeyState] -> ShowS
KeyState -> String
(Int -> KeyState -> ShowS)
-> (KeyState -> String) -> ([KeyState] -> ShowS) -> Show KeyState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyState] -> ShowS
$cshowList :: [KeyState] -> ShowS
show :: KeyState -> String
$cshow :: KeyState -> String
showsPrec :: Int -> KeyState -> ShowS
$cshowsPrec :: Int -> KeyState -> ShowS
Show, Typeable, (forall x. KeyState -> Rep KeyState x)
-> (forall x. Rep KeyState x -> KeyState) -> Generic KeyState
forall x. Rep KeyState x -> KeyState
forall x. KeyState -> Rep KeyState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeyState x -> KeyState
$cfrom :: forall x. KeyState -> Rep KeyState x
Generic)

instance NFData KeyState

-- | For use with the <http://www.glfw.org/docs/3.3/input.html#joystick Joystick Input> system.

data Joystick =
    Joystick'1
  | Joystick'2
  | Joystick'3
  | Joystick'4
  | Joystick'5
  | Joystick'6
  | Joystick'7
  | Joystick'8
  | Joystick'9
  | Joystick'10
  | Joystick'11
  | Joystick'12
  | Joystick'13
  | Joystick'14
  | Joystick'15
  | Joystick'16
  deriving (Joystick
Joystick -> Joystick -> Bounded Joystick
forall a. a -> a -> Bounded a
maxBound :: Joystick
$cmaxBound :: Joystick
minBound :: Joystick
$cminBound :: Joystick
Bounded, Typeable Joystick
DataType
Constr
Typeable Joystick =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Joystick -> c Joystick)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Joystick)
-> (Joystick -> Constr)
-> (Joystick -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Joystick))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Joystick))
-> ((forall b. Data b => b -> b) -> Joystick -> Joystick)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Joystick -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Joystick -> r)
-> (forall u. (forall d. Data d => d -> u) -> Joystick -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Joystick -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Joystick -> m Joystick)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Joystick -> m Joystick)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Joystick -> m Joystick)
-> Data Joystick
Joystick -> DataType
Joystick -> Constr
(forall b. Data b => b -> b) -> Joystick -> Joystick
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Joystick -> c Joystick
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Joystick
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) -> Joystick -> u
forall u. (forall d. Data d => d -> u) -> Joystick -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Joystick -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Joystick -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Joystick -> m Joystick
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Joystick -> m Joystick
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Joystick
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Joystick -> c Joystick
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Joystick)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Joystick)
$cJoystick'16 :: Constr
$cJoystick'15 :: Constr
$cJoystick'14 :: Constr
$cJoystick'13 :: Constr
$cJoystick'12 :: Constr
$cJoystick'11 :: Constr
$cJoystick'10 :: Constr
$cJoystick'9 :: Constr
$cJoystick'8 :: Constr
$cJoystick'7 :: Constr
$cJoystick'6 :: Constr
$cJoystick'5 :: Constr
$cJoystick'4 :: Constr
$cJoystick'3 :: Constr
$cJoystick'2 :: Constr
$cJoystick'1 :: Constr
$tJoystick :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Joystick -> m Joystick
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Joystick -> m Joystick
gmapMp :: (forall d. Data d => d -> m d) -> Joystick -> m Joystick
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Joystick -> m Joystick
gmapM :: (forall d. Data d => d -> m d) -> Joystick -> m Joystick
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Joystick -> m Joystick
gmapQi :: Int -> (forall d. Data d => d -> u) -> Joystick -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Joystick -> u
gmapQ :: (forall d. Data d => d -> u) -> Joystick -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Joystick -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Joystick -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Joystick -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Joystick -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Joystick -> r
gmapT :: (forall b. Data b => b -> b) -> Joystick -> Joystick
$cgmapT :: (forall b. Data b => b -> b) -> Joystick -> Joystick
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Joystick)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Joystick)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Joystick)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Joystick)
dataTypeOf :: Joystick -> DataType
$cdataTypeOf :: Joystick -> DataType
toConstr :: Joystick -> Constr
$ctoConstr :: Joystick -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Joystick
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Joystick
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Joystick -> c Joystick
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Joystick -> c Joystick
$cp1Data :: Typeable Joystick
Data, Int -> Joystick
Joystick -> Int
Joystick -> [Joystick]
Joystick -> Joystick
Joystick -> Joystick -> [Joystick]
Joystick -> Joystick -> Joystick -> [Joystick]
(Joystick -> Joystick)
-> (Joystick -> Joystick)
-> (Int -> Joystick)
-> (Joystick -> Int)
-> (Joystick -> [Joystick])
-> (Joystick -> Joystick -> [Joystick])
-> (Joystick -> Joystick -> [Joystick])
-> (Joystick -> Joystick -> Joystick -> [Joystick])
-> Enum Joystick
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Joystick -> Joystick -> Joystick -> [Joystick]
$cenumFromThenTo :: Joystick -> Joystick -> Joystick -> [Joystick]
enumFromTo :: Joystick -> Joystick -> [Joystick]
$cenumFromTo :: Joystick -> Joystick -> [Joystick]
enumFromThen :: Joystick -> Joystick -> [Joystick]
$cenumFromThen :: Joystick -> Joystick -> [Joystick]
enumFrom :: Joystick -> [Joystick]
$cenumFrom :: Joystick -> [Joystick]
fromEnum :: Joystick -> Int
$cfromEnum :: Joystick -> Int
toEnum :: Int -> Joystick
$ctoEnum :: Int -> Joystick
pred :: Joystick -> Joystick
$cpred :: Joystick -> Joystick
succ :: Joystick -> Joystick
$csucc :: Joystick -> Joystick
Enum, Joystick -> Joystick -> Bool
(Joystick -> Joystick -> Bool)
-> (Joystick -> Joystick -> Bool) -> Eq Joystick
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Joystick -> Joystick -> Bool
$c/= :: Joystick -> Joystick -> Bool
== :: Joystick -> Joystick -> Bool
$c== :: Joystick -> Joystick -> Bool
Eq, Eq Joystick
Eq Joystick =>
(Joystick -> Joystick -> Ordering)
-> (Joystick -> Joystick -> Bool)
-> (Joystick -> Joystick -> Bool)
-> (Joystick -> Joystick -> Bool)
-> (Joystick -> Joystick -> Bool)
-> (Joystick -> Joystick -> Joystick)
-> (Joystick -> Joystick -> Joystick)
-> Ord Joystick
Joystick -> Joystick -> Bool
Joystick -> Joystick -> Ordering
Joystick -> Joystick -> Joystick
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 :: Joystick -> Joystick -> Joystick
$cmin :: Joystick -> Joystick -> Joystick
max :: Joystick -> Joystick -> Joystick
$cmax :: Joystick -> Joystick -> Joystick
>= :: Joystick -> Joystick -> Bool
$c>= :: Joystick -> Joystick -> Bool
> :: Joystick -> Joystick -> Bool
$c> :: Joystick -> Joystick -> Bool
<= :: Joystick -> Joystick -> Bool
$c<= :: Joystick -> Joystick -> Bool
< :: Joystick -> Joystick -> Bool
$c< :: Joystick -> Joystick -> Bool
compare :: Joystick -> Joystick -> Ordering
$ccompare :: Joystick -> Joystick -> Ordering
$cp1Ord :: Eq Joystick
Ord, ReadPrec [Joystick]
ReadPrec Joystick
Int -> ReadS Joystick
ReadS [Joystick]
(Int -> ReadS Joystick)
-> ReadS [Joystick]
-> ReadPrec Joystick
-> ReadPrec [Joystick]
-> Read Joystick
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Joystick]
$creadListPrec :: ReadPrec [Joystick]
readPrec :: ReadPrec Joystick
$creadPrec :: ReadPrec Joystick
readList :: ReadS [Joystick]
$creadList :: ReadS [Joystick]
readsPrec :: Int -> ReadS Joystick
$creadsPrec :: Int -> ReadS Joystick
Read, Int -> Joystick -> ShowS
[Joystick] -> ShowS
Joystick -> String
(Int -> Joystick -> ShowS)
-> (Joystick -> String) -> ([Joystick] -> ShowS) -> Show Joystick
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Joystick] -> ShowS
$cshowList :: [Joystick] -> ShowS
show :: Joystick -> String
$cshow :: Joystick -> String
showsPrec :: Int -> Joystick -> ShowS
$cshowsPrec :: Int -> Joystick -> ShowS
Show, Typeable, (forall x. Joystick -> Rep Joystick x)
-> (forall x. Rep Joystick x -> Joystick) -> Generic Joystick
forall x. Rep Joystick x -> Joystick
forall x. Joystick -> Rep Joystick x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Joystick x -> Joystick
$cfrom :: forall x. Joystick -> Rep Joystick x
Generic)

instance NFData Joystick

-- | If a given joystick button is pressed or not when

-- 'Graphics.UI.GLFW.getJoystickButtons' is called.

data JoystickButtonState =
    JoystickButtonState'Pressed
  | JoystickButtonState'Released
  deriving (JoystickButtonState
JoystickButtonState
-> JoystickButtonState -> Bounded JoystickButtonState
forall a. a -> a -> Bounded a
maxBound :: JoystickButtonState
$cmaxBound :: JoystickButtonState
minBound :: JoystickButtonState
$cminBound :: JoystickButtonState
Bounded, Typeable JoystickButtonState
DataType
Constr
Typeable JoystickButtonState =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> JoystickButtonState
 -> c JoystickButtonState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JoystickButtonState)
-> (JoystickButtonState -> Constr)
-> (JoystickButtonState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JoystickButtonState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c JoystickButtonState))
-> ((forall b. Data b => b -> b)
    -> JoystickButtonState -> JoystickButtonState)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JoystickButtonState -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JoystickButtonState -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> JoystickButtonState -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> JoystickButtonState -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> JoystickButtonState -> m JoystickButtonState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> JoystickButtonState -> m JoystickButtonState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> JoystickButtonState -> m JoystickButtonState)
-> Data JoystickButtonState
JoystickButtonState -> DataType
JoystickButtonState -> Constr
(forall b. Data b => b -> b)
-> JoystickButtonState -> JoystickButtonState
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> JoystickButtonState
-> c JoystickButtonState
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoystickButtonState
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) -> JoystickButtonState -> u
forall u.
(forall d. Data d => d -> u) -> JoystickButtonState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickButtonState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickButtonState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> JoystickButtonState -> m JoystickButtonState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoystickButtonState -> m JoystickButtonState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoystickButtonState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> JoystickButtonState
-> c JoystickButtonState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoystickButtonState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoystickButtonState)
$cJoystickButtonState'Released :: Constr
$cJoystickButtonState'Pressed :: Constr
$tJoystickButtonState :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> JoystickButtonState -> m JoystickButtonState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoystickButtonState -> m JoystickButtonState
gmapMp :: (forall d. Data d => d -> m d)
-> JoystickButtonState -> m JoystickButtonState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoystickButtonState -> m JoystickButtonState
gmapM :: (forall d. Data d => d -> m d)
-> JoystickButtonState -> m JoystickButtonState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> JoystickButtonState -> m JoystickButtonState
gmapQi :: Int -> (forall d. Data d => d -> u) -> JoystickButtonState -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> JoystickButtonState -> u
gmapQ :: (forall d. Data d => d -> u) -> JoystickButtonState -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> JoystickButtonState -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickButtonState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickButtonState -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickButtonState -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickButtonState -> r
gmapT :: (forall b. Data b => b -> b)
-> JoystickButtonState -> JoystickButtonState
$cgmapT :: (forall b. Data b => b -> b)
-> JoystickButtonState -> JoystickButtonState
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoystickButtonState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoystickButtonState)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JoystickButtonState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoystickButtonState)
dataTypeOf :: JoystickButtonState -> DataType
$cdataTypeOf :: JoystickButtonState -> DataType
toConstr :: JoystickButtonState -> Constr
$ctoConstr :: JoystickButtonState -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoystickButtonState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoystickButtonState
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> JoystickButtonState
-> c JoystickButtonState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> JoystickButtonState
-> c JoystickButtonState
$cp1Data :: Typeable JoystickButtonState
Data, Int -> JoystickButtonState
JoystickButtonState -> Int
JoystickButtonState -> [JoystickButtonState]
JoystickButtonState -> JoystickButtonState
JoystickButtonState -> JoystickButtonState -> [JoystickButtonState]
JoystickButtonState
-> JoystickButtonState
-> JoystickButtonState
-> [JoystickButtonState]
(JoystickButtonState -> JoystickButtonState)
-> (JoystickButtonState -> JoystickButtonState)
-> (Int -> JoystickButtonState)
-> (JoystickButtonState -> Int)
-> (JoystickButtonState -> [JoystickButtonState])
-> (JoystickButtonState
    -> JoystickButtonState -> [JoystickButtonState])
-> (JoystickButtonState
    -> JoystickButtonState -> [JoystickButtonState])
-> (JoystickButtonState
    -> JoystickButtonState
    -> JoystickButtonState
    -> [JoystickButtonState])
-> Enum JoystickButtonState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: JoystickButtonState
-> JoystickButtonState
-> JoystickButtonState
-> [JoystickButtonState]
$cenumFromThenTo :: JoystickButtonState
-> JoystickButtonState
-> JoystickButtonState
-> [JoystickButtonState]
enumFromTo :: JoystickButtonState -> JoystickButtonState -> [JoystickButtonState]
$cenumFromTo :: JoystickButtonState -> JoystickButtonState -> [JoystickButtonState]
enumFromThen :: JoystickButtonState -> JoystickButtonState -> [JoystickButtonState]
$cenumFromThen :: JoystickButtonState -> JoystickButtonState -> [JoystickButtonState]
enumFrom :: JoystickButtonState -> [JoystickButtonState]
$cenumFrom :: JoystickButtonState -> [JoystickButtonState]
fromEnum :: JoystickButtonState -> Int
$cfromEnum :: JoystickButtonState -> Int
toEnum :: Int -> JoystickButtonState
$ctoEnum :: Int -> JoystickButtonState
pred :: JoystickButtonState -> JoystickButtonState
$cpred :: JoystickButtonState -> JoystickButtonState
succ :: JoystickButtonState -> JoystickButtonState
$csucc :: JoystickButtonState -> JoystickButtonState
Enum, JoystickButtonState -> JoystickButtonState -> Bool
(JoystickButtonState -> JoystickButtonState -> Bool)
-> (JoystickButtonState -> JoystickButtonState -> Bool)
-> Eq JoystickButtonState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoystickButtonState -> JoystickButtonState -> Bool
$c/= :: JoystickButtonState -> JoystickButtonState -> Bool
== :: JoystickButtonState -> JoystickButtonState -> Bool
$c== :: JoystickButtonState -> JoystickButtonState -> Bool
Eq, Eq JoystickButtonState
Eq JoystickButtonState =>
(JoystickButtonState -> JoystickButtonState -> Ordering)
-> (JoystickButtonState -> JoystickButtonState -> Bool)
-> (JoystickButtonState -> JoystickButtonState -> Bool)
-> (JoystickButtonState -> JoystickButtonState -> Bool)
-> (JoystickButtonState -> JoystickButtonState -> Bool)
-> (JoystickButtonState
    -> JoystickButtonState -> JoystickButtonState)
-> (JoystickButtonState
    -> JoystickButtonState -> JoystickButtonState)
-> Ord JoystickButtonState
JoystickButtonState -> JoystickButtonState -> Bool
JoystickButtonState -> JoystickButtonState -> Ordering
JoystickButtonState -> JoystickButtonState -> JoystickButtonState
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 :: JoystickButtonState -> JoystickButtonState -> JoystickButtonState
$cmin :: JoystickButtonState -> JoystickButtonState -> JoystickButtonState
max :: JoystickButtonState -> JoystickButtonState -> JoystickButtonState
$cmax :: JoystickButtonState -> JoystickButtonState -> JoystickButtonState
>= :: JoystickButtonState -> JoystickButtonState -> Bool
$c>= :: JoystickButtonState -> JoystickButtonState -> Bool
> :: JoystickButtonState -> JoystickButtonState -> Bool
$c> :: JoystickButtonState -> JoystickButtonState -> Bool
<= :: JoystickButtonState -> JoystickButtonState -> Bool
$c<= :: JoystickButtonState -> JoystickButtonState -> Bool
< :: JoystickButtonState -> JoystickButtonState -> Bool
$c< :: JoystickButtonState -> JoystickButtonState -> Bool
compare :: JoystickButtonState -> JoystickButtonState -> Ordering
$ccompare :: JoystickButtonState -> JoystickButtonState -> Ordering
$cp1Ord :: Eq JoystickButtonState
Ord, ReadPrec [JoystickButtonState]
ReadPrec JoystickButtonState
Int -> ReadS JoystickButtonState
ReadS [JoystickButtonState]
(Int -> ReadS JoystickButtonState)
-> ReadS [JoystickButtonState]
-> ReadPrec JoystickButtonState
-> ReadPrec [JoystickButtonState]
-> Read JoystickButtonState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JoystickButtonState]
$creadListPrec :: ReadPrec [JoystickButtonState]
readPrec :: ReadPrec JoystickButtonState
$creadPrec :: ReadPrec JoystickButtonState
readList :: ReadS [JoystickButtonState]
$creadList :: ReadS [JoystickButtonState]
readsPrec :: Int -> ReadS JoystickButtonState
$creadsPrec :: Int -> ReadS JoystickButtonState
Read, Int -> JoystickButtonState -> ShowS
[JoystickButtonState] -> ShowS
JoystickButtonState -> String
(Int -> JoystickButtonState -> ShowS)
-> (JoystickButtonState -> String)
-> ([JoystickButtonState] -> ShowS)
-> Show JoystickButtonState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoystickButtonState] -> ShowS
$cshowList :: [JoystickButtonState] -> ShowS
show :: JoystickButtonState -> String
$cshow :: JoystickButtonState -> String
showsPrec :: Int -> JoystickButtonState -> ShowS
$cshowsPrec :: Int -> JoystickButtonState -> ShowS
Show, Typeable, (forall x. JoystickButtonState -> Rep JoystickButtonState x)
-> (forall x. Rep JoystickButtonState x -> JoystickButtonState)
-> Generic JoystickButtonState
forall x. Rep JoystickButtonState x -> JoystickButtonState
forall x. JoystickButtonState -> Rep JoystickButtonState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JoystickButtonState x -> JoystickButtonState
$cfrom :: forall x. JoystickButtonState -> Rep JoystickButtonState x
Generic)

instance NFData JoystickButtonState

-- | Part of the t'Graphics.UI.GLFW.JoystickCallback', for when a monitor gets

-- connected or disconnected.

data JoystickState
  = JoystickState'Connected
  | JoystickState'Disconnected
  deriving (JoystickState
JoystickState -> JoystickState -> Bounded JoystickState
forall a. a -> a -> Bounded a
maxBound :: JoystickState
$cmaxBound :: JoystickState
minBound :: JoystickState
$cminBound :: JoystickState
Bounded, Typeable JoystickState
DataType
Constr
Typeable JoystickState =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> JoystickState -> c JoystickState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JoystickState)
-> (JoystickState -> Constr)
-> (JoystickState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JoystickState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c JoystickState))
-> ((forall b. Data b => b -> b) -> JoystickState -> JoystickState)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JoystickState -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JoystickState -> r)
-> (forall u. (forall d. Data d => d -> u) -> JoystickState -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> JoystickState -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> JoystickState -> m JoystickState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JoystickState -> m JoystickState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JoystickState -> m JoystickState)
-> Data JoystickState
JoystickState -> DataType
JoystickState -> Constr
(forall b. Data b => b -> b) -> JoystickState -> JoystickState
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoystickState -> c JoystickState
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoystickState
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) -> JoystickState -> u
forall u. (forall d. Data d => d -> u) -> JoystickState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JoystickState -> m JoystickState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoystickState -> m JoystickState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoystickState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoystickState -> c JoystickState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoystickState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoystickState)
$cJoystickState'Disconnected :: Constr
$cJoystickState'Connected :: Constr
$tJoystickState :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> JoystickState -> m JoystickState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoystickState -> m JoystickState
gmapMp :: (forall d. Data d => d -> m d) -> JoystickState -> m JoystickState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JoystickState -> m JoystickState
gmapM :: (forall d. Data d => d -> m d) -> JoystickState -> m JoystickState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JoystickState -> m JoystickState
gmapQi :: Int -> (forall d. Data d => d -> u) -> JoystickState -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JoystickState -> u
gmapQ :: (forall d. Data d => d -> u) -> JoystickState -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JoystickState -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickState -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickState -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickState -> r
gmapT :: (forall b. Data b => b -> b) -> JoystickState -> JoystickState
$cgmapT :: (forall b. Data b => b -> b) -> JoystickState -> JoystickState
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoystickState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoystickState)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JoystickState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoystickState)
dataTypeOf :: JoystickState -> DataType
$cdataTypeOf :: JoystickState -> DataType
toConstr :: JoystickState -> Constr
$ctoConstr :: JoystickState -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoystickState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoystickState
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoystickState -> c JoystickState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoystickState -> c JoystickState
$cp1Data :: Typeable JoystickState
Data, Int -> JoystickState
JoystickState -> Int
JoystickState -> [JoystickState]
JoystickState -> JoystickState
JoystickState -> JoystickState -> [JoystickState]
JoystickState -> JoystickState -> JoystickState -> [JoystickState]
(JoystickState -> JoystickState)
-> (JoystickState -> JoystickState)
-> (Int -> JoystickState)
-> (JoystickState -> Int)
-> (JoystickState -> [JoystickState])
-> (JoystickState -> JoystickState -> [JoystickState])
-> (JoystickState -> JoystickState -> [JoystickState])
-> (JoystickState
    -> JoystickState -> JoystickState -> [JoystickState])
-> Enum JoystickState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: JoystickState -> JoystickState -> JoystickState -> [JoystickState]
$cenumFromThenTo :: JoystickState -> JoystickState -> JoystickState -> [JoystickState]
enumFromTo :: JoystickState -> JoystickState -> [JoystickState]
$cenumFromTo :: JoystickState -> JoystickState -> [JoystickState]
enumFromThen :: JoystickState -> JoystickState -> [JoystickState]
$cenumFromThen :: JoystickState -> JoystickState -> [JoystickState]
enumFrom :: JoystickState -> [JoystickState]
$cenumFrom :: JoystickState -> [JoystickState]
fromEnum :: JoystickState -> Int
$cfromEnum :: JoystickState -> Int
toEnum :: Int -> JoystickState
$ctoEnum :: Int -> JoystickState
pred :: JoystickState -> JoystickState
$cpred :: JoystickState -> JoystickState
succ :: JoystickState -> JoystickState
$csucc :: JoystickState -> JoystickState
Enum, JoystickState -> JoystickState -> Bool
(JoystickState -> JoystickState -> Bool)
-> (JoystickState -> JoystickState -> Bool) -> Eq JoystickState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoystickState -> JoystickState -> Bool
$c/= :: JoystickState -> JoystickState -> Bool
== :: JoystickState -> JoystickState -> Bool
$c== :: JoystickState -> JoystickState -> Bool
Eq, Eq JoystickState
Eq JoystickState =>
(JoystickState -> JoystickState -> Ordering)
-> (JoystickState -> JoystickState -> Bool)
-> (JoystickState -> JoystickState -> Bool)
-> (JoystickState -> JoystickState -> Bool)
-> (JoystickState -> JoystickState -> Bool)
-> (JoystickState -> JoystickState -> JoystickState)
-> (JoystickState -> JoystickState -> JoystickState)
-> Ord JoystickState
JoystickState -> JoystickState -> Bool
JoystickState -> JoystickState -> Ordering
JoystickState -> JoystickState -> JoystickState
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 :: JoystickState -> JoystickState -> JoystickState
$cmin :: JoystickState -> JoystickState -> JoystickState
max :: JoystickState -> JoystickState -> JoystickState
$cmax :: JoystickState -> JoystickState -> JoystickState
>= :: JoystickState -> JoystickState -> Bool
$c>= :: JoystickState -> JoystickState -> Bool
> :: JoystickState -> JoystickState -> Bool
$c> :: JoystickState -> JoystickState -> Bool
<= :: JoystickState -> JoystickState -> Bool
$c<= :: JoystickState -> JoystickState -> Bool
< :: JoystickState -> JoystickState -> Bool
$c< :: JoystickState -> JoystickState -> Bool
compare :: JoystickState -> JoystickState -> Ordering
$ccompare :: JoystickState -> JoystickState -> Ordering
$cp1Ord :: Eq JoystickState
Ord, ReadPrec [JoystickState]
ReadPrec JoystickState
Int -> ReadS JoystickState
ReadS [JoystickState]
(Int -> ReadS JoystickState)
-> ReadS [JoystickState]
-> ReadPrec JoystickState
-> ReadPrec [JoystickState]
-> Read JoystickState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JoystickState]
$creadListPrec :: ReadPrec [JoystickState]
readPrec :: ReadPrec JoystickState
$creadPrec :: ReadPrec JoystickState
readList :: ReadS [JoystickState]
$creadList :: ReadS [JoystickState]
readsPrec :: Int -> ReadS JoystickState
$creadsPrec :: Int -> ReadS JoystickState
Read, Int -> JoystickState -> ShowS
[JoystickState] -> ShowS
JoystickState -> String
(Int -> JoystickState -> ShowS)
-> (JoystickState -> String)
-> ([JoystickState] -> ShowS)
-> Show JoystickState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoystickState] -> ShowS
$cshowList :: [JoystickState] -> ShowS
show :: JoystickState -> String
$cshow :: JoystickState -> String
showsPrec :: Int -> JoystickState -> ShowS
$cshowsPrec :: Int -> JoystickState -> ShowS
Show, Typeable, (forall x. JoystickState -> Rep JoystickState x)
-> (forall x. Rep JoystickState x -> JoystickState)
-> Generic JoystickState
forall x. Rep JoystickState x -> JoystickState
forall x. JoystickState -> Rep JoystickState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JoystickState x -> JoystickState
$cfrom :: forall x. JoystickState -> Rep JoystickState x
Generic)

instance NFData JoystickState

-- | The valid hat states of a joystick. Part of the

-- <https://www.glfw.org/docs/3.3/input_guide.html#joystick_hat joystick hat>

-- system.

data JoystickHatState
  = JoystickHatState'Centered
  | JoystickHatState'Up
  | JoystickHatState'Right
  | JoystickHatState'Down
  | JoystickHatState'Left
  | JoystickHatState'RightUp
  | JoystickHatState'RightDown
  | JoystickHatState'LeftUp
  | JoystickHatState'LeftDown
  deriving (JoystickHatState
JoystickHatState -> JoystickHatState -> Bounded JoystickHatState
forall a. a -> a -> Bounded a
maxBound :: JoystickHatState
$cmaxBound :: JoystickHatState
minBound :: JoystickHatState
$cminBound :: JoystickHatState
Bounded, Typeable JoystickHatState
DataType
Constr
Typeable JoystickHatState =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> JoystickHatState -> c JoystickHatState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JoystickHatState)
-> (JoystickHatState -> Constr)
-> (JoystickHatState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JoystickHatState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c JoystickHatState))
-> ((forall b. Data b => b -> b)
    -> JoystickHatState -> JoystickHatState)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JoystickHatState -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JoystickHatState -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> JoystickHatState -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> JoystickHatState -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> JoystickHatState -> m JoystickHatState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> JoystickHatState -> m JoystickHatState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> JoystickHatState -> m JoystickHatState)
-> Data JoystickHatState
JoystickHatState -> DataType
JoystickHatState -> Constr
(forall b. Data b => b -> b)
-> JoystickHatState -> JoystickHatState
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoystickHatState -> c JoystickHatState
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoystickHatState
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) -> JoystickHatState -> u
forall u. (forall d. Data d => d -> u) -> JoystickHatState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickHatState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickHatState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> JoystickHatState -> m JoystickHatState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoystickHatState -> m JoystickHatState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoystickHatState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoystickHatState -> c JoystickHatState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoystickHatState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoystickHatState)
$cJoystickHatState'LeftDown :: Constr
$cJoystickHatState'LeftUp :: Constr
$cJoystickHatState'RightDown :: Constr
$cJoystickHatState'RightUp :: Constr
$cJoystickHatState'Left :: Constr
$cJoystickHatState'Down :: Constr
$cJoystickHatState'Right :: Constr
$cJoystickHatState'Up :: Constr
$cJoystickHatState'Centered :: Constr
$tJoystickHatState :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> JoystickHatState -> m JoystickHatState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoystickHatState -> m JoystickHatState
gmapMp :: (forall d. Data d => d -> m d)
-> JoystickHatState -> m JoystickHatState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoystickHatState -> m JoystickHatState
gmapM :: (forall d. Data d => d -> m d)
-> JoystickHatState -> m JoystickHatState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> JoystickHatState -> m JoystickHatState
gmapQi :: Int -> (forall d. Data d => d -> u) -> JoystickHatState -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> JoystickHatState -> u
gmapQ :: (forall d. Data d => d -> u) -> JoystickHatState -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JoystickHatState -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickHatState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickHatState -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickHatState -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoystickHatState -> r
gmapT :: (forall b. Data b => b -> b)
-> JoystickHatState -> JoystickHatState
$cgmapT :: (forall b. Data b => b -> b)
-> JoystickHatState -> JoystickHatState
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoystickHatState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoystickHatState)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JoystickHatState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoystickHatState)
dataTypeOf :: JoystickHatState -> DataType
$cdataTypeOf :: JoystickHatState -> DataType
toConstr :: JoystickHatState -> Constr
$ctoConstr :: JoystickHatState -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoystickHatState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoystickHatState
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoystickHatState -> c JoystickHatState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoystickHatState -> c JoystickHatState
$cp1Data :: Typeable JoystickHatState
Data, Int -> JoystickHatState
JoystickHatState -> Int
JoystickHatState -> [JoystickHatState]
JoystickHatState -> JoystickHatState
JoystickHatState -> JoystickHatState -> [JoystickHatState]
JoystickHatState
-> JoystickHatState -> JoystickHatState -> [JoystickHatState]
(JoystickHatState -> JoystickHatState)
-> (JoystickHatState -> JoystickHatState)
-> (Int -> JoystickHatState)
-> (JoystickHatState -> Int)
-> (JoystickHatState -> [JoystickHatState])
-> (JoystickHatState -> JoystickHatState -> [JoystickHatState])
-> (JoystickHatState -> JoystickHatState -> [JoystickHatState])
-> (JoystickHatState
    -> JoystickHatState -> JoystickHatState -> [JoystickHatState])
-> Enum JoystickHatState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: JoystickHatState
-> JoystickHatState -> JoystickHatState -> [JoystickHatState]
$cenumFromThenTo :: JoystickHatState
-> JoystickHatState -> JoystickHatState -> [JoystickHatState]
enumFromTo :: JoystickHatState -> JoystickHatState -> [JoystickHatState]
$cenumFromTo :: JoystickHatState -> JoystickHatState -> [JoystickHatState]
enumFromThen :: JoystickHatState -> JoystickHatState -> [JoystickHatState]
$cenumFromThen :: JoystickHatState -> JoystickHatState -> [JoystickHatState]
enumFrom :: JoystickHatState -> [JoystickHatState]
$cenumFrom :: JoystickHatState -> [JoystickHatState]
fromEnum :: JoystickHatState -> Int
$cfromEnum :: JoystickHatState -> Int
toEnum :: Int -> JoystickHatState
$ctoEnum :: Int -> JoystickHatState
pred :: JoystickHatState -> JoystickHatState
$cpred :: JoystickHatState -> JoystickHatState
succ :: JoystickHatState -> JoystickHatState
$csucc :: JoystickHatState -> JoystickHatState
Enum, JoystickHatState -> JoystickHatState -> Bool
(JoystickHatState -> JoystickHatState -> Bool)
-> (JoystickHatState -> JoystickHatState -> Bool)
-> Eq JoystickHatState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoystickHatState -> JoystickHatState -> Bool
$c/= :: JoystickHatState -> JoystickHatState -> Bool
== :: JoystickHatState -> JoystickHatState -> Bool
$c== :: JoystickHatState -> JoystickHatState -> Bool
Eq, Eq JoystickHatState
Eq JoystickHatState =>
(JoystickHatState -> JoystickHatState -> Ordering)
-> (JoystickHatState -> JoystickHatState -> Bool)
-> (JoystickHatState -> JoystickHatState -> Bool)
-> (JoystickHatState -> JoystickHatState -> Bool)
-> (JoystickHatState -> JoystickHatState -> Bool)
-> (JoystickHatState -> JoystickHatState -> JoystickHatState)
-> (JoystickHatState -> JoystickHatState -> JoystickHatState)
-> Ord JoystickHatState
JoystickHatState -> JoystickHatState -> Bool
JoystickHatState -> JoystickHatState -> Ordering
JoystickHatState -> JoystickHatState -> JoystickHatState
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 :: JoystickHatState -> JoystickHatState -> JoystickHatState
$cmin :: JoystickHatState -> JoystickHatState -> JoystickHatState
max :: JoystickHatState -> JoystickHatState -> JoystickHatState
$cmax :: JoystickHatState -> JoystickHatState -> JoystickHatState
>= :: JoystickHatState -> JoystickHatState -> Bool
$c>= :: JoystickHatState -> JoystickHatState -> Bool
> :: JoystickHatState -> JoystickHatState -> Bool
$c> :: JoystickHatState -> JoystickHatState -> Bool
<= :: JoystickHatState -> JoystickHatState -> Bool
$c<= :: JoystickHatState -> JoystickHatState -> Bool
< :: JoystickHatState -> JoystickHatState -> Bool
$c< :: JoystickHatState -> JoystickHatState -> Bool
compare :: JoystickHatState -> JoystickHatState -> Ordering
$ccompare :: JoystickHatState -> JoystickHatState -> Ordering
$cp1Ord :: Eq JoystickHatState
Ord, ReadPrec [JoystickHatState]
ReadPrec JoystickHatState
Int -> ReadS JoystickHatState
ReadS [JoystickHatState]
(Int -> ReadS JoystickHatState)
-> ReadS [JoystickHatState]
-> ReadPrec JoystickHatState
-> ReadPrec [JoystickHatState]
-> Read JoystickHatState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JoystickHatState]
$creadListPrec :: ReadPrec [JoystickHatState]
readPrec :: ReadPrec JoystickHatState
$creadPrec :: ReadPrec JoystickHatState
readList :: ReadS [JoystickHatState]
$creadList :: ReadS [JoystickHatState]
readsPrec :: Int -> ReadS JoystickHatState
$creadsPrec :: Int -> ReadS JoystickHatState
Read, Int -> JoystickHatState -> ShowS
[JoystickHatState] -> ShowS
JoystickHatState -> String
(Int -> JoystickHatState -> ShowS)
-> (JoystickHatState -> String)
-> ([JoystickHatState] -> ShowS)
-> Show JoystickHatState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoystickHatState] -> ShowS
$cshowList :: [JoystickHatState] -> ShowS
show :: JoystickHatState -> String
$cshow :: JoystickHatState -> String
showsPrec :: Int -> JoystickHatState -> ShowS
$cshowsPrec :: Int -> JoystickHatState -> ShowS
Show, Typeable, (forall x. JoystickHatState -> Rep JoystickHatState x)
-> (forall x. Rep JoystickHatState x -> JoystickHatState)
-> Generic JoystickHatState
forall x. Rep JoystickHatState x -> JoystickHatState
forall x. JoystickHatState -> Rep JoystickHatState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JoystickHatState x -> JoystickHatState
$cfrom :: forall x. JoystickHatState -> Rep JoystickHatState x
Generic)

instance NFData JoystickHatState

-- | Part of the <http://www.Graphics.UI.GLFW.org/docs/3.3/input.html#input_mouse Mouse Input> system.

data MouseButton =
    MouseButton'1
  | MouseButton'2
  | MouseButton'3
  | MouseButton'4
  | MouseButton'5
  | MouseButton'6
  | MouseButton'7
  | MouseButton'8
  deriving (MouseButton
MouseButton -> MouseButton -> Bounded MouseButton
forall a. a -> a -> Bounded a
maxBound :: MouseButton
$cmaxBound :: MouseButton
minBound :: MouseButton
$cminBound :: MouseButton
Bounded, Typeable MouseButton
DataType
Constr
Typeable MouseButton =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> MouseButton -> c MouseButton)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MouseButton)
-> (MouseButton -> Constr)
-> (MouseButton -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MouseButton))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MouseButton))
-> ((forall b. Data b => b -> b) -> MouseButton -> MouseButton)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MouseButton -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MouseButton -> r)
-> (forall u. (forall d. Data d => d -> u) -> MouseButton -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MouseButton -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> MouseButton -> m MouseButton)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MouseButton -> m MouseButton)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MouseButton -> m MouseButton)
-> Data MouseButton
MouseButton -> DataType
MouseButton -> Constr
(forall b. Data b => b -> b) -> MouseButton -> MouseButton
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MouseButton -> c MouseButton
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MouseButton
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) -> MouseButton -> u
forall u. (forall d. Data d => d -> u) -> MouseButton -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MouseButton -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MouseButton -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MouseButton -> m MouseButton
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MouseButton -> m MouseButton
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MouseButton
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MouseButton -> c MouseButton
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MouseButton)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MouseButton)
$cMouseButton'8 :: Constr
$cMouseButton'7 :: Constr
$cMouseButton'6 :: Constr
$cMouseButton'5 :: Constr
$cMouseButton'4 :: Constr
$cMouseButton'3 :: Constr
$cMouseButton'2 :: Constr
$cMouseButton'1 :: Constr
$tMouseButton :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> MouseButton -> m MouseButton
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MouseButton -> m MouseButton
gmapMp :: (forall d. Data d => d -> m d) -> MouseButton -> m MouseButton
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MouseButton -> m MouseButton
gmapM :: (forall d. Data d => d -> m d) -> MouseButton -> m MouseButton
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MouseButton -> m MouseButton
gmapQi :: Int -> (forall d. Data d => d -> u) -> MouseButton -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MouseButton -> u
gmapQ :: (forall d. Data d => d -> u) -> MouseButton -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MouseButton -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MouseButton -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MouseButton -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MouseButton -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MouseButton -> r
gmapT :: (forall b. Data b => b -> b) -> MouseButton -> MouseButton
$cgmapT :: (forall b. Data b => b -> b) -> MouseButton -> MouseButton
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MouseButton)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MouseButton)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MouseButton)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MouseButton)
dataTypeOf :: MouseButton -> DataType
$cdataTypeOf :: MouseButton -> DataType
toConstr :: MouseButton -> Constr
$ctoConstr :: MouseButton -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MouseButton
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MouseButton
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MouseButton -> c MouseButton
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MouseButton -> c MouseButton
$cp1Data :: Typeable MouseButton
Data, Int -> MouseButton
MouseButton -> Int
MouseButton -> [MouseButton]
MouseButton -> MouseButton
MouseButton -> MouseButton -> [MouseButton]
MouseButton -> MouseButton -> MouseButton -> [MouseButton]
(MouseButton -> MouseButton)
-> (MouseButton -> MouseButton)
-> (Int -> MouseButton)
-> (MouseButton -> Int)
-> (MouseButton -> [MouseButton])
-> (MouseButton -> MouseButton -> [MouseButton])
-> (MouseButton -> MouseButton -> [MouseButton])
-> (MouseButton -> MouseButton -> MouseButton -> [MouseButton])
-> Enum MouseButton
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MouseButton -> MouseButton -> MouseButton -> [MouseButton]
$cenumFromThenTo :: MouseButton -> MouseButton -> MouseButton -> [MouseButton]
enumFromTo :: MouseButton -> MouseButton -> [MouseButton]
$cenumFromTo :: MouseButton -> MouseButton -> [MouseButton]
enumFromThen :: MouseButton -> MouseButton -> [MouseButton]
$cenumFromThen :: MouseButton -> MouseButton -> [MouseButton]
enumFrom :: MouseButton -> [MouseButton]
$cenumFrom :: MouseButton -> [MouseButton]
fromEnum :: MouseButton -> Int
$cfromEnum :: MouseButton -> Int
toEnum :: Int -> MouseButton
$ctoEnum :: Int -> MouseButton
pred :: MouseButton -> MouseButton
$cpred :: MouseButton -> MouseButton
succ :: MouseButton -> MouseButton
$csucc :: MouseButton -> MouseButton
Enum, MouseButton -> MouseButton -> Bool
(MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool) -> Eq MouseButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseButton -> MouseButton -> Bool
$c/= :: MouseButton -> MouseButton -> Bool
== :: MouseButton -> MouseButton -> Bool
$c== :: MouseButton -> MouseButton -> Bool
Eq, Eq MouseButton
Eq MouseButton =>
(MouseButton -> MouseButton -> Ordering)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> MouseButton)
-> (MouseButton -> MouseButton -> MouseButton)
-> Ord MouseButton
MouseButton -> MouseButton -> Bool
MouseButton -> MouseButton -> Ordering
MouseButton -> MouseButton -> MouseButton
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 :: MouseButton -> MouseButton -> MouseButton
$cmin :: MouseButton -> MouseButton -> MouseButton
max :: MouseButton -> MouseButton -> MouseButton
$cmax :: MouseButton -> MouseButton -> MouseButton
>= :: MouseButton -> MouseButton -> Bool
$c>= :: MouseButton -> MouseButton -> Bool
> :: MouseButton -> MouseButton -> Bool
$c> :: MouseButton -> MouseButton -> Bool
<= :: MouseButton -> MouseButton -> Bool
$c<= :: MouseButton -> MouseButton -> Bool
< :: MouseButton -> MouseButton -> Bool
$c< :: MouseButton -> MouseButton -> Bool
compare :: MouseButton -> MouseButton -> Ordering
$ccompare :: MouseButton -> MouseButton -> Ordering
$cp1Ord :: Eq MouseButton
Ord, ReadPrec [MouseButton]
ReadPrec MouseButton
Int -> ReadS MouseButton
ReadS [MouseButton]
(Int -> ReadS MouseButton)
-> ReadS [MouseButton]
-> ReadPrec MouseButton
-> ReadPrec [MouseButton]
-> Read MouseButton
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MouseButton]
$creadListPrec :: ReadPrec [MouseButton]
readPrec :: ReadPrec MouseButton
$creadPrec :: ReadPrec MouseButton
readList :: ReadS [MouseButton]
$creadList :: ReadS [MouseButton]
readsPrec :: Int -> ReadS MouseButton
$creadsPrec :: Int -> ReadS MouseButton
Read, Int -> MouseButton -> ShowS
[MouseButton] -> ShowS
MouseButton -> String
(Int -> MouseButton -> ShowS)
-> (MouseButton -> String)
-> ([MouseButton] -> ShowS)
-> Show MouseButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MouseButton] -> ShowS
$cshowList :: [MouseButton] -> ShowS
show :: MouseButton -> String
$cshow :: MouseButton -> String
showsPrec :: Int -> MouseButton -> ShowS
$cshowsPrec :: Int -> MouseButton -> ShowS
Show, Typeable, (forall x. MouseButton -> Rep MouseButton x)
-> (forall x. Rep MouseButton x -> MouseButton)
-> Generic MouseButton
forall x. Rep MouseButton x -> MouseButton
forall x. MouseButton -> Rep MouseButton x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MouseButton x -> MouseButton
$cfrom :: forall x. MouseButton -> Rep MouseButton x
Generic)

instance NFData MouseButton

-- | If the mouse button is pressed or not when 'Graphics.UI.GLFW.getMouseButton' is

-- called.

data MouseButtonState =
    MouseButtonState'Pressed
  | MouseButtonState'Released
  deriving (MouseButtonState
MouseButtonState -> MouseButtonState -> Bounded MouseButtonState
forall a. a -> a -> Bounded a
maxBound :: MouseButtonState
$cmaxBound :: MouseButtonState
minBound :: MouseButtonState
$cminBound :: MouseButtonState
Bounded, Typeable MouseButtonState
DataType
Constr
Typeable MouseButtonState =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> MouseButtonState -> c MouseButtonState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MouseButtonState)
-> (MouseButtonState -> Constr)
-> (MouseButtonState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MouseButtonState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MouseButtonState))
-> ((forall b. Data b => b -> b)
    -> MouseButtonState -> MouseButtonState)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MouseButtonState -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MouseButtonState -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> MouseButtonState -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MouseButtonState -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MouseButtonState -> m MouseButtonState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MouseButtonState -> m MouseButtonState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MouseButtonState -> m MouseButtonState)
-> Data MouseButtonState
MouseButtonState -> DataType
MouseButtonState -> Constr
(forall b. Data b => b -> b)
-> MouseButtonState -> MouseButtonState
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MouseButtonState -> c MouseButtonState
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MouseButtonState
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) -> MouseButtonState -> u
forall u. (forall d. Data d => d -> u) -> MouseButtonState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MouseButtonState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MouseButtonState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MouseButtonState -> m MouseButtonState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MouseButtonState -> m MouseButtonState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MouseButtonState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MouseButtonState -> c MouseButtonState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MouseButtonState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MouseButtonState)
$cMouseButtonState'Released :: Constr
$cMouseButtonState'Pressed :: Constr
$tMouseButtonState :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> MouseButtonState -> m MouseButtonState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MouseButtonState -> m MouseButtonState
gmapMp :: (forall d. Data d => d -> m d)
-> MouseButtonState -> m MouseButtonState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MouseButtonState -> m MouseButtonState
gmapM :: (forall d. Data d => d -> m d)
-> MouseButtonState -> m MouseButtonState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MouseButtonState -> m MouseButtonState
gmapQi :: Int -> (forall d. Data d => d -> u) -> MouseButtonState -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MouseButtonState -> u
gmapQ :: (forall d. Data d => d -> u) -> MouseButtonState -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MouseButtonState -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MouseButtonState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MouseButtonState -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MouseButtonState -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MouseButtonState -> r
gmapT :: (forall b. Data b => b -> b)
-> MouseButtonState -> MouseButtonState
$cgmapT :: (forall b. Data b => b -> b)
-> MouseButtonState -> MouseButtonState
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MouseButtonState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MouseButtonState)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MouseButtonState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MouseButtonState)
dataTypeOf :: MouseButtonState -> DataType
$cdataTypeOf :: MouseButtonState -> DataType
toConstr :: MouseButtonState -> Constr
$ctoConstr :: MouseButtonState -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MouseButtonState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MouseButtonState
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MouseButtonState -> c MouseButtonState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MouseButtonState -> c MouseButtonState
$cp1Data :: Typeable MouseButtonState
Data, Int -> MouseButtonState
MouseButtonState -> Int
MouseButtonState -> [MouseButtonState]
MouseButtonState -> MouseButtonState
MouseButtonState -> MouseButtonState -> [MouseButtonState]
MouseButtonState
-> MouseButtonState -> MouseButtonState -> [MouseButtonState]
(MouseButtonState -> MouseButtonState)
-> (MouseButtonState -> MouseButtonState)
-> (Int -> MouseButtonState)
-> (MouseButtonState -> Int)
-> (MouseButtonState -> [MouseButtonState])
-> (MouseButtonState -> MouseButtonState -> [MouseButtonState])
-> (MouseButtonState -> MouseButtonState -> [MouseButtonState])
-> (MouseButtonState
    -> MouseButtonState -> MouseButtonState -> [MouseButtonState])
-> Enum MouseButtonState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MouseButtonState
-> MouseButtonState -> MouseButtonState -> [MouseButtonState]
$cenumFromThenTo :: MouseButtonState
-> MouseButtonState -> MouseButtonState -> [MouseButtonState]
enumFromTo :: MouseButtonState -> MouseButtonState -> [MouseButtonState]
$cenumFromTo :: MouseButtonState -> MouseButtonState -> [MouseButtonState]
enumFromThen :: MouseButtonState -> MouseButtonState -> [MouseButtonState]
$cenumFromThen :: MouseButtonState -> MouseButtonState -> [MouseButtonState]
enumFrom :: MouseButtonState -> [MouseButtonState]
$cenumFrom :: MouseButtonState -> [MouseButtonState]
fromEnum :: MouseButtonState -> Int
$cfromEnum :: MouseButtonState -> Int
toEnum :: Int -> MouseButtonState
$ctoEnum :: Int -> MouseButtonState
pred :: MouseButtonState -> MouseButtonState
$cpred :: MouseButtonState -> MouseButtonState
succ :: MouseButtonState -> MouseButtonState
$csucc :: MouseButtonState -> MouseButtonState
Enum, MouseButtonState -> MouseButtonState -> Bool
(MouseButtonState -> MouseButtonState -> Bool)
-> (MouseButtonState -> MouseButtonState -> Bool)
-> Eq MouseButtonState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseButtonState -> MouseButtonState -> Bool
$c/= :: MouseButtonState -> MouseButtonState -> Bool
== :: MouseButtonState -> MouseButtonState -> Bool
$c== :: MouseButtonState -> MouseButtonState -> Bool
Eq, Eq MouseButtonState
Eq MouseButtonState =>
(MouseButtonState -> MouseButtonState -> Ordering)
-> (MouseButtonState -> MouseButtonState -> Bool)
-> (MouseButtonState -> MouseButtonState -> Bool)
-> (MouseButtonState -> MouseButtonState -> Bool)
-> (MouseButtonState -> MouseButtonState -> Bool)
-> (MouseButtonState -> MouseButtonState -> MouseButtonState)
-> (MouseButtonState -> MouseButtonState -> MouseButtonState)
-> Ord MouseButtonState
MouseButtonState -> MouseButtonState -> Bool
MouseButtonState -> MouseButtonState -> Ordering
MouseButtonState -> MouseButtonState -> MouseButtonState
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 :: MouseButtonState -> MouseButtonState -> MouseButtonState
$cmin :: MouseButtonState -> MouseButtonState -> MouseButtonState
max :: MouseButtonState -> MouseButtonState -> MouseButtonState
$cmax :: MouseButtonState -> MouseButtonState -> MouseButtonState
>= :: MouseButtonState -> MouseButtonState -> Bool
$c>= :: MouseButtonState -> MouseButtonState -> Bool
> :: MouseButtonState -> MouseButtonState -> Bool
$c> :: MouseButtonState -> MouseButtonState -> Bool
<= :: MouseButtonState -> MouseButtonState -> Bool
$c<= :: MouseButtonState -> MouseButtonState -> Bool
< :: MouseButtonState -> MouseButtonState -> Bool
$c< :: MouseButtonState -> MouseButtonState -> Bool
compare :: MouseButtonState -> MouseButtonState -> Ordering
$ccompare :: MouseButtonState -> MouseButtonState -> Ordering
$cp1Ord :: Eq MouseButtonState
Ord, ReadPrec [MouseButtonState]
ReadPrec MouseButtonState
Int -> ReadS MouseButtonState
ReadS [MouseButtonState]
(Int -> ReadS MouseButtonState)
-> ReadS [MouseButtonState]
-> ReadPrec MouseButtonState
-> ReadPrec [MouseButtonState]
-> Read MouseButtonState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MouseButtonState]
$creadListPrec :: ReadPrec [MouseButtonState]
readPrec :: ReadPrec MouseButtonState
$creadPrec :: ReadPrec MouseButtonState
readList :: ReadS [MouseButtonState]
$creadList :: ReadS [MouseButtonState]
readsPrec :: Int -> ReadS MouseButtonState
$creadsPrec :: Int -> ReadS MouseButtonState
Read, Int -> MouseButtonState -> ShowS
[MouseButtonState] -> ShowS
MouseButtonState -> String
(Int -> MouseButtonState -> ShowS)
-> (MouseButtonState -> String)
-> ([MouseButtonState] -> ShowS)
-> Show MouseButtonState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MouseButtonState] -> ShowS
$cshowList :: [MouseButtonState] -> ShowS
show :: MouseButtonState -> String
$cshow :: MouseButtonState -> String
showsPrec :: Int -> MouseButtonState -> ShowS
$cshowsPrec :: Int -> MouseButtonState -> ShowS
Show, Typeable, (forall x. MouseButtonState -> Rep MouseButtonState x)
-> (forall x. Rep MouseButtonState x -> MouseButtonState)
-> Generic MouseButtonState
forall x. Rep MouseButtonState x -> MouseButtonState
forall x. MouseButtonState -> Rep MouseButtonState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MouseButtonState x -> MouseButtonState
$cfrom :: forall x. MouseButtonState -> Rep MouseButtonState x
Generic)

instance NFData MouseButtonState

-- | If the mouse's cursor is in the window or not.

data CursorState =
    CursorState'InWindow
  | CursorState'NotInWindow
  deriving (CursorState
CursorState -> CursorState -> Bounded CursorState
forall a. a -> a -> Bounded a
maxBound :: CursorState
$cmaxBound :: CursorState
minBound :: CursorState
$cminBound :: CursorState
Bounded, Typeable CursorState
DataType
Constr
Typeable CursorState =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CursorState -> c CursorState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CursorState)
-> (CursorState -> Constr)
-> (CursorState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CursorState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CursorState))
-> ((forall b. Data b => b -> b) -> CursorState -> CursorState)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CursorState -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CursorState -> r)
-> (forall u. (forall d. Data d => d -> u) -> CursorState -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CursorState -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CursorState -> m CursorState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CursorState -> m CursorState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CursorState -> m CursorState)
-> Data CursorState
CursorState -> DataType
CursorState -> Constr
(forall b. Data b => b -> b) -> CursorState -> CursorState
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CursorState -> c CursorState
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CursorState
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) -> CursorState -> u
forall u. (forall d. Data d => d -> u) -> CursorState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CursorState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CursorState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CursorState -> m CursorState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CursorState -> m CursorState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CursorState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CursorState -> c CursorState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CursorState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CursorState)
$cCursorState'NotInWindow :: Constr
$cCursorState'InWindow :: Constr
$tCursorState :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CursorState -> m CursorState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CursorState -> m CursorState
gmapMp :: (forall d. Data d => d -> m d) -> CursorState -> m CursorState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CursorState -> m CursorState
gmapM :: (forall d. Data d => d -> m d) -> CursorState -> m CursorState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CursorState -> m CursorState
gmapQi :: Int -> (forall d. Data d => d -> u) -> CursorState -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CursorState -> u
gmapQ :: (forall d. Data d => d -> u) -> CursorState -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CursorState -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CursorState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CursorState -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CursorState -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CursorState -> r
gmapT :: (forall b. Data b => b -> b) -> CursorState -> CursorState
$cgmapT :: (forall b. Data b => b -> b) -> CursorState -> CursorState
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CursorState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CursorState)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CursorState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CursorState)
dataTypeOf :: CursorState -> DataType
$cdataTypeOf :: CursorState -> DataType
toConstr :: CursorState -> Constr
$ctoConstr :: CursorState -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CursorState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CursorState
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CursorState -> c CursorState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CursorState -> c CursorState
$cp1Data :: Typeable CursorState
Data, Int -> CursorState
CursorState -> Int
CursorState -> [CursorState]
CursorState -> CursorState
CursorState -> CursorState -> [CursorState]
CursorState -> CursorState -> CursorState -> [CursorState]
(CursorState -> CursorState)
-> (CursorState -> CursorState)
-> (Int -> CursorState)
-> (CursorState -> Int)
-> (CursorState -> [CursorState])
-> (CursorState -> CursorState -> [CursorState])
-> (CursorState -> CursorState -> [CursorState])
-> (CursorState -> CursorState -> CursorState -> [CursorState])
-> Enum CursorState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CursorState -> CursorState -> CursorState -> [CursorState]
$cenumFromThenTo :: CursorState -> CursorState -> CursorState -> [CursorState]
enumFromTo :: CursorState -> CursorState -> [CursorState]
$cenumFromTo :: CursorState -> CursorState -> [CursorState]
enumFromThen :: CursorState -> CursorState -> [CursorState]
$cenumFromThen :: CursorState -> CursorState -> [CursorState]
enumFrom :: CursorState -> [CursorState]
$cenumFrom :: CursorState -> [CursorState]
fromEnum :: CursorState -> Int
$cfromEnum :: CursorState -> Int
toEnum :: Int -> CursorState
$ctoEnum :: Int -> CursorState
pred :: CursorState -> CursorState
$cpred :: CursorState -> CursorState
succ :: CursorState -> CursorState
$csucc :: CursorState -> CursorState
Enum, CursorState -> CursorState -> Bool
(CursorState -> CursorState -> Bool)
-> (CursorState -> CursorState -> Bool) -> Eq CursorState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CursorState -> CursorState -> Bool
$c/= :: CursorState -> CursorState -> Bool
== :: CursorState -> CursorState -> Bool
$c== :: CursorState -> CursorState -> Bool
Eq, Eq CursorState
Eq CursorState =>
(CursorState -> CursorState -> Ordering)
-> (CursorState -> CursorState -> Bool)
-> (CursorState -> CursorState -> Bool)
-> (CursorState -> CursorState -> Bool)
-> (CursorState -> CursorState -> Bool)
-> (CursorState -> CursorState -> CursorState)
-> (CursorState -> CursorState -> CursorState)
-> Ord CursorState
CursorState -> CursorState -> Bool
CursorState -> CursorState -> Ordering
CursorState -> CursorState -> CursorState
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 :: CursorState -> CursorState -> CursorState
$cmin :: CursorState -> CursorState -> CursorState
max :: CursorState -> CursorState -> CursorState
$cmax :: CursorState -> CursorState -> CursorState
>= :: CursorState -> CursorState -> Bool
$c>= :: CursorState -> CursorState -> Bool
> :: CursorState -> CursorState -> Bool
$c> :: CursorState -> CursorState -> Bool
<= :: CursorState -> CursorState -> Bool
$c<= :: CursorState -> CursorState -> Bool
< :: CursorState -> CursorState -> Bool
$c< :: CursorState -> CursorState -> Bool
compare :: CursorState -> CursorState -> Ordering
$ccompare :: CursorState -> CursorState -> Ordering
$cp1Ord :: Eq CursorState
Ord, ReadPrec [CursorState]
ReadPrec CursorState
Int -> ReadS CursorState
ReadS [CursorState]
(Int -> ReadS CursorState)
-> ReadS [CursorState]
-> ReadPrec CursorState
-> ReadPrec [CursorState]
-> Read CursorState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CursorState]
$creadListPrec :: ReadPrec [CursorState]
readPrec :: ReadPrec CursorState
$creadPrec :: ReadPrec CursorState
readList :: ReadS [CursorState]
$creadList :: ReadS [CursorState]
readsPrec :: Int -> ReadS CursorState
$creadsPrec :: Int -> ReadS CursorState
Read, Int -> CursorState -> ShowS
[CursorState] -> ShowS
CursorState -> String
(Int -> CursorState -> ShowS)
-> (CursorState -> String)
-> ([CursorState] -> ShowS)
-> Show CursorState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CursorState] -> ShowS
$cshowList :: [CursorState] -> ShowS
show :: CursorState -> String
$cshow :: CursorState -> String
showsPrec :: Int -> CursorState -> ShowS
$cshowsPrec :: Int -> CursorState -> ShowS
Show, Typeable, (forall x. CursorState -> Rep CursorState x)
-> (forall x. Rep CursorState x -> CursorState)
-> Generic CursorState
forall x. Rep CursorState x -> CursorState
forall x. CursorState -> Rep CursorState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CursorState x -> CursorState
$cfrom :: forall x. CursorState -> Rep CursorState x
Generic)

instance NFData CursorState

-- | Allows for special forms of mouse input.

-- See <http://www.glfw.org/docs/3.3/input.html#cursor_mode Cursor Modes>

data CursorInputMode =
    CursorInputMode'Normal
  | CursorInputMode'Hidden
  | CursorInputMode'Disabled
  deriving (CursorInputMode
CursorInputMode -> CursorInputMode -> Bounded CursorInputMode
forall a. a -> a -> Bounded a
maxBound :: CursorInputMode
$cmaxBound :: CursorInputMode
minBound :: CursorInputMode
$cminBound :: CursorInputMode
Bounded, Typeable CursorInputMode
DataType
Constr
Typeable CursorInputMode =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CursorInputMode -> c CursorInputMode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CursorInputMode)
-> (CursorInputMode -> Constr)
-> (CursorInputMode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CursorInputMode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CursorInputMode))
-> ((forall b. Data b => b -> b)
    -> CursorInputMode -> CursorInputMode)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CursorInputMode -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CursorInputMode -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CursorInputMode -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CursorInputMode -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CursorInputMode -> m CursorInputMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CursorInputMode -> m CursorInputMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CursorInputMode -> m CursorInputMode)
-> Data CursorInputMode
CursorInputMode -> DataType
CursorInputMode -> Constr
(forall b. Data b => b -> b) -> CursorInputMode -> CursorInputMode
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CursorInputMode -> c CursorInputMode
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CursorInputMode
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) -> CursorInputMode -> u
forall u. (forall d. Data d => d -> u) -> CursorInputMode -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CursorInputMode -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CursorInputMode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CursorInputMode -> m CursorInputMode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CursorInputMode -> m CursorInputMode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CursorInputMode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CursorInputMode -> c CursorInputMode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CursorInputMode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CursorInputMode)
$cCursorInputMode'Disabled :: Constr
$cCursorInputMode'Hidden :: Constr
$cCursorInputMode'Normal :: Constr
$tCursorInputMode :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> CursorInputMode -> m CursorInputMode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CursorInputMode -> m CursorInputMode
gmapMp :: (forall d. Data d => d -> m d)
-> CursorInputMode -> m CursorInputMode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CursorInputMode -> m CursorInputMode
gmapM :: (forall d. Data d => d -> m d)
-> CursorInputMode -> m CursorInputMode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CursorInputMode -> m CursorInputMode
gmapQi :: Int -> (forall d. Data d => d -> u) -> CursorInputMode -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CursorInputMode -> u
gmapQ :: (forall d. Data d => d -> u) -> CursorInputMode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CursorInputMode -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CursorInputMode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CursorInputMode -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CursorInputMode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CursorInputMode -> r
gmapT :: (forall b. Data b => b -> b) -> CursorInputMode -> CursorInputMode
$cgmapT :: (forall b. Data b => b -> b) -> CursorInputMode -> CursorInputMode
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CursorInputMode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CursorInputMode)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CursorInputMode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CursorInputMode)
dataTypeOf :: CursorInputMode -> DataType
$cdataTypeOf :: CursorInputMode -> DataType
toConstr :: CursorInputMode -> Constr
$ctoConstr :: CursorInputMode -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CursorInputMode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CursorInputMode
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CursorInputMode -> c CursorInputMode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CursorInputMode -> c CursorInputMode
$cp1Data :: Typeable CursorInputMode
Data, Int -> CursorInputMode
CursorInputMode -> Int
CursorInputMode -> [CursorInputMode]
CursorInputMode -> CursorInputMode
CursorInputMode -> CursorInputMode -> [CursorInputMode]
CursorInputMode
-> CursorInputMode -> CursorInputMode -> [CursorInputMode]
(CursorInputMode -> CursorInputMode)
-> (CursorInputMode -> CursorInputMode)
-> (Int -> CursorInputMode)
-> (CursorInputMode -> Int)
-> (CursorInputMode -> [CursorInputMode])
-> (CursorInputMode -> CursorInputMode -> [CursorInputMode])
-> (CursorInputMode -> CursorInputMode -> [CursorInputMode])
-> (CursorInputMode
    -> CursorInputMode -> CursorInputMode -> [CursorInputMode])
-> Enum CursorInputMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CursorInputMode
-> CursorInputMode -> CursorInputMode -> [CursorInputMode]
$cenumFromThenTo :: CursorInputMode
-> CursorInputMode -> CursorInputMode -> [CursorInputMode]
enumFromTo :: CursorInputMode -> CursorInputMode -> [CursorInputMode]
$cenumFromTo :: CursorInputMode -> CursorInputMode -> [CursorInputMode]
enumFromThen :: CursorInputMode -> CursorInputMode -> [CursorInputMode]
$cenumFromThen :: CursorInputMode -> CursorInputMode -> [CursorInputMode]
enumFrom :: CursorInputMode -> [CursorInputMode]
$cenumFrom :: CursorInputMode -> [CursorInputMode]
fromEnum :: CursorInputMode -> Int
$cfromEnum :: CursorInputMode -> Int
toEnum :: Int -> CursorInputMode
$ctoEnum :: Int -> CursorInputMode
pred :: CursorInputMode -> CursorInputMode
$cpred :: CursorInputMode -> CursorInputMode
succ :: CursorInputMode -> CursorInputMode
$csucc :: CursorInputMode -> CursorInputMode
Enum, CursorInputMode -> CursorInputMode -> Bool
(CursorInputMode -> CursorInputMode -> Bool)
-> (CursorInputMode -> CursorInputMode -> Bool)
-> Eq CursorInputMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CursorInputMode -> CursorInputMode -> Bool
$c/= :: CursorInputMode -> CursorInputMode -> Bool
== :: CursorInputMode -> CursorInputMode -> Bool
$c== :: CursorInputMode -> CursorInputMode -> Bool
Eq, Eq CursorInputMode
Eq CursorInputMode =>
(CursorInputMode -> CursorInputMode -> Ordering)
-> (CursorInputMode -> CursorInputMode -> Bool)
-> (CursorInputMode -> CursorInputMode -> Bool)
-> (CursorInputMode -> CursorInputMode -> Bool)
-> (CursorInputMode -> CursorInputMode -> Bool)
-> (CursorInputMode -> CursorInputMode -> CursorInputMode)
-> (CursorInputMode -> CursorInputMode -> CursorInputMode)
-> Ord CursorInputMode
CursorInputMode -> CursorInputMode -> Bool
CursorInputMode -> CursorInputMode -> Ordering
CursorInputMode -> CursorInputMode -> CursorInputMode
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 :: CursorInputMode -> CursorInputMode -> CursorInputMode
$cmin :: CursorInputMode -> CursorInputMode -> CursorInputMode
max :: CursorInputMode -> CursorInputMode -> CursorInputMode
$cmax :: CursorInputMode -> CursorInputMode -> CursorInputMode
>= :: CursorInputMode -> CursorInputMode -> Bool
$c>= :: CursorInputMode -> CursorInputMode -> Bool
> :: CursorInputMode -> CursorInputMode -> Bool
$c> :: CursorInputMode -> CursorInputMode -> Bool
<= :: CursorInputMode -> CursorInputMode -> Bool
$c<= :: CursorInputMode -> CursorInputMode -> Bool
< :: CursorInputMode -> CursorInputMode -> Bool
$c< :: CursorInputMode -> CursorInputMode -> Bool
compare :: CursorInputMode -> CursorInputMode -> Ordering
$ccompare :: CursorInputMode -> CursorInputMode -> Ordering
$cp1Ord :: Eq CursorInputMode
Ord, ReadPrec [CursorInputMode]
ReadPrec CursorInputMode
Int -> ReadS CursorInputMode
ReadS [CursorInputMode]
(Int -> ReadS CursorInputMode)
-> ReadS [CursorInputMode]
-> ReadPrec CursorInputMode
-> ReadPrec [CursorInputMode]
-> Read CursorInputMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CursorInputMode]
$creadListPrec :: ReadPrec [CursorInputMode]
readPrec :: ReadPrec CursorInputMode
$creadPrec :: ReadPrec CursorInputMode
readList :: ReadS [CursorInputMode]
$creadList :: ReadS [CursorInputMode]
readsPrec :: Int -> ReadS CursorInputMode
$creadsPrec :: Int -> ReadS CursorInputMode
Read, Int -> CursorInputMode -> ShowS
[CursorInputMode] -> ShowS
CursorInputMode -> String
(Int -> CursorInputMode -> ShowS)
-> (CursorInputMode -> String)
-> ([CursorInputMode] -> ShowS)
-> Show CursorInputMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CursorInputMode] -> ShowS
$cshowList :: [CursorInputMode] -> ShowS
show :: CursorInputMode -> String
$cshow :: CursorInputMode -> String
showsPrec :: Int -> CursorInputMode -> ShowS
$cshowsPrec :: Int -> CursorInputMode -> ShowS
Show, Typeable, (forall x. CursorInputMode -> Rep CursorInputMode x)
-> (forall x. Rep CursorInputMode x -> CursorInputMode)
-> Generic CursorInputMode
forall x. Rep CursorInputMode x -> CursorInputMode
forall x. CursorInputMode -> Rep CursorInputMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CursorInputMode x -> CursorInputMode
$cfrom :: forall x. CursorInputMode -> Rep CursorInputMode x
Generic)

instance NFData CursorInputMode

-- | When sticky keys is enabled, once a key is pressed it will remain pressed

-- at least until the state is polled with 'Graphics.UI.GLFW.getKey'. After

-- that, if the key has been released it will switch back to released. This

-- helps prevent problems with low-resolution polling missing key pressed. Note

-- that use of the callbacks to avoid this problem the the recommended route,

-- and this is just for a fallback.

data StickyKeysInputMode =
    StickyKeysInputMode'Enabled
  | StickyKeysInputMode'Disabled
  deriving (StickyKeysInputMode
StickyKeysInputMode
-> StickyKeysInputMode -> Bounded StickyKeysInputMode
forall a. a -> a -> Bounded a
maxBound :: StickyKeysInputMode
$cmaxBound :: StickyKeysInputMode
minBound :: StickyKeysInputMode
$cminBound :: StickyKeysInputMode
Bounded, Typeable StickyKeysInputMode
DataType
Constr
Typeable StickyKeysInputMode =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> StickyKeysInputMode
 -> c StickyKeysInputMode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c StickyKeysInputMode)
-> (StickyKeysInputMode -> Constr)
-> (StickyKeysInputMode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c StickyKeysInputMode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c StickyKeysInputMode))
-> ((forall b. Data b => b -> b)
    -> StickyKeysInputMode -> StickyKeysInputMode)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> StickyKeysInputMode -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> StickyKeysInputMode -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> StickyKeysInputMode -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> StickyKeysInputMode -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> StickyKeysInputMode -> m StickyKeysInputMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> StickyKeysInputMode -> m StickyKeysInputMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> StickyKeysInputMode -> m StickyKeysInputMode)
-> Data StickyKeysInputMode
StickyKeysInputMode -> DataType
StickyKeysInputMode -> Constr
(forall b. Data b => b -> b)
-> StickyKeysInputMode -> StickyKeysInputMode
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StickyKeysInputMode
-> c StickyKeysInputMode
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StickyKeysInputMode
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) -> StickyKeysInputMode -> u
forall u.
(forall d. Data d => d -> u) -> StickyKeysInputMode -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StickyKeysInputMode -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StickyKeysInputMode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StickyKeysInputMode -> m StickyKeysInputMode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StickyKeysInputMode -> m StickyKeysInputMode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StickyKeysInputMode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StickyKeysInputMode
-> c StickyKeysInputMode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StickyKeysInputMode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StickyKeysInputMode)
$cStickyKeysInputMode'Disabled :: Constr
$cStickyKeysInputMode'Enabled :: Constr
$tStickyKeysInputMode :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> StickyKeysInputMode -> m StickyKeysInputMode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StickyKeysInputMode -> m StickyKeysInputMode
gmapMp :: (forall d. Data d => d -> m d)
-> StickyKeysInputMode -> m StickyKeysInputMode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StickyKeysInputMode -> m StickyKeysInputMode
gmapM :: (forall d. Data d => d -> m d)
-> StickyKeysInputMode -> m StickyKeysInputMode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StickyKeysInputMode -> m StickyKeysInputMode
gmapQi :: Int -> (forall d. Data d => d -> u) -> StickyKeysInputMode -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> StickyKeysInputMode -> u
gmapQ :: (forall d. Data d => d -> u) -> StickyKeysInputMode -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> StickyKeysInputMode -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StickyKeysInputMode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StickyKeysInputMode -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StickyKeysInputMode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StickyKeysInputMode -> r
gmapT :: (forall b. Data b => b -> b)
-> StickyKeysInputMode -> StickyKeysInputMode
$cgmapT :: (forall b. Data b => b -> b)
-> StickyKeysInputMode -> StickyKeysInputMode
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StickyKeysInputMode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StickyKeysInputMode)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c StickyKeysInputMode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StickyKeysInputMode)
dataTypeOf :: StickyKeysInputMode -> DataType
$cdataTypeOf :: StickyKeysInputMode -> DataType
toConstr :: StickyKeysInputMode -> Constr
$ctoConstr :: StickyKeysInputMode -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StickyKeysInputMode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StickyKeysInputMode
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StickyKeysInputMode
-> c StickyKeysInputMode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StickyKeysInputMode
-> c StickyKeysInputMode
$cp1Data :: Typeable StickyKeysInputMode
Data, Int -> StickyKeysInputMode
StickyKeysInputMode -> Int
StickyKeysInputMode -> [StickyKeysInputMode]
StickyKeysInputMode -> StickyKeysInputMode
StickyKeysInputMode -> StickyKeysInputMode -> [StickyKeysInputMode]
StickyKeysInputMode
-> StickyKeysInputMode
-> StickyKeysInputMode
-> [StickyKeysInputMode]
(StickyKeysInputMode -> StickyKeysInputMode)
-> (StickyKeysInputMode -> StickyKeysInputMode)
-> (Int -> StickyKeysInputMode)
-> (StickyKeysInputMode -> Int)
-> (StickyKeysInputMode -> [StickyKeysInputMode])
-> (StickyKeysInputMode
    -> StickyKeysInputMode -> [StickyKeysInputMode])
-> (StickyKeysInputMode
    -> StickyKeysInputMode -> [StickyKeysInputMode])
-> (StickyKeysInputMode
    -> StickyKeysInputMode
    -> StickyKeysInputMode
    -> [StickyKeysInputMode])
-> Enum StickyKeysInputMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StickyKeysInputMode
-> StickyKeysInputMode
-> StickyKeysInputMode
-> [StickyKeysInputMode]
$cenumFromThenTo :: StickyKeysInputMode
-> StickyKeysInputMode
-> StickyKeysInputMode
-> [StickyKeysInputMode]
enumFromTo :: StickyKeysInputMode -> StickyKeysInputMode -> [StickyKeysInputMode]
$cenumFromTo :: StickyKeysInputMode -> StickyKeysInputMode -> [StickyKeysInputMode]
enumFromThen :: StickyKeysInputMode -> StickyKeysInputMode -> [StickyKeysInputMode]
$cenumFromThen :: StickyKeysInputMode -> StickyKeysInputMode -> [StickyKeysInputMode]
enumFrom :: StickyKeysInputMode -> [StickyKeysInputMode]
$cenumFrom :: StickyKeysInputMode -> [StickyKeysInputMode]
fromEnum :: StickyKeysInputMode -> Int
$cfromEnum :: StickyKeysInputMode -> Int
toEnum :: Int -> StickyKeysInputMode
$ctoEnum :: Int -> StickyKeysInputMode
pred :: StickyKeysInputMode -> StickyKeysInputMode
$cpred :: StickyKeysInputMode -> StickyKeysInputMode
succ :: StickyKeysInputMode -> StickyKeysInputMode
$csucc :: StickyKeysInputMode -> StickyKeysInputMode
Enum, StickyKeysInputMode -> StickyKeysInputMode -> Bool
(StickyKeysInputMode -> StickyKeysInputMode -> Bool)
-> (StickyKeysInputMode -> StickyKeysInputMode -> Bool)
-> Eq StickyKeysInputMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StickyKeysInputMode -> StickyKeysInputMode -> Bool
$c/= :: StickyKeysInputMode -> StickyKeysInputMode -> Bool
== :: StickyKeysInputMode -> StickyKeysInputMode -> Bool
$c== :: StickyKeysInputMode -> StickyKeysInputMode -> Bool
Eq, Eq StickyKeysInputMode
Eq StickyKeysInputMode =>
(StickyKeysInputMode -> StickyKeysInputMode -> Ordering)
-> (StickyKeysInputMode -> StickyKeysInputMode -> Bool)
-> (StickyKeysInputMode -> StickyKeysInputMode -> Bool)
-> (StickyKeysInputMode -> StickyKeysInputMode -> Bool)
-> (StickyKeysInputMode -> StickyKeysInputMode -> Bool)
-> (StickyKeysInputMode
    -> StickyKeysInputMode -> StickyKeysInputMode)
-> (StickyKeysInputMode
    -> StickyKeysInputMode -> StickyKeysInputMode)
-> Ord StickyKeysInputMode
StickyKeysInputMode -> StickyKeysInputMode -> Bool
StickyKeysInputMode -> StickyKeysInputMode -> Ordering
StickyKeysInputMode -> StickyKeysInputMode -> StickyKeysInputMode
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 :: StickyKeysInputMode -> StickyKeysInputMode -> StickyKeysInputMode
$cmin :: StickyKeysInputMode -> StickyKeysInputMode -> StickyKeysInputMode
max :: StickyKeysInputMode -> StickyKeysInputMode -> StickyKeysInputMode
$cmax :: StickyKeysInputMode -> StickyKeysInputMode -> StickyKeysInputMode
>= :: StickyKeysInputMode -> StickyKeysInputMode -> Bool
$c>= :: StickyKeysInputMode -> StickyKeysInputMode -> Bool
> :: StickyKeysInputMode -> StickyKeysInputMode -> Bool
$c> :: StickyKeysInputMode -> StickyKeysInputMode -> Bool
<= :: StickyKeysInputMode -> StickyKeysInputMode -> Bool
$c<= :: StickyKeysInputMode -> StickyKeysInputMode -> Bool
< :: StickyKeysInputMode -> StickyKeysInputMode -> Bool
$c< :: StickyKeysInputMode -> StickyKeysInputMode -> Bool
compare :: StickyKeysInputMode -> StickyKeysInputMode -> Ordering
$ccompare :: StickyKeysInputMode -> StickyKeysInputMode -> Ordering
$cp1Ord :: Eq StickyKeysInputMode
Ord, ReadPrec [StickyKeysInputMode]
ReadPrec StickyKeysInputMode
Int -> ReadS StickyKeysInputMode
ReadS [StickyKeysInputMode]
(Int -> ReadS StickyKeysInputMode)
-> ReadS [StickyKeysInputMode]
-> ReadPrec StickyKeysInputMode
-> ReadPrec [StickyKeysInputMode]
-> Read StickyKeysInputMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StickyKeysInputMode]
$creadListPrec :: ReadPrec [StickyKeysInputMode]
readPrec :: ReadPrec StickyKeysInputMode
$creadPrec :: ReadPrec StickyKeysInputMode
readList :: ReadS [StickyKeysInputMode]
$creadList :: ReadS [StickyKeysInputMode]
readsPrec :: Int -> ReadS StickyKeysInputMode
$creadsPrec :: Int -> ReadS StickyKeysInputMode
Read, Int -> StickyKeysInputMode -> ShowS
[StickyKeysInputMode] -> ShowS
StickyKeysInputMode -> String
(Int -> StickyKeysInputMode -> ShowS)
-> (StickyKeysInputMode -> String)
-> ([StickyKeysInputMode] -> ShowS)
-> Show StickyKeysInputMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StickyKeysInputMode] -> ShowS
$cshowList :: [StickyKeysInputMode] -> ShowS
show :: StickyKeysInputMode -> String
$cshow :: StickyKeysInputMode -> String
showsPrec :: Int -> StickyKeysInputMode -> ShowS
$cshowsPrec :: Int -> StickyKeysInputMode -> ShowS
Show, Typeable, (forall x. StickyKeysInputMode -> Rep StickyKeysInputMode x)
-> (forall x. Rep StickyKeysInputMode x -> StickyKeysInputMode)
-> Generic StickyKeysInputMode
forall x. Rep StickyKeysInputMode x -> StickyKeysInputMode
forall x. StickyKeysInputMode -> Rep StickyKeysInputMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StickyKeysInputMode x -> StickyKeysInputMode
$cfrom :: forall x. StickyKeysInputMode -> Rep StickyKeysInputMode x
Generic)

instance NFData StickyKeysInputMode

-- | This is the mouse version of "StickyKeysInputMode".

data StickyMouseButtonsInputMode =
    StickyMouseButtonsInputMode'Enabled
  | StickyMouseButtonsInputMode'Disabled
  deriving (StickyMouseButtonsInputMode
StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode
-> Bounded StickyMouseButtonsInputMode
forall a. a -> a -> Bounded a
maxBound :: StickyMouseButtonsInputMode
$cmaxBound :: StickyMouseButtonsInputMode
minBound :: StickyMouseButtonsInputMode
$cminBound :: StickyMouseButtonsInputMode
Bounded, Typeable StickyMouseButtonsInputMode
DataType
Constr
Typeable StickyMouseButtonsInputMode =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> StickyMouseButtonsInputMode
 -> c StickyMouseButtonsInputMode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c StickyMouseButtonsInputMode)
-> (StickyMouseButtonsInputMode -> Constr)
-> (StickyMouseButtonsInputMode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c StickyMouseButtonsInputMode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c StickyMouseButtonsInputMode))
-> ((forall b. Data b => b -> b)
    -> StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> StickyMouseButtonsInputMode
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> StickyMouseButtonsInputMode
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> StickyMouseButtonsInputMode -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> StickyMouseButtonsInputMode
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> StickyMouseButtonsInputMode -> m StickyMouseButtonsInputMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> StickyMouseButtonsInputMode -> m StickyMouseButtonsInputMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> StickyMouseButtonsInputMode -> m StickyMouseButtonsInputMode)
-> Data StickyMouseButtonsInputMode
StickyMouseButtonsInputMode -> DataType
StickyMouseButtonsInputMode -> Constr
(forall b. Data b => b -> b)
-> StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StickyMouseButtonsInputMode
-> c StickyMouseButtonsInputMode
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StickyMouseButtonsInputMode
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) -> StickyMouseButtonsInputMode -> u
forall u.
(forall d. Data d => d -> u) -> StickyMouseButtonsInputMode -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> StickyMouseButtonsInputMode
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> StickyMouseButtonsInputMode
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StickyMouseButtonsInputMode -> m StickyMouseButtonsInputMode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StickyMouseButtonsInputMode -> m StickyMouseButtonsInputMode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StickyMouseButtonsInputMode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StickyMouseButtonsInputMode
-> c StickyMouseButtonsInputMode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c StickyMouseButtonsInputMode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StickyMouseButtonsInputMode)
$cStickyMouseButtonsInputMode'Disabled :: Constr
$cStickyMouseButtonsInputMode'Enabled :: Constr
$tStickyMouseButtonsInputMode :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> StickyMouseButtonsInputMode -> m StickyMouseButtonsInputMode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StickyMouseButtonsInputMode -> m StickyMouseButtonsInputMode
gmapMp :: (forall d. Data d => d -> m d)
-> StickyMouseButtonsInputMode -> m StickyMouseButtonsInputMode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StickyMouseButtonsInputMode -> m StickyMouseButtonsInputMode
gmapM :: (forall d. Data d => d -> m d)
-> StickyMouseButtonsInputMode -> m StickyMouseButtonsInputMode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StickyMouseButtonsInputMode -> m StickyMouseButtonsInputMode
gmapQi :: Int
-> (forall d. Data d => d -> u) -> StickyMouseButtonsInputMode -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> StickyMouseButtonsInputMode -> u
gmapQ :: (forall d. Data d => d -> u) -> StickyMouseButtonsInputMode -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> StickyMouseButtonsInputMode -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> StickyMouseButtonsInputMode
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> StickyMouseButtonsInputMode
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> StickyMouseButtonsInputMode
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> StickyMouseButtonsInputMode
-> r
gmapT :: (forall b. Data b => b -> b)
-> StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode
$cgmapT :: (forall b. Data b => b -> b)
-> StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StickyMouseButtonsInputMode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StickyMouseButtonsInputMode)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c StickyMouseButtonsInputMode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c StickyMouseButtonsInputMode)
dataTypeOf :: StickyMouseButtonsInputMode -> DataType
$cdataTypeOf :: StickyMouseButtonsInputMode -> DataType
toConstr :: StickyMouseButtonsInputMode -> Constr
$ctoConstr :: StickyMouseButtonsInputMode -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StickyMouseButtonsInputMode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StickyMouseButtonsInputMode
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StickyMouseButtonsInputMode
-> c StickyMouseButtonsInputMode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StickyMouseButtonsInputMode
-> c StickyMouseButtonsInputMode
$cp1Data :: Typeable StickyMouseButtonsInputMode
Data, Int -> StickyMouseButtonsInputMode
StickyMouseButtonsInputMode -> Int
StickyMouseButtonsInputMode -> [StickyMouseButtonsInputMode]
StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode
StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode -> [StickyMouseButtonsInputMode]
StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode
-> [StickyMouseButtonsInputMode]
(StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode)
-> (StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode)
-> (Int -> StickyMouseButtonsInputMode)
-> (StickyMouseButtonsInputMode -> Int)
-> (StickyMouseButtonsInputMode -> [StickyMouseButtonsInputMode])
-> (StickyMouseButtonsInputMode
    -> StickyMouseButtonsInputMode -> [StickyMouseButtonsInputMode])
-> (StickyMouseButtonsInputMode
    -> StickyMouseButtonsInputMode -> [StickyMouseButtonsInputMode])
-> (StickyMouseButtonsInputMode
    -> StickyMouseButtonsInputMode
    -> StickyMouseButtonsInputMode
    -> [StickyMouseButtonsInputMode])
-> Enum StickyMouseButtonsInputMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode
-> [StickyMouseButtonsInputMode]
$cenumFromThenTo :: StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode
-> [StickyMouseButtonsInputMode]
enumFromTo :: StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode -> [StickyMouseButtonsInputMode]
$cenumFromTo :: StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode -> [StickyMouseButtonsInputMode]
enumFromThen :: StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode -> [StickyMouseButtonsInputMode]
$cenumFromThen :: StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode -> [StickyMouseButtonsInputMode]
enumFrom :: StickyMouseButtonsInputMode -> [StickyMouseButtonsInputMode]
$cenumFrom :: StickyMouseButtonsInputMode -> [StickyMouseButtonsInputMode]
fromEnum :: StickyMouseButtonsInputMode -> Int
$cfromEnum :: StickyMouseButtonsInputMode -> Int
toEnum :: Int -> StickyMouseButtonsInputMode
$ctoEnum :: Int -> StickyMouseButtonsInputMode
pred :: StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode
$cpred :: StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode
succ :: StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode
$csucc :: StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode
Enum, StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode -> Bool
(StickyMouseButtonsInputMode
 -> StickyMouseButtonsInputMode -> Bool)
-> (StickyMouseButtonsInputMode
    -> StickyMouseButtonsInputMode -> Bool)
-> Eq StickyMouseButtonsInputMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode -> Bool
$c/= :: StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode -> Bool
== :: StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode -> Bool
$c== :: StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode -> Bool
Eq, Eq StickyMouseButtonsInputMode
Eq StickyMouseButtonsInputMode =>
(StickyMouseButtonsInputMode
 -> StickyMouseButtonsInputMode -> Ordering)
-> (StickyMouseButtonsInputMode
    -> StickyMouseButtonsInputMode -> Bool)
-> (StickyMouseButtonsInputMode
    -> StickyMouseButtonsInputMode -> Bool)
-> (StickyMouseButtonsInputMode
    -> StickyMouseButtonsInputMode -> Bool)
-> (StickyMouseButtonsInputMode
    -> StickyMouseButtonsInputMode -> Bool)
-> (StickyMouseButtonsInputMode
    -> StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode)
-> (StickyMouseButtonsInputMode
    -> StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode)
-> Ord StickyMouseButtonsInputMode
StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode -> Bool
StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode -> Ordering
StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode
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 :: StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode
$cmin :: StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode
max :: StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode
$cmax :: StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode
>= :: StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode -> Bool
$c>= :: StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode -> Bool
> :: StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode -> Bool
$c> :: StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode -> Bool
<= :: StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode -> Bool
$c<= :: StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode -> Bool
< :: StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode -> Bool
$c< :: StickyMouseButtonsInputMode -> StickyMouseButtonsInputMode -> Bool
compare :: StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode -> Ordering
$ccompare :: StickyMouseButtonsInputMode
-> StickyMouseButtonsInputMode -> Ordering
$cp1Ord :: Eq StickyMouseButtonsInputMode
Ord, ReadPrec [StickyMouseButtonsInputMode]
ReadPrec StickyMouseButtonsInputMode
Int -> ReadS StickyMouseButtonsInputMode
ReadS [StickyMouseButtonsInputMode]
(Int -> ReadS StickyMouseButtonsInputMode)
-> ReadS [StickyMouseButtonsInputMode]
-> ReadPrec StickyMouseButtonsInputMode
-> ReadPrec [StickyMouseButtonsInputMode]
-> Read StickyMouseButtonsInputMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StickyMouseButtonsInputMode]
$creadListPrec :: ReadPrec [StickyMouseButtonsInputMode]
readPrec :: ReadPrec StickyMouseButtonsInputMode
$creadPrec :: ReadPrec StickyMouseButtonsInputMode
readList :: ReadS [StickyMouseButtonsInputMode]
$creadList :: ReadS [StickyMouseButtonsInputMode]
readsPrec :: Int -> ReadS StickyMouseButtonsInputMode
$creadsPrec :: Int -> ReadS StickyMouseButtonsInputMode
Read, Int -> StickyMouseButtonsInputMode -> ShowS
[StickyMouseButtonsInputMode] -> ShowS
StickyMouseButtonsInputMode -> String
(Int -> StickyMouseButtonsInputMode -> ShowS)
-> (StickyMouseButtonsInputMode -> String)
-> ([StickyMouseButtonsInputMode] -> ShowS)
-> Show StickyMouseButtonsInputMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StickyMouseButtonsInputMode] -> ShowS
$cshowList :: [StickyMouseButtonsInputMode] -> ShowS
show :: StickyMouseButtonsInputMode -> String
$cshow :: StickyMouseButtonsInputMode -> String
showsPrec :: Int -> StickyMouseButtonsInputMode -> ShowS
$cshowsPrec :: Int -> StickyMouseButtonsInputMode -> ShowS
Show, Typeable, (forall x.
 StickyMouseButtonsInputMode -> Rep StickyMouseButtonsInputMode x)
-> (forall x.
    Rep StickyMouseButtonsInputMode x -> StickyMouseButtonsInputMode)
-> Generic StickyMouseButtonsInputMode
forall x.
Rep StickyMouseButtonsInputMode x -> StickyMouseButtonsInputMode
forall x.
StickyMouseButtonsInputMode -> Rep StickyMouseButtonsInputMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StickyMouseButtonsInputMode x -> StickyMouseButtonsInputMode
$cfrom :: forall x.
StickyMouseButtonsInputMode -> Rep StickyMouseButtonsInputMode x
Generic)

instance NFData StickyMouseButtonsInputMode

-- | Modifier keys that were pressed as part of another keypress event.

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

instance NFData ModifierKeys

-- | The different types of buttons we can find on a Gamepad.

data GamepadButton
  = GamepadButton'A
  | GamepadButton'B
  | GamepadButton'X
  | GamepadButton'Y
  | GamepadButton'LeftBumper
  | GamepadButton'RightBumper
  | GamepadButton'Back
  | GamepadButton'Start
  | GamepadButton'Guide
  | GamepadButton'LeftThumb
  | GamepadButton'RightThumb
  | GamepadButton'DpadUp
  | GamepadButton'DpadRight
  | GamepadButton'DpadDown
  | GamepadButton'DpadLeft
  | GamepadButton'Cross
  | GamepadButton'Circle
  | GamepadButton'Square
  | GamepadButton'Triangle
  deriving (GamepadButton
GamepadButton -> GamepadButton -> Bounded GamepadButton
forall a. a -> a -> Bounded a
maxBound :: GamepadButton
$cmaxBound :: GamepadButton
minBound :: GamepadButton
$cminBound :: GamepadButton
Bounded, Typeable GamepadButton
DataType
Constr
Typeable GamepadButton =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> GamepadButton -> c GamepadButton)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c GamepadButton)
-> (GamepadButton -> Constr)
-> (GamepadButton -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c GamepadButton))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c GamepadButton))
-> ((forall b. Data b => b -> b) -> GamepadButton -> GamepadButton)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GamepadButton -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GamepadButton -> r)
-> (forall u. (forall d. Data d => d -> u) -> GamepadButton -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> GamepadButton -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> GamepadButton -> m GamepadButton)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GamepadButton -> m GamepadButton)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GamepadButton -> m GamepadButton)
-> Data GamepadButton
GamepadButton -> DataType
GamepadButton -> Constr
(forall b. Data b => b -> b) -> GamepadButton -> GamepadButton
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GamepadButton -> c GamepadButton
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GamepadButton
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) -> GamepadButton -> u
forall u. (forall d. Data d => d -> u) -> GamepadButton -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadButton -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadButton -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GamepadButton -> m GamepadButton
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GamepadButton -> m GamepadButton
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GamepadButton
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GamepadButton -> c GamepadButton
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GamepadButton)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GamepadButton)
$cGamepadButton'Triangle :: Constr
$cGamepadButton'Square :: Constr
$cGamepadButton'Circle :: Constr
$cGamepadButton'Cross :: Constr
$cGamepadButton'DpadLeft :: Constr
$cGamepadButton'DpadDown :: Constr
$cGamepadButton'DpadRight :: Constr
$cGamepadButton'DpadUp :: Constr
$cGamepadButton'RightThumb :: Constr
$cGamepadButton'LeftThumb :: Constr
$cGamepadButton'Guide :: Constr
$cGamepadButton'Start :: Constr
$cGamepadButton'Back :: Constr
$cGamepadButton'RightBumper :: Constr
$cGamepadButton'LeftBumper :: Constr
$cGamepadButton'Y :: Constr
$cGamepadButton'X :: Constr
$cGamepadButton'B :: Constr
$cGamepadButton'A :: Constr
$tGamepadButton :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> GamepadButton -> m GamepadButton
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GamepadButton -> m GamepadButton
gmapMp :: (forall d. Data d => d -> m d) -> GamepadButton -> m GamepadButton
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GamepadButton -> m GamepadButton
gmapM :: (forall d. Data d => d -> m d) -> GamepadButton -> m GamepadButton
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GamepadButton -> m GamepadButton
gmapQi :: Int -> (forall d. Data d => d -> u) -> GamepadButton -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GamepadButton -> u
gmapQ :: (forall d. Data d => d -> u) -> GamepadButton -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GamepadButton -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadButton -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadButton -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadButton -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadButton -> r
gmapT :: (forall b. Data b => b -> b) -> GamepadButton -> GamepadButton
$cgmapT :: (forall b. Data b => b -> b) -> GamepadButton -> GamepadButton
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GamepadButton)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GamepadButton)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c GamepadButton)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GamepadButton)
dataTypeOf :: GamepadButton -> DataType
$cdataTypeOf :: GamepadButton -> DataType
toConstr :: GamepadButton -> Constr
$ctoConstr :: GamepadButton -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GamepadButton
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GamepadButton
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GamepadButton -> c GamepadButton
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GamepadButton -> c GamepadButton
$cp1Data :: Typeable GamepadButton
Data, Int -> GamepadButton
GamepadButton -> Int
GamepadButton -> [GamepadButton]
GamepadButton -> GamepadButton
GamepadButton -> GamepadButton -> [GamepadButton]
GamepadButton -> GamepadButton -> GamepadButton -> [GamepadButton]
(GamepadButton -> GamepadButton)
-> (GamepadButton -> GamepadButton)
-> (Int -> GamepadButton)
-> (GamepadButton -> Int)
-> (GamepadButton -> [GamepadButton])
-> (GamepadButton -> GamepadButton -> [GamepadButton])
-> (GamepadButton -> GamepadButton -> [GamepadButton])
-> (GamepadButton
    -> GamepadButton -> GamepadButton -> [GamepadButton])
-> Enum GamepadButton
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GamepadButton -> GamepadButton -> GamepadButton -> [GamepadButton]
$cenumFromThenTo :: GamepadButton -> GamepadButton -> GamepadButton -> [GamepadButton]
enumFromTo :: GamepadButton -> GamepadButton -> [GamepadButton]
$cenumFromTo :: GamepadButton -> GamepadButton -> [GamepadButton]
enumFromThen :: GamepadButton -> GamepadButton -> [GamepadButton]
$cenumFromThen :: GamepadButton -> GamepadButton -> [GamepadButton]
enumFrom :: GamepadButton -> [GamepadButton]
$cenumFrom :: GamepadButton -> [GamepadButton]
fromEnum :: GamepadButton -> Int
$cfromEnum :: GamepadButton -> Int
toEnum :: Int -> GamepadButton
$ctoEnum :: Int -> GamepadButton
pred :: GamepadButton -> GamepadButton
$cpred :: GamepadButton -> GamepadButton
succ :: GamepadButton -> GamepadButton
$csucc :: GamepadButton -> GamepadButton
Enum, GamepadButton -> GamepadButton -> Bool
(GamepadButton -> GamepadButton -> Bool)
-> (GamepadButton -> GamepadButton -> Bool) -> Eq GamepadButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GamepadButton -> GamepadButton -> Bool
$c/= :: GamepadButton -> GamepadButton -> Bool
== :: GamepadButton -> GamepadButton -> Bool
$c== :: GamepadButton -> GamepadButton -> Bool
Eq, Eq GamepadButton
Eq GamepadButton =>
(GamepadButton -> GamepadButton -> Ordering)
-> (GamepadButton -> GamepadButton -> Bool)
-> (GamepadButton -> GamepadButton -> Bool)
-> (GamepadButton -> GamepadButton -> Bool)
-> (GamepadButton -> GamepadButton -> Bool)
-> (GamepadButton -> GamepadButton -> GamepadButton)
-> (GamepadButton -> GamepadButton -> GamepadButton)
-> Ord GamepadButton
GamepadButton -> GamepadButton -> Bool
GamepadButton -> GamepadButton -> Ordering
GamepadButton -> GamepadButton -> GamepadButton
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 :: GamepadButton -> GamepadButton -> GamepadButton
$cmin :: GamepadButton -> GamepadButton -> GamepadButton
max :: GamepadButton -> GamepadButton -> GamepadButton
$cmax :: GamepadButton -> GamepadButton -> GamepadButton
>= :: GamepadButton -> GamepadButton -> Bool
$c>= :: GamepadButton -> GamepadButton -> Bool
> :: GamepadButton -> GamepadButton -> Bool
$c> :: GamepadButton -> GamepadButton -> Bool
<= :: GamepadButton -> GamepadButton -> Bool
$c<= :: GamepadButton -> GamepadButton -> Bool
< :: GamepadButton -> GamepadButton -> Bool
$c< :: GamepadButton -> GamepadButton -> Bool
compare :: GamepadButton -> GamepadButton -> Ordering
$ccompare :: GamepadButton -> GamepadButton -> Ordering
$cp1Ord :: Eq GamepadButton
Ord, ReadPrec [GamepadButton]
ReadPrec GamepadButton
Int -> ReadS GamepadButton
ReadS [GamepadButton]
(Int -> ReadS GamepadButton)
-> ReadS [GamepadButton]
-> ReadPrec GamepadButton
-> ReadPrec [GamepadButton]
-> Read GamepadButton
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GamepadButton]
$creadListPrec :: ReadPrec [GamepadButton]
readPrec :: ReadPrec GamepadButton
$creadPrec :: ReadPrec GamepadButton
readList :: ReadS [GamepadButton]
$creadList :: ReadS [GamepadButton]
readsPrec :: Int -> ReadS GamepadButton
$creadsPrec :: Int -> ReadS GamepadButton
Read, Int -> GamepadButton -> ShowS
[GamepadButton] -> ShowS
GamepadButton -> String
(Int -> GamepadButton -> ShowS)
-> (GamepadButton -> String)
-> ([GamepadButton] -> ShowS)
-> Show GamepadButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GamepadButton] -> ShowS
$cshowList :: [GamepadButton] -> ShowS
show :: GamepadButton -> String
$cshow :: GamepadButton -> String
showsPrec :: Int -> GamepadButton -> ShowS
$cshowsPrec :: Int -> GamepadButton -> ShowS
Show, Typeable, (forall x. GamepadButton -> Rep GamepadButton x)
-> (forall x. Rep GamepadButton x -> GamepadButton)
-> Generic GamepadButton
forall x. Rep GamepadButton x -> GamepadButton
forall x. GamepadButton -> Rep GamepadButton x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GamepadButton x -> GamepadButton
$cfrom :: forall x. GamepadButton -> Rep GamepadButton x
Generic)

instance NFData GamepadButton

-- | The states in which the gamepad buttons are found

data GamepadButtonState
  = GamepadButtonState'Pressed
  | GamepadButtonState'Released
  deriving (GamepadButtonState
GamepadButtonState
-> GamepadButtonState -> Bounded GamepadButtonState
forall a. a -> a -> Bounded a
maxBound :: GamepadButtonState
$cmaxBound :: GamepadButtonState
minBound :: GamepadButtonState
$cminBound :: GamepadButtonState
Bounded, Typeable GamepadButtonState
DataType
Constr
Typeable GamepadButtonState =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> GamepadButtonState
 -> c GamepadButtonState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c GamepadButtonState)
-> (GamepadButtonState -> Constr)
-> (GamepadButtonState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c GamepadButtonState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c GamepadButtonState))
-> ((forall b. Data b => b -> b)
    -> GamepadButtonState -> GamepadButtonState)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GamepadButtonState -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GamepadButtonState -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> GamepadButtonState -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> GamepadButtonState -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> GamepadButtonState -> m GamepadButtonState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> GamepadButtonState -> m GamepadButtonState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> GamepadButtonState -> m GamepadButtonState)
-> Data GamepadButtonState
GamepadButtonState -> DataType
GamepadButtonState -> Constr
(forall b. Data b => b -> b)
-> GamepadButtonState -> GamepadButtonState
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> GamepadButtonState
-> c GamepadButtonState
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GamepadButtonState
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) -> GamepadButtonState -> u
forall u. (forall d. Data d => d -> u) -> GamepadButtonState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadButtonState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadButtonState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GamepadButtonState -> m GamepadButtonState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GamepadButtonState -> m GamepadButtonState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GamepadButtonState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> GamepadButtonState
-> c GamepadButtonState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GamepadButtonState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GamepadButtonState)
$cGamepadButtonState'Released :: Constr
$cGamepadButtonState'Pressed :: Constr
$tGamepadButtonState :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> GamepadButtonState -> m GamepadButtonState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GamepadButtonState -> m GamepadButtonState
gmapMp :: (forall d. Data d => d -> m d)
-> GamepadButtonState -> m GamepadButtonState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GamepadButtonState -> m GamepadButtonState
gmapM :: (forall d. Data d => d -> m d)
-> GamepadButtonState -> m GamepadButtonState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GamepadButtonState -> m GamepadButtonState
gmapQi :: Int -> (forall d. Data d => d -> u) -> GamepadButtonState -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> GamepadButtonState -> u
gmapQ :: (forall d. Data d => d -> u) -> GamepadButtonState -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GamepadButtonState -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadButtonState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadButtonState -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadButtonState -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadButtonState -> r
gmapT :: (forall b. Data b => b -> b)
-> GamepadButtonState -> GamepadButtonState
$cgmapT :: (forall b. Data b => b -> b)
-> GamepadButtonState -> GamepadButtonState
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GamepadButtonState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GamepadButtonState)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c GamepadButtonState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GamepadButtonState)
dataTypeOf :: GamepadButtonState -> DataType
$cdataTypeOf :: GamepadButtonState -> DataType
toConstr :: GamepadButtonState -> Constr
$ctoConstr :: GamepadButtonState -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GamepadButtonState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GamepadButtonState
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> GamepadButtonState
-> c GamepadButtonState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> GamepadButtonState
-> c GamepadButtonState
$cp1Data :: Typeable GamepadButtonState
Data, Int -> GamepadButtonState
GamepadButtonState -> Int
GamepadButtonState -> [GamepadButtonState]
GamepadButtonState -> GamepadButtonState
GamepadButtonState -> GamepadButtonState -> [GamepadButtonState]
GamepadButtonState
-> GamepadButtonState -> GamepadButtonState -> [GamepadButtonState]
(GamepadButtonState -> GamepadButtonState)
-> (GamepadButtonState -> GamepadButtonState)
-> (Int -> GamepadButtonState)
-> (GamepadButtonState -> Int)
-> (GamepadButtonState -> [GamepadButtonState])
-> (GamepadButtonState
    -> GamepadButtonState -> [GamepadButtonState])
-> (GamepadButtonState
    -> GamepadButtonState -> [GamepadButtonState])
-> (GamepadButtonState
    -> GamepadButtonState
    -> GamepadButtonState
    -> [GamepadButtonState])
-> Enum GamepadButtonState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GamepadButtonState
-> GamepadButtonState -> GamepadButtonState -> [GamepadButtonState]
$cenumFromThenTo :: GamepadButtonState
-> GamepadButtonState -> GamepadButtonState -> [GamepadButtonState]
enumFromTo :: GamepadButtonState -> GamepadButtonState -> [GamepadButtonState]
$cenumFromTo :: GamepadButtonState -> GamepadButtonState -> [GamepadButtonState]
enumFromThen :: GamepadButtonState -> GamepadButtonState -> [GamepadButtonState]
$cenumFromThen :: GamepadButtonState -> GamepadButtonState -> [GamepadButtonState]
enumFrom :: GamepadButtonState -> [GamepadButtonState]
$cenumFrom :: GamepadButtonState -> [GamepadButtonState]
fromEnum :: GamepadButtonState -> Int
$cfromEnum :: GamepadButtonState -> Int
toEnum :: Int -> GamepadButtonState
$ctoEnum :: Int -> GamepadButtonState
pred :: GamepadButtonState -> GamepadButtonState
$cpred :: GamepadButtonState -> GamepadButtonState
succ :: GamepadButtonState -> GamepadButtonState
$csucc :: GamepadButtonState -> GamepadButtonState
Enum, GamepadButtonState -> GamepadButtonState -> Bool
(GamepadButtonState -> GamepadButtonState -> Bool)
-> (GamepadButtonState -> GamepadButtonState -> Bool)
-> Eq GamepadButtonState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GamepadButtonState -> GamepadButtonState -> Bool
$c/= :: GamepadButtonState -> GamepadButtonState -> Bool
== :: GamepadButtonState -> GamepadButtonState -> Bool
$c== :: GamepadButtonState -> GamepadButtonState -> Bool
Eq, Eq GamepadButtonState
Eq GamepadButtonState =>
(GamepadButtonState -> GamepadButtonState -> Ordering)
-> (GamepadButtonState -> GamepadButtonState -> Bool)
-> (GamepadButtonState -> GamepadButtonState -> Bool)
-> (GamepadButtonState -> GamepadButtonState -> Bool)
-> (GamepadButtonState -> GamepadButtonState -> Bool)
-> (GamepadButtonState -> GamepadButtonState -> GamepadButtonState)
-> (GamepadButtonState -> GamepadButtonState -> GamepadButtonState)
-> Ord GamepadButtonState
GamepadButtonState -> GamepadButtonState -> Bool
GamepadButtonState -> GamepadButtonState -> Ordering
GamepadButtonState -> GamepadButtonState -> GamepadButtonState
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 :: GamepadButtonState -> GamepadButtonState -> GamepadButtonState
$cmin :: GamepadButtonState -> GamepadButtonState -> GamepadButtonState
max :: GamepadButtonState -> GamepadButtonState -> GamepadButtonState
$cmax :: GamepadButtonState -> GamepadButtonState -> GamepadButtonState
>= :: GamepadButtonState -> GamepadButtonState -> Bool
$c>= :: GamepadButtonState -> GamepadButtonState -> Bool
> :: GamepadButtonState -> GamepadButtonState -> Bool
$c> :: GamepadButtonState -> GamepadButtonState -> Bool
<= :: GamepadButtonState -> GamepadButtonState -> Bool
$c<= :: GamepadButtonState -> GamepadButtonState -> Bool
< :: GamepadButtonState -> GamepadButtonState -> Bool
$c< :: GamepadButtonState -> GamepadButtonState -> Bool
compare :: GamepadButtonState -> GamepadButtonState -> Ordering
$ccompare :: GamepadButtonState -> GamepadButtonState -> Ordering
$cp1Ord :: Eq GamepadButtonState
Ord, ReadPrec [GamepadButtonState]
ReadPrec GamepadButtonState
Int -> ReadS GamepadButtonState
ReadS [GamepadButtonState]
(Int -> ReadS GamepadButtonState)
-> ReadS [GamepadButtonState]
-> ReadPrec GamepadButtonState
-> ReadPrec [GamepadButtonState]
-> Read GamepadButtonState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GamepadButtonState]
$creadListPrec :: ReadPrec [GamepadButtonState]
readPrec :: ReadPrec GamepadButtonState
$creadPrec :: ReadPrec GamepadButtonState
readList :: ReadS [GamepadButtonState]
$creadList :: ReadS [GamepadButtonState]
readsPrec :: Int -> ReadS GamepadButtonState
$creadsPrec :: Int -> ReadS GamepadButtonState
Read, Int -> GamepadButtonState -> ShowS
[GamepadButtonState] -> ShowS
GamepadButtonState -> String
(Int -> GamepadButtonState -> ShowS)
-> (GamepadButtonState -> String)
-> ([GamepadButtonState] -> ShowS)
-> Show GamepadButtonState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GamepadButtonState] -> ShowS
$cshowList :: [GamepadButtonState] -> ShowS
show :: GamepadButtonState -> String
$cshow :: GamepadButtonState -> String
showsPrec :: Int -> GamepadButtonState -> ShowS
$cshowsPrec :: Int -> GamepadButtonState -> ShowS
Show, Typeable, (forall x. GamepadButtonState -> Rep GamepadButtonState x)
-> (forall x. Rep GamepadButtonState x -> GamepadButtonState)
-> Generic GamepadButtonState
forall x. Rep GamepadButtonState x -> GamepadButtonState
forall x. GamepadButtonState -> Rep GamepadButtonState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GamepadButtonState x -> GamepadButtonState
$cfrom :: forall x. GamepadButtonState -> Rep GamepadButtonState x
Generic)

instance NFData GamepadButtonState

-- | The different axes along which we can measure continuous input on a Gamepad

data GamepadAxis
  = GamepadAxis'LeftX
  | GamepadAxis'LeftY
  | GamepadAxis'RightX
  | GamepadAxis'RightY
  | GamepadAxis'LeftTrigger
  | GamepadAxis'RightTrigger
  deriving (GamepadAxis
GamepadAxis -> GamepadAxis -> Bounded GamepadAxis
forall a. a -> a -> Bounded a
maxBound :: GamepadAxis
$cmaxBound :: GamepadAxis
minBound :: GamepadAxis
$cminBound :: GamepadAxis
Bounded, Typeable GamepadAxis
DataType
Constr
Typeable GamepadAxis =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> GamepadAxis -> c GamepadAxis)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c GamepadAxis)
-> (GamepadAxis -> Constr)
-> (GamepadAxis -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c GamepadAxis))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c GamepadAxis))
-> ((forall b. Data b => b -> b) -> GamepadAxis -> GamepadAxis)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GamepadAxis -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GamepadAxis -> r)
-> (forall u. (forall d. Data d => d -> u) -> GamepadAxis -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> GamepadAxis -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> GamepadAxis -> m GamepadAxis)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GamepadAxis -> m GamepadAxis)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GamepadAxis -> m GamepadAxis)
-> Data GamepadAxis
GamepadAxis -> DataType
GamepadAxis -> Constr
(forall b. Data b => b -> b) -> GamepadAxis -> GamepadAxis
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GamepadAxis -> c GamepadAxis
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GamepadAxis
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) -> GamepadAxis -> u
forall u. (forall d. Data d => d -> u) -> GamepadAxis -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadAxis -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadAxis -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GamepadAxis -> m GamepadAxis
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GamepadAxis -> m GamepadAxis
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GamepadAxis
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GamepadAxis -> c GamepadAxis
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GamepadAxis)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GamepadAxis)
$cGamepadAxis'RightTrigger :: Constr
$cGamepadAxis'LeftTrigger :: Constr
$cGamepadAxis'RightY :: Constr
$cGamepadAxis'RightX :: Constr
$cGamepadAxis'LeftY :: Constr
$cGamepadAxis'LeftX :: Constr
$tGamepadAxis :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> GamepadAxis -> m GamepadAxis
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GamepadAxis -> m GamepadAxis
gmapMp :: (forall d. Data d => d -> m d) -> GamepadAxis -> m GamepadAxis
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GamepadAxis -> m GamepadAxis
gmapM :: (forall d. Data d => d -> m d) -> GamepadAxis -> m GamepadAxis
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GamepadAxis -> m GamepadAxis
gmapQi :: Int -> (forall d. Data d => d -> u) -> GamepadAxis -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GamepadAxis -> u
gmapQ :: (forall d. Data d => d -> u) -> GamepadAxis -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GamepadAxis -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadAxis -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadAxis -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadAxis -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GamepadAxis -> r
gmapT :: (forall b. Data b => b -> b) -> GamepadAxis -> GamepadAxis
$cgmapT :: (forall b. Data b => b -> b) -> GamepadAxis -> GamepadAxis
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GamepadAxis)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GamepadAxis)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c GamepadAxis)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GamepadAxis)
dataTypeOf :: GamepadAxis -> DataType
$cdataTypeOf :: GamepadAxis -> DataType
toConstr :: GamepadAxis -> Constr
$ctoConstr :: GamepadAxis -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GamepadAxis
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GamepadAxis
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GamepadAxis -> c GamepadAxis
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GamepadAxis -> c GamepadAxis
$cp1Data :: Typeable GamepadAxis
Data, Int -> GamepadAxis
GamepadAxis -> Int
GamepadAxis -> [GamepadAxis]
GamepadAxis -> GamepadAxis
GamepadAxis -> GamepadAxis -> [GamepadAxis]
GamepadAxis -> GamepadAxis -> GamepadAxis -> [GamepadAxis]
(GamepadAxis -> GamepadAxis)
-> (GamepadAxis -> GamepadAxis)
-> (Int -> GamepadAxis)
-> (GamepadAxis -> Int)
-> (GamepadAxis -> [GamepadAxis])
-> (GamepadAxis -> GamepadAxis -> [GamepadAxis])
-> (GamepadAxis -> GamepadAxis -> [GamepadAxis])
-> (GamepadAxis -> GamepadAxis -> GamepadAxis -> [GamepadAxis])
-> Enum GamepadAxis
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GamepadAxis -> GamepadAxis -> GamepadAxis -> [GamepadAxis]
$cenumFromThenTo :: GamepadAxis -> GamepadAxis -> GamepadAxis -> [GamepadAxis]
enumFromTo :: GamepadAxis -> GamepadAxis -> [GamepadAxis]
$cenumFromTo :: GamepadAxis -> GamepadAxis -> [GamepadAxis]
enumFromThen :: GamepadAxis -> GamepadAxis -> [GamepadAxis]
$cenumFromThen :: GamepadAxis -> GamepadAxis -> [GamepadAxis]
enumFrom :: GamepadAxis -> [GamepadAxis]
$cenumFrom :: GamepadAxis -> [GamepadAxis]
fromEnum :: GamepadAxis -> Int
$cfromEnum :: GamepadAxis -> Int
toEnum :: Int -> GamepadAxis
$ctoEnum :: Int -> GamepadAxis
pred :: GamepadAxis -> GamepadAxis
$cpred :: GamepadAxis -> GamepadAxis
succ :: GamepadAxis -> GamepadAxis
$csucc :: GamepadAxis -> GamepadAxis
Enum, GamepadAxis -> GamepadAxis -> Bool
(GamepadAxis -> GamepadAxis -> Bool)
-> (GamepadAxis -> GamepadAxis -> Bool) -> Eq GamepadAxis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GamepadAxis -> GamepadAxis -> Bool
$c/= :: GamepadAxis -> GamepadAxis -> Bool
== :: GamepadAxis -> GamepadAxis -> Bool
$c== :: GamepadAxis -> GamepadAxis -> Bool
Eq, Eq GamepadAxis
Eq GamepadAxis =>
(GamepadAxis -> GamepadAxis -> Ordering)
-> (GamepadAxis -> GamepadAxis -> Bool)
-> (GamepadAxis -> GamepadAxis -> Bool)
-> (GamepadAxis -> GamepadAxis -> Bool)
-> (GamepadAxis -> GamepadAxis -> Bool)
-> (GamepadAxis -> GamepadAxis -> GamepadAxis)
-> (GamepadAxis -> GamepadAxis -> GamepadAxis)
-> Ord GamepadAxis
GamepadAxis -> GamepadAxis -> Bool
GamepadAxis -> GamepadAxis -> Ordering
GamepadAxis -> GamepadAxis -> GamepadAxis
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 :: GamepadAxis -> GamepadAxis -> GamepadAxis
$cmin :: GamepadAxis -> GamepadAxis -> GamepadAxis
max :: GamepadAxis -> GamepadAxis -> GamepadAxis
$cmax :: GamepadAxis -> GamepadAxis -> GamepadAxis
>= :: GamepadAxis -> GamepadAxis -> Bool
$c>= :: GamepadAxis -> GamepadAxis -> Bool
> :: GamepadAxis -> GamepadAxis -> Bool
$c> :: GamepadAxis -> GamepadAxis -> Bool
<= :: GamepadAxis -> GamepadAxis -> Bool
$c<= :: GamepadAxis -> GamepadAxis -> Bool
< :: GamepadAxis -> GamepadAxis -> Bool
$c< :: GamepadAxis -> GamepadAxis -> Bool
compare :: GamepadAxis -> GamepadAxis -> Ordering
$ccompare :: GamepadAxis -> GamepadAxis -> Ordering
$cp1Ord :: Eq GamepadAxis
Ord, ReadPrec [GamepadAxis]
ReadPrec GamepadAxis
Int -> ReadS GamepadAxis
ReadS [GamepadAxis]
(Int -> ReadS GamepadAxis)
-> ReadS [GamepadAxis]
-> ReadPrec GamepadAxis
-> ReadPrec [GamepadAxis]
-> Read GamepadAxis
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GamepadAxis]
$creadListPrec :: ReadPrec [GamepadAxis]
readPrec :: ReadPrec GamepadAxis
$creadPrec :: ReadPrec GamepadAxis
readList :: ReadS [GamepadAxis]
$creadList :: ReadS [GamepadAxis]
readsPrec :: Int -> ReadS GamepadAxis
$creadsPrec :: Int -> ReadS GamepadAxis
Read, Int -> GamepadAxis -> ShowS
[GamepadAxis] -> ShowS
GamepadAxis -> String
(Int -> GamepadAxis -> ShowS)
-> (GamepadAxis -> String)
-> ([GamepadAxis] -> ShowS)
-> Show GamepadAxis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GamepadAxis] -> ShowS
$cshowList :: [GamepadAxis] -> ShowS
show :: GamepadAxis -> String
$cshow :: GamepadAxis -> String
showsPrec :: Int -> GamepadAxis -> ShowS
$cshowsPrec :: Int -> GamepadAxis -> ShowS
Show, Typeable, (forall x. GamepadAxis -> Rep GamepadAxis x)
-> (forall x. Rep GamepadAxis x -> GamepadAxis)
-> Generic GamepadAxis
forall x. Rep GamepadAxis x -> GamepadAxis
forall x. GamepadAxis -> Rep GamepadAxis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GamepadAxis x -> GamepadAxis
$cfrom :: forall x. GamepadAxis -> Rep GamepadAxis x
Generic)

instance NFData GamepadAxis

-- | This describes the input state of a gamepad

data GamepadState = GamepadState
                    { GamepadState -> GamepadButton -> GamepadButtonState
getButtonState :: GamepadButton -> GamepadButtonState
                      -- ^ Returns the current state of the given button

                    , GamepadState -> GamepadAxis -> Float
getAxisState :: GamepadAxis -> Float
                      -- ^ Returns a value in the range [-1.0, 1.0] for the

                      -- given game axis

                    } deriving (Typeable, (forall x. GamepadState -> Rep GamepadState x)
-> (forall x. Rep GamepadState x -> GamepadState)
-> Generic GamepadState
forall x. Rep GamepadState x -> GamepadState
forall x. GamepadState -> Rep GamepadState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GamepadState x -> GamepadState
$cfrom :: forall x. GamepadState -> Rep GamepadState x
Generic)

instance Eq GamepadState where
  a :: GamepadState
a == :: GamepadState -> GamepadState -> Bool
== b :: GamepadState
b =
    let compareSt :: (GamepadState -> t -> a) -> t -> Bool -> Bool
compareSt f :: GamepadState -> t -> a
f x :: t
x = (Bool -> Bool -> Bool
&& (GamepadState -> t -> a
f GamepadState
a t
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== GamepadState -> t -> a
f GamepadState
b t
x))
     in (GamepadButton -> Bool -> Bool) -> Bool -> [GamepadButton] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((GamepadState -> GamepadButton -> GamepadButtonState)
-> GamepadButton -> Bool -> Bool
forall a t. Eq a => (GamepadState -> t -> a) -> t -> Bool -> Bool
compareSt GamepadState -> GamepadButton -> GamepadButtonState
getButtonState) Bool
True [GamepadButton
forall a. Bounded a => a
minBound..GamepadButton
forall a. Bounded a => a
maxBound] Bool -> Bool -> Bool
&&
        (GamepadAxis -> Bool -> Bool) -> Bool -> [GamepadAxis] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((GamepadState -> GamepadAxis -> Float)
-> GamepadAxis -> Bool -> Bool
forall a t. Eq a => (GamepadState -> t -> a) -> t -> Bool -> Bool
compareSt GamepadState -> GamepadAxis -> Float
getAxisState) Bool
True [GamepadAxis
forall a. Bounded a => a
minBound..GamepadAxis
forall a. Bounded a => a
maxBound]

instance NFData GamepadState

deriving instance Data CUChar

-- | GLFW image data, for setting up custom mouse cursor appearnaces.

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

-- | Create an image given the function to generate 8-bit RGBA values based on

-- the pixel location.

mkImage :: Int -> Int -> (Int -> Int -> (Word8, Word8, Word8, Word8)) -> Image
mkImage :: Int -> Int -> (Int -> Int -> (Word8, Word8, Word8, Word8)) -> Image
mkImage width :: Int
width height :: Int
height gen :: Int -> Int -> (Word8, Word8, Word8, Word8)
gen = $WImage :: Int -> Int -> [CUChar] -> Image
Image
  { imageWidth :: Int
imageWidth = Int
width
  , imageHeight :: Int
imageHeight = Int
height
  , imagePixels :: [CUChar]
imagePixels = [ Word8 -> CUChar
CUChar Word8
channel | Int
y <- [0..(Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)]
                                   , Int
x <- [0..(Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)]
                                   , let (r :: Word8
r, g :: Word8
g, b :: Word8
b, a :: Word8
a) = Int -> Int -> (Word8, Word8, Word8, Word8)
gen Int
x Int
y
                                   , Word8
channel <- [Word8
r, Word8
g, Word8
b, Word8
a]
                  ]
  }

instance NFData Image

-- | Represents a GLFW cursor.

newtype Cursor = Cursor
  { Cursor -> Ptr C'GLFWcursor
unCursor :: Ptr C'GLFWcursor
  } deriving (Typeable Cursor
DataType
Constr
Typeable Cursor =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Cursor -> c Cursor)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Cursor)
-> (Cursor -> Constr)
-> (Cursor -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Cursor))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cursor))
-> ((forall b. Data b => b -> b) -> Cursor -> Cursor)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Cursor -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Cursor -> r)
-> (forall u. (forall d. Data d => d -> u) -> Cursor -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Cursor -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Cursor -> m Cursor)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Cursor -> m Cursor)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Cursor -> m Cursor)
-> Data Cursor
Cursor -> DataType
Cursor -> Constr
(forall b. Data b => b -> b) -> Cursor -> Cursor
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cursor -> c Cursor
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cursor
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) -> Cursor -> u
forall u. (forall d. Data d => d -> u) -> Cursor -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cursor -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cursor -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cursor -> m Cursor
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cursor -> m Cursor
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cursor
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cursor -> c Cursor
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Cursor)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cursor)
$cCursor :: Constr
$tCursor :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Cursor -> m Cursor
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cursor -> m Cursor
gmapMp :: (forall d. Data d => d -> m d) -> Cursor -> m Cursor
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cursor -> m Cursor
gmapM :: (forall d. Data d => d -> m d) -> Cursor -> m Cursor
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cursor -> m Cursor
gmapQi :: Int -> (forall d. Data d => d -> u) -> Cursor -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Cursor -> u
gmapQ :: (forall d. Data d => d -> u) -> Cursor -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Cursor -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cursor -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cursor -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cursor -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cursor -> r
gmapT :: (forall b. Data b => b -> b) -> Cursor -> Cursor
$cgmapT :: (forall b. Data b => b -> b) -> Cursor -> Cursor
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cursor)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cursor)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Cursor)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Cursor)
dataTypeOf :: Cursor -> DataType
$cdataTypeOf :: Cursor -> DataType
toConstr :: Cursor -> Constr
$ctoConstr :: Cursor -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cursor
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cursor
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cursor -> c Cursor
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cursor -> c Cursor
$cp1Data :: Typeable Cursor
Data, Cursor -> Cursor -> Bool
(Cursor -> Cursor -> Bool)
-> (Cursor -> Cursor -> Bool) -> Eq Cursor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cursor -> Cursor -> Bool
$c/= :: Cursor -> Cursor -> Bool
== :: Cursor -> Cursor -> Bool
$c== :: Cursor -> Cursor -> Bool
Eq, Eq Cursor
Eq Cursor =>
(Cursor -> Cursor -> Ordering)
-> (Cursor -> Cursor -> Bool)
-> (Cursor -> Cursor -> Bool)
-> (Cursor -> Cursor -> Bool)
-> (Cursor -> Cursor -> Bool)
-> (Cursor -> Cursor -> Cursor)
-> (Cursor -> Cursor -> Cursor)
-> Ord Cursor
Cursor -> Cursor -> Bool
Cursor -> Cursor -> Ordering
Cursor -> Cursor -> Cursor
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 :: Cursor -> Cursor -> Cursor
$cmin :: Cursor -> Cursor -> Cursor
max :: Cursor -> Cursor -> Cursor
$cmax :: Cursor -> Cursor -> Cursor
>= :: Cursor -> Cursor -> Bool
$c>= :: Cursor -> Cursor -> Bool
> :: Cursor -> Cursor -> Bool
$c> :: Cursor -> Cursor -> Bool
<= :: Cursor -> Cursor -> Bool
$c<= :: Cursor -> Cursor -> Bool
< :: Cursor -> Cursor -> Bool
$c< :: Cursor -> Cursor -> Bool
compare :: Cursor -> Cursor -> Ordering
$ccompare :: Cursor -> Cursor -> Ordering
$cp1Ord :: Eq Cursor
Ord, Int -> Cursor -> ShowS
[Cursor] -> ShowS
Cursor -> String
(Int -> Cursor -> ShowS)
-> (Cursor -> String) -> ([Cursor] -> ShowS) -> Show Cursor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cursor] -> ShowS
$cshowList :: [Cursor] -> ShowS
show :: Cursor -> String
$cshow :: Cursor -> String
showsPrec :: Int -> Cursor -> ShowS
$cshowsPrec :: Int -> Cursor -> ShowS
Show, Typeable, (forall x. Cursor -> Rep Cursor x)
-> (forall x. Rep Cursor x -> Cursor) -> Generic Cursor
forall x. Rep Cursor x -> Cursor
forall x. Cursor -> Rep Cursor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cursor x -> Cursor
$cfrom :: forall x. Cursor -> Rep Cursor x
Generic)

-- | Lets you use one of the standard cursor appearnaces that the local

-- system theme provides for.

-- See <http://www.glfw.org/docs/3.3/input.html#cursor_standard Standard Cursor Creation>.

data StandardCursorShape =
    StandardCursorShape'Arrow
  | StandardCursorShape'IBeam
  | StandardCursorShape'Crosshair
  | StandardCursorShape'Hand
  | StandardCursorShape'HResize
  | StandardCursorShape'VResize
  deriving (StandardCursorShape
StandardCursorShape
-> StandardCursorShape -> Bounded StandardCursorShape
forall a. a -> a -> Bounded a
maxBound :: StandardCursorShape
$cmaxBound :: StandardCursorShape
minBound :: StandardCursorShape
$cminBound :: StandardCursorShape
Bounded, Typeable StandardCursorShape
DataType
Constr
Typeable StandardCursorShape =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> StandardCursorShape
 -> c StandardCursorShape)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c StandardCursorShape)
-> (StandardCursorShape -> Constr)
-> (StandardCursorShape -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c StandardCursorShape))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c StandardCursorShape))
-> ((forall b. Data b => b -> b)
    -> StandardCursorShape -> StandardCursorShape)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> StandardCursorShape -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> StandardCursorShape -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> StandardCursorShape -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> StandardCursorShape -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> StandardCursorShape -> m StandardCursorShape)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> StandardCursorShape -> m StandardCursorShape)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> StandardCursorShape -> m StandardCursorShape)
-> Data StandardCursorShape
StandardCursorShape -> DataType
StandardCursorShape -> Constr
(forall b. Data b => b -> b)
-> StandardCursorShape -> StandardCursorShape
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StandardCursorShape
-> c StandardCursorShape
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StandardCursorShape
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) -> StandardCursorShape -> u
forall u.
(forall d. Data d => d -> u) -> StandardCursorShape -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StandardCursorShape -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StandardCursorShape -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StandardCursorShape -> m StandardCursorShape
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StandardCursorShape -> m StandardCursorShape
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StandardCursorShape
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StandardCursorShape
-> c StandardCursorShape
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StandardCursorShape)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StandardCursorShape)
$cStandardCursorShape'VResize :: Constr
$cStandardCursorShape'HResize :: Constr
$cStandardCursorShape'Hand :: Constr
$cStandardCursorShape'Crosshair :: Constr
$cStandardCursorShape'IBeam :: Constr
$cStandardCursorShape'Arrow :: Constr
$tStandardCursorShape :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> StandardCursorShape -> m StandardCursorShape
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StandardCursorShape -> m StandardCursorShape
gmapMp :: (forall d. Data d => d -> m d)
-> StandardCursorShape -> m StandardCursorShape
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StandardCursorShape -> m StandardCursorShape
gmapM :: (forall d. Data d => d -> m d)
-> StandardCursorShape -> m StandardCursorShape
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StandardCursorShape -> m StandardCursorShape
gmapQi :: Int -> (forall d. Data d => d -> u) -> StandardCursorShape -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> StandardCursorShape -> u
gmapQ :: (forall d. Data d => d -> u) -> StandardCursorShape -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> StandardCursorShape -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StandardCursorShape -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StandardCursorShape -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StandardCursorShape -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StandardCursorShape -> r
gmapT :: (forall b. Data b => b -> b)
-> StandardCursorShape -> StandardCursorShape
$cgmapT :: (forall b. Data b => b -> b)
-> StandardCursorShape -> StandardCursorShape
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StandardCursorShape)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StandardCursorShape)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c StandardCursorShape)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StandardCursorShape)
dataTypeOf :: StandardCursorShape -> DataType
$cdataTypeOf :: StandardCursorShape -> DataType
toConstr :: StandardCursorShape -> Constr
$ctoConstr :: StandardCursorShape -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StandardCursorShape
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StandardCursorShape
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StandardCursorShape
-> c StandardCursorShape
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StandardCursorShape
-> c StandardCursorShape
$cp1Data :: Typeable StandardCursorShape
Data, Int -> StandardCursorShape
StandardCursorShape -> Int
StandardCursorShape -> [StandardCursorShape]
StandardCursorShape -> StandardCursorShape
StandardCursorShape -> StandardCursorShape -> [StandardCursorShape]
StandardCursorShape
-> StandardCursorShape
-> StandardCursorShape
-> [StandardCursorShape]
(StandardCursorShape -> StandardCursorShape)
-> (StandardCursorShape -> StandardCursorShape)
-> (Int -> StandardCursorShape)
-> (StandardCursorShape -> Int)
-> (StandardCursorShape -> [StandardCursorShape])
-> (StandardCursorShape
    -> StandardCursorShape -> [StandardCursorShape])
-> (StandardCursorShape
    -> StandardCursorShape -> [StandardCursorShape])
-> (StandardCursorShape
    -> StandardCursorShape
    -> StandardCursorShape
    -> [StandardCursorShape])
-> Enum StandardCursorShape
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StandardCursorShape
-> StandardCursorShape
-> StandardCursorShape
-> [StandardCursorShape]
$cenumFromThenTo :: StandardCursorShape
-> StandardCursorShape
-> StandardCursorShape
-> [StandardCursorShape]
enumFromTo :: StandardCursorShape -> StandardCursorShape -> [StandardCursorShape]
$cenumFromTo :: StandardCursorShape -> StandardCursorShape -> [StandardCursorShape]
enumFromThen :: StandardCursorShape -> StandardCursorShape -> [StandardCursorShape]
$cenumFromThen :: StandardCursorShape -> StandardCursorShape -> [StandardCursorShape]
enumFrom :: StandardCursorShape -> [StandardCursorShape]
$cenumFrom :: StandardCursorShape -> [StandardCursorShape]
fromEnum :: StandardCursorShape -> Int
$cfromEnum :: StandardCursorShape -> Int
toEnum :: Int -> StandardCursorShape
$ctoEnum :: Int -> StandardCursorShape
pred :: StandardCursorShape -> StandardCursorShape
$cpred :: StandardCursorShape -> StandardCursorShape
succ :: StandardCursorShape -> StandardCursorShape
$csucc :: StandardCursorShape -> StandardCursorShape
Enum, StandardCursorShape -> StandardCursorShape -> Bool
(StandardCursorShape -> StandardCursorShape -> Bool)
-> (StandardCursorShape -> StandardCursorShape -> Bool)
-> Eq StandardCursorShape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StandardCursorShape -> StandardCursorShape -> Bool
$c/= :: StandardCursorShape -> StandardCursorShape -> Bool
== :: StandardCursorShape -> StandardCursorShape -> Bool
$c== :: StandardCursorShape -> StandardCursorShape -> Bool
Eq, Eq StandardCursorShape
Eq StandardCursorShape =>
(StandardCursorShape -> StandardCursorShape -> Ordering)
-> (StandardCursorShape -> StandardCursorShape -> Bool)
-> (StandardCursorShape -> StandardCursorShape -> Bool)
-> (StandardCursorShape -> StandardCursorShape -> Bool)
-> (StandardCursorShape -> StandardCursorShape -> Bool)
-> (StandardCursorShape
    -> StandardCursorShape -> StandardCursorShape)
-> (StandardCursorShape
    -> StandardCursorShape -> StandardCursorShape)
-> Ord StandardCursorShape
StandardCursorShape -> StandardCursorShape -> Bool
StandardCursorShape -> StandardCursorShape -> Ordering
StandardCursorShape -> StandardCursorShape -> StandardCursorShape
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 :: StandardCursorShape -> StandardCursorShape -> StandardCursorShape
$cmin :: StandardCursorShape -> StandardCursorShape -> StandardCursorShape
max :: StandardCursorShape -> StandardCursorShape -> StandardCursorShape
$cmax :: StandardCursorShape -> StandardCursorShape -> StandardCursorShape
>= :: StandardCursorShape -> StandardCursorShape -> Bool
$c>= :: StandardCursorShape -> StandardCursorShape -> Bool
> :: StandardCursorShape -> StandardCursorShape -> Bool
$c> :: StandardCursorShape -> StandardCursorShape -> Bool
<= :: StandardCursorShape -> StandardCursorShape -> Bool
$c<= :: StandardCursorShape -> StandardCursorShape -> Bool
< :: StandardCursorShape -> StandardCursorShape -> Bool
$c< :: StandardCursorShape -> StandardCursorShape -> Bool
compare :: StandardCursorShape -> StandardCursorShape -> Ordering
$ccompare :: StandardCursorShape -> StandardCursorShape -> Ordering
$cp1Ord :: Eq StandardCursorShape
Ord, ReadPrec [StandardCursorShape]
ReadPrec StandardCursorShape
Int -> ReadS StandardCursorShape
ReadS [StandardCursorShape]
(Int -> ReadS StandardCursorShape)
-> ReadS [StandardCursorShape]
-> ReadPrec StandardCursorShape
-> ReadPrec [StandardCursorShape]
-> Read StandardCursorShape
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StandardCursorShape]
$creadListPrec :: ReadPrec [StandardCursorShape]
readPrec :: ReadPrec StandardCursorShape
$creadPrec :: ReadPrec StandardCursorShape
readList :: ReadS [StandardCursorShape]
$creadList :: ReadS [StandardCursorShape]
readsPrec :: Int -> ReadS StandardCursorShape
$creadsPrec :: Int -> ReadS StandardCursorShape
Read, Int -> StandardCursorShape -> ShowS
[StandardCursorShape] -> ShowS
StandardCursorShape -> String
(Int -> StandardCursorShape -> ShowS)
-> (StandardCursorShape -> String)
-> ([StandardCursorShape] -> ShowS)
-> Show StandardCursorShape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StandardCursorShape] -> ShowS
$cshowList :: [StandardCursorShape] -> ShowS
show :: StandardCursorShape -> String
$cshow :: StandardCursorShape -> String
showsPrec :: Int -> StandardCursorShape -> ShowS
$cshowsPrec :: Int -> StandardCursorShape -> ShowS
Show, Typeable, (forall x. StandardCursorShape -> Rep StandardCursorShape x)
-> (forall x. Rep StandardCursorShape x -> StandardCursorShape)
-> Generic StandardCursorShape
forall x. Rep StandardCursorShape x -> StandardCursorShape
forall x. StandardCursorShape -> Rep StandardCursorShape x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StandardCursorShape x -> StandardCursorShape
$cfrom :: forall x. StandardCursorShape -> Rep StandardCursorShape x
Generic)

instance NFData StandardCursorShape

--------------------------------------------------------------------------------


{-# ANN module "HLint: ignore Use camelCase" #-}