From 7b5f88a4a9ce421f7517b015623e72898c27c47b Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 28 Dec 2021 16:33:41 +0100 Subject: [PATCH] Lua: provide global `PANDOC_WRITER_OPTIONS` [API change] API changes: - The function T.P.Filter.applyFilters now takes a filter environment of type `Environment`, instead of a ReaderOptions value. The `Environment` type is exported from `T.P.Filter` and allows to combine ReaderOptions and WriterOptions in a single value. - Global, exported from T.P.Lua, has a new type constructor `PANDOC_WRITER_OPTIONS`. Closes: #5221 --- doc/lua-filters.md | 5 + pandoc.cabal | 2 + src/Text/Pandoc/App.hs | 6 +- src/Text/Pandoc/Filter.hs | 12 +- src/Text/Pandoc/Filter/Environment.hs | 27 ++ src/Text/Pandoc/Filter/JSON.hs | 11 +- src/Text/Pandoc/Filter/Lua.hs | 9 +- src/Text/Pandoc/Lua/Global.hs | 11 +- src/Text/Pandoc/Lua/Marshal/WriterOptions.hs | 255 +++++++++++++++++++ 9 files changed, 318 insertions(+), 20 deletions(-) create mode 100644 src/Text/Pandoc/Filter/Environment.hs create mode 100644 src/Text/Pandoc/Lua/Marshal/WriterOptions.hs diff --git a/doc/lua-filters.md b/doc/lua-filters.md index bacdabe006b2..ac04316e2894 100644 --- a/doc/lua-filters.md +++ b/doc/lua-filters.md @@ -262,6 +262,11 @@ variables. `PANDOC_READER_OPTIONS` : Table of the options which were provided to the parser. +`PANDOC_WRITER_OPTIONS` +: Table of the options that will be passed to the writer. + While the object can be modified, the changes will **not** + be picked up by pandoc. + `PANDOC_VERSION` : Contains the pandoc version as a [Version] object which behaves like a numerically indexed table, most significant diff --git a/pandoc.cabal b/pandoc.cabal index 738b2450b42b..0f9cd759590c 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -631,6 +631,7 @@ library Text.Pandoc.Class.PandocIO, Text.Pandoc.Class.PandocPure, Text.Pandoc.Class.Sandbox, + Text.Pandoc.Filter.Environment, Text.Pandoc.Filter.JSON, Text.Pandoc.Filter.Lua, Text.Pandoc.Filter.Path, @@ -705,6 +706,7 @@ library Text.Pandoc.Lua.Marshal.ReaderOptions, Text.Pandoc.Lua.Marshal.Reference, Text.Pandoc.Lua.Marshal.Sources, + Text.Pandoc.Lua.Marshal.WriterOptions, Text.Pandoc.Lua.Module.MediaBag, Text.Pandoc.Lua.Module.Pandoc, Text.Pandoc.Lua.Module.System, diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index 9eb9c2cf32df..f3a1c8f2847e 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -60,7 +60,8 @@ import Text.Pandoc.App.CommandLineOptions (parseOptions, parseOptionsFromArgs, options) import Text.Pandoc.App.OutputSettings (OutputSettings (..), optToOutputSettings) import Text.Collate.Lang (Lang (..), parseLang) -import Text.Pandoc.Filter (Filter (JSONFilter, LuaFilter), applyFilters) +import Text.Pandoc.Filter (Filter (JSONFilter, LuaFilter), Environment (..), + applyFilters) import Text.Pandoc.PDF (makePDF) import Text.Pandoc.SelfContained (makeSelfContained) import Text.Pandoc.Shared (eastAsianLineBreakFilter, stripEmptyParagraphs, @@ -280,6 +281,7 @@ convertWithOpts opts = do maybe id (setMeta "citation-abbreviations") (optCitationAbbreviations opts) $ mempty + let filterEnv = Environment readerOpts writerOptions doc <- (case reader of TextReader r | readerNameBase == "json" -> @@ -305,7 +307,7 @@ convertWithOpts opts = do >=> return . adjustMetadata (<> optMetadata opts) >=> return . adjustMetadata (<> cslMetadata) >=> applyTransforms transforms - >=> applyFilters readerOpts filters [T.unpack format] + >=> applyFilters filterEnv filters [T.unpack format] >=> maybe return extractMedia (optExtractMedia opts) ) diff --git a/src/Text/Pandoc/Filter.hs b/src/Text/Pandoc/Filter.hs index 84015ed9296c..e4640db9497d 100644 --- a/src/Text/Pandoc/Filter.hs +++ b/src/Text/Pandoc/Filter.hs @@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Filter @@ -15,6 +14,7 @@ Programmatically modifications of pandoc documents. -} module Text.Pandoc.Filter ( Filter (..) + , Environment (..) , applyFilters ) where @@ -23,7 +23,7 @@ import Data.Aeson import GHC.Generics (Generic) import Text.Pandoc.Class (report, getVerbosity, PandocMonad) import Text.Pandoc.Definition (Pandoc) -import Text.Pandoc.Options (ReaderOptions) +import Text.Pandoc.Filter.Environment (Environment (..)) import Text.Pandoc.Logging import Text.Pandoc.Citeproc (processCitations) import qualified Text.Pandoc.Filter.JSON as JSONFilter @@ -72,19 +72,19 @@ instance ToJSON Filter where -- | Modify the given document using a filter. applyFilters :: (PandocMonad m, MonadIO m) - => ReaderOptions + => Environment -> [Filter] -> [String] -> Pandoc -> m Pandoc -applyFilters ropts filters args d = do +applyFilters fenv filters args d = do expandedFilters <- mapM expandFilterPath filters foldM applyFilter d expandedFilters where applyFilter doc (JSONFilter f) = - withMessages f $ JSONFilter.apply ropts args f doc + withMessages f $ JSONFilter.apply fenv args f doc applyFilter doc (LuaFilter f) = - withMessages f $ LuaFilter.apply ropts args f doc + withMessages f $ LuaFilter.apply fenv args f doc applyFilter doc CiteprocFilter = processCitations doc withMessages f action = do diff --git a/src/Text/Pandoc/Filter/Environment.hs b/src/Text/Pandoc/Filter/Environment.hs new file mode 100644 index 000000000000..2e8809bc468c --- /dev/null +++ b/src/Text/Pandoc/Filter/Environment.hs @@ -0,0 +1,27 @@ +{- | + Module : Text.Pandoc.Filter.Environment + Copyright : ©2020-2021 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + Stability : alpha + Portability : portable + +Environment for pandoc filters. +-} +module Text.Pandoc.Filter.Environment + ( Environment (..) + ) where + +import Data.Default (Default (def)) +import Text.Pandoc.Options (ReaderOptions, WriterOptions) + +-- | Environment in which a filter is run. This includes reader and +-- writer options. +data Environment = Environment + { envReaderOptions :: ReaderOptions + , envWriterOptions :: WriterOptions + } + +instance Default Environment where + def = Environment def def diff --git a/src/Text/Pandoc/Filter/JSON.hs b/src/Text/Pandoc/Filter/JSON.hs index d2323fac4ec5..48b776455fde 100644 --- a/src/Text/Pandoc/Filter/JSON.hs +++ b/src/Text/Pandoc/Filter/JSON.hs @@ -23,16 +23,16 @@ import System.Directory (executable, doesFileExist, findExecutable, import System.Environment (getEnvironment) import System.Exit (ExitCode (..)) import System.FilePath ((), takeExtension) -import Text.Pandoc.Error (PandocError (PandocFilterError)) import Text.Pandoc.Definition (Pandoc) -import Text.Pandoc.Options (ReaderOptions) +import Text.Pandoc.Error (PandocError (PandocFilterError)) +import Text.Pandoc.Filter.Environment (Environment (..)) import Text.Pandoc.Process (pipeProcess) import Text.Pandoc.Shared (pandocVersion, tshow) import qualified Control.Exception as E import qualified Text.Pandoc.UTF8 as UTF8 apply :: MonadIO m - => ReaderOptions + => Environment -> [String] -> FilePath -> Pandoc @@ -40,8 +40,8 @@ apply :: MonadIO m apply ropts args f = liftIO . externalFilter ropts f args externalFilter :: MonadIO m - => ReaderOptions -> FilePath -> [String] -> Pandoc -> m Pandoc -externalFilter ropts f args' d = liftIO $ do + => Environment -> FilePath -> [String] -> Pandoc -> m Pandoc +externalFilter fenv f args' d = liftIO $ do exists <- doesFileExist f isExecutable <- if exists then executable <$> getPermissions f @@ -62,6 +62,7 @@ externalFilter ropts f args' d = liftIO $ do mbExe <- findExecutable f' when (isNothing mbExe) $ E.throwIO $ PandocFilterError fText (T.pack $ "Could not find executable " <> f') + let ropts = envReaderOptions fenv env <- getEnvironment let env' = Just ( ("PANDOC_VERSION", T.unpack pandocVersion) diff --git a/src/Text/Pandoc/Filter/Lua.hs b/src/Text/Pandoc/Filter/Lua.hs index 4e264261b356..fe0a5ba876df 100644 --- a/src/Text/Pandoc/Filter/Lua.hs +++ b/src/Text/Pandoc/Filter/Lua.hs @@ -18,25 +18,26 @@ import Text.Pandoc.Class (PandocMonad) import Control.Monad.Trans (MonadIO) import Text.Pandoc.Definition (Pandoc) import Text.Pandoc.Error (PandocError (PandocFilterError, PandocLuaError)) +import Text.Pandoc.Filter.Environment (Environment (..)) import Text.Pandoc.Lua (Global (..), runLua, runFilterFile, setGlobals) -import Text.Pandoc.Options (ReaderOptions) -- | Run the Lua filter in @filterPath@ for a transformation to the -- target format (first element in args). Pandoc uses Lua init files to -- setup the Lua interpreter. apply :: (PandocMonad m, MonadIO m) - => ReaderOptions + => Environment -> [String] -> FilePath -> Pandoc -> m Pandoc -apply ropts args fp doc = do +apply fenv args fp doc = do let format = case args of (x:_) -> x _ -> error "Format not supplied for Lua filter" runLua >=> forceResult fp $ do setGlobals [ FORMAT $ T.pack format - , PANDOC_READER_OPTIONS ropts + , PANDOC_READER_OPTIONS (envReaderOptions fenv) + , PANDOC_WRITER_OPTIONS (envWriterOptions fenv) , PANDOC_SCRIPT_FILE fp ] runFilterFile fp doc diff --git a/src/Text/Pandoc/Lua/Global.hs b/src/Text/Pandoc/Lua/Global.hs index cf82890c6ff2..951204d6b5ea 100644 --- a/src/Text/Pandoc/Lua/Global.hs +++ b/src/Text/Pandoc/Lua/Global.hs @@ -23,8 +23,9 @@ import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.Marshal.CommonState (pushCommonState) import Text.Pandoc.Lua.Marshal.Pandoc (pushPandoc) import Text.Pandoc.Lua.Marshal.ReaderOptions (pushReaderOptionsReadonly) +import Text.Pandoc.Lua.Marshal.WriterOptions (pushWriterOptions) import Text.Pandoc.Lua.Orphans () -import Text.Pandoc.Options (ReaderOptions) +import Text.Pandoc.Options (ReaderOptions, WriterOptions) import qualified Data.Text as Text @@ -34,6 +35,7 @@ data Global = | PANDOC_API_VERSION | PANDOC_DOCUMENT Pandoc | PANDOC_READER_OPTIONS ReaderOptions + | PANDOC_WRITER_OPTIONS WriterOptions | PANDOC_SCRIPT_FILE FilePath | PANDOC_STATE CommonState | PANDOC_VERSION @@ -47,7 +49,7 @@ setGlobal :: Global -> LuaE PandocError () setGlobal global = case global of -- This could be simplified if Global was an instance of Data. FORMAT format -> do - Lua.push format + Lua.pushText format Lua.setglobal "FORMAT" PANDOC_API_VERSION -> do pushVersion pandocTypesVersion @@ -58,8 +60,11 @@ setGlobal global = case global of PANDOC_READER_OPTIONS ropts -> do pushReaderOptionsReadonly ropts Lua.setglobal "PANDOC_READER_OPTIONS" + PANDOC_WRITER_OPTIONS wopts -> do + pushWriterOptions wopts + Lua.setglobal "PANDOC_WRITER_OPTIONS" PANDOC_SCRIPT_FILE filePath -> do - Lua.push filePath + Lua.pushString filePath Lua.setglobal "PANDOC_SCRIPT_FILE" PANDOC_STATE commonState -> do pushCommonState commonState diff --git a/src/Text/Pandoc/Lua/Marshal/WriterOptions.hs b/src/Text/Pandoc/Lua/Marshal/WriterOptions.hs new file mode 100644 index 000000000000..781ae3f7c5ac --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshal/WriterOptions.hs @@ -0,0 +1,255 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- | + Module : Text.Pandoc.Lua.Marshaling.WriterOptions + Copyright : © 2021-2022 Albert Krewinkel, John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + Stability : alpha + +Marshaling instance for WriterOptions and its components. +-} +module Text.Pandoc.Lua.Marshal.WriterOptions + ( peekWriterOptions + , pushWriterOptions + ) where + +import Control.Applicative (optional) +import Data.Aeson as Aeson +import Data.Default (def) +import HsLua as Lua +import HsLua.Aeson (peekValue, pushValue) +import Text.Pandoc.Lua.Marshal.List (pushPandocList) +import Text.Pandoc.Options (WriterOptions (..)) +import Text.Pandoc.UTF8 (fromString) + +-- +-- Writer Options +-- + +-- | Retrieve a WriterOptions value, either from a normal WriterOptions +-- value, from a read-only object, or from a table with the same +-- keys as a WriterOptions object. +peekWriterOptions :: LuaError e => Peeker e WriterOptions +peekWriterOptions = retrieving "WriterOptions" . \idx -> + liftLua (ltype idx) >>= \case + TypeUserdata -> peekUD typeWriterOptions idx + TypeTable -> peekWriterOptionsTable idx + _ -> failPeek =<< + typeMismatchMessage "WriterOptions userdata or table" idx + +-- | Pushes a WriterOptions value as userdata object. +pushWriterOptions :: LuaError e => Pusher e WriterOptions +pushWriterOptions = pushUD typeWriterOptions + +-- | 'WriterOptions' object type. +typeWriterOptions :: LuaError e => DocumentedType e WriterOptions +typeWriterOptions = deftype "WriterOptions" + [ operation Tostring $ lambda + ### liftPure show + <#> udparam typeWriterOptions "opts" "options to print in native format" + =#> functionResult pushString "string" "Haskell representation" + ] + [ property "cite_method" + "How to print cites" + (pushViaJSON, writerCiteMethod) + (peekViaJSON, \opts x -> opts{ writerCiteMethod = x }) + + , property "columns" + "Characters in a line (for text wrapping)" + (pushIntegral, writerColumns) + (peekIntegral, \opts x -> opts{ writerColumns = x }) + + , property "dpi" + "DPI for pixel to/from inch/cm conversions" + (pushIntegral, writerDpi) + (peekIntegral, \opts x -> opts{ writerDpi = x }) + + , property "email_obfuscation" + "How to obfuscate emails" + (pushViaJSON, writerEmailObfuscation) + (peekViaJSON, \opts x -> opts{ writerEmailObfuscation = x }) + + , property "epub_chapter_level" + "Header level for chapters (separate files)" + (pushIntegral, writerEpubChapterLevel) + (peekIntegral, \opts x -> opts{ writerEpubChapterLevel = x }) + + , property "epub_fonts" + "Paths to fonts to embed" + (pushPandocList pushString, writerEpubFonts) + (peekList peekString, \opts x -> opts{ writerEpubFonts = x }) + + , property "epub_metadata" + "Metadata to include in EPUB" + (maybe pushnil pushText, writerEpubMetadata) + (optional . peekText, \opts x -> opts{ writerEpubMetadata = x }) + + , property "epub_subdirectory" + "Subdir for epub in OCF" + (pushText, writerEpubSubdirectory) + (peekText, \opts x -> opts{ writerEpubSubdirectory = x }) + + , property "extensions" "Markdown extensions that can be used" + (pushViaJSON, writerExtensions) + (peekViaJSON, \opts x -> opts{ writerExtensions = x }) + + , property "highlight_style" + "Style to use for highlighting (nil = no highlighting)" + (maybe pushnil pushViaJSON, writerHighlightStyle) + (optional . peekViaJSON, \opts x -> opts{ writerHighlightStyle = x }) + + , property "html_math_method" + "How to print math in HTML" + (pushViaJSON, writerHTMLMathMethod) + (peekViaJSON, \opts x -> opts{ writerHTMLMathMethod = x }) + + , property "html_q_tags" + "Use @@ tags for quotes in HTML" + (pushBool, writerHtmlQTags) + (peekBool, \opts x -> opts{ writerHtmlQTags = x }) + + , property "identifier_prefix" + "Prefix for section & note ids in HTML and for footnote marks in markdown" + (pushText, writerIdentifierPrefix) + (peekText, \opts x -> opts{ writerIdentifierPrefix = x }) + + , property "incremental" + "True if lists should be incremental" + (pushBool, writerIncremental) + (peekBool, \opts x -> opts{ writerIncremental = x }) + + , property "listings" + "Use listings package for code" + (pushBool, writerListings) + (peekBool, \opts x -> opts{ writerListings = x }) + + , property "number_offset" + "Starting number for section, subsection, ..." + (pushPandocList pushIntegral, writerNumberOffset) + (peekList peekIntegral, \opts x -> opts{ writerNumberOffset = x }) + + , property "number_sections" + "Number sections in LaTeX" + (pushBool, writerNumberSections) + (peekBool, \opts x -> opts{ writerNumberSections = x }) + + , property "prefer_ascii" + "Prefer ASCII representations of characters when possible" + (pushBool, writerPreferAscii) + (peekBool, \opts x -> opts{ writerPreferAscii = x }) + + , property "reference_doc" + "Path to reference document if specified" + (maybe pushnil pushString, writerReferenceDoc) + (optional . peekString, \opts x -> opts{ writerReferenceDoc = x }) + + , property "reference_location" + "Location of footnotes and references for writing markdown" + (pushViaJSON, writerReferenceLocation) + (peekViaJSON, \opts x -> opts{ writerReferenceLocation = x }) + + , property "reference_links" + "Use reference links in writing markdown, rst" + (pushBool, writerReferenceLinks) + (peekBool, \opts x -> opts{ writerReferenceLinks = x }) + + , property "section_divs" + "Put sections in div tags in HTML" + (pushBool, writerSectionDivs) + (peekBool, \opts x -> opts{ writerSectionDivs = x }) + + , property "setext_headers" + "Use setext headers for levels 1-2 in markdown" + (pushBool, writerSetextHeaders) + (peekBool, \opts x -> opts{ writerSetextHeaders = x }) + + , property "slide_level" + "Force header level of slides" + (maybe pushnil pushIntegral, writerSlideLevel) + (optional . peekIntegral, \opts x -> opts{ writerSlideLevel = x }) + + -- , property "syntax_map" "Syntax highlighting definition" + -- (pushViaJSON, writerSyntaxMap) + -- (peekViaJSON, \opts x -> opts{ writerSyntaxMap = x }) + -- :: SyntaxMap + + , property "tab_stop" + "Tabstop for conversion btw spaces and tabs" + (pushIntegral, writerTabStop) + (peekIntegral, \opts x -> opts{ writerTabStop = x }) + + , property "table_of_contents" + "Include table of contents" + (pushBool, writerTableOfContents) + (peekBool, \opts x -> opts{ writerTableOfContents = x }) + + -- , property "template" "Template to use" + -- (maybe pushnil pushViaJSON, writerTemplate) + -- (optional . peekViaJSON, \opts x -> opts{ writerTemplate = x }) + -- :: Maybe (Template Text) + + , property "toc_depth" + "Number of levels to include in TOC" + (pushIntegral, writerTOCDepth) + (peekIntegral, \opts x -> opts{ writerTOCDepth = x }) + + , property "top_level_division" + "Type of top-level divisions" + (pushViaJSON, writerTopLevelDivision) + (peekViaJSON, \opts x -> opts{ writerTopLevelDivision = x }) + + , property "variables" + "Variables to set in template" + (pushViaJSON, writerVariables) + (peekViaJSON, \opts x -> opts{ writerVariables = x }) + + , property "wrap_text" + "Option for wrapping text" + (pushViaJSON, writerWrapText) + (peekViaJSON, \opts x -> opts{ writerWrapText = x }) + ] + +-- | Retrieves a 'WriterOptions' object from a table on the stack, using +-- the default values for all missing fields. +-- +-- Internally, this pushes the default writer options, sets each +-- key/value pair of the table in the userdata value, then retrieves the +-- object again. This will update all fields and complain about unknown +-- keys. +peekWriterOptionsTable :: LuaError e => Peeker e WriterOptions +peekWriterOptionsTable idx = retrieving "WriterOptions (table)" $ do + liftLua $ do + absidx <- absindex idx + pushUD typeWriterOptions def + let setFields = do + next absidx >>= \case + False -> return () -- all fields were copied + True -> do + pushvalue (nth 2) *> insert (nth 2) + settable (nth 4) -- set in userdata object + setFields + pushnil -- first key + setFields + peekUD typeWriterOptions top `lastly` pop 1 + +instance Pushable WriterOptions where + push = pushWriterOptions + +-- These will become part of hslua-aeson in future versions. + +-- | Retrieves a value from the Lua stack via JSON. +peekViaJSON :: (Aeson.FromJSON a, LuaError e) => Peeker e a +peekViaJSON idx = do + value <- peekValue idx + case fromJSON value of + Aeson.Success x -> pure x + Aeson.Error msg -> failPeek $ "failed to decode: " <> + fromString msg + +-- | Pushes a value to the Lua stack as a JSON-like value. +pushViaJSON :: (Aeson.ToJSON a, LuaError e) => Pusher e a +pushViaJSON = pushValue . toJSON