packages feed

hs-bindgen-1.0.0.0: src-internal/HsBindgen/Frontend/Pass/EnrichComments.hs

-- | Enrich parsed declarations with doxygen comments
--
-- Post-processing step after @EnrichComments@: looks up each declaration's
-- comment in the 'Doxygen' state and fills in @DeclInfo.comment@ and
-- per-field comments.
--
-- === Doxygen nesting
--
-- Doxygen and libclang see nested structs differently. Given:
--
-- @
-- struct outer {
--     struct inner {
--         int x;
--         struct {
--             int a;
--             struct inner_inner_inner {
--                 int c;
--             };
--         } inner_inner;
--     } field;
--     int z;
-- };
-- @
--
-- Doxygen produces one XML file per named compound, using @\"::\"@-qualified
-- names. Named nested structs get their own file; untagged structs are
-- flattened into the nearest named enclosing struct:
--
-- @
-- \<!-- outer.xml -->
-- \<compounddef kind=\"struct\">
--   \<compoundname>outer\</compoundname>
--   \<sectiondef kind=\"public-attrib\">
--     \<memberdef kind=\"variable\">\<name>field\</name>\</memberdef>
--     \<memberdef kind=\"variable\">\<name>z\</name>\</memberdef>
--   \</sectiondef>
-- \</compounddef>
--
-- \<!-- outer::inner.xml — note: field \"a\" is flattened from the untagged struct -->
-- \<compounddef kind=\"struct\">
--   \<compoundname>outer::inner\</compoundname>
--   \<sectiondef kind=\"public-attrib\">
--     \<memberdef kind=\"variable\">\<name>x\</name>\</memberdef>
--     \<memberdef kind=\"variable\">\<name>a\</name>\</memberdef>
--     \<memberdef kind=\"variable\">\<name>inner_inner\</name>\</memberdef>
--   \</sectiondef>
-- \</compounddef>
--
-- \<!-- outer::inner::inner_inner_inner.xml -->
-- \<compounddef kind=\"struct\">
--   \<compoundname>outer::inner::inner_inner_inner\</compoundname>
--   \<sectiondef kind=\"public-attrib\">
--     \<memberdef kind=\"variable\">\<name>c\</name>\</memberdef>
--   \</sectiondef>
-- \</compounddef>
-- @
--
-- The @doxygen-parser@ library turns this into a
-- @'Map' 'DoxygenKey' ('Comment' 'Text')@ with keys like:
--
-- @
-- KeyStruct \"outer\"                                 -- compound doc
-- KeyField  \"outer\" \"field\"                       -- field doc
-- KeyStruct \"outer::inner\"                          -- compound doc
-- KeyField  \"outer::inner\" \"x\"                    -- field doc
-- KeyField  \"outer::inner\" \"a\"                    -- flattened from untagged
-- KeyField  \"outer::inner\" \"inner_inner\"          -- untagged struct's doc
-- KeyStruct \"outer::inner::inner_inner_inner\"       -- compound doc
-- KeyField  \"outer::inner::inner_inner_inner\" \"c\" -- field doc
-- @
--
-- === Lookup algorithm
--
-- Each 'DeclInfo' carries @enclosing@: the list of enclosing declarations
-- (innermost first), set during parsing.
--
-- __Named declarations__ ('lookupCommentForId'): 'resolveQualifiedName'
-- reverses the @enclosing@ list, collects named ancestors (skipping
-- unnamed ones), and joins with @\"::\"@.  Then we look up
-- @'KeyDecl' qualName \<|\> 'KeyStruct' qualName@.
--
--  * @inner_inner_inner@ → enclosing list @[\<unnamed>, inner, outer]@, skip
--    unnamed → @\"outer::inner::inner_inner_inner\"@
--
-- Unnamed declarations have no doxygen comment of their own: doxygen
-- associates the comment with the enclosing field, which we pick up via
-- 'enrichStructField'\/'enrichUnionField' below.
--
-- __Fields__ ('enrichStructField', etc.): look up directly with
-- @'KeyField' enclosingQualName fieldName@ (or 'KeyEnumValue').
--
module HsBindgen.Frontend.Pass.EnrichComments (enrichComments) where

