haskell-gi 0.20.3 → 0.21.0

raw patch · 24 files changed

+520/−328 lines, 24 filesdep +semigroupsdep ~haskell-gi-basePVP ok

version bump matches the API change (PVP)

Dependencies added: semigroups

Dependency ranges changed: haskell-gi-base

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• haskell-gi.cabal +5/−2
• lib/Data/GI/CodeGen/CabalHooks.hs +2/−54
• lib/Data/GI/CodeGen/Callable.hs +22/−9
• lib/Data/GI/CodeGen/Code.hs +124/−100
• lib/Data/GI/CodeGen/CodeGen.hs +29/−8
• lib/Data/GI/CodeGen/Constant.hs +1/−1
• lib/Data/GI/CodeGen/Conversions.hs +22/−25
• lib/Data/GI/CodeGen/EnumFlags.hs +22/−10
• lib/Data/GI/CodeGen/Haddock.hs +25/−27
• lib/Data/GI/CodeGen/ModulePath.hs +3/−6
• lib/Data/GI/CodeGen/OverloadedLabels.hs +2/−2
• lib/Data/GI/CodeGen/OverloadedMethods.hs +2/−2
• lib/Data/GI/CodeGen/OverloadedSignals.hs +1/−1
• lib/Data/GI/CodeGen/Overrides.hs +14/−3
• lib/Data/GI/CodeGen/Properties.hs +59/−14
• lib/Data/GI/CodeGen/Signal.hs +92/−37
• lib/Data/GI/CodeGen/Struct.hs +69/−18
• lib/Data/GI/CodeGen/SymbolNaming.hs +6/−3
• lib/Data/GI/CodeGen/Transfer.hs +0/−4
• lib/Data/GI/GIR/Callback.hs +4/−1
• lib/Data/GI/GIR/Field.hs +3/−0
• lib/Data/GI/GIR/Property.hs +3/−0
• lib/Data/GI/GIR/Signal.hs +4/−1

@@ -1,3 +1,9 @@+### 0.20.4+++ Improve marshaling of array arguments with no specified size. This improves the generated bindings for various functions, for instance [`GObject.signalEmitv`](https://hackage.haskell.org/package/gi-gobject/docs/GI-GObject-Functions.html#v:signalEmitv).+++ Replace the enable-overloading flags with a explicit CPP check of the version of `haskell-gi-overloading` we are being compiled against, see [issue 124](https://github.com/haskell-gi/haskell-gi/issues/124) for the rationale.+ ### 0.20.3  + Make the overloading code protected by a CPP conditional, depending on ENABLE_OVERLOADING being defined. See [issue 107](https://github.com/haskell-gi/haskell-gi/issues/107).

@@ -1,5 +1,5 @@ name:                haskell-gi-version:             0.20.3+version:             0.21.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.@@ -26,7 +26,7 @@ Library   pkgconfig-depends:   gobject-introspection-1.0 >= 1.32, gobject-2.0 >= 2.32   build-depends:       base >= 4.7 && < 5,-                       haskell-gi-base == 0.20.*,+                       haskell-gi-base == 0.21.*,                        Cabal >= 1.20,                        attoparsec == 0.13.*,                        containers,@@ -42,6 +42,9 @@                        xml-conduit >= 1.3.0,                        regex-tdfa >= 1.2,                        text >= 1.0++  if !impl(ghc >= 8.0)+    build-depends: semigroups == 0.18.*    extensions:          CPP, ForeignFunctionInterface, DoAndIfThenElse, LambdaCase, RankNTypes, OverloadedStrings   ghc-options:         -Wall -fno-warn-missing-signatures -fwarn-incomplete-patterns -fno-warn-name-shadowing

@@ -9,12 +9,6 @@ import Distribution.Simple.Setup import Distribution.Simple (UserHooks(..), simpleUserHooks,                             defaultMainWithHooks, OptimisationLevel(..))-#if !MIN_VERSION_Cabal(2,0,0)-import Distribution.Simple (Dependency(..), PackageName(..), unPackageName)-#else-import Distribution.Types.PkgconfigDependency (PkgconfigDependency(..))-import Distribution.Types.PkgconfigName (unPkgconfigName)-#endif import Distribution.PackageDescription  import Data.GI.CodeGen.API (loadGIRInfo)@@ -25,14 +19,12 @@ import Data.GI.CodeGen.ModulePath (toModulePath) import Data.GI.CodeGen.Overrides (parseOverridesFile, girFixups,                                   filterAPIsAndDeps)-import Data.GI.CodeGen.PkgConfig (tryPkgConfig)-import Data.GI.CodeGen.Util (ucFirst, tshow, utf8ReadFile, utf8WriteFile)+import Data.GI.CodeGen.Util (ucFirst, utf8ReadFile)  import Control.Monad (when, void)  import Data.Maybe (fromJust, fromMaybe) import qualified Data.Map as M-import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T @@ -42,43 +34,6 @@ type ConfHook = (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags               -> IO LocalBuildInfo -#if !MIN_VERSION_Cabal(2,0,0)-#define PkgconfigDependency Dependency--unPkgconfigName :: PackageName -> String-unPkgconfigName = unPackageName--unFlagName :: FlagName -> String-unFlagName (FlagName n) = n-#endif---- | Generate the @PkgInfo@ module, listing the build information for--- the module. We include in particular the versions for the--- `pkg-config` dependencies of the module.-genPkgInfo :: [PkgconfigDependency] -> [(FlagName, Bool)] -> FilePath -> Text-           -> IO ()-genPkgInfo deps flags fName modName = do-  versions <- mapM findVersion deps-  utf8WriteFile fName $ T.unlines-         [ "module " <> modName <> " (pkgConfigVersions, flags) where"-         , ""-         , "import Prelude (String, Bool(..))"-         , ""-         , "pkgConfigVersions :: [(String, String)]"-         , "pkgConfigVersions = " <> tshow versions-         , ""-         , "flags :: [(String, Bool)]"-         , "flags = " <> tshow flags'-         ]-    where findVersion :: PkgconfigDependency -> IO (Text, Text)-          findVersion (PkgconfigDependency n _) =-              tryPkgConfig (T.pack (unPkgconfigName n)) >>= \case-                  Just v -> return v-                  Nothing -> error ("Could not determine version for required pkg-config module \"" <> (unPkgconfigName n) <> "\".")--          flags' :: [(String, Bool)]-          flags' = map (\(f, v) -> (unFlagName f, v)) flags- -- | A convenience helper for `confHook`, such that bindings for the -- given module are generated in the @configure@ step of @cabal@. confCodeGenHook :: Text -- ^ name@@ -109,8 +64,7 @@    let m = genCode cfg allAPIs (toModulePath name) (genModule apis) -  let pkgInfoMod = "GI." <> ucFirst name <> ".PkgInfo"-      em' = map (MN.fromString . T.unpack) (pkgInfoMod : listModuleTree m)+  let em' = map (MN.fromString . T.unpack) (listModuleTree m)       ctd' = ((condTreeData . fromJust . condLibrary) gpd) {exposedModules = em'}       cL' = ((fromJust . condLibrary) gpd) {condTreeData = ctd'}       gpd' = gpd {condLibrary = Just cL'}@@ -119,12 +73,6 @@                                 </> "GI" </> T.unpack (ucFirst name) <.> "hs")   when (not alreadyDone) $ do     void $ writeModuleTree verbosity outputDir m-    genPkgInfo ((pkgconfigDepends . libBuildInfo . condTreeData .-                  fromJust . condLibrary) gpd)-               (configConfigurationsFlags flags)-               (fromMaybe "" outputDir-                   </> "GI" </> T.unpack (ucFirst name) </> "PkgInfo.hs")-               pkgInfoMod    lbi <- defaultConfHook (gpd', hbi) flags 

