haskell-gi 0.25.0 → 0.26.0

raw patch · 13 files changed

+205/−96 lines, 13 filesdep ~basedep ~haskell-gi-basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, haskell-gi-base

API changes (from Hackage documentation)

Files

• ChangeLog.md +24/−0
• haskell-gi.cabal +8/−12
• lib/Data/GI/CodeGen/Code.hs +1/−0
• lib/Data/GI/CodeGen/Conversions.hsc +4/−7
• lib/Data/GI/CodeGen/CtoHaskellMap.hs +2/−2
• lib/Data/GI/CodeGen/Haddock.hs +3/−2
• lib/Data/GI/CodeGen/OverloadedMethods.hs +9/−9
• lib/Data/GI/CodeGen/ProjectInfo.hs +1/−1
• lib/Data/GI/CodeGen/Properties.hs +16/−2
• lib/Data/GI/CodeGen/Signal.hs +107/−57
• lib/Data/GI/CodeGen/Struct.hs +15/−1
• lib/Data/GI/CodeGen/SymbolNaming.hs +14/−3
• lib/Data/GI/GIR/Type.hs +1/−0

@@ -1,3 +1,27 @@+### 0.26.0+++ Support for 'HasField' methods, which allows the syntax 'widget.show' or 'widget.add child' for invoking methods using the new [RecordDotSyntax](https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0282-record-dot-syntax.rst) in ghc 9.2.+++ And an implicit '?self' parameter for callbacks, for accessing the calling object. See [issue 346](https://github.com/haskell-gi/haskell-gi/issues/346) where this is necessary in practice in gtk4 to use event controllers.+++ Add an 'After' attribute to connect to signals after the default handler on constructors/setters using attribute syntax, similar to [On](https://hackage.haskell.org/package/haskell-gi-base/docs/Data-GI-Base-Attributes.html#t:AttrOp).+++ Add [resolveSignal](https://hackage.haskell.org/package/haskell-gi-base-0.26.0/docs/Data-GI-Base-Signals.html#v:resolveSignal) for showing what an overloaded signal resolves to: `resolveSignal button #notify` will output [GI.GObject.Objects.Object.Object::notify](https://hackage.haskell.org/package/gi-gobject-2.0.27/docs/GI-GObject-Objects-Object.html#g:signal:notify).++### 0.25.0+++ Support non-GObject object attributes.+++ Support for ghc 9.0.1.+++ Improvements in the generated Haddocks.+++ Remove the command line version of the bindings generator.+++ Remove support for non-IsLabel overloading.+++ Add [resolveMethod](https://hackage.haskell.org/package/haskell-gi-base-0.25.0/docs/Data-GI-Base-Overloading.html#v:resolveMethod) for showing what an overloaded method resolves to: `resolveMethod #show widget` will output `GI.Gtk.Objects.Widget.widgetShow`.+ ### 0.24.5  + Fix an accidental double free for GValues, see [issue 320](https://github.com/haskell-gi/haskell-gi/issues/320).

@@ -1,5 +1,5 @@ name:                haskell-gi-version:             0.25.0+version:             0.26.0 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.@@ -7,14 +7,12 @@ license:             LGPL-2.1                      -- or above license-file:        LICENSE-author:              Will Thompson,-                     Iñaki García Etxebarria,-                     Jonas Platte-maintainer:          Iñaki García Etxebarria (inaki@blueleaf.cc)+author:              Will Thompson and Iñaki García Etxebarria+maintainer:          Iñaki García Etxebarria (github@the.blueleaf.cc) stability:           Experimental category:            Development build-type:          Custom-tested-with:         GHC == 8.8.1, GHC == 8.10.1+tested-with:         GHC == 8.4.1, GHC == 8.6.1, GHC == 8.8.1, GHC == 8.10.1, GHC == 9.0.1, GHC == 9.2.1 cabal-version:       2.0  extra-source-files: ChangeLog.md@@ -23,7 +21,7 @@  setup-depends:    base >= 4 && <5,    Cabal,-   cabal-doctest >= 1 && <1.1+   cabal-doctest >= 1  source-repository head   type: git@@ -32,8 +30,8 @@ Library   default-language:    Haskell2010   pkgconfig-depends:   gobject-introspection-1.0 >= 1.32, gobject-2.0 >= 2.32-  build-depends:       base >= 4.9 && < 5,-                       haskell-gi-base >= 0.25.0 && <0.26,+  build-depends:       base >= 4.11 && < 5,+                       haskell-gi-base >= 0.26.0 && <0.27,                        Cabal >= 1.24,                        attoparsec >= 0.13,                        containers,@@ -52,9 +50,7 @@                        text >= 1.0    default-extensions: CPP, ForeignFunctionInterface, DoAndIfThenElse, LambdaCase, RankNTypes, OverloadedStrings-  ghc-options:         -Wall -fwarn-incomplete-patterns -fno-warn-name-shadowing--  ghc-options: -Wcompat+  ghc-options:         -Wall -fwarn-incomplete-patterns -fno-warn-name-shadowing -Wcompat    c-sources:           lib/c/enumStorage.c   build-tool-depends:  hsc2hs:hsc2hs

