haskell-gi 0.26.12 → 0.26.13

raw patch · 10 files changed

+529/−200 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• haskell-gi.cabal +2/−2
• lib/Data/GI/CodeGen/CodeGen.hs +8/−8
• lib/Data/GI/CodeGen/CtoHaskellMap.hs +19/−3
• lib/Data/GI/CodeGen/Fixups.hs +7/−5
• lib/Data/GI/CodeGen/GtkDoc.hs +407/−159
• lib/Data/GI/CodeGen/Haddock.hs +53/−14
• lib/Data/GI/CodeGen/Properties.hs +1/−1
• lib/Data/GI/CodeGen/Struct.hs +3/−3
• lib/Data/GI/CodeGen/SymbolNaming.hs +23/−5
• lib/Data/GI/GIR/Property.hs +6/−0

@@ -1,8 +1,8 @@ name:                haskell-gi-version:             0.26.12+version:             0.26.13 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.+                     GTK, but many other libraries in the GObject ecosystem provide introspection data too. homepage:            https://github.com/haskell-gi/haskell-gi license:             LGPL-2.1                      -- or above

@@ -246,7 +246,7 @@ genGValueInstance :: Name -> Text -> Text -> Text -> Text -> CodeGen e () genGValueInstance n get_type_fn newFn get_value_fn set_value_fn = do   let name' = upperName n-      doc = "Convert '" <> name' <> "' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'."+      doc = "Convert t'" <> name' <> "' to and from t'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'."    writeHaddock DocBeforeSymbol doc @@ -322,13 +322,13 @@   return get_type_fn    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`."+        castDoc name' = "Cast to t'" <> 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' <> "`."+        classDoc name' = "Type class for types which can be safely cast to t'"+                         <> 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@@ -420,8 +420,8 @@   else group $ do     cls <- classConstraint n     exportDecl cls-    writeHaddock DocBeforeSymbol ("Type class for types which implement `"-                                  <> name' <> "`.")+    writeHaddock DocBeforeSymbol ("Type class for types which implement t'"+                                  <> name' <> "'.")      -- Create the IsX constraint. We cannot simply say     --

@@ -10,6 +10,7 @@ import Data.Monoid ((<>)) #endif import Data.Text (Text)+import qualified Data.Text as T  import Data.GI.CodeGen.GtkDoc (CRef(..), docName) import Data.GI.CodeGen.API (API(..), Name(..), Callback(..),@@ -62,7 +63,12 @@                     (CTypeRef "GError", TypeIdentifier "GError"),                     (CTypeRef "GType", TypeIdentifier "GType"),                     (CTypeRef "GVariant", TypeIdentifier "GVariant"),-                    (ConstantRef "NULL", ValueIdentifier "P.Nothing")]+                    (ConstantRef "NULL", ValueIdentifier "P.Nothing"),+                    (TypeRef (docName $ Name "GLib" "Variant"),+                     TypeIdentifier "GVariant"),+                    (TypeRef (docName $ Name "GLib" "HashTable"),+                     TypeIdentifier "GHashTable")+                   ]  -- | Obtain the fully qualified symbol pointing to a value. fullyQualifiedValue :: Name -> API -> Text -> Hyperlink@@ -93,10 +99,19 @@ enumRefs :: API -> Name -> Enumeration -> [(CRef, Hyperlink)] enumRefs api n e = (CTypeRef (enumCType e), qualified)                    : (TypeRef (docName n), qualified)-                   : map memberToRef (enumMembers e)+                   : map memberToOldRef (enumMembers e)+                   <> map memberToRef (enumMembers e)   where qualified = fullyQualifiedType n api $ upperName n+        memberToOldRef :: EnumerationMember -> (CRef, Hyperlink)+        memberToOldRef em = (ConstantRef (enumMemberCId em),+                          fullyQualifiedValue n api $ upperName $+                          n {name = name n <> "_" <> enumMemberName em})         memberToRef :: EnumerationMember -> (CRef, Hyperlink)-        memberToRef em = (ConstantRef (enumMemberCId em),+        -- Sometimes the references are written in uppercase while the+        -- name of the member in the introspection data is written in+        -- lowercase, so normalise everything to lowercase. (See the+        -- similar annotation in GtkDoc.hs.)+        memberToRef em = (EnumMemberRef (docName n) (T.toLower $ enumMemberName em),                           fullyQualifiedValue n api $ upperName $                           n {name = name n <> "_" <> enumMemberName em}) @@ -170,6 +185,7 @@ ifaceRefs n i = maybeCType n (APIInterface i) (ifCType i)                  <> methodRefs n (APIInterface i) (ifMethods i)                  <> signalRefs n (APIInterface i) (ifCType i) (ifSignals i)+                 <> propRefs n (APIInterface i) (ifCType i) (ifProperties i)  -- | Extract the C references in an object. objectRefs :: Name -> Object -> [(CRef, Hyperlink)]

@@ -11,7 +11,7 @@     ) where  import Data.Char (generalCategory, GeneralCategory(UppercaseLetter))-import Data.Maybe (isNothing, isJust)+import Data.Maybe (fromMaybe, isNothing, isJust) import qualified Data.Map as M #if !MIN_VERSION_base(4,13,0) import Data.Monoid ((<>))@@ -61,14 +61,14 @@ -- | Guess nullability for the properties of an interface. guessInterfacePropertyNullability :: Interface -> Interface guessInterfacePropertyNullability iface =-    iface {ifProperties = map (guessNullability (ifMethods iface))+    iface { ifProperties = map (guessNullability (ifMethods iface))                               (ifProperties iface)}  -- | Guess the nullability for a property, given the list of methods -- for the object/interface. guessNullability :: [Method] -> Property -> Property guessNullability methods = guessReadNullability methods-                         . guessWriteNullability methods+                           . guessWriteNullability methods  -- | Guess whether "get" on the given property may return NULL, based -- on the corresponding "get_prop_name" method, if it exists.@@ -80,7 +80,8 @@       nullableGetter :: Maybe Bool       nullableGetter =           let prop_name = T.replace "-" "_" (propName p)-          in case findMethod methods ("get_" <> prop_name) of+              getter = fromMaybe ("get_" <> prop_name) (propGetter p)+          in case findMethod methods getter of                Nothing -> Nothing                -- Check that it looks like a sensible getter                -- for the property.@@ -106,7 +107,8 @@       nullableSetter :: Maybe Bool       nullableSetter =           let prop_name = T.replace "-" "_" (propName p)-          in case findMethod methods ("set_" <> prop_name) of+              setter = fromMaybe ("set_" <> prop_name) (propSetter p)+          in case findMethod methods setter of                Nothing -> Nothing                -- Check that it looks like a sensible setter.                Just m ->

