xcffib 1.5.0 → 1.6.0

raw patch · 11 files changed

+613/−304 lines, 11 filesdep +prettydep −language-pythondep −semigroupsdep ~HUnitdep ~attoparsecdep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: pretty

Dependencies removed: language-python, semigroups

Dependency ranges changed: HUnit, attoparsec, bytestring, containers, directory, either, filemanip, filepath, mtl, optparse-applicative, split, test-framework, test-framework-hunit, xcb-types

API changes (from Hackage documentation)

Files

• generator/Data/XCB/Python/AST.hs +236/−0
• generator/Data/XCB/Python/Parse.hs +138/−129
• generator/Data/XCB/Python/PyHelpers.hs +43/−117
• generator/xcffibgen.hs +1/−10
• test/GeneratorTests.hs +1/−2
• test/PyHelpersTests.hs +6/−7
• test/generator/event.py +1/−1
• test/generator/no_sequence.py +1/−1
• test/generator/record.py +118/−0
• test/generator/record.xml +33/−0
• xcffib.cabal +35/−37

@@ -0,0 +1,236 @@+{-+ - Copyright 2024 Tycho Andersen+ -+ - This module exists as a small AST to replace language-python, which seems+ - largely unmaintained at this point. This is not really intended to be a+ - complete python grammer, mostly it is just enough to be what xcffib needs to+ - generate its trees.+ -+ - It has no annotations as in language-python, because xcffib doesn't use them.+ -+ - The grammar not complete: it cannot express anything other than empty+ - dictionaries, cannot express sets at all, cannot do async, etc. all because+ - these features of the language are unused by xcffib.+ -+ - The grammar is not sound: it has one "op" class, representing both unary and+ - binary operators.+ -+ - Use at your own risk :)+ -}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+module Data.XCB.Python.AST (+  Expr(..),+  Suite,+  Statement(..),+  Ident,+  Op(..),+  Pretty(..),+  prettyText,+  PseudoExpr(..)+) where++import Prelude hiding ((<>))++import Data.Maybe++import Text.PrettyPrint++type Suite = [Statement]++type Ident = String++-- we don't use that many operations :)+data Op+   = Plus+   | Minus+   | Multiply+   | FloorDivide+   | BinaryAnd+   | ShiftRight+   | ShiftLeft+   | Invert+   | Equality+   | LessThan+   | Modulo+   deriving (Eq, Ord, Show)++data Statement+    = Import+      { import_item :: Ident }+    -- this is only a one level dotted import; other levels are not supported+    | FromImport+      { from_module :: Ident+      , from_item :: Ident+      }+    -- we skip While, For, AsyncFor, etc. because we don't use them+    | Fun+      { fun_name :: Ident+      -- only named variables, no default values, kwargs, etc.+      , fun_args :: [Ident]+      , fun_body :: Suite+      }+    | Decorated+      { decorations :: Ident+      -- only decorated functions/methods are supported+      , fun_name :: Ident+      , fun_args :: [Ident]+      , fun_body :: Suite+      }+    -- skip AsyncFun...+    | Class+      { class_name :: Ident+      -- same as functions, only identifiers allowed+      , class_args :: [Ident]+      , class_body :: Suite+      }+    | Conditional+      { if_cond :: Expr+      , if_body :: Suite+      , else_body :: Suite+      }+    | Assign+      { assign_to :: Expr+      , assign_expr :: Expr+      }+    | AugmentedAssign+      { aug_assign_to :: Expr+      , aug_assign_op :: Op+      , aug_assign_expr :: Expr+      }+    -- skip AnnotatedAssign, Decorated+    | Return+      { return_expr :: Maybe (Expr) }+    -- skip Try, With, AsyncWith+    | Pass {}+    -- skip Break, Continue, Delete+    | StmtExpr+      { stmt_expr :: Expr }+    -- skip Global, NonLocal, Assert, Print, Exec+    | Raise { raise_exception :: Ident }+    deriving (Eq, Ord, Show)++data Expr+    = Var { var :: Ident }+    | Int { int_value :: Int }+    | Bool { bool_value :: Bool }+    | None+    | Strings { strings_strings :: [String] }+    | Call+      { call_fun :: Expr+      , call_args :: [Expr]+      }+    | CondExpr+      { ce_true_branch :: Expr+      , ce_conditon :: Expr+      , ce_false_branch :: Expr+      }+    | Subscript+      { subscriptee :: Expr+      , subscript_expr :: Expr+      }+    | BinaryOp+      { operator :: Op+      , binop_left :: Expr+      , binop_right :: Expr+      }+    | UnaryOp+      { operator :: Op+      , unop_arg :: Expr+      }+    | Dot+      { dot_expr :: Expr+      , dot_attribute :: Ident+      }+    | Tuple { tuple_exprs :: [Expr] }+    | EmptyDict {} -- an empty dictionary+    | Paren { paren_expr :: Expr }+    deriving (Eq, Ord, Show)++prettyText :: Pretty a => a -> String+prettyText = render . pretty++class Pretty a where+    pretty :: a -> Doc++instance Pretty Op where+    pretty Plus = text "+"+    pretty Minus = text "-"+    pretty Multiply = text "*"+    pretty FloorDivide = text "//"+    pretty BinaryAnd = text "&"+    pretty ShiftRight = text ">>"+    pretty ShiftLeft = text "<<"+    pretty Invert = text "~"+    pretty Equality = text "=="+    pretty LessThan = text "<"+    pretty Modulo = text "%"++_reserved :: [String]+_reserved = [ "None"+            , "def"+            , "class"+            , "and"+            , "or"+            ]++-- | Sanitize identifiers.+instance Pretty Ident where+    pretty s | s `elem` _reserved = text $ "_" ++ s+    pretty s | isInt s = text $ "_" ++ s+      where+        isInt str = isJust $ ((maybeRead str) :: Maybe Int)+        maybeRead = fmap fst . listToMaybe . reads+    pretty s = text s++instance Pretty Suite where+    pretty stmts = vcat $ map pretty stmts++indent :: Doc -> Doc+indent = nest 4++instance Pretty Statement where+    pretty (Import item) = text "import" <+> pretty item+    pretty (FromImport source item) = text "from" <+> text source <+> text "import" <+> pretty item+    pretty (Fun name args bod) = text "def" <+> pretty name <> (parens (addCommas args)) <> colon+                                 $+$ indent (pretty bod)+    pretty (Decorated decorator name args bod) = text "@" <> text decorator $+$ pretty (Fun name args bod)+    pretty (Class name [] body) = text "class" <+> pretty name <> colon $+$ indent (pretty body)+    pretty (Class name superclasses body) = text "class" <+> pretty name <> parens (addCommas superclasses) <> colon $+$ indent (pretty body)+    pretty (Conditional cond if_ else_) = text "if" <+> pretty cond <> colon $+$ indent (pretty if_) $+$ pretty else_+    pretty (Assign to expr) = pretty to <+> text "=" <+> pretty expr+    pretty (AugmentedAssign to op expr) = pretty to <+> pretty op <> text "=" <+> pretty expr+    pretty (Return (Just expr)) = text "return" <+> pretty expr+    pretty (Return Nothing) = text "return"+    pretty Pass = text "pass"+    pretty (StmtExpr expr) = pretty expr+    pretty (Raise exc) = text "raise" <+> pretty exc++class PseudoExpr a where+  getExpr :: a -> Expr++instance PseudoExpr String where+  getExpr s = Var s+instance PseudoExpr Expr where+  getExpr = id++addCommas :: PseudoExpr a => [a] -> Doc+addCommas exprs = hsep $ punctuate (text ",") (map (pretty . getExpr) exprs)++instance Pretty Expr where+    pretty (Var v) = pretty v+    pretty (Int i) = integer (toInteger i)+    pretty (Bool True) = text "True"+    pretty (Bool False) = text "False"+    pretty None = text "None"+    pretty (Strings xs) = hcat (map text xs)+    pretty (Call fun args) = pretty fun <> lparen <> addCommas args <> rparen+    pretty (CondExpr trueB cond falseB) = pretty trueB <+> text "if" <+> pretty cond <+> text "else" <+> pretty falseB+    pretty (Subscript thing expr) = pretty thing <> brackets (pretty expr)+    pretty (BinaryOp op left right) = pretty left <+> pretty op <+> pretty right+    pretty (UnaryOp op arg) = pretty op <> pretty arg+    pretty (Dot thing attr) = pretty thing <> text "." <> pretty attr+    pretty (Tuple [expr]) = pretty expr <> comma -- one element still needs to be a tuple+    pretty (Tuple exprs) = addCommas exprs+    pretty EmptyDict = text "{}"+    pretty (Paren expr) = lparen <> pretty expr <> rparen