@@ -952,6 +952,7 @@                 , "import qualified Data.GI.Base.Properties as B.Properties"                 , "import qualified Data.GI.Base.Signals as B.Signals"                 , "import qualified Control.Monad.IO.Class as MIO"+                , "import qualified Data.Coerce as Coerce"                 , "import qualified Data.Text as T"                 , "import qualified Data.ByteString.Char8 as B"                 , "import qualified Data.Map as Map"

@@ -74,7 +74,6 @@     Free ma <*> b = Free $ (<*> b) <$> ma  instance (Functor f) => Monad (Free f) where-    return = Pure     (Free x) >>= f = Free (fmap (>>= f) x)     (Pure r) >>= f = f r @@ -649,19 +648,17 @@   a <- findAPI t   case a of     Just (APIStruct s) -> if structIsBoxed s-                          then wrapTransient t+                          then wrapTransient                           else fToH t TransferNothing     Just (APIUnion u) -> if unionIsBoxed u-                         then wrapTransient t+                         then wrapTransient                          else fToH t TransferNothing     _ -> fToH t TransferNothing transientToH t transfer = fToH t transfer  -- | Wrap the given transient.-wrapTransient :: Type -> CodeGen e Converter-wrapTransient t = do-  hCon <- typeConName <$> haskellType t-  return $ lambdaConvert $ "B.ManagedPtr.withTransient " <> hCon+wrapTransient :: CodeGen e Converter+wrapTransient = return $ lambdaConvert $ "B.ManagedPtr.withTransient "  unpackCArray :: Text -> Type -> Transfer -> ExcCodeGen Converter unpackCArray length (TCArray False _ _ t) transfer =

@@ -21,7 +21,7 @@                             Signal(..)) import Data.GI.CodeGen.ModulePath (dotModulePath) import Data.GI.CodeGen.SymbolNaming (moduleLocation, lowerName, upperName,-                                     signalHaskellName)+                                     signalHaskellName, haddockSignalAnchor) import Data.GI.CodeGen.Util (ucFirst)  -- | Link to an identifier, module, etc.@@ -120,7 +120,7 @@                 Nothing -> let Name ns owner = n                            in ucFirst ns <> owner           in (SignalRef ownerCName sn,-              ModuleLinkWithAnchor (Just sn') mod ("g:signal:" <> sn'))+              ModuleLinkWithAnchor (Just sn') mod (haddockSignalAnchor <> sn'))  -- | Given an optional C type and the API constructor construct the -- list of associated refs.

@@ -34,7 +34,8 @@ import Data.GI.CodeGen.GtkDoc (GtkDoc(..), Token(..), CRef(..), Language(..),                                Link(..), ListItem(..), parseGtkDoc) import Data.GI.CodeGen.Overrides (onlineDocsMap)-import Data.GI.CodeGen.SymbolNaming (lowerSymbol, signalHaskellName)+import Data.GI.CodeGen.SymbolNaming (lowerSymbol, signalHaskellName,+                                     haddockSignalAnchor)  -- | Where is the documentation located with respect to the relevant -- symbol, useful for determining whether we want to start with @|@ or @^@.@@ -81,7 +82,7 @@ formatUnknownCRef _ (ParamRef p) = "/@" <> lowerSymbol p <> "@/" formatUnknownCRef _ (LocalSignalRef s) =   let sn = signalHaskellName s-  in "[" <> sn <> "](#g:signal:" <> sn <> ")"+  in "[" <> sn <> "](#" <> haddockSignalAnchor <> sn <> ")" formatUnknownCRef c2h (SignalRef owner signal) =   case M.lookup (TypeRef owner) c2h of     Nothing -> formatCRef $ owner <> "::" <> signal

