-- | Auxiliary Xlib types
module AuxTypes where

data Gravity = ForgetGravity |
               NorthWestGravity |
               NorthGravity |
               NorthEastGravity |
               WestGravity |
               CenterGravity |
               EastGravity |
               SouthWestGravity |
               SouthGravity |
               SouthEastGravity |
               StaticGravity 
               deriving (Gravity -> Gravity -> Bool
(Gravity -> Gravity -> Bool)
-> (Gravity -> Gravity -> Bool) -> Eq Gravity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Gravity -> Gravity -> Bool
$c/= :: Gravity -> Gravity -> Bool
== :: Gravity -> Gravity -> Bool
$c== :: Gravity -> Gravity -> Bool
Eq, Eq Gravity
Eq Gravity
-> (Gravity -> Gravity -> Ordering)
-> (Gravity -> Gravity -> Bool)
-> (Gravity -> Gravity -> Bool)
-> (Gravity -> Gravity -> Bool)
-> (Gravity -> Gravity -> Bool)
-> (Gravity -> Gravity -> Gravity)
-> (Gravity -> Gravity -> Gravity)
-> Ord Gravity
Gravity -> Gravity -> Bool
Gravity -> Gravity -> Ordering
Gravity -> Gravity -> Gravity
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 :: Gravity -> Gravity -> Gravity
$cmin :: Gravity -> Gravity -> Gravity
max :: Gravity -> Gravity -> Gravity
$cmax :: Gravity -> Gravity -> Gravity
>= :: Gravity -> Gravity -> Bool
$c>= :: Gravity -> Gravity -> Bool
> :: Gravity -> Gravity -> Bool
$c> :: Gravity -> Gravity -> Bool
<= :: Gravity -> Gravity -> Bool
$c<= :: Gravity -> Gravity -> Bool
< :: Gravity -> Gravity -> Bool
$c< :: Gravity -> Gravity -> Bool
compare :: Gravity -> Gravity -> Ordering
$ccompare :: Gravity -> Gravity -> Ordering
$cp1Ord :: Eq Gravity
Ord, ReadPrec [Gravity]
ReadPrec Gravity
Int -> ReadS Gravity
ReadS [Gravity]
(Int -> ReadS Gravity)
-> ReadS [Gravity]
-> ReadPrec Gravity
-> ReadPrec [Gravity]
-> Read Gravity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Gravity]
$creadListPrec :: ReadPrec [Gravity]
readPrec :: ReadPrec Gravity
$creadPrec :: ReadPrec Gravity
readList :: ReadS [Gravity]
$creadList :: ReadS [Gravity]
readsPrec :: Int -> ReadS Gravity
$creadsPrec :: Int -> ReadS Gravity
Read, Int -> Gravity -> ShowS
[Gravity] -> ShowS
Gravity -> String
(Int -> Gravity -> ShowS)
-> (Gravity -> String) -> ([Gravity] -> ShowS) -> Show Gravity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Gravity] -> ShowS
$cshowList :: [Gravity] -> ShowS
show :: Gravity -> String
$cshow :: Gravity -> String
showsPrec :: Int -> Gravity -> ShowS
$cshowsPrec :: Int -> Gravity -> ShowS
Show, Gravity
Gravity -> Gravity -> Bounded Gravity
forall a. a -> a -> Bounded a
maxBound :: Gravity
$cmaxBound :: Gravity
minBound :: Gravity
$cminBound :: Gravity
Bounded, Int -> Gravity
Gravity -> Int
Gravity -> [Gravity]
Gravity -> Gravity
Gravity -> Gravity -> [Gravity]
Gravity -> Gravity -> Gravity -> [Gravity]
(Gravity -> Gravity)
-> (Gravity -> Gravity)
-> (Int -> Gravity)
-> (Gravity -> Int)
-> (Gravity -> [Gravity])
-> (Gravity -> Gravity -> [Gravity])
-> (Gravity -> Gravity -> [Gravity])
-> (Gravity -> Gravity -> Gravity -> [Gravity])
-> Enum Gravity
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 :: Gravity -> Gravity -> Gravity -> [Gravity]
$cenumFromThenTo :: Gravity -> Gravity -> Gravity -> [Gravity]
enumFromTo :: Gravity -> Gravity -> [Gravity]
$cenumFromTo :: Gravity -> Gravity -> [Gravity]
enumFromThen :: Gravity -> Gravity -> [Gravity]
$cenumFromThen :: Gravity -> Gravity -> [Gravity]
enumFrom :: Gravity -> [Gravity]
$cenumFrom :: Gravity -> [Gravity]
fromEnum :: Gravity -> Int
$cfromEnum :: Gravity -> Int
toEnum :: Int -> Gravity
$ctoEnum :: Int -> Gravity
pred :: Gravity -> Gravity
$cpred :: Gravity -> Gravity
succ :: Gravity -> Gravity
$csucc :: Gravity -> Gravity
Enum)

