diff --git a/haskell-gi.cabal b/haskell-gi.cabal --- a/haskell-gi.cabal +++ b/haskell-gi.cabal @@ -1,5 +1,5 @@ name: haskell-gi -version: 0.26.6 +version: 0.26.7 synopsis: Generate Haskell bindings for GObject Introspection capable libraries description: Generate Haskell bindings for GObject Introspection capable libraries. This includes most notably Gtk+, but many other libraries in the GObject ecosystem provide introspection data too. diff --git a/lib/Data/GI/CodeGen/Callable.hs b/lib/Data/GI/CodeGen/Callable.hs --- a/lib/Data/GI/CodeGen/Callable.hs +++ b/lib/Data/GI/CodeGen/Callable.hs @@ -652,8 +652,9 @@ -- arguments to Haskell code. closures = map (args callable!!) . filter (/= -1) . map argClosure $ inArgs destroyers = map (args callable!!) . filter (/= -1) . map argDestroy $ inArgs + callbackUserData = filter argCallbackUserData (args callable) omitted = case expose of - WithoutClosures -> arrayLengths callable <> closures <> destroyers + WithoutClosures -> arrayLengths callable <> closures <> destroyers <> callbackUserData WithClosures -> arrayLengths callable in (filter (`notElem` omitted) inArgs, omitted) @@ -963,7 +964,8 @@ forgetClosures :: Callable -> Callable forgetClosures c = c {args = map forgetClosure (args c)} where forgetClosure :: Arg -> Arg - forgetClosure arg = arg {argClosure = -1} + forgetClosure arg = arg {argClosure = -1, + argCallbackUserData = False} -- | Generate a wrapper for a dynamic C symbol (i.e. a Haskell -- function that will invoke its first argument, which should be a diff --git a/lib/Data/GI/CodeGen/CodeGen.hs b/lib/Data/GI/CodeGen/CodeGen.hs --- a/lib/Data/GI/CodeGen/CodeGen.hs +++ b/lib/Data/GI/CodeGen/CodeGen.hs @@ -22,7 +22,7 @@ import Data.GI.CodeGen.Fixups (dropMovedItems, guessPropertyNullability, detectGObject, dropDuplicatedFields, checkClosureDestructors, fixSymbolNaming, - fixClosures) + fixClosures, fixCallbackUserData) import Data.GI.CodeGen.GObject import Data.GI.CodeGen.Haddock (deprecatedPragma, addSectionDocumentation, writeHaddock, @@ -557,6 +557,9 @@ -- Make sure that the argClosure argument refers to a callback, -- not to the user_data field. $ map fixClosures + -- Make sure that the user_data argument of callbacks is + -- annotated as such. + $ map fixCallbackUserData -- Make sure that the symbols to be generated are valid -- Haskell identifiers, when necessary. $ map fixSymbolNaming diff --git a/lib/Data/GI/CodeGen/Conversions.hsc b/lib/Data/GI/CodeGen/Conversions.hsc --- a/lib/Data/GI/CodeGen/Conversions.hsc +++ b/lib/Data/GI/CodeGen/Conversions.hsc @@ -852,7 +852,9 @@ -- | Whether the callable has closure arguments (i.e. "user_data" -- style arguments). callableHasClosures :: Callable -> Bool -callableHasClosures = any (/= -1) . map argClosure . args +callableHasClosures c = or . concatMap checkArg $ args c + where checkArg :: Arg -> [Bool] + checkArg arg = [argClosure arg /= -1, argCallbackUserData arg] -- | Check whether the given type corresponds to a callback. typeIsCallback :: Type -> CodeGen e Bool diff --git a/lib/Data/GI/CodeGen/Fixups.hs b/lib/Data/GI/CodeGen/Fixups.hs --- a/lib/Data/GI/CodeGen/Fixups.hs +++ b/lib/Data/GI/CodeGen/Fixups.hs @@ -6,6 +6,7 @@ , dropDuplicatedFields , checkClosureDestructors , fixClosures + , fixCallbackUserData , fixSymbolNaming ) where @@ -246,6 +247,36 @@ where fixMethod :: Method -> Method fixMethod m = m {methodCallable = fixCallableClosures (methodCallable m)} + +-- | The last argument of callbacks is often a @user_data@ argument, +-- but currently gobject-introspection does not have an annotation +-- representing this. This is generally OK, since the gir generator +-- will mark these arguments as @(closure)@ if they are named +-- @user_data@, and we do the right things in this case, but recently +-- there has been a push to "fix" these annotations by removing them +-- without providing any replacement, which breaks the bindings. See +-- https://gitlab.gnome.org/GNOME/gobject-introspection/-/issues/450 +-- Here we try to guess which arguments in callbacks are user_data +-- arguments. +fixCallbackUserData :: (Name, API) -> (Name, API) +fixCallbackUserData (n, APICallback cb) = + (n, APICallback (cb {cbCallable = fixCallableUserData (cbCallable cb)})) +fixCallbackUserData (n, api) = (n, api) + +-- | If the last argument of a callable is a @gpointer@, and it is not +-- marked as a closure pointing to a different argument, mark it as a +-- callback @user_data@ argument. +fixCallableUserData :: Callable -> Callable +fixCallableUserData c = c {args = fixLast 0 (args c)} + where + fixLast :: Int -> [Arg] -> [Arg] + fixLast _ [] = [] + fixLast n (arg:[]) + | argType arg == TBasicType TPtr && + argClosure arg `elem` [-1, n] = + [arg {argClosure = -1, argCallbackUserData = True}] + | otherwise = [arg] + fixLast n (arg:rest) = arg : fixLast (n+1) rest -- | Some symbols have names that are not valid Haskell identifiers, -- fix that here. diff --git a/lib/Data/GI/GIR/Arg.hs b/lib/Data/GI/GIR/Arg.hs --- a/lib/Data/GI/GIR/Arg.hs +++ b/lib/Data/GI/GIR/Arg.hs @@ -38,6 +38,8 @@ argClosure :: Int, argDestroy :: Int, argCallerAllocates :: Bool, + argCallbackUserData :: Bool, + -- ^ Whether the argument is an "user-data" argument for a callback. transfer :: Transfer } deriving (Show, Eq, Ord) @@ -76,6 +78,10 @@ then nullable || allowNone else nullable callerAllocates <- optionalAttr "caller-allocates" False parseBool + -- There is no annotation for this one yet, see + -- https://gitlab.gnome.org/GNOME/gobject-introspection/-/issues/450 + -- We will use some heuristics later for setting this field. + let callbackUserData = False t <- parseType doc <- parseDocumentation return $ Arg { argCName = name @@ -87,5 +93,6 @@ , argClosure = closure , argDestroy = destroy , argCallerAllocates = callerAllocates + , argCallbackUserData = callbackUserData , transfer = ownership }