@@ -136,11 +136,11 @@         let callable = fixupCallerAllocates (methodCallable m)         sig <- callableSignature callable (KnownForeignSymbol undefined) WithoutClosures         bline $ "data " <> infoName-        -- This should not happen, since ordinary methods always-        -- have the instance as first argument.-        when (null (signatureArgTypes sig)) $-          error $ "Internal error: too few parameters! " ++ show m-        let (obj:otherTypes) = map snd (signatureArgTypes sig)+        let (obj, otherTypes) = case map snd (signatureArgTypes sig) of+              -- This should not happen, since ordinary methods always+              -- have the instance as first argument.+              [] -> error $ "Internal error: too few parameters! " ++ show m+              (obj':otherTypes') -> (obj', otherTypes')             sigConstraint = "signature ~ (" <> T.intercalate " -> "               (otherTypes ++ [signatureReturnType sig]) <> ")" @@ -160,12 +160,12 @@           line $ "instance O.OverloadedMethodInfo " <> infoName <> " " <> obj             <> " where"           indent $ do-            line $ "overloadedMethodInfo = O.MethodInfo {"+            line $ "overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {"             indent $ do-              line $ "O.overloadedMethodName = \"" <> dbgInfo <> "\","-              line $ "O.overloadedMethodURL = \"" <>+              line $ "O.resolvedSymbolName = \"" <> dbgInfo <> "\","+              line $ "O.resolvedSymbolURL = \"" <>                 hackageLink <> "#v:" <> mangled <> "\""-              line $ "}"+              line $ "})"          export (NamedSubsection MethodSection $ lowerName mn) infoName 

@@ -24,7 +24,7 @@ homepage = "https://github.com/haskell-gi/haskell-gi"  authors :: Text-authors = "Will Thompson, Iñaki García Etxebarria and Jonas Platte"+authors = "Will Thompson and Iñaki García Etxebarria"  maintainers :: Text maintainers = "Iñaki García Etxebarria"

@@ -25,11 +25,14 @@ import Data.GI.CodeGen.Haddock (addSectionDocumentation, writeHaddock,                                 RelativeDocPosition(DocBeforeSymbol)) import Data.GI.CodeGen.Inheritance (fullObjectPropertyList, fullInterfacePropertyList)+import Data.GI.CodeGen.ModulePath (dotModulePath) import Data.GI.CodeGen.SymbolNaming (lowerName, upperName, classConstraint,                                      hyphensToCamelCase, qualifiedSymbol,                                      typeConstraint, callbackDynamicWrapper,                                      callbackHaskellToForeign,-                                     callbackWrapperAllocator, safeCast)+                                     callbackWrapperAllocator, safeCast,+                                     hackageModuleLink, moduleLocation,+                                     haddockAttrAnchor) import Data.GI.CodeGen.Type import Data.GI.CodeGen.Util @@ -376,7 +379,8 @@ genOneProperty owner prop = do   let name = upperName owner       cName = (hyphensToCamelCase . propName) prop-      docSection = NamedSubsection PropertySection (lcFirst cName)+      lcAttr = lcFirst cName+      docSection = NamedSubsection PropertySection lcAttr       pName = name <> cName       flags = propFlags prop       writable = PropertyWritable `elem` flags &&@@ -458,6 +462,11 @@                          else [])     it <- infoType owner prop     export docSection it+    api <- findAPIByName owner+    hackageLink <- hackageModuleLink owner+    let qualifiedAttrName = dotModulePath (moduleLocation owner api)+                            <> "." <> lcAttr+        attrInfoURL = hackageLink <> "#" <> haddockAttrAnchor <> lcAttr     bline $ "data " <> it     line $ "instance AttrInfo " <> it <> " where"     indent $ do@@ -480,6 +489,11 @@               else line $ "attrTransfer _ = undefined"             line $ "attrConstruct = " <> constructor             line $ "attrClear = " <> clear+            line $ "dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {"+            indent $ do+              line $ "O.resolvedSymbolName = \"" <> qualifiedAttrName <> "\""+              line $ ", O.resolvedSymbolURL = \"" <> attrInfoURL <> "\""+              line $ "})"  -- | Generate a placeholder property for those cases in which code -- generation failed.