data ShapeKind = ShapeBounding | ShapeClip
                 deriving (ShapeKind -> ShapeKind -> Bool
(ShapeKind -> ShapeKind -> Bool)
-> (ShapeKind -> ShapeKind -> Bool) -> Eq ShapeKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShapeKind -> ShapeKind -> Bool
$c/= :: ShapeKind -> ShapeKind -> Bool
== :: ShapeKind -> ShapeKind -> Bool
$c== :: ShapeKind -> ShapeKind -> Bool
Eq, Eq ShapeKind
Eq ShapeKind
-> (ShapeKind -> ShapeKind -> Ordering)
-> (ShapeKind -> ShapeKind -> Bool)
-> (ShapeKind -> ShapeKind -> Bool)
-> (ShapeKind -> ShapeKind -> Bool)
-> (ShapeKind -> ShapeKind -> Bool)
-> (ShapeKind -> ShapeKind -> ShapeKind)
-> (ShapeKind -> ShapeKind -> ShapeKind)
-> Ord ShapeKind
ShapeKind -> ShapeKind -> Bool
ShapeKind -> ShapeKind -> Ordering
ShapeKind -> ShapeKind -> ShapeKind
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 :: ShapeKind -> ShapeKind -> ShapeKind
$cmin :: ShapeKind -> ShapeKind -> ShapeKind
max :: ShapeKind -> ShapeKind -> ShapeKind
$cmax :: ShapeKind -> ShapeKind -> ShapeKind
>= :: ShapeKind -> ShapeKind -> Bool
$c>= :: ShapeKind -> ShapeKind -> Bool
> :: ShapeKind -> ShapeKind -> Bool
$c> :: ShapeKind -> ShapeKind -> Bool
<= :: ShapeKind -> ShapeKind -> Bool
$c<= :: ShapeKind -> ShapeKind -> Bool
< :: ShapeKind -> ShapeKind -> Bool
$c< :: ShapeKind -> ShapeKind -> Bool
compare :: ShapeKind -> ShapeKind -> Ordering
$ccompare :: ShapeKind -> ShapeKind -> Ordering
$cp1Ord :: Eq ShapeKind
Ord, Int -> ShapeKind -> ShowS
[ShapeKind] -> ShowS
ShapeKind -> String
(Int -> ShapeKind -> ShowS)
-> (ShapeKind -> String)
-> ([ShapeKind] -> ShowS)
-> Show ShapeKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShapeKind] -> ShowS
$cshowList :: [ShapeKind] -> ShowS
show :: ShapeKind -> String
$cshow :: ShapeKind -> String
showsPrec :: Int -> ShapeKind -> ShowS
$cshowsPrec :: Int -> ShapeKind -> ShowS
Show, ReadPrec [ShapeKind]
ReadPrec ShapeKind
Int -> ReadS ShapeKind
ReadS [ShapeKind]
(Int -> ReadS ShapeKind)
-> ReadS [ShapeKind]
-> ReadPrec ShapeKind
-> ReadPrec [ShapeKind]
-> Read ShapeKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ShapeKind]
$creadListPrec :: ReadPrec [ShapeKind]
readPrec :: ReadPrec ShapeKind
$creadPrec :: ReadPrec ShapeKind
readList :: ReadS [ShapeKind]
$creadList :: ReadS [ShapeKind]
readsPrec :: Int -> ReadS ShapeKind
$creadsPrec :: Int -> ReadS ShapeKind
Read, ShapeKind
ShapeKind -> ShapeKind -> Bounded ShapeKind
forall a. a -> a -> Bounded a
maxBound :: ShapeKind
$cmaxBound :: ShapeKind
minBound :: ShapeKind
$cminBound :: ShapeKind
Bounded, Int -> ShapeKind
ShapeKind -> Int
ShapeKind -> [ShapeKind]
ShapeKind -> ShapeKind
ShapeKind -> ShapeKind -> [ShapeKind]
ShapeKind -> ShapeKind -> ShapeKind -> [ShapeKind]
(ShapeKind -> ShapeKind)
-> (ShapeKind -> ShapeKind)
-> (Int -> ShapeKind)
-> (ShapeKind -> Int)
-> (ShapeKind -> [ShapeKind])
-> (ShapeKind -> ShapeKind -> [ShapeKind])
-> (ShapeKind -> ShapeKind -> [ShapeKind])
-> (ShapeKind -> ShapeKind -> ShapeKind -> [ShapeKind])
-> Enum ShapeKind
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 :: ShapeKind -> ShapeKind -> ShapeKind -> [ShapeKind]
$cenumFromThenTo :: ShapeKind -> ShapeKind -> ShapeKind -> [ShapeKind]
enumFromTo :: ShapeKind -> ShapeKind -> [ShapeKind]
$cenumFromTo :: ShapeKind -> ShapeKind -> [ShapeKind]
enumFromThen :: ShapeKind -> ShapeKind -> [ShapeKind]
$cenumFromThen :: ShapeKind -> ShapeKind -> [ShapeKind]
enumFrom :: ShapeKind -> [ShapeKind]
$cenumFrom :: ShapeKind -> [ShapeKind]
fromEnum :: ShapeKind -> Int
$cfromEnum :: ShapeKind -> Int
toEnum :: Int -> ShapeKind
$ctoEnum :: Int -> ShapeKind
pred :: ShapeKind -> ShapeKind
$cpred :: ShapeKind -> ShapeKind
succ :: ShapeKind -> ShapeKind
$csucc :: ShapeKind -> ShapeKind
Enum)