@@ -34,10 +34,9 @@ import Data.Maybe import Data.XCB.FromXML import Data.XCB.Types as X+import Data.XCB.Python.AST (Expr(..), Op(..), Statement(..), Suite, prettyText) import Data.XCB.Python.PyHelpers -import Language.Python.Common as P- import System.FilePath import System.FilePath.Glob @@ -55,15 +54,15 @@ type TypeInfoMap = M.Map X.Type TypeInfo  data BindingPart =-  Request (Statement ()) (Suite ()) |-  Declaration (Suite ()) |+  Request Statement Suite |+  Declaration Suite |   Noop   deriving (Show) -collectBindings :: [BindingPart] -> (Suite (), Suite ())+collectBindings :: [BindingPart] -> (Suite, Suite) collectBindings = foldr collectR ([], [])   where-    collectR :: BindingPart -> (Suite (), Suite ()) -> (Suite (), Suite ())+    collectR :: BindingPart -> (Suite, Suite) -> (Suite, Suite)     collectR (Request def decl) (defs, decls) = (def : defs, decl ++ decls)     collectR (Declaration decl) (defs, decls) = (defs, decl ++ decls)     collectR Noop x = x@@ -73,25 +72,25 @@   files <- namesMatching $ fp </> "*.xml"   fromFiles files -renderPy :: Suite () -> String+renderPy :: Suite -> String renderPy s = ((intercalate "\n") $ map prettyText s) ++ "\n"  -- | Generate the code for a set of X headers. Note that the code is generated -- in dependency order, NOT in the order you pass them in. Thus, you get a -- string (a suggested filename) along with the python code for that XHeader -- back.-xform :: [XHeader] -> [(String, Suite ())]+xform :: [XHeader] -> [(String, Suite)] xform = map buildPython . dependencyOrder   where-    buildPython :: Tree XHeader -> (String, Suite ())+    buildPython :: Tree XHeader -> (String, Suite)     buildPython forest =       let forest' = (mapM processXHeader $ postOrder forest)           results = evalState forest' baseTypeInfo       in last results     processXHeader :: XHeader-                   -> State TypeInfoMap (String, Suite ())+                   -> State TypeInfoMap (String, Suite)     processXHeader header = do-      let imports = [mkImport "xcffib", mkImport "struct", mkImport "io"]+      let imports = [Import "xcffib", Import "struct", Import "io"]           version = mkVersion header           key = maybeToList $ mkKey header           globals = [mkDict "_events", mkDict "_errors"]@@ -120,20 +119,20 @@     postOrder (Node e cs) = (concat $ map postOrder cs) ++ [e]  -mkAddExt :: XHeader -> Statement ()+mkAddExt :: XHeader -> Statement mkAddExt (xheader_header -> "xproto") =-  flip StmtExpr () $ mkCall "xcffib._add_core" [ mkName "xprotoExtension"-                                               , mkName "Setup"-                                               , mkName "_events"-                                               , mkName "_errors"-                                               ]+  StmtExpr $ mkCall "xcffib._add_core" [ mkName "xprotoExtension"+                                       , mkName "Setup"+                                       , mkName "_events"+                                       , mkName "_errors"+                                       ] mkAddExt header =   let name = xheader_header header-  in flip StmtExpr () $ mkCall "xcffib._add_ext" [ mkName "key"-                                                 , mkName (name ++ "Extension")-                                                 , mkName "_events"-                                                 , mkName "_errors"-                                                 ]+  in StmtExpr $ mkCall "xcffib._add_ext" [ mkName "key"+                                         , mkName (name ++ "Extension")+                                         , mkName "_events"+                                         , mkName "_errors"+                                         ]  -- | Information on basic X types. baseTypeInfo :: TypeInfoMap@@ -189,26 +188,26 @@      lang = many $ (,) <$> optional decimal <*> (satisfy $ inClass $ M.keys sizeM) -xBinopToPyOp :: X.Binop -> P.Op ()-xBinopToPyOp X.Add = P.Plus ()-xBinopToPyOp X.Sub = P.Minus ()-xBinopToPyOp X.Mult = P.Multiply ()-xBinopToPyOp X.Div = P.FloorDivide ()-xBinopToPyOp X.And = P.BinaryAnd ()-xBinopToPyOp X.RShift = P.ShiftRight ()+xBinopToPyOp :: X.Binop -> Op+xBinopToPyOp X.Add = Plus+xBinopToPyOp X.Sub = Minus+xBinopToPyOp X.Mult = Multiply+xBinopToPyOp X.Div = FloorDivide+xBinopToPyOp X.And = BinaryAnd+xBinopToPyOp X.RShift = ShiftRight -xUnopToPyOp :: X.Unop -> P.Op ()-xUnopToPyOp X.Complement = P.Invert ()+xUnopToPyOp :: X.Unop -> Op+xUnopToPyOp X.Complement = Invert -xExpressionToNestedPyExpr :: (String -> String) -> XExpression -> Expr ()+xExpressionToNestedPyExpr :: (String -> String) -> XExpression -> Expr xExpressionToNestedPyExpr acc (Op o e1 e2) =-  Paren (xExpressionToPyExpr acc (Op o e1 e2)) ()+  Paren (xExpressionToPyExpr acc (Op o e1 e2)) xExpressionToNestedPyExpr acc xexpr =   xExpressionToPyExpr acc xexpr -xExpressionToPyExpr :: (String -> String) -> XExpression -> Expr ()-xExpressionToPyExpr _ (Value i) = mkInt i-xExpressionToPyExpr _ (Bit i) = BinaryOp (ShiftLeft ()) (mkInt 1) (mkInt i) ()+xExpressionToPyExpr :: (String -> String) -> XExpression -> Expr+xExpressionToPyExpr _ (Value i) = Int i+xExpressionToPyExpr _ (Bit i) = BinaryOp ShiftLeft (Int 1) (Int i) xExpressionToPyExpr acc (FieldRef n) = mkName $ acc n xExpressionToPyExpr _ (EnumRef (UnQualType enum) n) = mkName $ enum ++ "." ++ n -- Currently xcb only uses unqualified types, not sure how qualtype should behave@@ -221,11 +220,11 @@   let o' = xBinopToPyOp o       e1' = xExpressionToNestedPyExpr acc e1       e2' = xExpressionToNestedPyExpr acc e2-  in BinaryOp o' e1' e2' ()+  in BinaryOp o' e1' e2' xExpressionToPyExpr acc (Unop o e) =   let o' = xUnopToPyOp o       e' = xExpressionToNestedPyExpr acc e-  in Paren (UnaryOp o' e' ()) ()+  in Paren (UnaryOp o' e') xExpressionToPyExpr acc (ParamRef n) =     if n == "num_axes"     then mkName $ acc n@@ -251,13 +250,13 @@ getConst (PopCount e) = fmap popCount $ getConst e getConst _ = Nothing -xEnumElemsToPyEnum :: (String -> String) -> [XEnumElem] -> [(String, Expr ())]+xEnumElemsToPyEnum :: (String -> String) -> [XEnumElem] -> [(String, Expr)] xEnumElemsToPyEnum accessor membs = reverse $ conv membs [] [0..]   where     exprConv = xExpressionToPyExpr accessor-    conv :: [XEnumElem] -> [(String, Expr ())] -> [Int] -> [(String, Expr ())]+    conv :: [XEnumElem] -> [(String, Expr)] -> [Int] -> [(String, Expr)]     conv ((EnumElem name expr) : els) acc is =-      let expr' = fromMaybe (mkInt (head is)) $ fmap exprConv expr+      let expr' = fromMaybe (Int (head is)) $ fmap exprConv expr           is' = dropWhile (<= (fromIntegral (int_value expr'))) is           acc' = (name, expr') : acc       in conv els acc' is'@@ -283,13 +282,13 @@ mkPad 1 = "x" mkPad i = (show i) ++ "x" -structElemToPyUnpack :: Expr ()+structElemToPyUnpack :: Expr                      -> String                      -> TypeInfoMap                      -> GenStructElem Type                      -> Either (Maybe String, String)-                               (String, Either (Expr (), Expr ())-                                               ([(Expr (), [GenStructElem Type])]), Maybe Int)+                               (String, Either (Expr, Expr)+                                               ([(Expr, [GenStructElem Type])]), Maybe Int) structElemToPyUnpack _ _ _ (Pad PadBytes i) = Left (Nothing, mkPad i) structElemToPyUnpack _ _ _ (Pad PadAlignment _) = Left (Nothing, "") @@ -305,23 +304,27 @@       switch = map (mkSwitch cmp) bitcases   in Right (name, Right switch, Nothing)     where-      mkSwitch :: Expr ()+      mkSwitch :: Expr                -> BitCase-               -> (Expr (), [GenStructElem Type])+               -> (Expr, [GenStructElem Type])       mkSwitch cmp (BitCase Nothing bcCmp _ elems) =-        let cmpVal = xExpressionToPyExpr id bcCmp-            equality = BinaryOp (P.BinaryAnd ()) cmp cmpVal ()+        -- note: head here and below is a hack; i am not exactly sure the+        -- semantics of the multi-expression BitCase, since it's "fake" and+        -- "encoded only once" see b3b5e029e7ad ("XKB: Fix GetKbdByName") for+        -- details. needs some wiresniffing to investigate.+        let cmpVal = xExpressionToPyExpr id (head bcCmp)+            equality = BinaryOp BinaryAnd cmp cmpVal         in (equality, elems)        mkSwitch cmp (BitCase (Just _) bcCmp _ elems) =-        let cmpVal = xExpressionToPyExpr id bcCmp-            equality = BinaryOp (P.Equality ()) cmp cmpVal ()+        let cmpVal = xExpressionToPyExpr id (head bcCmp)+            equality = BinaryOp Equality cmp cmpVal         in (equality, elems)  -- The enum field is mostly for user information, so we ignore it. structElemToPyUnpack unpacker ext m (X.List n typ len _) =   let attr = ((++) "self.")-      len' = fromMaybe pyNone $ fmap (xExpressionToPyExpr attr) len+      len' = fromMaybe None $ fmap (xExpressionToPyExpr attr) len       cons = case m M.! typ of                BaseType c -> mkStr c                CompositeType tExt c | ext /= tExt -> mkName $ tExt ++ "." ++ c@@ -355,8 +358,8 @@                    -> TypeInfoMap                    -> (String -> String)                    -> GenStructElem Type-                   -> Either (Maybe String, String) [(String, Either (Maybe (Expr ()))-                                                                     [(Expr (), [GenStructElem Type])]+                   -> Either (Maybe String, String) [(String, Either (Maybe (Expr))+                                                                     [(Expr, [GenStructElem Type])]                                                     )] structElemToPyPack _ _ _ (Pad _ i) = Left (Nothing, mkPad i) -- TODO: implement these?@@ -369,25 +372,26 @@       elems = map (mkSwitch cmp) bitcases   in Right $ [(name, Right elems)]     where-      mkSwitch :: Expr ()+      mkSwitch :: Expr                -> BitCase-               -> (Expr (), [GenStructElem Type])+               -> (Expr, [GenStructElem Type])       mkSwitch cmp (BitCase _ bcCmp _ elems') =-        let cmpVal = xExpressionToPyExpr accessor bcCmp-            equality = BinaryOp (P.BinaryAnd ()) cmp cmpVal ()+        -- see comment above about head for BitCase+        let cmpVal = xExpressionToPyExpr accessor (head bcCmp)+            equality = BinaryOp BinaryAnd cmp cmpVal         in (equality, elems') structElemToPyPack ext m accessor (SField n typ _ _) =   let name = accessor n   in case m M.! typ of        BaseType c -> Left (Just name, c)        CompositeType tExt typNam ->-         let cond = mkCall "hasattr" [mkArg name, ArgExpr (mkStr "pack") ()]-             trueB = mkCall (name ++ ".pack") noArgs+         let cond = mkCall "hasattr" [mkName name, (mkStr "pack")]+             trueB = mkCall (name ++ ".pack") []              typNam' = if ext == tExt then typNam else tExt ++ "." ++ typNam-             synthetic = mkCall (typNam' ++ ".synthetic") [mkArg ("*" ++ name)]-             falseB = mkCall (mkDot synthetic "pack") noArgs+             synthetic = mkCall (typNam' ++ ".synthetic") [mkName ("*" ++ name)]+             falseB = mkCall (mkDot synthetic "pack") []          in Right $ [(name-                    , Left (Just (CondExpr trueB cond falseB ()))+                    , Left (Just (CondExpr trueB cond falseB))                     )] -- TODO: assert values are in enum? structElemToPyPack ext m accessor (X.List n typ expr _) =@@ -421,7 +425,7 @@                                                                 ]))                              )]        CompositeType _ _ -> Right $ [(name'-                                    , Left (Just (mkCall (mkDot e "pack") noArgs))+                                    , Left (Just (mkCall (mkDot e "pack") []))                                     )]  -- As near as I can tell here the padding param is unused.@@ -436,8 +440,8 @@     CompositeType _ _ -> error (       "ValueParams other than CARD{16,32} not allowed.") -buf :: Suite ()-buf = [mkAssign "buf" (mkCall "io.BytesIO" noArgs)]+buf :: Suite+buf = [mkAssign "buf" (mkCall "io.BytesIO" [])]  mkPackStmts :: String             -> String@@ -445,7 +449,7 @@             -> (String -> String)             -> String             -> [GenStructElem Type]-            -> ([String], Suite ())+            -> ([String], Suite) mkPackStmts ext name m accessor prefix membs =   let packF = structElemToPyPack ext m accessor       (toPack, stmts) = span EC.isLeft $ map packF membs@@ -471,30 +475,30 @@       packStr = addStructData prefix $ intercalate "" keys       write = mkCall "buf.write" [mkCall "struct.pack"                                          (mkStr ('=' : packStr) : (map mkName args))]-      writeStmt = if length packStr > 0 then [StmtExpr write ()] else []+      writeStmt = if length packStr > 0 then [StmtExpr write] else []   in (args ++ listNames', writeStmt ++ listWrites)     where       mkWrites :: String-               -> Either (Maybe (Expr ()))-                         [(Expr (), [GenStructElem Type])]-               -> Suite ()+               -> Either (Maybe (Expr))+                         [(Expr, [GenStructElem Type])]+               -> Suite       mkWrites _ (Left Nothing) = []       mkWrites _ (Left (Just expr)) = [mkListWrite expr]       mkWrites valueList (Right condList) =         let (conds, exprs) = unzip condList             (names, stmts) = unzip $ map (mkPackStmts ext name m accessor "") exprs-        in map (\(x, y, z) -> Conditional [(x, map (mkPop valueList) y ++ z)] [] ()) $ zip3 conds names stmts+        in map (\(x, y, z) -> Conditional x (map (mkPop valueList) y ++ z) []) $ zip3 conds names stmts -      mkListWrite :: Expr ()-                  -> Statement ()-      mkListWrite expr' = flip StmtExpr () . mkCall "buf.write" $ (: []) expr'+      mkListWrite :: Expr+                  -> Statement+      mkListWrite expr' = StmtExpr . mkCall "buf.write" $ (: []) expr'        mkPop :: String             -> String-            -> Statement ()+            -> Statement       mkPop toPop n =-        let pop = mkCall (mkDot toPop "pop") [mkInt 0]-        in if null n then StmtExpr pop () else mkAssign n pop+        let pop = mkCall (mkDot toPop "pop") [Int 0]+        in if null n then StmtExpr pop else mkAssign n pop        mkBasePack (Nothing, "") = []       mkBasePack (n, c) =@@ -507,28 +511,29 @@              -> Maybe (String, Int)              -> [GenStructElem Type]              -> Maybe Int-             -> Statement ()+             -> Statement mkPackMethod ext name m prefixAndOp structElems minLen =   let accessor = ((++) "self.")       (prefix, op) = case prefixAndOp of                         Just ('x' : rest, i) ->-                          let packOpcode = mkCall "struct.pack" [mkStr "=B", mkInt i]+                          let packOpcode = mkCall "struct.pack" [mkStr "=B", Int i]                               write = mkCall "buf.write" [packOpcode]-                          in (rest, [StmtExpr write ()])+                          in (rest, [StmtExpr write])                         Just (rest, _) -> error ("internal API error: " ++ show rest)                         Nothing -> ("", [])       (_, packStmts) = mkPackStmts ext name m accessor prefix structElems       extend = concat $ do         len <- maybeToList minLen         let bufLen = mkName "buf_len"-            bufLenAssign = mkAssign bufLen $ mkCall "len" [mkCall "buf.getvalue" noArgs]-            test = (BinaryOp (LessThan ()) bufLen (mkInt len)) ()-            bufWriteLen = Paren (BinaryOp (Minus ()) (mkInt 32) bufLen ()) ()-            extra = mkCall "struct.pack" [repeatStr "x" bufWriteLen]-            writeExtra = [StmtExpr (mkCall "buf.write" [extra]) ()]+            bufLenAssign = mkAssign bufLen $ mkCall "len" [mkCall "buf.getvalue" []]+            test = (BinaryOp LessThan bufLen (Int len))+            bufWriteLen = Paren (BinaryOp Minus (Int 32) bufLen)+            extraPackFmt = Paren (BinaryOp Modulo (mkStr "%dx") bufWriteLen)+            extra = mkCall "struct.pack" [extraPackFmt]+            writeExtra = [StmtExpr (mkCall "buf.write" [extra])]         return $ [bufLenAssign, mkIf test writeExtra]-      ret = [mkReturn $ mkCall "buf.getvalue" noArgs]-  in mkMethod "pack" (mkParams ["self"]) $ buf ++ op ++ packStmts ++ extend ++ ret+      ret = [mkReturn $ mkCall "buf.getvalue" []]+  in mkMethod "pack" ["self"] $ buf ++ op ++ packStmts ++ extend ++ ret  data StructUnpackState = StructUnpackState {   -- | stNeedsPad is whether or not a type_pad() is needed. As near@@ -552,14 +557,14 @@                     -> String                     -> TypeInfoMap                     -> [GenStructElem Type]-                    -> (Suite (), Maybe Int)+                    -> (Suite, Maybe Int) mkStructStyleUnpack prefix ext m membs =   let unpacked = map (structElemToPyUnpack (mkName "unpacker") ext m) membs       initial = StructUnpackState False [] prefix       (_, unpackStmts, size) = evalState (mkUnpackStmts unpacked) initial       base = [mkAssign "base" $ mkName "unpacker.offset"]       bufsize =-        let rhs = BinaryOp (Minus ()) (mkName "unpacker.offset") (mkName "base") ()+        let rhs = BinaryOp Minus (mkName "unpacker.offset") (mkName "base")         in [mkAssign (mkAttr "bufsize") rhs]       statements = base ++ unpackStmts ++ bufsize   in (statements, size)@@ -568,9 +573,9 @@       -- Apparently you only type_pad before unpacking Structs or Lists, never       -- base types.       mkUnpackStmts :: [Either (Maybe String, String)-                               (String, Either (Expr (), Expr ())-                                               ([(Expr (), [GenStructElem Type])]), Maybe Int)]-                    -> State StructUnpackState ([String], Suite (), Maybe Int)+                               (String, Either (Expr, Expr)+                                               ([(Expr, [GenStructElem Type])]), Maybe Int)]+                    -> State StructUnpackState ([String], Suite, Maybe Int)        mkUnpackStmts [] = flushAcc @@ -601,11 +606,11 @@                )           where             mkUnpackListOrSwitch :: String-                                 -> Either (Expr (), Expr ())-                                           ([(Expr (), [GenStructElem Type])])+                                 -> Either (Expr, Expr)+                                           ([(Expr, [GenStructElem Type])])                                  -> Bool                                  -> StructUnpackState-                                 -> Suite ()+                                 -> Suite             mkUnpackListOrSwitch name' (Left (list, cons)) needsPad _ =               let pad = if needsPad                         then [typePad cons]@@ -614,17 +619,17 @@             mkUnpackListOrSwitch _ (Right switchList) _ st' =               let (conds, elems) = unzip switchList                   stmts = map (mkUnpackSwitchElems st') elems-              in map (\x -> Conditional [x] [] ()) $ zip conds stmts+              in map (\(cond,body) -> Conditional cond body []) $ zip conds stmts              mkUnpackSwitchElems :: StructUnpackState                                 -> [GenStructElem Type]-                                -> Suite ()+                                -> Suite             mkUnpackSwitchElems st' elems' =               let unpacked' = map (structElemToPyUnpack (mkName "unpacker") ext m) elems'                   (_, stmts', _) = evalState (mkUnpackStmts unpacked') st'               in stmts' -      flushAcc :: State StructUnpackState ([String], Suite (), Maybe Int)+      flushAcc :: State StructUnpackState ([String], Suite, Maybe Int)       flushAcc = do         StructUnpackState needsPad args keys <- get         let size = calcsize keys@@ -632,7 +637,7 @@         put $ StructUnpackState needsPad [] ""         return (args, assign, Just size) -      typePad e = StmtExpr (mkCall "unpacker.pad" [e]) ()+      typePad e = StmtExpr (mkCall "unpacker.pad" [e])  -- | Given a (qualified) type name and a target type, generate a TypeInfoMap -- updater.@@ -643,16 +648,15 @@                       ]   in M.union m m' -mkSyntheticMethod :: [GenStructElem Type] -> [Statement ()]+mkSyntheticMethod :: [GenStructElem Type] -> [Statement] mkSyntheticMethod membs = do   let names = catMaybes $ map getName membs-      args = mkParams $ "cls" : names+      args = "cls" : names       self = mkAssign "self" $ mkCall (mkDot "cls" "__new__") [mkName "cls"]       body = map assign names       ret = mkReturn $ mkName "self"-      synthetic = mkMethod "synthetic" args $ (self : body) ++ [ret]-      classmethod = Decorator [ident "classmethod"] noArgs ()-  if null names then [] else [Decorated [classmethod] synthetic ()]+      synthetic = Decorated "classmethod" "synthetic" args $ (self : body) ++ [ret]+  if null names then [] else [synthetic]     where       getName :: GenStructElem Type -> Maybe String       getName (Pad _ _) = Nothing@@ -665,7 +669,7 @@       getName (Fd n) = Just n       getName (Length _ _) = Nothing -      assign :: String -> Statement ()+      assign :: String -> Statement       assign n = mkAssign (mkDot "self" n) $ mkName n  processXDecl :: String@@ -689,7 +693,7 @@       synthetic = mkSyntheticMethod membs       fixedLength = maybeToList $ do         theLen <- len-        let rhs = mkInt theLen+        let rhs = Int theLen         return $ mkAssign "fixed_size" rhs   modify $ mkModify ext n (CompositeType ext n)   return $ Declaration [mkXClass n "xcffib.Struct" False statements (pack : fixedLength ++ synthetic)]@@ -736,18 +740,20 @@         return [theReply, cookie]        hasReply = if length replyDecl > 0-                 then [ArgExpr (mkName cookieName) ()]+                 then [mkName cookieName]                  else []-      isChecked = pyTruth $ isJust reply-      argChecked = ArgKeyword (ident "is_checked") (mkName "is_checked") ()-      checkedParam = Param (ident "is_checked") Nothing (Just isChecked) ()-      allArgs = (mkParams $ "self" : (filter (not . null) args)) ++ [checkedParam]-      mkArg' = flip ArgExpr ()-      ret = mkReturn $ mkCall "self.send_request" ((map mkArg' [ mkInt opcode-                                                               , mkName "buf"-                                                               ])-                                                               ++ hasReply-                                                               ++ [argChecked])+      -- another hack for not supporting named parameters+      -- argChecked = ArgKeyword (ident "is_checked") (mkName "is_checked")+      argChecked = mkName ("is_checked=is_checked")+      -- a hack to not have to support separate params/exprs+      -- checkedParam = Param (ident "is_checked") Nothing (Just isChecked)+      checkedParam = "is_checked=" ++ (show (isJust reply))+      allArgs = ("self" : (filter (not . null) args)) ++ [checkedParam]+      ret = mkReturn $ mkCall "self.send_request" ([ Int opcode+                                                   , mkName "buf"+                                                   ]+                                                   ++ hasReply+                                                   ++ [argChecked])       requestBody = buf ++ packStmts ++ [ret]       request = mkMethod name allArgs requestBody   return $ Request request replyDecl@@ -756,11 +762,9 @@   let unpackF = structElemToPyUnpack unpackerCopy ext m       (fields, listInfo) = span EC.isLeft $ map unpackF membs       toUnpack = concat $ map (mkUnionUnpack . EC.fromLeft') fields-      listInfo' = map (either mkBaseUnpack id) listInfo-      (names, listOrSwitches, _) = unzip3 listInfo'-      (exprs, _) = unzip $ map EC.fromLeft' listOrSwitches-      lists = map (uncurry mkAssign) $ zip (map mkAttr names) exprs-      initMethod = lists ++ toUnpack+      initMethod = if any EC.isLeft listInfo+                   then [notImplemented]+                   else (mkListUnpack listInfo) ++ toUnpack       -- Here, we only want to pack the first member of the union, since every       -- member is the same data and we don't want to repeatedly pack it.       pack = mkPackMethod ext name m Nothing [head membs] Nothing@@ -768,13 +772,18 @@   modify $ mkModify ext name (CompositeType ext name)   return $ Declaration decl   where-    unpackerCopy = mkCall "unpacker.copy" noArgs+    unpackerCopy = mkCall "unpacker.copy" []     mkUnionUnpack :: (Maybe String, String)-                  -> Suite ()+                  -> Suite     mkUnionUnpack (n, typ) =       mkUnpackFrom unpackerCopy (maybeToList n) typ -    mkBaseUnpack _ = error "xcffib: trailing base types unpack not implemented"+    mkListUnpack listInfo =+      let listInfo' = map EC.fromRight' listInfo+          (names, listOrSwitches, _) = unzip3 listInfo'+          (exprs, _) = unzip $ map EC.fromLeft' listOrSwitches+          lists = map (uncurry mkAssign) $ zip (map mkAttr names) exprs+      in lists  processXDecl ext (XidUnion name _) =   -- These are always unions of only XIDs.@@ -796,16 +805,16 @@   modify $ mkModify ext name (CompositeType ext name)   return $ Declaration $ [mkXClass name "xcffib.Buffer" False [] []] -mkVersion :: XHeader -> Suite ()+mkVersion :: XHeader -> Suite mkVersion header =   let major = ver "MAJOR_VERSION" (xheader_major_version header)       minor = ver "MINOR_VERSION" (xheader_minor_version header)   in major ++ minor   where-    ver :: String -> Maybe Int -> Suite ()-    ver target i = maybeToList $ fmap (\x -> mkAssign target (mkInt x)) i+    ver :: String -> Maybe Int -> Suite+    ver target i = maybeToList $ fmap (\x -> mkAssign target (Int x)) i -mkKey :: XHeader -> Maybe (Statement ())+mkKey :: XHeader -> Maybe (Statement) mkKey header = do   name <- xheader_xname header   let call = mkCall "xcffib.ExtensionKey" [mkStr name]

@@ -15,13 +15,9 @@  -} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module Data.XCB.Python.PyHelpers (-  mkImport,   mkRelImport,-  mkInt,   mkAssign,   mkCall,-  noArgs,-  mkArg,   mkEnum,   mkName,   mkDot,@@ -36,113 +32,52 @@   mkDictUpdate,   mkMethod,   mkReturn,-  pyTruth,-  mkParams,-  ident,-  pyNone,   mkIf,-  repeatStr+  notImplemented   ) where  import Data.List.Split-import Data.Maybe -import Language.Python.Common--_reserved :: [String]-_reserved = [ "None"-            , "def"-            , "class"-            , "and"-            , "or"-            ]--class PseudoExpr a where-  getExpr :: a -> Expr ()--instance PseudoExpr String where-  getExpr s = mkName s-instance PseudoExpr (Expr ()) where-  getExpr = id---- | Create and sanatize a python identifier.-ident :: String -> Ident ()-ident s | s `elem` _reserved = Ident ("_" ++ s) ()-ident s | isInt s = Ident ("_" ++ s) ()-  where-    isInt str = isJust $ ((maybeRead str) :: Maybe Int)-    maybeRead = fmap fst . listToMaybe . reads-ident s = Ident s ()---- Make a DottedName out of a string like "foo.bar" for use in imports.-mkDottedName :: String -> DottedName ()-mkDottedName = map ident . splitOn "."--mkVar :: String -> Expr ()-mkVar name = Var (ident name) ()+import Data.XCB.Python.AST (Expr(..), Op(..), Statement(..), Suite, Ident, PseudoExpr, getExpr)  -- | Make an Expr out of a string like "foo.bar" describing the name.-mkName :: String -> Expr ()+mkName :: String -> Expr mkName s =   let strings = splitOn "." s-  in foldl mkDot (mkVar $ head strings) (tail strings)+  in foldl mkDot (Var $ head strings) (tail strings) -mkDot :: PseudoExpr a => a -> String -> Expr ()-mkDot e1 attr = Dot (getExpr e1) (ident attr) ()+mkDot :: PseudoExpr a => a -> String -> Expr+mkDot e1 attr = Dot (getExpr e1) attr  -- | Make an attribute access, i.e. self.<string>.-mkAttr :: String -> Expr ()+mkAttr :: String -> Expr mkAttr s = mkName ("self." ++ s) -mkImport :: String -> Statement ()-mkImport name = Import [ImportItem (mkDottedName name) Nothing ()] ()--mkRelImport :: String -> Statement ()-mkRelImport name = FromImport (ImportRelative 1 Nothing ()) (FromItems [FromItem (ident name) Nothing ()] ()) ()--mkInt :: Int -> Expr ()-mkInt i = Int (toInteger i) (show i) ()--mkAssign :: PseudoExpr a => a -> Expr () -> Statement ()-mkAssign name expr = Assign [getExpr name] expr ()--mkIncr :: String -> Expr () -> Statement ()-mkIncr name expr = AugmentedAssign (mkName name) (PlusAssign ()) expr ()--class PseudoArgument a where-  getArgument :: a -> Argument ()+mkRelImport :: String -> Statement+mkRelImport name = FromImport "." name -instance PseudoArgument (Expr ()) where-  getArgument p = ArgExpr p ()-instance PseudoArgument (Argument ()) where-  getArgument = id+mkAssign :: PseudoExpr a => a -> Expr -> Statement+mkAssign name expr = Assign (getExpr name) expr -mkCall :: (PseudoExpr a, PseudoArgument b) => a -> [b] -> Expr ()-mkCall name args = Call (getExpr name) (map getArgument args) ()+mkIncr :: String -> Expr -> Statement+mkIncr name expr = AugmentedAssign (mkName name) Plus expr -noArgs :: [Argument ()]-noArgs = []+mkCall :: PseudoExpr a => a -> [Expr] -> Expr+mkCall name args = Call (getExpr name) args -mkEnum :: String -> [(String, Expr ())] -> Statement ()+mkEnum :: String -> [(String, Expr)] -> Statement mkEnum cname values =   let body = map (uncurry mkAssign) values-  in Class (Ident cname ()) [] body ()--mkParams :: [String] -> [Parameter ()]-mkParams = map (\x -> Param (ident x) Nothing Nothing ())--mkArg :: String -> Argument ()-mkArg n = ArgExpr (mkName n) ()+  in Class cname [] body -mkXClass :: String -> String -> Bool -> Suite () -> Suite () -> Statement ()+mkXClass :: String -> String -> Bool -> Suite -> Suite -> Statement mkXClass clazz superclazz False [] [] = mkEmptyClass clazz superclazz mkXClass clazz superclazz xge constructor methods =   let args = [ "self", "unpacker" ]       super = mkCall (superclazz ++ ".__init__") $ map mkName args-      body = eventToUnpacker : (StmtExpr super ()) : constructor-      initParams = mkParams args+      body = eventToUnpacker : (StmtExpr super) : constructor       xgeexp = mkAssign "xge" (if xge then (mkName "True") else (mkName "False"))-      initMethod = Fun (ident "__init__") initParams Nothing body ()+      initMethod = Fun "__init__" args body   in mkClass clazz superclazz $ xgeexp : initMethod : methods      where@@ -151,55 +86,46 @@       -- passed directly to __init__. Since we don't keep track of the       -- underlying buffers after the event is created, we have to re-pack       -- things so they can be unpacked again.-      eventToUnpacker :: Statement ()+      eventToUnpacker :: Statement       eventToUnpacker = let newUnpacker = mkAssign "unpacker" (mkCall "xcffib.MemoryUnpacker"-                                                              [mkCall "unpacker.pack" noArgs])+                                                              [mkCall "unpacker.pack" []])                             cond = mkCall "isinstance" [mkName "unpacker", mkName "xcffib.Protobj"]                         in mkIf cond [newUnpacker]  -mkEmptyClass :: String -> String -> Statement ()-mkEmptyClass clazz superclazz = mkClass clazz superclazz [Pass ()]--mkClass :: String -> String -> Suite () -> Statement ()-mkClass clazz superclazz body = Class (ident clazz) [mkArg superclazz] body ()+mkEmptyClass :: String -> String -> Statement+mkEmptyClass clazz superclazz = mkClass clazz superclazz [Pass] -mkStr :: String -> Expr ()-mkStr s = Strings ["\"", s, "\""] ()+mkClass :: String -> String -> Suite -> Statement+mkClass clazz superclazz body = Class clazz [superclazz] body -mkTuple :: [Expr ()] -> Expr ()-mkTuple = flip Tuple ()+mkStr :: String -> Expr+mkStr s = Strings ["\"", s, "\""] -mkUnpackFrom :: PseudoExpr a => a -> [String] -> String -> Suite ()+mkUnpackFrom :: PseudoExpr a => a -> [String] -> String -> Suite mkUnpackFrom unpacker names packs =-  let lhs = mkTuple $ map mkAttr names+  let lhs = Tuple $ map mkAttr names       -- Don't spam with this default arg unless it is really necessary.       unpackF = mkDot unpacker "unpack"       rhs = mkCall unpackF [mkStr packs]-      stmt = if length names > 0 then mkAssign lhs rhs else StmtExpr rhs ()+      stmt = if length names > 0 then mkAssign lhs rhs else StmtExpr rhs   in if length packs > 0 then [stmt] else [] -mkDict :: String -> Statement ()-mkDict name = mkAssign name (Dictionary [] ())+mkDict :: String -> Statement+mkDict name = mkAssign name EmptyDict -mkDictUpdate :: String -> Int -> String -> Statement ()+mkDictUpdate :: String -> Int -> String -> Statement mkDictUpdate dict key value =-  mkAssign (Subscript (mkName dict) (mkInt key) ()) (mkName value)--mkMethod :: String -> [Parameter ()] -> Suite () -> Statement ()-mkMethod name args body = Fun (ident name) args Nothing body ()--mkReturn :: Expr () -> Statement ()-mkReturn = flip Return () . Just+  mkAssign (Subscript (mkName dict) (Int key)) (mkName value) -pyTruth :: Bool -> Expr ()-pyTruth = flip Bool ()+mkMethod :: String -> [Ident] -> Suite -> Statement+mkMethod name args body = Fun name args body -pyNone :: Expr ()-pyNone = None ()+mkReturn :: Expr -> Statement+mkReturn = Return . Just -mkIf :: Expr () -> Suite () -> Statement ()-mkIf e s = Conditional [(e, s)] [] ()+mkIf :: Expr -> Suite -> Statement+mkIf e s = Conditional e s [] -repeatStr :: String -> Expr () -> Expr ()-repeatStr s i = BinaryOp (Multiply ()) (mkStr s) i ()+notImplemented :: Statement+notImplemented = Raise "xcffib.XcffibNotImplemented"

@@ -15,8 +15,6 @@  -} module Main where --import Data.XCB.Types import Data.XCB.Python.Parse  import Options.Applicative@@ -39,18 +37,11 @@        <> metavar "DIR"        <> help "Output directory for generated python.") --- Headers we can't emit right now. Obviously we want to get rid of this :-)-badHeaders :: [String]-badHeaders = [ "xkb"-             , "xprint"-             ]- run :: Xcffibgen -> IO () run (Xcffibgen inp out) = do   headers <- parseXHeaders inp-  let headers' = filter (flip notElem badHeaders . xheader_header) headers   createDirectoryIfMissing True out-  sequence_ $ map processFile $ xform headers'+  sequence_ $ map processFile $ xform headers   where     processFile (fname, suite) = do       putStrLn fname

@@ -15,8 +15,7 @@  -} module Main (main) where -import Language.Python.Common-+import Data.XCB.Python.AST import Data.XCB.Python.Parse import Data.XCB.FromXML import Data.XCB.Types

