{-# LANGUAGE
     RecordWildCards,
     DeriveFunctor
     #-}

-- |
-- Module    :  Data.XCB.Types
-- Copyright :  (c) Antoine Latter 2008
-- License   :  BSD3
--
-- Maintainer:  Antoine Latter <aslatter@gmail.com>
-- Stability :  provisional
-- Portability: portable
--
-- Defines types inteneded to be equivalent to the schema used by
-- the XCB project in their XML protocol description.
--


module Data.XCB.Types
    ( XHeader
    , XDecl
    , StructElem
    , XEnumElem
    , BitCase
    , XidUnionElem
    , XReply
    , XExpression
    , GenXHeader ( .. )
    , GenXDecl ( .. )
    , GenStructElem ( .. )
    , GenBitCase ( .. )
    , GenXReply ( .. )
    , GenXidUnionElem ( .. )
    , EnumElem ( .. )
    , Expression ( .. )
    , Binop ( .. )
    , Unop ( .. )
    , Type ( .. )
    , EnumVals
    , MaskVals
    , Name
    , Ref
    , MaskName
    , ListName
    , MaskPadding
    , Alignment ( .. )
    , AllowedEvent ( .. )
    ) where

import Data.Map

-- 'xheader_header' is the name gauranteed to exist, and is used in
-- imports and in type qualifiers.
--
-- 'xheader_name' is the InterCaps name, and should be prefered in the naming
-- of types, functions and haskell modules when available.
-- |This is what a single XML file maps to.  It contains some meta-data
-- then declarations.
data GenXHeader typ = XHeader
    {GenXHeader typ -> Name
xheader_header :: Name -- ^Name of module.  Used in the other modules as a reference.
    ,GenXHeader typ -> Maybe Name
xheader_xname :: Maybe Name  -- ^Name used to indentify extensions between the X client and server.
    ,GenXHeader typ -> Maybe Name
xheader_name :: Maybe Name -- ^InterCaps name.
    ,GenXHeader typ -> Maybe Bool
xheader_multiword :: Maybe Bool
    ,GenXHeader typ -> Maybe Int
xheader_major_version :: Maybe Int
    ,GenXHeader typ -> Maybe Int
xheader_minor_version :: Maybe Int
    ,GenXHeader typ -> [GenXDecl typ]
xheader_decls :: [GenXDecl typ]  -- ^Declarations contained in this module.
    }
 deriving (Int -> GenXHeader typ -> ShowS
[GenXHeader typ] -> ShowS
GenXHeader typ -> Name
(Int -> GenXHeader typ -> ShowS)
-> (GenXHeader typ -> Name)
-> ([GenXHeader typ] -> ShowS)
-> Show (GenXHeader typ)
forall typ. Show typ => Int -> GenXHeader typ -> ShowS
forall typ. Show typ => [GenXHeader typ] -> ShowS
forall typ. Show typ => GenXHeader typ -> Name
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [GenXHeader typ] -> ShowS
$cshowList :: forall typ. Show typ => [GenXHeader typ] -> ShowS
show :: GenXHeader typ -> Name
$cshow :: forall typ. Show typ => GenXHeader typ -> Name
showsPrec :: Int -> GenXHeader typ -> ShowS
$cshowsPrec :: forall typ. Show typ => Int -> GenXHeader typ -> ShowS
Show, a -> GenXHeader b -> GenXHeader a
(a -> b) -> GenXHeader a -> GenXHeader b
(forall a b. (a -> b) -> GenXHeader a -> GenXHeader b)
-> (forall a b. a -> GenXHeader b -> GenXHeader a)
-> Functor GenXHeader
forall a b. a -> GenXHeader b -> GenXHeader a
forall a b. (a -> b) -> GenXHeader a -> GenXHeader b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GenXHeader b -> GenXHeader a
$c<$ :: forall a b. a -> GenXHeader b -> GenXHeader a
fmap :: (a -> b) -> GenXHeader a -> GenXHeader b
$cfmap :: forall a b. (a -> b) -> GenXHeader a -> GenXHeader b
Functor)

type XHeader = GenXHeader Type
type XDecl = GenXDecl Type
type StructElem = GenStructElem Type
type BitCase = GenBitCase Type
type XidUnionElem = GenXidUnionElem Type
type XReply = GenXReply Type
type XExpression = Expression Type
type XEnumElem = EnumElem Type

-- |The different types of declarations which can be made in one of the
-- XML files.
data GenXDecl typ
    = XStruct  Name (Maybe Alignment) [GenStructElem typ]
    | XTypeDef Name typ
    | XEvent Name Int (Maybe Alignment) [GenStructElem typ] (Maybe Bool)  -- ^ The boolean indicates if the event includes a sequence number.
    | XRequest Name Int (Maybe Alignment) [GenStructElem typ] (Maybe (GenXReply typ))
    | XidType  Name
    | XidUnion  Name [GenXidUnionElem typ]
    | XEnum Name [EnumElem typ]
    | XUnion Name (Maybe Alignment) [GenStructElem typ]
    | XImport Name
    | XError Name Int (Maybe Alignment) [GenStructElem typ]
    | XEventStruct Name [AllowedEvent]
 deriving (Int -> GenXDecl typ -> ShowS
[GenXDecl typ] -> ShowS
GenXDecl typ -> Name
(Int -> GenXDecl typ -> ShowS)
-> (GenXDecl typ -> Name)
-> ([GenXDecl typ] -> ShowS)
-> Show (GenXDecl typ)
forall typ. Show typ => Int -> GenXDecl typ -> ShowS
forall typ. Show typ => [GenXDecl typ] -> ShowS
forall typ. Show typ => GenXDecl typ -> Name
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [GenXDecl typ] -> ShowS
$cshowList :: forall typ. Show typ => [GenXDecl typ] -> ShowS
show :: GenXDecl typ -> Name
$cshow :: forall typ. Show typ => GenXDecl typ -> Name
showsPrec :: Int -> GenXDecl typ -> ShowS
$cshowsPrec :: forall typ. Show typ => Int -> GenXDecl typ -> ShowS
Show, a -> GenXDecl b -> GenXDecl a
(a -> b) -> GenXDecl a -> GenXDecl b
(forall a b. (a -> b) -> GenXDecl a -> GenXDecl b)
-> (forall a b. a -> GenXDecl b -> GenXDecl a) -> Functor GenXDecl
forall a b. a -> GenXDecl b -> GenXDecl a
forall a b. (a -> b) -> GenXDecl a -> GenXDecl b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GenXDecl b -> GenXDecl a
$c<$ :: forall a b. a -> GenXDecl b -> GenXDecl a
fmap :: (a -> b) -> GenXDecl a -> GenXDecl b
$cfmap :: forall a b. (a -> b) -> GenXDecl a -> GenXDecl b
Functor)

data GenStructElem typ
    = Pad Int
    | List Name typ (Maybe (Expression typ)) (Maybe (EnumVals typ))
    | SField Name typ (Maybe (EnumVals typ)) (Maybe (MaskVals typ))
    | ExprField Name typ (Expression typ)
    | ValueParam typ Name (Maybe MaskPadding) ListName
    | Switch Name (Expression typ) (Maybe Alignment) [GenBitCase typ]
    | Doc (Maybe String) (Map Name String) [(String, String)]
    | Fd String
    | Length typ (Expression typ)
 deriving (Int -> GenStructElem typ -> ShowS
[GenStructElem typ] -> ShowS
GenStructElem typ -> Name
(Int -> GenStructElem typ -> ShowS)
-> (GenStructElem typ -> Name)
-> ([GenStructElem typ] -> ShowS)
-> Show (GenStructElem typ)
forall typ. Show typ => Int -> GenStructElem typ -> ShowS
forall typ. Show typ => [GenStructElem typ] -> ShowS
forall typ. Show typ => GenStructElem typ -> Name
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [GenStructElem typ] -> ShowS
$cshowList :: forall typ. Show typ => [GenStructElem typ] -> ShowS
show :: GenStructElem typ -> Name
$cshow :: forall typ. Show typ => GenStructElem typ -> Name
showsPrec :: Int -> GenStructElem typ -> ShowS
$cshowsPrec :: forall typ. Show typ => Int -> GenStructElem typ -> ShowS
Show, a -> GenStructElem b -> GenStructElem a
(a -> b) -> GenStructElem a -> GenStructElem b
(forall a b. (a -> b) -> GenStructElem a -> GenStructElem b)
-> (forall a b. a -> GenStructElem b -> GenStructElem a)
-> Functor GenStructElem
forall a b. a -> GenStructElem b -> GenStructElem a
forall a b. (a -> b) -> GenStructElem a -> GenStructElem b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GenStructElem b -> GenStructElem a
$c<$ :: forall a b. a -> GenStructElem b -> GenStructElem a
fmap :: (a -> b) -> GenStructElem a -> GenStructElem b
$cfmap :: forall a b. (a -> b) -> GenStructElem a -> GenStructElem b
Functor)

data GenBitCase typ
    = BitCase (Maybe Name) (Expression typ) (Maybe Alignment) [GenStructElem typ]
 deriving (Int -> GenBitCase typ -> ShowS
[GenBitCase typ] -> ShowS
GenBitCase typ -> Name
(Int -> GenBitCase typ -> ShowS)
-> (GenBitCase typ -> Name)
-> ([GenBitCase typ] -> ShowS)
-> Show (GenBitCase typ)
forall typ. Show typ => Int -> GenBitCase typ -> ShowS
forall typ. Show typ => [GenBitCase typ] -> ShowS
forall typ. Show typ => GenBitCase typ -> Name
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [GenBitCase typ] -> ShowS
$cshowList :: forall typ. Show typ => [GenBitCase typ] -> ShowS
show :: GenBitCase typ -> Name
$cshow :: forall typ. Show typ => GenBitCase typ -> Name
showsPrec :: Int -> GenBitCase typ -> ShowS
$cshowsPrec :: forall typ. Show typ => Int -> GenBitCase typ -> ShowS
Show, a -> GenBitCase b -> GenBitCase a
(a -> b) -> GenBitCase a -> GenBitCase b
(forall a b. (a -> b) -> GenBitCase a -> GenBitCase b)
-> (forall a b. a -> GenBitCase b -> GenBitCase a)
-> Functor GenBitCase
forall a b. a -> GenBitCase b -> GenBitCase a
forall a b. (a -> b) -> GenBitCase a -> GenBitCase b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GenBitCase b -> GenBitCase a
$c<$ :: forall a b. a -> GenBitCase b -> GenBitCase a
fmap :: (a -> b) -> GenBitCase a -> GenBitCase b
$cfmap :: forall a b. (a -> b) -> GenBitCase a -> GenBitCase b
Functor)

type EnumVals typ = typ
type MaskVals typ = typ

type Name = String
data GenXReply typ = GenXReply (Maybe Alignment) [GenStructElem typ]
 deriving (Int -> GenXReply typ -> ShowS
[GenXReply typ] -> ShowS
GenXReply typ -> Name
(Int -> GenXReply typ -> ShowS)
-> (GenXReply typ -> Name)
-> ([GenXReply typ] -> ShowS)
-> Show (GenXReply typ)
forall typ. Show typ => Int -> GenXReply typ -> ShowS
forall typ. Show typ => [GenXReply typ] -> ShowS
forall typ. Show typ => GenXReply typ -> Name
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [GenXReply typ] -> ShowS
$cshowList :: forall typ. Show typ => [GenXReply typ] -> ShowS
show :: GenXReply typ -> Name
$cshow :: forall typ. Show typ => GenXReply typ -> Name
showsPrec :: Int -> GenXReply typ -> ShowS
$cshowsPrec :: forall typ. Show typ => Int -> GenXReply typ -> ShowS
Show, a -> GenXReply b -> GenXReply a
(a -> b) -> GenXReply a -> GenXReply b
(forall a b. (a -> b) -> GenXReply a -> GenXReply b)
-> (forall a b. a -> GenXReply b -> GenXReply a)
-> Functor GenXReply
forall a b. a -> GenXReply b -> GenXReply a
forall a b. (a -> b) -> GenXReply a -> GenXReply b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GenXReply b -> GenXReply a
$c<$ :: forall a b. a -> GenXReply b -> GenXReply a
fmap :: (a -> b) -> GenXReply a -> GenXReply b
$cfmap :: forall a b. (a -> b) -> GenXReply a -> GenXReply b
Functor)
type Ref = String
type MaskName = Name
type ListName = Name
type MaskPadding = Int

-- |Types may include a reference to the containing module.
data Type = UnQualType Name
          | QualType Name Name
 deriving (Int -> Type -> ShowS
[Type] -> ShowS
Type -> Name
(Int -> Type -> ShowS)
-> (Type -> Name) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> Name
$cshow :: Type -> Name
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show, Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Eq Type
Eq Type
-> (Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
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 :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
$cp1Ord :: Eq Type
Ord)

data GenXidUnionElem typ = XidUnionElem typ
 deriving (Int -> GenXidUnionElem typ -> ShowS
[GenXidUnionElem typ] -> ShowS
GenXidUnionElem typ -> Name
(Int -> GenXidUnionElem typ -> ShowS)
-> (GenXidUnionElem typ -> Name)
-> ([GenXidUnionElem typ] -> ShowS)
-> Show (GenXidUnionElem typ)
forall typ. Show typ => Int -> GenXidUnionElem typ -> ShowS
forall typ. Show typ => [GenXidUnionElem typ] -> ShowS
forall typ. Show typ => GenXidUnionElem typ -> Name
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [GenXidUnionElem typ] -> ShowS
$cshowList :: forall typ. Show typ => [GenXidUnionElem typ] -> ShowS
show :: GenXidUnionElem typ -> Name
$cshow :: forall typ. Show typ => GenXidUnionElem typ -> Name
showsPrec :: Int -> GenXidUnionElem typ -> ShowS
$cshowsPrec :: forall typ. Show typ => Int -> GenXidUnionElem typ -> ShowS
Show, a -> GenXidUnionElem b -> GenXidUnionElem a
(a -> b) -> GenXidUnionElem a -> GenXidUnionElem b
(forall a b. (a -> b) -> GenXidUnionElem a -> GenXidUnionElem b)
-> (forall a b. a -> GenXidUnionElem b -> GenXidUnionElem a)
-> Functor GenXidUnionElem
forall a b. a -> GenXidUnionElem b -> GenXidUnionElem a
forall a b. (a -> b) -> GenXidUnionElem a -> GenXidUnionElem b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GenXidUnionElem b -> GenXidUnionElem a
$c<$ :: forall a b. a -> GenXidUnionElem b -> GenXidUnionElem a
fmap :: (a -> b) -> GenXidUnionElem a -> GenXidUnionElem b
$cfmap :: forall a b. (a -> b) -> GenXidUnionElem a -> GenXidUnionElem b
Functor)

-- Should only ever have expressions of type 'Value' or 'Bit'.
data EnumElem typ = EnumElem Name (Maybe (Expression typ))
 deriving (Int -> EnumElem typ -> ShowS
[EnumElem typ] -> ShowS
EnumElem typ -> Name
(Int -> EnumElem typ -> ShowS)
-> (EnumElem typ -> Name)
-> ([EnumElem typ] -> ShowS)
-> Show (EnumElem typ)
forall typ. Show typ => Int -> EnumElem typ -> ShowS
forall typ. Show typ => [EnumElem typ] -> ShowS
forall typ. Show typ => EnumElem typ -> Name
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [EnumElem typ] -> ShowS
$cshowList :: forall typ. Show typ => [EnumElem typ] -> ShowS
show :: EnumElem typ -> Name
$cshow :: forall typ. Show typ => EnumElem typ -> Name
showsPrec :: Int -> EnumElem typ -> ShowS
$cshowsPrec :: forall typ. Show typ => Int -> EnumElem typ -> ShowS
Show, a -> EnumElem b -> EnumElem a
(a -> b) -> EnumElem a -> EnumElem b
(forall a b. (a -> b) -> EnumElem a -> EnumElem b)
-> (forall a b. a -> EnumElem b -> EnumElem a) -> Functor EnumElem
forall a b. a -> EnumElem b -> EnumElem a
forall a b. (a -> b) -> EnumElem a -> EnumElem b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> EnumElem b -> EnumElem a
$c<$ :: forall a b. a -> EnumElem b -> EnumElem a
fmap :: (a -> b) -> EnumElem a -> EnumElem b
$cfmap :: forall a b. (a -> b) -> EnumElem a -> EnumElem b
Functor)

-- |Declarations may contain expressions from this small language
data Expression typ
    = Value Int  -- ^A literal value
    | Bit Int    -- ^A log-base-2 literal value
    | FieldRef Name -- ^A reference to a field in the same declaration
    | EnumRef typ Name -- ^A reference to a member of an enum.
    | PopCount (Expression typ) -- ^Calculate the number of set bits in the argument
    | SumOf Name -- ^Note sure. The argument should be a reference to a list
    | Op Binop (Expression typ) (Expression typ) -- ^A binary opeation
    | Unop Unop (Expression typ) -- ^A unary operation
    | ParamRef Name -- ^I think this is the name of an argument passed to the request. See fffbd04d63 in xcb-proto.
 deriving (Int -> Expression typ -> ShowS
[Expression typ] -> ShowS
Expression typ -> Name
(Int -> Expression typ -> ShowS)
-> (Expression typ -> Name)
-> ([Expression typ] -> ShowS)
-> Show (Expression typ)
forall typ. Show typ => Int -> Expression typ -> ShowS
forall typ. Show typ => [Expression typ] -> ShowS
forall typ. Show typ => Expression typ -> Name
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [Expression typ] -> ShowS
$cshowList :: forall typ. Show typ => [Expression typ] -> ShowS
show :: Expression typ -> Name
$cshow :: forall typ. Show typ => Expression typ -> Name
showsPrec :: Int -> Expression typ -> ShowS
$cshowsPrec :: forall typ. Show typ => Int -> Expression typ -> ShowS
Show, a -> Expression b -> Expression a
(a -> b) -> Expression a -> Expression b
(forall a b. (a -> b) -> Expression a -> Expression b)
-> (forall a b. a -> Expression b -> Expression a)
-> Functor Expression
forall a b. a -> Expression b -> Expression a
forall a b. (a -> b) -> Expression a -> Expression b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Expression b -> Expression a
$c<$ :: forall a b. a -> Expression b -> Expression a
fmap :: (a -> b) -> Expression a -> Expression b
$cfmap :: forall a b. (a -> b) -> Expression a -> Expression b
Functor)

-- |Supported Binary operations.
data Binop = Add
           | Sub
           | Mult
           | Div
           | And
           | RShift
 deriving (Int -> Binop -> ShowS
[Binop] -> ShowS
Binop -> Name
(Int -> Binop -> ShowS)
-> (Binop -> Name) -> ([Binop] -> ShowS) -> Show Binop
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [Binop] -> ShowS
$cshowList :: [Binop] -> ShowS
show :: Binop -> Name
$cshow :: Binop -> Name
showsPrec :: Int -> Binop -> ShowS
$cshowsPrec :: Int -> Binop -> ShowS
Show)

data Unop = Complement
 deriving (Int -> Unop -> ShowS
[Unop] -> ShowS
Unop -> Name
(Int -> Unop -> ShowS)
-> (Unop -> Name) -> ([Unop] -> ShowS) -> Show Unop
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [Unop] -> ShowS
$cshowList :: [Unop] -> ShowS
show :: Unop -> Name
$cshow :: Unop -> Name
showsPrec :: Int -> Unop -> ShowS
$cshowsPrec :: Int -> Unop -> ShowS
Show)

data Alignment = Alignment Int Int deriving (Int -> Alignment -> ShowS
[Alignment] -> ShowS
Alignment -> Name
(Int -> Alignment -> ShowS)
-> (Alignment -> Name) -> ([Alignment] -> ShowS) -> Show Alignment
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [Alignment] -> ShowS
$cshowList :: [Alignment] -> ShowS
show :: Alignment -> Name
$cshow :: Alignment -> Name
showsPrec :: Int -> Alignment -> ShowS
$cshowsPrec :: Int -> Alignment -> ShowS
Show)

data AllowedEvent = AllowedEvent Name Bool Int Int deriving (Int -> AllowedEvent -> ShowS
[AllowedEvent] -> ShowS
AllowedEvent -> Name
(Int -> AllowedEvent -> ShowS)
-> (AllowedEvent -> Name)
-> ([AllowedEvent] -> ShowS)
-> Show AllowedEvent
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [AllowedEvent] -> ShowS
$cshowList :: [AllowedEvent] -> ShowS
show :: AllowedEvent -> Name
$cshow :: AllowedEvent -> Name
showsPrec :: Int -> AllowedEvent -> ShowS
$cshowsPrec :: Int -> AllowedEvent -> ShowS
Show)