doxygen-parser (empty) → 0.1.0
raw patch · 23 files changed
+2860/−0 lines, 23 filesdep +QuickCheckdep +basedep +containers
Dependencies added: QuickCheck, base, containers, directory, doxygen-parser, filepath, process, tasty, tasty-hunit, tasty-quickcheck, temporary, text, xml-conduit
Files
- CHANGELOG.md +19/−0
- LICENSE +29/−0
- README.md +79/−0
- doxygen-parser.cabal +122/−0
- src-internal/Doxygen/Parser/Internal.hs +1257/−0
- src-internal/Doxygen/Parser/Types.hs +208/−0
- src-internal/Doxygen/Parser/Warning.hs +52/−0
- src/Doxygen/Parser.hs +73/−0
- test/Main.hs +35/−0
- test/Test/Doxygen/Parser/Block.hs +106/−0
- test/Test/Doxygen/Parser/CodeBlock.hs +47/−0
- test/Test/Doxygen/Parser/Comment.hs +72/−0
- test/Test/Doxygen/Parser/Helpers.hs +215/−0
- test/Test/Doxygen/Parser/InlineNesting.hs +37/−0
- test/Test/Doxygen/Parser/InlineParsing.hs +57/−0
- test/Test/Doxygen/Parser/List.hs +60/−0
- test/Test/Doxygen/Parser/NormalizeWhitespace.hs +18/−0
- test/Test/Doxygen/Parser/Param.hs +61/−0
- test/Test/Doxygen/Parser/Properties.hs +24/−0
- test/Test/Doxygen/Parser/SimpleSect.hs +71/−0
- test/Test/Doxygen/Parser/StructuralWarnings.hs +62/−0
- test/Test/Doxygen/Parser/Whitespace.hs +38/−0
- test/Test/Doxygen/Parser/XMLFileResult.hs +118/−0
+ CHANGELOG.md view
@@ -0,0 +1,19 @@+# Revision history for `doxygen-parser`++## ?.?.? -- YYYY-mm-dd++### Breaking changes++### New features++### Minor changes++### Bug fixes++## 0.1.0 -- 2026-06-18++* First version. Extracted from+ [`hs-bindgen`](https://github.com/well-typed/hs-bindgen). See+ [hs-bindgen#1884][hs-bindgen-is-1884].++[hs-bindgen-is-1884]: https://github.com/well-typed/hs-bindgen/issues/1884
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2024-2026, Well-Typed LLP and Anduril Industries Inc.+++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,79 @@+# `doxygen-parser`: Parse Doxygen XML output into a typed Haskell AST++[](https://github.com/well-typed/doxygen-parser/actions/workflows/haskell.yml)++`doxygen-parser` is a standalone Haskell library that invokes the+[`doxygen`](https://www.doxygen.nl/) binary on C/C++ header files and+turns its XML output into a typed Haskell AST. It works on any C/C+++headers `doxygen` understands.++## Requirements++The `doxygen` executable must be installed and on `PATH` (or the path+must be supplied via the `binary` field of `Config`). Tested with+`doxygen` 1.15.0; older versions usually work but the XML schema+shifts subtly between releases.++## Quick start++```haskell+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++import Doxygen.Parser+import Data.List.NonEmpty (NonEmpty (..))++main :: IO ()+main = do+ Result{doxygen, warnings, doxygenVersion} <-+ parse defaultConfig ("myheader.h" :| [])+ putStrLn $ "doxygen version: " ++ show doxygenVersion+ mapM_ print warnings+ -- `doxygen` is opaque; query it with the lookup helpers:+ print $ lookupComment (KeyDecl "myFunc") doxygen+```++`Result` carries:++ * `doxygen :: Doxygen`: opaque map of `DoxygenKey` to comment trees,+ queried via `lookupComment`, `lookupGroupMembership`,+ and `lookupGroupInfo`.+ * `warnings :: [Warning]`: non-fatal degradations encountered while+ parsing (unknown elements, malformed refs, etc.).+ * `doxygenVersion :: Text`: the version of the `doxygen` binary+ that was invoked.++If the `doxygen` invocation itself fails, `parse` throws+`DoxygenException`.++## Public modules++| Module | Purpose |+| ------------------------ | --------------------------------------------- |+| `Doxygen.Parser` | Top-level public API. Start here. |+| `Doxygen.Parser.Types` | The `Comment` / `Block` / `Inline` AST. |+| `Doxygen.Parser.Warning` | Warning, `Context`, and `Degradation` types. |++## Stability++`doxygen-parser` follows the [Haskell Package Versioning+Policy](https://pvp.haskell.org/). The `Doxygen.Parser`,+`Doxygen.Parser.Types`, and `Doxygen.Parser.Warning` modules form the+supported public API; breaking changes there bump the major version+(`A.B`).++## Used by++ * [`hs-bindgen`](https://github.com/well-typed/hs-bindgen): automatic+ Haskell FFI binding generation from C headers.++## Contributors++Contributors are listed in the [`hs-bindgen`+README](https://github.com/well-typed/hs-bindgen#contributors), which+covers `doxygen-parser` along with the other supporting packages.++## License++BSD-3-Clause. Copyright 2024-2026 Well-Typed LLP and Anduril Industries Inc.+See [`LICENSE`](./LICENSE).
+ doxygen-parser.cabal view
@@ -0,0 +1,122 @@+cabal-version: 3.0+name: doxygen-parser+version: 0.1.0+license: BSD-3-Clause+license-file: LICENSE+copyright: 2024-2026 Well-Typed LLP and Anduril Industries Inc.+author: Well-Typed LLP+maintainer: info@well-typed.com+homepage: https://github.com/well-typed/doxygen-parser+bug-reports: https://github.com/well-typed/doxygen-parser/issues+category: Development, Documentation, Parsing+build-type: Simple+synopsis: Parse Doxygen XML output into a typed Haskell AST+description:+ A standalone library for invoking the @doxygen@ binary on C\/C++ headers+ and turning its XML output into a typed Haskell AST.++ The library spawns @doxygen@ on a set of header files, walks the resulting+ @xml\/@ directory, and assembles a 'Doxygen.Parser.Doxygen' value mapping+ each documented C entity to a structured 'Doxygen.Parser.Comment' tree+ (with paragraphs, inline markup, parameter docs, group memberships, and+ cross-references).++ See the "Doxygen.Parser" module for the public API and the project+ README for a quick-start example. The @doxygen@ executable must be+ installed separately.++extra-doc-files:+ CHANGELOG.md+ README.md++tested-with:+ GHC ==9.2.8+ || ==9.4.8+ || ==9.6.7+ || ==9.8.4+ || ==9.10.3+ || ==9.12.2+ || ==9.14.1++source-repository head+ type: git+ location: https://github.com/well-typed/doxygen-parser++common lang+ ghc-options:+ -Wall -Widentities -Wprepositive-qualified-module+ -Wredundant-constraints -Wunused-packages -Wmissing-export-lists++ build-depends: base >=4.16 && <4.23+ default-language: GHC2021+ default-extensions:+ DerivingStrategies+ DuplicateRecordFields+ NoFieldSelectors+ OverloadedRecordDot+ OverloadedStrings++library internal+ import: lang+ visibility: private+ hs-source-dirs: src-internal+ exposed-modules:+ Doxygen.Parser.Internal+ Doxygen.Parser.Types+ Doxygen.Parser.Warning++ build-depends:+ , containers >=0.6.5.1 && <0.9+ , directory >=1.3.6.2 && <1.4+ , filepath >=1.4 && <1.6+ , process >=1.6 && <1.7+ , temporary >=1.3 && <1.4+ , text >=1.2 && <2.2+ , xml-conduit >=1.9 && <1.11++library+ import: lang+ hs-source-dirs: src+ exposed-modules: Doxygen.Parser+ reexported-modules:+ , Doxygen.Parser.Types+ , Doxygen.Parser.Warning++ build-depends: doxygen-parser:internal++test-suite test-doxygen-parser+ import: lang+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ ghc-options: -threaded+ other-modules:+ Test.Doxygen.Parser.Block+ Test.Doxygen.Parser.CodeBlock+ Test.Doxygen.Parser.Comment+ Test.Doxygen.Parser.Helpers+ Test.Doxygen.Parser.InlineNesting+ Test.Doxygen.Parser.InlineParsing+ Test.Doxygen.Parser.List+ Test.Doxygen.Parser.NormalizeWhitespace+ Test.Doxygen.Parser.Param+ Test.Doxygen.Parser.Properties+ Test.Doxygen.Parser.SimpleSect+ Test.Doxygen.Parser.StructuralWarnings+ Test.Doxygen.Parser.Whitespace+ Test.Doxygen.Parser.XMLFileResult++ -- Internal dependencies+ build-depends:+ , doxygen-parser+ , doxygen-parser:internal++ -- External dependencies+ build-depends:+ , containers >=0.6.5.1 && <0.9+ , QuickCheck >=2.14.3 && <2.16+ , tasty >=1.5 && <1.6+ , tasty-hunit >=0.10.2 && <0.11+ , tasty-quickcheck >=0.10.2 && <0.12+ , text >=1.2 && <2.2+ , xml-conduit >=1.9 && <1.11
+ src-internal/Doxygen/Parser/Internal.hs view
@@ -0,0 +1,1257 @@+{-# LANGUAGE RecordWildCards #-}++{-# OPTIONS_HADDOCK hide #-}++-- | Doxygen XML parser — internal implementation.+--+-- This module contains the full implementation of the Doxygen XML parser.+-- The public API is re-exported by "Doxygen.Parser"; this module additionally+-- exposes internal functions for testing.+--+-- === What doxygen generates+--+-- Given a C header, @doxygen@ produces an @xml\/@ directory containing:+--+-- [@index.xml@]+-- Master index of all "compounds" (files, groups, structs, unions) and their+-- members. Each member's @refid@ attribute encodes which group it belongs+-- to, e.g. @\"group__core__types_1ga...\"@ means the member is in the+-- @core_types@ group, while @\"myheader_8h_1a...\"@ means ungrouped.+--+-- [@\<file\>_8h.xml@]+-- One per input file (e.g. @myheader_8h.xml@). Lists all declarations+-- with their @refid@s — we don't parse comments from these directly.+--+-- [@group__\<name\>.xml@]+-- One per @\@defgroup@\/@\@addtogroup@ group. Contains the group title,+-- member comments, inner-group references, and enum value docs.+--+-- [@struct\<name\>.xml@ \/ @union\<name\>.xml@]+-- One per struct\/union. Contains the compound-level comment and+-- per-field comments (brief + detailed).+--+-- We parse @index.xml@ first for the member→group mapping, then iterate+-- over all other @.xml@ files to extract comments. Each file is parsed+-- into a 'XMLFileResult' and the results are merged into 'Doxygen'.+--+module Doxygen.Parser.Internal (+ -- * Configuration+ Config(..)+ , defaultConfig+ -- * Parsing+ , parse+ , Result(..)+ -- * State type+ , Doxygen(..)+ , emptyDoxygen+ -- * Lookup keys+ , DoxygenKey(..)+ , lookupComment+ -- * Group sections+ , lookupGroupMembership+ , lookupGroupInfo+ -- * Errors+ , DoxygenException(..)+ -- * Internals (exported for testing)+ , buildComment+ , extractBriefAndDetail+ , parseBlockElement+ , parseInline+ , parseInlineChildren+ , normalizeWhitespace+ , trimEdges+ , XMLFileResult(..)+ , extractEntity+ , nodeElementName+ , forChildren+ , ChildAction(..)+ , readXML+ , parseXMLOutput+ ) where++import Control.Exception (Exception, SomeException, catch, throwIO)+import Control.Monad (unless)+import Data.Char qualified as Char+import Data.List qualified as List+import Data.List.NonEmpty (NonEmpty, toList)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe, listToMaybe, mapMaybe, maybeToList)+import Data.Text (Text)+import Data.Text qualified as Text+import System.Directory (doesDirectoryExist, listDirectory)+import System.Exit (ExitCode (..))+import System.FilePath (takeExtension, (</>))+import System.IO.Error (isDoesNotExistError)+import System.IO.Temp (withSystemTempDirectory)+import System.Process (CreateProcess (..), StdStream (..), proc,+ readCreateProcessWithExitCode)+import Text.XML qualified as XML+import Text.XML.Cursor (Cursor, ($/), ($//))+import Text.XML.Cursor qualified as Cursor++import Doxygen.Parser.Types+import Doxygen.Parser.Warning++{-------------------------------------------------------------------------------+ Configuration+-------------------------------------------------------------------------------}++-- | Configuration for the doxygen invocation+--+data Config = Config {+ binary :: FilePath+ -- ^ Path to doxygen executable (default: @\"doxygen\"@)+ , extractAll :: Bool+ -- ^ @EXTRACT_ALL@ option: document all entities even without+ -- Doxygen comments (default: @True@)+ , quiet :: Bool+ -- ^ @QUIET@ option: suppress doxygen output (default: @True@)+ , outputDir :: Maybe FilePath+ -- ^ When @Just dir@, doxygen XML output is written to @dir@+ -- and persists after 'parse' returns. When 'Nothing' (default),+ -- a temporary directory is used and cleaned up automatically.+ }+ deriving stock (Show, Eq)++-- | Default configuration: uses @\"doxygen\"@ from @PATH@, extracts all,+-- quiet mode enabled, temporary output directory+--+defaultConfig :: Config+defaultConfig = Config {+ binary = "doxygen"+ , extractAll = True+ , quiet = True+ , outputDir = Nothing+ }++{-------------------------------------------------------------------------------+ Lookup keys+-------------------------------------------------------------------------------}++-- | Key for looking up a comment in the 'Doxygen' state+--+-- Unifies the four separate map lookups (declarations, structs, fields,+-- enum values) into a single 'Map' keyed by this type.+--+data DoxygenKey+ = KeyDecl { name :: Text }+ -- ^ Function, typedef, variable, or enum (keyed by C name)+ | KeyStruct { name :: Text }+ -- ^ Struct\/union compound (keyed by C type name)+ | KeyField { structName :: Text, fieldName :: Text }+ -- ^ Struct\/union field+ | KeyEnumValue { enumName :: Text, valueName :: Text }+ -- ^ Enum value+ deriving stock (Eq, Ord, Show)++{-------------------------------------------------------------------------------+ State+-------------------------------------------------------------------------------}++-- | Parsed doxygen state for C\/C++ headers+--+-- The 'comments' map uses 'DoxygenKey' to distinguish declaration-level,+-- struct-level, field-level, and enum-value-level comments.+-- The @Comment DoxyRef@ values contain @DoxyRef@ at cross-reference+-- positions (@\<ref\>@ elements in the XML). Each @DoxyRef@ carries+-- the C name and the optional @kindref@ attribute ('RefKind').+-- Consumers can resolve these to their own identifier types+-- via 'Functor'\/'Traversable' on 'Comment'.+--+data Doxygen = Doxygen {+ -- | All extracted comments, keyed by 'DoxygenKey'.+ comments :: Map DoxygenKey (Comment DoxyRef)+ -- | Group membership: declaration name -> group name.+ --+ -- Useful for generating export-list sections from Doxygen+ -- @\@defgroup@ annotations.+ , groupMembership :: Map Text Text+ -- | Group info: group name -> (title, parent group name).+ --+ -- Useful for generating export-list sections from Doxygen+ -- @\@defgroup@ annotations.+ , groupInfo :: Map Text (Text, Maybe Text)+ }+ deriving stock (Show)++-- | Empty doxygen state (no comments, no group information).+--+-- Useful as a fallback when doxygen is unavailable or fails, so that+-- downstream code can proceed without documentation rather than aborting.+emptyDoxygen :: Doxygen+emptyDoxygen = Doxygen {+ comments = Map.empty+ , groupMembership = Map.empty+ , groupInfo = Map.empty+ }++{-------------------------------------------------------------------------------+ Lookups+-------------------------------------------------------------------------------}++-- | Look up a comment by key+lookupComment :: DoxygenKey -> Doxygen -> Maybe (Comment DoxyRef)+lookupComment key doxy = Map.lookup key doxy.comments++-- | Look up which group a declaration belongs to+lookupGroupMembership :: Text -> Doxygen -> Maybe Text+lookupGroupMembership declName doxy =+ Map.lookup declName doxy.groupMembership++-- | Look up group info: @(title, parent group name)@+lookupGroupInfo :: Text -> Doxygen -> Maybe (Text, Maybe Text)+lookupGroupInfo groupName doxy =+ Map.lookup groupName doxy.groupInfo++{-------------------------------------------------------------------------------+ Result+-------------------------------------------------------------------------------}++-- | Result of parsing doxygen XML output+data Result = Result {+ doxygen :: Doxygen+ -- ^ The parsed comments and group information+ , warnings :: [Warning]+ -- ^ Parser warnings about unsupported or degraded content.+ -- These are non-fatal issues detected during XML parsing (e.g.,+ -- unsupported HTML elements). For fatal errors, see 'DoxygenException'.+ , doxygenVersion :: Text+ -- ^ The doxygen version that produced the XML (e.g., @\"1.15.0\"@).+ -- Defaults to @\"unknown\"@ if the version could not be determined.+ }+ deriving stock (Show)++{-------------------------------------------------------------------------------+ Errors+-------------------------------------------------------------------------------}++-- | Exception thrown when doxygen invocation or XML parsing fails+data DoxygenException+ = DoxygenNotFound+ -- ^ The @doxygen@ binary was not found on @PATH@+ | DoxygenFailed Int String+ -- ^ @doxygen@ exited with a non-zero exit code.+ -- The 'Int' is the exit code; the 'String' is stderr output from the+ -- @doxygen@ process.+ | DoxygenXMLParseError FilePath String+ -- ^ Failed to parse a doxygen XML output file.+ -- The 'String' is the parse error as reported by @xml-conduit@.+ | DoxygenIOError IOError+ -- ^ An IO error occurred while invoking @doxygen@ (e.g., permission+ -- denied). The 'DoxygenNotFound' constructor handles the specific case+ -- where the binary is absent; this covers all other 'IOError's.+ | DoxygenOutputDirMissing FilePath+ -- ^ The 'outputDir' specified in 'Config' does not exist.+ deriving stock (Show)++instance Exception DoxygenException++{-------------------------------------------------------------------------------+ Public API+-------------------------------------------------------------------------------}++-- | Parse C\/C++ header files using doxygen+--+-- Invokes the @doxygen@ binary on the given header files, parses the XML+-- output, and returns a 'Result' containing all extracted comments, group+-- information, and any warnings about unsupported content.+--+-- When 'outputDir' is @Just dir@ in the 'Config', doxygen writes its XML+-- output to @dir\/xml\/@ and the files persist after this function returns.+-- When 'Nothing', a temporary directory is used and cleaned up automatically.+--+-- Throws 'DoxygenException' on failure.+--+parse :: Config -> NonEmpty FilePath -> IO Result+parse config headerPaths =+ withDir $ \dir -> do+ runDoxygen config headerPaths dir+ parseXMLOutput (dir </> "xml")+ where+ withDir :: (FilePath -> IO a) -> IO a+ withDir = case config.outputDir of+ Nothing -> withSystemTempDirectory "doxygen-parser"+ Just dir -> \f -> do+ exists <- doesDirectoryExist dir+ unless exists $ throwIO $ DoxygenOutputDirMissing dir+ f dir++{-------------------------------------------------------------------------------+ Doxygen invocation+-------------------------------------------------------------------------------}++-- | Run the @doxygen@ binary, writing XML output to @outputDir\/xml\/@+runDoxygen :: Config -> NonEmpty FilePath -> FilePath -> IO ()+runDoxygen config headerPaths dir = do+ let doxyConfig = generateConfig config headerPaths dir+ (exitCode, _stdout, stderr) <- readCreateProcessWithExitCode+ (proc config.binary ["-"]) { std_in = CreatePipe }+ (Text.unpack doxyConfig)+ `catch` \e ->+ if isDoesNotExistError e+ then throwIO DoxygenNotFound+ else throwIO (DoxygenIOError e)+ case exitCode of+ ExitFailure code -> throwIO $ DoxygenFailed code stderr+ ExitSuccess -> pure ()++-- | Generate the doxygen configuration string+generateConfig :: Config -> NonEmpty FilePath -> FilePath -> Text+generateConfig config inputPaths outputDir = Text.unlines $+ [ "INPUT = " <> Text.unwords (map Text.pack (toList inputPaths))+ , "OUTPUT_DIRECTORY = " <> Text.pack outputDir+ , "GENERATE_XML = " <> boolOption True+ , "GENERATE_HTML = " <> boolOption False+ , "GENERATE_LATEX = " <> boolOption False+ , "XML_PROGRAMLISTING = " <> boolOption False+ , "EXTRACT_ALL = " <> boolOption config.extractAll+ , "JAVADOC_BANNER = " <> boolOption True+ , "QUIET = " <> boolOption config.quiet+ ]+ where+ boolOption :: Bool -> Text+ boolOption True = "YES"+ boolOption False = "NO"++{-------------------------------------------------------------------------------+ XML parsing — assembles Doxygen directly from XML files+-------------------------------------------------------------------------------}++-- | Parse the XML output directory into a 'Result'+--+parseXMLOutput :: FilePath -> IO Result+parseXMLOutput xmlDir = do+ -- Parse index.xml for declaration→group mappings and doxygen version+ (indexWarns, memberGroupMap, version) <- parseIndexXML (xmlDir </> "index.xml")++ -- Parse all per-entity XML files (groups, structs, unions, file) and+ -- accumulate results+ xmlFiles <- List.sort . filter isEntityXML <$> listDirectory xmlDir+ results <- mapM (\f -> parseEntityXML (xmlDir </> f)) xmlFiles++ -- Merge results from all XML files into a single state.+ -- Left-biased: if two XML files define the same key, the first one wins.+ -- This is fine because doxygen produces at most one comment per entity+ -- per run.+ let allComments = Map.unionsWith const [r.comments | r <- results]++ -- child→parent map from <innergroup> elements+ childToParent = Map.fromList $ concatMap (.groupChildren) results++ allGroupInfo = Map.fromList+ [ (gname, (title, Map.lookup gname childToParent))+ | r <- results+ , (gname, title) <- r.groupTitles+ ]+ innerClassMembers = Map.fromList $ concatMap (.groupMembers) results++ allGroupMembership = Map.union memberGroupMap innerClassMembers++ allWarnings = concatMap (.warnings) results++ pure Result {+ doxygen = Doxygen {+ comments = allComments+ , groupMembership = allGroupMembership+ , groupInfo = allGroupInfo+ }+ , warnings = indexWarns ++ allWarnings+ , doxygenVersion = version+ }++-- | Intermediate result from parsing one XML file+--+-- Each XML file (group, struct, union, file) produces one of these.+-- They are merged into the final 'Doxygen' by 'parseXMLOutput'.+--+data XMLFileResult = XMLFileResult {+ comments :: Map DoxygenKey (Comment DoxyRef)+ , groupTitles :: [(Text, Text)]+ -- ^ (group name, title) — only populated for group XML files+ , groupChildren :: [(Text, Text)]+ -- ^ (child group name, parent group name) — derived from+ -- @\<innergroup\>@ elements in group XML files+ , groupMembers :: [(Text, Text)]+ -- ^ (declaration name, group name) — derived from+ -- @\<innerclass\>@ elements in group XML files (structs\/unions)+ , warnings :: [Warning]+ }++{-------------------------------------------------------------------------------+ index.xml parsing++ The index lists every compound and its members. Example:++ <doxygenindex>+ <compound refid="myheader_8h" kind="file"><name>myheader.h</name>+ <member refid="group__core__types_1ga..." kind="typedef">+ <name>my_int</name>+ </member>+ <member refid="myheader_8h_1a..." kind="function">+ <name>ungrouped_func</name>+ </member>+ </compound>+ <compound refid="group__core__types" kind="group">+ <name>core_types</name>+ ...+ </compound>+ </doxygenindex>++ We extract two things:+ 1. member→group mapping: parse "group__core__types" from the refid prefix+ to learn that "my_int" belongs to group "core_types". Members whose+ refid starts with the file name (e.g. "myheader_8h_1a...") are ungrouped.+ 2. group refs: which group compounds exist (titles come later from compound+ XML files).+-------------------------------------------------------------------------------}++-- | Parse @index.xml@ to extract the declaration→group mapping and version.+parseIndexXML :: FilePath -> IO ([Warning], Map Text Text, Text)+parseIndexXML path = do+ doc <- readXML path+ let root = Cursor.fromDocument doc+ version = fromMaybe "unknown"+ $ listToMaybe+ $ Cursor.attribute "version" root++ (rootWarns, compounds) =+ forChildren "doxygenindex" (Cursor.child root) $+ \n c -> case n of+ "compound" -> Just (Yield c)+ _ -> Nothing++ (compoundWarns, memberGroups) = collectWarnings $ map processCompound compounds++ pure ( rootWarns ++ compoundWarns+ , Map.fromList memberGroups+ , version+ )+ where+ processCompound :: Cursor -> ([Warning], [(Text, Text)])+ processCompound c = case listToMaybe $ Cursor.attribute "kind" c of+ Just "file" ->+ let (warns, members) =+ forChildren "compound" (Cursor.child c) $+ \n ch -> case n of+ "member" -> Just (Yield ch)+ "name" -> Just Skip+ _ -> Nothing+ (memberWarns, pairs) = collectWarnings $ map processMember members+ in (warns ++ memberWarns, pairs)+ _otherwise -> ([], [])++ processMember :: Cursor -> ([Warning], [(Text, Text)])+ processMember c =+ let (warns, names) =+ forChildren "member" (Cursor.child c) $+ \n ch -> case n of+ "name" -> Just (Yield (extractText ch))+ _ -> Nothing+ result = do+ name <- listToMaybe names+ refid <- listToMaybe $ Cursor.attribute "refid" c+ group <- groupFromRefid refid+ pure (name, group)+ in (warns, maybeToList result)++-- | Extract group name from a refid like @\"group__core__types_1ga...\"@+--+-- Uses 'Text.breakOnEnd' to find the /last/ @\"_1\"@ (the member separator),+-- so that group names containing @\"_1\"@ as a substring are handled correctly+-- (e.g., @group__v1__helpers_1ga...@ → @\"v1_helpers\"@).+groupFromRefid :: Text -> Maybe Text+groupFromRefid refid+ | Just rest <- Text.stripPrefix "group__" refid+ = let (before, after) = Text.breakOnEnd "_1" rest+ in Just $ Text.replace "__" "_" $+ if Text.null before || Text.null after+ then rest+ else Text.dropEnd 2 before+ | otherwise+ = Nothing++{-------------------------------------------------------------------------------+ Per-entity XML parsing++ Each entity XML file has the structure:++ <doxygen>+ <compounddef kind="group|struct|union|file">+ <compoundname> → entity name+ <title> → group title (groups only)+ <briefdescription> → compound-level brief+ <detaileddescription>+ <innergroup> → group hierarchy (groups only)+ <sectiondef kind="func|enum|typedef|public-attrib|...">+ <memberdef kind="function|enum|variable|typedef|...">+ <name> → member name+ <qualifiedname> → e.g. "config_t::id" (struct fields)+ <briefdescription>+ <detaileddescription>+ <enumvalue> → per-enumerator (enum memberdefs only)+ <name>+ <briefdescription>+ <detaileddescription>+ + type, definition, argsstring, param, location, ... (ignored)+ + header, description (ignored)+ + includes, location, listofallmembers, graphs, ... (ignored)++ See 'classifyCompoundDef', 'classifyMemberDef', and 'classifyEnumValue'+ for the full list of known-but-ignored elements at each level.+-------------------------------------------------------------------------------}++-- | Parse a single XML file (group, struct, union, or file)+parseEntityXML :: FilePath -> IO XMLFileResult+parseEntityXML path = do+ doc <- readXML path+ let root = Cursor.fromDocument doc+ (rootWarns, compoundDefs) =+ forChildren "doxygen" (Cursor.child root) $+ \n c -> case n of+ "compounddef" -> Just (Yield c)+ _ -> Nothing+ results = map extractEntity compoundDefs++ pure XMLFileResult {+ comments = Map.unionsWith const [r.comments | r <- results]+ , groupTitles = concatMap (.groupTitles) results+ , groupChildren = concatMap (.groupChildren) results+ , groupMembers = concatMap (.groupMembers) results+ , warnings = rootWarns ++ concatMap (.warnings) results+ }++-- | Extract all information from a @\<compounddef\>@ element.+--+-- A compounddef represents one documented entity (struct, union, group, or+-- file). This function classifies its children, extracts comments from+-- members, and assembles a 'XMLFileResult' with all comment map entries.+--+extractEntity :: Cursor -> XMLFileResult+extractEntity cd =+ let kind = Text.concat $ Cursor.attribute "kind" cd+ children = Cursor.child cd++ -- Classify <compounddef> children into buckets+ parts = classifyCompoundDef children++ -- Compound-level comment (struct/union docs)+ (commentWarns, mComment) = extractBriefAndDetail parts.briefs parts.details+ structDocs = case (kind `elem` ["struct", "union"], parts.name, mComment) of+ (True, Just sname, Just comment) -> [(KeyStruct sname, comment)]+ _ -> []++ -- Group metadata (only for kind="group")+ groupTitles = case (kind, parts.name, parts.title) of+ ("group", Just gname, Just gtitle) -> [(gname, Text.strip gtitle)]+ _ -> []+ groupChildren = case (kind, parts.name) of+ ("group", Just parentName) ->+ [ (childName, parentName)+ | c <- parts.innerGroups+ , refid <- Cursor.attribute "refid" c+ , childName <- maybeToList (groupFromRefid refid)+ ]+ _ -> []++ groupMembers = case (kind, parts.name) of+ ("group", Just groupName) ->+ [ (extractText c, groupName)+ | c <- parts.innerClasses+ ]+ _ -> []++ -- Member comments from <sectiondef>s → keyed as KeyDecl / KeyField+ (membersWarns, members) = extractAllMembers parts.sections+ declDocs = toDeclMap members+ fieldDocs = toFieldMap kind parts.name members++ -- Enum value comments → keyed as KeyEnumValue+ (enumWarns, enumDocs) = extractAllEnumValues members++ in XMLFileResult {+ comments = Map.fromList (structDocs ++ declDocs ++ fieldDocs ++ enumDocs)+ , groupTitles = groupTitles+ , groupChildren = groupChildren+ , groupMembers = groupMembers+ , warnings = parts.warnings ++ commentWarns ++ membersWarns ++ enumWarns+ }+ where++ {-------------------------------------------------------------------+ Comment map construction+ -------------------------------------------------------------------}++ -- Top-level declarations (functions, typedefs, enums).+ -- Struct fields have a qualifiedname containing "::" — exclude those.+ toDeclMap :: [MemberInfo] -> [(DoxygenKey, Comment DoxyRef)]+ toDeclMap ms =+ [ (KeyDecl mi.miName, mi.miComment)+ | mi <- ms+ , not (isStructField mi.miQualName) ]++ -- Struct/union field comments.+ -- For struct/union compounds, all members are fields of that struct.+ -- For other compounds (groups, files), fields are identified by their+ -- <qualifiedname> (e.g. "config_t::id" → KeyField "config_t" "id").+ toFieldMap :: Text -> Maybe Text -> [MemberInfo] -> [(DoxygenKey, Comment DoxyRef)]+ toFieldMap k mEntityName ms+ | k `elem` ["struct", "union"]+ , Just sname <- mEntityName+ = [(KeyField sname mi.miName, mi.miComment) | mi <- ms]+ | otherwise+ = [ (KeyField sname fname, mi.miComment)+ | mi <- ms+ , Just qn <- [mi.miQualName]+ , (sname, fname) <- maybeToList (splitQualifiedName qn)+ ]++ {-------------------------------------------------------------------+ <sectiondef> → <memberdef> extraction+ -------------------------------------------------------------------}++ extractAllMembers :: [Cursor] -> ([Warning], [MemberInfo])+ extractAllMembers = collectWarnings . map extractSectionMembers++ -- A sectiondef groups memberdefs by kind (func, typedef, public-attrib, …)+ extractSectionMembers :: Cursor -> ([Warning], [MemberInfo])+ extractSectionMembers secCursor =+ let (warns, memberDefs) = forChildren "sectiondef" (Cursor.child secCursor) $ \n c ->+ case n of+ "memberdef" -> Just (Yield c)+ "header" -> Just Skip+ "description" -> Just Skip+ _ -> Nothing+ pairs = map extractMember memberDefs+ in (warns ++ concatMap fst pairs, mapMaybe snd pairs)++ extractMember :: Cursor -> ([Warning], Maybe MemberInfo)+ extractMember mc =+ let mp = classifyMemberDef (Cursor.child mc)+ (commentWarns, mComment) = extractBriefAndDetail mp.briefs mp.details+ in case (mp.name, mComment) of+ (Just mname, Just comment) ->+ ( mp.warnings ++ commentWarns+ , Just MemberInfo { miName = mname, miComment = comment+ , miQualName = mp.qualifiedName+ , miEnumValues = mp.enumValues }+ )+ _ -> (mp.warnings ++ commentWarns, Nothing)++ {-------------------------------------------------------------------+ <enumvalue> extraction+ -------------------------------------------------------------------}++ extractAllEnumValues :: [MemberInfo] -> ([Warning], [(DoxygenKey, Comment DoxyRef)])+ extractAllEnumValues = collectWarnings . map extractEnumValuesFrom++ extractEnumValuesFrom :: MemberInfo -> ([Warning], [(DoxygenKey, Comment DoxyRef)])+ extractEnumValuesFrom mi =+ collectWarnings $ map (extractEnumValue mi.miName) mi.miEnumValues++ extractEnumValue :: Text -> Cursor -> ([Warning], [(DoxygenKey, Comment DoxyRef)])+ extractEnumValue ename ev =+ let evp = classifyEnumValue (Cursor.child ev)+ (commentWarns, mComment) = extractBriefAndDetail evp.briefs evp.details+ in case (evp.name, mComment) of+ (Just vname, Just comment) ->+ (evp.warnings ++ commentWarns, [(KeyEnumValue ename vname, comment)])+ _ ->+ (evp.warnings ++ commentWarns, [])++ {-------------------------------------------------------------------+ Child classifiers — one fold per XML element type++ Each classifier iterates children exactly once, dispatching on+ element name. Known-but-ignored elements are listed explicitly+ so that only truly unknown elements trigger warnings.+ -------------------------------------------------------------------}++ classifyCompoundDef :: [Cursor] -> CompoundParts+ classifyCompoundDef = foldr go (CompoundParts [] Nothing Nothing [] [] [] [] [])+ where+ go c acc@CompoundParts{..} = case nodeElementName c of+ -- Processed:+ Just "compoundname" -> CompoundParts { name = Just (extractText c), .. }+ Just "title" -> CompoundParts { title = Just (extractText c), .. }+ Just "briefdescription" -> CompoundParts { briefs = c : briefs, .. }+ Just "detaileddescription" -> CompoundParts { details = c : details, .. }+ Just "sectiondef" -> CompoundParts { sections = c : sections, .. }+ Just "innergroup" -> CompoundParts { innerGroups = c : innerGroups, .. }+ Just "innerclass" -> CompoundParts { innerClasses = c : innerClasses, .. }+ -- Known but ignored (expected doxygen output):+ Just "includes" -> acc+ Just "includedby" -> acc+ Just "innernamespace" -> acc+ Just "listofallmembers" -> acc+ Just "location" -> acc+ Just "collaborationgraph" -> acc+ Just "inheritancegraph" -> acc+ Just "incdepgraph" -> acc+ Just "invincdepgraph" -> acc+ Just "templateparamlist" -> acc+ Just "basecompoundref" -> acc+ Just "derivedcompoundref" -> acc+ Just "programlisting" -> acc+ -- Unknown → warn+ Just other -> CompoundParts+ { warnings = unknownChildWarning "compounddef" other : warnings, .. }+ Nothing -> acc++ classifyMemberDef :: [Cursor] -> MemberParts+ classifyMemberDef = foldr go (MemberParts [] Nothing Nothing [] [] [])+ where+ go c acc@MemberParts{..} = case nodeElementName c of+ Just "name" -> MemberParts { name = Just (extractText c), .. }+ Just "qualifiedname" -> MemberParts { qualifiedName = Just (extractText c), .. }+ Just "briefdescription" -> MemberParts { briefs = c : briefs, .. }+ Just "detaileddescription" -> MemberParts { details = c : details, .. }+ Just "enumvalue" -> MemberParts { enumValues = c : enumValues, .. }+ -- Known but ignored:+ Just "type" -> acc+ Just "definition" -> acc+ Just "argsstring" -> acc+ Just "location" -> acc+ Just "param" -> acc+ Just "initializer" -> acc+ Just "reimplements" -> acc+ Just "reimplementedby" -> acc+ Just "references" -> acc+ Just "referencedby" -> acc+ Just "templateparamlist" -> acc+ Just "inbodydescription" -> acc+ Just "scope" -> acc+ Just "bitfield" -> acc+ -- Unknown → warn+ Just other -> MemberParts+ { warnings = unknownChildWarning "memberdef" other : warnings, .. }+ Nothing -> acc++ classifyEnumValue :: [Cursor] -> EnumValueParts+ classifyEnumValue = foldr go (EnumValueParts [] Nothing [] [])+ where+ go c acc@EnumValueParts{..} = case nodeElementName c of+ Just "name" -> EnumValueParts { name = Just (extractText c), .. }+ Just "briefdescription" -> EnumValueParts { briefs = c : briefs, .. }+ Just "detaileddescription" -> EnumValueParts { details = c : details, .. }+ -- Known but ignored:+ Just "initializer" -> acc+ Just "inbodydescription" -> acc+ Just "location" -> acc+ -- Unknown → warn+ Just other -> EnumValueParts+ { warnings = unknownChildWarning "enumvalue" other : warnings, .. }+ Nothing -> acc++-- | Classified children of a @\<compounddef\>@ element+data CompoundParts = CompoundParts {+ warnings :: [Warning]+ , name :: Maybe Text+ , title :: Maybe Text+ , briefs :: [Cursor]+ , details :: [Cursor]+ , sections :: [Cursor]+ , innerGroups :: [Cursor]+ , innerClasses :: [Cursor]+ }++-- | Classified children of a @\<memberdef\>@ element+data MemberParts = MemberParts {+ warnings :: [Warning]+ , name :: Maybe Text+ , qualifiedName :: Maybe Text+ , briefs :: [Cursor]+ , details :: [Cursor]+ , enumValues :: [Cursor]+ }++-- | Classified children of an @\<enumvalue\>@ element+data EnumValueParts = EnumValueParts {+ warnings :: [Warning]+ , name :: Maybe Text+ , briefs :: [Cursor]+ , details :: [Cursor]+ }++-- | Intermediate result from extracting a single @\<memberdef\>@+data MemberInfo = MemberInfo {+ miName :: Text+ , miComment :: Comment DoxyRef+ , miQualName :: Maybe Text -- ^ e.g. @\"config_t::id\"@ for struct fields+ , miEnumValues :: [Cursor] -- ^ @\<enumvalue\>@ children (enum memberdefs only)+ }++{-------------------------------------------------------------------------------+ Shared XML helpers+-------------------------------------------------------------------------------}++-- | Extract text content from an element's children+extractText :: Cursor -> Text+extractText c = Text.concat $ c $/ Cursor.content++-- | Get the local element name from a cursor, if it's an element node+nodeElementName :: Cursor -> Maybe Text+nodeElementName c = case Cursor.node c of+ XML.NodeElement el -> Just (XML.nameLocalName (XML.elementName el))+ _ -> Nothing++-- | What to do with a child element+data ChildAction a+ = Skip -- ^ Known child, not needed here — skip silently+ | Yield a -- ^ Known child, include in results++-- | Process element children, dispatching on element name.+--+-- For each element child, calls the handler with the element name and+-- cursor. The handler returns:+--+-- * @Just (Yield x)@ — include @x@ in the result list+-- * @Just Skip@ — known child, skip silently+-- * @Nothing@ — unknown child, emit a 'StructureLevel' warning+--+-- Text and other non-element nodes are silently skipped.+forChildren+ :: Text -- ^ Parent element name (for warnings)+ -> [Cursor] -- ^ Children to iterate+ -> (Text -> Cursor -> Maybe (ChildAction a)) -- ^ Handler+ -> ([Warning], [a])+forChildren parent cs handler = foldr go ([], []) cs+ where+ go c (ws, xs) = case nodeElementName c of+ Just n -> case handler n c of+ Just (Yield x) -> (ws, x : xs)+ Just Skip -> (ws, xs)+ Nothing -> (unknownChildWarning parent n : ws, xs)+ Nothing -> (ws, xs)++-- | Construct a 'StructureLevel' warning for an unknown child element+unknownChildWarning :: Text -> Text -> Warning+unknownChildWarning parent child = Warning {+ element = child+ , context = StructureLevel parent+ , degradation = Omitted+ , explanation = "unknown child <" <> child <> "> of <" <> parent <> ">; ignored"+ }++-- | Unsupported block-level element (preserved as 'Tag')+unsupportedBlockWarning :: Text -> Warning+unsupportedBlockWarning el = Warning {+ element = el+ , context = BlockLevel+ , degradation = Omitted+ , explanation = "unsupported block element: " <> el+ }++-- | Unsupported inline-level element (content preserved as plain text)+degradedInlineWarning :: Text -> Warning+degradedInlineWarning el = Warning {+ element = el+ , context = InlineLevel+ , degradation = DegradedToText+ , explanation = el <> " text preserved as plain text (no AST representation)"+ }++-- | Unknown @\<simplesect\>@ kind (defaulted to Note)+unknownSectKindWarning :: Text -> Warning+unknownSectKindWarning kind = Warning {+ element = kind+ , context = UnknownSectKind+ , degradation = DefaultedTo "Note"+ , explanation = "unknown simplesect kind '" <> kind <> "'; defaulted to Note"+ }++-- | Missing kind attribute on @\<simplesect\>@ (defaulted to Note)+missingSectKindWarning :: Warning+missingSectKindWarning = Warning {+ element = "simplesect"+ , context = UnknownSectKind+ , degradation = DefaultedTo "Note"+ , explanation = "simplesect with no kind attribute; defaulted to Note"+ }++-- | Collect warnings and results from a list of warning\/result pairs+collectWarnings :: [([a], [b])] -> ([a], [b])+collectWarnings pairs = (concatMap fst pairs, concatMap snd pairs)++-- | Extract brief and detailed descriptions, build a 'Comment'.+--+-- Takes the @\<briefdescription\>@ and @\<detaileddescription\>@ cursors+-- (already classified by the caller's fold). Enumerates brief children+-- for @\<para\>@s, warning on unexpected elements.+extractBriefAndDetail :: [Cursor] -> [Cursor] -> ([Warning], Maybe (Comment DoxyRef))+extractBriefAndDetail briefDescs detailDescs =+ let (briefDescWarns, briefParas) =+ collectWarnings $ map classifyBriefChildren briefDescs+ detailChildren = concatMap Cursor.child detailDescs+ (commentWarns, mComment) = buildComment briefParas detailChildren+ in (briefDescWarns ++ commentWarns, mComment)+ where+ classifyBriefChildren :: Cursor -> ([Warning], [Cursor])+ classifyBriefChildren bd =+ forChildren "briefdescription" (Cursor.child bd) $+ \n c -> case n of+ "para" -> Just (Yield c)+ _ -> Nothing++-- | Build a 'Comment' from pre-classified brief @\<para\>@s and detailed+-- children.+buildComment :: [Cursor] -> [Cursor] -> ([Warning], Maybe (Comment DoxyRef))+buildComment briefParas detailChildren =+ let (briefWarns, briefInlines) =+ collectWarnings $ map parseInlineChildren briefParas+ trimmedBrief = trimEdges briefInlines+ (detailWarns, detailedBlocks) =+ collectWarnings $ map parseBlockElement detailChildren+ in case (trimmedBrief, detailedBlocks) of+ ([], []) -> (briefWarns ++ detailWarns, Nothing)+ _ -> ( briefWarns ++ detailWarns+ , Just Comment {+ brief = trimmedBrief+ , detailed = detailedBlocks+ })++{-------------------------------------------------------------------------------+ Block and inline parsing+-------------------------------------------------------------------------------}++-- | Parse block-level content from a cursor+parseBlockElement :: Cursor -> ([Warning], [Block DoxyRef])+parseBlockElement cursor =+ case Cursor.node cursor of+ XML.NodeElement el -> parseBlock el cursor+ _ -> ([], [])++-- | Parse a block-level XML element+parseBlock :: XML.Element -> Cursor -> ([Warning], [Block DoxyRef])+parseBlock el cursor = case XML.nameLocalName (XML.elementName el) of+ "para" ->+ let children = Cursor.child cursor+ (warns, blocks, inlines) = partitionContent children+ trimmed = trimEdges inlines+ in (warns,+ [Paragraph trimmed | not (null trimmed)]+ ++ blocks)++ "parameterlist" ->+ let kind = case listToMaybe $ Cursor.attribute "kind" cursor of+ Just "retval" -> ParamListRetVal+ _ -> ParamListParam+ (childWarns, items) = forChildren "parameterlist" (Cursor.child cursor) $ \n c ->+ case n of+ "parameteritem" -> Just (Yield c)+ _ -> Nothing+ (warns, params) = parseParamItems items+ in (childWarns ++ warns, [ParamList kind params])++ "simplesect" ->+ let children = Cursor.child cursor+ titles = [extractText c | c <- children, nodeElementName c == Just "title"]+ (kindWarns, kind) = parseSimpleSectKind cursor (listToMaybe titles)+ -- Filter <title> — already consumed by parseSimpleSectKind for SSPar+ contentChildren = filter (not . isTitle) children+ (contentWarns, content) = unzipBlocks contentChildren+ in (kindWarns ++ contentWarns, [SimpleSect kind content])++ "programlisting" ->+ let (childWarns, codelines) = forChildren "programlisting" (Cursor.child cursor) $ \n c ->+ case n of+ "codeline" -> Just (Yield c)+ _ -> Nothing+ (codeWarns, codeLines) = unzip $ map extractCodeLine codelines+ in (childWarns ++ concat codeWarns, [CodeBlock codeLines])++ "itemizedlist" ->+ let (childWarns, items) = forChildren "itemizedlist" (Cursor.child cursor) $ \n c ->+ case n of+ "listitem" -> Just (Yield c)+ _ -> Nothing+ (warns, blocks) = unzipListItems items+ in (childWarns ++ warns, [ItemizedList blocks])++ "orderedlist" ->+ let (childWarns, items) = forChildren "orderedlist" (Cursor.child cursor) $ \n c ->+ case n of+ "listitem" -> Just (Yield c)+ _ -> Nothing+ (warns, blocks) = unzipListItems items+ in (childWarns ++ warns, [OrderedList blocks])++ "xrefsect" ->+ let (childWarns, parts) = forChildren "xrefsect" (Cursor.child cursor) $ \n c ->+ case n of+ "xreftitle" -> Just (Yield (Left (Text.strip (extractText c))))+ "xrefdescription" -> Just (Yield (Right (Cursor.child c)))+ _ -> Nothing+ title = fromMaybe "" $ listToMaybe [t | Left t <- parts]+ (descWarns, desc) = unzipBlocks (concat [cs | Right cs <- parts])+ in (childWarns ++ descWarns, [XRefSect title desc])++ "table" ->+ let (childWarns, children) = unzipBlocks (Cursor.child cursor)+ in (childWarns, [Tag "table" children])++ other ->+ let (childWarns, children) = unzipBlocks (Cursor.child cursor)+ in (unsupportedBlockWarning other : childWarns, [Tag other children])++-- | Partition children of a @\<para\>@ into block and inline content+--+partitionContent :: [Cursor] -> ([Warning], [Block DoxyRef], [Inline DoxyRef])+partitionContent = go [] [] []+ where+ go warns blocks inlines [] = (reverse warns, reverse blocks, reverse inlines)+ go warns blocks inlines (c : rest) =+ case Cursor.node c of+ XML.NodeContent txt+ | Text.all Char.isSpace txt ->+ go warns blocks (Text " " : inlines) rest+ | otherwise ->+ go warns blocks (Text (normalizeWhitespace txt) : inlines) rest+ XML.NodeElement el+ | XML.nameLocalName (XML.elementName el) `elem` blockElements+ -> let (bw, bs) = parseBlock el c+ in go (bw ++ warns) (reverse bs ++ blocks) inlines rest+ | otherwise+ -> let (iw, is) = parseInline el c+ in go (iw ++ warns) blocks (reverse is ++ inlines) rest+ _ -> go warns blocks inlines rest++ blockElements :: [Text]+ blockElements =+ [ "parameterlist", "simplesect", "programlisting"+ , "itemizedlist", "orderedlist", "xrefsect"+ , "table"+ ]++-- | Parse inline content from an XML element+parseInline :: XML.Element -> Cursor -> ([Warning], [Inline DoxyRef])+parseInline el cursor = case XML.nameLocalName (XML.elementName el) of+ "bold" -> let (w, is) = parseInlineChildren cursor in (w, [Bold is])+ "emphasis" -> let (w, is) = parseInlineChildren cursor in (w, [Emph is])+ "computeroutput" -> let (w, is) = parseInlineChildren cursor in (w, [Mono is])+ "ref" -> let t = Text.strip $ Text.concat $ cursor $/ Cursor.content+ k = case listToMaybe $ Cursor.attribute "kindref" cursor of+ Just "compound" -> Just RefCompound+ Just "member" -> Just RefMember+ _ -> Nothing+ in ([], [Ref (DoxyRef t k) t])+ "anchor" -> ([], [Anchor $ Text.concat $ Cursor.attribute "id" cursor])+ "ulink" -> let (w, is) = parseInlineChildren cursor+ in (w, [Link is (Text.concat $ Cursor.attribute "url" cursor)])+ "linebreak" -> ([], [Text "\n"])+ "sp" -> ([], [Text " "])+ other ->+ let txt = Text.strip $ Text.concat $ cursor $// Cursor.content+ w = degradedInlineWarning other+ in if Text.null txt+ then ([w], [])+ else ([w], [Text txt])++-- | Parse all inline children of a cursor+parseInlineChildren :: Cursor -> ([Warning], [Inline DoxyRef])+parseInlineChildren cursor = collectWarnings $ map go (Cursor.child cursor)+ where+ go :: Cursor -> ([Warning], [Inline DoxyRef])+ go c = case Cursor.node c of+ XML.NodeContent txt+ | Text.all Char.isSpace txt -> ([], [Text " "])+ | otherwise -> ([], [Text (normalizeWhitespace txt)])+ XML.NodeElement el -> parseInline el c+ _ -> ([], [])++{-------------------------------------------------------------------------------+ Helpers+-------------------------------------------------------------------------------}++-- | Normalize whitespace in an XML text node+--+-- Collapses runs of whitespace to a single space, preserving a leading+-- and\/or trailing space when the original text started\/ended with+-- whitespace. This is important for mixed-content XML: the text node+-- @\"Hello \"@ in @\<para\>Hello \<bold\>world\<\/bold\>\<\/para\>@ must+-- keep its trailing space so that the rendered output reads+-- @\"Hello world\"@ rather than @\"Helloworld\"@.+--+normalizeWhitespace :: Text -> Text+normalizeWhitespace txt+ | Text.null txt = txt+ | otherwise =+ let leading = if Char.isSpace (Text.head txt) then " " else ""+ trailing = if Char.isSpace (Text.last txt) then " " else ""+ inner = Text.unwords $ Text.words txt+ in leading <> inner <> trailing++-- | Trim leading whitespace from the first 'Text' and trailing+-- whitespace from the last 'Text' in an inline sequence.+--+-- This is applied at paragraph boundaries (when constructing+-- 'Paragraph' and the brief description) to remove XML formatting+-- whitespace from paragraph edges while preserving inter-element+-- whitespace within the paragraph.+--+trimEdges :: [Inline ref] -> [Inline ref]+trimEdges = trimTrailing . trimLeading+ where+ trimLeading :: [Inline ref] -> [Inline ref]+ trimLeading (Text t : rest)+ | Text.null stripped = trimLeading rest+ | otherwise = Text stripped : rest+ where stripped = Text.stripStart t+ trimLeading xs = xs++ trimTrailing :: [Inline ref] -> [Inline ref]+ trimTrailing [] = []+ trimTrailing [Text t]+ | Text.null stripped = []+ | otherwise = [Text stripped]+ where stripped = Text.stripEnd t+ trimTrailing (x : xs) = x : trimTrailing xs++parseParamItems :: [Cursor] -> ([Warning], [Param DoxyRef])+parseParamItems cursors =+ let pairs = map parseParamItem cursors+ in (concatMap fst pairs, mapMaybe snd pairs)++parseParamItem :: Cursor -> ([Warning], Maybe (Param DoxyRef))+parseParamItem cursor =+ let (itemWarns, parts) =+ forChildren "parameteritem" (Cursor.child cursor) $+ \n c -> case n of+ "parameternamelist" -> Just (Yield (Left c))+ "parameterdescription" -> Just (Yield (Right (Cursor.child c)))+ _ -> Nothing++ nameListCursors = [c | Left c <- parts]+ descChildren = concat [cs | Right cs <- parts]++ (nameListWarns, nameElems) =+ collectWarnings $ map classifyParamNameList nameListCursors++ in case listToMaybe $ map extractText nameElems of+ Nothing -> (itemWarns ++ nameListWarns, Nothing)+ Just pname ->+ let direction = listToMaybe nameElems >>= \n ->+ case listToMaybe $ Cursor.attribute "direction" n of+ Just "in" -> Just DirIn+ Just "out" -> Just DirOut+ Just "inout" -> Just DirInOut+ _ -> Nothing+ (descWarns, desc) = unzipBlocks descChildren+ in (itemWarns ++ nameListWarns ++ descWarns,+ Just Param { paramName = pname, paramDirection = direction, paramDesc = desc })+ where+ classifyParamNameList :: Cursor -> ([Warning], [Cursor])+ classifyParamNameList nl =+ forChildren "parameternamelist" (Cursor.child nl) $+ \n c -> case n of+ "parametername" -> Just (Yield c)+ _ -> Nothing++parseSimpleSectKind :: Cursor -> Maybe Text -> ([Warning], SimpleSectKind)+parseSimpleSectKind cursor mTitle =+ case listToMaybe $ Cursor.attribute "kind" cursor of+ Just "return" -> ([], SSReturn)+ Just "warning" -> ([], SSWarning)+ Just "note" -> ([], SSNote)+ Just "see" -> ([], SSSee)+ Just "since" -> ([], SSSince)+ Just "version" -> ([], SSVersion)+ Just "pre" -> ([], SSPre)+ Just "post" -> ([], SSPost)+ Just "deprecated" -> ([], SSDeprecated)+ Just "remark" -> ([], SSRemark)+ Just "attention" -> ([], SSAttention)+ Just "todo" -> ([], SSTodo)+ Just "invariant" -> ([], SSInvariant)+ Just "author" -> ([], SSAuthor)+ Just "date" -> ([], SSDate)+ Just "par" -> ([], SSPar $ maybe "" Text.strip mTitle)+ Just other -> ([unknownSectKindWarning other], SSNote)+ Nothing -> ([missingSectKindWarning], SSNote)++extractCodeLine :: Cursor -> ([Warning], Text)+extractCodeLine cursor =+ let (childWarns, highlights) =+ forChildren "codeline" (Cursor.child cursor) $+ \n c -> case n of+ "highlight" -> Just (Yield c)+ _ -> Nothing+ in (childWarns, Text.concat $ map extractHighlight highlights)+ where+ extractHighlight :: Cursor -> Text+ extractHighlight c = Text.concat $ map nodeText (Cursor.child c)++ nodeText :: Cursor -> Text+ nodeText c = case Cursor.node c of+ XML.NodeContent txt -> txt+ XML.NodeElement el -> case XML.nameLocalName (XML.elementName el) of+ "sp" -> " "+ "ref" -> Text.concat $ c $/ Cursor.content+ _ -> Text.concat $ c $// Cursor.content+ _ -> ""++-- | Collect block elements from children, threading warnings+unzipBlocks :: [Cursor] -> ([Warning], [Block DoxyRef])+unzipBlocks = collectWarnings . map parseBlockElement++-- | Collect list items, threading warnings+unzipListItems :: [Cursor] -> ([Warning], [[Block DoxyRef]])+unzipListItems items =+ let pairs = map parseListItem items+ in (concatMap fst pairs, map snd pairs)++parseListItem :: Cursor -> ([Warning], [Block DoxyRef])+parseListItem cursor = unzipBlocks (Cursor.child cursor)++-- | Check if a cursor points at a @\<title\>@ element+isTitle :: Cursor -> Bool+isTitle c = case Cursor.node c of+ XML.NodeElement el -> XML.nameLocalName (XML.elementName el) == "title"+ _ -> False++-- | Check if a @\<memberdef\>@ is a struct\/union field.+--+-- Struct fields have a @\<qualifiedname\>@ child like @\"config_t::id\"@,+-- whereas top-level declarations do not.+isStructField :: Maybe Text -> Bool+isStructField (Just qn) = "::" `Text.isInfixOf` qn+isStructField Nothing = False++-- | Split a qualified name like @\"config_t::id\"@ into @(\"config_t\", \"id\")@.+splitQualifiedName :: Text -> Maybe (Text, Text)+splitQualifiedName qualName =+ case Text.breakOn "::" qualName of+ (sname, rest)+ | Just fn <- Text.stripPrefix "::" rest+ , not (Text.null sname)+ , not (Text.null fn)+ -> Just (sname, fn)+ _ -> Nothing++-- | Filter for entity XML files (groups, structs, unions, files).+--+-- This is a deny-list: it excludes known non-entity files. If future doxygen+-- versions add new auxiliary XML files, they would pass through and be parsed+-- as entities — harmlessly yielding an empty result since they won't contain+-- a recognised @\<compounddef\>@.+--+-- Excludes schema files (@.xsd@), XSLT files, @index.xml@, @Doxyfile.xml@,+-- @dir_*.xml@ (directory compounds), @namespace*.xml@ and @class*.xml@+-- (C++-only compounds), @deprecated.xml@, and @indexpage.xml@.+isEntityXML :: FilePath -> Bool+isEntityXML f =+ takeExtension f == ".xml"+ && f /= "index.xml"+ && not ("Doxyfile" `List.isPrefixOf` f)+ && not ("dir_" `List.isPrefixOf` f)+ && not ("namespace" `List.isPrefixOf` f)+ && not ("class" `List.isPrefixOf` f)+ && f /= "deprecated.xml"+ && f /= "indexpage.xml"++-- | Read an XML file, wrapping parse errors in 'DoxygenXMLParseError'+readXML :: FilePath -> IO XML.Document+readXML path =+ XML.readFile XML.def path+ `catch` \(e :: SomeException) ->+ throwIO $ DoxygenXMLParseError path (show e)
+ src-internal/Doxygen/Parser/Types.hs view
@@ -0,0 +1,208 @@+-- | Doxygen comment types parameterized by cross-reference type+--+-- These types represent structured Doxygen comments parsed from XML output.+-- They are parameterized by @ref@ so that cross-references can be threaded+-- through consumer-specific pipelines and resolved later.+--+-- The structure closely mirrors Doxygen's XML schema:+--+-- * 'Comment' splits brief and detailed descriptions+-- * 'Block' represents block-level content (paragraphs, lists, code, etc.)+-- * 'Inline' represents inline formatting and cross-references+-- * 'Param' represents documented parameters with direction+--+-- Intended for qualified import:+--+-- @+-- import Doxygen.Parser.Types qualified as Doxy+-- @+--+module Doxygen.Parser.Types (+ -- * Comment types+ Comment(..)+ , Block(..)+ , Inline(..)+ , Param(..)+ -- * Cross-reference types+ , DoxyRef(..)+ , RefKind(..)+ -- * Enumerations+ , ParamListKind(..)+ , ParamDirection(..)+ , SimpleSectKind(..)+ ) where++import Data.Text (Text)+import GHC.Generics (Generic)++{-------------------------------------------------------------------------------+ Comment types+-------------------------------------------------------------------------------}++-- | A Doxygen comment with brief and detailed sections+--+-- The @ref@ parameter is the cross-reference type. The parser produces+-- @Comment DoxyRef@, where each 'DoxyRef' carries the raw C name and the+-- optional @kindref@. Consumers can 'fmap' or 'traverse' to resolve these+-- to their own identifier types.+--+-- Corresponds to the @\<briefdescription\>@ and @\<detaileddescription\>@+-- elements in Doxygen XML output.+--+data Comment ref = Comment {+ brief :: [Inline ref]+ -- ^ Brief one-line summary, from the @\<briefdescription\>@ element.+ , detailed :: [Block ref]+ -- ^ Detailed description blocks, from @\<detaileddescription\>@.+ }+ deriving stock (Functor, Foldable, Traversable, Show, Eq, Generic)++-- | Block-level content in a Doxygen comment+--+data Block ref+ = Paragraph [Inline ref]+ -- ^ A paragraph: @\<para\>@ element+ | ParamList ParamListKind [Param ref]+ -- ^ Parameter or return value list: @\<parameterlist\>@+ | SimpleSect SimpleSectKind [Block ref]+ -- ^ Special section: @\<simplesect kind=\"...\"\>@+ | CodeBlock [Text]+ -- ^ Code block: @\<programlisting\>@+ | ItemizedList [[Block ref]]+ -- ^ Bullet list: @\<itemizedlist\>@. Each element is one list item.+ | OrderedList [[Block ref]]+ -- ^ Numbered list: @\<orderedlist\>@. Each element is one list item.+ | XRefSect Text [Block ref]+ -- ^ Cross-reference section: @\<xrefsect\>@+ --+ -- Used for @\@deprecated@ and similar. First field is the title+ -- (e.g., \"Deprecated\"), second is the description.+ | Tag Text [Block ref]+ -- ^ Unsupported or unrecognised XML\/HTML tag.+ --+ -- Used for tags that do not have a dedicated constructor (e.g., HTML+ -- @\<table\>@). The 'Text' is the element name; the @[Block ref]@+ -- are the recursively-parsed children, so that content inside+ -- unsupported tags is still preserved.+ deriving stock (Functor, Foldable, Traversable, Show, Eq, Generic)++-- | Inline content in a Doxygen comment+data Inline ref+ = Text Text+ -- ^ Plain text+ | Bold [Inline ref]+ -- ^ Bold text: @\<bold\>@ element (from @\@b@ or @\<b\>@)+ | Emph [Inline ref]+ -- ^ Emphasized text: @\<emphasis\>@ element (from @\@e@, @\@a@, or @\<i\>@)+ | Mono [Inline ref]+ -- ^ Monospace text: @\<computeroutput\>@ element (from @\@c@, @\@p@, or @\<code\>@)+ | Ref ref Text+ -- ^ Cross-reference: @\<ref\>@ element+ --+ -- First field is the reference (consumer-specific type).+ -- Second field is the display text (the C name as shown in the comment).+ | Anchor Text+ -- ^ Anchor: @\<anchor\>@ element+ | Link [Inline ref] Text+ -- ^ Hyperlink: @\<ulink\>@ element. First field is the label, second is the URL.+ deriving stock (Functor, Foldable, Traversable, Show, Eq, Generic)++-- | A documented parameter+--+data Param ref = Param {+ paramName :: Text+ -- ^ Parameter name, from the @\<parametername\>@ element.+ , paramDirection :: Maybe ParamDirection+ -- ^ Direction annotation (@in@, @out@, @inout@), when present.+ , paramDesc :: [Block ref]+ -- ^ Parameter description blocks.+ }+ deriving stock (Functor, Foldable, Traversable, Show, Eq, Generic)++{-------------------------------------------------------------------------------+ Enumerations+-------------------------------------------------------------------------------}++-- | Kind of parameter list+--+data ParamListKind+ = ParamListParam+ -- ^ @\@param@ documentation+ | ParamListRetVal+ -- ^ @\@retval@ documentation+ deriving stock (Show, Eq, Generic)++-- | Parameter passing direction+--+data ParamDirection+ = DirIn+ -- ^ Input parameter: @\@param[in]@+ | DirOut+ -- ^ Output parameter: @\@param[out]@+ | DirInOut+ -- ^ Input/output parameter: @\@param[in,out]@+ deriving stock (Show, Eq, Generic)++-- | Kind of simple section+--+data SimpleSectKind+ = SSReturn+ -- ^ @\@return@ / @\@returns@ / @\@result@+ | SSWarning+ -- ^ @\@warning@+ | SSNote+ -- ^ @\@note@+ | SSSee+ -- ^ @\@see@ / @\@sa@+ | SSSince+ -- ^ @\@since@+ | SSVersion+ -- ^ @\@version@+ | SSPre+ -- ^ @\@pre@+ | SSPost+ -- ^ @\@post@+ | SSPar Text+ -- ^ @\@par Title:@ (the 'Text' is the paragraph title)+ | SSDeprecated+ -- ^ @\@deprecated@+ | SSRemark+ -- ^ @\@remark@ / @\@remarks@+ | SSAttention+ -- ^ @\@attention@+ | SSTodo+ -- ^ @\@todo@+ | SSInvariant+ -- ^ @\@invariant@+ | SSAuthor+ -- ^ @\@author@+ | SSDate+ -- ^ @\@date@+ deriving stock (Show, Eq, Generic)++{-------------------------------------------------------------------------------+ Cross-reference types+-------------------------------------------------------------------------------}++-- | Kind of a Doxygen cross-reference target+--+-- Corresponds to the @kindref@ attribute on @\<ref\>@ elements in Doxygen XML.+data RefKind+ = RefCompound+ -- ^ Compound type (struct, union, class, namespace, etc.)+ | RefMember+ -- ^ Member (function, variable, typedef, macro, enum value, etc.)+ deriving stock (Show, Eq, Generic)++-- | Doxygen cross-reference with optional kind information+--+-- The parser produces @'DoxyRef'@ values at cross-reference positions+-- (@\<ref\>@ elements in Doxygen XML), preserving the @kindref@ attribute+-- when present.+data DoxyRef = DoxyRef {+ doxyRefName :: Text+ -- ^ The referenced C name, as shown in the comment.+ , doxyRefKind :: Maybe RefKind+ -- ^ The @kindref@ attribute, when Doxygen records it.+ }+ deriving stock (Show, Eq, Generic)
+ src-internal/Doxygen/Parser/Warning.hs view
@@ -0,0 +1,52 @@+-- | Structured warnings for unsupported or degraded Doxygen content+--+-- When the parser encounters Doxygen XML elements it cannot fully represent+-- in the typed AST, it emits a 'Warning' describing what happened and how+-- the content was degraded.+--+module Doxygen.Parser.Warning (+ Warning(..)+ , Context(..)+ , Degradation(..)+ ) where++import Data.Text (Text)+import GHC.Generics (Generic)++-- | A structured warning about unsupported or degraded content+data Warning = Warning {+ element :: Text+ -- ^ The XML element or feature that triggered the warning+ , context :: Context+ -- ^ Where in the AST the element appeared+ , degradation :: Degradation+ -- ^ How the content was degraded+ , explanation :: Text+ -- ^ Human-readable description of what happened+ }+ deriving stock (Show, Eq, Generic)++-- | Where in the AST hierarchy the unsupported element appeared+data Context+ = BlockLevel+ -- ^ Inside a block-level context (e.g., child of @\<para\>@ or+ -- @\<detaileddescription\>@)+ | InlineLevel+ -- ^ Inside an inline context (e.g., child of @\<bold\>@ or inline+ -- content within @\<para\>@)+ | UnknownSectKind+ -- ^ An unrecognised @kind@ attribute on @\<simplesect\>@+ | StructureLevel Text+ -- ^ Inside a structural element. The 'Text' identifies the parent+ -- (e.g. @\"compounddef\"@, @\"sectiondef\"@, @\"memberdef\"@).+ deriving stock (Show, Eq, Generic)++-- | How the unsupported content was handled+data Degradation+ = Omitted+ -- ^ Content was entirely dropped from the AST+ | DegradedToText+ -- ^ Formatting was lost; content preserved as plain text+ | DefaultedTo Text+ -- ^ An unknown value was replaced with a default+ deriving stock (Show, Eq, Generic)
+ src/Doxygen/Parser.hs view
@@ -0,0 +1,73 @@+-- | Public API for parsing Doxygen XML output into a typed Haskell AST.+--+-- = Overview+--+-- 'parse' invokes the @doxygen@ binary on a non-empty list of C\/C+++-- header files, walks the resulting @xml\/@ directory, and assembles a+-- 'Doxygen' value that maps each documented entity to a structured+-- 'Comment' tree. The @doxygen@ binary must be available on @PATH@ (or+-- configured via 'Config').+--+-- = Quick start+--+-- @+-- {-\# LANGUAGE NamedFieldPuns \#-}+-- {-\# LANGUAGE OverloadedStrings \#-}+--+-- import "Doxygen.Parser"+-- import Data.List.NonEmpty (NonEmpty (..))+--+-- main :: IO ()+-- main = do+-- 'Result'{doxygen, warnings, doxygenVersion} \<-+-- 'parse' 'defaultConfig' (\"myheader.h\" :| [])+-- mapM_ print warnings+-- print ('lookupComment' ('KeyDecl' \"myFunc\") doxygen)+-- @+--+-- 'parse' throws 'DoxygenException' if the @doxygen@ invocation itself+-- fails; recoverable problems (unknown XML elements, malformed refs,+-- etc.) are returned as 'Warning's in the 'Result'.+--+-- = Stability+--+-- This module, "Doxygen.Parser.Types", and "Doxygen.Parser.Warning"+-- form the supported public API.+--+module Doxygen.Parser (+ -- * Configuration+ Config(..)+ , defaultConfig+ -- * Parsing+ , parse+ , Result(..)+ -- * State type+ , Doxygen -- Opaque+ , emptyDoxygen+ -- * Lookup keys+ , DoxygenKey(..)+ , lookupComment+ -- * Group sections+ , lookupGroupMembership+ , lookupGroupInfo+ -- * Errors+ , DoxygenException(..)+ -- * Comment types (from "Doxygen.Parser.Types")+ , Comment(..)+ , Block(..)+ , Inline(..)+ , Param(..)+ , DoxyRef(..)+ , RefKind(..)+ , ParamListKind(..)+ , ParamDirection(..)+ , SimpleSectKind(..)+ -- * Warnings (from "Doxygen.Parser.Warning")+ , Warning(..)+ , Context(..)+ , Degradation(..)+ ) where++import Doxygen.Parser.Internal+import Doxygen.Parser.Types+import Doxygen.Parser.Warning
+ test/Main.hs view
@@ -0,0 +1,35 @@+module Main (main) where++import Test.Tasty++import Test.Doxygen.Parser.Block qualified as Block+import Test.Doxygen.Parser.CodeBlock qualified as CodeBlock+import Test.Doxygen.Parser.Comment qualified as Comment+import Test.Doxygen.Parser.InlineNesting qualified as InlineNesting+import Test.Doxygen.Parser.InlineParsing qualified as InlineParsing+import Test.Doxygen.Parser.List qualified as List+import Test.Doxygen.Parser.NormalizeWhitespace qualified as NormalizeWhitespace+import Test.Doxygen.Parser.Param qualified as Param+import Test.Doxygen.Parser.Properties qualified as Properties+import Test.Doxygen.Parser.SimpleSect qualified as SimpleSect+import Test.Doxygen.Parser.StructuralWarnings qualified as StructuralWarnings+import Test.Doxygen.Parser.Whitespace qualified as Whitespace+import Test.Doxygen.Parser.XMLFileResult qualified as XMLFileResult++main :: IO ()+main =+ defaultMain $ testGroup "doxygen-parser"+ [ testGroup "normalizeWhitespace" NormalizeWhitespace.tests+ , testGroup "inline parsing" InlineParsing.tests+ , testGroup "inline nesting" InlineNesting.tests+ , testGroup "whitespace handling" Whitespace.tests+ , testGroup "block parsing" Block.tests+ , testGroup "comment parsing" Comment.tests+ , testGroup "parameter parsing" Param.tests+ , testGroup "simplesect kinds" SimpleSect.tests+ , testGroup "list parsing" List.tests+ , testGroup "code block parsing" CodeBlock.tests+ , testGroup "structural warnings" StructuralWarnings.tests+ , testGroup "XMLFileResult assembly" XMLFileResult.tests+ , testGroup "properties" Properties.tests+ ]
+ test/Test/Doxygen/Parser/Block.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE LambdaCase #-}++module Test.Doxygen.Parser.Block (tests) where++import Data.Text qualified as Text+import Test.Tasty+import Test.Tasty.HUnit++import Doxygen.Parser+import Test.Doxygen.Parser.Helpers++tests :: [TestTree]+tests =+ [ testCase "paragraph" $+ blockShouldMatch "<para>Hello</para>" $ \b ->+ b @?= Paragraph [Text "Hello"]++ , testCase "empty paragraph produces nothing" $ do+ let (ws, bs) = parseBlockFromXML (wrap "<para></para>")+ ws @?= []+ bs @?= []++ , testCase "whitespace-only paragraph produces nothing" $ do+ let (ws, bs) = parseBlockFromXML (wrap "<para> </para>")+ ws @?= []+ bs @?= []++ , testCase "para with mixed block and inline content" $ do+ let (_, bs) = parseBlockFromXML $ wrap $ Text.concat+ [ "<para>"+ , "Some text"+ , "<simplesect kind=\"note\"><para>A note</para></simplesect>"+ , "</para>"+ ]+ bs @?= [ Paragraph [Text "Some text"]+ , SimpleSect SSNote [Paragraph [Text "A note"]]+ ]++ , testCase "para with only a parameterlist produces no empty paragraph" $ do+ let (_, bs) = parseBlockFromXML $ wrap $ Text.concat+ [ "<para>"+ , mkParamListXML "param" [(Nothing, "x", "Desc")]+ , "</para>"+ ]+ bs @?= [ParamList ParamListParam+ [Param { paramName = "x"+ , paramDirection = Nothing+ , paramDesc = [Paragraph [Text "Desc"]]+ }]]++ , testCase "parameterlist (param kind)" $+ blockShouldMatch (mkParamListXML "param" [(Just "in", "x", "The input")]) $+ \case+ ParamList ParamListParam [p] -> do+ p.paramName @?= "x"+ p.paramDirection @?= Just DirIn+ b -> assertFailure $ "unexpected: " ++ show b++ , testCase "parameterlist (retval kind)" $+ blockShouldMatch (mkParamListXML "retval" [(Nothing, "0", "Success")]) $+ \case+ ParamList ParamListRetVal _ -> pure ()+ b -> assertFailure $ "expected retval list, got: " ++ show b++ , testCase "simplesect return" $+ blockShouldMatch "<simplesect kind=\"return\"><para>The result</para></simplesect>" $+ \case+ SimpleSect SSReturn _ -> pure ()+ b -> assertFailure $ "expected SSReturn: " ++ show b++ , testCase "programlisting" $+ blockShouldMatch+ ("<programlisting>"+ <> "<codeline><highlight class=\"normal\">int<sp/>x<sp/>=<sp/>0;</highlight></codeline>"+ <> "</programlisting>") $+ \case+ CodeBlock [line] -> line @?= "int x = 0;"+ b -> assertFailure $ "expected code block: " ++ show b++ , testCase "xrefsect (deprecated)" $+ blockShouldMatch+ ("<xrefsect id=\"deprecated\">"+ <> "<xreftitle>Deprecated</xreftitle>"+ <> "<xrefdescription><para>Use new_func instead</para></xrefdescription>"+ <> "</xrefsect>") $+ \case+ XRefSect "Deprecated" _ -> pure ()+ b -> assertFailure $ "expected xrefsect: " ++ show b++ , testCase "table preserves content as Tag without warning" $ do+ let (ws, bs) = parseBlockFromXML (wrap "<table><row><entry><para>cell</para></entry></row></table>")+ assertBool ("no table warning expected, got: " ++ show [w | w <- ws, w.element == "table"])+ (not $ any (\w -> w.element == "table") ws)+ case bs of+ [Tag tag _children] -> tag @?= "table"+ _ -> assertFailure $ "expected Tag: " ++ show bs++ , testCase "unknown block element emits warning + Tag" $ do+ let (ws, bs) = parseBlockFromXML (wrap "<sect1><title>Heading</title></sect1>")+ case ws of+ (w : _) -> w.context @?= BlockLevel+ _ -> assertFailure $ "expected at least 1 warning, got: " ++ show ws+ case bs of+ [Tag tag _children] -> tag @?= "sect1"+ _ -> assertFailure $ "expected Tag: " ++ show bs+ ]
+ test/Test/Doxygen/Parser/CodeBlock.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE LambdaCase #-}++module Test.Doxygen.Parser.CodeBlock (tests) where++import Test.Tasty+import Test.Tasty.HUnit++import Doxygen.Parser+import Test.Doxygen.Parser.Helpers++tests :: [TestTree]+tests =+ [ testCase "single code line" $+ blockShouldMatch+ ("<programlisting>"+ <> "<codeline><highlight class=\"normal\">return<sp/>0;</highlight></codeline>"+ <> "</programlisting>") $+ \case+ CodeBlock [line] -> line @?= "return 0;"+ b -> assertFailure $ "expected code block: " ++ show b++ , testCase "multiple code lines" $+ blockShouldMatch+ ("<programlisting>"+ <> "<codeline><highlight class=\"normal\">int<sp/>x;</highlight></codeline>"+ <> "<codeline><highlight class=\"normal\">x<sp/>=<sp/>0;</highlight></codeline>"+ <> "</programlisting>") $+ \case+ CodeBlock codeLines -> length codeLines @?= 2+ b -> assertFailure $ "expected 2 code lines: " ++ show b++ , testCase "code line with ref" $+ blockShouldMatch+ ("<programlisting>"+ <> "<codeline><highlight class=\"normal\">"+ <> "<ref refid=\"abc\">my_type</ref><sp/>x;</highlight></codeline>"+ <> "</programlisting>") $+ \case+ CodeBlock [line] -> line @?= "my_type x;"+ b -> assertFailure $ "expected code block: " ++ show b++ , testCase "empty code block" $+ blockShouldMatch "<programlisting></programlisting>" $+ \case+ CodeBlock [] -> pure ()+ b -> assertFailure $ "expected empty code block: " ++ show b+ ]
+ test/Test/Doxygen/Parser/Comment.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE LambdaCase #-}++module Test.Doxygen.Parser.Comment (tests) where++import Data.Text qualified as Text+import Test.Tasty+import Test.Tasty.HUnit++import Doxygen.Parser+import Test.Doxygen.Parser.Helpers++tests :: [TestTree]+tests =+ [ testCase "brief and detailed" $ do+ let (ws, mc) = parseCommentFromXML (mkCommentXML "Brief text" "Detailed text")+ ws @?= []+ case mc of+ Just c -> do+ c.brief @?= [Text "Brief text"]+ length c.detailed @?= 1+ Nothing -> assertFailure "expected a comment"++ , testCase "brief only" $ do+ let (_, mc) = parseCommentFromXML (mkCommentXML "Brief only" "")+ case mc of+ Just c -> do+ c.brief @?= [Text "Brief only"]+ c.detailed @?= []+ Nothing -> assertFailure "expected a comment"++ , testCase "detailed only" $ do+ let (_, mc) = parseCommentFromXML (mkCommentXML "" "Detailed only")+ case mc of+ Just c -> do+ c.brief @?= []+ length c.detailed @?= 1+ Nothing -> assertFailure "expected a comment"++ , testCase "empty descriptions produce Nothing" $ do+ let (_, mc) = parseCommentFromXML (mkCommentXML "" "")+ mc @?= Nothing++ , testCase "brief with inline formatting" $ do+ let xml = Text.concat+ [ "<root>"+ , " <briefdescription>"+ , " <para>Use <computeroutput>foo</computeroutput> for bar</para>"+ , " </briefdescription>"+ , " <detaileddescription></detaileddescription>"+ , "</root>"+ ]+ let (_, mc) = parseCommentFromXML xml+ case mc of+ Just c ->+ assertBool "should have mono inline" $+ any (\case Mono _ -> True; _ -> False) c.brief+ Nothing -> assertFailure "expected a comment"++ , testCase "multiple paragraphs in detailed" $ do+ let (_, mc) = parseCommentFromXML $ Text.concat+ [ "<root>"+ , " <briefdescription></briefdescription>"+ , " <detaileddescription>"+ , " <para>First paragraph</para>"+ , " <para>Second paragraph</para>"+ , " </detaileddescription>"+ , "</root>"+ ]+ case mc of+ Just c -> length c.detailed @?= 2+ Nothing -> assertFailure "expected a comment"+ ]
+ test/Test/Doxygen/Parser/Helpers.hs view
@@ -0,0 +1,215 @@+{-# LANGUAGE LambdaCase #-}++-- | Shared XML-builder and assertion helpers for the test suite.+module Test.Doxygen.Parser.Helpers (+ -- * XML parsing+ mkCursor+ , parseBlockFromXML+ , parseCommentFromXML+ , parseInlinesFromXML+ , wrap+ -- * Assertion combinators+ , inlineShouldBe+ , blockShouldMatch+ , shouldWarnAbout+ -- * XML builders for parameterlist+ , mkParamListXML+ , mkCommentXML+ -- * XML builders for entity extraction+ , mkDoxygen+ , mkCompound+ , mkSection+ , mkMember+ , mkEnumVal+ , withExtractedEntity+ -- * Re-exports for tests that consume entity-extraction results+ , XMLFileResult (..)+ ) where++import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Lazy qualified as LText+import Test.Tasty.HUnit+import Text.XML qualified as XML+import Text.XML.Cursor (Cursor)+import Text.XML.Cursor qualified as Cursor++import Doxygen.Parser+import Doxygen.Parser.Internal (ChildAction (..), XMLFileResult (..),+ extractBriefAndDetail, extractEntity,+ forChildren, parseBlockElement,+ parseInlineChildren)++{-------------------------------------------------------------------------------+ Test helpers: XML parsing+-------------------------------------------------------------------------------}++-- | Parse a raw XML string into a cursor pointing at the root element+mkCursor :: Text -> Cursor+mkCursor xml =+ Cursor.fromDocument $ XML.parseText_ XML.def (LText.fromStrict xml)++-- | Parse all children of @\<root\>@ as block elements+parseBlockFromXML :: Text -> ([Warning], [Block DoxyRef])+parseBlockFromXML xml =+ let root = mkCursor xml+ pairs = map parseBlockElement (Cursor.child root)+ in (concatMap fst pairs, concatMap snd pairs)++-- | Parse comment from an XML element with brief/detailed descriptions+parseCommentFromXML :: Text -> ([Warning], Maybe (Comment DoxyRef))+parseCommentFromXML xml =+ let cursor = mkCursor xml+ (_warns, parts) = forChildren "root" (Cursor.child cursor) $ \n c ->+ case n of+ "briefdescription" -> Just (Yield (Left c))+ "detaileddescription" -> Just (Yield (Right c))+ _ -> Just Skip+ briefDescs = [c | Left c <- parts]+ detailDescs = [c | Right c <- parts]+ in extractBriefAndDetail briefDescs detailDescs++-- | Parse inline children of the root element+parseInlinesFromXML :: Text -> ([Warning], [Inline DoxyRef])+parseInlinesFromXML xml = parseInlineChildren (mkCursor xml)++-- | Wrap content in a root element+wrap :: Text -> Text+wrap content = "<root>" <> content <> "</root>"++{-------------------------------------------------------------------------------+ Test helpers: assertion combinators+-------------------------------------------------------------------------------}++-- | Assert that parsing an inline XML fragment produces the expected inlines+-- with no warnings.+inlineShouldBe :: Text -> [Inline DoxyRef] -> Assertion+inlineShouldBe xml expected = do+ let (ws, is) = parseInlinesFromXML (wrap xml)+ ws @?= []+ is @?= expected++-- | Assert that parsing a block XML fragment produces a single block matching+-- the predicate, with no warnings.+blockShouldMatch :: Text -> (Block DoxyRef -> Assertion) -> Assertion+blockShouldMatch xml check = do+ let (ws, bs) = parseBlockFromXML (wrap xml)+ ws @?= []+ case bs of+ [b] -> check b+ _ -> assertFailure $ "expected exactly 1 block, got: " ++ show bs++-- | Assert that warnings contain exactly one warning with the given structural+-- context and element name.+shouldWarnAbout :: [Warning] -> Text -> Text -> Assertion+shouldWarnAbout ws parentCtx elemName = do+ let filtered = filter (\w -> w.context == StructureLevel parentCtx) ws+ case filtered of+ [w] -> w.element @?= elemName+ _ -> assertFailure $+ "expected 1 " ++ Text.unpack parentCtx+ ++ " warning about " ++ Text.unpack elemName+ ++ ", got: " ++ show filtered++{-------------------------------------------------------------------------------+ Test helpers: XML builders for parameterlist+-------------------------------------------------------------------------------}++-- | Build a @\<parameterlist\>@ XML fragment.+mkParamListXML :: Text -> [(Maybe Text, Text, Text)] -> Text+mkParamListXML kind params = Text.concat $+ ["<parameterlist kind=\"", kind, "\">"]+ ++ concatMap mkItem params+ ++ ["</parameterlist>"]+ where+ mkItem (mDir, name, desc) =+ [ Text.concat+ [ "<parameteritem>"+ , " <parameternamelist>"+ , " <parametername", dirAttr mDir, ">", name, "</parametername>"+ , " </parameternamelist>"+ , " <parameterdescription><para>", desc, "</para></parameterdescription>"+ , "</parameteritem>"+ ]+ ]++ dirAttr Nothing = ""+ dirAttr (Just dir) = " direction=\"" <> dir <> "\""++-- | Build a comment XML element with brief and detailed descriptions.+mkCommentXML :: Text -> Text -> Text+mkCommentXML brief detailed = Text.concat+ [ "<root>"+ , " <briefdescription>", wrapPara brief, "</briefdescription>"+ , " <detaileddescription>", wrapPara detailed, "</detaileddescription>"+ , "</root>"+ ]++{-------------------------------------------------------------------------------+ Test helpers: XML builders for entity extraction+-------------------------------------------------------------------------------}++-- | Wrap compound definitions in a @\<doxygen\>@ root.+mkDoxygen :: Text -> Text+mkDoxygen body = "<doxygen>" <> body <> "</doxygen>"++-- | Build a @\<compounddef\>@ with brief description and body content.+mkCompound :: Text -> Text -> Text -> Text -> Text -> Text+mkCompound kind cid name brief body = Text.concat+ [ "<compounddef kind=\"", kind, "\" id=\"", cid, "\">"+ , "<compoundname>", name, "</compoundname>"+ , "<briefdescription>", wrapPara brief, "</briefdescription>"+ , "<detaileddescription></detaileddescription>"+ , body+ , "</compounddef>"+ ]++-- | Build a @\<sectiondef\>@.+mkSection :: Text -> Text -> Text+mkSection kind body = Text.concat+ [ "<sectiondef kind=\"", kind, "\">"+ , body+ , "</sectiondef>"+ ]++-- | Build a @\<memberdef\>@ with brief description and optional body content.+mkMember :: Text -> Text -> Text -> Text -> Text -> Text+mkMember kind mid name brief body = Text.concat+ [ "<memberdef kind=\"", kind, "\" id=\"", mid, "\">"+ , "<name>", name, "</name>"+ , "<briefdescription>", wrapPara brief, "</briefdescription>"+ , "<detaileddescription></detaileddescription>"+ , body+ , "</memberdef>"+ ]++-- | Wrap text in a @\<para\>@; empty input produces empty output (so an empty+-- @\<para\>\</para\>@ is dropped by the parser, matching the real-world+-- shape of @doxygen@ XML).+wrapPara :: Text -> Text+wrapPara "" = ""+wrapPara t = "<para>" <> t <> "</para>"++-- | Build an @\<enumvalue\>@.+mkEnumVal :: Text -> Text -> Text -> Text -> Text+mkEnumVal evid name brief body = Text.concat+ [ "<enumvalue id=\"", evid, "\">"+ , "<name>", name, "</name>"+ , "<briefdescription><para>", brief, "</para></briefdescription>"+ , "<detaileddescription></detaileddescription>"+ , body+ , "</enumvalue>"+ ]++-- | Parse a @\<compounddef\>@ from XML and run assertions on the result.+withExtractedEntity :: Text -> (XMLFileResult -> Assertion) -> Assertion+withExtractedEntity xml check = do+ let doc = XML.parseText_ XML.def (LText.fromStrict xml)+ root = Cursor.fromDocument doc+ let (_warns, cds) = forChildren "doxygen" (Cursor.child root) $ \n c ->+ case n of+ "compounddef" -> Just (Yield c)+ _ -> Just Skip+ case cds of+ [] -> assertFailure "no compounddef found"+ (cd:_) -> check (extractEntity cd)
+ test/Test/Doxygen/Parser/InlineNesting.hs view
@@ -0,0 +1,37 @@+module Test.Doxygen.Parser.InlineNesting (tests) where++import Test.Tasty+import Test.Tasty.HUnit++import Doxygen.Parser+import Test.Doxygen.Parser.Helpers++tests :: [TestTree]+tests =+ [ testCase "bold inside emphasis" $+ "<emphasis><bold>text</bold></emphasis>"+ `inlineShouldBe` [Emph [Bold [Text "text"]]]+ , testCase "code inside bold" $+ "<bold><computeroutput>code</computeroutput></bold>"+ `inlineShouldBe` [Bold [Mono [Text "code"]]]+ , testCase "3-deep nesting: bold > emphasis > mono" $+ "<bold><emphasis><computeroutput>deep</computeroutput></emphasis></bold>"+ `inlineShouldBe` [Bold [Emph [Mono [Text "deep"]]]]+ , testCase "nested emphasis" $+ "<emphasis>outer <emphasis>inner</emphasis> outer</emphasis>"+ `inlineShouldBe`+ [Emph [Text "outer ", Emph [Text "inner"], Text " outer"]]+ , testCase "ref inside emphasis" $+ "<emphasis><ref refid=\"x\">name</ref></emphasis>"+ `inlineShouldBe` [Emph [Ref (DoxyRef "name" Nothing) "name"]]+ , testCase "link inside bold" $+ "<bold><ulink url=\"http://x\">text</ulink></bold>"+ `inlineShouldBe` [Bold [Link [Text "text"] "http://x"]]+ , testCase "mixed siblings: text + bold + text + emphasis" $+ "Hello <bold>world</bold> and <emphasis>more</emphasis>!"+ `inlineShouldBe`+ [ Text "Hello ", Bold [Text "world"]+ , Text " and ", Emph [Text "more"]+ , Text "!"+ ]+ ]
+ test/Test/Doxygen/Parser/InlineParsing.hs view
@@ -0,0 +1,57 @@+module Test.Doxygen.Parser.InlineParsing (tests) where++import Test.Tasty+import Test.Tasty.HUnit++import Doxygen.Parser+import Test.Doxygen.Parser.Helpers++tests :: [TestTree]+tests =+ [ testCase "plain text" $+ "hello" `inlineShouldBe` [Text "hello"]+ , testCase "bold" $+ "<bold>text</bold>" `inlineShouldBe` [Bold [Text "text"]]+ , testCase "emphasis" $+ "<emphasis>text</emphasis>" `inlineShouldBe` [Emph [Text "text"]]+ , testCase "computeroutput" $+ "<computeroutput>code</computeroutput>" `inlineShouldBe` [Mono [Text "code"]]+ , testCase "ref without kindref" $+ "<ref refid=\"abc\">my_func</ref>" `inlineShouldBe` [Ref (DoxyRef "my_func" Nothing) "my_func"]+ , testCase "ref with kindref compound" $+ "<ref refid=\"structfoo\" kindref=\"compound\">foo</ref>"+ `inlineShouldBe` [Ref (DoxyRef "foo" (Just RefCompound)) "foo"]+ , testCase "ref with kindref member" $+ "<ref refid=\"file_1abc\" kindref=\"member\">bar</ref>"+ `inlineShouldBe` [Ref (DoxyRef "bar" (Just RefMember)) "bar"]+ , testCase "anchor" $+ "<anchor id=\"foo\"/>" `inlineShouldBe` [Anchor "foo"]+ , testCase "ulink" $+ "<ulink url=\"http://example.com\">click</ulink>"+ `inlineShouldBe` [Link [Text "click"] "http://example.com"]+ , testCase "linebreak" $+ "<linebreak/>" `inlineShouldBe` [Text "\n"]+ , testCase "sp" $+ "<sp/>" `inlineShouldBe` [Text " "]+ , testCase "empty bold" $+ "<bold></bold>" `inlineShouldBe` [Bold []]+ , testCase "empty emphasis" $+ "<emphasis></emphasis>" `inlineShouldBe` [Emph []]++ , testCase "special XML characters" $+ "a < b & c > d" `inlineShouldBe` [Text "a < b & c > d"]++ , testCase "unknown inline degrades to text" $ do+ let (ws, is) = parseInlinesFromXML (wrap "<subscript>x</subscript>")+ case ws of+ [w] -> do+ w.context @?= InlineLevel+ w.degradation @?= DegradedToText+ _ -> assertFailure $ "expected 1 warning, got: " ++ show ws+ is @?= [Text "x"]++ , testCase "unknown inline with empty text" $ do+ let (ws, is) = parseInlinesFromXML (wrap "<subscript/>")+ length ws @?= 1+ is @?= []+ ]
+ test/Test/Doxygen/Parser/List.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE LambdaCase #-}++module Test.Doxygen.Parser.List (tests) where++import Test.Tasty+import Test.Tasty.HUnit++import Doxygen.Parser+import Test.Doxygen.Parser.Helpers++tests :: [TestTree]+tests =+ [ testCase "itemized list" $+ blockShouldMatch+ ("<itemizedlist>"+ <> "<listitem><para>First</para></listitem>"+ <> "<listitem><para>Second</para></listitem>"+ <> "</itemizedlist>") $+ \case+ ItemizedList items -> length items @?= 2+ b -> assertFailure $ "expected itemized list: " ++ show b++ , testCase "ordered list" $+ blockShouldMatch+ ("<orderedlist>"+ <> "<listitem><para>First</para></listitem>"+ <> "<listitem><para>Second</para></listitem>"+ <> "<listitem><para>Third</para></listitem>"+ <> "</orderedlist>") $+ \case+ OrderedList items -> length items @?= 3+ b -> assertFailure $ "expected ordered list: " ++ show b++ , testCase "nested lists" $+ blockShouldMatch+ ("<itemizedlist>"+ <> "<listitem>"+ <> " <para>Outer</para>"+ <> " <itemizedlist>"+ <> " <listitem><para>Inner</para></listitem>"+ <> " </itemizedlist>"+ <> "</listitem>"+ <> "</itemizedlist>") $+ \case+ ItemizedList [item] ->+ assertBool "should have nested list" $+ any (\case ItemizedList _ -> True; _ -> False) item+ b -> assertFailure $ "expected nested list: " ++ show b++ , testCase "list item with formatted content" $+ blockShouldMatch+ ("<itemizedlist>"+ <> "<listitem><para>Use <bold>this</bold> function</para></listitem>"+ <> "</itemizedlist>") $+ \case+ ItemizedList [[Paragraph is]] ->+ assertBool "should have bold" $+ any (\case Bold _ -> True; _ -> False) is+ b -> assertFailure $ "unexpected: " ++ show b+ ]
+ test/Test/Doxygen/Parser/NormalizeWhitespace.hs view
@@ -0,0 +1,18 @@+module Test.Doxygen.Parser.NormalizeWhitespace (tests) where++import Test.Tasty+import Test.Tasty.HUnit++import Doxygen.Parser.Internal (normalizeWhitespace)++tests :: [TestTree]+tests =+ [ testCase "plain text" $ normalizeWhitespace "hello" @?= "hello"+ , testCase "preserves trailing space" $ normalizeWhitespace "hello " @?= "hello "+ , testCase "preserves leading space" $ normalizeWhitespace " hello" @?= " hello"+ , testCase "preserves both" $ normalizeWhitespace " hello " @?= " hello "+ , testCase "collapses internal whitespace" $ normalizeWhitespace "hello world" @?= "hello world"+ , testCase "collapses newlines" $ normalizeWhitespace "hello\n world" @?= "hello world"+ , testCase "leading newline becomes space" $ normalizeWhitespace "\n hello" @?= " hello"+ , testCase "trailing newline becomes space" $ normalizeWhitespace "hello\n" @?= "hello "+ ]
+ test/Test/Doxygen/Parser/Param.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE LambdaCase #-}++module Test.Doxygen.Parser.Param (tests) where++import Data.Text (Text)+import Data.Text qualified as Text+import Test.Tasty+import Test.Tasty.HUnit++import Doxygen.Parser+import Test.Doxygen.Parser.Helpers++tests :: [TestTree]+tests =+ [ mkParamTest "param with direction=in" (Just "in") "x" (Just DirIn)+ , mkParamTest "param with direction=out" (Just "out") "result" (Just DirOut)+ , mkParamTest "param with direction=inout" (Just "inout") "buf" (Just DirInOut)+ , mkParamTest "param with no direction" Nothing "x" Nothing++ , testCase "param with empty description" $+ blockShouldMatch (mkParamListXML "param" [(Nothing, "x", "")]) $+ \case+ -- Empty <para> in description is dropped, so paramDesc is empty+ -- (the mkParamListXML wraps desc in <para>, but empty text+ -- produces an empty paragraph which is dropped)+ ParamList _ [_p] -> pure ()+ b -> assertFailure $ "unexpected: " ++ show b++ , testCase "param with missing name is skipped" $ do+ let xml = wrap $ Text.concat+ [ "<parameterlist kind=\"param\">"+ , "<parameteritem>"+ , " <parameternamelist></parameternamelist>"+ , " <parameterdescription><para>Desc</para></parameterdescription>"+ , "</parameteritem>"+ , "</parameterlist>"+ ]+ let (_, bs) = parseBlockFromXML xml+ case bs of+ [ParamList _ params] ->+ length params @?= 0+ _ -> assertFailure $ "unexpected: " ++ show bs++ , testCase "multiple params" $+ blockShouldMatch+ (mkParamListXML "param"+ [ (Nothing, "a", "First")+ , (Nothing, "b", "Second")+ ]) $+ \case+ ParamList _ params -> length params @?= 2+ b -> assertFailure $ "unexpected: " ++ show b+ ]+ where+ mkParamTest :: String -> Maybe Text -> Text -> Maybe ParamDirection -> TestTree+ mkParamTest name mDir paramName expectedDir =+ testCase name $+ blockShouldMatch (mkParamListXML "param" [(mDir, paramName, "Desc")]) $+ \case+ ParamList _ [p] -> p.paramDirection @?= expectedDir+ b -> assertFailure $ "unexpected: " ++ show b
+ test/Test/Doxygen/Parser/Properties.hs view
@@ -0,0 +1,24 @@+module Test.Doxygen.Parser.Properties (tests) where++import Data.Text qualified as Text+import Test.QuickCheck ((===))+import Test.QuickCheck qualified as QC+import Test.Tasty+import Test.Tasty.QuickCheck (testProperty)++import Doxygen.Parser.Internal (normalizeWhitespace)++tests :: [TestTree]+tests =+ [ testProperty "normalizeWhitespace is idempotent" $ \(QC.PrintableString s) ->+ let t = Text.pack s+ in normalizeWhitespace (normalizeWhitespace t) === normalizeWhitespace t++ , testProperty "normalizeWhitespace: no internal double spaces" $+ \(QC.PrintableString s) ->+ let t = Text.pack s+ result = normalizeWhitespace t+ -- Strip the (at most one) leading and trailing space+ interior = Text.dropWhileEnd (== ' ') $ Text.dropWhile (== ' ') result+ in not (Text.isInfixOf " " interior)+ ]
+ test/Test/Doxygen/Parser/SimpleSect.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE LambdaCase #-}++module Test.Doxygen.Parser.SimpleSect (tests) where++import Data.Text (Text)+import Data.Text qualified as Text+import Test.Tasty+import Test.Tasty.HUnit++import Doxygen.Parser+import Test.Doxygen.Parser.Helpers++tests :: [TestTree]+tests =+ [ mkSimpleSectTest "return" SSReturn+ , mkSimpleSectTest "warning" SSWarning+ , mkSimpleSectTest "note" SSNote+ , mkSimpleSectTest "see" SSSee+ , mkSimpleSectTest "since" SSSince+ , mkSimpleSectTest "version" SSVersion+ , mkSimpleSectTest "pre" SSPre+ , mkSimpleSectTest "post" SSPost+ , mkSimpleSectTest "deprecated" SSDeprecated+ , mkSimpleSectTest "remark" SSRemark+ , mkSimpleSectTest "attention" SSAttention+ , mkSimpleSectTest "todo" SSTodo+ , mkSimpleSectTest "invariant" SSInvariant+ , mkSimpleSectTest "author" SSAuthor+ , mkSimpleSectTest "date" SSDate++ , testCase "par with title" $+ blockShouldMatch+ ("<simplesect kind=\"par\">"+ <> "<title>My Title</title>"+ <> "<para>Content</para>"+ <> "</simplesect>") $+ \case+ SimpleSect (SSPar title) _ -> title @?= "My Title"+ b -> assertFailure $ "expected SSPar: " ++ show b++ , testCase "unknown kind defaults to SSNote with warning" $ do+ let (ws, bs) = parseBlockFromXML+ (wrap "<simplesect kind=\"bogus\"><para>X</para></simplesect>")+ case ws of+ [w] -> do+ w.context @?= UnknownSectKind+ w.degradation @?= DefaultedTo "Note"+ _ -> assertFailure $ "expected 1 warning, got: " ++ show ws+ case bs of+ [SimpleSect SSNote _] -> pure ()+ _ -> assertFailure $ "expected SSNote: " ++ show bs++ , testCase "missing kind defaults to SSNote with warning" $ do+ let (ws, bs) = parseBlockFromXML+ (wrap "<simplesect><para>X</para></simplesect>")+ case ws of+ [w] -> w.context @?= UnknownSectKind+ _ -> assertFailure $ "expected 1 warning, got: " ++ show ws+ case bs of+ [SimpleSect SSNote _] -> pure ()+ _ -> assertFailure $ "expected SSNote: " ++ show bs+ ]++mkSimpleSectTest :: Text -> SimpleSectKind -> TestTree+mkSimpleSectTest kindAttr expected =+ testCase (Text.unpack kindAttr) $+ blockShouldMatch+ ("<simplesect kind=\"" <> kindAttr <> "\"><para>Content</para></simplesect>") $+ \case+ SimpleSect k _ -> k @?= expected+ b -> assertFailure $ "expected simplesect: " ++ show b
+ test/Test/Doxygen/Parser/StructuralWarnings.hs view
@@ -0,0 +1,62 @@+module Test.Doxygen.Parser.StructuralWarnings (tests) where++import Data.Text qualified as Text+import Test.Tasty+import Test.Tasty.HUnit++import Doxygen.Parser+import Test.Doxygen.Parser.Helpers++tests :: [TestTree]+tests =+ [ testCase "unknown briefdescription child warns" $ do+ let xml = Text.concat+ [ "<root>"+ , " <briefdescription>"+ , " <para>Normal para</para>"+ , " <bogus>unexpected</bogus>"+ , " </briefdescription>"+ , " <detaileddescription></detaileddescription>"+ , "</root>"+ ]+ (ws, mc) = parseCommentFromXML xml+ assertBool "should still produce a comment" $ mc /= Nothing+ shouldWarnAbout ws "briefdescription" "bogus"++ , testCase "unknown parameteritem child warns" $ do+ let (ws, _) = parseBlockFromXML $ wrap $ Text.concat+ [ "<parameterlist kind=\"param\">"+ , " <parameteritem>"+ , " <parameternamelist>"+ , " <parametername direction=\"in\">x</parametername>"+ , " </parameternamelist>"+ , " <parameterdescription><para>The input.</para></parameterdescription>"+ , " <alien/>"+ , " </parameteritem>"+ , "</parameterlist>"+ ]+ shouldWarnAbout ws "parameteritem" "alien"++ , testCase "unknown programlisting child warns" $ do+ let (ws, bs) = parseBlockFromXML $ wrap $ Text.concat+ [ "<programlisting>"+ , " <codeline><highlight class=\"normal\">code</highlight></codeline>"+ , " <bogus/>"+ , "</programlisting>"+ ]+ shouldWarnAbout ws "programlisting" "bogus"+ case bs of+ [CodeBlock lines'] -> length lines' @?= 1+ _ -> assertFailure $ "expected CodeBlock: " ++ show bs++ , testCase "unknown codeline child warns" $ do+ let (ws, _) = parseBlockFromXML $ wrap $ Text.concat+ [ "<programlisting>"+ , " <codeline>"+ , " <highlight class=\"normal\">code</highlight>"+ , " <mystery/>"+ , " </codeline>"+ , "</programlisting>"+ ]+ shouldWarnAbout ws "codeline" "mystery"+ ]
+ test/Test/Doxygen/Parser/Whitespace.hs view
@@ -0,0 +1,38 @@+module Test.Doxygen.Parser.Whitespace (tests) where++import Test.Tasty+import Test.Tasty.HUnit++import Doxygen.Parser+import Test.Doxygen.Parser.Helpers++tests :: [TestTree]+tests =+ [ testCase "space between text and bold is preserved" $+ "Hello <bold>world</bold>"+ `inlineShouldBe` [Text "Hello ", Bold [Text "world"]]++ , testCase "space after bold is preserved" $+ "<bold>word</bold> rest"+ `inlineShouldBe` [Bold [Text "word"], Text " rest"]++ , testCase "inter-element spacing in sentence" $+ "Use <computeroutput>foo</computeroutput> for bar"+ `inlineShouldBe` [Text "Use ", Mono [Text "foo"], Text " for bar"]++ , testCase "whitespace-only text node is normalized to space" $+ " " `inlineShouldBe` [Text " "]+ , testCase "newline-only text is normalized to space" $+ "\n \n" `inlineShouldBe` [Text " "]+ , testCase "unicode content preserved" $+ "caf\233 na\239ve" `inlineShouldBe` [Text "caf\233 na\239ve"]++ , testCase "whitespace between sibling inline elements in para" $ do+ let (ws, bs) = parseBlockFromXML+ (wrap "<para><bold>a</bold> <emphasis>b</emphasis></para>")+ ws @?= []+ case bs of+ [Paragraph inlines] ->+ inlines @?= [Bold [Text "a"], Text " ", Emph [Text "b"]]+ _ -> assertFailure $ "unexpected: " ++ show bs+ ]
+ test/Test/Doxygen/Parser/XMLFileResult.hs view
@@ -0,0 +1,118 @@+module Test.Doxygen.Parser.XMLFileResult (tests) where++import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import Test.Tasty+import Test.Tasty.HUnit++import Doxygen.Parser+import Test.Doxygen.Parser.Helpers++tests :: [TestTree]+tests =+ [ testCase "struct compound extracts struct doc and field docs" $+ withExtractedEntity+ (mkDoxygen $ mkCompound "struct" "structfoo" "foo_t" "A foo struct" $+ mkSection "public-attrib" $ Text.concat+ [ mkMember "variable" "field_x" "x" "X coordinate" ""+ , mkMember "variable" "field_y" "y" "Y coordinate" ""+ ]) $ \result -> do+ assertBool "should have struct doc" $+ Map.member (KeyStruct "foo_t") result.comments+ assertBool "should have field x" $+ Map.member (KeyField "foo_t" "x") result.comments+ assertBool "should have field y" $+ Map.member (KeyField "foo_t" "y") result.comments++ , testCase "group compound extracts title and member docs" $+ withExtractedEntity+ (mkDoxygen $ mkCompound "group" "group__core" "core" "" $+ "<title>Core Functions</title>"+ <> mkSection "func"+ (mkMember "function" "func_init" "init" "Initialize" "")+ ) $ \result -> do+ result.groupTitles @?= [("core", "Core Functions")]+ assertBool "should have init decl" $+ Map.member (KeyDecl "init") result.comments++ , testCase "enum member extracts enum value docs" $+ withExtractedEntity+ (mkDoxygen $ mkCompound "file" "myfile_8h" "myfile.h" "" $+ mkSection "enum" $+ mkMember "enum" "enum_color" "color_t" "A color enum" $ Text.concat+ [ mkEnumVal "ev_red" "RED" "Red color" ""+ , mkEnumVal "ev_blue" "BLUE" "Blue color" ""+ ]+ ) $ \result -> do+ assertBool "should have color_t decl" $+ Map.member (KeyDecl "color_t") result.comments+ assertBool "should have RED" $+ Map.member (KeyEnumValue "color_t" "RED") result.comments+ assertBool "should have BLUE" $+ Map.member (KeyEnumValue "color_t" "BLUE") result.comments++ , testCase "known-but-ignored compounddef children produce no warnings" $+ withExtractedEntity+ (mkDoxygen $ mkCompound "struct" "structbar" "bar_t" "A bar struct" $+ "<location file=\"test.h\" line=\"1\"/>"+ <> "<includes refid=\"test_8h\">test.h</includes>"+ ) $ \result -> do+ assertBool "should have struct doc" $+ Map.member (KeyStruct "bar_t") result.comments+ result.warnings @?= []++ , testCase "truly unknown compounddef children emit warnings" $+ withExtractedEntity+ (mkDoxygen $ mkCompound "struct" "structbar" "bar_t" "A bar struct"+ "<nonstandard>unexpected content</nonstandard>"+ ) $ \result -> do+ assertBool "should have struct doc" $+ Map.member (KeyStruct "bar_t") result.comments+ shouldWarnAbout result.warnings "compounddef" "nonstandard"+ case result.warnings of+ [w] -> w.degradation @?= Omitted+ _ -> assertFailure $ "expected 1 warning, got: " ++ show result.warnings++ , testCase "unknown memberdef children emit warnings" $+ withExtractedEntity+ (mkDoxygen $ mkCompound "group" "group__test" "test" "" $+ mkSection "func" $+ mkMember "function" "test_1" "foo" "A function"+ "<type>void</type><bogus_tag>unexpected</bogus_tag>"+ ) $ \result -> do+ assertBool "should have decl doc" $+ Map.member (KeyDecl "foo") result.comments+ shouldWarnAbout result.warnings "memberdef" "bogus_tag"++ , testCase "unknown sectiondef children emit warnings" $+ withExtractedEntity+ (mkDoxygen $ mkCompound "group" "group__test" "test" "" $+ mkSection "func" $+ mkMember "function" "test_1" "bar" "A function" ""+ <> "<unexpected_child/>"+ ) $ \result ->+ shouldWarnAbout result.warnings "sectiondef" "unexpected_child"++ , testCase "unknown enumvalue children emit warnings" $+ withExtractedEntity+ (mkDoxygen $ mkCompound "group" "group__test" "test" "" $+ mkSection "enum" $+ mkMember "enum" "test_1" "color_t" "Colors" $+ mkEnumVal "ev1" "RED" "Red"+ "<initializer>= 0</initializer><alien_element/>"+ ) $ \result -> do+ assertBool "should have enum value doc" $+ Map.member (KeyEnumValue "color_t" "RED") result.comments+ shouldWarnAbout result.warnings "enumvalue" "alien_element"++ , testCase "compounddef with no compoundname produces empty result" $+ withExtractedEntity (Text.concat+ [ "<doxygen>"+ , "<compounddef kind=\"struct\" id=\"structempty\">"+ , " <briefdescription><para>Orphaned doc</para></briefdescription>"+ , " <detaileddescription></detaileddescription>"+ , "</compounddef>"+ , "</doxygen>"+ ]) $ \result ->+ result.comments @?= Map.empty+ ]