data ShapeOperation = ShapeSet |
                      ShapeUnion |
                      ShapeIntersect |
                      ShapeSubtract |
                      ShapeInvert 
                      deriving (ShapeOperation -> ShapeOperation -> Bool
(ShapeOperation -> ShapeOperation -> Bool)
-> (ShapeOperation -> ShapeOperation -> Bool) -> Eq ShapeOperation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShapeOperation -> ShapeOperation -> Bool
$c/= :: ShapeOperation -> ShapeOperation -> Bool
== :: ShapeOperation -> ShapeOperation -> Bool
$c== :: ShapeOperation -> ShapeOperation -> Bool
Eq, Eq ShapeOperation
Eq ShapeOperation
-> (ShapeOperation -> ShapeOperation -> Ordering)
-> (ShapeOperation -> ShapeOperation -> Bool)
-> (ShapeOperation -> ShapeOperation -> Bool)
-> (ShapeOperation -> ShapeOperation -> Bool)
-> (ShapeOperation -> ShapeOperation -> Bool)
-> (ShapeOperation -> ShapeOperation -> ShapeOperation)
-> (ShapeOperation -> ShapeOperation -> ShapeOperation)
-> Ord ShapeOperation
ShapeOperation -> ShapeOperation -> Bool
ShapeOperation -> ShapeOperation -> Ordering
ShapeOperation -> ShapeOperation -> ShapeOperation
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 :: ShapeOperation -> ShapeOperation -> ShapeOperation
$cmin :: ShapeOperation -> ShapeOperation -> ShapeOperation
max :: ShapeOperation -> ShapeOperation -> ShapeOperation
$cmax :: ShapeOperation -> ShapeOperation -> ShapeOperation
>= :: ShapeOperation -> ShapeOperation -> Bool
$c>= :: ShapeOperation -> ShapeOperation -> Bool
> :: ShapeOperation -> ShapeOperation -> Bool
$c> :: ShapeOperation -> ShapeOperation -> Bool
<= :: ShapeOperation -> ShapeOperation -> Bool
$c<= :: ShapeOperation -> ShapeOperation -> Bool
< :: ShapeOperation -> ShapeOperation -> Bool
$c< :: ShapeOperation -> ShapeOperation -> Bool
compare :: ShapeOperation -> ShapeOperation -> Ordering
$ccompare :: ShapeOperation -> ShapeOperation -> Ordering
$cp1Ord :: Eq ShapeOperation
Ord, Int -> ShapeOperation -> ShowS
[ShapeOperation] -> ShowS
ShapeOperation -> String
(Int -> ShapeOperation -> ShowS)
-> (ShapeOperation -> String)
-> ([ShapeOperation] -> ShowS)
-> Show ShapeOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShapeOperation] -> ShowS
$cshowList :: [ShapeOperation] -> ShowS
show :: ShapeOperation -> String
$cshow :: ShapeOperation -> String
showsPrec :: Int -> ShapeOperation -> ShowS
$cshowsPrec :: Int -> ShapeOperation -> ShowS
Show, ReadPrec [ShapeOperation]
ReadPrec ShapeOperation
Int -> ReadS ShapeOperation
ReadS [ShapeOperation]
(Int -> ReadS ShapeOperation)
-> ReadS [ShapeOperation]
-> ReadPrec ShapeOperation
-> ReadPrec [ShapeOperation]
-> Read ShapeOperation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ShapeOperation]
$creadListPrec :: ReadPrec [ShapeOperation]
readPrec :: ReadPrec ShapeOperation
$creadPrec :: ReadPrec ShapeOperation
readList :: ReadS [ShapeOperation]
$creadList :: ReadS [ShapeOperation]
readsPrec :: Int -> ReadS ShapeOperation
$creadsPrec :: Int -> ReadS ShapeOperation
Read, ShapeOperation
ShapeOperation -> ShapeOperation -> Bounded ShapeOperation
forall a. a -> a -> Bounded a
maxBound :: ShapeOperation
$cmaxBound :: ShapeOperation
minBound :: ShapeOperation
$cminBound :: ShapeOperation
Bounded, Int -> ShapeOperation
ShapeOperation -> Int
ShapeOperation -> [ShapeOperation]
ShapeOperation -> ShapeOperation
ShapeOperation -> ShapeOperation -> [ShapeOperation]
ShapeOperation
-> ShapeOperation -> ShapeOperation -> [ShapeOperation]
(ShapeOperation -> ShapeOperation)
-> (ShapeOperation -> ShapeOperation)
-> (Int -> ShapeOperation)
-> (ShapeOperation -> Int)
-> (ShapeOperation -> [ShapeOperation])
-> (ShapeOperation -> ShapeOperation -> [ShapeOperation])
-> (ShapeOperation -> ShapeOperation -> [ShapeOperation])
-> (ShapeOperation
    -> ShapeOperation -> ShapeOperation -> [ShapeOperation])
