haskell-gi 0.26.0 → 0.26.1
raw patch · 6 files changed
+337/−102 lines, 6 filesdep ~haskell-gi-basePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: haskell-gi-base
API changes (from Hackage documentation)
- Data.GI.CodeGen.GType: data GType
+ Data.GI.CodeGen.GType: data () => GType
- Data.GI.GIR.Parser: data Element
+ Data.GI.GIR.Parser: data () => Element
Files
- haskell-gi.cabal +2/−2
- lib/Data/GI/CodeGen/Code.hs +1/−0
- lib/Data/GI/CodeGen/Conversions.hsc +6/−3
- lib/Data/GI/CodeGen/CtoHaskellMap.hs +51/−28
- lib/Data/GI/CodeGen/GtkDoc.hs +249/−60
- lib/Data/GI/CodeGen/Haddock.hs +28/−9
haskell-gi.cabal view
@@ -1,5 +1,5 @@ name: haskell-gi-version: 0.26.0+version: 0.26.1 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.@@ -31,7 +31,7 @@ default-language: Haskell2010 pkgconfig-depends: gobject-introspection-1.0 >= 1.32, gobject-2.0 >= 2.32 build-depends: base >= 4.11 && < 5,- haskell-gi-base >= 0.26.0 && <0.27,+ haskell-gi-base >= 0.26.1 && <0.27, Cabal >= 1.24, attoparsec >= 0.13, containers,
lib/Data/GI/CodeGen/Code.hs view
@@ -945,6 +945,7 @@ , "import qualified Data.GI.Base.GArray as B.GArray" , "import qualified Data.GI.Base.GClosure as B.GClosure" , "import qualified Data.GI.Base.GError as B.GError"+ , "import qualified Data.GI.Base.GHashTable as B.GHT" , "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"
lib/Data/GI/CodeGen/Conversions.hsc view
@@ -354,11 +354,14 @@ -- (destroy,packer,unpacker) for the given type. hashTablePtrPackers :: Type -> ExcCodeGen (Text, Text, Text) hashTablePtrPackers (TBasicType TPtr) =- return ("Nothing", "ptrPackPtr", "ptrUnpackPtr")+ return ("Nothing", "B.GHT.ptrPackPtr", "B.GHT.ptrUnpackPtr") hashTablePtrPackers (TBasicType TUTF8) =- return ("(Just ptr_to_g_free)", "cstringPackPtr", "cstringUnpackPtr")+ return ("(Just ptr_to_g_free)", "B.GHT.cstringPackPtr", "B.GHT.cstringUnpackPtr")+hashTablePtrPackers TGValue =+ return ("(Just B.GValue.ptr_to_gvalue_free)", "B.GHT.gvaluePackPtr",+ "B.GHT.gvalueUnpackPtr") hashTablePtrPackers t =- notImplementedError $ "GHashTable element of type " <> tshow t <> " unsupported."+ notImplementedError $ "GHashTable element of type " <> tshow t <> " unsupported." hToF_PackGHashTable :: Type -> Type -> ExcCodeGen Converter hToF_PackGHashTable keys elems = do
lib/Data/GI/CodeGen/CtoHaskellMap.hs view
@@ -6,7 +6,6 @@ ) where import qualified Data.Map as M-import Data.Maybe (catMaybes) #if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>)) #endif@@ -18,11 +17,12 @@ Enumeration(..), EnumerationMember(..), Interface(..), Object(..), Function(..), Method(..), Struct(..), Union(..),- Signal(..))+ Signal(..), Property(..)) import Data.GI.CodeGen.ModulePath (dotModulePath) import Data.GI.CodeGen.SymbolNaming (moduleLocation, lowerName, upperName,- signalHaskellName, haddockSignalAnchor)-import Data.GI.CodeGen.Util (ucFirst)+ signalHaskellName, haddockSignalAnchor,+ haddockAttrAnchor, hyphensToCamelCase)+import Data.GI.CodeGen.Util (ucFirst, lcFirst) -- | Link to an identifier, module, etc. data Hyperlink = ValueIdentifier Text@@ -56,12 +56,12 @@ extractRefs (n, APIObject o) = objectRefs n o builtins :: [(CRef, Hyperlink)]- builtins = [(TypeRef "gboolean", TypeIdentifier "P.Bool"),+ builtins = [(CTypeRef "gboolean", TypeIdentifier "P.Bool"), (ConstantRef "TRUE", ValueIdentifier "P.True"), (ConstantRef "FALSE", ValueIdentifier "P.False"),- (TypeRef "GError", TypeIdentifier "GError"),- (TypeRef "GType", TypeIdentifier "GType"),- (TypeRef "GVariant", TypeIdentifier "GVariant"),+ (CTypeRef "GError", TypeIdentifier "GError"),+ (CTypeRef "GType", TypeIdentifier "GType"),+ (CTypeRef "GVariant", TypeIdentifier "GVariant"), (ConstantRef "NULL", ValueIdentifier "P.Nothing")] -- | Obtain the fully qualified symbol pointing to a value.@@ -77,41 +77,44 @@ -- | Extract the C name of a constant. These are often referred to as -- types, so we allow that too. constRefs :: Name -> Constant -> [(CRef, Hyperlink)]-constRefs n c = [(ConstantRef (constantCType c),- fullyQualifiedValue n (APIConst c) $ name n),- (TypeRef (constantCType c),- fullyQualifiedValue n (APIConst c) $ name n)]+constRefs n c = [(ConstantRef (constantCType c), qualified),+ (CTypeRef (constantCType c), qualified),+ (TypeRef n, qualified)]+ where qualified = fullyQualifiedValue n (APIConst c) $ name n -- | Extract the C name of a function. funcRefs :: Name -> Function -> [(CRef, Hyperlink)]-funcRefs n f = [(FunctionRef (fnSymbol f),- fullyQualifiedValue n (APIFunction f) $ lowerName n)]+funcRefs n f = [(OldFunctionRef (fnSymbol f), qualified),+ (FunctionRef n, qualified)]+ where qualified = fullyQualifiedValue n (APIFunction f) $ lowerName n -- | Extract the C names of the fields in an enumeration/flags, and -- the name of the type itself. enumRefs :: API -> Name -> Enumeration -> [(CRef, Hyperlink)]-enumRefs api n e = (TypeRef (enumCType e),- fullyQualifiedType n api $ upperName n) :- map memberToRef (enumMembers e)- where memberToRef :: EnumerationMember -> (CRef, Hyperlink)+enumRefs api n e = (CTypeRef (enumCType e), qualified)+ : (TypeRef n, qualified)+ : map memberToRef (enumMembers e)+ where qualified = fullyQualifiedType n api $ upperName n+ memberToRef :: EnumerationMember -> (CRef, Hyperlink) memberToRef em = (ConstantRef (enumMemberCId em), fullyQualifiedValue n api $ upperName $ n {name = name n <> "_" <> enumMemberName em}) -- | Refs to the methods for a given owner. methodRefs :: Name -> API -> [Method] -> [(CRef, Hyperlink)]-methodRefs n api methods = catMaybes $ map methodRef methods- where methodRef :: Method -> Maybe (CRef, Hyperlink)+methodRefs n api methods = concatMap methodRef methods+ where methodRef :: Method -> [(CRef, Hyperlink)] methodRef Method{methodSymbol = symbol, methodName = mn} = -- Method name namespaced by the owner. let mn' = mn {name = name n <> "_" <> name mn}- in Just (FunctionRef symbol,- fullyQualifiedValue n api $ lowerName mn')+ qualified = fullyQualifiedValue n api $ lowerName mn'+ in [(OldFunctionRef symbol, qualified),+ (MethodRef n (name mn), qualified)] -- | Refs to the signals for a given owner. signalRefs :: Name -> API -> Maybe Text -> [Signal] -> [(CRef, Hyperlink)]-signalRefs n api maybeCName signals = map signalRef signals- where signalRef :: Signal -> (CRef, Hyperlink)+signalRefs n@(Name _ owner) api maybeCName signals = concatMap signalRef signals+ where signalRef :: Signal -> [(CRef, Hyperlink)] signalRef (Signal {sigName = sn}) = let mod = dotModulePath (moduleLocation n api) sn' = signalHaskellName sn@@ -119,15 +122,34 @@ Just cname -> cname Nothing -> let Name ns owner = n in ucFirst ns <> owner- in (SignalRef ownerCName sn,- ModuleLinkWithAnchor (Just sn') mod (haddockSignalAnchor <> sn'))+ label = Just (owner <> "::" <> sn')+ link = ModuleLinkWithAnchor label mod (haddockSignalAnchor <> sn')+ in [(OldSignalRef ownerCName sn, link),+ (SignalRef n sn, link)] +-- | Refs to the properties for a given owner.+propRefs :: Name -> API -> Maybe Text -> [Property] -> [(CRef, Hyperlink)]+propRefs n@(Name _ owner) api maybeCName props = concatMap propertyRef props+ where propertyRef :: Property -> [(CRef, Hyperlink)]+ propertyRef (Property {propName = pn}) =+ let mod = dotModulePath (moduleLocation n api)+ hn = lcFirst . hyphensToCamelCase $ pn+ ownerCName = case maybeCName of+ Just cname -> cname+ Nothing -> let Name ns owner = n+ in ucFirst ns <> owner+ label = Just (owner <> ":" <> hn)+ link = ModuleLinkWithAnchor label mod (haddockAttrAnchor <> hn)+ in [(OldPropertyRef ownerCName pn, link),+ (PropertyRef n pn, link)]+ -- | Given an optional C type and the API constructor construct the -- list of associated refs. maybeCType :: Name -> API -> Maybe Text -> [(CRef, Hyperlink)] maybeCType _ _ Nothing = []-maybeCType n api (Just ctype) = [(TypeRef ctype,- fullyQualifiedType n api (upperName n))]+maybeCType n api (Just ctype) = [(CTypeRef ctype, qualified),+ (TypeRef n, qualified)]+ where qualified = fullyQualifiedType n api (upperName n) -- | Extract the C name of a callback. callbackRefs :: Name -> Callback -> [(CRef, Hyperlink)]@@ -154,3 +176,4 @@ objectRefs n o = maybeCType n (APIObject o) (objCType o) <> methodRefs n (APIObject o) (objMethods o) <> signalRefs n (APIObject o) (objCType o) (objSignals o)+ <> propRefs n (APIObject o) (objCType o) (objProperties o)
lib/Data/GI/CodeGen/GtkDoc.hs view
@@ -20,8 +20,10 @@ #endif import Control.Applicative ((<|>)) +import Data.GI.GIR.BasicTypes (Name(Name))+ import Data.Attoparsec.Text-import Data.Char (isAsciiUpper, isAsciiLower, isDigit)+import Data.Char (isAlphaNum, isAlpha, isAscii) import qualified Data.Text as T import Data.Text (Text) @@ -53,15 +55,21 @@ deriving (Show, Eq) -- | A reference to some symbol in the API.-data CRef = FunctionRef Text+data CRef = FunctionRef Name+ | OldFunctionRef Text+ | MethodRef Name Text | ParamRef Text | ConstantRef Text- | SignalRef Text Text+ | SignalRef Name Text+ | OldSignalRef Text Text | LocalSignalRef Text- | PropertyRef Text Text+ | PropertyRef Name Text+ | OldPropertyRef Text Text | VMethodRef Text Text+ | VFuncRef Name Text | StructFieldRef Text Text- | TypeRef Text+ | CTypeRef Text+ | TypeRef Name deriving (Show, Eq, Ord) -- | A parsed representation of gtk-doc formatted documentation.@@ -75,7 +83,7 @@ -- GtkDoc [] -- -- >>> parseGtkDoc "func()"--- GtkDoc [SymbolRef (FunctionRef "func")]+-- GtkDoc [SymbolRef (OldFunctionRef "func")] -- -- >>> parseGtkDoc "literal" -- GtkDoc [Literal "literal"]@@ -84,13 +92,13 @@ -- GtkDoc [Literal "This is a long literal"] -- -- >>> parseGtkDoc "Call foo() for free cookies"--- GtkDoc [Literal "Call ",SymbolRef (FunctionRef "foo"),Literal " for free cookies"]+-- GtkDoc [Literal "Call ",SymbolRef (OldFunctionRef "foo"),Literal " for free cookies"] -- -- >>> parseGtkDoc "The signal ::activate is related to gtk_button_activate()."--- GtkDoc [Literal "The signal ",SymbolRef (LocalSignalRef "activate"),Literal " is related to ",SymbolRef (FunctionRef "gtk_button_activate"),Literal "."]+-- GtkDoc [Literal "The signal ",SymbolRef (LocalSignalRef "activate"),Literal " is related to ",SymbolRef (OldFunctionRef "gtk_button_activate"),Literal "."] -- -- >>> parseGtkDoc "The signal ##%#GtkButton::activate is related to gtk_button_activate()."--- GtkDoc [Literal "The signal ##%",SymbolRef (SignalRef "GtkButton" "activate"),Literal " is related to ",SymbolRef (FunctionRef "gtk_button_activate"),Literal "."]+-- GtkDoc [Literal "The signal ##%",SymbolRef (OldSignalRef "GtkButton" "activate"),Literal " is related to ",SymbolRef (OldFunctionRef "gtk_button_activate"),Literal "."] -- -- >>> parseGtkDoc "# A section\n\n## and a subsection ##\n" -- GtkDoc [SectionHeader 1 (GtkDoc [Literal "A section"]),Literal "\n",SectionHeader 2 (GtkDoc [Literal "and a subsection "])]@@ -162,7 +170,7 @@ -- -- === __Examples__ -- >>> parseOnly (parseToken <* endOfInput) "func()"--- Right (SymbolRef (FunctionRef "func"))+-- 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@@ -173,17 +181,21 @@ -- parser much, and it is the main source of -- backtracking. parseFunctionRef+ <|> parseMethod+ <|> parseConstructor <|> parseSignal+ <|> parseId <|> parseLocalSignal <|> parseProperty <|> parseVMethod <|> parseStructField- <|> parseType+ <|> parseClass+ <|> parseCType <|> parseConstant <|> parseParam <|> parseEscaped- <|> parseVerbatim <|> parseCodeBlock+ <|> parseVerbatim <|> parseUrl <|> parseImage <|> parseSectionHeader@@ -191,20 +203,152 @@ <|> parseComment <|> parseBoringLiteral --- | Parse a signal name, of the form--- > #Object::signal+-- | Whether the given character is valid in a C identifier.+isCIdent :: Char -> Bool+isCIdent '_' = True+isCIdent c = isAscii c && isAlphaNum c++-- | Something that could be a valid C identifier (loosely speaking,+-- we do not need to be too strict here).+parseCIdent :: Parser Text+parseCIdent = takeWhile1 isCIdent++-- | Parse a function ref+parseFunctionRef :: Parser Token+parseFunctionRef = parseOldFunctionRef <|> parseNewFunctionRef++-- | Parse an unresolved reference to a C symbol in new gtk-doc notation.+parseId :: Parser Token+parseId = do+ _ <- string "[id@"+ ident <- parseCIdent+ _ <- char ']'+ 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+-- followed by "()", return it as a literal instead. -- -- === __Examples__--- >>> parseOnly (parseSignal <* endOfInput) "#GtkButton::activate"--- Right (SymbolRef (SignalRef "GtkButton" "activate"))+-- >>> parseOnly (parseFunctionRef <* endOfInput) "test_func()"+-- Right (SymbolRef (OldFunctionRef "test_func"))+--+-- >>> parseOnly (parseFunctionRef <* endOfInput) "not_a_func"+-- Right (Literal "not_a_func")+parseOldFunctionRef :: Parser Token+parseOldFunctionRef = do+ ident <- parseCIdent+ 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 (Name {namespace = "Gtk", name = "init"})))+parseNewFunctionRef :: Parser Token+parseNewFunctionRef = do+ _ <- string "[func@"+ ns <- takeWhile1 (\c -> isAscii c && isAlpha c)+ _ <- char '.'+ n <- takeWhile1 isCIdent+ _ <- char ']'+ return $ SymbolRef $ FunctionRef (Name 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 (Name {namespace = "Gtk", name = "Button"}) "set_child"))+parseMethod :: Parser Token+parseMethod = do+ _ <- string "[method@"+ ns <- takeWhile1 (\c -> isAscii c && isAlpha c)+ _ <- char '.'+ n <- takeWhile1 isCIdent+ _ <- char '.'+ method <- takeWhile1 isCIdent+ _ <- char ']'+ return $ SymbolRef $ MethodRef (Name 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 (Name {namespace = "Gtk", name = "Builder"}) "new_from_file"))+parseConstructor :: Parser Token+parseConstructor = do+ _ <- string "[ctor@"+ ns <- takeWhile1 (\c -> isAscii c && isAlpha c)+ _ <- char '.'+ n <- takeWhile1 isCIdent+ _ <- char '.'+ method <- takeWhile1 isCIdent+ _ <- char ']'+ return $ SymbolRef $ MethodRef (Name 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:+-- > [enum@Namespace.Name]+--+-- === __Examples__+-- >>> parseOnly (parseClass <* endOfInput) "[class@Gtk.Dialog]"+-- Right (SymbolRef (TypeRef (Name {namespace = "Gtk", name = "Dialog"})))+--+-- >>> parseOnly (parseClass <* endOfInput) "[iface@Gtk.Editable]"+-- Right (SymbolRef (TypeRef (Name {namespace = "Gtk", name = "Editable"})))+--+-- >>> parseOnly (parseClass <* endOfInput) "[enum@Gtk.SizeRequestMode]"+-- Right (SymbolRef (TypeRef (Name {namespace = "Gtk", name = "SizeRequestMode"})))+parseClass :: Parser Token+parseClass = do+ _ <- string "[class@" <|> string "[iface@" <|> string "[enum@"+ ns <- takeWhile1 (\c -> isAscii c && isAlpha c)+ _ <- char '.'+ n <- takeWhile1 isCIdent+ _ <- char ']'+ return $ SymbolRef $ TypeRef (Name ns n)+ parseSignal :: Parser Token-parseSignal = do+parseSignal = parseOldSignal <|> parseNewSignal++-- | Parse an old style signal name, of the form+-- > #Object::signal+--+-- === __Examples__+-- >>> parseOnly (parseOldSignal <* endOfInput) "#GtkButton::activate"+-- Right (SymbolRef (OldSignalRef "GtkButton" "activate"))+parseOldSignal :: Parser Token+parseOldSignal = do _ <- char '#' obj <- parseCIdent _ <- string "::" signal <- signalOrPropName- return (SymbolRef (SignalRef 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 (Name {namespace = "Gtk", name = "AboutDialog"}) "activate-link"))+parseNewSignal :: Parser Token+parseNewSignal = do+ _ <- string "[signal@"+ ns <- takeWhile1 (\c -> isAscii c && isAlpha c)+ _ <- char '.'+ n <- parseCIdent+ _ <- string "::"+ signal <- takeWhile1 (\c -> (isAscii c && isAlpha c) || c == '-')+ _ <- char ']'+ return (SymbolRef (SignalRef (Name ns n) signal))+ -- | Parse a reference to a signal defined in the current module, of the form -- > ::signal --@@ -217,20 +361,41 @@ signal <- signalOrPropName return (SymbolRef (LocalSignalRef signal)) --- | Parse a property name, of the form+-- | Parse a property name in the old style, of the form -- > #Object:property -- -- === __Examples__--- >>> parseOnly (parseProperty <* endOfInput) "#GtkButton:always-show-image"--- Right (SymbolRef (PropertyRef "GtkButton" "always-show-image"))-parseProperty :: Parser Token-parseProperty = do+-- >>> parseOnly (parseOldProperty <* endOfInput) "#GtkButton:always-show-image"+-- Right (SymbolRef (OldPropertyRef "GtkButton" "always-show-image"))+parseOldProperty :: Parser Token+parseOldProperty = do _ <- char '#' obj <- parseCIdent _ <- char ':' property <- signalOrPropName- return (SymbolRef (PropertyRef 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 (Name {namespace = "Gtk", name = "ProgressBar"}) "show-text"))+parseNewProperty :: Parser Token+parseNewProperty = do+ _ <- string "[property@"+ ns <- takeWhile1 (\c -> isAscii c && isAlpha c)+ _ <- char '.'+ n <- parseCIdent+ _ <- char ':'+ property <- takeWhile1 (\c -> (isAscii c && isAlpha c) || c == '-')+ _ <- char ']'+ return (SymbolRef (PropertyRef (Name ns n) property))++-- | Parse a property+parseProperty :: Parser Token+parseProperty = parseOldProperty <|> parseNewProperty+ -- | Parse an xml comment, of the form -- > <!-- comment --> -- Note that this function keeps spaces.@@ -243,14 +408,14 @@ comment <- string "<!--" *> manyTill anyChar (string "-->") return (Comment $ T.pack comment) --- | Parse a reference to a virtual method, of the form+-- | Parse an old style reference to a virtual method, of the form -- > #Struct.method() -- -- === __Examples__--- >>> parseOnly (parseVMethod <* endOfInput) "#Foo.bar()"+-- >>> parseOnly (parseOldVMethod <* endOfInput) "#Foo.bar()" -- Right (SymbolRef (VMethodRef "Foo" "bar"))-parseVMethod :: Parser Token-parseVMethod = do+parseOldVMethod :: Parser Token+parseOldVMethod = do _ <- char '#' obj <- parseCIdent _ <- char '.'@@ -258,6 +423,26 @@ _ <- string "()" 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 (Name {namespace = "Gtk", name = "Widget"}) "get_request_mode"))+parseVFunc :: Parser Token+parseVFunc = do+ _ <- string "[vfunc@"+ ns <- takeWhile1 (\c -> isAscii c && isAlpha c)+ _ <- char '.'+ n <- parseCIdent+ _ <- char '.'+ vfunc <- parseCIdent+ _ <- char ']'+ return (SymbolRef (VFuncRef (Name ns n) vfunc))++-- | Parse a reference to a virtual method+parseVMethod :: Parser Token+parseVMethod = parseOldVMethod <|> parseVFunc+ -- | Parse a reference to a struct field, of the form -- > #Struct.field --@@ -276,13 +461,13 @@ -- > #Type -- -- === __Examples__--- >>> parseOnly (parseType <* endOfInput) "#Foo"--- Right (SymbolRef (TypeRef "Foo"))-parseType :: Parser Token-parseType = do+-- >>> parseOnly (parseCType <* endOfInput) "#Foo"+-- Right (SymbolRef (CTypeRef "Foo"))+parseCType :: Parser Token+parseCType = do _ <- char '#' obj <- parseCIdent- return (SymbolRef (TypeRef obj))+ return (SymbolRef (CTypeRef obj)) -- | Parse a constant, of the form -- > %CONSTANT_NAME@@ -308,11 +493,6 @@ param <- parseCIdent return (SymbolRef (ParamRef param)) --- | Whether the given character is valid in a C identifier.-isCIdent :: Char -> Bool-isCIdent '_' = True-isCIdent c = isDigit c || isAsciiUpper c || isAsciiLower c- -- | Name of a signal or property name. Similar to a C identifier, but -- hyphens are allowed too. signalOrPropName :: Parser Text@@ -321,27 +501,6 @@ isSignalOrPropIdent '-' = True isSignalOrPropIdent c = isCIdent c --- | Something that could be a valid C identifier (loosely speaking,--- we do not need to be too strict here).-parseCIdent :: Parser Text-parseCIdent = takeWhile1 isCIdent---- | Parse a function ref, given by a valid C identifier followed by--- '()', for instance 'gtk_widget_show()'. If the identifier is not--- followed by "()", return it as a literal instead.------ === __Examples__--- >>> parseOnly (parseFunctionRef <* endOfInput) "test_func()"--- Right (SymbolRef (FunctionRef "test_func"))------ >>> parseOnly (parseFunctionRef <* endOfInput) "not_a_func"--- Right (Literal "not_a_func")-parseFunctionRef :: Parser Token-parseFunctionRef = do- ident <- parseCIdent- option (Literal ident) (string "()" >>- return (SymbolRef (FunctionRef ident)))- -- | Parse a escaped special character, i.e. one preceded by '\'. parseEscaped :: Parser Token parseEscaped = do@@ -419,7 +578,37 @@ -- | Parse a code block embedded in the documentation. parseCodeBlock :: Parser Token-parseCodeBlock = do+parseCodeBlock = parseOldStyleCodeBlock <|> parseNewStyleCodeBlock++-- | Parse a new style code block, of the form+-- > ```c+-- > some c code+-- > ```+--+-- === __Examples__+-- >>> parseOnly (parseNewStyleCodeBlock <* endOfInput) "```c\nThis is C code\n```"+-- Right (CodeBlock (Just (Language "c")) "This is C code")+parseNewStyleCodeBlock :: Parser Token+parseNewStyleCodeBlock = do+ _ <- 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++-- | 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")+--+-- >>> parseOnly (parseOldStyleCodeBlock <* endOfInput) "|[<!-- language=\"C\"-->this is C code]|"+-- 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 "]|")
lib/Data/GI/CodeGen/Haddock.hs view
@@ -23,6 +23,7 @@ import Data.Text (Text) import Data.GI.GIR.Arg (Arg(..))+import Data.GI.GIR.BasicTypes (Name(Name)) import Data.GI.GIR.Callable (Callable(..)) import Data.GI.GIR.Deprecation (DeprecationInfo(..)) import Data.GI.GIR.Documentation (Documentation(..))@@ -51,8 +52,8 @@ -- >>> formatHaddock M.empty "" (GtkDoc [Literal "Hello ", Literal "World!"]) -- "Hello World!" ----- >>> let c2h = M.fromList [(FunctionRef "foo", ValueIdentifier "foo")]--- >>> formatHaddock c2h "" (GtkDoc [SymbolRef (FunctionRef "foo")])+-- >>> let c2h = M.fromList [(OldFunctionRef "foo", ValueIdentifier "foo")]+-- >>> formatHaddock c2h "" (GtkDoc [SymbolRef (OldFunctionRef "foo")]) -- "'foo'" -- -- >>> let onlineDocs = "http://wiki.haskell.org"@@ -78,28 +79,46 @@ -- | Format a `CRef` whose Haskell representation is not known. formatUnknownCRef :: M.Map CRef Hyperlink -> CRef -> Text-formatUnknownCRef _ (FunctionRef f) = formatCRef $ f <> "()"+formatUnknownCRef _ (OldFunctionRef f) = formatCRef $ f <> "()"+formatUnknownCRef _ (FunctionRef (Name ns n)) = formatCRef $ ns <> "." <> n formatUnknownCRef _ (ParamRef p) = "/@" <> lowerSymbol p <> "@/" formatUnknownCRef _ (LocalSignalRef s) = let sn = signalHaskellName s in "[" <> sn <> "](#" <> haddockSignalAnchor <> sn <> ")"-formatUnknownCRef c2h (SignalRef owner signal) =+formatUnknownCRef c2h (SignalRef owner@(Name ns n) signal) = case M.lookup (TypeRef owner) c2h of+ Nothing -> formatCRef $ ns <> "." <> n <> "::" <> signal+ Just r -> formatHyperlink r <> "::" <> formatCRef signal+formatUnknownCRef c2h (OldSignalRef owner signal) =+ case M.lookup (CTypeRef owner) c2h of Nothing -> formatCRef $ owner <> "::" <> signal Just r -> formatHyperlink r <> "::" <> formatCRef signal-formatUnknownCRef c2h (PropertyRef owner prop) =- case M.lookup (TypeRef owner) c2h of+formatUnknownCRef c2h (OldPropertyRef owner prop) =+ case M.lookup (CTypeRef owner) c2h of Nothing -> formatCRef $ owner <> ":" <> prop Just r -> formatHyperlink r <> ":" <> formatCRef prop-formatUnknownCRef c2h (VMethodRef owner vmethod) =+formatUnknownCRef c2h (PropertyRef owner@(Name ns n) prop) = case M.lookup (TypeRef owner) c2h of+ Nothing -> formatCRef $ ns <> "." <> n <> ":" <> prop+ Just r -> formatHyperlink r <> ":" <> formatCRef prop+formatUnknownCRef c2h (VMethodRef owner vmethod) =+ case M.lookup (CTypeRef owner) c2h of Nothing -> formatCRef $ owner <> "." <> vmethod <> "()" Just r -> formatHyperlink r <> "." <> formatCRef vmethod <> "()"-formatUnknownCRef c2h (StructFieldRef owner field) =+formatUnknownCRef c2h (VFuncRef owner@(Name ns n) vmethod) = case M.lookup (TypeRef owner) c2h of+ Nothing -> formatCRef $ ns <> "." <> n <> "." <> vmethod <> "()"+ Just r -> formatHyperlink r <> "." <> formatCRef vmethod <> "()"+formatUnknownCRef c2h (MethodRef owner@(Name ns n) method) =+ case M.lookup (TypeRef owner) c2h of+ Nothing -> formatCRef $ ns <> "." <> n <> "." <> method <> "()"+ Just r -> formatHyperlink r <> "." <> formatCRef method <> "()"+formatUnknownCRef c2h (StructFieldRef owner field) =+ case M.lookup (CTypeRef owner) c2h of Nothing -> formatCRef $ owner <> "." <> field Just r -> formatHyperlink r <> "." <> formatCRef field-formatUnknownCRef _ (TypeRef t) = formatCRef t+formatUnknownCRef _ (CTypeRef t) = formatCRef t+formatUnknownCRef _ (TypeRef (Name ns n)) = formatCRef $ ns <> "." <> n formatUnknownCRef _ (ConstantRef t) = formatCRef t -- | Formatting for an unknown C reference.