@@ -6,7 +6,7 @@  import Control.Monad (forM, forM_, when, unless) -import Data.Maybe (catMaybes)+import Data.Maybe (catMaybes, isJust) #if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>)) #endif@@ -27,6 +27,7 @@                                 RelativeDocPosition(..), writeHaddock,                                 writeDocumentation,                                 writeArgDocumentation, writeReturnDocumentation)+import Data.GI.CodeGen.ModulePath (dotModulePath) import Data.GI.CodeGen.SymbolNaming import Data.GI.CodeGen.Transfer (freeContainerType) import Data.GI.CodeGen.Type@@ -37,8 +38,8 @@ -- | The prototype of the callback on the Haskell side (what users of -- the binding will see) genHaskellCallbackPrototype :: Text -> Callable -> Text -> ExposeClosures ->-                               Documentation -> ExcCodeGen ()-genHaskellCallbackPrototype subsec cb htype expose doc = group $ do+                               Bool -> Documentation -> ExcCodeGen ()+genHaskellCallbackPrototype subsec cb htype expose isSignal doc = group $ do     let name' = case expose of                   WithClosures -> callbackHTypeWithClosures htype                   WithoutClosures -> htype@@ -65,13 +66,14 @@       line $ returnArrow <> typeShow (io ret)       writeReturnDocumentation cb False -    blank+    when (not isSignal) $ do+      blank -    -- For optional parameters, in case we want to pass Nothing.-    export (NamedSubsection SignalSection subsec) ("no" <> name')-    writeHaddock DocBeforeSymbol (noCallbackDoc name')-    line $ "no" <> name' <> " :: Maybe " <> name'-    line $ "no" <> name' <> " = Nothing"+      -- For optional parameters, in case we want to pass Nothing.+      export (NamedSubsection SignalSection subsec) ("no" <> name')+      writeHaddock DocBeforeSymbol (noCallbackDoc name')+      line $ "no" <> name' <> " :: Maybe " <> name'+      line $ "no" <> name' <> " = Nothing"    where noCallbackDoc :: Text -> Text         noCallbackDoc typeName =@@ -80,16 +82,21 @@  -- | Generate the type synonym for the prototype of the callback on -- the C side. Returns the name given to the type synonym.-genCCallbackPrototype :: Text -> Callable -> Text -> Bool -> CodeGen e Text-genCCallbackPrototype subsec cb name' isSignal = group $ do+genCCallbackPrototype :: Text -> Callable -> Text ->+                         Maybe Text -> CodeGen e Text+genCCallbackPrototype subsec cb name' maybeOwner = group $ do     let ctypeName = callbackCType name'+        isSignal = isJust maybeOwner -    export (NamedSubsection SignalSection subsec) ctypeName-    writeHaddock DocBeforeSymbol ccallbackDoc+    when (not isSignal) $ do+      export (NamedSubsection SignalSection subsec) ctypeName+      writeHaddock DocBeforeSymbol ccallbackDoc      line $ "type " <> ctypeName <> " ="     indent $ do-      when isSignal $ line $ withComment "Ptr () ->" "object"+      maybe (return ())+        (\owner -> line $ withComment ("Ptr " <> owner <> " ->") "object")+        maybeOwner       forM_ (args cb) $ \arg -> do         ht <- foreignType $ argType arg         let ht' = if direction arg /= DirectionIn@@ -98,7 +105,7 @@         line $ typeShow ht' <> " ->"       when (callableThrows cb) $         line "Ptr (Ptr GError) ->"-      when isSignal $ line $ withComment "Ptr () ->" "user_data"+      when (isJust maybeOwner) $ line $ withComment "Ptr () ->" "user_data"       ret <- io <$> case returnType cb of                       Nothing -> return $ con0 "()"                       Just t -> foreignType t@@ -110,14 +117,15 @@     ccallbackDoc = "Type for the callback on the (unwrapped) C side."  -- | Generator for wrappers callable from C-genCallbackWrapperFactory :: Text -> Text -> CodeGen e ()-genCallbackWrapperFactory subsec name' = group $ do+genCallbackWrapperFactory :: Text -> Text -> Bool -> CodeGen e ()+genCallbackWrapperFactory subsec name' isSignal = group $ do     let factoryName = callbackWrapperAllocator name'     writeHaddock DocBeforeSymbol factoryDoc     line "foreign import ccall \"wrapper\""     indent $ line $ factoryName <> " :: " <> callbackCType name'                <> " -> IO (FunPtr " <> callbackCType name' <> ")"-    export (NamedSubsection SignalSection subsec) factoryName+    when (not isSignal) $ do+      export (NamedSubsection SignalSection subsec) factoryName    where factoryDoc :: Text         factoryDoc = "Generate a function pointer callable from C code, from a `"@@ -141,8 +149,8 @@   return (prime drop)  -- | Generator of closures-genClosure :: Text -> Callable -> Text -> Text -> Bool -> CodeGen e ()-genClosure subsec cb callback name isSignal = group $ do+genClosure :: Text -> Callable -> Text -> Text -> CodeGen e ()+genClosure subsec cb callback name = group $ do   let closure = callbackClosureGenerator name   export (NamedSubsection SignalSection subsec) closure   writeHaddock DocBeforeSymbol closureDoc@@ -151,7 +159,7 @@                      <> callbackCType callback <> ")"       line $ closure <> " cb = liftIO $ do"       indent $ do-            wrapped <- genWrappedCallback cb "cb" callback isSignal+            wrapped <- genWrappedCallback cb "cb" callback False             line $ callbackWrapperAllocator callback <> " " <> wrapped                      <> " >>= B.GClosure.newGClosure"   where@@ -267,24 +275,26 @@ -- FunPtr will be freed by someone else (the function registering the -- callback for ScopeTypeCall, or a destroy notifier for -- ScopeTypeNotified).-genCallbackWrapper :: Text -> Callable -> Text -> Bool -> ExcCodeGen ()-genCallbackWrapper subsec cb name' isSignal = group $ do+genCallbackWrapper :: Text -> Callable -> Text ->+                      Maybe Text -> ExcCodeGen ()+genCallbackWrapper subsec cb name' maybeOwner = group $ do   let wrapperName = callbackHaskellToForeign name'       (hInArgs, _) = callableHInArgs cb WithClosures       hOutArgs = callableHOutArgs cb       wrapperDoc = "Wrap a `" <> name' <> "` into a `" <>                    callbackCType name' <> "`."+      isSignal = isJust maybeOwner -  export (NamedSubsection SignalSection subsec) wrapperName-  writeHaddock DocBeforeSymbol wrapperDoc+  when (not isSignal) $ do+    export (NamedSubsection SignalSection subsec) wrapperName+    writeHaddock DocBeforeSymbol wrapperDoc    group $ do-    line $ wrapperName <> " ::"+    line $ wrapperName <> " :: "     indent $ do       if isSignal-      then do-        line $ name' <> " ->"-      else do+        then line $ "GObject a => (a -> " <> name' <> ") ->"+        else do            line $ "Maybe (Ptr (FunPtr " <> callbackCType name' <> ")) ->"            let hType = if callableHasClosures cb                        then callbackHTypeWithClosures name'@@ -295,8 +305,8 @@      let cArgNames = map escapedArgName (args cb)         allArgs = if isSignal-                  then T.unwords $ ["_cb", "_"] <> cArgNames <> ["_"]-                  else T.unwords $ ["funptrptr", "_cb"] <> cArgNames+                  then T.unwords $ ["gi'cb", "gi'selfPtr"] <> cArgNames <> ["_"]+                  else T.unwords $ ["gi'funptrptr", "gi'cb"] <> cArgNames     line $ wrapperName <> " " <> allArgs <> " = do"     indent $ do       hInNames <- forM hInArgs (prepareArgForCall cb)@@ -310,11 +320,18 @@                          []  -> ""                          [r] -> r <> " <- "                          _   -> mkTuple returnVars <> " <- "-      line $ returnBind <> "_cb " <> T.concat (map (" " <>) hInNames) +      if isSignal+      then line $ returnBind+                  <> "B.ManagedPtr.withTransient"+                  <> " gi'selfPtr $ \\gi'self -> "+                  <> "gi'cb (Coerce.coerce gi'self) "+                  <> T.concat (map (" " <>) hInNames)+      else line $ returnBind <> "gi'cb " <> T.concat (map (" " <>) hInNames)+       forM_ hOutArgs saveOutArg -      unless isSignal $ line "maybeReleaseFunPtr funptrptr"+      unless isSignal $ line "maybeReleaseFunPtr gi'funptrptr"        case returnType cb of         Nothing -> return ()@@ -322,7 +339,7 @@            nullableReturnType <- typeIsNullable r            if returnMayBeNull cb && nullableReturnType            then do-             line "maybeM nullPtr result $ \\result' -> do"+             line "maybeM FP.nullPtr result $ \\result' -> do"              indent $ unwrapped "result'"            else unwrapped "result"            where@@ -348,14 +365,14 @@                    line $ "-- XXX Could not generate callback wrapper for "                           <> name'                    printCGError e) $ do-      typeSynonym <- genCCallbackPrototype name' cb' name' False+      typeSynonym <- genCCallbackPrototype name' cb' name' Nothing       dynamic <- genDynamicCallableWrapper n typeSynonym cb       export (NamedSubsection SignalSection name') dynamic-      genCallbackWrapperFactory name' name'+      genCallbackWrapperFactory name' name' False       deprecatedPragma name' (callableDeprecated cb')-      genHaskellCallbackPrototype name' cb' name' WithoutClosures cbDoc+      genHaskellCallbackPrototype name' cb' name' WithoutClosures False cbDoc       when (callableHasClosures cb') $ do-           genHaskellCallbackPrototype name' cb' name' WithClosures cbDoc+           genHaskellCallbackPrototype name' cb' name' WithClosures False cbDoc            genDropClosures name' cb' name'       if callableThrows cb'       then do@@ -379,14 +396,19 @@         line $ "-- No Haskell->C wrapper generated since the function throws."         blank       else do-        genClosure name' cb' name' name' False-        genCallbackWrapper name' cb' name' False+        genClosure name' cb' name' name'+        genCallbackWrapper name' cb' name' Nothing  -- | Generate the given signal instance for the given API object. genSignalInfoInstance :: Name -> Signal -> CodeGen e () genSignalInfoInstance owner signal = group $ do+  api <- findAPIByName owner   let name = upperName owner-  let sn = (ucFirst . signalHaskellName . sigName) signal+      sn = (ucFirst . signalHaskellName . sigName) signal+      lcSignal = lcFirst sn+      qualifiedSignalName = dotModulePath (moduleLocation owner api)+                            <> "::" <> sigName signal+  hackageLink <- hackageModuleLink owner   si <- signalInfoName owner signal   bline $ "data " <> si   line $ "instance SignalInfo " <> si <> " where"@@ -395,8 +417,14 @@           cbHaskellType = signalConnectorName <> "Callback"       line $ "type HaskellCallbackType " <> si <> " = " <> cbHaskellType       line $ "connectSignal obj cb connectMode detail = do"-      indent $ genSignalConnector signal cbHaskellType "connectMode" "detail"-  export (NamedSubsection SignalSection $ lcFirst sn) si+      indent $ do+        genSignalConnector signal cbHaskellType "connectMode" "detail" "cb"+      line $ "dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {"+      indent $ do+        line $ "O.resolvedSymbolName = \"" <> qualifiedSignalName <> "\""+        line $ ", O.resolvedSymbolURL = \"" <> hackageLink <> "#"+          <> haddockSignalAnchor <> lcSignal <> "\"})"+  export (NamedSubsection SignalSection $ lcSignal) si  -- | Write some simple debug message when signal generation fails, and -- generate a placeholder SignalInfo instance.@@ -436,19 +464,18 @@    deprecatedPragma cbType (callableDeprecated cb) -  genHaskellCallbackPrototype (lcFirst sn') cb cbType WithoutClosures (sigDoc s)+  genHaskellCallbackPrototype (lcFirst sn') cb cbType WithoutClosures True (sigDoc s) -  _ <- genCCallbackPrototype (lcFirst sn') cb cbType True+  _ <- genCCallbackPrototype (lcFirst sn') cb cbType (Just on') -  genCallbackWrapperFactory (lcFirst sn') cbType+  genCallbackWrapperFactory (lcFirst sn') cbType True    if callableThrows cb     then do       line $ "-- No Haskell->C wrapper generated since the function throws."       blank     else do-      genClosure (lcFirst sn') cb cbType signalConnectorName True-      genCallbackWrapper (lcFirst sn') cb cbType True+      genCallbackWrapper (lcFirst sn') cb cbType (Just on')    -- Wrapper for connecting functions to the signal   -- We can connect to a signal either before the default handler runs@@ -459,10 +486,15 @@     -- since if something provides signals it is necessarily a     -- GObject.     klass <- classConstraint on++    addLanguagePragma "ImplicitParams"+    addLanguagePragma "RankNTypes"+     let signatureConstraints = "(" <> klass <> " a, MonadIO m) =>"+        implicitSelfCBType = "((?self :: a) => " <> cbType <> ")"         signatureArgs = if sigDetailed s-          then "a -> P.Maybe T.Text -> " <> cbType <> " -> m SignalHandlerId"-          else "a -> " <> cbType <> " -> m SignalHandlerId"+          then "a -> P.Maybe T.Text -> " <> implicitSelfCBType <> " -> m SignalHandlerId"+          else "a -> " <> implicitSelfCBType <> " -> m SignalHandlerId"         signature = " :: " <> signatureConstraints <> " " <> signatureArgs         onName = "on" <> signalConnectorName         afterName = "after" <> signalConnectorName@@ -473,10 +505,14 @@       if sigDetailed s         then do         line $ onName <> " obj detail cb = liftIO $ do"-        indent $ genSignalConnector s cbType "SignalConnectBefore" "detail"+        indent $ do+          line $ "let wrapped self = let ?self = self in cb"+          genSignalConnector s cbType "SignalConnectBefore" "detail" "wrapped"         else do         line $ onName <> " obj cb = liftIO $ do"-        indent $ genSignalConnector s cbType "SignalConnectBefore" "Nothing"+        indent $ do+          line $ "let wrapped self = let ?self = self in cb"+          genSignalConnector s cbType "SignalConnectBefore" "Nothing" "wrapped"       export docSection onName      group $ do@@ -485,10 +521,14 @@       if sigDetailed s         then do         line $ afterName <> " obj detail cb = liftIO $ do"-        indent $ genSignalConnector s cbType "SignalConnectAfter" "detail"+        indent $ do+          line $ "let wrapped self = let ?self = self in cb"+          genSignalConnector s cbType "SignalConnectAfter" "detail" "wrapped"         else do         line $ afterName <> " obj cb = liftIO $ do"-        indent $ genSignalConnector s cbType "SignalConnectAfter" "Nothing"+        indent $ do+          line $ "let wrapped self = let ?self = self in cb"+          genSignalConnector s cbType "SignalConnectAfter" "Nothing" "wrapped"       export docSection afterName    cppIf CPPOverloading (genSignalInfoInstance on s)@@ -520,7 +560,9 @@         <> hsn <> " callback"       , "@"       , ""-      , detailedDoc ]+      , detailedDoc+      , ""+      , selfDoc]      detailedDoc :: Text     detailedDoc = if not (sigDetailed s)@@ -531,6 +573,12 @@         <> "::detail@” instead."       ] +    selfDoc :: Text+    selfDoc = T.unlines [+      "By default the object invoking the signal is not passed to the callback."+      , "If you need to access it, you can use the implit @?self@ parameter."+      , "Note that this requires activating the @ImplicitParams@ GHC extension."+      ]  -- | Generate the code for connecting the given signal. This assumes -- that it lives inside a @do@ block.@@ -538,9 +586,11 @@                    -> Text -- ^ Callback type                    -> Text -- ^ SignalConnectBefore or SignalConnectAfter                    -> Text -- ^ Detail+                   -> Text -- ^ Name of variable holding the callback                    -> CodeGen e ()-genSignalConnector (Signal {sigName = sn, sigCallable = cb}) cbType when detail = do-  cb' <- genWrappedCallback cb "cb" cbType True+genSignalConnector (Signal {sigName = sn, sigCallable = cb})+                   cbType when detail cbName = do+  cb' <- genWrappedCallback cb cbName cbType True   let cb'' = prime cb'   line $ cb'' <> " <- " <> callbackWrapperAllocator cbType <> " " <> cb'   line $ "connectSignalFunPtr obj \"" <> sn <> "\" " <> cb'' <> " " <> when