@@ -15,9 +15,8 @@  -} module Main (main) where -import Language.Python.Common- import Data.XCB.Python.PyHelpers+import Data.XCB.Python.AST  import Test.Framework ( defaultMain, Test ) import Test.Framework.Providers.HUnit@@ -29,15 +28,15 @@ testMkName :: Test testMkName =   let result = mkName "self.foo.bar"-      expected = (Dot (Dot (Var (Ident "self" ()) ())-                           (Ident "foo" ()) ())-                      (Ident "bar" ()) ())+      expected = (Dot (Dot (Var "self")+                           "foo")+                      "bar")   in mkTest "testMkName" expected result  testReserves :: Test testReserves =-  let result = mkName "None"-      expected = (Var (Ident "_None" ()) ())+  let result = prettyText (mkName "None")+      expected = "_None"   in mkTest "testReserves" expected result  main :: IO ()

@@ -21,7 +21,7 @@         buf.write(struct.pack("=B2xIIIIHHHHHH", self.rotation, self.timestamp, self.config_timestamp, self.root, self.request_window, self.sizeID, self.subpixel_order, self.width, self.height, self.mwidth, self.mheight))         buf_len = len(buf.getvalue())         if buf_len < 32:-            buf.write(struct.pack("x" * (32 - buf_len)))+            buf.write(struct.pack(("%dx" % (32 - buf_len))))         return buf.getvalue()     @classmethod     def synthetic(cls, rotation, timestamp, config_timestamp, root, request_window, sizeID, subpixel_order, width, height, mwidth, mheight):