@@ -36,7 +36,7 @@ import Data.GI.CodeGen.API import Data.GI.CodeGen.Code import Data.GI.CodeGen.Conversions-import Data.GI.CodeGen.Haddock (deprecatedPragma,+import Data.GI.CodeGen.Haddock (deprecatedPragma, writeHaddock,                                 writeDocumentation, RelativeDocPosition(..),                                 writeArgDocumentation, writeReturnDocumentation) import Data.GI.CodeGen.SymbolNaming@@ -85,7 +85,9 @@         line =<< last     return hSymbol     where-    hSymbol = cSymbol+    hSymbol = if T.any (== '_') cSymbol+              then lcFirst cSymbol+              else "_" <> cSymbol     first = "foreign import ccall \"" <> cSymbol <> "\" " <> hSymbol <> " :: "     fArgStr arg = do         ft <- foreignType $ argType arg@@ -252,7 +254,8 @@           Just name -> freeFn arg name $                        -- Pass in the length argument in case it's needed.                        case argType arg of-                         TCArray False (-1) (-1) _ -> undefined+                         TCArray False (-1) (-1) _ ->+                           parenthesize ("length " <> escapedArgName arg)                          TCArray False (-1) length _ ->                              escapedArgName $ (args callable)!!length                          _ -> undefined@@ -654,9 +657,12 @@     where       unwrappedConvertResult rname =           case returnType callable of-            -- Arrays without length information are just passed-            -- along.-            Just (TCArray False (-1) (-1) _) -> return rname+            -- Arrays without length information cannot be converted+            -- into Haskell values.+            Just (t@(TCArray False (-1) (-1) _)) ->+                badIntroError ("`" <> tshow t <>+                "' is an array type, but contains no length information,\n"+                <> "so it cannot be unpacked.")             -- Not zero-terminated C arrays require knowledge of the             -- length, so we deal with them directly.             Just (t@(TCArray False _ _ _)) ->@@ -677,11 +683,12 @@       Just name' -> return name'       Nothing -> badIntroError $ "Parameter " <> name <> " not found!"   case argType arg of-      -- Passed along as a raw pointer-      TCArray False (-1) (-1) _ ->+      t@(TCArray False (-1) (-1) _) ->           if argCallerAllocates arg           then return inName-          else genConversion inName $ apply $ M "peek"+          else  badIntroError ("`" <> tshow t <>+                "' is an array type, but contains no length information,\n"+                <> "so it cannot be unpacked.")       t@(TCArray False _ _ _) -> do           aname' <- if argCallerAllocates arg                     then return inName@@ -925,6 +932,12 @@    blank +  writeHaddock DocBeforeSymbol dynamicDoc+   let dyn = DynamicWrapper { dynamicWrapper = wrapper                            , dynamicType    = typeSynonym }   genHaskellWrapper n (DynamicForeignSymbol dyn) callable' WithClosures++  where+    dynamicDoc :: Text+    dynamicDoc = "Given a pointer to a foreign C function, wrap it into a function callable from Haskell."

@@ -1,7 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Data.GI.CodeGen.Code     ( Code-    , ModuleInfo(moduleCode, moduleDoc)+    , ModuleInfo(moduleCode, sectionDocs)     , ModuleFlag(..)     , BaseCodeGen     , CodeGen@@ -44,13 +44,14 @@     , setModuleFlags     , setModuleMinBase -    , exportToplevel     , exportModule     , exportDecl-    , exportMethod-    , exportProperty-    , exportSignal+    , export+    , HaddockSection(..)+    , NamedSection(..) +    , addSectionFormattedDocs+     , findAPI     , getAPI     , findAPIByName@@ -74,6 +75,7 @@ import qualified Data.Map.Strict as M import Data.Sequence (ViewL ((:<)), viewl, (|>)) import qualified Data.Sequence as Seq+import qualified Data.Semigroup as Sem import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T@@ -94,12 +96,12 @@ import Data.GI.CodeGen.ProjectInfo (authors, license, maintainers)  -- | Set of CPP conditionals understood by the code generator.-data CPPConditional = CPPIfdef Text -- ^ #ifdef Foo+data CPPConditional = CPPIf Text -- ^ #if Foo   deriving (Eq, Show, Ord)  -- | The generated `Code` is a sequence of `CodeToken`s. newtype Code = Code (Seq.Seq CodeToken)-  deriving (Monoid, Eq, Show, Ord)+  deriving (Sem.Semigroup, Monoid, Eq, Show, Ord)  -- | Initializes a code block to the empty sequence. emptyCode :: Code@@ -127,9 +129,20 @@ type Deps = Set.Set Text  -- | Subsection of the haddock documentation where the export should--- be located.-type HaddockSection = Text+-- be located, or alternatively the toplevel section.+data HaddockSection = ToplevelSection+                    | NamedSubsection NamedSection Text+  deriving (Show, Eq, Ord) +-- | Known subsections. The ordering here is the ordering in which+-- they will appear in the haddocks.+data NamedSection = MethodSection+                  | PropertySection+                  | SignalSection+                  | EnumSection+                  | FlagSection+  deriving (Show, Eq, Ord)+ -- | Symbol to export. type SymbolName = Text @@ -145,11 +158,9 @@     } deriving (Show, Eq, Ord)  -- | Possible types of exports.-data ExportType = ExportTypeDecl -- ^ A type declaration.-                | ExportToplevel -- ^ An export in no specific section.-                | ExportMethod HaddockSection -- ^ A method for a struct/union, etc.-                | ExportProperty HaddockSection -- ^ A property for an object/interface.-                | ExportSignal HaddockSection  -- ^ A signal for an object/interface.+data ExportType = ExportSymbol HaddockSection -- ^ An export in the+                  -- given haddock section.+                | ExportTypeDecl -- ^ A type declaration.                 | ExportModule   -- ^ Reexport of a whole module.                   deriving (Show, Eq, Ord) @@ -166,7 +177,9 @@     , modulePragmas :: Set.Set Text -- ^ Set of language pragmas for the module.     , moduleGHCOpts :: Set.Set Text -- ^ GHC options for compiling the module.     , moduleFlags   :: Set.Set ModuleFlag -- ^ Flags for the module.-    , moduleDoc     :: Maybe Text -- ^ Documentation for the module.+    , sectionDocs   :: M.Map HaddockSection Text -- ^ Documentation+                                     -- for the different sections in+                                     -- the module.     , moduleMinBase :: BaseVersion -- ^ Minimal version of base the                                    -- module will work on.     }@@ -198,7 +211,7 @@                            , modulePragmas = Set.empty                            , moduleGHCOpts = Set.empty                            , moduleFlags = Set.empty-                           , moduleDoc = Nothing+                           , sectionDocs = M.empty                            , moduleMinBase = Base47                            } @@ -258,7 +271,7 @@ cleanInfo info = info { moduleCode = emptyCode, submodules = M.empty,                         bootCode = emptyCode, moduleExports = Seq.empty,                         qualifiedImports = Set.empty,-                        moduleDoc = Nothing, moduleMinBase = Base47 }+                        sectionDocs = M.empty, moduleMinBase = Base47 }  -- | Run the given code generator using the state and config of an -- ambient CodeGen, but without adding the generated code to@@ -305,13 +318,13 @@         newGHCOpts = Set.union (moduleGHCOpts oldState) (moduleGHCOpts newState)         newFlags = Set.union (moduleFlags oldState) (moduleFlags newState)         newBoot = bootCode oldState <> bootCode newState-        newDoc = moduleDoc oldState <> moduleDoc newState+        newDocs = sectionDocs oldState <> sectionDocs newState         newMinBase = max (moduleMinBase oldState) (moduleMinBase newState)     in oldState {moduleDeps = newDeps, submodules = newSubmodules,                  moduleExports = newExports, qualifiedImports = newImports,                  modulePragmas = newPragmas,                  moduleGHCOpts = newGHCOpts, moduleFlags = newFlags,-                 bootCode = newBoot, moduleDoc = newDoc,+                 bootCode = newBoot, sectionDocs = newDocs,                  moduleMinBase = newMinBase }  -- | Merge the infos, including code too.@@ -541,15 +554,15 @@   blank   return x --- | Guard a block of code with @#ifdef@.-cppIfdef :: Text -> BaseCodeGen e a -> BaseCodeGen e a-cppIfdef cond cg = do+-- | Guard a block of code with @#if@.+cppIfBlock :: Text -> BaseCodeGen e a -> BaseCodeGen e a+cppIfBlock cond cg = do   (x, code) <- recurseWithState addConditional cg-  tellCode (CPPBlock (CPPIfdef cond) code)+  tellCode (CPPBlock (CPPIf cond) code)   blank   return x     where addConditional :: CGState -> CGState-          addConditional cgs = CGState {cgsCPPConditionals = CPPIfdef cond :+          addConditional cgs = CGState {cgsCPPConditionals = CPPIf cond :                                          cgsCPPConditionals cgs}  -- | Possible features to test via CPP.@@ -558,7 +571,7 @@ -- | Guard a code block with CPP code, such that it is included only -- if the specified feature is enabled. cppIf :: CPPGuard -> BaseCodeGen e a -> BaseCodeGen e a-cppIf CPPOverloading = cppIfdef "ENABLE_OVERLOADING"+cppIf CPPOverloading = cppIfBlock "ENABLE_OVERLOADING"  -- | Write the given code into the .hs-boot file for the current module. hsBoot :: BaseCodeGen e a -> BaseCodeGen e a@@ -572,35 +585,23 @@         addGuards (cond : conds) c = codeSingleton $ CPPBlock cond (addGuards conds c)  -- | Add a export to the current module.-export :: ([CPPConditional] -> Export) -> CodeGen ()-export partial =+exportPartial :: ([CPPConditional] -> Export) -> CodeGen ()+exportPartial partial =     modify' $ \(cgs, s) -> (cgs,                             let e = partial $ cgsCPPConditionals cgs                             in s{moduleExports = moduleExports s |> e})  -- | Reexport a whole module. exportModule :: SymbolName -> CodeGen ()-exportModule m = export (Export ExportModule m)---- | Export a toplevel (i.e. belonging to no section) symbol.-exportToplevel :: SymbolName -> CodeGen ()-exportToplevel t = export (Export ExportToplevel t)+exportModule m = exportPartial (Export ExportModule m)  -- | Add a type declaration-related export. exportDecl :: SymbolName -> CodeGen ()-exportDecl d = export (Export ExportTypeDecl d)---- | Add a method export under the given section.-exportMethod :: HaddockSection -> SymbolName -> CodeGen ()-exportMethod s n = export (Export (ExportMethod s) n)---- | Add a property-related export under the given section.-exportProperty :: HaddockSection -> SymbolName -> CodeGen ()-exportProperty s n = export (Export (ExportProperty s) n)+exportDecl d = exportPartial (Export ExportTypeDecl d) --- | Add a signal-related export under the given section.-exportSignal :: HaddockSection -> SymbolName -> CodeGen ()-exportSignal s n = export (Export (ExportSignal s) n)+-- | Export a symbol in the given haddock subsection.+export :: HaddockSection -> SymbolName -> CodeGen ()+export s n = exportPartial (Export (ExportSymbol s) n)  -- | Set the language pragmas for the current module. setLanguagePragmas :: [Text] -> CodeGen ()@@ -622,9 +623,15 @@ setModuleMinBase v =     modify' $ \(cgs, s) -> (cgs, s{moduleMinBase = max v (moduleMinBase s)}) +-- | Add documentation for a given section.+addSectionFormattedDocs :: HaddockSection -> Text -> CodeGen ()+addSectionFormattedDocs section docs =+    modify' $ \(cgs, s) -> (cgs, s{sectionDocs = M.insertWith (<>) section+                                                 docs (sectionDocs s)})+ -- | Format a CPP conditional. cppCondFormat :: CPPConditional -> (Text, Text)-cppCondFormat (CPPIfdef c) = ("#ifdef " <> c <> "\n", "#endif\n")+cppCondFormat (CPPIf c) = ("#if " <> c <> "\n", "#endif\n")  -- | Return a text representation of the `Code`. codeToText :: Code -> Text@@ -672,7 +679,7 @@ formatToplevel [] = Nothing formatToplevel exports =     Just . T.concat . map (formatExport exportSymbol)-         . filter ((== ExportToplevel) . exportType) $ exports+         . filter ((== ExportSymbol ToplevelSection) . exportType) $ exports  -- | Format the type declarations section. formatTypeDecls :: [Export] -> Maybe Text@@ -687,30 +694,44 @@ -- | A subsection name, with an optional anchor name. data Subsection = Subsection { subsectionTitle  :: Text                              , subsectionAnchor :: Maybe Text+                             , subsectionDoc    :: Maybe Text                              } deriving (Eq, Show, Ord) --- | A subsection with an anchor given by the title and @prefix:title@ anchor.-subsecWithPrefix prefix title =+-- | A subsection with an anchor given by the title and @prefix:title@+-- anchor, and the given documentation.+subsecWithPrefix :: NamedSection -> Text -> Maybe Text -> Subsection+subsecWithPrefix mainSection title doc =   Subsection { subsectionTitle = title-             , subsectionAnchor = Just (prefix <> ":" <> title) }+             , subsectionAnchor = Just (prefix <> ":" <> title)+             , subsectionDoc = doc }+  where prefix = case mainSection of+          MethodSection -> "method"+          PropertySection -> "attr"+          SignalSection -> "signal"+          EnumSection -> "enum"+          FlagSection -> "flag" +-- | User-facing name in the Haddocks for the given main section.+mainSectionName :: NamedSection -> Text+mainSectionName MethodSection = "Methods"+mainSectionName PropertySection = "Properties"+mainSectionName SignalSection = "Signals"+mainSectionName EnumSection = "Enumerations"+mainSectionName FlagSection = "Flags"+ -- | Format a given section made of subsections.-formatSection :: Text -> (Export -> Maybe (Subsection, Export)) ->-                 [Export] -> Maybe Text-formatSection section filter exports =-    if M.null exportedSubsections+formatSection :: NamedSection -> [(Subsection, Export)] -> Maybe Text+formatSection section exports =+    if null exports     then Nothing-    else Just . T.unlines $ [" -- * " <> section+    else Just . T.unlines $ [" -- * " <> mainSectionName section                             , ( T.unlines                               . map formatSubsection                               . M.toList ) exportedSubsections]      where-      filteredExports :: [(Subsection, Export)]-      filteredExports = catMaybes (map filter exports)-       exportedSubsections :: M.Map Subsection (Set.Set Export)-      exportedSubsections = foldr extract M.empty filteredExports+      exportedSubsections = foldr extract M.empty exports        extract :: (Subsection, Export) -> M.Map Subsection (Set.Set Export)               -> M.Map Subsection (Set.Set Export)@@ -723,44 +744,37 @@                                     Just anchor -> subsectionTitle subsec <>                                                    " #" <> anchor <> "#"                                     Nothing -> subsectionTitle subsec+                    , case subsectionDoc subsec of+                        Just text -> "{- | " <> text  <> "\n-}"+                        Nothing -> ""                     , ( T.concat                       . map (formatExport exportSymbol)                       . Set.toList ) symbols] --- | Format the list of methods.-formatMethods :: [Export] -> Maybe Text-formatMethods = formatSection "Methods" toMethod-    where toMethod :: Export -> Maybe (Subsection, Export)-          toMethod e@(Export (ExportMethod s) _ _) =-            Just (subsecWithPrefix "method" s, e)-          toMethod _ = Nothing---- | Format the list of properties.-formatProperties :: [Export] -> Maybe Text-formatProperties = formatSection "Properties" toProperty-    where toProperty :: Export -> Maybe (Subsection, Export)-          toProperty e@(Export (ExportProperty s) _ _) =-            Just (subsecWithPrefix "attr" s, e)-          toProperty _ = Nothing+-- | Format the list of exports into grouped sections.+formatSubsectionExports :: M.Map HaddockSection Text -> [Export] -> [Maybe Text]+formatSubsectionExports docs exports = map (uncurry formatSection)+                                       (M.toAscList collectedExports)+  where collectedExports :: M.Map NamedSection [(Subsection, Export)]+        collectedExports = foldl classifyExport M.empty exports --- | Format the list of signals.-formatSignals :: [Export] -> Maybe Text-formatSignals = formatSection "Signals" toSignal-    where toSignal :: Export -> Maybe (Subsection, Export)-          toSignal e@(Export (ExportSignal s) _ _) =-            Just (subsecWithPrefix "signal" s, e)-          toSignal _ = Nothing+        classifyExport :: M.Map NamedSection [(Subsection, Export)] ->+                          Export -> M.Map NamedSection [(Subsection, Export)]+        classifyExport m export =+          case exportType export of+            ExportSymbol hs@(NamedSubsection ms n) ->+              let subsec = subsecWithPrefix ms n (M.lookup hs docs)+              in M.insertWith (++) ms [(subsec, export)] m+            _ -> m  -- | Format the given export list. This is just the inside of the -- parenthesis.-formatExportList :: [Export] -> Text-formatExportList exports =-    T.unlines . catMaybes $ [ formatExportedModules exports-                            , formatToplevel exports-                            , formatTypeDecls exports-                            , formatMethods exports-                            , formatProperties exports-                            , formatSignals exports ]+formatExportList :: M.Map HaddockSection Text -> [Export] -> Text+formatExportList docs exports =+    T.unlines . catMaybes $ formatExportedModules exports+                            : formatToplevel exports+                            : formatTypeDecls exports+                            : formatSubsectionExports docs exports  -- | Write down the list of language pragmas. languagePragmas :: [Text] -> Text@@ -772,6 +786,13 @@ ghcOptions [] = "" ghcOptions opts = "{-# OPTIONS_GHC " <> T.intercalate ", " opts <> " #-}\n" +-- | Generate some convenience CPP macros.+cppMacros :: Text+cppMacros = T.unlines ["#define ENABLE_OVERLOADING (MIN_VERSION_haskell_gi_overloading(1,0,0) \\"+                      -- Haddocks look better without overloading+                      , "       && !defined(__HADDOCK_VERSION__))"+                      ]+ -- | Standard fields for every module. standardFields :: Text standardFields = T.unlines [ "Copyright  : " <> authors@@ -785,22 +806,22 @@                                               description, "-}"]  -- | Generic module prelude. We reexport all of the submodules.-modulePrelude :: Text -> [Export] -> [Text] -> Text-modulePrelude name [] [] = "module " <> name <> " () where\n"-modulePrelude name exports [] =+modulePrelude :: M.Map HaddockSection Text -> Text -> [Export] -> [Text] -> Text+modulePrelude _ name [] [] = "module " <> name <> " () where\n"+modulePrelude docs name exports [] =     "module " <> name <> "\n    ( "-    <> formatExportList exports+    <> formatExportList docs exports     <> "    ) where\n"-modulePrelude name [] reexportedModules =+modulePrelude docs name [] reexportedModules =     "module " <> name <> "\n    ( "-    <> formatExportList (map (\m -> Export ExportModule m []) reexportedModules)+    <> formatExportList docs (map (\m -> Export ExportModule m []) reexportedModules)     <> "    ) where\n\n"     <> T.unlines (map ("import " <>) reexportedModules)-modulePrelude name exports reexportedModules =+modulePrelude docs name exports reexportedModules =     "module " <> name <> "\n    ( "-    <> formatExportList (map (\m -> Export ExportModule m []) reexportedModules)+    <> formatExportList docs (map (\m -> Export ExportModule m []) reexportedModules)     <> "\n"-    <> formatExportList exports+    <> formatExportList docs exports     <> "    ) where\n\n"     <> T.unlines (map ("import " <>) reexportedModules) @@ -833,6 +854,7 @@                 , "import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr"                 , "import qualified Data.GI.Base.GError as B.GError"                 , "import qualified Data.GI.Base.GVariant as B.GVariant"+                , "import qualified Data.GI.Base.GValue as B.GValue"                 , "import qualified Data.GI.Base.GParamSpec as B.GParamSpec"                 , "import qualified Data.GI.Base.CallStack as B.CallStack"                 , "import qualified Data.Text as T"@@ -857,7 +879,8 @@       code = codeToText (moduleCode minfo)       pragmas = languagePragmas (Set.toList $ modulePragmas minfo)       optionsGHC = ghcOptions (Set.toList $ moduleGHCOpts minfo)-      prelude = modulePrelude (dotWithPrefix $ modulePath minfo)+      prelude = modulePrelude (sectionDocs minfo)+                (dotWithPrefix $ modulePath minfo)                 (F.toList (moduleExports minfo))                 submoduleExports       imports = if ImplicitPrelude `Set.member` moduleFlags minfo@@ -865,12 +888,12 @@                 else moduleImports       pkgRoot = ModulePath (take 1 (modulePathToList $ modulePath minfo))       deps = importDeps pkgRoot (Set.toList $ qualifiedImports minfo)-      haddock = moduleHaddock (moduleDoc minfo)+      haddock = moduleHaddock (M.lookup ToplevelSection (sectionDocs minfo))    when verbose $ putStrLn ((T.unpack . dotWithPrefix . modulePath) minfo                            ++ " -> " ++ fname)   createDirectoryIfMissing True dirname-  utf8WriteFile fname (T.unlines [pragmas, optionsGHC, haddock,+  utf8WriteFile fname (T.unlines [pragmas, optionsGHC, haddock, cppMacros,                                  prelude, imports, deps, code])   when (not . isCodeEmpty $ bootCode minfo) $ do     let bootFName = modulePathToFilePath dirPrefix (modulePath minfo) ".hs-boot"@@ -879,6 +902,7 @@ -- | Generate the .hs-boot file for the given module. genHsBoot :: ModuleInfo -> Text genHsBoot minfo =+    cppMacros <>     "module " <> (dotWithPrefix . modulePath) minfo <> " where\n\n" <>     moduleImports <> "\n" <>     codeToText (bootCode minfo)

@@ -24,7 +24,9 @@ import Data.GI.CodeGen.Fixups (dropMovedItems, guessPropertyNullability,                                detectGObject) import Data.GI.CodeGen.GObject-import Data.GI.CodeGen.Haddock (deprecatedPragma, addModuleDocumentation)+import Data.GI.CodeGen.Haddock (deprecatedPragma, addSectionDocumentation,+                                writeHaddock,+                                RelativeDocPosition(DocBeforeSymbol)) import Data.GI.CodeGen.Inheritance (instanceTree, fullObjectMethodList,                        fullInterfaceMethodList) import Data.GI.CodeGen.Properties (genInterfaceProperties, genObjectProperties,@@ -52,7 +54,7 @@                            <> "\n-- Error was : " <> describeCGError e))                         (do                           genCCallableWrapper n symbol callable-                          exportMethod (lowerName n) (lowerName n)+                          export (NamedSubsection MethodSection $ lowerName n) (lowerName n)                         )  genBoxedObject :: Name -> Text -> CodeGen ()@@ -74,11 +76,12 @@ genStruct n s = unless (ignoreStruct n s) $ do    let name' = upperName n +   writeHaddock DocBeforeSymbol ("Memory-managed wrapper type.")    let decl = line $ "newtype " <> name' <> " = " <> name' <> " (ManagedPtr " <> name' <> ")"    hsBoot decl    decl -   addModuleDocumentation (structDocumentation s)+   addSectionDocumentation ToplevelSection (structDocumentation s)     if structIsBoxed s    then genBoxedObject n (fromJust $ structTypeInit s)@@ -116,11 +119,12 @@ genUnion n u = do   let name' = upperName n +  writeHaddock DocBeforeSymbol ("Memory-managed wrapper type.")   let decl = line $ "newtype " <> name' <> " = " <> name' <> " (ManagedPtr " <> name' <> ")"   hsBoot decl   decl -  addModuleDocumentation (unionDocumentation u)+  addSectionDocumentation ToplevelSection (unionDocumentation u)    if unionIsBoxed u   then genBoxedObject n (fromJust $ unionTypeInit u)@@ -225,7 +229,7 @@               then fixMethodArgs c'               else c'     genCCallableWrapper mn' sym c''-    exportMethod (lowerName mn) (lowerName mn')+    export (NamedSubsection MethodSection $ lowerName mn) (lowerName mn')      cppIf CPPOverloading $          genMethodInfo cn (m {methodCallable = c''})@@ -247,6 +251,8 @@   className <- classConstraint n   group $ do     exportDecl className+    writeHaddock DocBeforeSymbol (classDoc name')+     bline $ "class GObject o => " <> className <> " o"     line $ "#if MIN_VERSION_base(4,9,0)"     line $ "instance {-# OVERLAPPABLE #-} (GObject a, O.UnknownAncestorError "@@ -262,10 +268,20 @@   group $ do     let safeCast = "to" <> name'     exportDecl safeCast+    writeHaddock DocBeforeSymbol (castDoc name')     line $ safeCast <> " :: (MonadIO m, " <> className <> " o) => o -> m " <> name'     line $ safeCast <> " = liftIO . unsafeCastTo " <> name' --- Wrap a given Object. We enforce that every Object that we wrap is a+  where castDoc :: Text -> Text+        castDoc name' = "Cast to `" <> name' <>+                        "`, for types for which this is known to be safe. " <>+                        "For general casts, use `Data.GI.Base.ManagedPtr.castTo`."++        classDoc :: Text -> Text+        classDoc name' = "Type class for types which can be safely cast to `"+                         <> name' <> "`, for instance with `to" <> name' <> "`."++-- | Wrap a given Object. We enforce that every Object that we wrap is a -- GObject. This is the case for everything except the ParamSpec* set -- of objects, we deal with these separately. genObject :: Name -> Object -> CodeGen ()@@ -278,10 +294,11 @@   then line $ "-- APIObject \"" <> name' <>                 "\" does not descend from GObject, it will be ignored."   else do+    writeHaddock DocBeforeSymbol ("Memory-managed wrapper type.")     bline $ "newtype " <> name' <> " = " <> name' <> " (ManagedPtr " <> name' <> ")"     exportDecl (name' <> "(..)") -    addModuleDocumentation (objDocumentation o)+    addSectionDocumentation ToplevelSection (objDocumentation o)      -- Type safe casting to parent objects, and implemented interfaces.     parents <- instanceTree n@@ -320,11 +337,12 @@   let name' = upperName n    line $ "-- interface " <> name' <> " "+  writeHaddock DocBeforeSymbol ("Memory-managed wrapper type.")   deprecatedPragma name' $ ifDeprecated iface   bline $ "newtype " <> name' <> " = " <> name' <> " (ManagedPtr " <> name' <> ")"   exportDecl (name' <> "(..)") -  addModuleDocumentation (ifDocumentation iface)+  addSectionDocumentation ToplevelSection (ifDocumentation iface)    noName name' @@ -353,6 +371,9 @@   else group $ do     cls <- classConstraint n     exportDecl cls+    writeHaddock DocBeforeSymbol ("Type class for types which implement `"+                                  <> name' <> "`.")+     bline $ "class ManagedPtrNewtype a => " <> cls <> " a"     line $ "instance " <> cls <> " " <> name'     genWrappedPtr n (ifAllocationInfo iface) 0

@@ -50,7 +50,7 @@   handleCGExc (\e -> line $ "-- XXX: Could not generate constant: " <> describeCGError e)     (do writeDocumentation DocBeforeSymbol (constantDocumentation c)         assignValue name (constantType c) (constantValue c)-        exportToplevel ("pattern " <> name))+        export ToplevelSection ("pattern " <> name))  -- | Assign to the given name the given constant value, in a way that -- can be assigned to the corresponding Haskell type.

@@ -164,7 +164,7 @@            genConversion l next     Literal Id next -> genConversion l next --- Given an array, together with its type, return the code for reading+-- | Given an array, together with its type, return the code for reading -- its length. computeArrayLength :: Text -> Type -> ExcCodeGen Text computeArrayLength array (TCArray _ _ _ t) = do@@ -371,8 +371,6 @@ hToF (TGArray t) transfer = hToF_PackedType t "packGArray" transfer hToF (TPtrArray t) transfer = hToF_PackedType t "packGPtrArray" transfer hToF (TGHash ta tb) _ = hToF_PackGHashTable ta tb--- Arrays without length info are just passed along.-hToF (TCArray False (-1) (-1) _) _ = return $ Pure () hToF (TCArray zt _ _ t@(TCArray{})) transfer = do   let packer = if zt                then "packZeroTerminated"@@ -453,14 +451,14 @@ fVariantToH :: Transfer -> CodeGen Constructor fVariantToH transfer =   return $ M $ case transfer of-                  TransferEverything -> "wrapGVariantPtr"-                  _ -> "newGVariantFromPtr"+                  TransferEverything -> "B.GVariant.wrapGVariantPtr"+                  _ -> "B.GVariant.newGVariantFromPtr"  fParamSpecToH :: Transfer -> CodeGen Constructor fParamSpecToH transfer =   return $ M $ case transfer of-                  TransferEverything -> "wrapGParamSpecPtr"-                  _ -> "newGParamSpecFromPtr"+                  TransferEverything -> "B.GParamSpec.wrapGParamSpecPtr"+                  _ -> "B.GParamSpec.newGParamSpecFromPtr"  fToH' :: Type -> Maybe API -> TypeRep -> TypeRep -> Transfer          -> ExcCodeGen Constructor@@ -545,20 +543,22 @@ fToH (TGList t) transfer = do   isPtr <- typeIsPtr t   when (not isPtr) $-       badIntroError ("'" <> tshow t <>+       badIntroError ("`" <> tshow t <>                       "' is not a pointer type, cannot unpack from a GList.")   fToH_PackedType t "unpackGList" transfer fToH (TGSList t) transfer = do   isPtr <- typeIsPtr t   when (not isPtr) $-       badIntroError ("'" <> tshow t <>+       badIntroError ("`" <> tshow t <>                       "' is not a pointer type, cannot unpack from a GSList.")   fToH_PackedType t "unpackGSList" transfer fToH (TGArray t) transfer = fToH_PackedType t "unpackGArray" transfer fToH (TPtrArray t) transfer = fToH_PackedType t "unpackGPtrArray" transfer fToH (TGHash a b) transfer = fToH_UnpackGHashTable a b transfer--- Arrays without length info are just passed along.-fToH (TCArray False (-1) (-1) _) _ = return $ Pure ()+-- We cannot unpack arrays without any kind of length info.+fToH t@(TCArray False (-1) (-1) _) _ =+  badIntroError ("`" <> tshow t <>+                  "' is an array type, but contains no length information.") fToH (TCArray True _ _ t@(TCArray{})) transfer =   fToH_PackedType t "unpackZeroTerminatedPtrArray" transfer fToH (TCArray True _ _ t@(TInterface _)) transfer = do@@ -662,7 +662,7 @@  unpackCArray _ _ _ = notImplementedError "unpackCArray : unexpected array type." --- Given a type find the typeclasses the type belongs to, and return+-- | Given a type find the typeclasses the type belongs to, and return -- the representation of the type in the function signature and the -- list of typeclass constraints for the type. argumentType :: [Char] -> Type -> CodeGen ([Char], Text, [Text])@@ -731,15 +731,15 @@ haskellBasicType TIntPtr   = con0 "CIntPtr" haskellBasicType TUIntPtr  = con0 "CUIntPtr" --- This translates GI types to the types used for generated Haskell code.+-- | This translates GI types to the types used for generated Haskell code. haskellType :: Type -> CodeGen TypeRep haskellType (TBasicType bt) = return $ haskellBasicType bt--- We cannot really do anything sensible for a foreign array with no--- length info, so just pass the pointer along.-haskellType (TCArray False (-1) (-1) t) =-    ptr <$> foreignType t+-- There is no great choice in this case, so we simply pass the+-- pointer along. This is useful for GdkPixbufNotify, for example.+haskellType t@(TCArray False (-1) (-1) (TBasicType TUInt8)) =+  foreignType t haskellType (TCArray _ _ _ (TBasicType TUInt8)) =-    return $ "ByteString" `con` []+  return $ "ByteString" `con` [] haskellType (TCArray _ _ _ a) = do   inner <- haskellType a   return $ "[]" `con` [inner]@@ -763,8 +763,8 @@ haskellType TError = return $ "GError" `con` [] haskellType TVariant = return $ "GVariant" `con` [] haskellType TParamSpec = return $ "GParamSpec" `con` []-haskellType (TInterface (Name "GObject" "Value")) = return $ "GValue" `con` [] haskellType (TInterface (Name "GObject" "Closure")) = return $ "Closure" `con` []+haskellType (TInterface (Name "GObject" "Value")) = return $ "GValue" `con` [] haskellType t@(TInterface n) = do   api <- getAPI t   tname <- qualifiedAPI n@@ -807,8 +807,6 @@ -- This translates GI types to the types used in foreign function calls. foreignType :: Type -> CodeGen TypeRep foreignType (TBasicType t) = return $ foreignBasicType t-foreignType (TCArray False (-1) (-1) t) =-    ptr <$> foreignType t foreignType (TCArray zt _ _ t) = do   api <- findAPI t   let size = case api of@@ -838,9 +836,10 @@ foreignType t@TError = ptr <$> haskellType t foreignType t@TVariant = ptr <$> haskellType t foreignType t@TParamSpec = ptr <$> haskellType t-foreignType (TInterface (Name "GObject" "Value")) = return $ ptr $ "GValue" `con` [] foreignType (TInterface (Name "GObject" "Closure")) =     return $ ptr $ "Closure" `con` []+foreignType (TInterface (Name "GObject" "Value")) =+  return $ ptr $ "GValue" `con` [] foreignType t@(TInterface n) = do   isScalar <- getIsScalar t   if isScalar@@ -955,11 +954,9 @@ typeIsNullable :: Type -> CodeGen Bool typeIsNullable t = isJust <$> maybeNullConvert t --- If the given type maps to a list in Haskell, return the type of the+-- | If the given type maps to a list in Haskell, return the type of the -- elements, and the function that maps over them. elementTypeAndMap :: Type -> Text -> Maybe (Type, Text)--- Passed along as a raw pointer.-elementTypeAndMap (TCArray False (-1) (-1) _) _ = Nothing -- ByteString elementTypeAndMap (TCArray _ _ _ (TBasicType TUInt8)) _ = Nothing elementTypeAndMap (TCArray True _ _ t) _ = Just (t, "mapZeroTerminatedCArray")

@@ -18,8 +18,8 @@ import Data.GI.CodeGen.SymbolNaming (upperName) import Data.GI.CodeGen.Util (tshow) -genEnumOrFlags :: Name -> Enumeration -> ExcCodeGen ()-genEnumOrFlags n@(Name ns name) e = do+genEnumOrFlags :: HaddockSection -> Name -> Enumeration -> ExcCodeGen ()+genEnumOrFlags docSection n@(Name ns name) e = do   -- Conversion functions expect enums and flags to map to CUInt,   -- which we assume to be of 32 bits. Fail early, instead of giving   -- strange errors at runtime.@@ -36,7 +36,7 @@   deprecatedPragma name' (enumDeprecated e)    group $ do-    exportDecl (name' <> "(..)")+    export docSection (name' <> "(..)")     hsBoot . line $ "data " <> name'     writeDocumentation DocBeforeSymbol (enumDocumentation e)     line $ "data " <> name' <> " = "@@ -69,7 +69,7 @@     line $ "instance P.Ord " <> name' <> " where"     indent $ line "compare a b = P.compare (P.fromEnum a) (P.fromEnum b)" -  maybe (return ()) (genErrorDomain name') (enumErrorDomain e)+  maybe (return ()) (genErrorDomain docSection name') (enumErrorDomain e)  genBoxedEnum :: Name -> Text -> CodeGen () genBoxedEnum n typeInit = do@@ -87,8 +87,9 @@ genEnum n@(Name _ name) enum = do   line $ "-- Enum " <> name +  let docSection = NamedSubsection EnumSection (upperName n)   handleCGExc (\e -> line $ "-- XXX Could not generate: " <> describeCGError e)-              (do genEnumOrFlags n enum+              (do genEnumOrFlags docSection n enum                   case enumTypeInit enum of                     Nothing -> return ()                     Just ti -> genBoxedEnum n ti)@@ -111,9 +112,10 @@ genFlags n@(Name _ name) (Flags enum) = do   line $ "-- Flags " <> name +  let docSection = NamedSubsection FlagSection (upperName n)   handleCGExc (\e -> line $ "-- XXX Could not generate: " <> describeCGError e)               (do-                genEnumOrFlags n enum+                genEnumOrFlags docSection n enum                  case enumTypeInit enum of                   Nothing -> return ()@@ -123,8 +125,8 @@                 group $ bline $ "instance IsGFlag " <> name')  -- | Support for enums encapsulating error codes.-genErrorDomain :: Text -> Text -> CodeGen ()-genErrorDomain name' domain = do+genErrorDomain :: HaddockSection -> Text -> Text -> CodeGen ()+genErrorDomain docSection name' domain = do   group $ do     line $ "instance GErrorClass " <> name' <> " where"     indent $ line $@@ -133,19 +135,29 @@   -- it's clearer to read).   group $ do     let catcher = "catch" <> name'+    writeHaddock DocBeforeSymbol catcherDoc     line $ catcher <> " ::"     indent $ do             line   "IO a ->"             line $ "(" <> name' <> " -> GErrorMessage -> IO a) ->"             line   "IO a"     line $ catcher <> " = catchGErrorJustDomain"+   group $ do     let handler = "handle" <> name'+    writeHaddock DocBeforeSymbol handleDoc     line $ handler <> " ::"     indent $ do             line $ "(" <> name' <> " -> GErrorMessage -> IO a) ->"             line   "IO a ->"             line   "IO a"     line $ handler <> " = handleGErrorJustDomain"-  exportToplevel ("catch" <> name')-  exportToplevel ("handle" <> name')+  export docSection ("catch" <> name')+  export docSection ("handle" <> name')++  where+    catcherDoc :: Text+    catcherDoc = "Catch exceptions of type `" <> name' <> "`. This is a specialized version of `Data.GI.Base.GError.catchGErrorJustDomain`."++    handleDoc :: Text+    handleDoc = "Handle exceptions of type `" <> name' <> "`. This is a specialized version of `Data.GI.Base.GError.handleGErrorJustDomain`."

@@ -7,14 +7,13 @@   , writeHaddock   , writeArgDocumentation   , writeReturnDocumentation-  , addModuleDocumentation+  , addSectionDocumentation   ) where  #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Control.Monad (mapM_, unless)-import Control.Monad.State.Strict (modify') import qualified Data.Map as M import Data.Monoid ((<>)) import qualified Data.Text as T@@ -25,8 +24,8 @@ import Data.GI.GIR.Deprecation (DeprecationInfo(..)) import Data.GI.GIR.Documentation (Documentation(..)) -import Data.GI.CodeGen.Code (CodeGen, config, line, blank,-                             getC2HMap, ModuleInfo(moduleDoc))+import Data.GI.CodeGen.Code (CodeGen, config, line, HaddockSection,+                             getC2HMap, addSectionFormattedDocs) import Data.GI.CodeGen.Config (modName, overrides) import Data.GI.CodeGen.CtoHaskellMap (Hyperlink(..)) import Data.GI.CodeGen.GtkDoc (GtkDoc(..), Token(..), CRef(..), Language(..),@@ -207,23 +206,27 @@                        Nothing -> []                        Just v -> ["(Since version " <> v <> ")"] --- | Write the given documentation into a Haddock comment.-writeDocumentation :: RelativeDocPosition -> Documentation -> CodeGen ()-writeDocumentation pos doc = do-  c2h <- getC2HMap-  docBase <- getDocBase+-- | Format the given documentation into a set of lines. Note that+-- this does include the opening or ending comment delimiters.+formatDocumentation :: M.Map CRef Hyperlink -> Text -> Documentation -> Text+formatDocumentation c2h docBase doc = do   let description = case rawDocText doc of         Just raw -> formatHaddock c2h docBase (parseGtkDoc raw)         Nothing -> "/No description available in the introspection data./"+  description <> case sinceVersion doc of+                   Nothing -> ""+                   Just ver -> "\n\n@since " <> ver++-- | Write the given documentation into generated code.+writeDocumentation :: RelativeDocPosition -> Documentation -> CodeGen ()+writeDocumentation pos doc = do   line $ case pos of            DocBeforeSymbol -> "{- |"            DocAfterSymbol ->  "{- ^"-  mapM_ line (T.lines description)-  case sinceVersion doc of-    Nothing -> return ()-    Just ver -> do-      blank-      line $ "@since " <> ver+  c2h <- getC2HMap+  docBase <- getDocBase+  let haddock = formatDocumentation c2h docBase doc+  mapM_ line (T.lines haddock)   line "-}"  -- | Like `writeDocumentation`, but allows us to pass explicitly the@@ -270,15 +273,10 @@   unless (T.null fullInfo) $     line $ "{- ^ " <>  fullInfo <> " -}" --- | Add the given text to the module-level documentation for the--- module being generated.-addModuleDocumentation :: Documentation -> CodeGen ()-addModuleDocumentation doc =-  case rawDocText doc of-    Nothing -> return ()-    Just raw -> do-      c2h <- getC2HMap-      docBase <- getDocBase-      modify' $ \(cgs, s) -> (cgs, s{moduleDoc = moduleDoc s <>-                                      Just (formatHaddock c2h docBase-                                            (parseGtkDoc raw))})+-- | Add the given text to the documentation for the section being generated.+addSectionDocumentation :: HaddockSection -> Documentation -> CodeGen ()+addSectionDocumentation section doc = do+  c2h <- getC2HMap+  docBase <- getDocBase+  let formatted = formatDocumentation c2h docBase doc+  addSectionFormattedDocs section formatted

@@ -1,3 +1,4 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Abstract representation for paths into modules. module Data.GI.CodeGen.ModulePath   ( ModulePath(..)@@ -9,22 +10,18 @@ import Data.Monoid (Monoid(..), (<>)) import Data.String (IsString(..)) import qualified Data.Text as T+import qualified Data.Semigroup as Sem import Data.Text (Text)  import Data.GI.CodeGen.Util (ucFirst)  -- | A path to a module. newtype ModulePath = ModulePath { modulePathToList :: [Text] }-  deriving (Eq, Show, Ord)+  deriving (Sem.Semigroup, Monoid, Eq, Show, Ord)  -- | Construct a `ModulePath` from a `String`. instance IsString ModulePath where   fromString = toModulePath . T.pack---- | `ModulePath`s are `Monoid`s.-instance Monoid ModulePath where-  mempty = ModulePath []-  mappend (ModulePath as) (ModulePath bs) = ModulePath (as <> bs)  -- | Construct a path into the given GIR namespace. The given `Text` -- will be split along ".".

@@ -78,11 +78,11 @@   line $ "_" <> l <> " :: IsLabelProxy \"" <> l <> "\" a => a"   line $ "_" <> l <> " = fromLabelProxy (Proxy :: Proxy \""            <> l <> "\")"-  exportToplevel ("_" <> l)+  export ToplevelSection ("_" <> l)  genOverloadedLabels :: [(Name, API)] -> CodeGen () genOverloadedLabels allAPIs = do-  setLanguagePragmas ["DataKinds", "FlexibleContexts"]+  setLanguagePragmas ["DataKinds", "FlexibleContexts", "CPP"]   setModuleFlags [ImplicitPrelude]    line $ "import Data.Proxy (Proxy(..))"

@@ -96,7 +96,7 @@         let mn = methodName m             mangled = lowerName (mn {name = name n <> "_" <> name mn})         indent $ line $ "overloadedMethod _ = " <> mangled-        exportMethod (lowerName mn) infoName+        export (NamedSubsection MethodSection $ lowerName mn) infoName  -- | Generate a method info that is not actually callable, but rather -- gives a type error when trying to use it.@@ -110,4 +110,4 @@            <> lowerName (methodName m) <> "\" " <> name n            <> ") => O.MethodInfo " <> infoName <> " o p where"   indent $ line $ "overloadedMethod _ = undefined"-  exportMethod "Unsupported methods" infoName+  export ToplevelSection infoName

@@ -88,7 +88,7 @@       line $ "type HaskellCallbackType " <> si <> " = " <> cbHaskellType       line $ "connectSignal _ obj cb connectMode = do"       indent $ genSignalConnector signal cbHaskellType "connectMode"-  exportSignal (lcFirst sn) si+  export (NamedSubsection SignalSection $ lcFirst sn) si  -- | Signal instances for (GObject-derived) objects. genObjectSignals :: Name -> Object -> CodeGen ()

@@ -13,10 +13,11 @@  import Control.Monad.Except import Control.Monad.State-import Control.Monad.Writer+import Control.Monad.Writer (WriterT, execWriterT, tell)  import Data.Maybe (isJust) import qualified Data.Map as M+import Data.Semigroup as Sem import qualified Data.Set as S import qualified Data.Text as T import Data.Text (Text)@@ -72,8 +73,18 @@ -- encode this so that we can view the parser as a writer monad of -- configs. instance Monoid Overrides where-    mempty = defaultOverrides-    mappend a b = Overrides {+  mempty = defaultOverrides+#if !MIN_VERSION_base(4,11,0)+  mappend = concatOverrides+#endif++-- | There is a sensible notion of zero and addition of Overridess,+-- encode this so that we can view the parser as a writer monad of+-- configs.+instance Sem.Semigroup Overrides where+  (<>) = concatOverrides++concatOverrides a b = Overrides {       ignoredAPIs = ignoredAPIs a <> ignoredAPIs b,       sealedStructs = sealedStructs a <> sealedStructs b,       allocInfo = allocInfo a <> allocInfo b,

@@ -20,6 +20,8 @@ import Data.GI.CodeGen.Conversions import Data.GI.CodeGen.Code import Data.GI.CodeGen.GObject+import Data.GI.CodeGen.Haddock (addSectionDocumentation, writeHaddock,+                                RelativeDocPosition(DocBeforeSymbol)) import Data.GI.CodeGen.Inheritance (fullObjectPropertyList, fullInterfacePropertyList) import Data.GI.CodeGen.SymbolNaming (lowerName, upperName,                                      classConstraint, typeConstraint,@@ -88,13 +90,25 @@   (_,t,constraints) <- argumentType ['a'..'l'] $ propType prop   return (constraints, t) -genPropertySetter :: Text -> Name -> Text -> Property -> CodeGen ()+-- | Generate documentation for the given setter.+setterDoc :: Name -> Property -> Text+setterDoc n prop = T.unlines [+    "Set the value of the “@" <> propName prop <> "@” property."+  , "When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to"+  , ""+  , "@"+  , "'Data.GI.Base.Attributes.set' " <> lowerName n <> " [ #" <> hPropName prop+    <> " 'Data.GI.Base.Attributes.:=' value ]"+  , "@"]++genPropertySetter :: Text -> Name -> HaddockSection -> Property -> CodeGen () genPropertySetter setter n docSection prop = group $ do   (constraints, t) <- attrType prop   isNullable <- typeIsNullable (propType prop)   cls <- classConstraint n   let constraints' = "MonadIO m":(cls <> " o"):constraints   tStr <- propTypeStr $ propType prop+  writeHaddock DocBeforeSymbol (setterDoc n prop)   line $ setter <> " :: (" <> T.intercalate ", " constraints'            <> ") => o -> " <> t <> " -> m ()"   line $ setter <> " obj val = liftIO $ setObjectProperty" <> tStr@@ -102,9 +116,19 @@            <> if isNullable               then "\" (Just val)"               else "\" val"-  exportProperty docSection setter+  export docSection setter -genPropertyGetter :: Text -> Name -> Text -> Property -> CodeGen ()+-- | Generate documentation for the given getter.+getterDoc :: Name -> Property -> Text+getterDoc n prop = T.unlines [+    "Get the value of the “@" <> propName prop <> "@” property."+  , "When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to"+  , ""+  , "@"+  , "'Data.GI.Base.Attributes.get' " <> lowerName n <> " #" <> hPropName prop+  , "@"]++genPropertyGetter :: Text -> Name -> HaddockSection -> Property -> CodeGen () genPropertyGetter getter n docSection prop = group $ do   isNullable <- typeIsNullable (propType prop)   let isMaybe = isNullable && propReadNullable prop /= Just False@@ -119,6 +143,7 @@                 then "checkUnexpectedNothing \"" <> getter                          <> "\" $ getObjectProperty" <> tStr                 else "getObjectProperty" <> tStr+  writeHaddock DocBeforeSymbol (getterDoc n prop)   line $ getter <> " :: " <> constraints <>                 " => o -> " <> typeShow ("m" `con` [outType])   line $ getter <> " obj = liftIO $ " <> getProp@@ -126,9 +151,15 @@            if tStr `elem` ["Object", "Boxed"]            then " " <> typeShow constructorType -- These require the constructor.            else ""-  exportProperty docSection getter+  export docSection getter -genPropertyConstructor :: Text -> Name -> Text -> Property -> CodeGen ()+-- | Generate documentation for the given constructor.+constructorDoc :: Property -> Text+constructorDoc prop = T.unlines [+    "Construct a `GValueConstruct` with valid value for the “@" <> propName prop <> "@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`."+    ]++genPropertyConstructor :: Text -> Name -> HaddockSection -> Property -> CodeGen () genPropertyConstructor constructor n docSection prop = group $ do   (constraints, t) <- attrType prop   tStr <- propTypeStr $ propType prop@@ -136,6 +167,7 @@   cls <- classConstraint n   let constraints' = (cls <> " o") : constraints       pconstraints = parenthesize (T.intercalate ", " constraints') <> " => "+  writeHaddock DocBeforeSymbol (constructorDoc prop)   line $ constructor <> " :: " <> pconstraints            <> t <> " -> IO (GValueConstruct o)"   line $ constructor <> " val = constructObjectProperty" <> tStr@@ -143,20 +175,31 @@            <> if isNullable               then "\" (Just val)"               else "\" val"-  exportProperty docSection constructor+  export docSection constructor -genPropertyClear :: Text -> Name -> Text -> Property -> CodeGen ()+-- | Generate documentation for the given setter.+clearDoc :: Property -> Text+clearDoc prop = T.unlines [+    "Set the value of the “@" <> propName prop <> "@” property to `Nothing`."+  , "When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to"+  , ""+  , "@"+  , "'Data.GI.Base.Attributes.clear'" <> " #" <> hPropName prop+  , "@"]++genPropertyClear :: Text -> Name -> HaddockSection -> Property -> CodeGen () genPropertyClear clear n docSection prop = group $ do   nothingType <- typeShow . maybeT <$> haskellType (propType prop)   cls <- classConstraint n   let constraints = ["MonadIO m", cls <> " o"]   tStr <- propTypeStr $ propType prop+  writeHaddock DocBeforeSymbol (clearDoc prop)   line $ clear <> " :: (" <> T.intercalate ", " constraints            <> ") => o -> m ()"   line $ clear <> " obj = liftIO $ setObjectProperty" <> tStr            <> " obj \"" <> propName prop <> "\" (Nothing :: "            <> nothingType <> ")"-  exportProperty docSection clear+  export docSection clear  -- | The property name as a lexically valid Haskell identifier. Note -- that this is not escaped, since it is assumed that it will be used@@ -207,7 +250,7 @@ genOneProperty owner prop = do   let name = upperName owner       cName = (hyphensToCamelCase . propName) prop-      docSection = lcFirst cName+      docSection = NamedSubsection PropertySection (lcFirst cName)       pName = name <> cName       flags = propFlags prop       writable = PropertyWritable `elem` flags &&@@ -215,6 +258,8 @@       readable = PropertyReadable `elem` flags       constructOnly = PropertyConstructOnly `elem` flags +  addSectionDocumentation docSection (propDoc prop)+   -- For properties the meaning of having transfer /= TransferNothing   -- is not clear (what are the right semantics for GValue setters?),   -- and the other possibilities are very uncommon, so let us just@@ -287,7 +332,7 @@                          then ["'AttrClear"]                          else [])     it <- infoType owner prop-    exportProperty docSection it+    export docSection it     bline $ "data " <> it     line $ "instance AttrInfo " <> it <> " where"     indent $ do@@ -311,8 +356,8 @@   line $ "-- XXX Placeholder"   it <- infoType owner prop   let cName = (hyphensToCamelCase . propName) prop-      docSection = lcFirst cName-  exportProperty docSection it+      docSection = NamedSubsection PropertySection (lcFirst cName)+  export docSection it   line $ "data " <> it   line $ "instance AttrInfo " <> it <> " where"   indent $ do@@ -367,9 +412,9 @@   forM_ filteredAttrs $ \attr -> group $ do     let cName = ucFirst attr         labelProxy = lcFirst name <> cName-        docSection = lcFirst cName+        docSection = NamedSubsection PropertySection (lcFirst cName)      line $ labelProxy <> " :: AttrLabelProxy \"" <> lcFirst cName <> "\""     line $ labelProxy <> " = AttrLabelProxy" -    exportProperty docSection labelProxy+    export docSection labelProxy

@@ -25,49 +25,70 @@                                  callableHInArgs, callableHOutArgs) import Data.GI.CodeGen.Code import Data.GI.CodeGen.Conversions-import Data.GI.CodeGen.Haddock (deprecatedPragma)+import Data.GI.CodeGen.Haddock (deprecatedPragma,+                                RelativeDocPosition(..), writeHaddock,+                                writeDocumentation,+                                writeArgDocumentation, writeReturnDocumentation) import Data.GI.CodeGen.SymbolNaming import Data.GI.CodeGen.Transfer (freeContainerType) import Data.GI.CodeGen.Type import Data.GI.CodeGen.Util (parenthesize, withComment, tshow, terror,                              lcFirst, ucFirst, prime)+import Data.GI.GIR.Documentation (Documentation)  -- | The prototype of the callback on the Haskell side (what users of -- the binding will see) genHaskellCallbackPrototype :: Text -> Callable -> Text -> ExposeClosures ->-                               ExcCodeGen ()-genHaskellCallbackPrototype subsec cb htype expose = group $ do+                               Documentation -> ExcCodeGen ()+genHaskellCallbackPrototype subsec cb htype expose doc = group $ do     let name' = case expose of                   WithClosures -> callbackHTypeWithClosures htype                   WithoutClosures -> htype         (hInArgs, _) = callableHInArgs cb expose+        inArgsWithArrows = zip ("" : repeat "-> ") hInArgs         hOutArgs = callableHOutArgs cb -    exportSignal subsec name'+    export (NamedSubsection SignalSection subsec) name'+    writeDocumentation DocBeforeSymbol doc     line $ "type " <> name' <> " ="     indent $ do-      forM_ hInArgs $ \arg -> do+      forM_ inArgsWithArrows $ \(arrow, arg) -> do         ht <- haskellType (argType arg)-        wrapMaybe arg >>= bool-                          (line $ typeShow ht <> " ->")-                          (line $ typeShow (maybeT ht) <> " ->")+        isMaybe <- wrapMaybe arg+        let formattedType = if isMaybe+                            then typeShow (maybeT ht)+                            else typeShow ht+        line $ arrow <> formattedType+        writeArgDocumentation arg       ret <- hOutType cb hOutArgs-      line $ typeShow $ io ret+      let returnArrow = if null hInArgs+                        then ""+                        else "-> "+      line $ returnArrow <> typeShow (io ret)+      writeReturnDocumentation cb False      blank      -- For optional parameters, in case we want to pass Nothing.-    exportSignal subsec ("no" <> name')+    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 =+          "A convenience synonym for @`Nothing` :: `Maybe` `" <> typeName <>+          "`@."+ -- | 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 Text genCCallbackPrototype subsec cb name' isSignal = group $ do     let ctypeName = callbackCType name'-    exportSignal subsec ctypeName +    export (NamedSubsection SignalSection subsec) ctypeName+    writeHaddock DocBeforeSymbol ccallbackDoc+     line $ "type " <> ctypeName <> " ="     indent $ do       when isSignal $ line $ withComment "Ptr () ->" "object"@@ -86,15 +107,24 @@       line $ typeShow ret     return ctypeName --- Generator for wrappers callable from C+  where+    ccallbackDoc :: Text+    ccallbackDoc = "Type for the callback on the (unwrapped) C side."++-- | Generator for wrappers callable from C genCallbackWrapperFactory :: Text -> Text -> CodeGen () genCallbackWrapperFactory subsec name' = group $ do     let factoryName = callbackWrapperAllocator name'+    writeHaddock DocBeforeSymbol factoryDoc     line "foreign import ccall \"wrapper\""     indent $ line $ factoryName <> " :: " <> callbackCType name'                <> " -> IO (FunPtr " <> callbackCType name' <> ")"-    exportSignal subsec factoryName+    export (NamedSubsection SignalSection subsec) factoryName +  where factoryDoc :: Text+        factoryDoc = "Generate a function pointer callable from C code, from a `"+                     <> callbackCType name' <> "`."+ -- | Wrap the Haskell `cb` callback into a foreign function of the -- right type. Returns the name of the wrapped value. genWrappedCallback :: Callable -> Text -> Text -> Bool -> CodeGen Text@@ -116,7 +146,8 @@ genClosure :: Text -> Callable -> Text -> Text -> Bool -> CodeGen () genClosure subsec cb callback name isSignal = group $ do   let closure = callbackClosureGenerator name-  exportSignal subsec closure+  export (NamedSubsection SignalSection subsec) closure+  writeHaddock DocBeforeSymbol closureDoc   group $ do       line $ closure <> " :: " <> callback <> " -> IO Closure"       line $ closure <> " cb = do"@@ -124,6 +155,9 @@             wrapped <- genWrappedCallback cb "cb" callback isSignal             line $ callbackWrapperAllocator callback <> " " <> wrapped                      <> " >>= newCClosure"+  where+    closureDoc :: Text+    closureDoc = "Wrap the callback into a `Closure`."  -- Wrap a conversion of a nullable object into "Maybe" object, by -- checking whether the pointer is NULL.@@ -218,12 +252,16 @@                              else Nothing       argNames = map (maybe "_" id . passOrIgnore) inWithClosures -  exportSignal subsec dropper+  export (NamedSubsection SignalSection subsec) dropper+  writeHaddock DocBeforeSymbol dropperDoc    line $ dropper <> " :: " <> name' <> " -> " <> callbackHTypeWithClosures name'   line $ dropper <> " _f " <> T.unwords argNames <> " = _f "            <> T.unwords (catMaybes (map passOrIgnore inWithClosures)) +  where dropperDoc :: Text+        dropperDoc = "A simple wrapper that ignores the closure arguments."+ -- | The wrapper itself, marshalling to and from Haskell. The `Callable` -- argument is possibly a pointer to a FunPtr to free (via -- freeHaskellFunPtr) once the callback is run once, or Nothing if the@@ -235,8 +273,11 @@   let wrapperName = callbackHaskellToForeign name'       (hInArgs, _) = callableHInArgs cb WithClosures       hOutArgs = callableHOutArgs cb+      wrapperDoc = "Wrap a `" <> name' <> "` into a `" <>+                   callbackCType name' <> "`." -  exportSignal subsec wrapperName+  export (NamedSubsection SignalSection subsec) wrapperName+  writeHaddock DocBeforeSymbol wrapperDoc    group $ do     line $ wrapperName <> " ::"@@ -244,7 +285,6 @@       if isSignal       then do         line $ name' <> " ->"-        line "Ptr () ->"       else do            line $ "Maybe (Ptr (FunPtr " <> callbackCType name' <> ")) ->"            let hType = if callableHasClosures cb@@ -252,19 +292,7 @@                        else name'            line $ hType <> " ->" -      forM_ (args cb) $ \arg -> do-        ht <- foreignType $ argType arg-        let ht' = if direction arg /= DirectionIn-                  then ptr ht-                  else ht-        line $ typeShow ht' <> " ->"-      when (callableThrows cb) $-        line "Ptr (Ptr GError) ->"-      when isSignal $ line "Ptr () ->"-      ret <- io <$> case returnType cb of-                      Nothing -> return $ con0 "()"-                      Just t -> foreignType t-      line $ typeShow ret+      line $ callbackCType name'      let cArgNames = map escapedArgName (args cb)         allArgs = if isSignal@@ -304,7 +332,7 @@                line $ "return " <> result'  genCallback :: Name -> Callback -> CodeGen ()-genCallback n (Callback {cbCallable = cb}) = do+genCallback n (Callback {cbCallable = cb, cbDocumentation = cbDoc }) = do   let name' = upperName n   line $ "-- callback " <> name'   line $ "--          -> " <> tshow (fixupCallerAllocates cb)@@ -322,12 +350,12 @@                              "\n-- Error was : " <> describeCGError e)) $ do       typeSynonym <- genCCallbackPrototype name' cb' name' False       dynamic <- genDynamicCallableWrapper n typeSynonym cb-      exportSignal name' dynamic+      export (NamedSubsection SignalSection name') dynamic       genCallbackWrapperFactory name' name'       deprecatedPragma name' (callableDeprecated cb')-      genHaskellCallbackPrototype name' cb' name' WithoutClosures+      genHaskellCallbackPrototype name' cb' name' WithoutClosures cbDoc       when (callableHasClosures cb') $ do-           genHaskellCallbackPrototype name' cb' name' WithClosures+           genHaskellCallbackPrototype name' cb' name' WithClosures cbDoc            genDropClosures name' cb' name'       if callableThrows cb'       then do@@ -368,10 +396,12 @@   let sn' = signalHaskellName sn       signalConnectorName = on' <> ucFirst sn'       cbType = signalConnectorName <> "Callback"+      docSection = NamedSubsection SignalSection $ lcFirst sn'    deprecatedPragma cbType (callableDeprecated cb)-  genHaskellCallbackPrototype (lcFirst sn') cb cbType WithoutClosures +  genHaskellCallbackPrototype (lcFirst sn') cb cbType WithoutClosures (sigDoc s)+   _ <- genCCallbackPrototype (lcFirst sn') cb cbType True    genCallbackWrapperFactory (lcFirst sn') cbType@@ -400,16 +430,41 @@         afterName = "after" <> signalConnectorName      group $ do+      writeHaddock DocBeforeSymbol onDoc       line $ onName <> signature       line $ onName <> " obj cb = liftIO $ do"       indent $ genSignalConnector s cbType "SignalConnectBefore"-      exportSignal (lcFirst sn') onName+      export docSection onName      group $ do+      writeHaddock DocBeforeSymbol afterDoc       line $ afterName <> signature       line $ afterName <> " obj cb = liftIO $ do"       indent $ genSignalConnector s cbType "SignalConnectAfter"-      exportSignal (lcFirst sn') afterName+      export docSection afterName++  where+    onDoc :: Text+    onDoc = T.unlines [+      "Connect a signal handler for the “@" <> sn <>+        "@” signal, to be run before the default handler."+      , "When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to"+      , ""+      , "@"+      , "'Data.GI.Base.Signals.on' " <> lowerName on <> " #"+        <> lcFirst (hyphensToCamelCase sn) <> " callback"+      , "@" ]++    afterDoc :: Text+    afterDoc = T.unlines [+      "Connect a signal handler for the “@" <> sn <>+        "@” signal, to be run after the default handler."+      , "When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to"+      , ""+      , "@"+      , "'Data.GI.Base.Signals.after' " <> lowerName on <> " #"+        <> lcFirst (hyphensToCamelCase sn) <> " callback"+      , "@" ]  -- | Generate the code for connecting the given signal. This assumes -- that it lives inside a @do@ block.

@@ -21,6 +21,8 @@ import Data.GI.CodeGen.API import Data.GI.CodeGen.Conversions import Data.GI.CodeGen.Code+import Data.GI.CodeGen.Haddock (addSectionDocumentation, writeHaddock,+                                RelativeDocPosition(DocBeforeSymbol)) import Data.GI.CodeGen.SymbolNaming import Data.GI.CodeGen.Type import Data.GI.CodeGen.Util@@ -95,6 +97,20 @@       Nothing -> badIntroError "Cannot determine whether the field is embedded."       Just isPtr -> return (not isPtr) +-- | Name for the getter function+fieldGetter :: Name -> Field -> Text+fieldGetter name' field = "get" <> upperName name' <> fName field++-- | Generate documentation for the given getter.+getterDoc :: Name -> Field -> Text+getterDoc n field = T.unlines [+    "Get the value of the “@" <> fieldName field <> "@” field."+  , "When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to"+  , ""+  , "@"+  , "'Data.GI.Base.Attributes.get' " <> lowerName n <> " #" <> labelName field+  , "@"]+ -- Notice that when reading the field we return a copy of any embedded -- structs, so modifications of the returned struct will not affect -- the original struct. This is on purpose, in order to increase@@ -116,6 +132,8 @@                         else isoHaskellType (fieldType field)   fType <- typeShow <$> foreignType (fieldType field) +  writeHaddock DocBeforeSymbol (getterDoc n field)+   line $ getter <> " :: MonadIO m => " <> name' <> " -> m " <>               if T.any (== ' ') hType               then parenthesize hType@@ -140,6 +158,21 @@                 return "result"     line $ "return " <> result +-- | Name for the setter function+fieldSetter :: Name -> Field -> Text+fieldSetter name' field = "set" <> upperName name' <> fName field++-- | Generate documentation for the given setter.+setterDoc :: Name -> Field -> Text+setterDoc n field = T.unlines [+    "Set the value of the “@" <> fieldName field <> "@” field."+  , "When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to"+  , ""+  , "@"+  , "'Data.GI.Base.Attributes.set' " <> lowerName n <> " [ #" <> labelName field+    <> " 'Data.GI.Base.Attributes.:=' value ]"+  , "@"]+ -- | Write a field into a struct. Note that, since we cannot know for -- sure who will be deallocating the fields in the struct, we leave -- any conversions that involve pointers to the caller. What this@@ -158,6 +191,8 @@            then return fType            else typeShow <$> haskellType (fieldType field) +  writeHaddock DocBeforeSymbol (setterDoc n field)+   line $ setter <> " :: MonadIO m => " <> name' <> " -> "            <> hType <> " -> m ()"   line $ setter <> " s val = liftIO $ withManagedPtr s $ \\ptr -> do"@@ -168,6 +203,20 @@     line $ "poke (ptr `plusPtr` " <> tshow (fieldOffset field)          <> ") (" <> converted <> " :: " <> fType <> ")" +-- | Name for the clear function+fieldClear :: Name -> Field -> Text+fieldClear name' field = "clear" <> upperName name' <> fName field++-- | Documentation for the @clear@ method.+clearDoc :: Field -> Text+clearDoc field = T.unlines [+  "Set the value of the “@" <> fieldName field <> "@” field to `Nothing`."+  , "When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to"+  , ""+  , "@"+  , "'Data.GI.Base.Attributes.clear'" <> " #" <> labelName field+  , "@"]+ -- | Write a @NULL@ into a field of a struct of type `Ptr`. buildFieldClear :: Name -> Field -> Text -> ExcCodeGen () buildFieldClear n field nullPtr = group $ do@@ -176,28 +225,22 @@    fType <- typeShow <$> foreignType (fieldType field) +  writeHaddock DocBeforeSymbol (clearDoc field)+   line $ clear <> " :: MonadIO m => " <> name' <> " -> m ()"   line $ clear <> " s = liftIO $ withManagedPtr s $ \\ptr -> do"   indent $     line $ "poke (ptr `plusPtr` " <> tshow (fieldOffset field)          <> ") ("  <> nullPtr <> " :: " <> fType <> ")" --- | Name for the getter function-fieldGetter :: Name -> Field -> Text-fieldGetter name' field = "get" <> upperName name' <> fName field---- | Name for the setter function-fieldSetter :: Name -> Field -> Text-fieldSetter name' field = "set" <> upperName name' <> fName field---- | Name for the clear function-fieldClear :: Name -> Field -> Text-fieldClear name' field = "clear" <> upperName name' <> fName field- -- | Haskell name for the field fName :: Field -> Text fName = underscoresToCamelCase . fieldName +-- | Label associated to the field.+labelName :: Field -> Text+labelName = lcFirst  . fName+ -- | Support for modifying fields as attributes. Returns a tuple with -- the name of the overloaded label to be used for the field, and the -- associated info type.@@ -250,30 +293,33 @@     line $ labelProxy <> " :: AttrLabelProxy \"" <> lcFirst (fName field) <> "\""     line $ labelProxy <> " = AttrLabelProxy" -    exportProperty (lcFirst $ fName field) labelProxy+    export (NamedSubsection PropertySection $ lcFirst $ fName field) labelProxy -  return $ "'(\"" <> (lcFirst  . fName) field <> "\", " <> it <> ")"+  return $ "'(\"" <> labelName field <> "\", " <> it <> ")"  buildFieldAttributes :: Name -> Field -> ExcCodeGen (Maybe Text) buildFieldAttributes n field     | not (fieldVisible field) = return Nothing     | privateType (fieldType field) = return Nothing     | otherwise = group $ do+      nullPtr <- nullPtrForType (fieldType field)       embedded <- isEmbedded field +     addSectionDocumentation docSection (fieldDocumentation field)+      buildFieldReader n field-     exportProperty (lcFirst $ fName field) (fieldGetter n field)+     export docSection (fieldGetter n field)       when (not embedded) $ do          buildFieldWriter n field-         exportProperty (lcFirst $ fName field) (fieldSetter n field)+         export docSection (fieldSetter n field)           case nullPtr of            Just null -> do               buildFieldClear n field null-              exportProperty (lcFirst $ fName field) (fieldClear n field)+              export docSection (fieldClear n field)            Nothing -> return ()       Just <$> cppIf CPPOverloading (genAttrInfo n field)@@ -282,6 +328,8 @@           privateType (TInterface n) = "Private" `T.isSuffixOf` name n           privateType _ = False +          docSection = NamedSubsection PropertySection $ lcFirst $ fName field+ genStructOrUnionFields :: Name -> [Field] -> CodeGen () genStructOrUnionFields n fields = do   let name' = upperName n@@ -309,7 +357,10 @@       let name = upperName n       let builder = "newZero" <> name           tsize = tshow size-      line $ "-- | Construct a `" <> name <> "` struct initialized to zero."++      writeHaddock DocBeforeSymbol ("Construct a `" <> name <>+                                     "` struct initialized to zero.")+       line $ builder <> " :: MonadIO m => m " <> name       line $ builder <> " = liftIO $ " <>            if isBoxed

@@ -159,9 +159,12 @@ -- want to pass Nothing. noName :: Text -> CodeGen () noName name' = group $ do-                 line $ "no" <> name' <> " :: Maybe " <> name'-                 line $ "no" <> name' <> " = Nothing"-                 exportDecl ("no" <> name')+  -- We should use `writeHaddock` here, but it would give rise to a+  -- cyclic import.+  line $ "-- | A convenience alias for `Nothing` :: `Maybe` `" <> name' <> "`."+  line $ "no" <> name' <> " :: Maybe " <> name'+  line $ "no" <> name' <> " = Nothing"+  exportDecl ("no" <> name')  -- | Turn a hyphen-separated identifier into camel case. --

@@ -30,7 +30,6 @@ basicFreeFn (TBasicType TFileName) = Just "freeMem" basicFreeFn (TBasicType _) = Nothing basicFreeFn (TInterface _) = Nothing-basicFreeFn (TCArray False (-1) (-1) _) = Nothing -- Just passing it along basicFreeFn (TCArray{}) = Just "freeMem" basicFreeFn (TGArray _) = Just "unrefGArray" basicFreeFn (TPtrArray _) = Just "unrefPtrArray"@@ -94,9 +93,6 @@                                  return Nothing                           else return Nothing     _ -> return Nothing--- Arrays without length info are just passed along, we do not need to--- free them.-basicFreeFnOnError (TCArray False (-1) (-1) _) _ = return Nothing basicFreeFnOnError (TCArray{}) _ = return $ Just "freeMem" basicFreeFnOnError (TGArray _) _ = return $ Just "unrefGArray" basicFreeFnOnError (TPtrArray _) _ = return $ Just "unrefPtrArray"

@@ -12,6 +12,7 @@  data Callback = Callback { cbCallable :: Callable                          , cbCType    :: Maybe Text+                         , cbDocumentation :: Documentation                          }     deriving Show @@ -20,5 +21,7 @@   name <- parseName   callable <- parseCallable   ctype <- queryCType+  doc <- parseDocumentation   return (name, Callback { cbCallable = callable-                         , cbCType = ctype })+                         , cbCType = ctype+                         , cbDocumentation = doc })

@@ -22,6 +22,7 @@       fieldCallback :: Maybe Callback,       fieldOffset :: Int,       fieldFlags :: [FieldInfoFlag],+      fieldDocumentation :: Documentation,       fieldDeprecated :: Maybe DeprecationInfo }     deriving Show @@ -42,6 +43,7 @@              <> if writable then [FieldIsWritable] else []   introspectable <- optionalAttr "introspectable" True parseBool   private <- optionalAttr "private" False parseBool+  doc <- parseDocumentation   (t, isPtr, callback) <-       if introspectable       then do@@ -76,6 +78,7 @@              , fieldCallback = callback              , fieldOffset = error ("unfixed field offset " ++ show name)              , fieldFlags = flags+             , fieldDocumentation = doc              , fieldDeprecated = deprecated           } 

