Lua: add new module pandoc.highlighting.

doc/lua-filters.md

@@ -5091,6 +5091,88 @@ Returns:
 
 <!-- END: AUTOGENERATED CONTENT -->
 
+<!-- BEGIN: AUTOGENERATED CONTENT for module pandoc.highlighting -->
+
+# Module pandoc.highlighting
+
+Code highlighting
+
+## Fields {#pandoc.highlighting-fields}
+
+### styles {#pandoc.highlighting.styles}
+
+List of known code highlighting styles. ({string,\...})
+
+## Functions {#pandoc.highlighting-functions}
+
+### definitions {#pandoc.highlighting.definitions}
+
+`definitions (style, format)`
+
+Generate highlighting definitions for the given format. For
+example, to generate CSS definitions for the *espresso* style, run
+`pandoc.highlighting.toformat('espresso', 'css')`.
+
+Parameters:
+
+`style`
+:   style table or style name (table\|string)
+
+`format`
+:   `'context'`, `'css'`, or `'latex'` (string)
+
+Returns:
+
+- style definitions (string)
+
+*Since: 3.8*
+
+### highlight {#pandoc.highlighting.highlight}
+
+`highlight (code element, format[, wopts])`
+
+Highlight code in the given format.
+
+Parameters:
+
+`code element`
+:   element that will be highlighted ([Inline]\|[Block])
+
+`format`
+:   target format (`'ansi'`, `'context'`, `'html'`, or `'latex'`')
+    (string)
+
+`wopts`
+:    ([WriterOptions])
+
+Returns:
+
+- highlighted code (string)
+
+*Since: 3.8*
+
+### style {#pandoc.highlighting.style}
+
+`style (name)`
+
+Returns the style definitions for a given style name. If the name
+is a standard style, it is loaded amd returned; if it ends in
+`.theme`, attemts to load a KDE theme from the file path
+specified.
+
+Parameters:
+
+`name`
+:   style name or path to theme file (string)
+
+Returns:
+
+- style (table)
+
+*Since: 3.8*
+
+<!-- END: AUTOGENERATED CONTENT -->
+
 <!-- BEGIN: AUTOGENERATED CONTENT for module pandoc.image -->
 
 # Module pandoc.image

pandoc-lua-engine/pandoc-lua-engine.cabal

@@ -88,6 +88,7 @@ library
                      , Text.Pandoc.Lua.Marshal.WriterOptions
                      , Text.Pandoc.Lua.Module.CLI
                      , Text.Pandoc.Lua.Module.Format
+                     , Text.Pandoc.Lua.Module.Highlighting
                      , Text.Pandoc.Lua.Module.Image
                      , Text.Pandoc.Lua.Module.JSON
                      , Text.Pandoc.Lua.Module.Log
@@ -109,6 +110,7 @@ library
                      , Text.Pandoc.Lua.Writer.Scaffolding
 
   build-depends:       aeson
+                     , blaze-html            >= 0.9     && < 0.10
                      , bytestring            >= 0.9     && < 0.13
                      , crypton               >= 0.30    && < 1.1
                      , citeproc              >= 0.8     && < 0.10
@@ -133,7 +135,6 @@ library
                      , parsec                >= 3.1     && < 3.2
                      , text                  >= 1.1.1   && < 2.2
 
-
 test-suite test-pandoc-lua-engine
   import:              common-options
   type:                exitcode-stdio-1.0

pandoc-lua-engine/src/Text/Pandoc/Lua/Module.hs

@@ -26,6 +26,7 @@ import qualified HsLua.Module.DocLayout as Module.Layout
 import qualified HsLua.Module.Zip as Module.Zip
 import qualified Text.Pandoc.Lua.Module.CLI as Pandoc.CLI
 import qualified Text.Pandoc.Lua.Module.Format as Pandoc.Format
+import qualified Text.Pandoc.Lua.Module.Highlighting as Pandoc.Highlighting
 import qualified Text.Pandoc.Lua.Module.Image as Pandoc.Image
 import qualified Text.Pandoc.Lua.Module.JSON as Pandoc.JSON
 import qualified Text.Pandoc.Lua.Module.Log as Pandoc.Log
@@ -80,6 +81,7 @@ submodules :: [Module PandocError]
 submodules =
   [ Pandoc.CLI.documentedModule
   , Pandoc.Format.documentedModule
+  , Pandoc.Highlighting.documentedModule
   , Pandoc.Image.documentedModule
   , Pandoc.JSON.documentedModule
   , Pandoc.Log.documentedModule

pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Highlighting.hs

@@ -0,0 +1,164 @@
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module      : Text.Pandoc.Lua.Module.Highlighting
+Copyright   : © 2025 Albert Krewinkel
+License     : MIT
+Maintainer  : Albert Krewinkel <[email protected]>
+
+Lua module for basic image operations.
+-}
+module Text.Pandoc.Lua.Module.Highlighting (
+  -- * Module
+    documentedModule
+
+  -- ** Functions
+  , style
+  )
+where
+
+import Prelude hiding (null)
+import Control.Applicative ((<|>))
+import Data.Default (def)
+import Data.Maybe (fromMaybe)
+import Data.Version (makeVersion)
+import HsLua.Aeson (peekViaJSON, pushViaJSON)
+import HsLua.Core
+import HsLua.Marshalling
+import HsLua.Packaging
+import Text.Blaze.Html.Renderer.Text (renderHtml)
+import Text.Pandoc.Definition (Block(CodeBlock), Inline(Code))
+import Text.Pandoc.Error (PandocError)
+import Text.Pandoc.Highlighting
+  ( Style
+  , formatANSI
+  , formatConTeXtBlock
+  , formatConTeXtInline
+  , formatHtmlBlock
+  , formatHtmlInline
+  , formatLaTeXBlock
+  , formatLaTeXInline
+  , highlightingStyles
+  , lookupHighlightingStyle
+  , pygments
+  , styleToConTeXt
+  , styleToCss
+  , styleToLaTeX
+  )
+import Text.Pandoc.Lua.Marshal.AST (peekBlockFuzzy, peekInlineFuzzy)
+import Text.Pandoc.Lua.Marshal.WriterOptions (peekWriterOptions)
+import Text.Pandoc.Lua.PandocLua (unPandocLua)
+import Text.Pandoc.Options
+  ( WriterOptions (writerHighlightStyle, writerSyntaxMap) )
+
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Text.Pandoc.Highlighting as HL
+
+-- | The @pandoc.image@ module specification.
+documentedModule :: Module PandocError
+documentedModule = Module
+  { moduleName = "pandoc.highlighting"
+  , moduleDescription = "Code highlighting"
+  , moduleFields = fields
+  , moduleFunctions =
+    [ definitions `since` makeVersion [3, 8]
+    , highlight   `since` makeVersion [3, 8]
+    , style       `since` makeVersion [3, 8]
+    ]
+  , moduleOperations = []
+  , moduleTypeInitializers = []
+  }
+
+--
+-- Fields
+--
+
+-- | Exported fields.
+fields :: LuaError e => [Field e]
+fields =
+  [ Field
+    { fieldName = "styles"
+    , fieldType = "{string,...}"
+    , fieldDescription = "List of known code highlighting styles."
+    , fieldPushValue = pushList (pushText . fst) highlightingStyles
+    }
+  ]
+
+--
+-- Functions
+--
+
+-- | Gets a highlighting style of the given name.
+style :: DocumentedFunction PandocError
+style = defun "style"
+  ### (unPandocLua . lookupHighlightingStyle)
+  <#> stringParam "name" "style name or path to theme file"
+  =#> functionResult pushViaJSON "table" "style"
+  #? "Returns the style definitions for a given style name.\
+     \\
+     \ If the name is a standard style, it is loaded amd returned;\
+     \ if it ends in `.theme`, attemts to load a KDE theme from the \
+     \ file path specified."
+
+definitions :: DocumentedFunction PandocError
+definitions = defun "definitions"
+  ### (\sty format -> case T.toLower format of
+          "context" -> pure $ styleToConTeXt sty
+          "css"     -> pure $ T.pack $ styleToCss sty
+          "latex"   -> pure $ styleToLaTeX sty
+          _ -> failLua $ "Unsupported format: " <> T.unpack format)
+  <#> parameter peekStyle "table|string" "style" "style table or style name"
+  <#> textParam "format" "`'context'`, `'css'`, or `'latex'`"
+  =#> functionResult pushText "string" "style definitions"
+  #? "Generate highlighting definitions for the given format.\
+     \ For example, to generate CSS definitions for the *espresso* style,\
+     \ run `pandoc.highlighting.toformat('espresso', 'css')`."
+
+highlight :: DocumentedFunction PandocError
+highlight = defun "highlight"
+  ### (\codeElement format mwopts -> do
+          (attr, code, inline) <-
+            case codeElement of
+              Left (Code a c)       -> pure (a, c, True)
+              Right (CodeBlock a c) -> pure (a, c, False)
+              _                     -> failLua "Cannot highlight element"
+          let wopts = fromMaybe def mwopts
+          let sty = fromMaybe pygments (writerHighlightStyle wopts)
+          (inlineFormatter, blockFormatter) <- case T.toLower format of
+            "ansi"    -> pure ( \opts lns -> formatANSI opts sty lns
+                              , \opts lns -> formatANSI opts sty lns )
+            "context" -> pure (formatConTeXtInline, formatConTeXtBlock)
+            "html"    -> let htmlToText fn = \opts src ->
+                               TL.toStrict $ renderHtml (fn opts src)
+                         in pure ( htmlToText formatHtmlInline
+                                 , htmlToText formatHtmlBlock )
+            "latex"   -> pure (formatLaTeXInline, formatLaTeXBlock)
+            _ -> failLua $
+                 "Unsupported highlighting format: " <> T.unpack format
+          let syntaxMap = writerSyntaxMap wopts
+          let formatter = if inline then inlineFormatter else blockFormatter
+          case HL.highlight syntaxMap formatter attr code of
+            Left err -> failLua $ T.unpack err
+            Right result -> pure result)
+  <#> parameter
+        (\idx ->
+           (Left <$> peekInlineFuzzy idx) <|>
+           (Right <$> peekBlockFuzzy idx))
+        "Inline|Block" "code element" "element that will be highlighted"
+  <#> textParam "format"
+        "target format (`'ansi'`, `'context'`, `'html'`, or `'latex'`')"
+  <#> opt (parameter peekWriterOptions "WriterOptions" "wopts" "")
+  =#> functionResult pushText "string" "highlighted code"
+  #? "Highlight code in the given format."
+
+-- | Retrieves a highlighting style; accepts a string, themepath, or style
+-- table.
+peekStyle :: Peeker PandocError Style
+peekStyle idx = do
+  liftLua (ltype idx) >>= \case
+    TypeTable -> peekViaJSON idx
+    TypeString -> do
+      name <- peekString idx
+      liftLua $ unPandocLua $ lookupHighlightingStyle name
+    _type -> failPeek "Can't retrieve style."