@@ -6,7 +6,6 @@   , Token(..)   , Language(..)   , Link(..)-  , ListItem(..)   , CRef(..)   , DocSymbolName(..)   , docName@@ -18,15 +17,18 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>), (<*)) #endif+import Control.Applicative ((<|>))+import Control.Monad (forM, guard, when)+import Data.Either (isRight) #if !MIN_VERSION_base(4,13,0) import Data.Monoid ((<>)) #endif-import Control.Applicative ((<|>)) +import Data.GI.CodeGen.Util (terror) import Data.GI.GIR.BasicTypes (Name(Name))  import Data.Attoparsec.Text-import Data.Char (isAlphaNum, isAlpha, isAscii)+import Data.Char (isAlphaNum, isAlpha, isAscii, isDigit) import qualified Data.Text as T import Data.Text (Text) @@ -37,7 +39,11 @@            | CodeBlock (Maybe Language) Text            | ExternalLink Link            | Image Link-           | List [ListItem]+           | UnnumberedList [GtkDoc]+           -- ^ An unnumbered list of items.+           | NumberedList [(Text, GtkDoc)]+           -- ^ A list of numbered list items. The first element in+           -- the pair is the index.            | SectionHeader Int GtkDoc -- ^ A section header of the given depth.            | SymbolRef CRef   deriving (Show, Eq)@@ -47,13 +53,6 @@                  , linkAddress :: Text }   deriving (Show, Eq) --- | An item in a list, given by a list of lines (not including ending--- newlines). The list is always non-empty, so we represent it by the--- first line and then a possibly empty list with the rest of the--- lines.-data ListItem = ListItem GtkDoc [GtkDoc]-  deriving (Show, Eq)- -- | The language for an embedded code block. newtype Language = Language Text   deriving (Show, Eq)@@ -72,6 +71,7 @@           | VMethodRef Text Text           | VFuncRef DocSymbolName Text           | StructFieldRef Text Text+          | EnumMemberRef DocSymbolName Text           | CTypeRef Text           | TypeRef DocSymbolName           deriving (Show, Eq, Ord)@@ -117,42 +117,42 @@ -- GtkDoc [SectionHeader 1 (GtkDoc [Literal "A section"]),Literal "\n",SectionHeader 2 (GtkDoc [Literal "and a subsection "])] -- -- >>> parseGtkDoc "Compact list:\n- First item\n- Second item"--- GtkDoc [Literal "Compact list:\n",List [ListItem (GtkDoc [Literal "First item"]) [],ListItem (GtkDoc [Literal "Second item"]) []]]+-- GtkDoc [Literal "Compact list:\n",UnnumberedList [GtkDoc [Literal "First item"],GtkDoc [Literal "Second item"]]] -- -- >>> parseGtkDoc "Spaced list:\n\n- First item\n\n- Second item"--- GtkDoc [Literal "Spaced list:\n",List [ListItem (GtkDoc [Literal "First item"]) [],ListItem (GtkDoc [Literal "Second item"]) []]]+-- GtkDoc [Literal "Spaced list:\n\n",UnnumberedList [GtkDoc [Literal "First item"],GtkDoc [Literal "Second item"]]] -- -- >>> parseGtkDoc "List with urls:\n- [test](http://test)\n- ![](image.png)"--- GtkDoc [Literal "List with urls:\n",List [ListItem (GtkDoc [ExternalLink (Link {linkName = "test", linkAddress = "http://test"})]) [],ListItem (GtkDoc [Image (Link {linkName = "", linkAddress = "image.png"})]) []]]+-- GtkDoc [Literal "List with urls:\n",UnnumberedList [GtkDoc [ExternalLink (Link {linkName = "test", linkAddress = "http://test"})],GtkDoc [Image (Link {linkName = "", linkAddress = "image.png"})]]] parseGtkDoc :: Text -> GtkDoc-parseGtkDoc raw =+parseGtkDoc doc = rawParseGtkDoc (T.cons startOfString doc)++-- | Like `parseGtkDoc`, but it does not annotate beginning of lines.+rawParseGtkDoc :: Text -> GtkDoc+rawParseGtkDoc raw =   case parseOnly (parseTokens <* endOfInput) raw of     Left e ->-      error $ "gtk-doc parsing failed with error \"" <> e-      <> "\" on the input \"" <> T.unpack raw <> "\""-    Right tks -> GtkDoc . coalesceLiterals-                 . restoreSHPreNewlines . restoreListPreNewline $ tks+      terror $ "gtk-doc parsing failed with error \"" <> T.pack e+      <> "\" on the input \"" <>+      T.replace (T.singleton startOfString) "" raw <> "\""+    Right tks -> GtkDoc . coalesceLiterals . removeSOS $ tks --- | `parseSectionHeader` eats the newline before the section header,--- but `parseInitialSectionHeader` does not, since it only matches at--- the beginning of the text. This restores the newlines eaten by--- `parseSectionHeader`, so a `SectionHeader` returned by the parser--- can always be assumed /not/ to have an implicit starting newline.-restoreSHPreNewlines :: [Token] -> [Token]-restoreSHPreNewlines [] = []-restoreSHPreNewlines (i : rest) = i : restoreNewlines rest-  where restoreNewlines :: [Token] -> [Token]-        restoreNewlines [] = []-        restoreNewlines (s@(SectionHeader _ _) : rest) =-          Literal "\n" : s : restoreNewlines rest-        restoreNewlines (x : rest) = x : restoreNewlines rest+-- | A character indicating the start of the string, to simplify the+-- GtkDoc parser (part of the syntax is sensitive to the start of+-- lines, which we can represent as any character after '\n' or SOS).+startOfString :: Char+startOfString = '\x98' -- Unicode Start Of String (SOS) --- | `parseList` eats the newline before the list, restore it.-restoreListPreNewline :: [Token] -> [Token]-restoreListPreNewline [] = []-restoreListPreNewline (l@(List _) : rest) =-  Literal "\n" : l : restoreListPreNewline rest-restoreListPreNewline (x : rest) = x : restoreListPreNewline rest+-- | Remove the SOS marker from the input. Since this only appears at+-- the beginning of the text, we only need to worry about replacing it+-- in the first token, and only if it's a literal.+removeSOS :: [Token] -> [Token]+removeSOS [] = []+removeSOS (Literal l : rest) =+  if l == T.singleton startOfString+  then rest+  else Literal (T.replace (T.singleton startOfString) "" l) : rest+removeSOS (other : rest) = other : rest  -- | Accumulate consecutive literals into a single literal. coalesceLiterals :: [Token] -> [Token]@@ -174,17 +174,20 @@         headerAndTokens = do           header <- parseInitialSectionHeader           tokens <- justTokens-          return (header : tokens)+          return (header <> tokens)          justTokens :: Parser [Token]-        justTokens = many' parseToken+        justTokens = concat <$> many' parseToken --- | Parse a single token.+-- | Parse a single token. This can sometimes return more than a+-- single token, when parsing a logical token produces multiple output+-- tokens (for example when keeping the initial structure requires+-- adding together literals and other tokens). -- -- === __Examples__ -- >>> parseOnly (parseToken <* endOfInput) "func()"--- Right (SymbolRef (OldFunctionRef "func"))-parseToken :: Parser Token+-- Right [SymbolRef (OldFunctionRef "func")]+parseToken :: Parser [Token] parseToken = -- Note that the parsers overlap, so this is not as              -- efficient as it could be (if we had combined parsers              -- and then branched, so that there is no@@ -205,6 +208,7 @@              <|> parseClass              <|> parseCType              <|> parseConstant+             <|> parseEnumMember              <|> parseParam              <|> parseEscaped              <|> parseCodeBlock@@ -212,7 +216,8 @@              <|> parseUrl              <|> parseImage              <|> parseSectionHeader-             <|> parseList+             <|> parseUnnumberedList+             <|> parseNumberedList              <|> parseComment              <|> parseBoringLiteral @@ -227,16 +232,16 @@ parseCIdent = takeWhile1 isCIdent  -- | Parse a function ref-parseFunctionRef :: Parser Token+parseFunctionRef :: Parser [Token] parseFunctionRef = parseOldFunctionRef <|> parseNewFunctionRef  -- | Parse an unresolved reference to a C symbol in new gtk-doc notation.-parseId :: Parser Token+parseId :: Parser [Token] parseId = do   _ <- string "[id@"   ident <- parseCIdent   _ <- char ']'-  return (SymbolRef (OldFunctionRef ident))+  return [SymbolRef (OldFunctionRef ident)]  -- | Parse a function ref, given by a valid C identifier followed by -- '()', for instance 'gtk_widget_show()'. If the identifier is not@@ -244,55 +249,58 @@ -- -- === __Examples__ -- >>> parseOnly (parseFunctionRef <* endOfInput) "test_func()"--- Right (SymbolRef (OldFunctionRef "test_func"))+-- Right [SymbolRef (OldFunctionRef "test_func")] -- -- >>> parseOnly (parseFunctionRef <* endOfInput) "not_a_func"--- Right (Literal "not_a_func")-parseOldFunctionRef :: Parser Token+-- Right [Literal "not_a_func"]+parseOldFunctionRef :: Parser [Token] parseOldFunctionRef = do   ident <- parseCIdent-  option (Literal ident) (string "()" >>-                          return (SymbolRef (OldFunctionRef ident)))+  option [Literal ident] (string "()" >>+                          return [SymbolRef (OldFunctionRef ident)])  -- | Parse a function name in new style, of the form -- > [func@Namespace.c_func_name] -- -- === __Examples__ -- >>> parseOnly (parseFunctionRef <* endOfInput) "[func@Gtk.init]"--- Right (SymbolRef (FunctionRef (AbsoluteName "Gtk" "init")))-parseNewFunctionRef :: Parser Token+-- Right [SymbolRef (FunctionRef (AbsoluteName "Gtk" "init"))]+parseNewFunctionRef :: Parser [Token] parseNewFunctionRef = do   _ <- string "[func@"   ns <- takeWhile1 (\c -> isAscii c && isAlpha c)   _ <- char '.'   n <- takeWhile1 isCIdent   _ <- char ']'-  return $ SymbolRef $ FunctionRef (AbsoluteName ns n)+  return [SymbolRef $ FunctionRef (AbsoluteName ns n)]  -- | Parse a method name, of the form -- > [method@Namespace.Object.c_func_name] -- -- === __Examples__ -- >>> parseOnly (parseMethod <* endOfInput) "[method@Gtk.Button.set_child]"--- Right (SymbolRef (MethodRef (AbsoluteName "Gtk" "Button") "set_child"))-parseMethod :: Parser Token+-- Right [SymbolRef (MethodRef (AbsoluteName "Gtk" "Button") "set_child")]+--+-- >>> parseOnly (parseMethod <* endOfInput) "[func@Gtk.Settings.get_for_display]"+-- Right [SymbolRef (MethodRef (AbsoluteName "Gtk" "Settings") "get_for_display")]+parseMethod :: Parser [Token] parseMethod = do-  _ <- string "[method@"+  _ <- string "[method@" <|> string "[func@"   ns <- takeWhile1 (\c -> isAscii c && isAlpha c)   _ <- char '.'   n <- takeWhile1 isCIdent   _ <- char '.'   method <- takeWhile1 isCIdent   _ <- char ']'-  return $ SymbolRef $ MethodRef (AbsoluteName ns n) method+  return [SymbolRef $ MethodRef (AbsoluteName ns n) method]  -- | Parse a reference to a constructor, of the form -- > [ctor@Namespace.Object.c_func_name] -- -- === __Examples__ -- >>> parseOnly (parseConstructor <* endOfInput) "[ctor@Gtk.Builder.new_from_file]"--- Right (SymbolRef (MethodRef (AbsoluteName "Gtk" "Builder") "new_from_file"))-parseConstructor :: Parser Token+-- Right [SymbolRef (MethodRef (AbsoluteName "Gtk" "Builder") "new_from_file")]+parseConstructor :: Parser [Token] parseConstructor = do   _ <- string "[ctor@"   ns <- takeWhile1 (\c -> isAscii c && isAlpha c)@@ -301,34 +309,59 @@   _ <- char '.'   method <- takeWhile1 isCIdent   _ <- char ']'-  return $ SymbolRef $ MethodRef (AbsoluteName ns n) method+  return [SymbolRef $ MethodRef (AbsoluteName ns n) method]  -- | Parse a reference to a type, of the form -- > [class@Namespace.Name] -- an interface of the form -- > [iface@Namespace.Name]--- or an enum type:+-- or an enumeration type, of the form -- > [enum@Namespace.Name] -- -- === __Examples__ -- >>> parseOnly (parseClass <* endOfInput) "[class@Gtk.Dialog]"--- Right (SymbolRef (TypeRef (AbsoluteName "Gtk" "Dialog")))+-- Right [SymbolRef (TypeRef (AbsoluteName "Gtk" "Dialog"))] -- -- >>> parseOnly (parseClass <* endOfInput) "[iface@Gtk.Editable]"--- Right (SymbolRef (TypeRef (AbsoluteName "Gtk" "Editable")))+-- Right [SymbolRef (TypeRef (AbsoluteName "Gtk" "Editable"))] -- -- >>> parseOnly (parseClass <* endOfInput) "[enum@Gtk.SizeRequestMode]"--- Right (SymbolRef (TypeRef (AbsoluteName "Gtk" "SizeRequestMode")))-parseClass :: Parser Token+-- Right [SymbolRef (TypeRef (AbsoluteName "Gtk" "SizeRequestMode"))]+--+-- >>> parseOnly (parseClass <* endOfInput) "[struct@GLib.Variant]"+-- Right [SymbolRef (TypeRef (AbsoluteName "GLib" "Variant"))]+parseClass :: Parser [Token] parseClass = do-  _ <- string "[class@" <|> string "[iface@" <|> string "[enum@"+  _ <- string "[class@" <|> string "[iface@" <|>+       string "[enum@" <|> string "[struct@"   ns <- takeWhile1 (\c -> isAscii c && isAlpha c)   _ <- char '.'   n <- takeWhile1 isCIdent   _ <- char ']'-  return $ SymbolRef $ TypeRef (AbsoluteName ns n)+  return [SymbolRef $ TypeRef (AbsoluteName ns n)] -parseSignal :: Parser Token+-- | Parse a reference to a member of the enum, of the form+-- > [enum@Gtk.FontRendering.AUTOMATIC]+--+-- === __Examples__+-- >>> parseOnly (parseEnumMember <* endOfInput) "[enum@Gtk.FontRendering.AUTOMATIC]"+-- Right [SymbolRef (EnumMemberRef (AbsoluteName "Gtk" "FontRendering") "automatic")]+parseEnumMember :: Parser [Token]+parseEnumMember = do+  _ <- string "[enum@"+  ns <- takeWhile1 (\c -> isAscii c && isAlpha c)+  _ <- char '.'+  n <- takeWhile1 isCIdent+  _ <- char '.'+  member <- takeWhile1 isCIdent+  _ <- char ']'+  -- Sometimes the references are written in uppercase while the name+  -- of the member in the introspection data is written in lowercase,+  -- so normalise everything to lowercase. (See the similar annotation+  -- in CtoHaskellMap.hs.)+  return [SymbolRef $ EnumMemberRef (AbsoluteName ns n) (T.toLower member)]++parseSignal :: Parser [Token] parseSignal = parseOldSignal <|> parseNewSignal  -- | Parse an old style signal name, of the form@@ -336,22 +369,22 @@ -- -- === __Examples__ -- >>> parseOnly (parseOldSignal <* endOfInput) "#GtkButton::activate"--- Right (SymbolRef (OldSignalRef "GtkButton" "activate"))-parseOldSignal :: Parser Token+-- Right [SymbolRef (OldSignalRef "GtkButton" "activate")]+parseOldSignal :: Parser [Token] parseOldSignal = do   _ <- char '#'   obj <- parseCIdent   _ <- string "::"   signal <- signalOrPropName-  return (SymbolRef (OldSignalRef obj signal))+  return [SymbolRef (OldSignalRef obj signal)]  -- | Parse a new style signal ref, of the form -- > [signal@Namespace.Object::signal-name] -- -- === __Examples__ -- >>> parseOnly (parseNewSignal <* endOfInput) "[signal@Gtk.AboutDialog::activate-link]"--- Right (SymbolRef (SignalRef (AbsoluteName "Gtk" "AboutDialog") "activate-link"))-parseNewSignal :: Parser Token+-- Right [SymbolRef (SignalRef (AbsoluteName "Gtk" "AboutDialog") "activate-link")]+parseNewSignal :: Parser [Token] parseNewSignal = do   _ <- string "[signal@"   ns <- takeWhile1 (\c -> isAscii c && isAlpha c)@@ -360,41 +393,43 @@   _ <- string "::"   signal <- takeWhile1 (\c -> (isAscii c && isAlpha c) || c == '-')   _ <- char ']'-  return (SymbolRef (SignalRef (AbsoluteName ns n) signal))+  return [SymbolRef (SignalRef (AbsoluteName ns n) signal)]  -- | Parse a reference to a signal defined in the current module, of the form -- > ::signal -- -- === __Examples__ -- >>> parseOnly (parseLocalSignal <* endOfInput) "::activate"--- Right (SymbolRef (LocalSignalRef "activate"))-parseLocalSignal :: Parser Token+-- Right [SymbolRef (LocalSignalRef "activate")]+parseLocalSignal :: Parser [Token] parseLocalSignal = do   _ <- string "::"   signal <- signalOrPropName-  return (SymbolRef (LocalSignalRef signal))+  return [SymbolRef (LocalSignalRef signal)]  -- | Parse a property name in the old style, of the form -- > #Object:property -- -- === __Examples__ -- >>> parseOnly (parseOldProperty <* endOfInput) "#GtkButton:always-show-image"--- Right (SymbolRef (OldPropertyRef "GtkButton" "always-show-image"))-parseOldProperty :: Parser Token+-- Right [SymbolRef (OldPropertyRef "GtkButton" "always-show-image")]+parseOldProperty :: Parser [Token] parseOldProperty = do   _ <- char '#'   obj <- parseCIdent   _ <- char ':'   property <- signalOrPropName-  return (SymbolRef (OldPropertyRef obj property))+  return [SymbolRef (OldPropertyRef obj property)]  -- | Parse a property name in the new style: -- > [property@Namespace.Object:property-name] -- -- === __Examples__ -- >>> parseOnly (parseNewProperty <* endOfInput) "[property@Gtk.ProgressBar:show-text]"--- Right (SymbolRef (PropertyRef (AbsoluteName "Gtk" "ProgressBar") "show-text"))-parseNewProperty :: Parser Token+-- Right [SymbolRef (PropertyRef (AbsoluteName "Gtk" "ProgressBar") "show-text")]+-- >>> parseOnly (parseNewProperty <* endOfInput) "[property@Gtk.Editable:width-chars]"+-- Right [SymbolRef (PropertyRef (AbsoluteName "Gtk" "Editable") "width-chars")]+parseNewProperty :: Parser [Token] parseNewProperty = do   _ <- string "[property@"   ns <- takeWhile1 (\c -> isAscii c && isAlpha c)@@ -403,10 +438,10 @@   _ <- char ':'   property <- takeWhile1 (\c -> (isAscii c && isAlpha c) || c == '-')   _ <- char ']'-  return (SymbolRef (PropertyRef (AbsoluteName ns n) property))+  return [SymbolRef (PropertyRef (AbsoluteName ns n) property)]  -- | Parse a property-parseProperty :: Parser Token+parseProperty :: Parser [Token] parseProperty = parseOldProperty <|> parseNewProperty  -- | Parse an xml comment, of the form@@ -415,33 +450,33 @@ -- -- === __Examples__ -- >>> parseOnly (parseComment <* endOfInput) "<!-- comment -->"--- Right (Comment " comment ")-parseComment :: Parser Token+-- Right [Comment " comment "]+parseComment :: Parser [Token] parseComment = do   comment <- string "<!--" *> manyTill anyChar (string "-->")-  return (Comment $ T.pack comment)+  return [Comment $ T.pack comment]  -- | Parse an old style reference to a virtual method, of the form -- > #Struct.method() -- -- === __Examples__ -- >>> parseOnly (parseOldVMethod <* endOfInput) "#Foo.bar()"--- Right (SymbolRef (VMethodRef "Foo" "bar"))-parseOldVMethod :: Parser Token+-- Right [SymbolRef (VMethodRef "Foo" "bar")]+parseOldVMethod :: Parser [Token] parseOldVMethod = do   _ <- char '#'   obj <- parseCIdent   _ <- char '.'   method <- parseCIdent   _ <- string "()"-  return (SymbolRef (VMethodRef obj method))+  return [SymbolRef (VMethodRef obj method)]  -- | Parse a new style reference to a virtual function, of the form -- > [vfunc@Namespace.Object.vfunc_name] -- -- >>> parseOnly (parseVFunc <* endOfInput) "[vfunc@Gtk.Widget.get_request_mode]"--- Right (SymbolRef (VFuncRef (AbsoluteName "Gtk" "Widget") "get_request_mode"))-parseVFunc :: Parser Token+-- Right [SymbolRef (VFuncRef (AbsoluteName "Gtk" "Widget") "get_request_mode")]+parseVFunc :: Parser [Token] parseVFunc = do   _ <- string "[vfunc@"   ns <- takeWhile1 (\c -> isAscii c && isAlpha c)@@ -450,10 +485,10 @@   _ <- char '.'   vfunc <- parseCIdent   _ <- char ']'-  return (SymbolRef (VFuncRef (AbsoluteName ns n) vfunc))+  return [SymbolRef (VFuncRef (AbsoluteName ns n) vfunc)]  -- | Parse a reference to a virtual method-parseVMethod :: Parser Token+parseVMethod :: Parser [Token] parseVMethod = parseOldVMethod <|> parseVFunc  -- | Parse a reference to a struct field, of the form@@ -461,50 +496,50 @@ -- -- === __Examples__ -- >>> parseOnly (parseStructField <* endOfInput) "#Foo.bar"--- Right (SymbolRef (StructFieldRef "Foo" "bar"))-parseStructField :: Parser Token+-- Right [SymbolRef (StructFieldRef "Foo" "bar")]+parseStructField :: Parser [Token] parseStructField = do   _ <- char '#'   obj <- parseCIdent   _ <- char '.'   field <- parseCIdent-  return (SymbolRef (StructFieldRef obj field))+  return [SymbolRef (StructFieldRef obj field)]  -- | Parse a reference to a C type, of the form -- > #Type -- -- === __Examples__ -- >>> parseOnly (parseCType <* endOfInput) "#Foo"--- Right (SymbolRef (CTypeRef "Foo"))-parseCType :: Parser Token+-- Right [SymbolRef (CTypeRef "Foo")]+parseCType :: Parser [Token] parseCType = do   _ <- char '#'   obj <- parseCIdent-  return (SymbolRef (CTypeRef obj))+  return [SymbolRef (CTypeRef obj)]  -- | Parse a constant, of the form -- > %CONSTANT_NAME -- -- === __Examples__ -- >>> parseOnly (parseConstant <* endOfInput) "%TEST_CONSTANT"--- Right (SymbolRef (ConstantRef "TEST_CONSTANT"))-parseConstant :: Parser Token+-- Right [SymbolRef (ConstantRef "TEST_CONSTANT")]+parseConstant :: Parser [Token] parseConstant = do   _ <- char '%'   c <- parseCIdent-  return (SymbolRef (ConstantRef c))+  return [SymbolRef (ConstantRef c)]  -- | Parse a reference to a parameter, of the form -- > @param_name -- -- === __Examples__ -- >>> parseOnly (parseParam <* endOfInput) "@test_param"--- Right (SymbolRef (ParamRef "test_param"))-parseParam :: Parser Token+-- Right [SymbolRef (ParamRef "test_param")]+parseParam :: Parser [Token] parseParam = do   _ <- char '@'   param <- parseCIdent-  return (SymbolRef (ParamRef param))+  return [SymbolRef (ParamRef param)]  -- | Name of a signal or property name. Similar to a C identifier, but -- hyphens are allowed too.@@ -515,20 +550,20 @@         isSignalOrPropIdent c = isCIdent c  -- | Parse a escaped special character, i.e. one preceded by '\'.-parseEscaped :: Parser Token+parseEscaped :: Parser [Token] parseEscaped = do   _ <- char '\\'   c <- satisfy (`elem` ("#@%\\`" :: [Char]))-  return $ Literal (T.singleton c)+  return [Literal (T.singleton c)]  -- | Parse a literal, i.e. anything without a known special -- meaning. Note that this parser always consumes the first character, -- regardless of what it is.-parseBoringLiteral :: Parser Token+parseBoringLiteral :: Parser [Token] parseBoringLiteral = do   c <- anyChar   boring <- takeWhile (not . special)-  return $ Literal (T.cons c boring)+  return [Literal (T.cons c boring)]  -- | List of special characters from the point of view of the parser -- (in the sense that they may be the beginning of something with a@@ -544,6 +579,7 @@ special '!' = True special '\n' = True special ':' = True+special '-' = True special c = isCIdent c  -- | Parse a verbatim string, of the form@@ -551,46 +587,46 @@ -- -- === __Examples__ -- >>> parseOnly (parseVerbatim <* endOfInput) "`Example quote!`"--- Right (Verbatim "Example quote!")-parseVerbatim :: Parser Token+-- Right [Verbatim "Example quote!"]+parseVerbatim :: Parser [Token] parseVerbatim = do   _ <- char '`'   v <- takeWhile1 (/= '`')   _ <- char '`'-  return $ Verbatim v+  return [Verbatim v]  -- | Parse a URL in Markdown syntax, of the form -- > [name](url) -- -- === __Examples__ -- >>> parseOnly (parseUrl <* endOfInput) "[haskell](http://haskell.org)"--- Right (ExternalLink (Link {linkName = "haskell", linkAddress = "http://haskell.org"}))-parseUrl :: Parser Token+-- Right [ExternalLink (Link {linkName = "haskell", linkAddress = "http://haskell.org"})]+parseUrl :: Parser [Token] parseUrl = do   _ <- char '['   name <- takeWhile1 (/= ']')   _ <- string "]("   address <- takeWhile1 (/= ')')   _ <- char ')'-  return $ ExternalLink $ Link {linkName = name, linkAddress = address}+  return [ExternalLink $ Link {linkName = name, linkAddress = address}]  -- | Parse an image reference, of the form -- > ![label](url) -- -- === __Examples__ -- >>> parseOnly (parseImage <* endOfInput) "![](diagram.png)"--- Right (Image (Link {linkName = "", linkAddress = "diagram.png"}))-parseImage :: Parser Token+-- Right [Image (Link {linkName = "", linkAddress = "diagram.png"})]+parseImage :: Parser [Token] parseImage = do   _ <- string "!["   name <- takeWhile (/= ']')   _ <- string "]("   address <- takeWhile1 (/= ')')   _ <- char ')'-  return $ Image $ Link {linkName = name, linkAddress = address}+  return [Image $ Link {linkName = name, linkAddress = address}]  -- | Parse a code block embedded in the documentation.-parseCodeBlock :: Parser Token+parseCodeBlock :: Parser [Token] parseCodeBlock = parseOldStyleCodeBlock <|> parseNewStyleCodeBlock  -- | Parse a new style code block, of the form@@ -600,32 +636,44 @@ -- -- === __Examples__ -- >>> parseOnly (parseNewStyleCodeBlock <* endOfInput) "```c\nThis is C code\n```"--- Right (CodeBlock (Just (Language "c")) "This is C code")-parseNewStyleCodeBlock :: Parser Token+-- Right [CodeBlock (Just (Language "c")) "This is C code"]+--+-- >>> parseOnly (parseNewStyleCodeBlock <* endOfInput) "```\nThis is langless\n```"+-- Right [CodeBlock Nothing "This is langless"]+--+-- >>> parseOnly (parseNewStyleCodeBlock <* endOfInput) "   ```py\n   This has space in front\n   ```"+-- Right [CodeBlock (Just (Language "py")) "   This has space in front"]+--+-- >>> parseOnly (parseNewStyleCodeBlock <* endOfInput) "   ```c\n   new_type_id = g_type_register_dynamic (parent_type_id,\n                                          \"TypeName\",\n                                          new_type_plugin,\n                                          type_flags);\n   ```"+-- Right [CodeBlock (Just (Language "c")) "   new_type_id = g_type_register_dynamic (parent_type_id,\n                                          \"TypeName\",\n                                          new_type_plugin,\n                                          type_flags);"]+parseNewStyleCodeBlock :: Parser [Token] parseNewStyleCodeBlock = do+  _ <- takeWhile isHorizontalSpace   _ <- string "```"   lang <- T.strip <$> takeWhile (/= '\n')   _ <- char '\n'   let maybeLang = if T.null lang then Nothing                   else Just lang-  code <- T.pack <$> manyTill anyChar (string "\n```")-  return $ CodeBlock (Language <$> maybeLang) code+  code <- T.pack <$> manyTill anyChar (string "\n" >>+                                       takeWhile isHorizontalSpace >>+                                       string "```")+  return [CodeBlock (Language <$> maybeLang) code]  -- | Parse an old style code block, of the form -- > |[<!-- language="C" --> code ]| -- -- === __Examples__ -- >>> parseOnly (parseOldStyleCodeBlock <* endOfInput) "|[this is code]|"--- Right (CodeBlock Nothing "this is code")+-- Right [CodeBlock Nothing "this is code"] -- -- >>> parseOnly (parseOldStyleCodeBlock <* endOfInput) "|[<!-- language=\"C\"-->this is C code]|"--- Right (CodeBlock (Just (Language "C")) "this is C code")-parseOldStyleCodeBlock :: Parser Token+-- Right [CodeBlock (Just (Language "C")) "this is C code"]+parseOldStyleCodeBlock :: Parser [Token] parseOldStyleCodeBlock = do   _ <- string "|["   lang <- (Just <$> parseLanguage) <|> return Nothing   code <- T.pack <$> manyTill anyChar (string "]|")-  return $ CodeBlock lang code+  return [CodeBlock lang code]  -- | Parse the language of a code block, specified as a comment. parseLanguage :: Parser Language@@ -639,11 +687,30 @@   _ <- string "-->"   return $ Language lang +-- | Parse at least one newline (or Start of String (SOS)), and keep+-- going while we see newlines. Return either the empty list (for the+-- case that we see a single SOS), or a singleton list with the+-- Literal representing the seen newlines, and removing the SOS.+parseInitialNewlines :: Parser [Token]+parseInitialNewlines = do+  initial <- char '\n' <|> char startOfString+  let initialString = if initial == '\n'+                      then "\n"+                      else ""+  others <- T.pack <$> many' (char '\n')+  let joint = initialString <> others+  if T.null joint+    then return []+    else return [Literal joint]+ -- | Parse a section header, given by a number of hash symbols, and -- then ordinary text. Note that this parser "eats" the newline before -- and after the section header.-parseSectionHeader :: Parser Token-parseSectionHeader = char '\n' >> parseInitialSectionHeader+parseSectionHeader :: Parser [Token]+parseSectionHeader = do+  initialNewlines <- parseInitialNewlines+  sectionHeader <- parseInitialSectionHeader+  return $ initialNewlines <> sectionHeader  -- | Parse a section header at the beginning of the text. I.e. this is -- the same as `parseSectionHeader`, but we do not expect a newline as@@ -651,42 +718,223 @@ -- -- === __Examples__ -- >>> parseOnly (parseInitialSectionHeader <* endOfInput) "### Hello! ###\n"--- Right (SectionHeader 3 (GtkDoc [Literal "Hello! "]))+-- Right [SectionHeader 3 (GtkDoc [Literal "Hello! "])] -- -- >>> parseOnly (parseInitialSectionHeader <* endOfInput) "# Hello!\n"--- Right (SectionHeader 1 (GtkDoc [Literal "Hello!"]))-parseInitialSectionHeader :: Parser Token+-- Right [SectionHeader 1 (GtkDoc [Literal "Hello!"])]+parseInitialSectionHeader :: Parser [Token] parseInitialSectionHeader = do   hashes <- takeWhile1 (== '#')   _ <- many1 space   heading <- takeWhile1 (notInClass "#\n")   _ <- (string hashes >> char '\n') <|> (char '\n')-  return $ SectionHeader (T.length hashes) (parseGtkDoc heading)+  return [SectionHeader (T.length hashes) (parseGtkDoc heading)] --- | Parse a list header. Note that the newline before the start of--- the list is "eaten" by this parser, but is restored later by--- `parseGtkDoc`.------ === __Examples__--- >>> parseOnly (parseList <* endOfInput) "\n- First item\n- Second item"--- Right (List [ListItem (GtkDoc [Literal "First item"]) [],ListItem (GtkDoc [Literal "Second item"]) []])------ >>> parseOnly (parseList <* endOfInput) "\n\n- Two line\n  item\n\n- Second item,\n  also two lines"--- Right (List [ListItem (GtkDoc [Literal "Two line"]) [GtkDoc [Literal "item"]],ListItem (GtkDoc [Literal "Second item,"]) [GtkDoc [Literal "also two lines"]]])-parseList :: Parser Token-parseList = do-  items <- many1 parseListItem-  return $ List items-  where parseListItem :: Parser ListItem-        parseListItem = do-          _ <- char '\n'-          _ <- string "\n- " <|> string "- "-          first <- takeWhile1 (/= '\n')-          rest <- many' parseLine-          return $ ListItem (parseGtkDoc first) (map parseGtkDoc rest)+{- | Parse an unnumbered list. -        parseLine :: Parser Text-        parseLine = string "\n  " >> takeWhile1 (/= '\n')+=== __Examples__+>>> :{+parseOnly (parseUnnumberedList <* endOfInput) $ T.stripEnd $ T.unlines [+T.cons startOfString+"- First item",+"- Second item"+]+:}+Right [UnnumberedList [GtkDoc [Literal "First item"],GtkDoc [Literal "Second item"]]]++>>> :{+parseOnly (parseUnnumberedList <* endOfInput) $ T.stripEnd $ T.unlines [+"",+"",+"- Two line",+"  item",+"",+"- Second item,",+"  with three lines",+"  of text."+]+:}+Right [Literal "\n\n",UnnumberedList [GtkDoc [Literal "Two line\nitem"],GtkDoc [Literal "Second item,\nwith three lines\nof text."]]]+-}+parseUnnumberedList :: Parser [Token]+parseUnnumberedList = do+  (initialNewlines, entries) <- parseList (string "- ") T.length+  return $ initialNewlines <> [UnnumberedList (map snd entries)]++{- | Parse a numbered list header.++=== __Examples__+>>> :{+parseOnly (parseNumberedList <* endOfInput) $ T.stripEnd $ T.unlines [+T.cons startOfString+"1. First item,",+"   written in two lines",+"",+"2. Second item,",+"   also in two lines"+]+:}+Right [NumberedList [("1",GtkDoc [Literal "First item,\nwritten in two lines"]),("2",GtkDoc [Literal "Second item,\nalso in two lines"])]]++>>> :{+parseOnly (parseNumberedList <* endOfInput) $ T.stripEnd $ T.unlines [+T.cons startOfString+"1. First item,",+"   written in two lines",+"2. Second item,",+"   now in three lines,",+"   written compactly"+]+:}+Right [NumberedList [("1",GtkDoc [Literal "First item,\nwritten in two lines"]),("2",GtkDoc [Literal "Second item,\nnow in three lines,\nwritten compactly"])]]++>>> :{+parseOnly (parseNumberedList <* endOfInput) $ T.stripEnd $ T.unlines [+T.cons startOfString+"9. This is a list entry with two lines,",+"   with the second line in its own line.",+"10. If the label width changes,",+"    the indentation of the second line should also be adjusted.",+"",+"11. You can optionally include an empty line between entries",+"    without stopping the list.",+"",+"    This also applies within list entries, this is still part of",+"    entry 11.",+"12. But you don't have to."+]+:}+Right [NumberedList [("9",GtkDoc [Literal "This is a list entry with two lines,\nwith the second line in its own line."]),("10",GtkDoc [Literal "If the label width changes,\nthe indentation of the second line should also be adjusted."]),("11",GtkDoc [Literal "You can optionally include an empty line between entries\nwithout stopping the list.\n\nThis also applies within list entries, this is still part of\nentry 11."]),("12",GtkDoc [Literal "But you don't have to."])]]++>>> :{+parseGtkDoc $ T.stripEnd $ T.unlines [+"1. A list with a single element",+"",+"And this is text not in the list, so we use parseGtkDoc."+]+:}+GtkDoc [NumberedList [("1",GtkDoc [Literal "A list with a single element"])],Literal "\n\nAnd this is text not in the list, so we use parseGtkDoc."]++>>> :{+parseOnly (parseNumberedList <* endOfInput) $ T.stripEnd $ T.unlines [+T.cons startOfString+"1. An example of a list in lenient mode,",+"where we don't require indenting this second line.",+"",+"2. In this mode entries can be optionally separated by an empty line.",+"3. But they don't need to"+]+:}+Right [NumberedList [("1",GtkDoc [Literal "An example of a list in lenient mode,\nwhere we don't require indenting this second line."]),("2",GtkDoc [Literal "In this mode entries can be optionally separated by an empty line."]),("3",GtkDoc [Literal "But they don't need to"])]]+-}+parseNumberedList :: Parser [Token]+parseNumberedList = do+  (initialNewlines, list) <- parseList (do idx <- takeWhile1 isDigit+                                           _ <- string ". "+                                           return idx)+                                       (\label -> T.length label + 2)+  return $ initialNewlines <> [NumberedList list]++{- | The indent parsing mode. In strict mode we require that all the+   text in the lines is indented relative to the label, as in the+   following example:++        1. The first line,+           and the second line++           In this mode we allow empty lines in the entry.+        2. This is the second entry.++   In lenient mode we drop this restriction, so the following is valid:+        1. The first line,+        and the second line+        In this mode we _do not_ allow empty lines in the entry.+        2. This is the second entry.+-}+data IndentParsingMode = Lenient | Strict+  deriving (Eq)++{- | Parse an unnumbered or numbered list. See 'parseNumberedList' and+   'parseUnnumberedList' for examples.+-}+parseList :: Parser Text -> (Text -> Int) ->+                    Parser ([Token], [(Text, GtkDoc)])+parseList labelParser indent =+  doParseList Lenient <|> doParseList Strict+ where+   doParseList :: IndentParsingMode ->+                  Parser ([Token], [(Text, GtkDoc)])+   doParseList mode = do+     -- Consume the initial newlines before parseListItem does, so we can+     -- restore the initial newlines after. We impose that there is at+     -- least a newline (or Start of String symbol) before the start of+     -- the list.+     initialNewlines <- parseInitialNewlines+     (initialSpace, first) <-+       parseListItem (takeWhile isHorizontalSpace) (pure ())+     -- We allow either one or zero empty lines between entries.+     let newlineParser = (string "\n\n" <|> string "\n") >> pure ()+     rest <- map snd <$>+             many' (parseListItem (string initialSpace) newlineParser)+     -- Validate the resulting entries, and assemble them into GtkDoc.+     validated <- forM (first : rest) $ \(label, (firstLine, otherLines)) -> do+       validate label otherLines+       return (label,+               parseGtkDoc $ T.strip $ T.unlines $ firstLine : otherLines)++     return (initialNewlines, validated)++    where+      parseListItem :: Parser Text -> Parser () ->+                         Parser (Text, (Text, (Text, [Text])))+      parseListItem parseInitialSpace startingNewlines = do+        startingNewlines+        initialSpace <- parseInitialSpace+        label <- labelParser+        first <- takeWhile (/= '\n')+        let padding = case mode of+              Strict -> initialSpace <> T.replicate (indent label) " "+              Lenient -> initialSpace+            paddingParser = string padding++        rest <- many' (parseLine paddingParser)++        return (initialSpace, (label, (first, rest)))++      parseLine :: Parser Text -> Parser Text+      parseLine paddingParser = do+        emptyLines <- case mode of+          -- We do not allow empty lines in entries in the lenient+          -- indent parser, while the strict indent one allows one+          -- at most.+          Strict -> option "" emptyLine+          Lenient -> pure ""+        _ <- char '\n' >> paddingParser+        contents <- takeWhile1 (/= '\n')+        when (startsWith labelParser contents) $+          fail "Line starting with a label"+        return $ emptyLines <> contents++      emptyLine = do+        _ <- char '\n'+        maybeNext <- peekChar+        guard $ maybeNext == Nothing || maybeNext == Just '\n'+        return ("\n" :: Text)++      startsWith :: Parser a -> Text -> Bool+      startsWith p l = isRight $ parseOnly p l++      validate :: Text -> [Text] -> Parser ()+      validate _ [] = pure ()+      validate label lines = case mode of+        Strict -> pure ()+        Lenient -> do+          let extraIndent = string $ T.replicate (indent label) " "++          -- If every line has extra padding we are most likely in+          -- the wrong mode too.+          when (all (startsWith extraIndent) lines) $+            fail "All lines have extra indent"  -- | Turn an ordinary `Name` into a `DocSymbolName` docName :: Name -> DocSymbolName