@@ -26,11 +26,14 @@ import Data.GI.CodeGen.Code import Data.GI.CodeGen.Haddock (addSectionDocumentation, writeHaddock,                                 RelativeDocPosition(DocBeforeSymbol))+import Data.GI.CodeGen.ModulePath (dotModulePath) import Data.GI.CodeGen.SymbolNaming (upperName, lowerName,                                      underscoresToCamelCase,                                      qualifiedSymbol,                                      callbackHaskellToForeign,-                                     callbackWrapperAllocator)+                                     callbackWrapperAllocator,+                                     haddockAttrAnchor, moduleLocation,+                                     hackageModuleLink)  import Data.GI.CodeGen.Type import Data.GI.CodeGen.Util@@ -334,6 +337,12 @@   transferType <- fieldTransferType (fieldType field)   transferConstraint <- fieldTransferTypeConstraint (fieldType field) +  api <- findAPIByName owner+  hackageLink <- hackageModuleLink owner+  let qualifiedAttrName = dotModulePath (moduleLocation owner api)+                          <> "." <> labelName field+      attrInfoURL = hackageLink <> "#" <> haddockAttrAnchor <> labelName field+   line $ "data " <> it   line $ "instance AttrInfo " <> it <> " where"   indent $ do@@ -366,6 +375,11 @@           line $ "attrTransfer _ v = do"           indent $ genFieldTransfer "v" (fieldType field)       else line $ "attrTransfer = undefined"+    line $ "dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {"+    indent $ do+      line $ "O.resolvedSymbolName = \"" <> qualifiedAttrName <> "\""+      line $ ", O.resolvedSymbolURL = \"" <> attrInfoURL <> "\""+      line $ "})"    blank 

