Lua: add function `pandoc.utils.documentation` (#11383)

Closes #10999.

This is now used to generate much of the Lua API documentation.

5 files changed, 234 insertions, 10 deletions

diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Documentation.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Documentation.hs
new file mode 100644
index 000000000..833d57603
--- /dev/null
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Documentation.hs
@@ -0,0 +1,187 @@
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes        #-}
+{- |
+   Module      : Text.Pandoc.Lua.Documentation
+   Copyright   : Copyright © 2026 Albert Krewinkel
+   License     : GPL-2.0-or-later
+   Maintainer  : Albert Krewinkel <[email protected]>
+
+Render Lua documentation
+-}
+module Text.Pandoc.Lua.Documentation
+  ( renderDocumentation
+  ) where
+
+import Data.Default (def)
+import Data.List (intersperse)
+import Data.Sequence (Seq ((:|>)))
+import Data.Version (showVersion)
+import HsLua as Lua
+import Text.Pandoc.Class (runPure)
+import Text.Pandoc.Definition (Pandoc (Pandoc))
+import Text.Pandoc.Extensions (extensionsFromList, Extension (..))
+import Text.Pandoc.Options (ReaderOptions (readerExtensions))
+import Text.Pandoc.Readers (readCommonMark)
+import Text.Pandoc.Shared (compactify)
+import Text.Pandoc.Walk (walk)
+
+import qualified Data.Text as T
+import qualified Text.Pandoc.Builder as B
+import qualified Text.Pandoc.UTF8 as UTF8
+
+-- | Render the documentation object as pandoc Blocks
+renderDocumentation :: DocumentationObject -> B.Blocks
+renderDocumentation = \case
+  DocObjectFunction fn -> renderFunctionDoc Nothing fn
+  DocObjectModule mdl  -> renderModuleDoc mdl
+  DocObjectType tp     -> renderTypeDoc Nothing tp
+
+renderTypeDoc :: Maybe T.Text -> TypeDoc -> B.Blocks
+renderTypeDoc mbmodname td = mconcat
+  [ B.headerWith (ident, [], []) 1 (B.str $ typeDocName td)
+  , parseCommonMark $ typeDocDescription td
+  , if null $ typeDocMethods td
+    then mempty
+    else
+      B.header 2 "Methods" <>
+      (shiftHeadings 2 . mconcat . map (renderFunctionDoc Nothing) $
+       typeDocMethods td)
+  ]
+ where
+  ident = case mbmodname of
+    Just modname  -> mconcat [ "type-", modname, ".", typeDocName td ]
+    Nothing       -> mconcat [ "type-", typeDocName td ]
+
+-- Shift headings
+shiftHeadings :: Int -> B.Blocks -> B.Blocks
+shiftHeadings incr blks = flip walk blks $ \case
+  B.Header level attr inner -> B.Header (level + incr) attr inner
+  x -> x
+
+renderModuleDoc :: ModuleDoc -> B.Blocks
+renderModuleDoc moddoc =
+  let modname = moduleDocName moddoc
+  in mconcat
+  [ B.headerWith ("module-" <> modname, [], []) 1
+      (B.str $ "Module " <> modname)
+  , parseCommonMark (moduleDocDescription moddoc)
+  , if null (moduleDocFields moddoc)
+    then mempty
+    else
+      let ident = modname <> "-fields"
+      in B.headerWith (ident, [], []) 2 (B.str "Fields") <>
+         shiftHeadings 0 (mconcat (map (renderFieldDoc modname)
+                                   (moduleDocFields moddoc)))
+  , if null (moduleDocFunctions moddoc)
+    then mempty
+    else
+      let ident = modname <> "-functions"
+      in B.headerWith (ident, [], []) 2 (B.str "Functions") <>
+         (shiftHeadings 2 . mconcat . map (renderFunctionDoc $ Just modname) $
+          moduleDocFunctions moddoc)
+  , if null (moduleDocTypes moddoc)
+    then mempty
+    else
+      let ident = modname <> "-types"
+      in B.headerWith (ident, [], []) 2 (B.str "Types") <>
+         (shiftHeadings 2 . mconcat . map (renderTypeDoc $ Just modname) .
+          reverse $ moduleDocTypes moddoc)
+  ]
+
+parseCommonMark :: T.Text -> B.Blocks
+parseCommonMark txt =
+  let exts = extensionsFromList
+        [ Ext_wikilinks_title_after_pipe
+        , Ext_smart
+        ]
+      result = runPure $ do
+        Pandoc _ blks <- readCommonMark (def {readerExtensions = exts}) txt
+        return $ B.fromList blks
+  in either mempty id result
+
+appendInlines :: B.Blocks -> B.Inlines -> B.Blocks
+appendInlines blks inlns = case B.unMany blks of
+  front :|> (B.Para xs) -> B.Many front <> B.para (addTo xs)
+  front :|> (B.Plain xs) -> B.Many front <> B.plain (addTo xs)
+  _ -> blks <> B.para inlns
+ where addTo xs = B.fromList xs <> B.space <> inlns
+
+appendType :: B.Blocks -> TypeSpec -> B.Blocks
+appendType blks typespec =
+  appendInlines blks (B.str "(" <> typeToInlines typespec <> B.str ")")
+
+typeToInlines :: TypeSpec -> B.Inlines
+typeToInlines = \case
+  bt@BasicType{}   -> builtin $ tystr bt
+  NamedType "integer" -> builtin "integer"
+  NamedType name   -> B.linkWith ("", ["documented-type"], [])
+                        ("#" <> n2t name) mempty $ B.str (n2t name)
+  SeqType itemtype -> "{" <> typeToInlines itemtype <> ",...}"
+  SumType summands -> mconcat . intersperse (B.str "|") $ map typeToInlines summands
+  AnyType          -> "any"
+  x                -> tystr x
+ where
+  tystr = B.str . T.pack . typeSpecToString
+  n2t = UTF8.toText . fromName
+  builtin = B.spanWith ("", ["builtin-lua-type"], [])
+
+renderFunctionDoc :: Maybe T.Text -> FunctionDoc -> B.Blocks
+renderFunctionDoc mbmodule fndoc =
+  let name = case mbmodule of
+        Just _   ->  T.takeWhileEnd (/= '.') $ funDocName fndoc
+        Nothing  -> funDocName fndoc
+      ident = funDocName fndoc
+      level = 1
+      argsString = argslist (funDocParameters fndoc)
+      paramToDefItem p = ( B.code $ parameterName p
+                         , compactify
+                           [ appendType
+                               (parseCommonMark $ parameterDescription p)
+                               (parameterType p)
+                           ]
+                         )
+      paramlist = B.definitionList . map paramToDefItem $
+                  funDocParameters fndoc
+  in mconcat
+     [ B.headerWith (ident, [], []) level (B.str name)
+     , B.plain (B.code $ name <> " (" <> argsString <> ")")
+     , parseCommonMark (funDocDescription fndoc)
+     , if null (funDocParameters fndoc)
+       then mempty
+       else B.para "Parameters:" <> paramlist
+     , if funDocResults fndoc == ResultsDocList []
+       then mempty
+       else B.para "Returns:" <> renderResults (funDocResults fndoc)
+     , case funDocSince fndoc of
+         Nothing -> mempty
+         Just version ->
+           B.para $ B.emph $ "Since: " <> (B.str . T.pack $ showVersion version)
+     ]
+
+renderResults :: ResultsDoc -> B.Blocks
+renderResults (ResultsDocMult descr) = parseCommonMark descr
+renderResults (ResultsDocList rvd) = B.bulletList $ map renderResultVal rvd
+ where
+   renderResultVal (ResultValueDoc typespec descr) =
+     parseCommonMark descr `appendType` typespec
+
+argslist :: [ParameterDoc] -> T.Text
+argslist params =
+  -- Expect optional values to come after required values.
+  let (required, optional') = break parameterIsOptional params
+      reqs = map parameterName required
+      opts = map parameterName optional'
+  in if null opts
+     then T.intercalate ", " reqs
+     else T.intercalate ", " reqs <>
+          (if null required then "[" else "[, ") <>
+          T.intercalate "[, " opts <> T.replicate (length opts) "]"
+
+renderFieldDoc :: T.Text -> FieldDoc -> B.Blocks
+renderFieldDoc _modname fd =
+  B.headerWith (ident, [], []) 3 (B.str name) <>
+  appendType (parseCommonMark $ fieldDocDescription fd) (fieldDocType fd)
+ where
+  ident = fieldDocName fd
+  name = T.takeWhileEnd (/= '.') $ fieldDocName fd
diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Init.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Init.hs
index 2756dc61b..546323761 100644
--- a/pandoc-lua-engine/src/Text/Pandoc/Lua/Init.hs
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Init.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE RankNTypes        #-}
 {- |
    Module      : Text.Pandoc.Lua.Init
-   Copyright   : © 2017-2024 Albert Krewinkel
+   Copyright   : © 2017-2026 Albert Krewinkel
    License     : GPL-2.0-or-later
    Maintainer  : Albert Krewinkel <[email protected]>
 
diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/MediaBag.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/MediaBag.hs
index 412131560..7d0c76b80 100644
--- a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/MediaBag.hs
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/MediaBag.hs
@@ -104,8 +104,9 @@ insert = defun "insert"
           setMediaBag $ MB.insertMedia fp mmime contents mb
           return (Lua.NumResults 0))
   <#> stringParam "filepath" "filename and path relative to the output folder."
-  <#> opt (textParam "mimetype"
-           "the item's MIME type; omit if unknown or unavailable.")
+  <#> parameter (Lua.peekNilOr Lua.peekText) "string|nil" "mimetype"
+        "the item's MIME type; use `nil` if the MIME type is\
+        \ unknown or unavailable."
   <#> parameter Lua.peekLazyByteString "string" "contents"
         "the binary contents of the file."
   =#> []
diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Path.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Path.hs
index efe00e03c..9334a2252 100644
--- a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Path.hs
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Path.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE TypeApplications    #-}
 {- |
    Module      : Text.Pandoc.Lua.Module.Path
-   Copyright   : © 2019-2024 Albert Krewinkel
+   Copyright   : © 2019-2026 Albert Krewinkel
    License     : GNU GPL, version 2 or above
 
    Maintainer  : Albert Krewinkel <[email protected]>
diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Utils.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Utils.hs
index d4b7cea08..a5a6bde8b 100644
--- a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Utils.hs
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Utils.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE TypeApplications    #-}
 {- |
    Module      : Text.Pandoc.Lua.Module.Utils
-   Copyright   : Copyright © 2017-2026 Albert Krewinkel
+   Copyright   : © 2017-2026 Albert Krewinkel
    License     : GNU GPL, version 2 or above
 
    Maintainer  : Albert Krewinkel <[email protected]>
@@ -19,6 +19,7 @@ module Text.Pandoc.Lua.Module.Utils
 
 import Control.Applicative ((<|>))
 import Control.Monad ((<$!>))
+import Control.Monad.Except (MonadError (throwError))
 import Crypto.Hash (hashWith, SHA1(SHA1))
 import Data.Data (showConstr, toConstr)
 import Data.Default (def)
@@ -28,12 +29,17 @@ import HsLua as Lua
 import HsLua.Module.Version (peekVersionFuzzy, pushVersion)
 import Text.Pandoc.Citeproc (getReferences, processCitations)
 import Text.Pandoc.Definition
-import Text.Pandoc.Error (PandocError)
+import Text.Pandoc.Error (PandocError (PandocLuaError))
 import Text.Pandoc.Filter (applyJSONFilter)
+import Text.Pandoc.Format (FlavoredFormat (formatName), parseFlavoredFormat)
+import Text.Pandoc.Lua.Documentation (renderDocumentation)
 import Text.Pandoc.Lua.Filter (runFilterFile')
 import Text.Pandoc.Lua.Marshal.AST
+import Text.Pandoc.Lua.Marshal.Format (peekFlavoredFormat)
 import Text.Pandoc.Lua.Marshal.Reference
 import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua))
+import Text.Pandoc.Options (WriterOptions (writerExtensions))
+import Text.Pandoc.Writers (Writer (..), getWriter)
 
 import qualified Data.Map as Map
 import qualified Data.Text as T
@@ -52,6 +58,7 @@ documentedModule = defmodule "pandoc.utils"
   `withFunctions`
     [ blocks_to_inlines `since` v[2,2,3]
     , citeproc          `since` v[2,19,1]
+    , documentation     `since` v[3,8,4]
     , equals            `since` v[2,5]
     , from_simple_table `since` v[2,11]
     , make_sections     `since` v[2,8]
@@ -67,8 +74,7 @@ documentedModule = defmodule "pandoc.utils"
 
     , defun "Version"
       ### liftPure (id @Version)
-      <#> parameter peekVersionFuzzy
-            "version string, list of integers, or integer"
+      <#> parameter peekVersionFuzzy "Version|string|{integer,...}|number"
             "v" "version description"
       =#> functionResult pushVersion "Version" "new Version object"
       #? "Creates a Version object."
@@ -125,6 +131,35 @@ citeproc = defun "citeproc"
       , "    end"
       ]
 
+documentation :: DocumentedFunction PandocError
+documentation = defun "documentation"
+  ### (\idx mformat -> do
+          docobj <- getdocumentation idx >>= \case
+            TypeNil -> fail "Undocumented object"
+            _ -> forcePeek $ peekDocumentationObject top
+          let blocks = renderDocumentation docobj
+          if maybe mempty formatName mformat == "blocks"
+            then pure . Left $ B.toList blocks
+            else unPandocLua $ do
+              flvrd <- maybe (parseFlavoredFormat "ansi") pure mformat
+              getWriter flvrd >>= \case
+                (TextWriter w, es) -> Right <$>
+                  w def{ writerExtensions = es } (B.doc blocks)
+                _ -> throwError $ PandocLuaError
+                  "ByteString writers are not supported here.")
+  <#> parameter pure "any" "object" "Retrieve documentation for this object"
+  <#> opt (parameter peekFlavoredFormat "string|table" "format"
+            "result format; defaults to `'ansi'`")
+  =#> functionResult (either pushBlocks pushText) "string|Blocks"
+        "rendered documentation"
+  #? "Return the documentation for a function or module defined by pandoc.\
+     \ Throws an error if there is no documentation for the given object.\n\
+     \\n\
+     \The result format can be any textual format accepted by `pandoc.write`,\
+     \ and the documentation will be returned in that format.\
+     \ Additionally, the special format `blocks` is accepted, in which case\
+     \ the documentation is returned as [[Blocks]]."
+
 equals :: LuaError e => DocumentedFunction e
 equals = defun "equals"
   ### equal
@@ -205,7 +240,7 @@ normalize_date :: DocumentedFunction e
 normalize_date = defun "normalize_date"
   ### liftPure Shared.normalizeDate
   <#> parameter peekText "string" "date" "the date string"
-  =#> functionResult (maybe pushnil pushText) "string or nil"
+  =#> functionResult (maybe pushnil pushText) "string|nil"
         "normalized date, or nil if normalization failed."
   #? T.unwords
   [ "Parse a date and convert (if possible) to \"YYYY-MM-DD\" format. We"
@@ -320,7 +355,8 @@ stringify = defun "stringify"
          , (fmap (const "") . peekAttr)
          , (fmap (const "") . peekListAttributes)
          ] idx)
-  <#> parameter pure "AST element" "element" "some pandoc AST element"
+  <#> parameter pure "Pandoc|Block|Inline|Caption|Cell|MetaValue"
+        "element" "some pandoc AST element"
   =#> functionResult pushText "string"
         "A plain string representation of the given element."
   #? T.unlines