diff --git a/Data/XCB/Types.hs b/Data/XCB/Types.hs --- a/Data/XCB/Types.hs +++ b/Data/XCB/Types.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE + RecordWildCards + #-} -- | -- Module : Data.XCB.Types @@ -26,43 +29,87 @@ -- 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 XHeader = XHeader {xheader_header :: Name -- ^Name of module. Used in the other modules as a reference. - ,xheader_xname :: Maybe Name -- ^Name used to indentify extensions between the X client and server. - ,xheader_name :: Maybe Name -- ^InterCaps name. - ,xheader_multiword :: Maybe Bool - ,xheader_major_version :: Maybe Int - ,xheader_minor_version :: Maybe Int - ,xheader_decls :: [XDecl] -- ^Declarations contained in this module. - } +data GenXHeader typ = XHeader + {xheader_header :: Name -- ^Name of module. Used in the other modules as a reference. + ,xheader_xname :: Maybe Name -- ^Name used to indentify extensions between the X client and server. + ,xheader_name :: Maybe Name -- ^InterCaps name. + ,xheader_multiword :: Maybe Bool + ,xheader_major_version :: Maybe Int + ,xheader_minor_version :: Maybe Int + ,xheader_decls :: [GenXDecl typ] -- ^Declarations contained in this module. + } deriving (Show) +mapTypes :: (a -> b) -> GenXHeader a -> GenXHeader b +mapTypes f XHeader{..} = + XHeader + xheader_header + xheader_xname + xheader_name + xheader_multiword + xheader_major_version + xheader_minor_version + (map (mapDecls f) xheader_decls) + +type XHeader = GenXHeader Type +type XDecl = GenXDecl Type +type StructElem = GenStructElem Type +type XidUnionElem = GenXidUnionElem Type +type XReply = GenXReply Type + -- |The different types of declarations which can be made in one of the -- XML files. -data XDecl = XStruct Name [StructElem] - | XTypeDef Name Type - | XEvent Name Int [StructElem] (Maybe Bool) -- ^ The boolean indicates if the event includes a sequence number. - | XRequest Name Int [StructElem] (Maybe XReply) - | XidType Name - | XidUnion Name [XidUnionElem] - | XEnum Name [EnumElem] - | XUnion Name [StructElem] - | XImport Name - | XError Name Int [StructElem] +data GenXDecl typ + = XStruct Name [GenStructElem typ] + | XTypeDef Name typ + | XEvent Name Int [GenStructElem typ] (Maybe Bool) -- ^ The boolean indicates if the event includes a sequence number. + | XRequest Name Int [GenStructElem typ] (Maybe (GenXReply typ)) + | XidType Name + | XidUnion Name [GenXidUnionElem typ] + | XEnum Name [EnumElem] + | XUnion Name [GenStructElem typ] + | XImport Name + | XError Name Int [GenStructElem typ] deriving (Show) -data StructElem = Pad Int - | List Name Type (Maybe Expression) (Maybe EnumVals) - | SField Name Type (Maybe EnumVals) (Maybe MaskVals) - | ExprField Name Type Expression - | ValueParam Type MaskName (Maybe MaskPadding) ListName +mapDecls :: (a -> b) -> GenXDecl a -> GenXDecl b +mapDecls f = go + where + go (XStruct name elems) = XStruct name (map (mapSElem f) elems) + go (XTypeDef name t) = XTypeDef name (f t) + go (XEvent name n elems seq) = XEvent name n (map (mapSElem f) elems) seq + go (XRequest name n elems rep) = XRequest name n (map (mapSElem f) elems) (mapReply f rep) + go (XidType name) = XidType name + go (XEnum name elems) = XEnum name elems + go (XUnion name elems) = XUnion name (map (mapSElem f) elems) + go (XidUnion name elems) = XidUnion name (map (mapUnions f) elems) + go (XImport name) = XImport name + go (XError name n elems) = XError name n (map (mapSElem f) elems) + +mapReply f = liftM (map (mapSElem f)) + +data GenStructElem typ + = Pad Int + | List Name typ (Maybe Expression) (Maybe (EnumVals typ)) + | SField Name typ (Maybe (EnumVals typ)) (Maybe (MaskVals typ)) + | ExprField Name typ Expression + | ValueParam typ Name (Maybe MaskPadding) ListName deriving (Show) -type AltEnumVals = Type -type EnumVals = Type -type MaskVals = Type +mapSElem f = go + where + go (Pad n) = Pad n + go (List name typ exp enum) = List name (f typ) exp (liftM f enum) + go (SField name typ enum mask) = SField name (f typ) (liftM f enum) (liftM f mask) + go (ExprField name typ expr) = ExprField name (f typ) expr + go (ValueParam typ name pad lname) = ValueParam (f typ) name pad lname +type AltEnumVals typ = typ +type EnumVals typ = typ +type MaskVals typ = typ + type Name = String -type XReply = [StructElem] +type GenXReply typ = [GenStructElem typ] type Ref = String type MaskName = Name type ListName = Name @@ -73,9 +120,11 @@ | QualType Name Name deriving Show -data XidUnionElem = XidUnionElem Type +data GenXidUnionElem typ = XidUnionElem typ deriving (Show) +mapUnions f (XidUnionElem t) = XidUnionElem (f t) + -- Should only ever have expressions of type 'Value' or 'Bit'. data EnumElem = EnumElem Name (Maybe Expression) deriving (Show) @@ -83,7 +132,7 @@ -- |Declarations may contain expressions from this small language data Expression = Value Int -- ^A literal value | Bit Int -- ^A log-base-2 literal value - | FieldRef String -- ^A reference to a field in the same declaration + | FieldRef Name -- ^A reference to a field in the same declaration | Op Binop Expression Expression -- ^A binary opeation deriving (Show) diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Antoine Latter 2008 +Copyright Antoine Latter 2008, 2009 All rights reserved. diff --git a/xcb-types.cabal b/xcb-types.cabal --- a/xcb-types.cabal +++ b/xcb-types.cabal @@ -1,5 +1,5 @@ Name: xcb-types -Version: 0.4.0 +Version: 0.5.0 Cabal-Version: >= 1.2 Synopsis: Parses XML files used by the XCB project Description: This package provides types which mirror the structures