@@ -31,6 +31,8 @@     , normalizedAPIName      , hackageModuleLink+    , haddockSignalAnchor+    , haddockAttrAnchor     ) where  #if !MIN_VERSION_base(4,11,0)@@ -268,9 +270,11 @@  -- | Return the name for the signal in Haskell CamelCase conventions. signalHaskellName :: Text -> Text-signalHaskellName sn = let (w:ws) = T.split (== '-') sn-                       in w <> T.concat (map ucFirst ws)-+signalHaskellName sn = case T.split (== '-') sn of+                         [] -> ""  -- Won't happen due to the+                                   -- definition of T.split, but GHC+                                   -- does not know this.+                         w:ws -> w <> T.concat (map ucFirst ws)  -- | Return a link to the hackage package for the given name. Note -- that the generated link will only be valid if the name belongs to@@ -284,3 +288,10 @@   return $ "https://hackage.haskell.org/package/" <> pkg <> "/docs/"            <> location <> ".html" +-- | Prefix in Haddock for the signal anchor.+haddockSignalAnchor :: Text+haddockSignalAnchor = "g:signal:"++-- | Prefix in Haddock for the attribute anchor.+haddockAttrAnchor :: Text+haddockAttrAnchor = "g:attr:"

@@ -94,6 +94,7 @@ -- | A hash table. parseHashTable :: Parser Type parseHashTable = parseTypeElements >>= \case+                 [] -> return $ TGHash (TBasicType TPtr) (TBasicType TPtr)                  [Just key, Just value] -> return $ TGHash key value                  other -> parseError $ "Unsupported hash type: "                                        <> T.pack (show other)