@@ -19,7 +19,7 @@         buf.write(xcffib.pack_list(self.keys, "B"))         buf_len = len(buf.getvalue())         if buf_len < 32:-            buf.write(struct.pack("x" * (32 - buf_len)))+            buf.write(struct.pack(("%dx" % (32 - buf_len))))         return buf.getvalue()     @classmethod     def synthetic(cls, keys):

@@ -0,0 +1,118 @@+import xcffib+import struct+import io+MAJOR_VERSION = 1+MINOR_VERSION = 13+key = xcffib.ExtensionKey("RECORD")+_events = {}+_errors = {}+class Range8(xcffib.Struct):+    xge = False+    def __init__(self, unpacker):+        if isinstance(unpacker, xcffib.Protobj):+            unpacker = xcffib.MemoryUnpacker(unpacker.pack())+        xcffib.Struct.__init__(self, unpacker)+        base = unpacker.offset+        self.first, self.last = unpacker.unpack("BB")+        self.bufsize = unpacker.offset - base+    def pack(self):+        buf = io.BytesIO()+        buf.write(struct.pack("=BB", self.first, self.last))+        return buf.getvalue()+    fixed_size = 2+    @classmethod+    def synthetic(cls, first, last):+        self = cls.__new__(cls)+        self.first = first+        self.last = last+        return self+class Range16(xcffib.Struct):+    xge = False+    def __init__(self, unpacker):+        if isinstance(unpacker, xcffib.Protobj):+            unpacker = xcffib.MemoryUnpacker(unpacker.pack())+        xcffib.Struct.__init__(self, unpacker)+        base = unpacker.offset+        self.first, self.last = unpacker.unpack("HH")+        self.bufsize = unpacker.offset - base+    def pack(self):+        buf = io.BytesIO()+        buf.write(struct.pack("=HH", self.first, self.last))+        return buf.getvalue()+    fixed_size = 4+    @classmethod+    def synthetic(cls, first, last):+        self = cls.__new__(cls)+        self.first = first+        self.last = last+        return self+class ExtRange(xcffib.Struct):+    xge = False+    def __init__(self, unpacker):+        if isinstance(unpacker, xcffib.Protobj):+            unpacker = xcffib.MemoryUnpacker(unpacker.pack())+        xcffib.Struct.__init__(self, unpacker)+        base = unpacker.offset+        self.major = Range8(unpacker)+        unpacker.pad(Range16)+        self.minor = Range16(unpacker)+        self.bufsize = unpacker.offset - base+    def pack(self):+        buf = io.BytesIO()+        buf.write(self.major.pack() if hasattr(self.major, "pack") else Range8.synthetic(*self.major).pack())+        buf.write(self.minor.pack() if hasattr(self.minor, "pack") else Range16.synthetic(*self.minor).pack())+        return buf.getvalue()+    @classmethod+    def synthetic(cls, major, minor):+        self = cls.__new__(cls)+        self.major = major+        self.minor = minor+        return self+class Range(xcffib.Struct):+    xge = False+    def __init__(self, unpacker):+        if isinstance(unpacker, xcffib.Protobj):+            unpacker = xcffib.MemoryUnpacker(unpacker.pack())+        xcffib.Struct.__init__(self, unpacker)+        base = unpacker.offset+        self.core_requests = Range8(unpacker)+        unpacker.pad(Range8)+        self.core_replies = Range8(unpacker)+        unpacker.pad(ExtRange)+        self.ext_requests = ExtRange(unpacker)+        unpacker.pad(ExtRange)+        self.ext_replies = ExtRange(unpacker)+        unpacker.pad(Range8)+        self.delivered_events = Range8(unpacker)+        unpacker.pad(Range8)+        self.device_events = Range8(unpacker)+        unpacker.pad(Range8)+        self.errors = Range8(unpacker)+        self.client_started, self.client_died = unpacker.unpack("BB")+        self.bufsize = unpacker.offset - base+    def pack(self):+        buf = io.BytesIO()+        buf.write(self.core_requests.pack() if hasattr(self.core_requests, "pack") else Range8.synthetic(*self.core_requests).pack())+        buf.write(self.core_replies.pack() if hasattr(self.core_replies, "pack") else Range8.synthetic(*self.core_replies).pack())+        buf.write(self.ext_requests.pack() if hasattr(self.ext_requests, "pack") else ExtRange.synthetic(*self.ext_requests).pack())+        buf.write(self.ext_replies.pack() if hasattr(self.ext_replies, "pack") else ExtRange.synthetic(*self.ext_replies).pack())+        buf.write(self.delivered_events.pack() if hasattr(self.delivered_events, "pack") else Range8.synthetic(*self.delivered_events).pack())+        buf.write(self.device_events.pack() if hasattr(self.device_events, "pack") else Range8.synthetic(*self.device_events).pack())+        buf.write(self.errors.pack() if hasattr(self.errors, "pack") else Range8.synthetic(*self.errors).pack())+        buf.write(struct.pack("=B", self.client_started))+        buf.write(struct.pack("=B", self.client_died))+        return buf.getvalue()+    @classmethod+    def synthetic(cls, core_requests, core_replies, ext_requests, ext_replies, delivered_events, device_events, errors, client_started, client_died):+        self = cls.__new__(cls)+        self.core_requests = core_requests+        self.core_replies = core_replies+        self.ext_requests = ext_requests+        self.ext_replies = ext_replies+        self.delivered_events = delivered_events+        self.device_events = device_events+        self.errors = errors+        self.client_started = client_started+        self.client_died = client_died+        return self+xcffib._add_ext(key, recordExtension, _events, _errors)

