[API Change] Extract Lua code into new package pandoc-lua-engine

The flag 'lua53` must now be used with that package if pandoc is to be
compiled against Lua 5.3.

6 files changed, 845 insertions, 0 deletions

diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/MediaBag.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/MediaBag.hs
new file mode 100644
index 000000000..ca028f444
--- /dev/null
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/MediaBag.hs
@@ -0,0 +1,142 @@
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+{- |
+   Module      : Text.Pandoc.Lua.Module.MediaBag
+   Copyright   : Copyright © 2017-2022 Albert Krewinkel
+   License     : GNU GPL, version 2 or above
+   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+The Lua module @pandoc.mediabag@.
+-}
+module Text.Pandoc.Lua.Module.MediaBag
+  ( documentedModule
+  ) where
+
+import Prelude hiding (lookup)
+import Data.Maybe (fromMaybe)
+import HsLua ( LuaE, DocumentedFunction, Module (..)
+             , (<#>), (###), (=#>), (=?>), (#?), defun, functionResult
+             , opt, parameter, stringParam, textParam)
+import Text.Pandoc.Class ( CommonState (..), fetchItem, fillMediaBag
+                         , getMediaBag, modifyCommonState, setMediaBag)
+import Text.Pandoc.Error (PandocError)
+import Text.Pandoc.Lua.Marshal.Pandoc (peekPandoc, pushPandoc)
+import Text.Pandoc.Lua.Marshal.List (pushPandocList)
+import Text.Pandoc.Lua.Orphans ()
+import Text.Pandoc.Lua.PandocLua (unPandocLua)
+import Text.Pandoc.MIME (MimeType)
+
+import qualified Data.ByteString.Lazy as BL
+import qualified HsLua as Lua
+import qualified Text.Pandoc.MediaBag as MB
+
+--
+-- MediaBag submodule
+--
+documentedModule :: Module PandocError
+documentedModule = Module
+  { moduleName = "pandoc.mediabag"
+  , moduleDescription = "mediabag access"
+  , moduleFields = []
+  , moduleFunctions =
+      [ delete
+      , empty
+      , fetch
+      , fill
+      , insert
+      , items
+      , list
+      , lookup
+      ]
+  , moduleOperations = []
+  }
+
+-- | Delete a single item from the media bag.
+delete :: DocumentedFunction PandocError
+delete = defun "delete"
+  ### (\fp -> unPandocLua $ modifyCommonState
+              (\st -> st { stMediaBag = MB.deleteMedia fp (stMediaBag st) }))
+  <#> stringParam "filepath" "filename of item to delete"
+  =#> []
+
+
+-- | Delete all items from the media bag.
+empty :: DocumentedFunction PandocError
+empty = defun "empty"
+  ### unPandocLua (modifyCommonState (\st -> st { stMediaBag = mempty }))
+  =#> []
+
+-- | Fill the mediabag with all images in the document that aren't
+-- present yet.
+fill :: DocumentedFunction PandocError
+fill = defun "fill"
+  ### unPandocLua . fillMediaBag
+  <#> parameter peekPandoc "Pandoc" "doc"
+        "document from which to fill the mediabag"
+  =#> functionResult pushPandoc "Pandoc" "modified document"
+  #? ("Fills the mediabag with the images in the given document.\n" <>
+      "An image that cannot be retrieved will be replaced with a Span\n" <>
+      "of class \"image\" that contains the image description.\n" <>
+      "" <>
+      "Images for which the mediabag already contains an item will\n" <>
+      "not be processed again.")
+
+-- | Insert a new item into the media bag.
+insert :: DocumentedFunction PandocError
+insert = defun "insert"
+  ### (\fp mmime contents -> unPandocLua $ do
+          mb <- getMediaBag
+          setMediaBag $ MB.insertMedia fp mmime contents mb
+          return (Lua.NumResults 0))
+  <#> stringParam "filepath" "item file path"
+  <#> opt (textParam "mimetype" "the item's MIME type")
+  <#> parameter Lua.peekLazyByteString "string" "contents" "binary contents"
+  =#> []
+
+-- | Returns iterator values to be used with a Lua @for@ loop.
+items :: DocumentedFunction PandocError
+items = defun "items"
+  ### (do
+          mb <-unPandocLua getMediaBag
+          let pushItem (fp, mimetype, contents) = do
+                Lua.pushString fp
+                Lua.pushText mimetype
+                Lua.pushByteString $ BL.toStrict contents
+                return (Lua.NumResults 3)
+          Lua.pushIterator pushItem (MB.mediaItems mb))
+  =?> "Iterator triple"
+
+-- | Function to lookup a value in the mediabag.
+lookup :: DocumentedFunction PandocError
+lookup = defun "lookup"
+  ### (\fp -> unPandocLua (MB.lookupMedia fp <$> getMediaBag) >>= \case
+          Nothing   -> 1 <$ Lua.pushnil
+          Just item -> 2 <$ do
+            Lua.pushText $ MB.mediaMimeType item
+            Lua.pushLazyByteString $ MB.mediaContents item)
+  <#> stringParam "filepath" "path of item to lookup"
+  =?> "MIME type and contents"
+
+-- | Function listing all mediabag items.
+list :: DocumentedFunction PandocError
+list = defun "list"
+  ### (unPandocLua (MB.mediaDirectory <$> getMediaBag))
+  =#> functionResult (pushPandocList pushEntry) "table" "list of entry triples"
+ where
+  pushEntry :: (FilePath, MimeType, Int) -> LuaE PandocError ()
+  pushEntry (fp, mimeType, contentLength) = do
+    Lua.newtable
+    Lua.pushName "path"   *> Lua.pushString fp              *> Lua.rawset (-3)
+    Lua.pushName "type"   *> Lua.pushText mimeType          *> Lua.rawset (-3)
+    Lua.pushName "length" *> Lua.pushIntegral contentLength *> Lua.rawset (-3)
+
+-- | Lua function to retrieve a new item.
+fetch :: DocumentedFunction PandocError
+fetch = defun "fetch"
+  ### (\src -> do
+          (bs, mimeType) <- unPandocLua $ fetchItem src
+          Lua.pushText $ fromMaybe "" mimeType
+          Lua.pushByteString bs
+          return 2)
+  <#> textParam "src" "URI to fetch"
+  =?> "Returns two string values: the fetched contents and the mimetype."
diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Pandoc.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Pandoc.hs
new file mode 100644
index 000000000..e708f4345
--- /dev/null
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Pandoc.hs
@@ -0,0 +1,320 @@
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications  #-}
+{- |
+   Module      : Text.Pandoc.Lua.Module.Pandoc
+   Copyright   : Copyright © 2017-2022 Albert Krewinkel
+   License     : GNU GPL, version 2 or above
+
+   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+   Stability   : alpha
+
+Pandoc module for lua.
+-}
+module Text.Pandoc.Lua.Module.Pandoc
+  ( pushModule
+  , documentedModule
+  ) where
+
+import Prelude hiding (read)
+import Control.Applicative ((<|>))
+import Control.Monad (forM_, when)
+import Control.Monad.Catch (catch, throwM)
+import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr)
+import Data.Default (Default (..))
+import Data.Maybe (fromMaybe)
+import Data.Proxy (Proxy (Proxy))
+import HsLua hiding (pushModule)
+import System.Exit (ExitCode (..))
+import Text.Pandoc.Definition
+import Text.Pandoc.Error (PandocError (..))
+import Text.Pandoc.Lua.Orphans ()
+import Text.Pandoc.Lua.Marshal.AST
+import Text.Pandoc.Lua.Marshal.Filter (peekFilter)
+import Text.Pandoc.Lua.Marshal.ReaderOptions ( peekReaderOptions
+                                             , pushReaderOptions)
+import Text.Pandoc.Lua.Marshal.Sources (peekSources)
+import Text.Pandoc.Lua.Marshal.WriterOptions ( peekWriterOptions
+                                             , pushWriterOptions)
+import Text.Pandoc.Lua.Module.Utils (sha1)
+import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua), liftPandocLua)
+import Text.Pandoc.Options ( ReaderOptions (readerExtensions)
+                           , WriterOptions (writerExtensions) )
+import Text.Pandoc.Process (pipeProcess)
+import Text.Pandoc.Readers (Reader (..), getReader, readers)
+import Text.Pandoc.Sources (toSources)
+import Text.Pandoc.Writers (Writer (..), getWriter, writers)
+
+import qualified HsLua as Lua
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Char8 as BSL
+import qualified Data.Set as Set
+import qualified Data.Text as T
+import qualified Text.Pandoc.UTF8 as UTF8
+
+-- | Push the "pandoc" package to the Lua stack. Requires the `List`
+-- module to be loadable.
+pushModule :: PandocLua NumResults
+pushModule = do
+  liftPandocLua $ Lua.pushModule documentedModule
+  return 1
+
+documentedModule :: Module PandocError
+documentedModule = Module
+  { moduleName = "pandoc"
+  , moduleDescription = T.unlines
+    [ "Lua functions for pandoc scripts; includes constructors for"
+    , "document elements, functions to parse text in a given"
+    , "format, and functions to filter and modify a subtree."
+    ]
+  , moduleFields = readersField : writersField :
+                   stringConstants ++ [inlineField, blockField]
+  , moduleOperations = []
+  , moduleFunctions = mconcat
+      [ functions
+      , otherConstructors
+      , blockConstructors
+      , inlineConstructors
+      , metaValueConstructors
+      ]
+  }
+
+-- | Set of input formats accepted by @read@.
+readersField :: Field PandocError
+readersField = Field
+  { fieldName = "readers"
+  , fieldDescription = T.unlines
+    [ "Set of formats that pandoc can parse. All keys in this table can"
+    , "be used as the `format` value in `pandoc.read`."
+    ]
+  , fieldPushValue = pushSet pushText $
+                     Set.fromList (map fst (readers @PandocLua))
+  }
+
+-- | Set of input formats accepted by @write@.
+writersField :: Field PandocError
+writersField = Field
+  { fieldName = "writers"
+  , fieldDescription = T.unlines
+    [ "Set of formats that pandoc can generate. All keys in this table"
+    , "can be used as the `format` value in `pandoc.write`."
+    ]
+  , fieldPushValue = pushSet pushText $
+                     Set.fromList (map fst (writers @PandocLua))
+  }
+
+-- | Inline table field
+inlineField :: Field PandocError
+inlineField = Field
+  { fieldName = "Inline"
+  , fieldDescription = "Inline constructors, nested under 'constructors'."
+  -- the nesting happens for historical reasons and should probably be
+  -- changed.
+  , fieldPushValue = pushWithConstructorsSubtable inlineConstructors
+  }
+
+-- | @Block@ module field
+blockField :: Field PandocError
+blockField = Field
+  { fieldName = "Block"
+  , fieldDescription = "Inline constructors, nested under 'constructors'."
+  -- the nesting happens for historical reasons and should probably be
+  -- changed.
+  , fieldPushValue = pushWithConstructorsSubtable blockConstructors
+  }
+
+pushWithConstructorsSubtable :: [DocumentedFunction PandocError]
+                             -> LuaE PandocError ()
+pushWithConstructorsSubtable constructors = do
+  newtable -- Field table
+  newtable -- constructor table
+  pushName "constructor" *> pushvalue (nth 2) *> rawset (nth 4)
+  forM_ constructors $ \fn -> do
+    pushName (functionName fn)
+    pushDocumentedFunction fn
+    rawset (nth 3)
+  pop 1 -- pop constructor table
+
+otherConstructors :: LuaError e => [DocumentedFunction e]
+otherConstructors =
+  [ mkPandoc
+  , mkMeta
+  , mkAttr
+  , mkAttributeList
+  , mkBlocks
+  , mkCitation
+  , mkCell
+  , mkRow
+  , mkTableHead
+  , mkTableFoot
+  , mkInlines
+  , mkListAttributes
+  , mkSimpleTable
+
+  , defun "ReaderOptions"
+    ### liftPure id
+    <#> parameter peekReaderOptions "ReaderOptions|table" "opts" "reader options"
+    =#> functionResult pushReaderOptions "ReaderOptions" "new object"
+    #? "Creates a new ReaderOptions value."
+
+  , defun "WriterOptions"
+    ### liftPure id
+    <#> parameter peekWriterOptions "WriterOptions|table" "opts"
+          "writer options"
+    =#> functionResult pushWriterOptions "WriterOptions" "new object"
+    #? "Creates a new WriterOptions value."
+  ]
+
+stringConstants :: [Field e]
+stringConstants =
+  let constrs :: forall a. Data a => Proxy a -> [String]
+      constrs _ = map showConstr . dataTypeConstrs . dataTypeOf @a $ undefined
+      nullaryConstructors = mconcat
+        [ constrs (Proxy @ListNumberStyle)
+        , constrs (Proxy @ListNumberDelim)
+        , constrs (Proxy @QuoteType)
+        , constrs (Proxy @MathType)
+        , constrs (Proxy @Alignment)
+        , constrs (Proxy @CitationMode)
+        ]
+      toField s = Field
+        { fieldName = T.pack s
+        , fieldDescription = T.pack s
+        , fieldPushValue = pushString s
+        }
+  in map toField nullaryConstructors
+
+functions :: [DocumentedFunction PandocError]
+functions =
+  [ defun "pipe"
+    ### (\command args input -> do
+            (ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input
+                            `catch` (throwM . PandocIOError "pipe")
+            case ec of
+              ExitSuccess -> 1 <$ Lua.pushLazyByteString output
+              ExitFailure n -> do
+                pushPipeError (PipeError (T.pack command) n output)
+                Lua.error)
+    <#> parameter peekString "string" "command" "path to executable"
+    <#> parameter (peekList peekString) "{string,...}" "args"
+          "list of arguments"
+    <#> parameter peekLazyByteString "string" "input"
+          "input passed to process via stdin"
+    =?> "output string, or error triple"
+
+  , defun "read"
+    ### (\content mformatspec mreaderOptions -> do
+            let formatSpec = fromMaybe "markdown" mformatspec
+                readerOpts = fromMaybe def mreaderOptions
+                readAction = getReader formatSpec >>= \case
+                  (TextReader r, es)       ->
+                    r readerOpts{readerExtensions = es}
+                      (case content of
+                         Left bs       -> toSources $ UTF8.toText bs
+                         Right sources -> sources)
+                  (ByteStringReader r, es) ->
+                    case content of
+                      Left bs -> r readerOpts{readerExtensions = es}
+                                   (BSL.fromStrict bs)
+                      Right _ -> liftPandocLua $ Lua.failLua
+                                 "Cannot use bytestring reader with Sources"
+            try (unPandocLua readAction) >>= \case
+              Right pd ->
+                -- success, got a Pandoc document
+                return pd
+              Left  (PandocUnknownReaderError f) ->
+                Lua.failLua . T.unpack $ "Unknown reader: " <> f
+              Left  (PandocUnsupportedExtensionError e f) ->
+                Lua.failLua . T.unpack $
+                "Extension " <> e <> " not supported for " <> f
+              Left e ->
+                throwM e)
+    <#> parameter (\idx -> (Left  <$> peekByteString idx)
+                       <|> (Right <$> peekSources idx))
+          "string|Sources" "content" "text to parse"
+    <#> opt (textParam "formatspec" "format and extensions")
+    <#> opt (parameter peekReaderOptions "ReaderOptions" "reader_options"
+             "reader options")
+    =#> functionResult pushPandoc "Pandoc" "result document"
+
+  , sha1
+
+  , defun "walk_block"
+    ### walkElement
+    <#> parameter peekBlockFuzzy "Block" "block" "element to traverse"
+    <#> parameter peekFilter "Filter" "lua_filter" "filter functions"
+    =#> functionResult pushBlock "Block" "modified Block"
+
+  , defun "walk_inline"
+    ### walkElement
+    <#> parameter peekInlineFuzzy "Inline" "inline" "element to traverse"
+    <#> parameter peekFilter "Filter" "lua_filter" "filter functions"
+    =#> functionResult pushInline "Inline" "modified Inline"
+
+  , defun "write"
+    ### (\doc mformatspec mwriterOpts -> do
+            let formatSpec = fromMaybe "html" mformatspec
+                writerOpts = fromMaybe def mwriterOpts
+            unPandocLua $ getWriter formatSpec >>= \case
+              (TextWriter w, es)      -> Right <$>
+                w writerOpts{ writerExtensions = es } doc
+              (ByteStringWriter w, es) -> Left <$>
+                w writerOpts{ writerExtensions = es } doc)
+    <#> parameter peekPandoc "Pandoc" "doc" "document to convert"
+    <#> opt (textParam "formatspec" "format and extensions")
+    <#> opt (parameter peekWriterOptions "WriterOptions" "writer_options"
+              "writer options")
+    =#> functionResult (either pushLazyByteString pushText) "string"
+          "result document"
+  ]
+ where
+  walkElement x f =
+        walkInlineSplicing f x
+    >>= walkInlinesStraight f
+    >>= walkBlockSplicing f
+    >>= walkBlocksStraight f
+
+data PipeError = PipeError
+  { pipeErrorCommand :: T.Text
+  , pipeErrorCode :: Int
+  , pipeErrorOutput :: BL.ByteString
+  }
+
+peekPipeError :: LuaError e => StackIndex -> LuaE e PipeError
+peekPipeError idx =
+  PipeError
+  <$> (Lua.getfield idx "command"    *> Lua.peek (-1) <* Lua.pop 1)
+  <*> (Lua.getfield idx "error_code" *> Lua.peek (-1) <* Lua.pop 1)
+  <*> (Lua.getfield idx "output"     *> Lua.peek (-1) <* Lua.pop 1)
+
+pushPipeError :: LuaError e => Pusher e PipeError
+pushPipeError pipeErr = do
+  pushAsTable [ ("command"    , pushText . pipeErrorCommand)
+              , ("error_code" , pushIntegral . pipeErrorCode)
+              , ("output"     , pushLazyByteString . pipeErrorOutput)
+              ] pipeErr
+  pushPipeErrorMetaTable
+  Lua.setmetatable (nth 2)
+    where
+      pushPipeErrorMetaTable :: LuaError e => LuaE e ()
+      pushPipeErrorMetaTable = do
+        v <- Lua.newmetatable "pandoc pipe error"
+        when v $ do
+          pushName "__tostring"
+          pushHaskellFunction pipeErrorMessage
+          rawset (nth 3)
+
+      pipeErrorMessage :: LuaError e => LuaE e NumResults
+      pipeErrorMessage = do
+        (PipeError cmd errorCode output) <- peekPipeError (nthBottom 1)
+        pushByteString . BSL.toStrict . BSL.concat $
+          [ BSL.pack "Error running "
+          , BSL.pack $ T.unpack cmd
+          , BSL.pack " (error code "
+          , BSL.pack $ show errorCode
+          , BSL.pack "): "
+          , if output == mempty then BSL.pack "<no output>" else output
+          ]
+        return (NumResults 1)
diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/System.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/System.hs
new file mode 100644
index 000000000..70ef1b315
--- /dev/null
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/System.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{- |
+   Module      : Text.Pandoc.Lua.Module.System
+   Copyright   : © 2019-2022 Albert Krewinkel
+   License     : GNU GPL, version 2 or above
+
+   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+   Stability   : alpha
+
+Pandoc's system Lua module.
+-}
+module Text.Pandoc.Lua.Module.System
+  ( documentedModule
+  ) where
+
+import HsLua
+import HsLua.Module.System
+  (arch, env, getwd, ls, mkdir, os, rmdir, with_env, with_tmpdir, with_wd)
+
+-- | Push the pandoc.system module on the Lua stack.
+documentedModule :: LuaError e => Module e
+documentedModule = Module
+  { moduleName = "pandoc.system"
+  , moduleDescription = "system functions"
+  , moduleFields =
+      [ arch
+      , os
+      ]
+  , moduleFunctions =
+      [ setName "environment" env
+      , setName "get_working_directory" getwd
+      , setName "list_directory" ls
+      , setName "make_directory" mkdir
+      , setName "remove_directory" rmdir
+      , setName "with_environment" with_env
+      , setName "with_temporary_directory" with_tmpdir
+      , setName "with_working_directory" with_wd
+      ]
+  , moduleOperations = []
+  }
diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Template.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Template.hs
new file mode 100644
index 000000000..967fe31a8
--- /dev/null
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Template.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE OverloadedStrings #-}
+{- |
+   Module      : Text.Pandoc.Lua.Module.Template
+   Copyright   : Copyright © 2022 Albert Krewinkel, John MacFarlane
+   License     : GNU GPL, version 2 or above
+   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+Lua module to handle pandoc templates.
+-}
+module Text.Pandoc.Lua.Module.Template
+  ( documentedModule
+  ) where
+
+import HsLua
+import Text.Pandoc.Error (PandocError)
+import Text.Pandoc.Lua.Marshal.Template (pushTemplate)
+import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua), liftPandocLua)
+import Text.Pandoc.Templates
+  (compileTemplate, getDefaultTemplate, runWithPartials, runWithDefaultPartials)
+
+import qualified Data.Text as T
+
+-- | The "pandoc.template" module.
+documentedModule :: Module PandocError
+documentedModule = Module
+  { moduleName = "pandoc.template"
+  , moduleDescription = T.unlines
+    [ "Lua functions for pandoc templates."
+    ]
+  , moduleFields = []
+  , moduleOperations = []
+  , moduleFunctions = functions
+  }
+
+-- | Template module functions.
+functions :: [DocumentedFunction PandocError]
+functions =
+  [ defun "compile"
+     ### (\template mfilepath -> unPandocLua $
+           case mfilepath of
+             Just fp -> runWithPartials (compileTemplate fp template)
+             Nothing -> runWithDefaultPartials
+                        (compileTemplate "templates/default" template))
+     <#> parameter peekText "string" "template" "template string"
+     <#> opt (stringParam "templ_path" "template path")
+     =#> functionResult (either failLua pushTemplate) "pandoc Template"
+           "compiled template"
+
+  , defun "default"
+     ### (\mformat -> unPandocLua $ do
+           let getFORMAT = liftPandocLua $ do
+                 getglobal "FORMAT"
+                 forcePeek $ peekText top `lastly` pop 1
+           format <- maybe getFORMAT pure mformat
+           getDefaultTemplate format)
+     <#> opt (textParam "writer"
+              "writer for which the template should be returned.")
+     =#> functionResult pushText "string"
+           "string representation of the writer's default template"
+
+  ]
diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Types.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Types.hs
new file mode 100644
index 000000000..b8d45d93e
--- /dev/null
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Types.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE OverloadedStrings #-}
+{- |
+   Module      : Text.Pandoc.Lua.Module.Types
+   Copyright   : © 2019-2022 Albert Krewinkel
+   License     : GNU GPL, version 2 or above
+
+   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+   Stability   : alpha
+
+Pandoc data type constructors.
+-}
+module Text.Pandoc.Lua.Module.Types
+  ( documentedModule
+  ) where
+
+import HsLua ( Module (..), (###), (<#>), (=#>)
+             , defun, functionResult, parameter)
+import HsLua.Module.Version (peekVersionFuzzy, pushVersion)
+import Text.Pandoc.Error (PandocError)
+import Text.Pandoc.Lua.ErrorConversion ()
+
+-- | Push the pandoc.types module on the Lua stack.
+documentedModule :: Module PandocError
+documentedModule = Module
+  { moduleName = "pandoc.types"
+  , moduleDescription =
+      "Constructors for types that are not part of the pandoc AST."
+  , moduleFields = []
+  , moduleFunctions =
+      [ defun "Version"
+        ### return
+        <#> parameter peekVersionFuzzy "string|integer|{integer,...}|Version"
+              "version_specifier"
+              (mconcat [ "either a version string like `'2.7.3'`, "
+                       , "a single integer like `2`, "
+                       , "list of integers like `{2,7,3}`, "
+                       , "or a Version object"
+                       ])
+        =#> functionResult pushVersion "Version" "A new Version object."
+      ]
+  , moduleOperations = []
+  }
diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Utils.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Utils.hs
new file mode 100644
index 000000000..33349870c
--- /dev/null
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Utils.hs
@@ -0,0 +1,239 @@
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+{- |
+   Module      : Text.Pandoc.Lua.Module.Utils
+   Copyright   : Copyright © 2017-2022 Albert Krewinkel
+   License     : GNU GPL, version 2 or above
+
+   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+   Stability   : alpha
+
+Utility module for Lua, exposing internal helper functions.
+-}
+module Text.Pandoc.Lua.Module.Utils
+  ( documentedModule
+  , sha1
+  ) where
+
+import Control.Applicative ((<|>))
+import Control.Monad ((<$!>))
+import Data.Data (showConstr, toConstr)
+import Data.Default (def)
+import Data.Maybe (fromMaybe)
+import Data.Version (Version)
+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.Filter (applyJSONFilter)
+import Text.Pandoc.Lua.Marshal.AST
+import Text.Pandoc.Lua.Marshal.Reference
+import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua))
+
+import qualified Data.Digest.Pure.SHA as SHA
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.Map as Map
+import qualified Data.Text as T
+import qualified Text.Pandoc.Builder as B
+import qualified Text.Pandoc.Shared as Shared
+import qualified Text.Pandoc.UTF8 as UTF8
+import qualified Text.Pandoc.Writers.Shared as Shared
+
+-- | Push the "pandoc.utils" module to the Lua stack.
+documentedModule :: Module PandocError
+documentedModule = Module
+  { moduleName = "pandoc.utils"
+  , moduleDescription = "pandoc utility functions"
+  , moduleFields = []
+  , moduleOperations = []
+  , moduleFunctions =
+    [ defun "blocks_to_inlines"
+      ### (\blks mSep -> do
+              let sep = maybe Shared.defaultBlocksSeparator B.fromList mSep
+              return $ B.toList (Shared.blocksToInlinesWithSep sep blks))
+      <#> parameter (peekList peekBlock) "list of blocks"
+            "blocks" ""
+      <#> opt (parameter (peekList peekInline) "list of inlines" "inline" "")
+      =#> functionResult pushInlines "list of inlines" ""
+
+    , defun "citeproc"
+      ### unPandocLua . processCitations
+      <#> parameter peekPandoc "Pandoc" "doc" "document"
+      =#> functionResult pushPandoc "Pandoc" "processed document"
+      #?  T.unwords
+          [ "Process the citations in the file, replacing them with "
+          , "rendered citations and adding a bibliography. "
+          , "See the manual section on citation rendering for details."
+          ]
+
+    , defun "equals"
+      ### equal
+      <#> parameter pure "AST element" "elem1" ""
+      <#> parameter pure "AST element" "elem2" ""
+      =#> functionResult pushBool "boolean" "true iff elem1 == elem2"
+
+    , defun "make_sections"
+      ### liftPure3 Shared.makeSections
+      <#> parameter peekBool "boolean" "numbering" "add header numbers"
+      <#> parameter (\i -> (Nothing <$ peekNil i) <|> (Just <$!> peekIntegral i))
+                    "integer or nil" "baselevel" ""
+      <#> parameter (peekList peekBlock) "list of blocks"
+            "blocks" "document blocks to process"
+      =#> functionResult pushBlocks "list of Blocks"
+            "processes blocks"
+
+    , defun "normalize_date"
+      ### liftPure Shared.normalizeDate
+      <#> parameter peekText "string" "date" "the date string"
+      =#> functionResult (maybe pushnil pushText) "string or nil"
+            "normalized date, or nil if normalization failed."
+      #? T.unwords
+      [ "Parse a date and convert (if possible) to \"YYYY-MM-DD\" format. We"
+      , "limit years to the range 1601-9999 (ISO 8601 accepts greater than"
+      , "or equal to 1583, but MS Word only accepts dates starting 1601)."
+      , "Returns nil instead of a string if the conversion failed."
+      ]
+
+    , sha1
+
+    , defun "Version"
+      ### liftPure (id @Version)
+      <#> parameter peekVersionFuzzy
+            "version string, list of integers, or integer"
+            "v" "version description"
+      =#> functionResult pushVersion "Version" "new Version object"
+      #? "Creates a Version object."
+
+    , defun "references"
+      ### (unPandocLua . getReferences Nothing)
+      <#> parameter peekPandoc "Pandoc" "doc" "document"
+      =#> functionResult (pushPandocList pushReference) "table"
+            "lift of references"
+      #? mconcat
+         [ "Get references defined inline in the metadata and via an external "
+         , "bibliography.  Only references that are actually cited in the "
+         , "document (either with a genuine citation or with `nocite`) are "
+         , "returned. URL variables are converted to links."
+         ]
+
+    , defun "run_json_filter"
+      ### (\doc filterPath margs -> do
+              args <- case margs of
+                        Just xs -> return xs
+                        Nothing -> do
+                          Lua.getglobal "FORMAT"
+                          (forcePeek ((:[]) <$!> peekString top) <* pop 1)
+              applyJSONFilter def args filterPath doc
+          )
+      <#> parameter peekPandoc "Pandoc" "doc" "input document"
+      <#> parameter peekString "filepath" "filter_path" "path to filter"
+      <#> opt (parameter (peekList peekString) "list of strings"
+               "args" "arguments to pass to the filter")
+      =#> functionResult pushPandoc "Pandoc" "filtered document"
+
+    , defun "stringify"
+      ### stringify
+      <#> parameter pure "AST element" "elem" "some pandoc AST element"
+      =#> functionResult pushText "string" "stringified element"
+
+    , defun "from_simple_table"
+      ### from_simple_table
+      <#> parameter peekSimpleTable "SimpleTable" "simple_tbl" ""
+      =?> "Simple table"
+
+    , defun "to_roman_numeral"
+      ### liftPure Shared.toRomanNumeral
+      <#> parameter (peekIntegral @Int) "integer" "n" "number smaller than 4000"
+      =#> functionResult pushText "string" "roman numeral"
+      #? "Converts a number < 4000 to uppercase roman numeral."
+
+    , defun "to_simple_table"
+      ### to_simple_table
+      <#> parameter peekTable "Block" "tbl" "a table"
+      =#> functionResult pushSimpleTable "SimpleTable" "SimpleTable object"
+      #? "Converts a table into an old/simple table."
+
+    , defun "type"
+      ### (\idx -> getmetafield idx "__name" >>= \case
+              TypeString -> fromMaybe mempty <$> tostring top
+              _ -> ltype idx >>= typename)
+      <#> parameter pure "any" "object" ""
+      =#> functionResult pushByteString "string" "type of the given value"
+    #? ("Pandoc-friendly version of Lua's default `type` function, " <>
+        "returning the type of a value. If the argument has a " <>
+        "string-valued metafield `__name`, then it gives that string. " <>
+        "Otherwise it behaves just like the normal `type` function.")
+    ]
+  }
+
+-- | Documented Lua function to compute the hash of a string.
+sha1 :: DocumentedFunction e
+sha1 = defun "sha1"
+  ### liftPure (SHA.showDigest . SHA.sha1)
+  <#> parameter (fmap BSL.fromStrict . peekByteString) "string" "input" ""
+  =#> functionResult pushString "string" "hexadecimal hash value"
+  #? "Compute the hash of the given string value."
+
+
+-- | Convert pandoc structure to a string with formatting removed.
+-- Footnotes are skipped (since we don't want their contents in link
+-- labels).
+stringify :: LuaError e => StackIndex -> LuaE e T.Text
+stringify idx = forcePeek . retrieving "stringifyable element" $
+  choice
+  [ (fmap Shared.stringify . peekPandoc)
+  , (fmap Shared.stringify . peekInline)
+  , (fmap Shared.stringify . peekBlock)
+  , (fmap Shared.stringify . peekCitation)
+  , (fmap stringifyMetaValue . peekMetaValue)
+  , (fmap (const "") . peekAttr)
+  , (fmap (const "") . peekListAttributes)
+  ] idx
+ where
+  stringifyMetaValue :: MetaValue -> T.Text
+  stringifyMetaValue mv = case mv of
+    MetaBool b   -> T.toLower $ T.pack (show b)
+    MetaString s -> s
+    MetaList xs  -> mconcat $ map stringifyMetaValue xs
+    MetaMap m    -> mconcat $ map (stringifyMetaValue . snd) (Map.toList m)
+    _            -> Shared.stringify mv
+
+-- | Converts an old/simple table into a normal table block element.
+from_simple_table :: SimpleTable -> LuaE PandocError NumResults
+from_simple_table (SimpleTable capt aligns widths head' body) = do
+  Lua.push $ Table
+    nullAttr
+    (Caption Nothing [Plain capt | not (null capt)])
+    (zipWith (\a w -> (a, toColWidth w)) aligns widths)
+    (TableHead nullAttr [blockListToRow head' | not (null head') ])
+    [TableBody nullAttr 0 [] $ map blockListToRow body | not (null body)]
+    (TableFoot nullAttr [])
+  return (NumResults 1)
+  where
+    blockListToRow :: [[Block]] -> Row
+    blockListToRow = Row nullAttr . map (B.simpleCell . B.fromList)
+
+    toColWidth :: Double -> ColWidth
+    toColWidth 0 = ColWidthDefault
+    toColWidth w = ColWidth w
+
+-- | Converts a table into an old/simple table.
+to_simple_table :: Block -> LuaE PandocError SimpleTable
+to_simple_table = \case
+  Table _attr caption specs thead tbodies tfoot -> do
+    let (capt, aligns, widths, headers, rows) =
+          Shared.toLegacyTable caption specs thead tbodies tfoot
+    return $ SimpleTable capt aligns widths headers rows
+  blk -> Lua.failLua $ mconcat
+         [ "Expected Table, got ", showConstr (toConstr blk), "." ]
+
+peekTable :: LuaError e => Peeker e Block
+peekTable idx = peekBlock idx >>= \case
+  t@(Table {}) -> return t
+  b -> Lua.failPeek $ mconcat
+       [ "Expected Table, got "
+       , UTF8.fromString $ showConstr (toConstr b)
+       , "." ]