@@ -33,7 +33,7 @@ import Data.GI.CodeGen.Config (modName, overrides) import Data.GI.CodeGen.CtoHaskellMap (Hyperlink(..)) import Data.GI.CodeGen.GtkDoc (GtkDoc(..), Token(..), CRef(..), Language(..),-                               Link(..), ListItem(..), parseGtkDoc,+                               Link(..), parseGtkDoc,                                DocSymbolName(..), resolveDocSymbol, docName) import Data.GI.CodeGen.Overrides (onlineDocsMap) import Data.GI.CodeGen.SymbolNaming (lowerSymbol, signalHaskellName,@@ -53,6 +53,9 @@ -- >>> formatHaddock M.empty "" "Test" (GtkDoc [Literal "Hello ", Literal "World!"]) -- "Hello World!" --+-- >>> formatHaddock M.empty "" "Test" (GtkDoc [Literal "This is a **bold** world!"])+-- "This is a __bold__ world!"+-- -- >>> let c2h = M.fromList [(OldFunctionRef "foo", ValueIdentifier "foo")] -- >>> formatHaddock c2h "" "Test" (GtkDoc [SymbolRef (OldFunctionRef "foo")]) -- "'foo'"@@ -61,12 +64,15 @@ -- >>> formatHaddock M.empty onlineDocs "Test" (GtkDoc [ExternalLink (Link "GI" "GObjectIntrospection")]) -- "<http://wiki.haskell.org/GObjectIntrospection GI>" ----- >>> formatHaddock M.empty "a" "Test" (GtkDoc [List [ListItem (GtkDoc [Image (Link "test" "test.png")]) []]])--- "\n* <<a/test.png test>>\n"+-- >>> formatHaddock M.empty "a" "Test" (GtkDoc [UnnumberedList [GtkDoc [Image (Link "test" "test.png")]]])+-- "* <<a/test.png test>>\n"+--+-- >>> formatHaddock M.empty "a" "Test" (GtkDoc [NumberedList [("1", GtkDoc [Literal "Hi!"]), ("2", GtkDoc [Literal "Second and very long, so split\n line."])]])+-- "1. Hi!\n\n2. Second and very long, so split\n   line.\n\n" formatHaddock :: M.Map CRef Hyperlink -> Text -> Text -> GtkDoc -> Text formatHaddock c2h docBase defaultNS (GtkDoc tokens) = T.concat $ map formatToken tokens   where formatToken :: Token -> Text-        formatToken (Literal l) = escape l+        formatToken (Literal l) = escape (convertBold l)         formatToken (Comment _) = ""         formatToken (Verbatim v) = "@" <> escape v <> "@"         formatToken (CodeBlock l c) = formatCodeBlock l c@@ -74,11 +80,19 @@         formatToken (Image l) = formatImage l docBase         formatToken (SectionHeader l h) =           formatSectionHeader c2h docBase defaultNS l h-        formatToken (List l) = formatList c2h docBase defaultNS l+        formatToken (UnnumberedList l) =+          formatUnnumberedList c2h docBase defaultNS l+        formatToken (NumberedList l) =+          formatNumberedList c2h docBase defaultNS l         formatToken (SymbolRef cr) = case M.lookup cr c2h of           Just hr -> formatHyperlink hr           Nothing -> formatUnknownCRef c2h defaultNS cr +        -- Markdown accepts both two underscores and two stars as+        -- indicating bold, but Haddock only accepts two underscores.+        convertBold :: Text -> Text+        convertBold l = T.replace "**" "__" l+ -- | Format a `CRef` whose Haskell representation is not known, using -- a provided default namespace for relative symbols. formatUnknownCRef :: M.Map CRef Hyperlink -> Text -> CRef -> Text@@ -129,6 +143,11 @@ formatUnknownCRef _ defaultNS (TypeRef n) =   formatCRef $ formatDocSymbol n defaultNS formatUnknownCRef _ _ (ConstantRef t) = formatCRef t+formatUnknownCRef c2h defaultNS (EnumMemberRef docSymbol member) =+  let owner@(Name ns n) = resolveDocSymbol docSymbol defaultNS+  in case M.lookup (TypeRef (docName owner)) c2h of+    Nothing -> formatCRef $ ns <> "." <> n <> "." <> member+    Just r -> formatHyperlink r <> "." <> formatCRef member  -- | Format the given symbol name in a fully qualified way, using the -- default namespace if needed.@@ -154,7 +173,8 @@ formatCodeBlock :: Maybe Language -> Text -> Text formatCodeBlock maybeLang code =   let header = case maybeLang of-        Nothing -> ""+        Nothing -> "\n\t\n"  -- This is to convince haddock that we+                             -- are indeed starting a code block         Just (Language lang) -> "\n=== /" <> lang <> " code/\n"       birdTrack = T.unlines . map (T.cons '>') . T.lines   in header <> birdTrack code@@ -193,15 +213,34 @@   T.replicate level "=" <> " " <> formatHaddock c2h docBase defaultNS header <> "\n"  -- | Format a list of items.-formatList :: M.Map CRef Hyperlink -> Text -> Text -> [ListItem] -> Text-formatList c2h docBase defaultNS items = "\n" <> T.concat (map formatListItem items)-  where formatListItem :: ListItem -> Text-        formatListItem (ListItem first rest) =-          "* " <> format first <> "\n"-          <> T.concat (map ((<> "\n") . format) rest)+formatUnnumberedList :: M.Map CRef Hyperlink -> Text -> Text -> [GtkDoc]+                     -> Text+formatUnnumberedList c2h docBase defaultNS items =+  T.concat (map formatListItem items)+  where formatListItem :: GtkDoc -> Text+        formatListItem doc =+          let indent l = "  " <> T.stripStart l+              formatted = formatHaddock c2h docBase defaultNS doc+              indented = (T.unlines . map indent . T.lines) formatted+          in "* " <> T.stripStart indented -        format :: GtkDoc -> Text-        format doc = formatHaddock c2h docBase defaultNS doc+-- | Format a numbered list of items.+formatNumberedList :: M.Map CRef Hyperlink -> Text -> Text -> [(Text, GtkDoc)]+                   -> Text+formatNumberedList c2h docBase defaultNS items =+  T.concat (formatEnumeration items)+  where+    formatEnumeration :: [(Text, GtkDoc)] -> [Text]+    formatEnumeration [] = []+    formatEnumeration ((idx, doc):rest) =+      formatListItem idx doc <> "\n" : formatEnumeration rest++    formatListItem :: Text -> GtkDoc -> Text+    formatListItem idx doc =+      let indent l = T.replicate (T.length idx + 2) " " <> T.stripStart l+          formatted = formatHaddock c2h docBase defaultNS doc+          indented = (T.unlines . map indent . T.lines) formatted+      in idx <> ". " <> T.stripStart indented  -- | Escape the reserved Haddock characters in a given `Text`. --

@@ -278,7 +278,7 @@ -- | 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`."+    "Construct a t'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 -> ExcCodeGen ()

@@ -468,8 +468,8 @@       let builder = "newZero" <> name           tsize = tshow size -      writeHaddock DocBeforeSymbol ("Construct a `" <> name <>-                                     "` struct initialized to zero.")+      writeHaddock DocBeforeSymbol ("Construct a t'" <> name <>+                                     "' struct initialized to zero.")        line $ builder <> " :: MonadIO m => m " <> name       line $ builder <> " = liftIO $ " <>@@ -515,7 +515,7 @@ genBoxedGValueInstance :: Name -> Text -> CodeGen e () genBoxedGValueInstance n get_type_fn = do   let name' = upperName n-      doc = "Convert '" <> name' <> "' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'."+      doc = "Convert t'" <> name' <> "' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'."    writeHaddock DocBeforeSymbol doc 

@@ -35,6 +35,7 @@     , haddockAttrAnchor     ) where +import qualified Data.Char as C #if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>)) #endif@@ -116,14 +117,22 @@ sanitize (T.uncons -> Just ('_', xs)) = sanitize xs <> "_" sanitize xs = xs --- | Same as `lowerSymbol`, but accepts a `Name`. The namespace part--- of the name will be discarded.+-- | Turn the given `Name` into CamelCase, starting with a lowercase+-- letter. The resulting identifier will be qualified by the namespace+-- if necessary. -- -- === __Examples__ -- >>> lowerName (Name "Gtk" "main_quit") -- "mainQuit"+--+-- >>> lowerName (Name "NM" "80211Test")+-- "nM80211Test" lowerName :: Name -> Text-lowerName (Name _ s) = lowerSymbol s+lowerName (Name ns s) =+  if not . C.isAlpha $ T.head (sanitize s) then+    lowerSymbol (ns <> s)+  else+    lowerSymbol s  -- | Turn the given identifier into camelCase, starting with a -- lowercase letter.@@ -136,13 +145,22 @@                   "" -> error "empty name!!"                   n -> lcFirst n --- | Turn the given `Name` into CamelCase, starting with a capital letter.+-- | Turn the given `Name` into CamelCase, starting with a capital+-- letter. The resulting identifier will be qualified by the namespace+-- if necessary. -- -- === __Examples__ -- >>> upperName (Name "Foo" "bar_baz") -- "BarBaz"+--+-- >>> upperName (Name "NM" "80211ApFlags")+-- "NM80211ApFlags" upperName :: Name -> Text-upperName (Name _ s) = underscoresToCamelCase (sanitize s)+upperName (Name ns s) =+  if not . C.isAlpha $ T.head (sanitize s) then+    underscoresToCamelCase (sanitize (ns <> s))+  else+    underscoresToCamelCase (sanitize s)  -- | Construct the submodule path where the given API element will -- live. This is the path relative to the root for the corresponding

@@ -26,6 +26,8 @@         propFlags :: [PropertyFlag],         propReadNullable :: Maybe Bool,         propWriteNullable :: Maybe Bool,+        propSetter :: Maybe Text,+        propGetter :: Maybe Text,         propTransfer :: Transfer,         propDoc :: Documentation,         propDeprecated :: Maybe DeprecationInfo@@ -40,6 +42,8 @@   readable <- optionalAttr "readable" True parseBool   writable <- optionalAttr "writable" False parseBool   construct <- optionalAttr "construct" False parseBool+  setter <- queryAttr "setter"+  getter <- queryAttr "getter"   constructOnly <- optionalAttr "construct-only" False parseBool   maybeNullable <- optionalAttr "nullable" Nothing (\t -> Just <$> parseBool t)   let flags = (if readable then [PropertyReadable] else [])@@ -56,4 +60,6 @@                 , propDoc = doc                 , propReadNullable = maybeNullable                 , propWriteNullable = maybeNullable+                , propSetter = setter+                , propGetter = getter                 }