-> Enum ShapeOperation
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 :: ShapeOperation
-> ShapeOperation -> ShapeOperation -> [ShapeOperation]
$cenumFromThenTo :: ShapeOperation
-> ShapeOperation -> ShapeOperation -> [ShapeOperation]
enumFromTo :: ShapeOperation -> ShapeOperation -> [ShapeOperation]
$cenumFromTo :: ShapeOperation -> ShapeOperation -> [ShapeOperation]
enumFromThen :: ShapeOperation -> ShapeOperation -> [ShapeOperation]
$cenumFromThen :: ShapeOperation -> ShapeOperation -> [ShapeOperation]
enumFrom :: ShapeOperation -> [ShapeOperation]
$cenumFrom :: ShapeOperation -> [ShapeOperation]
fromEnum :: ShapeOperation -> Int
$cfromEnum :: ShapeOperation -> Int
toEnum :: Int -> ShapeOperation
$ctoEnum :: Int -> ShapeOperation
pred :: ShapeOperation -> ShapeOperation
$cpred :: ShapeOperation -> ShapeOperation
succ :: ShapeOperation -> ShapeOperation
$csucc :: ShapeOperation -> ShapeOperation
Enum)

-- There already is an Ordering in the 1.3 Prelude
data Ordering' = Unsorted | YSorted | YXSorted | YXBanded
     deriving (Ordering' -> Ordering' -> Bool
(Ordering' -> Ordering' -> Bool)
-> (Ordering' -> Ordering' -> Bool) -> Eq Ordering'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ordering' -> Ordering' -> Bool
$c/= :: Ordering' -> Ordering' -> Bool
== :: Ordering' -> Ordering' -> Bool
$c== :: Ordering' -> Ordering' -> Bool
Eq, Eq Ordering'
Eq Ordering'
-> (Ordering' -> Ordering' -> Ordering)
-> (Ordering' -> Ordering' -> Bool)
-> (Ordering' -> Ordering' -> Bool)
-> (Ordering' -> Ordering' -> Bool)
-> (Ordering' -> Ordering' -> Bool)
-> (Ordering' -> Ordering' -> Ordering')
-> (Ordering' -> Ordering' -> Ordering')
-> Ord Ordering'
Ordering' -> Ordering' -> Bool
Ordering' -> Ordering' -> Ordering
Ordering' -> Ordering' -> Ordering'
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 :: Ordering' -> Ordering' -> Ordering'
$cmin :: Ordering' -> Ordering' -> Ordering'
max :: Ordering' -> Ordering' -> Ordering'
$cmax :: Ordering' -> Ordering' -> Ordering'
>= :: Ordering' -> Ordering' -> Bool
$c>= :: Ordering' -> Ordering' -> Bool
> :: Ordering' -> Ordering' -> Bool
$c> :: Ordering' -> Ordering' -> Bool
<= :: Ordering' -> Ordering' -> Bool
$c<= :: Ordering' -> Ordering' -> Bool
< :: Ordering' -> Ordering' -> Bool
$c< :: Ordering' -> Ordering' -> Bool
compare :: Ordering' -> Ordering' -> Ordering
$ccompare :: Ordering' -> Ordering' -> Ordering
$cp1Ord :: Eq Ordering'
Ord, Int -> Ordering' -> ShowS
[Ordering'] -> ShowS
Ordering' -> String
(Int -> Ordering' -> ShowS)
-> (Ordering' -> String)
-> ([Ordering'] -> ShowS)
-> Show Ordering'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ordering'] -> ShowS
$cshowList :: [Ordering'] -> ShowS
show :: Ordering' -> String
$cshow :: Ordering' -> String
showsPrec :: Int -> Ordering' -> ShowS
$cshowsPrec :: Int -> Ordering' -> ShowS
Show, ReadPrec [Ordering']
ReadPrec Ordering'
Int -> ReadS Ordering'
ReadS [Ordering']
(Int -> ReadS Ordering')
-> ReadS [Ordering']
-> ReadPrec Ordering'
-> ReadPrec [Ordering']
-> Read Ordering'
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Ordering']
$creadListPrec :: ReadPrec [Ordering']
readPrec :: ReadPrec Ordering'
$creadPrec :: ReadPrec Ordering'
readList :: ReadS [Ordering']
$creadList :: ReadS [Ordering']
readsPrec :: Int -> ReadS Ordering'
$creadsPrec :: Int -> ReadS Ordering'
Read, Ordering'
Ordering' -> Ordering' -> Bounded Ordering'
forall a. a -> a -> Bounded a
maxBound :: Ordering'
$cmaxBound :: Ordering'
minBound :: Ordering'
$cminBound :: Ordering'
Bounded, Int -> Ordering'
Ordering' -> Int
Ordering' -> [Ordering']
Ordering' -> Ordering'
Ordering' -> Ordering' -> [Ordering']
Ordering' -> Ordering' -> Ordering' -> [Ordering']
(Ordering' -> Ordering')
-> (Ordering' -> Ordering')
-> (Int -> Ordering')
-> (Ordering' -> Int)
-> (Ordering' -> [Ordering'])
-> (Ordering' -> Ordering' -> [Ordering'])
-> (Ordering' -> Ordering' -> [Ordering'])
-> (Ordering' -> Ordering' -> Ordering' -> [Ordering'])
-> Enum Ordering'
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 :: Ordering' -> Ordering' -> Ordering' -> [Ordering']
$cenumFromThenTo :: Ordering' -> Ordering' -> Ordering' -> [Ordering']
enumFromTo :: Ordering' -> Ordering' -> [Ordering']
$cenumFromTo :: Ordering' -> Ordering' -> [Ordering']
enumFromThen :: Ordering' -> Ordering' -> [Ordering']
$cenumFromThen :: Ordering' -> Ordering' -> [Ordering']
enumFrom :: Ordering' -> [Ordering']
$cenumFrom :: Ordering' -> [Ordering']
fromEnum :: Ordering' -> Int
$cfromEnum :: Ordering' -> Int
toEnum :: Int -> Ordering'
$ctoEnum :: Int -> Ordering'
pred :: Ordering' -> Ordering'
$cpred :: Ordering' -> Ordering'
succ :: Ordering' -> Ordering'
$csucc :: Ordering' -> Ordering'
Enum)

type RmClass = String
type RmName = String
type RmQuery = (RmClass, RmName)
type RmSpec = [RmQuery]
type RmValue = String
type RmDatabase = Int

rmNothing :: Int
rmNothing = Int
0::Int

data Modifiers = Shift | Lock | Control
               | Mod1 | Mod2 | Mod3 | Mod4 | Mod5
               | Button1 | Button2 | Button3 | Button4 | Button5
               | Mod13 | Mod14 -- non-standard, but used in XQuartz
               | Any 
               deriving (Modifiers -> Modifiers -> Bool
(Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Bool) -> Eq Modifiers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Modifiers -> Modifiers -> Bool
$c/= :: Modifiers -> Modifiers -> Bool
== :: Modifiers -> Modifiers -> Bool
$c== :: Modifiers -> Modifiers -> Bool
Eq, Eq Modifiers
Eq Modifiers
-> (Modifiers -> Modifiers -> Ordering)
-> (Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Bool)
-> (Modifiers -> Modifiers -> Modifiers)
-> (Modifiers -> Modifiers -> Modifiers)
-> Ord Modifiers
Modifiers -> Modifiers -> Bool
Modifiers -> Modifiers -> Ordering
Modifiers -> Modifiers -> Modifiers
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 :: Modifiers -> Modifiers -> Modifiers
$cmin :: Modifiers -> Modifiers -> Modifiers
max :: Modifiers -> Modifiers -> Modifiers
$cmax :: Modifiers -> Modifiers -> Modifiers
>= :: Modifiers -> Modifiers -> Bool
$c>= :: Modifiers -> Modifiers -> Bool
> :: Modifiers -> Modifiers -> Bool
$c> :: Modifiers -> Modifiers -> Bool
<= :: Modifiers -> Modifiers -> Bool
$c<= :: Modifiers -> Modifiers -> Bool
< :: Modifiers -> Modifiers -> Bool
$c< :: Modifiers -> Modifiers -> Bool
compare :: Modifiers -> Modifiers -> Ordering
$ccompare :: Modifiers -> Modifiers -> Ordering
$cp1Ord :: Eq Modifiers
Ord, Int -> Modifiers -> ShowS
[Modifiers] -> ShowS
Modifiers -> String
(Int -> Modifiers -> ShowS)
-> (Modifiers -> String)
-> ([Modifiers] -> ShowS)
-> Show Modifiers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Modifiers] -> ShowS
$cshowList :: [Modifiers] -> ShowS
show :: Modifiers -> String
$cshow :: Modifiers -> String
showsPrec :: Int -> Modifiers -> ShowS
$cshowsPrec :: Int -> Modifiers -> ShowS
Show, ReadPrec [Modifiers]
ReadPrec Modifiers
Int -> ReadS Modifiers
ReadS [Modifiers]
(Int -> ReadS Modifiers)
-> ReadS [Modifiers]
-> ReadPrec Modifiers
-> ReadPrec [Modifiers]
-> Read Modifiers
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Modifiers]
$creadListPrec :: ReadPrec [Modifiers]
readPrec :: ReadPrec Modifiers
$creadPrec :: ReadPrec Modifiers
readList :: ReadS [Modifiers]
$creadList :: ReadS [Modifiers]
readsPrec :: Int -> ReadS Modifiers
$creadsPrec :: Int -> ReadS Modifiers
Read, Modifiers
Modifiers -> Modifiers -> Bounded Modifiers
forall a. a -> a -> Bounded a
maxBound :: Modifiers
$cmaxBound :: Modifiers
minBound :: Modifiers
$cminBound :: Modifiers
Bounded, Int -> Modifiers
Modifiers -> Int
Modifiers -> [Modifiers]
Modifiers -> Modifiers
Modifiers -> Modifiers -> [Modifiers]
Modifiers -> Modifiers -> Modifiers -> [Modifiers]
(Modifiers -> Modifiers)
-> (Modifiers -> Modifiers)
-> (Int -> Modifiers)
-> (Modifiers -> Int)
-> (Modifiers -> [Modifiers])
-> (Modifiers -> Modifiers -> [Modifiers])
-> (Modifiers -> Modifiers -> [Modifiers])
-> (Modifiers -> Modifiers -> Modifiers -> [Modifiers])
-> Enum Modifiers
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 :: Modifiers -> Modifiers -> Modifiers -> [Modifiers]
$cenumFromThenTo :: Modifiers -> Modifiers -> Modifiers -> [Modifiers]
enumFromTo :: Modifiers -> Modifiers -> [Modifiers]
$cenumFromTo :: Modifiers -> Modifiers -> [Modifiers]
enumFromThen :: Modifiers -> Modifiers -> [Modifiers]
$cenumFromThen :: Modifiers -> Modifiers -> [Modifiers]
enumFrom :: Modifiers -> [Modifiers]
$cenumFrom :: Modifiers -> [Modifiers]
fromEnum :: Modifiers -> Int
$cfromEnum :: Modifiers -> Int
toEnum :: Int -> Modifiers
$ctoEnum :: Int -> Modifiers
pred :: Modifiers -> Modifiers
$cpred :: Modifiers -> Modifiers
succ :: Modifiers -> Modifiers
$csucc :: Modifiers -> Modifiers
Enum)

clModifiers :: [Modifiers]
clModifiers =
    [Modifiers
Shift, Modifiers
Lock, Modifiers
Control, Modifiers
Mod1, Modifiers
Mod2, Modifiers
Mod3, Modifiers
Mod4, Modifiers
Mod5,
     Modifiers
Button1, Modifiers
Button2, Modifiers
Button3, Modifiers
Button4, Modifiers
Button5]

data Button = AnyButton | Button Int  deriving (Button -> Button -> Bool
(Button -> Button -> Bool)
-> (Button -> Button -> Bool) -> Eq Button
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Button -> Button -> Bool
$c/= :: Button -> Button -> Bool
== :: Button -> Button -> Bool
$c== :: Button -> Button -> Bool
Eq, Eq Button
Eq Button
-> (Button -> Button -> Ordering)
-> (Button -> Button -> Bool)
-> (Button -> Button -> Bool)
-> (Button -> Button -> Bool)
-> (Button -> Button -> Bool)
-> (Button -> Button -> Button)
-> (Button -> Button -> Button)
-> Ord Button
Button -> Button -> Bool
Button -> Button -> Ordering
Button -> Button -> Button
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 :: Button -> Button -> Button
$cmin :: Button -> Button -> Button
max :: Button -> Button -> Button
$cmax :: Button -> Button -> Button
>= :: Button -> Button -> Bool
$c>= :: Button -> Button -> Bool
> :: Button -> Button -> Bool
$c> :: Button -> Button -> Bool
<= :: Button -> Button -> Bool
$c<= :: Button -> Button -> Bool
< :: Button -> Button -> Bool
$c< :: Button -> Button -> Bool
compare :: Button -> Button -> Ordering
$ccompare :: Button -> Button -> Ordering
$cp1Ord :: Eq Button
Ord, ReadPrec [Button]
ReadPrec Button
Int -> ReadS Button
ReadS [Button]
(Int -> ReadS Button)
-> ReadS [Button]
-> ReadPrec Button
-> ReadPrec [Button]
-> Read Button
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Button]
$creadListPrec :: ReadPrec [Button]
readPrec :: ReadPrec Button
$creadPrec :: ReadPrec Button
readList :: ReadS [Button]
$creadList :: ReadS [Button]
readsPrec :: Int -> ReadS Button
$creadsPrec :: Int -> ReadS Button
Read, Int -> Button -> ShowS
[Button] -> ShowS
Button -> String
(Int -> Button -> ShowS)
-> (Button -> String) -> ([Button] -> ShowS) -> Show Button
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Button] -> ShowS
$cshowList :: [Button] -> ShowS
show :: Button -> String
$cshow :: Button -> String
showsPrec :: Int -> Button -> ShowS
$cshowsPrec :: Int -> Button -> ShowS
Show)

type ModState = [Modifiers]

type KeySym = String