Lua: add module `pandoc.structure`.

Adds support for table of contents and chunks handling. The function
`make_sections` has been given a friendlier interface and was moved to
the new module; the old `pandoc.utils.make_sections` has been
deprecated.

3 files changed, 337 insertions, 0 deletions

diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Init.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Init.hs
index 5357d9294..4dc4ca80e 100644
--- a/pandoc-lua-engine/src/Text/Pandoc/Lua/Init.hs
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Init.hs
@@ -42,6 +42,7 @@ import qualified Text.Pandoc.Lua.Module.Format as Pandoc.Format
 import qualified Text.Pandoc.Lua.Module.MediaBag as Pandoc.MediaBag
 import qualified Text.Pandoc.Lua.Module.Pandoc as Module.Pandoc
 import qualified Text.Pandoc.Lua.Module.Scaffolding as Pandoc.Scaffolding
+import qualified Text.Pandoc.Lua.Module.Structure as Pandoc.Structure
 import qualified Text.Pandoc.Lua.Module.System as Pandoc.System
 import qualified Text.Pandoc.Lua.Module.Template as Pandoc.Template
 import qualified Text.Pandoc.Lua.Module.Types as Pandoc.Types
@@ -87,6 +88,7 @@ loadedModules =
   , Pandoc.Format.documentedModule
   , Pandoc.MediaBag.documentedModule
   , Pandoc.Scaffolding.documentedModule
+  , Pandoc.Structure.documentedModule
   , Pandoc.System.documentedModule
   , Pandoc.Template.documentedModule
   , Pandoc.Types.documentedModule
diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/Chunks.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/Chunks.hs
new file mode 100644
index 000000000..808ebeae5
--- /dev/null
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/Chunks.hs
@@ -0,0 +1,145 @@
+{-# LANGUAGE LambdaCase           #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{- |
+   Module      : Text.Pandoc.Lua.Marshal.Chunks
+   Copyright   : © 2022 Albert Krewinkel
+   License     : GPL-2.0-or-later
+   Maintainer  : Albert Krewinkel <[email protected]>
+
+Marshaling chunks, i.e., pandoc subdocuments.
+-}
+module Text.Pandoc.Lua.Marshal.Chunks
+  ( peekChunk
+  , pushChunk
+  , peekChunkedDoc
+  , pushChunkedDoc
+  ) where
+
+import Control.Monad ((<$!>))
+import Data.Tree (Tree (..))
+import HsLua
+import Text.Pandoc.Chunks (Chunk (..), ChunkedDoc (..), SecInfo (..))
+import Text.Pandoc.Lua.Marshal.AST
+
+-- | Retrieves a 'Chunk' from the Lua stack.
+peekChunk :: LuaError e => Peeker e Chunk
+peekChunk = peekUD typeChunk
+
+-- | Pushes a 'Chunk' to the top of the Lua stack.
+pushChunk :: LuaError e => Pusher e Chunk
+pushChunk = pushUD typeChunk
+
+typeChunk :: LuaError e => DocumentedType e Chunk
+typeChunk = deftype "pandoc.Chunk"
+  [ operation Tostring $ lambda
+    ### liftPure show
+    <#> udparam typeChunk "chunk" "chunk to print in native format"
+    =#> functionResult pushString "string" "Haskell representation"
+  ]
+  [ property "heading"
+    "heading text"
+    (pushInlines, chunkHeading)
+    (peekInlinesFuzzy, \chunk inlns -> chunk{ chunkHeading = inlns })
+
+  , property "id"
+    "identifier"
+    (pushText, chunkId)
+    (peekText, \chunk ident -> chunk{ chunkId = ident })
+
+  , property "level"
+    "level of topmost heading in chunk"
+    (pushIntegral, chunkLevel)
+    (peekIntegral, \chunk level -> chunk{ chunkLevel = level })
+
+  , property "number"
+    "chunk number"
+    (pushIntegral, chunkNumber)
+    (peekIntegral, \chunk number -> chunk{ chunkNumber = number })
+
+  , property "section_number"
+    "hierarchical section number"
+    (pushMaybe pushText, chunkSectionNumber)
+    (peekMaybe peekText, \chunk secnum -> chunk{ chunkSectionNumber = secnum })
+
+  , property "path"
+    "target filepath for this chunk"
+    (pushString, chunkPath)
+    (peekString, \chunk path -> chunk{ chunkPath = path })
+
+  , property "up"
+    "link to the enclosing section chunk, if any"
+    (pushMaybe pushChunk, chunkUp)
+    (peekMaybe peekChunk, \chunk up -> chunk{ chunkUp = up })
+
+  , property "prev"
+    "link to the previous section, if any"
+    (pushMaybe pushChunk, chunkPrev)
+    (peekMaybe peekChunk, \chunk prev -> chunk{ chunkPrev = prev })
+
+  , property "next"
+    "link to the next section, if any"
+    (pushMaybe pushChunk, chunkNext)
+    (peekMaybe peekChunk, \chunk next' -> chunk{ chunkNext = next' })
+
+  , property "unlisted"
+    ( "whether the section in this chunk should be listed in the TOC" <>
+      "even if the chunk has no section number" )
+    (pushBool, chunkUnlisted)
+    (peekBool, \chunk unlisted -> chunk { chunkUnlisted = unlisted })
+
+  , property "contents"
+    "the chunk's block contents"
+    (pushBlocks, chunkContents)
+    (peekBlocksFuzzy, \chunk blks -> chunk{ chunkContents = blks })
+  ]
+
+-- | Retrieves a 'ChunkedDoc' from the Lua stack.
+peekChunkedDoc :: LuaError e => Peeker e ChunkedDoc
+peekChunkedDoc = peekUD typeChunkedDoc
+
+-- | Pushes a 'ChunkedDoc to the top of the Lua stack.
+pushChunkedDoc :: LuaError e => Pusher e ChunkedDoc
+pushChunkedDoc = pushUD typeChunkedDoc
+
+-- | Lua type for 'ChunkedDoc' values.
+typeChunkedDoc :: LuaError e => DocumentedType e ChunkedDoc
+typeChunkedDoc = deftype "pandoc.ChunkedDoc"
+  []
+  [ readonly "chunks"
+    "list of chunks that make up the document"
+    (pushList pushChunk, chunkedChunks)
+
+  , readonly "meta"
+    "the document's metadata"
+    (pushMeta, chunkedMeta)
+
+  , readonly "toc"
+    "table of contents information"
+    (pushTocTree, chunkedTOC)
+  ]
+
+-- | Pushes a TOC tree to the stack. The resulting object is a list with
+-- the top-level entry placed at index @0@ and all subentries as the
+-- rest of the list.
+pushTocTree :: LuaError e => Pusher e (Tree SecInfo)
+pushTocTree (Node secInfo subSecInfo) = do
+  pushList pushTocTree subSecInfo
+  pushSecInfo secInfo
+  rawseti (nth 2) 0
+
+pushSecInfo :: LuaError e => Pusher e SecInfo
+pushSecInfo = pushAsTable
+  [ ("title"  , pushInlines . secTitle)
+  , ("number" , maybe pushnil pushText . secNumber)
+  , ("id"     , pushText . secId)
+  , ("path"   , pushText . secPath)
+  , ("level"  , pushIntegral . secLevel)
+  ]
+
+peekMaybe :: LuaError e => Peeker e a -> Peeker e (Maybe a)
+peekMaybe p idx = liftLua (isnoneornil idx) >>= \case
+  True  -> pure Nothing
+  False -> Just <$!> p idx
+
+pushMaybe :: LuaError e => Pusher e a -> Pusher e (Maybe a)
+pushMaybe = maybe pushnil
diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Structure.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Structure.hs
new file mode 100644
index 000000000..56977edae
--- /dev/null
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Structure.hs
@@ -0,0 +1,190 @@
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+{- |
+   Module      : Text.Pandoc.Lua.Module.Structure
+   Copyright   : © 2023 Albert Krewinkel
+   License     : GPL-2.0-or-later
+   Maintainer  : Albert Krewinkel <[email protected]>
+
+Command line helpers
+-}
+module Text.Pandoc.Lua.Module.Structure
+  ( documentedModule
+  ) where
+
+import Control.Applicative ((<|>), optional)
+import Data.Default (Default (..))
+import Data.Maybe (fromMaybe)
+import HsLua ( DocumentedFunction, LuaError, Module (..), Peeker
+             , (###), (<#>), (=#>), (#?)
+             , defun, functionResult, getfield, isnil, lastly, liftLua
+             , opt, liftPure, parameter , peekBool, peekIntegral
+             , peekFieldRaw, peekText, pop, pushIntegral, top )
+import Text.Pandoc.Chunks ( ChunkedDoc (..), PathTemplate (..)
+                          , tocToList, splitIntoChunks )
+import Text.Pandoc.Definition (Pandoc (..), Block)
+import Text.Pandoc.Error (PandocError)
+import Text.Pandoc.Lua.PandocLua ()
+import Text.Pandoc.Lua.Marshal.AST ( peekBlocksFuzzy, peekPandoc
+                                   , pushBlock, pushBlocks )
+import Text.Pandoc.Lua.Marshal.Chunks
+import Text.Pandoc.Lua.Marshal.WriterOptions ( peekWriterOptions )
+import Text.Pandoc.Options (WriterOptions (writerTOCDepth))
+import Text.Pandoc.Slides (getSlideLevel, prepSlides)
+import Text.Pandoc.Writers.Shared (toTableOfContents)
+import qualified Data.Text as T
+import qualified Text.Pandoc.Shared as Shared
+
+-- | Push the pandoc.structure module on the Lua stack.
+documentedModule :: Module PandocError
+documentedModule = Module
+  { moduleName = "pandoc.structure"
+  , moduleDescription =
+    "Access to the higher-level document structure, including" <>
+    "hierarchical sections and the table of contents."
+  , moduleFields = []
+  , moduleFunctions =
+      [ make_sections
+      , slide_level
+      , split_into_chunks
+      , table_of_contents
+      ]
+  , moduleOperations = []
+  }
+
+make_sections :: LuaError e => DocumentedFunction e
+make_sections = defun "make_sections"
+  ### (\blks mopts ->
+         let (numSects, baseLevel, mslideLevel) =
+               fromMaybe (defNumSec, Nothing, Nothing) mopts
+             blks' = case mslideLevel of
+                       Just l | l <= 0 -> prepSlides (getSlideLevel blks) blks
+                       Just sl -> prepSlides sl blks
+                       Nothing -> blks
+         in pure $ Shared.makeSections numSects baseLevel blks')
+  <#> parameter peekBodyBlocks "Blocks" "blocks" "document blocks to process"
+  <#> opt (parameter peekOpts "table" "opts" "options")
+  =#> functionResult pushBlocks "list of Blocks"
+        "processed blocks"
+  #? T.unlines
+     [ "Puts [Blocks] into a hierarchical structure: a list of sections"
+     , "(each a Div with class \"section\" and first element a Header)."
+     , ""
+     , "The optional `opts` argument can be a table; two settings are"
+     , "recognized: If `number_sections` is true, a `number` attribute"
+     , "containing the section number will be added to each `Header`. If"
+     , "`base_level` is an integer, then `Header` levels will be"
+     , "reorganized so that there are no gaps, with numbering levels"
+     , "shifted by the given value. Finally, an integer `slide_level`"
+     , "value triggers the creation of slides at that heading level."
+     , ""
+     , "Note that a [WriterOptions][] object can be passed as the opts"
+     , "table; this will set the `number_section` and `slide_level` values"
+     , "to those defined on the command line."
+     ]
+  where
+    defNumSec = False
+    peekOpts idx = do
+      numberSections <- fromMaybe defNumSec <$> do
+        liftLua $ getfield idx "number_sections"
+        optional (peekBool top `lastly` pop 1)
+      baseLevel <- do
+        liftLua $ getfield idx "base_level"
+        optional (peekIntegral top `lastly` pop 1)
+      slideLevel <- do
+        liftLua $ getfield idx "slide_level"
+        optional (peekIntegral top `lastly` pop 1)
+      return (numberSections, baseLevel, slideLevel)
+
+slide_level :: LuaError e => DocumentedFunction e
+slide_level = defun "slide_level"
+  ### liftPure getSlideLevel
+  <#> parameter peekBodyBlocks "Pandoc|Blocks" "blocks" "document body"
+  =#> functionResult pushIntegral "integer" "slide level"
+  #? T.unlines
+  [ "Find level of header that starts slides (defined as the least"
+  , "header level that occurs before a non-header/non-hrule in the"
+  , "blocks)."
+  ]
+
+-- | Split 'Pandoc' into 'Chunk's.
+split_into_chunks :: LuaError e => DocumentedFunction e
+split_into_chunks = defun "split_into_chunks"
+  ### (\doc mopts -> pure $
+          let defOpts = (defPathTmpl, defNumSects, Nothing, defLvl)
+              (pathTempl, numberSect, mbBaseLevel, chunkLevel) =
+                fromMaybe defOpts mopts
+          in splitIntoChunks pathTempl numberSect mbBaseLevel chunkLevel doc)
+  <#> parameter peekPandoc "Pandoc" "doc" "document to split"
+  <#> opt (parameter peekSplitOpts "table" "opts" optionsDescr)
+  =#> functionResult pushChunkedDoc "ChunkedDoc" ""
+  #? T.unlines
+     [ "Converts a `Pandoc` document into a `ChunkedDoc`." ]
+ where
+  defPathTmpl = PathTemplate "chunk-%n"
+  defNumSects = False
+  defLvl = 1
+  peekSplitOpts idx = (,,,)
+    <$> peekFieldRaw ((fmap PathTemplate . peekText) `orDefault` defPathTmpl)
+                     "path_template" idx
+    <*> peekFieldRaw (peekBool `orDefault` defNumSects) "number_sections" idx
+    <*> peekFieldRaw (optional . peekIntegral) "base_heading_level" idx
+    <*> peekFieldRaw (peekIntegral `orDefault` defLvl) "chunk_level" idx
+  orDefault p defaultValue idx' = liftLua (isnil idx') >>= \case
+    True  -> pure defaultValue
+    False -> p idx'
+  optionsDescr = T.unlines
+    [ "The following options are supported:"
+    , ""
+    , "    `path_template`"
+    , "    :   template used to generate the chunks' filepaths"
+    , "        `%n` will be replaced with the chunk number (padded with"
+    , "        leading 0s to 3 digits), `%s` with the section number of"
+    , "        the heading, `%h` with the (stringified) heading text,"
+    , "        `%i` with the section identifier. For example,"
+    , "        `\"section-%s-%i.html\"` might be resolved to"
+    , "        `\"section-1.2-introduction.html\"`."
+    , ""
+    , "        Default is `\"chunk-%n\"` (string)"
+    , ""
+    , "    `number_sections`"
+    , "    :   whether sections should be numbered; default is `false`"
+    , "        (boolean)"
+    , ""
+    , "    `chunk_level`"
+    , "    :   The heading level the document should be split into"
+    , "        chunks. The default is to split at the top-level, i.e.,"
+    , "        `1`. (integer)"
+    , ""
+    , "    `base_heading_level`"
+    , "    :   The base level to be used for numbering. Default is `nil`"
+    , "        (integer|nil)"
+    ]
+
+-- | Generate a table of contents.
+table_of_contents :: DocumentedFunction PandocError
+table_of_contents = defun "table_of_contents"
+  ### (\tocSource mwriterOpts -> pure $
+          let writerOpts = fromMaybe def mwriterOpts
+          in case tocSource of
+               Left blks  -> toTableOfContents writerOpts blks
+               Right tree -> tocToList (writerTOCDepth writerOpts) tree
+      )
+  <#> parameter peekTocSource "Blocks|Pandoc|ChunkedDoc" "toc_source"
+        "list of command line arguments"
+  <#> opt (parameter peekWriterOptions "WriterOptions" "opts" "options")
+  =#> functionResult pushBlock "Block"
+        "Table of contents as a BulletList object"
+  #? T.unlines
+     [ "Generates a table of contents for the given object." ]
+ where
+  peekTocSource idx =
+    (Left <$> peekBodyBlocks idx) <|>
+    (Right . chunkedTOC <$> peekChunkedDoc idx)
+
+-- | Retrieves the body blocks of a 'Pandoc' object or from a list of
+-- blocks.
+peekBodyBlocks :: LuaError e => Peeker e [Block]
+peekBodyBlocks idx =
+  ((\(Pandoc _ blks) -> blks) <$> peekPandoc idx) <|>
+  peekBlocksFuzzy idx