@@ -0,0 +1,33 @@+<xcb header="record" extension-xname="RECORD" extension-name="Record"+    major-version="1" minor-version="13">++    <!-- Types -->+    <xidtype name="CONTEXT" />++    <struct name="Range8">+    <field type="CARD8" name="first" />+    <field type="CARD8" name="last" />+    </struct>++    <struct name="Range16">+    <field type="CARD16" name="first" />+    <field type="CARD16" name="last" />+    </struct>++    <struct name="ExtRange">+    <field type="Range8" name="major" />+    <field type="Range16" name="minor" />+    </struct>++    <struct name="Range">+    <field type="Range8" name="core_requests" />+    <field type="Range8" name="core_replies" />+    <field type="ExtRange" name="ext_requests" />+    <field type="ExtRange" name="ext_replies" />+    <field type="Range8" name="delivered_events" />+    <field type="Range8" name="device_events" />+    <field type="Range8" name="errors" />+    <field type="BOOL" name="client_started" />+    <field type="BOOL" name="client_died" />+    </struct>+</xcb>

@@ -1,14 +1,14 @@+cabal-version:       2.4 name:                xcffib-version:             1.5.0+version:             1.6.0 synopsis:            A cffi-based python binding for X homepage:            http://github.com/tych0/xcffib-license:             OtherLicense+license:             Apache-2.0 license-file:        LICENSE author:              Tycho Andersen maintainer:          Tycho Andersen <tycho@tycho.pizza> category:            X11 build-type:          Simple-cabal-version:       >=1.10 bug-reports:         https://github.com/tych0/xcffib/issues description: A cffi-based python binding for X, comparable to xpyb extra-source-files: test/generator/*.py,@@ -25,19 +25,20 @@  library   build-depends: base ==4.*,-                 xcb-types >= 0.13.0,-                 language-python >= 0.5.6,-                 filepath,-                 filemanip,-                 split,-                 containers,-                 mtl >= 2.1,-                 attoparsec,-                 bytestring,-                 either+                 xcb-types >= 0.15.0 && < 0.16,+                 filepath >= 1.4.2 && < 1.5,+                 filemanip >= 0.3.6 && < 0.4,+                 split >= 0.2.3 && < 0.3,+                 containers >= 0.6.5 && < 0.7,+                 mtl >= 2.2.2 && < 2.4,+                 attoparsec >= 0.14.4 && < 0.15,+                 bytestring >= 0.11.3 && < 0.12,+                 either >= 5.0.2 && < 5.1,+                 pretty >= 1.1 && < 1.2   hs-source-dirs: generator   exposed-modules: Data.XCB.Python.Parse,                    Data.XCB.Python.PyHelpers+                   Data.XCB.Python.AST   ghc-options: -Wall   default-language: Haskell2010 @@ -46,22 +47,21 @@   hs-source-dirs: generator   build-depends: base ==4.*,                  xcffib,-                 language-python >= 0.5.6,-                 split,-                 xcb-types >= 0.13.0,-                 optparse-applicative >= 0.13,-                 filepath,-                 filemanip,-                 directory >= 1.2,-                 containers,-                 mtl >= 2.1,-                 attoparsec,-                 bytestring,-                 either-  if impl(ghc < 8.0)-    build-depends: semigroups+                 xcb-types >= 0.15.0 && < 0.16,+                 filepath >= 1.4.2 && < 1.5,+                 filemanip >= 0.3.6 && < 0.4,+                 split >= 0.2.3 && < 0.3,+                 containers >= 0.6.5 && < 0.7,+                 mtl >= 2.2.2 && < 2.4,+                 attoparsec >= 0.14.4 && < 0.15,+                 bytestring >= 0.11.3 && < 0.12,+                 either >= 5.0.2 && < 5.1,+                 pretty >= 1.1 && < 1.2,+                 directory >= 1.3.6 && < 1.4,+                 optparse-applicative >= 0.18.1 && < 0.19   other-modules: Data.XCB.Python.Parse,                  Data.XCB.Python.PyHelpers+                 Data.XCB.Python.AST   ghc-options: -Wall   default-language: Haskell2010 @@ -71,10 +71,9 @@   type: exitcode-stdio-1.0   build-depends: base ==4.*,                  xcffib,-                 language-python >= 0.5.6,-                 HUnit,-                 test-framework,-                 test-framework-hunit+                 HUnit >= 1.6.2 && < 1.7,+                 test-framework >= 0.8.2 && < 0.9,+                 test-framework-hunit >= 0.3.0 && < 0.4   default-language: Haskell2010  test-suite GeneratorTests.hs@@ -83,10 +82,9 @@   type: exitcode-stdio-1.0   build-depends: base ==4.*,                  xcffib,-                 xcb-types >= 0.13.0,-                 language-python >= 0.5.6,-                 HUnit,-                 test-framework,-                 test-framework-hunit,-                 filepath+                 xcb-types >= 0.15.0 && < 0.16,+                 filepath >= 1.4.2 && < 1.5,+                 HUnit >= 1.6.2 && < 1.7,+                 test-framework >= 0.8.2 && < 0.9,+                 test-framework-hunit >= 0.3.0 && < 0.4   default-language: Haskell2010