Lua: Support built-in default templates for custom writers

Custom writers can define a default template via a global `Template`
function; the data directory is no longer searched for a default
template.

Writer authors can restore the old lookup behavior with

``` lua
Template = function ()
  local template
  return template.compile(template.default(PANDOC_SCRIPT_FILE))
end
```

Author: tarleb

.gitattributes

@@ -1,2 +1,3 @@
 test/fb2/reader/* -text
 pandoc-lua-engine/test/*.custom		-text
+pandoc-lua-engine/test/*.txt		-text

doc/custom-writers.md

@@ -83,6 +83,17 @@ function Writer (doc, opts)
 end
 ```
 
+## Default template
+
+The default template of a custom writer is defined by the return
+value of the global function `Template`. Pandoc uses the default
+template for rendering when the user has not specified a template,
+but invoked with the `-s`/`--standalone` flag.
+
+The `Template` global can be left undefined, in which case pandoc
+will throw an error when it would otherwise use the default
+template.
+
 ## Example: modified Markdown writer
 
 Writers have access to all modules described in the [Lua filters
@@ -106,6 +117,11 @@ function Writer (doc, opts)
   }
   return pandoc.write(doc:walk(filter), 'gfm', opts)
 end
+
+function Template ()
+  local template = pandoc.template
+  return template.compile(template.default 'gfm')
+end
 ```
 
 [Lua filters documentation]: https://pandoc.org/lua-filters.html

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

@@ -32,6 +32,8 @@ extra-source-files:  README.md
                    , test/tables.native
                    , test/testsuite.native
                    , test/writer.custom
+                   , test/writer-template.lua
+                   , test/writer-template.out.txt
 
 source-repository head
   type:                git

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

@@ -21,21 +21,24 @@ import Control.Exception
 import Control.Monad ((<=<))
 import Data.Default (def)
 import Data.Maybe (fromMaybe)
+import Data.Text (Text)
 import HsLua
 import HsLua.Core.Run (newGCManagedState, withGCManagedState)
 import Control.Monad.IO.Class (MonadIO)
 import Text.Pandoc.Class (PandocMonad, findFileWithDataFallback)
-import Text.Pandoc.Error (PandocError)
+import Text.Pandoc.Error (PandocError (..))
 import Text.Pandoc.Format (ExtensionsConfig (..))
 import Text.Pandoc.Lua.Global (Global (..), setGlobals)
 import Text.Pandoc.Lua.Init (runLuaWith)
 import Text.Pandoc.Lua.Marshal.Format (peekExtensionsConfig)
+import Text.Pandoc.Lua.Marshal.Template (peekTemplate)
+import Text.Pandoc.Templates (Template)
 import Text.Pandoc.Writers (Writer (..))
 import qualified Text.Pandoc.Lua.Writer.Classic as Classic
 
 -- | Convert Pandoc to custom markup.
 writeCustom :: (PandocMonad m, MonadIO m)
-            => FilePath -> m (Writer m, ExtensionsConfig)
+            => FilePath -> m (Writer m, ExtensionsConfig, m (Template Text))
 writeCustom luaFile = do
   luaState <- liftIO newGCManagedState
   luaFile' <- fromMaybe luaFile <$> findFileWithDataFallback "writers" luaFile
@@ -56,25 +59,39 @@ writeCustom luaFile = do
           pushName x
           rawget (nth 2) <* remove (nth 2) -- remove global table
 
-    let writerField = "PANDOC Writer function"
+    let writerField = "Pandoc Writer function"
 
     extsConf <- rawgetglobal "writer_extensions" >>= \case
-      TypeNil   -> pure $ ExtensionsConfig mempty mempty
+      TypeNil   -> ExtensionsConfig mempty mempty <$ pop 1
       _         -> forcePeek $ peekExtensionsConfig top `lastly` pop 1
 
+    -- Store template function in registry
+    let templateField = "Pandoc Writer Template"
+    rawgetglobal "Template" *> setfield registryindex templateField
+
+    let getTemplate = liftIO $ withGCManagedState @PandocError luaState $ do
+          getfield registryindex templateField >>= \case
+            TypeNil   -> failLua $ "No default template for writer; " <>
+                         "the global variable Template is undefined."
+            _ -> do
+              callTrace 0 1
+              forcePeek $ peekTemplate top `lastly` pop 1
+
+    let addProperties = (, extsConf, getTemplate)
+
     rawgetglobal "Writer" >>= \case
       TypeNil -> rawgetglobal "ByteStringWriter" >>= \case
         TypeNil -> do
           -- Neither `Writer` nor `BinaryWriter` are defined. Try to
           -- use the file as a classic writer.
           pop 1  -- remove nil
-          pure $ (,extsConf) . TextWriter $ \opts doc ->
+          pure $ addProperties . TextWriter $ \opts doc ->
             liftIO $ withGCManagedState luaState $ do
               Classic.runCustom @PandocError opts doc
         _ -> do
           -- Binary writer. Writer function is on top of the stack.
           setfield registryindex writerField
-          pure $ (,extsConf) . ByteStringWriter $ \opts doc ->
+          pure $ addProperties . ByteStringWriter $ \opts doc ->
             -- Call writer with document and writer options as arguments.
             liftIO $ withGCManagedState luaState $ do
               getfield registryindex writerField
@@ -85,7 +102,7 @@ writeCustom luaFile = do
       _ -> do
         -- New-type text writer. Writer function is on top of the stack.
         setfield registryindex writerField
-        pure $ (,extsConf) . TextWriter $ \opts doc ->
+        pure $ addProperties . TextWriter $ \opts doc ->
           liftIO $ withGCManagedState luaState $ do
             getfield registryindex writerField
             push doc

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

@@ -35,7 +35,7 @@ tests =
         source <- UTF8.toText <$> readFileStrict "testsuite.native"
         doc <- readNative def source
         txt <- writeCustom "sample.lua" >>= \case
-          (TextWriter f, _) -> f def doc
+          (TextWriter f, _, _) -> f def doc
           _            -> error "Expected a text writer"
         pure $ BL.fromStrict (UTF8.fromText txt))
 
@@ -45,23 +45,34 @@ tests =
         source <- UTF8.toText <$> readFileStrict "tables.native"
         doc <- readNative def source
         txt <- writeCustom "sample.lua" >>= \case
-          (TextWriter f, _) -> f def doc
+          (TextWriter f, _, _) -> f def doc
           _            -> error "Expected a text writer"
         pure $ BL.fromStrict (UTF8.fromText txt))
 
-  , goldenVsString "tables testsuite"
+  , goldenVsString "bytestring writer"
     "bytestring.bin"
     (runIOorExplode $ do
         txt <- writeCustom "bytestring.lua" >>= \case
-          (ByteStringWriter f, _) -> f def mempty
+          (ByteStringWriter f, _, _) -> f def mempty
           _                       -> error "Expected a bytestring writer"
         pure txt)
 
+  , goldenVsString "template"
+    "writer-template.out.txt"
+    (runIOorExplode $ do
+        txt <- writeCustom "writer-template.lua" >>= \case
+          (TextWriter f, _, mt) -> do
+            template <- mt
+            let opts = def{ writerTemplate = Just template }
+            f opts (B.doc (B.plain (B.str "body goes here")))
+          _ -> error "Expected a text writer"
+        pure $ BL.fromStrict (UTF8.fromText txt))
+
   , testCase "preset extensions" $ do
       let ediff = ExtensionsDiff{extsToEnable = [], extsToDisable = []}
       let format = FlavoredFormat "extensions.lua" ediff
       result <- runIOorExplode $ writeCustom "extensions.lua" >>= \case
-          (TextWriter write, extsConf) -> do
+          (TextWriter write, extsConf, _) -> do
             exts <- applyExtensionsDiff extsConf format
             write def{writerExtensions = exts} (B.doc mempty)
           _                        -> error "Expected a text writer"
@@ -73,7 +84,7 @@ tests =
             }
       let format = FlavoredFormat "extensions.lua" ediff
       result <- runIOorExplode $ writeCustom "extensions.lua" >>= \case
-          (TextWriter write, extsConf) -> do
+          (TextWriter write, extsConf, _) -> do
             exts <- applyExtensionsDiff extsConf format
             write def{writerExtensions = exts} (B.doc mempty)
           _                        -> error "Expected a text writer"

pandoc-lua-engine/test/writer-template.lua

@@ -0,0 +1,7 @@
+function Writer (doc, opts)
+  return pandoc.write(doc, 'gfm', opts)
+end
+
+function Template ()
+  return pandoc.template.compile '<!-- start -->\n$body$\n<!-- stop -->\n'
+end

pandoc-lua-engine/test/writer-template.out.txt

@@ -0,0 +1,4 @@
+<!-- start -->
+body goes here
+
+<!-- stop -->

src/Text/Pandoc/App/OutputSettings.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP                 #-}
 {-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections       #-}
@@ -104,20 +105,40 @@ optToOutputSettings scriptingEngine opts = do
 
   flvrd@(Format.FlavoredFormat format _extsDiff) <-
     Format.parseFlavoredFormat writerName
-  (writer, writerExts) <-
+
+  let standalone = optStandalone opts || not (isTextFormat format) || pdfOutput
+  let processCustomTemplate getDefault =
+        case optTemplate opts of
+          _ | not standalone -> return Nothing
+          Nothing -> Just <$> getDefault
+          Just tp -> do
+            -- strip off extensions
+            let tp' = case takeExtension tp of
+                        "" -> tp <.> T.unpack format
+                        _  -> tp
+            getTemplate tp'
+              >>= runWithPartials . compileTemplate tp'
+              >>= (\case
+                      Left  e -> throwError $ PandocTemplateError (T.pack e)
+                      Right t -> return $ Just t)
+
+  (writer, writerExts, mtemplate) <-
     if "lua" `T.isSuffixOf` format
     then do
-      (w, extsConf) <- engineWriteCustom scriptingEngine (T.unpack format)
-      wexts         <- Format.applyExtensionsDiff extsConf flvrd
-      return (w, wexts)
+      (w, extsConf, mt) <- engineWriteCustom scriptingEngine (T.unpack format)
+      wexts <- Format.applyExtensionsDiff extsConf flvrd
+      templ <- processCustomTemplate mt
+      return (w, wexts, templ)
     else do
+      tmpl <- processCustomTemplate (compileDefaultTemplate format)
       if optSandbox opts
       then case runPure (getWriter flvrd) of
-             Right (w, wexts) -> return (makeSandboxed w, wexts)
+             Right (w, wexts) -> return (makeSandboxed w, wexts, tmpl)
              Left e           -> throwError e
-      else getWriter flvrd
+      else do
+           (w, wexts) <- getWriter flvrd
+           return (w, wexts, tmpl)
 
-  let standalone = optStandalone opts || not (isTextFormat format) || pdfOutput
 
   let addSyntaxMap existingmap f = do
         res <- liftIO (parseSyntaxDefinition f)
@@ -186,23 +207,8 @@ optToOutputSettings scriptingEngine opts = do
                       setVariableM "dzslides-core" dzcore vars
                   else return vars)
 
-  templ <- case optTemplate opts of
-                  _ | not standalone -> return Nothing
-                  Nothing ->
-                    let filename = T.pack . takeFileName . T.unpack
-                    in Just <$> compileDefaultTemplate (filename format)
-                  Just tp -> do
-                    -- strip off extensions
-                    let tp' = case takeExtension tp of
-                                   "" -> tp <.> T.unpack format
-                                   _  -> tp
-                    res <- getTemplate tp' >>= runWithPartials . compileTemplate tp'
-                    case res of
-                      Left  e -> throwError $ PandocTemplateError $ T.pack e
-                      Right t -> return $ Just t
-
   let writerOpts = def {
-          writerTemplate         = templ
+          writerTemplate         = mtemplate
         , writerVariables        = variables
         , writerTabStop          = optTabStop opts
         , writerTableOfContents  = optTableOfContents opts

src/Text/Pandoc/Scripting.hs

@@ -23,6 +23,7 @@ import Text.Pandoc.Definition (Pandoc)
 import Text.Pandoc.Error (PandocError (PandocNoScriptingEngine))
 import Text.Pandoc.Filter.Environment (Environment)
 import Text.Pandoc.Format (ExtensionsConfig)
+import Text.Pandoc.Templates (Template)
 import Text.Pandoc.Readers (Reader)
 import Text.Pandoc.Writers (Writer)
 
@@ -40,10 +41,12 @@ data ScriptingEngine = ScriptingEngine
     -- ^ Function to parse input into a 'Pandoc' document.
 
   , engineWriteCustom :: forall m. (PandocMonad m, MonadIO m)
-                      => FilePath -> m (Writer m, ExtensionsConfig)
+                      => FilePath -> m (WriterProperties m)
     -- ^ Invoke the given script file to convert to any custom format.
   }
 
+type WriterProperties m = (Writer m, ExtensionsConfig, m (Template Text))
+
 noEngine :: ScriptingEngine
 noEngine = ScriptingEngine
   { engineName = "none"