@@ -25,6 +25,7 @@         propReadNullable :: Maybe Bool,         propWriteNullable :: Maybe Bool,         propTransfer :: Transfer,+        propDoc :: Documentation,         propDeprecated :: Maybe DeprecationInfo     } deriving (Show, Eq) @@ -42,12 +43,14 @@               <> (if writable then [PropertyWritable] else [])               <> (if construct then [PropertyConstruct] else [])               <> (if constructOnly then [PropertyConstructOnly] else [])+  doc <- parseDocumentation   return $ Property {                   propName = name                 , propType = t                 , propFlags = flags                 , propTransfer = transfer                 , propDeprecated = deprecated+                , propDoc = doc                 -- No support in the GIR for nullability info                 , propReadNullable = Nothing                 , propWriteNullable = Nothing

@@ -11,7 +11,8 @@ data Signal = Signal {         sigName :: Text,         sigCallable :: Callable,-        sigDeprecated :: Maybe DeprecationInfo+        sigDeprecated :: Maybe DeprecationInfo,+        sigDoc :: Documentation     } deriving (Show, Eq)  parseSignal :: Parser Signal@@ -19,8 +20,10 @@   n <- getAttr "name"   deprecated <- parseDeprecation   callable <- parseCallable+  doc <- parseDocumentation   return $ Signal {                 sigName = n               , sigCallable = callable               , sigDeprecated = deprecated+              , sigDoc = doc               }