Menu
▾
▴
[Gtk2hs-commit] gtk2hs/tools/apiGen Template.chs,1.4,1.5 format-docs.xsl,1.5,1.6 ApiGen.hs,1.5,1.6
|
From: Duncan C. <dun...@us...> - 2005-01-24 01:39:38
|
Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12983/tools/apiGen Modified Files: Template.chs format-docs.xsl ApiGen.hs Log Message: Update the code generation tool. Change the style from single module per file to having every module in a single file since this is the way the gapi tool works. Index: Template.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Template.chs,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Template.chs 12 Jan 2005 02:44:28 -0000 1.4 +++ Template.chs 24 Jan 2005 01:39:28 -0000 1.5 @@ -20,7 +20,7 @@ -- | -- Maintainer : gtk2hs-users\@lists.sourceforge.net -- Stability : provisional --- Portability : non-portable (uses gtk+ C library) +-- Portability : non-portable (uses Gtk+ C library) -- -- @DESCRIPTION@@TODO@ -- Index: format-docs.xsl =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/format-docs.xsl,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- format-docs.xsl 12 Jan 2005 02:44:28 -0000 1.5 +++ format-docs.xsl 24 Jan 2005 01:39:28 -0000 1.6 @@ -73,23 +73,34 @@ <xsl:template match="footnote"></xsl:template> -<xsl:template match="/"> +<xsl:template match="/apidoc"> <apidoc> + <xsl:for-each select="book"> <module> - <name><xsl:value-of select="/book/refentry/refnamediv/refname"/></name> - <summary><xsl:value-of select="/book/refentry/refnamediv/refpurpose"/></summary> + <module-info> + <name><xsl:value-of select="refentry/refnamediv/refname"/></name> + <altname><xsl:value-of select="refentry/refsynopsisdiv/anchor/@id"/></altname> + <summary><xsl:value-of select="refentry/refnamediv/refpurpose"/></summary> <description> - <xsl:for-each select="/book/refentry/refsect1[title='Description']"> + <xsl:for-each select="refentry/refsect1[title='Description']"> <xsl:apply-templates select="para | section | refsect2"/> </xsl:for-each> </description> <object-hierarchy> - <xsl:for-each select="/book/refentry/refsect1[title='Object Hierarchy']/synopsis"> - <xsl:copy-of select="text() | link"/> + <xsl:for-each select="refentry/refsect1[title='Object Hierarchy']/synopsis/node()"> + <xsl:choose> + <xsl:when test="name(.)='link'"> + <xref-type><xsl:value-of select="."/></xref-type> + </xsl:when> + <xsl:otherwise> + <xsl:value-of select="."/> + <xsl:value-of select="name(.)"/> + </xsl:otherwise> + </xsl:choose> </xsl:for-each> </object-hierarchy> - </module> - <xsl:for-each select="/book/refentry/refsect1[title='Details']/refsect2[contains(title,' ()')]"> + </module-info> + <xsl:for-each select="refentry/refsect1[title='Details']/refsect2[contains(title,' ()')]"> <function> <name><xsl:value-of select="indexterm/primary"/></name> <since> @@ -108,6 +119,8 @@ </params> </function> </xsl:for-each> + </module> + </xsl:for-each> </apidoc> </xsl:template> </xsl:transform> Index: ApiGen.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- ApiGen.hs 12 Jan 2005 02:44:28 -0000 1.5 +++ ApiGen.hs 24 Jan 2005 01:39:28 -0000 1.6 @@ -9,6 +9,7 @@ module Main (main) where import Prelude hiding (Enum, lines) +import qualified Prelude (lines) import Monad (when) import Maybe (catMaybes, fromJust) import Char (toLower, toUpper, isSpace, isAlpha, isAlphaNum, isUpper) @@ -147,7 +148,14 @@ parameter_name = Xml.verbatim name, parameter_isArray = True } - +extractParameter (Xml.CElem (Xml.Elem "callback" + [("cname", Xml.AttValue cname)] _)) = + Parameter { + parameter_type = "callback", + parameter_name = Xml.verbatim cname, + parameter_isArray = False + } + extractConstructor :: Xml.Content -> Maybe Constructor extractConstructor (Xml.CElem (Xml.Elem "constructor" @@ -166,20 +174,26 @@ ------------------------------------------------------------------------------- -- Types representing the content of the documentation XML file ------------------------------------------------------------------------------- -data ApiDoc = ApiDoc { - apidoc_name :: String, -- these docs apply to this object - apidoc_summary :: String, -- a one line summary - apidoc_description :: [DocPara], -- the main description - apidoc_sections :: [DocSection], -- any additional titled subsections - apidoc_functions :: [FuncDoc] -- documentation for each function +type ApiDoc = [ModuleDoc] + +data ModuleDoc = ModuleDoc { + moduledoc_name :: String, -- these docs apply to this object + moduledoc_altname :: String, -- sometimes a better index entry + moduledoc_summary :: String, -- a one line summary + moduledoc_description :: [DocPara], -- the main description + moduledoc_sections :: [DocSection], -- any additional titled subsections + moduledoc_hierarchy :: [DocParaSpan], -- a tree of parent objects (as text) + moduledoc_functions :: [FuncDoc] -- documentation for each function } -noApiDoc = ApiDoc { - apidoc_name = "", - apidoc_summary = "", - apidoc_description = [], - apidoc_sections = [], - apidoc_functions = [] +noModuleDoc = ModuleDoc { + moduledoc_name = "", + moduledoc_altname = "", + moduledoc_summary = "", + moduledoc_description = [], + moduledoc_sections = [], + moduledoc_hierarchy = [], + moduledoc_functions = [] } data DocSection = DocSection { @@ -219,29 +233,36 @@ -- extract functions to convert the doc xml file to the internal representation ------------------------------------------------------------------------------- extractDocumentation :: Xml.Document -> ApiDoc -extractDocumentation (Xml.Document _ _ (Xml.Elem "apidoc" [] (moduleinfo:functions))) = +extractDocumentation (Xml.Document _ _ (Xml.Elem "apidoc" [] modules)) = + map extractDocModule modules + +extractDocModule :: Xml.Content -> ModuleDoc +extractDocModule (Xml.CElem (Xml.Elem "module" [] (moduleinfo:functions))) = (extractDocModuleinfo moduleinfo) { - apidoc_functions = map extractDocFunc functions + moduledoc_functions = map extractDocFunc functions } -extractDocModuleinfo :: Xml.Content -> ApiDoc +extractDocModuleinfo :: Xml.Content -> ModuleDoc extractDocModuleinfo - (Xml.CElem (Xml.Elem "module" [] + (Xml.CElem (Xml.Elem "module-info" [] [Xml.CElem (Xml.Elem "name" [] name) + ,Xml.CElem (Xml.Elem "altname" [] altname) ,Xml.CElem (Xml.Elem "summary" [] summary) ,Xml.CElem (Xml.Elem "description" [] parasAndSections) - ,Xml.CElem (Xml.Elem "object-hierarchy" [] _)] + ,Xml.CElem (Xml.Elem "object-hierarchy" [] objHierSpans)] )) = let (paras, sections) = span (\elem -> case elem of Xml.CElem (Xml.Elem "section" _ _) -> False _ -> True) parasAndSections - in ApiDoc { - apidoc_name = Xml.verbatim name, - apidoc_summary = Xml.verbatim summary, - apidoc_description = concatMap extractDocPara paras, - apidoc_sections = map extractDocSection sections, - apidoc_functions = undefined + in ModuleDoc { + moduledoc_name = Xml.verbatim name, + moduledoc_altname = Xml.verbatim altname, + moduledoc_summary = Xml.verbatim summary, + moduledoc_description = concatMap extractDocPara paras, + moduledoc_sections = map extractDocSection sections, + moduledoc_hierarchy = map extractDocParaSpan objHierSpans, + moduledoc_functions = undefined } extractDocSection :: Xml.Content -> DocSection @@ -333,28 +354,47 @@ "literal" -> DocLiteral text "arg" -> DocArg text other -> error $ "extractDocParaSpan: other tag " ++ tag + +extractDocParaSpan other@(Xml.CRef (Xml.RefEntity entity)) = DocText (Xml.verbatim other) extractDocParaSpan other = error $ "extractDocParaSpan: " ++ Xml.verbatim other ------------------------------------------------------------------------------- -- Functions for formatting haddock documentation ------------------------------------------------------------------------------- -genModuleDocumentation :: ApiDoc -> ShowS -genModuleDocumentation apidoc = - (if null (apidoc_description apidoc) +genModuleDocumentation :: ModuleDoc -> ShowS +genModuleDocumentation moduledoc = + (if null (moduledoc_description moduledoc) then id else comment.ss "* Description".nl. comment.nl. - comment.ss "| ".haddocFormatParas (apidoc_description apidoc).nl). - (if null (apidoc_sections apidoc) + comment.ss "| ".haddocFormatParas (moduledoc_description moduledoc).nl). + (if null (moduledoc_sections moduledoc) then id - else nl.comment.haddocFormatSections (apidoc_sections apidoc).nl.comment) + else nl.comment.haddocFormatSections (moduledoc_sections moduledoc).nl.comment) + -- Getting decent formatting for the class hierarchy does not seem to be + -- possible with the available haddock markup. So disabling for now. + -- + .nl. + (if null (moduledoc_hierarchy moduledoc) + then id + else nl.comment.ss "* Class Hierarchy".nl. + comment.ss "|".nl. + comment.ss "@".nl. + comment.ss "| ".haddocFormatHierarchy (moduledoc_hierarchy moduledoc).nl. + comment.ss "@".nl) -addVersionParagraphs :: NameSpace -> ApiDoc -> ApiDoc +haddocFormatHierarchy :: [DocParaSpan] -> ShowS +haddocFormatHierarchy = + sepBy "\n-- |" + . Prelude.lines + . concatMap haddocFormatSpan + +addVersionParagraphs :: NameSpace -> ModuleDoc -> ModuleDoc addVersionParagraphs namespace apiDoc = apiDoc { - apidoc_description = apidoc_description apiDoc ++ moduleVersionParagraph, - apidoc_functions = functionVersionParagraphs moduleVersion (apidoc_functions apiDoc) + moduledoc_description = moduledoc_description apiDoc ++ moduleVersionParagraph, + moduledoc_functions = functionVersionParagraphs moduleVersion (moduledoc_functions apiDoc) } where functionVersionParagraphs :: Maybe String -> [FuncDoc] -> [FuncDoc] functionVersionParagraphs baseVersion funcdocs = @@ -380,7 +420,7 @@ -- than the original version moduleVersion :: Maybe String moduleVersion = case [ funcdoc_since funcdoc - | funcdoc <- apidoc_functions apiDoc ] of + | funcdoc <- moduledoc_functions apiDoc ] of [] -> Nothing versions -> minimum versions @@ -560,11 +600,11 @@ . concatMap haddocFormatSpan columnIndent = maximum [ length parmType | (parmType, _) <- paramTypes ] -genModuleBody :: Object -> ApiDoc -> ShowS +genModuleBody :: Object -> ModuleDoc -> ShowS genModuleBody object apiDoc = doVersionIfDefs (sepBy' "\n\n") $ - genConstructors object (apidoc_functions apiDoc) - ++ genMethods object (apidoc_functions apiDoc) + genConstructors object (moduledoc_functions apiDoc) + ++ genMethods object (moduledoc_functions apiDoc) genMethods :: Object -> [FuncDoc] -> [(ShowS, Maybe FuncDoc)] genMethods object apiDoc = @@ -618,17 +658,22 @@ genExports :: Object -> [FuncDoc] -> ShowS genExports object docs = + comment.ss "* Types". + indent 1.ss (object_name object).sc ','. + indent 1.ss (object_name object).ss "Class,". + indent 1.ss "castTo".ss (object_name object).sc ','.nl. nl. - comment.ss "* Constructors".nl. - doVersionIfDefs lines - [ (ss " ". ss (cFuncNameToHsName (method_cname constructor)). sc ',', doc) - | (constructor, doc) <- constructors object docs]. - nl. + (case [ (ss " ". ss (cFuncNameToHsName (method_cname constructor)). sc ',', doc) + | (constructor, doc) <- constructors object docs] of + [] -> id + cs -> comment.ss "* Constructors".nl. + doVersionIfDefs lines cs.nl). nl. - comment.ss "* Methods".nl. - doVersionIfDefs lines - [ (ss " ". ss (cFuncNameToHsName (method_cname method)). sc ',', doc) - | (method, doc) <- methods object docs] + (case [ (ss " ". ss (cFuncNameToHsName (method_cname method)). sc ',', doc) + | (method, doc) <- methods object docs] of + [] -> id + cs -> comment.ss "* Methods".nl. + doVersionIfDefs lines cs) genTodoItems :: Object -> ShowS genTodoItems object = @@ -795,9 +840,11 @@ -- Read in the documentation xml file if supplied -- apiDoc <- if null docFile - then return noApiDoc + then return [] else do content <- readFile docFile return $ extractDocumentation (Xml.xmlParse docFile content) + let apiDocMap = [ (moduledoc_name moduleDoc, moduleDoc) | moduleDoc <- apiDoc ] + ++ [ (moduledoc_altname moduleDoc, moduleDoc) | moduleDoc <- apiDoc ] ----------------------------------------------------------------------------- -- A few values that are used in the template @@ -813,27 +860,33 @@ -- Write the result file(s) by substituting values into the template file -- mapM - (\(namespace, object) -> - let apiDoc' = addVersionParagraphs namespace apiDoc in - writeFile (outdir ++ object_name object ++ ".chs") $ - templateSubstitute template (\var -> - case var of - "YEAR" -> ss year - "DATE" -> ss date - "OBJECT_NAME" -> ss (object_name object) - "DESCRIPTION" -> ss (apidoc_summary apiDoc') - "DOCUMENTATION" -> genModuleDocumentation apiDoc' - "TODO" -> genTodoItems object - "MODULE_NAME" -> ss (modPrefix ++ object_name object) - "EXPORTS" -> genExports object (apidoc_functions apiDoc') - "IMPORTS" -> ss "-- CHECKME: extra imports may be required\n" - "CONTEXT_LIB" -> ss (if null lib then namespace_library namespace else lib) - "CONTEXT_PREFIX" -> ss (if null prefix then namespace_library namespace else prefix) - "MODULE_BODY" -> genModuleBody object apiDoc' - _ -> ss "" - ) "") [ (namespace, object) - | namespace <- api - , object <- namespace_objects namespace ] + (\(namespace, object, maybeModuleDoc) -> do + moduleDoc <- case maybeModuleDoc of + Nothing -> do when (not (null apiDoc)) $ + putStrLn ("Warning: no documentation found for module " + ++ show (object_name object)) + return noModuleDoc + Just moduleDoc -> return $ addVersionParagraphs namespace moduleDoc + writeFile (outdir ++ object_name object ++ ".chs") $ + templateSubstitute template (\var -> + case var of + "YEAR" -> ss year + "DATE" -> ss date + "OBJECT_NAME" -> ss (object_name object) + "DESCRIPTION" -> ss (moduledoc_summary moduleDoc) + "DOCUMENTATION" -> genModuleDocumentation moduleDoc + "TODO" -> genTodoItems object + "MODULE_NAME" -> ss (modPrefix ++ object_name object) + "EXPORTS" -> genExports object (moduledoc_functions moduleDoc) + "IMPORTS" -> ss $ "{#import Graphics.UI.Gtk.Types#}\n" + ++ "-- CHECKME: extra imports may be required\n" + "CONTEXT_LIB" -> ss (if null lib then namespace_library namespace else lib) + "CONTEXT_PREFIX" -> ss (if null prefix then namespace_library namespace else prefix) + "MODULE_BODY" -> genModuleBody object moduleDoc + _ -> ss "" ) "" + ) [ (namespace, object, lookup (object_cname object) apiDocMap) + | namespace <- api + , object <- namespace_objects namespace ] usage = do |