import Control.Applicative ((<|>))
import Data.Text qualified as Text

import HsBindgen.Frontend.Pass.EnrichComments.IsPass (EnrichComments)
import HsBindgen.Frontend.Pass.FillUnnamedIds.IsPass (FillUnnamedIds)
import HsBindgen.Frontend.Pass.Parse.Result
import HsBindgen.Imports
import HsBindgen.IR.C qualified as C
import HsBindgen.IR.Pass

import Doxygen.Parser (Doxygen, DoxygenKey (..), lookupComment)
import Doxygen.Parser.Types qualified as Doxy

{-------------------------------------------------------------------------------
  Top-level
-------------------------------------------------------------------------------}

-- | Enrich parsed declarations with doxygen comments
enrichComments ::
     forall l. Doxygen
  -> [ParseResult l FillUnnamedIds ]
  -> [ParseResult l EnrichComments]
enrichComments doxy results =
    map enrichOne coerced
  where
    -- Coerce input to 'EnrichComments' before enrichment. The coercion sets
    -- every @comment@ field to 'Nothing' (since 'CommentDecl FillUnnamedIds'
    -- is @()@ and 'CommentDecl EnrichComments' is @Maybe (Comment EnrichComments)@)
    -- via 'CoercePassCommentDecl'. We then fill in comments by looking up the
    -- doxygen state.
    coerced :: [ParseResult l EnrichComments]
    coerced = map coercePass results

    enrichOne :: ParseResult l EnrichComments -> ParseResult l EnrichComments
    enrichOne pr = case pr.classification of
      ParseResultSuccess success ->
        let decl' = enrichDecl doxy success.decl
        in  pr { classification =
                    ParseResultSuccess success { decl = decl' }
               }
      _ -> pr

{-------------------------------------------------------------------------------
  Declaration-level enrichment
-------------------------------------------------------------------------------}

enrichDecl ::
     Doxygen
  -> C.Decl l EnrichComments
  -> C.Decl l EnrichComments
enrichDecl doxy decl =
    decl & #info %~ enrichDeclInfo doxy
         & #kind %~ enrichDeclKind doxy effectiveEnclosing
  where
    -- Doxygen-qualified name for field lookups (e.g., @\"outer::inner\"@)
    effectiveEnclosing :: Text
    effectiveEnclosing = resolveQualifiedName decl.info

enrichDeclInfo ::
     Doxygen
  -> C.DeclInfo EnrichComments
  -> C.DeclInfo EnrichComments
enrichDeclInfo doxy info
  | Just doxyComment <- lookupCommentForId doxy info
  = info & #comment .~ Just (wrapDoxygenRefs doxyComment)
  | otherwise
  = info

lookupCommentForId ::
     Doxygen
  -> C.DeclInfo EnrichComments
  -> Maybe (Doxy.Comment Doxy.DoxyRef)
lookupCommentForId doxy info
  | not info.id.isUnnamed =
      let qualName = resolveQualifiedName info
      in  lookupComment (KeyDecl qualName) doxy
            <|> lookupComment (KeyStruct qualName) doxy
  | otherwise = Nothing

{-------------------------------------------------------------------------------
  Field-level enrichment
-------------------------------------------------------------------------------}

enrichDeclKind ::
     Doxygen
  -> Text  -- ^ Declaration C name (enclosing for field lookups)
  -> C.DeclKind l EnrichComments
  -> C.DeclKind l EnrichComments
enrichDeclKind doxy name = \case
    C.DeclStruct struct -> C.DeclStruct $ enrichStruct doxy name struct
    C.DeclUnion  union  -> C.DeclUnion  $ enrichUnion  doxy name union
    C.DeclEnum   enum   -> C.DeclEnum   $ enrichEnum   doxy name enum
    C.DeclUntaggedEnumConstant uec ->
      C.DeclUntaggedEnumConstant $
        uec & #constant %~ enrichEnumConstant doxy name
    other -> other

enrichStruct :: Doxygen -> Text -> C.Struct EnrichComments -> C.Struct EnrichComments
enrichStruct doxy name struct = struct
    & #fields %~ map (enrichField doxy name)
    & #flam   %~ C.mapFlamField (enrichRegularField doxy name)

enrichUnion :: Doxygen -> Text -> C.Union EnrichComments -> C.Union EnrichComments
enrichUnion doxy name union = union
    & #fields %~ map (enrichField doxy name)

enrichEnum :: Doxygen -> Text -> C.Enum EnrichComments -> C.Enum EnrichComments
enrichEnum doxy name enum = enum
    & #constants %~ map (enrichEnumConstant doxy name)

enrichField ::
     Doxygen -> Text -> C.Field EnrichComments -> C.Field EnrichComments
enrichField doxy name = C.mapField (enrichRegularField doxy name) (enrichImplicitField doxy name)

enrichRegularField ::
     Doxygen -> Text -> C.RegularField EnrichComments -> C.RegularField EnrichComments
enrichRegularField doxy name field =
    maybe field (\c -> field & #info % #comment .~ Just c) $ do
      lookupFieldComment doxy (KeyField name field.info.name.text)

enrichImplicitField ::
     Doxygen -> Text -> C.ImplicitField EnrichComments -> C.ImplicitField EnrichComments
enrichImplicitField doxy name field =
    #indirect %~ fmap (enrichIndirectField doxy name) $
    maybe field (\c -> field & #info % #comment .~ Just c) $ do
        lookupFieldComment doxy (KeyField name field.info.name.text)

enrichIndirectField ::
     Doxygen -> Text -> C.IndirectField EnrichComments -> C.IndirectField EnrichComments
enrichIndirectField doxy name field =
    maybe field (\c -> field & #info % #comment .~ Just c) $ do
        lookupFieldComment doxy (KeyField name field.info.name.text)

enrichEnumConstant ::
     Doxygen -> Text -> C.EnumConstant EnrichComments -> C.EnumConstant EnrichComments
enrichEnumConstant doxy name ec =
    maybe ec (\c -> ec & #info % #comment .~ Just c) $ do
      lookupFieldComment doxy (KeyEnumValue name ec.info.name.text)

{-------------------------------------------------------------------------------
  Enclosing declaration resolution
-------------------------------------------------------------------------------}

-- | Build the @\"::\"@-qualified name that doxygen uses for this declaration.
--
-- Named ancestors are joined with @\"::\"@ (e.g., @outer::inner@).
-- Unnamed ancestors are skipped. Unnamed decls resolve to the nearest
-- named ancestor.
resolveQualifiedName :: C.DeclInfo EnrichComments -> Text
resolveQualifiedName info =
    Text.intercalate "::" (map (.name.text) path)
  where
    path :: [C.DeclId]
    path =
      filter (not . (.isUnnamed)) $
      reverse (map getEnclosingRef info.enclosing) ++ [info.id]

    getEnclosingRef :: C.EnclosingRef EnrichComments -> C.DeclId
    getEnclosingRef = \case
        C.EnclosingRef         x -> x
        C.UnusableEnclosingRef x -> x

{-------------------------------------------------------------------------------
  Helpers
-------------------------------------------------------------------------------}

-- | Look up a doxygen comment by key and wrap its cross-references
lookupFieldComment :: Doxygen -> DoxygenKey -> Maybe (C.Comment EnrichComments)
lookupFieldComment doxy key = wrapDoxygenRefs <$> lookupComment key doxy

-- | Wrap doxygen cross-references into 'C.CommentRef'
wrapDoxygenRefs :: Doxy.Comment Doxy.DoxyRef -> C.Comment EnrichComments
wrapDoxygenRefs comment = C.Comment (fmap wrapRef comment)
  where
    wrapRef :: Doxy.DoxyRef -> C.CommentRef EnrichComments
    wrapRef (Doxy.DoxyRef name mKind) = C.CommentRef name Nothing mKind