pandoc-lua-engine/test/Tests/Lua/Module.hs

@@ -25,6 +25,8 @@ tests =
                   ("lua" </> "module" </> "pandoc-list.lua")
   , testPandocLua "pandoc.format"
                   ("lua" </> "module" </> "pandoc-format.lua")
+  , testPandocLua "pandoc.highlighting"
+                  ("lua" </> "module" </> "pandoc-highlighting.lua")
   , testPandocLua "pandoc.image"
                   ("lua" </> "module" </> "pandoc-image.lua")
   , testPandocLua "pandoc.json"

pandoc-lua-engine/test/lua/module/pandoc-highlighting.lua

@@ -0,0 +1,64 @@
+local tasty = require 'tasty'
+
+local test = tasty.test_case
+local group = tasty.test_group
+local assert = tasty.assert
+
+local pandoc = require 'pandoc'
+local highlighting = require 'pandoc.highlighting'
+
+return {
+  group 'styles' {
+    test('is a table', function ()
+      assert.are_equal('table', type(highlighting.styles))
+    end),
+  },
+
+  group 'definitions' {
+    test('returns a string', function ()
+      local defs = highlighting.definitions('espresso', 'css')
+      assert.are_equal('string', type(defs))
+    end),
+    test('errors when presented with an unknown style name', function ()
+      assert.error_matches(
+        function ()
+          highlighting.definitions('unknown-style', 'css')
+        end,
+        'Unknown highlight%-style'
+      )
+    end),
+    test('errors when asked to converto to an unsupported format', function ()
+      local kate = highlighting.style('kate')
+      assert.error_matches(
+        function ()
+          highlighting.definitions(kate, 'markdown')
+        end,
+        'Unsupported format'
+      )
+    end),
+  },
+
+  group 'highlight' {
+    test('produces highlighted code', function ()
+      local espresso = highlighting.style 'espresso'
+      local codeblock = pandoc.CodeBlock('print(42, "answer")', {class='lua'})
+      local highlighted = highlighting.highlight(codeblock, 'html')
+      assert.are_equal('string', type(highlighted))
+    end)
+  },
+
+  group 'style' {
+    test('returns a table for a default style', function ()
+      local style = highlighting.style('espresso')
+      assert.are_equal('table', type(style))
+    end),
+    test('errors when presented with an unknown style name', function ()
+      assert.error_matches(
+        function ()
+          highlighting.style('unknown-style')
+        end,
+        'Unknown highlight%-style unknown%-style'
+      )
+    end)
+  },
+}