From 3692a1d1e83703fbf235214f2838cd92683c625c Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sun, 28 Nov 2021 02:08:01 +0100 Subject: Lua: use package pandoc-lua-marshal (#7719) The marshaling functions for pandoc's AST are extracted into a separate package. The package comes with a number of changes: - Pandoc's List module was rewritten in C, thereby improving error messages. - Lists of `Block` and `Inline` elements are marshaled using the new list types `Blocks` and `Inlines`, respectively. These types currently behave identical to the generic List type, but give better error messages. This also opens up the possibility of adding element-specific methods to these lists in the future. - Elements of type `MetaValue` are no longer pushed as values which have `.t` and `.tag` properties. This was already true for `MetaString` and `MetaBool` values, which are still marshaled as Lua strings and booleans, respectively. Affected values: + `MetaBlocks` values are marshaled as a `Blocks` list; + `MetaInlines` values are marshaled as a `Inlines` list; + `MetaList` values are marshaled as a generic pandoc `List`s. + `MetaMap` values are marshaled as plain tables and no longer given any metatable. - The test suite for marshaled objects and their constructors has been extended and improved. - A bug in Citation objects, where setting a citation's suffix modified it's prefix, has been fixed. --- src/Text/Pandoc/Lua/Marshal/CommonState.hs | 70 ++++++++++++++ src/Text/Pandoc/Lua/Marshal/Context.hs | 28 ++++++ src/Text/Pandoc/Lua/Marshal/PandocError.hs | 51 ++++++++++ src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs | 133 +++++++++++++++++++++++++++ 4 files changed, 282 insertions(+) create mode 100644 src/Text/Pandoc/Lua/Marshal/CommonState.hs create mode 100644 src/Text/Pandoc/Lua/Marshal/Context.hs create mode 100644 src/Text/Pandoc/Lua/Marshal/PandocError.hs create mode 100644 src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs (limited to 'src/Text/Pandoc/Lua/Marshal') diff --git a/src/Text/Pandoc/Lua/Marshal/CommonState.hs b/src/Text/Pandoc/Lua/Marshal/CommonState.hs new file mode 100644 index 000000000..a8c0e28d2 --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshal/CommonState.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedStrings #-} +{- | + Module : Text.Pandoc.Lua.Marshal.CommonState + Copyright : © 2012-2021 John MacFarlane + © 2017-2021 Albert Krewinkel + License : GNU GPL, version 2 or above + Maintainer : Albert Krewinkel + Stability : alpha + +Instances to marshal (push) and unmarshal (peek) the common state. +-} +module Text.Pandoc.Lua.Marshal.CommonState + ( typeCommonState + , peekCommonState + , pushCommonState + ) where + +import HsLua.Core +import HsLua.Marshalling +import HsLua.Packaging +import Text.Pandoc.Class (CommonState (..)) +import Text.Pandoc.Logging (LogMessage, showLogMessage) +import Text.Pandoc.Lua.Marshal.List (pushPandocList) + +-- | Lua type used for the @CommonState@ object. +typeCommonState :: LuaError e => DocumentedType e CommonState +typeCommonState = deftype "pandoc CommonState" [] + [ readonly "input_files" "input files passed to pandoc" + (pushPandocList pushString, stInputFiles) + + , readonly "output_file" "the file to which pandoc will write" + (maybe pushnil pushString, stOutputFile) + + , readonly "log" "list of log messages" + (pushPandocList (pushUD typeLogMessage), stLog) + + , readonly "request_headers" "headers to add for HTTP requests" + (pushPandocList (pushPair pushText pushText), stRequestHeaders) + + , readonly "resource_path" + "path to search for resources like included images" + (pushPandocList pushString, stResourcePath) + + , readonly "source_url" "absolute URL + dir of 1st source file" + (maybe pushnil pushText, stSourceURL) + + , readonly "user_data_dir" "directory to search for data files" + (maybe pushnil pushString, stUserDataDir) + + , readonly "trace" "controls whether tracing messages are issued" + (pushBool, stTrace) + + , readonly "verbosity" "verbosity level" + (pushString . show, stVerbosity) + ] + +peekCommonState :: LuaError e => Peeker e CommonState +peekCommonState = peekUD typeCommonState + +pushCommonState :: LuaError e => Pusher e CommonState +pushCommonState = pushUD typeCommonState + +typeLogMessage :: LuaError e => DocumentedType e LogMessage +typeLogMessage = deftype "pandoc LogMessage" + [ operation Index $ defun "__tostring" + ### liftPure showLogMessage + <#> udparam typeLogMessage "msg" "object" + =#> functionResult pushText "string" "stringified log message" + ] + mempty -- no members diff --git a/src/Text/Pandoc/Lua/Marshal/Context.hs b/src/Text/Pandoc/Lua/Marshal/Context.hs new file mode 100644 index 000000000..17af936e1 --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshal/Context.hs @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- | + Module : Text.Pandoc.Lua.Marshaling.Context + Copyright : © 2012-2021 John MacFarlane + © 2017-2021 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + Stability : alpha + +Marshaling instance for doctemplates Context and its components. +-} +module Text.Pandoc.Lua.Marshal.Context () where + +import qualified HsLua as Lua +import HsLua (Pushable) +import Text.DocTemplates (Context(..), Val(..), TemplateTarget) +import Text.DocLayout (render) + +instance (TemplateTarget a, Pushable a) => Pushable (Context a) where + push (Context m) = Lua.push m + +instance (TemplateTarget a, Pushable a) => Pushable (Val a) where + push NullVal = Lua.push () + push (BoolVal b) = Lua.push b + push (MapVal ctx) = Lua.push ctx + push (ListVal xs) = Lua.push xs + push (SimpleVal d) = Lua.push $ render Nothing d diff --git a/src/Text/Pandoc/Lua/Marshal/PandocError.hs b/src/Text/Pandoc/Lua/Marshal/PandocError.hs new file mode 100644 index 000000000..d1c0ad4f4 --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshal/PandocError.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{- | + Module : Text.Pandoc.Lua.Marshal.PandocError + Copyright : © 2020-2021 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + Stability : alpha + +Marshal of @'PandocError'@ values. +-} +module Text.Pandoc.Lua.Marshal.PandocError + ( peekPandocError + , pushPandocError + , typePandocError + ) + where + +import HsLua.Core (LuaError) +import HsLua.Marshalling (Peeker, Pusher, pushString, liftLua) +import HsLua.Packaging +import Text.Pandoc.Error (PandocError (PandocLuaError)) + +import qualified HsLua as Lua +import qualified Text.Pandoc.UTF8 as UTF8 + +-- | Lua userdata type definition for PandocError. +typePandocError :: LuaError e => DocumentedType e PandocError +typePandocError = deftype "PandocError" + [ operation Tostring $ defun "__tostring" + ### liftPure (show @PandocError) + <#> udparam typePandocError "obj" "PandocError object" + =#> functionResult pushString "string" "string representation of error." + ] + mempty -- no members + +-- | Peek a @'PandocError'@ element to the Lua stack. +pushPandocError :: LuaError e => Pusher e PandocError +pushPandocError = pushUD typePandocError + +-- | Retrieve a @'PandocError'@ from the Lua stack. +peekPandocError :: LuaError e => Peeker e PandocError +peekPandocError idx = Lua.retrieving "PandocError" $ + liftLua (Lua.ltype idx) >>= \case + Lua.TypeUserdata -> peekUD typePandocError idx + _ -> do + msg <- liftLua $ Lua.state >>= \l -> Lua.liftIO (Lua.popErrorMessage l) + return $ PandocLuaError (UTF8.toText msg) diff --git a/src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs b/src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs new file mode 100644 index 000000000..c20770dba --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- | + Module : Text.Pandoc.Lua.Marshaling.ReaderOptions + Copyright : © 2012-2021 John MacFarlane + © 2017-2021 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + Stability : alpha + +Marshaling instance for ReaderOptions and its components. +-} +module Text.Pandoc.Lua.Marshal.ReaderOptions + ( peekReaderOptions + , pushReaderOptions + , pushReaderOptionsReadonly + ) where + +import Data.Default (def) +import HsLua as Lua +import Text.Pandoc.Lua.Marshal.List (pushPandocList) +import Text.Pandoc.Options (ReaderOptions (..)) + +-- +-- Reader Options +-- + +-- | Retrieve a ReaderOptions value, either from a normal ReaderOptions +-- value, from a read-only object, or from a table with the same +-- keys as a ReaderOptions object. +peekReaderOptions :: LuaError e => Peeker e ReaderOptions +peekReaderOptions = retrieving "ReaderOptions" . \idx -> + liftLua (ltype idx) >>= \case + TypeUserdata -> choice [ peekUD typeReaderOptions + , peekUD typeReaderOptionsReadonly + ] + idx + TypeTable -> peekReaderOptionsTable idx + _ -> failPeek =<< + typeMismatchMessage "ReaderOptions userdata or table" idx + +-- | Pushes a ReaderOptions value as userdata object. +pushReaderOptions :: LuaError e => Pusher e ReaderOptions +pushReaderOptions = pushUD typeReaderOptions + +-- | Pushes a ReaderOptions object, but makes it read-only. +pushReaderOptionsReadonly :: LuaError e => Pusher e ReaderOptions +pushReaderOptionsReadonly = pushUD typeReaderOptionsReadonly + +-- | ReaderOptions object type for read-only values. +typeReaderOptionsReadonly :: LuaError e => DocumentedType e ReaderOptions +typeReaderOptionsReadonly = deftype "ReaderOptions (read-only)" + [ operation Tostring $ lambda + ### liftPure show + <#> udparam typeReaderOptions "opts" "options to print in native format" + =#> functionResult pushString "string" "Haskell representation" + , operation Newindex $ lambda + ### (failLua "This ReaderOptions value is read-only.") + =?> "Throws an error when called, i.e., an assignment is made." + ] + readerOptionsMembers + +-- | 'ReaderOptions' object type. +typeReaderOptions :: LuaError e => DocumentedType e ReaderOptions +typeReaderOptions = deftype "ReaderOptions" + [ operation Tostring $ lambda + ### liftPure show + <#> udparam typeReaderOptions "opts" "options to print in native format" + =#> functionResult pushString "string" "Haskell representation" + ] + readerOptionsMembers + +-- | Member properties of 'ReaderOptions' Lua values. +readerOptionsMembers :: LuaError e + => [Member e (DocumentedFunction e) ReaderOptions] +readerOptionsMembers = + [ property "abbreviations" "" + (pushSet pushText, readerAbbreviations) + (peekSet peekText, \opts x -> opts{ readerAbbreviations = x }) + , property "columns" "" + (pushIntegral, readerColumns) + (peekIntegral, \opts x -> opts{ readerColumns = x }) + , property "default_image_extension" "" + (pushText, readerDefaultImageExtension) + (peekText, \opts x -> opts{ readerDefaultImageExtension = x }) + , property "extensions" "" + (pushString . show, readerExtensions) + (peekRead, \opts x -> opts{ readerExtensions = x }) + , property "indented_code_classes" "" + (pushPandocList pushText, readerIndentedCodeClasses) + (peekList peekText, \opts x -> opts{ readerIndentedCodeClasses = x }) + , property "strip_comments" "" + (pushBool, readerStripComments) + (peekBool, \opts x -> opts{ readerStripComments = x }) + , property "standalone" "" + (pushBool, readerStandalone) + (peekBool, \opts x -> opts{ readerStandalone = x }) + , property "tab_stop" "" + (pushIntegral, readerTabStop) + (peekIntegral, \opts x -> opts{ readerTabStop = x }) + , property "track_changes" "" + (pushString . show, readerTrackChanges) + (peekRead, \opts x -> opts{ readerTrackChanges = x }) + ] + +-- | Retrieves a 'ReaderOptions' object from a table on the stack, using +-- the default values for all missing fields. +-- +-- Internally, this pushes the default reader 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. +peekReaderOptionsTable :: LuaError e => Peeker e ReaderOptions +peekReaderOptionsTable idx = retrieving "ReaderOptions (table)" $ do + liftLua $ do + absidx <- absindex idx + pushUD typeReaderOptions 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 typeReaderOptions top + +instance Pushable ReaderOptions where + push = pushReaderOptions -- cgit v1.2.3 From 83b5b79c0e4f073198b5af11b9e8a0a4471fcd41 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Wed, 8 Dec 2021 19:06:48 +0100 Subject: Custom reader: pass list of sources instead of concatenated text The first argument passed to Lua `Reader` functions is no longer a plain string but a richer data structure. The structure can easily be converted to a string by applying `tostring`, but is also a list with elements that contain each the *text* and *name* of each input source as a property of the respective name. A small example is added to the custom reader documentation, showcasing its use in a reader that creates a syntax-highlighted code block for each source code file passed as input. Existing readers must be updated. --- data/creole.lua | 2 +- doc/custom-readers.md | 55 +++++++++++++++++++++++++++++----- pandoc.cabal | 1 + src/Text/Pandoc/Lua/Marshal/Sources.hs | 46 ++++++++++++++++++++++++++++ src/Text/Pandoc/Lua/Orphans.hs | 5 ++++ src/Text/Pandoc/Readers/Custom.hs | 10 +++---- 6 files changed, 104 insertions(+), 15 deletions(-) create mode 100644 src/Text/Pandoc/Lua/Marshal/Sources.hs (limited to 'src/Text/Pandoc/Lua/Marshal') diff --git a/data/creole.lua b/data/creole.lua index 5b7d7f554..590dfc871 100644 --- a/data/creole.lua +++ b/data/creole.lua @@ -186,5 +186,5 @@ G = P{ "Doc", } function Reader(input, reader_options) - return lpeg.match(G, input) + return lpeg.match(G, tostring(input)) end diff --git a/doc/custom-readers.md b/doc/custom-readers.md index afa0caa73..df2de2182 100644 --- a/doc/custom-readers.md +++ b/doc/custom-readers.md @@ -17,7 +17,7 @@ install any additional software to do this. A custom reader is a Lua file that defines a function called `Reader`, which takes two arguments: -- a string, the raw input to be parsed +- the raw input to be parsed, as a list of sources - optionally, a table of reader options, e.g. `{ columns = 62, standalone = true }`. @@ -27,6 +27,16 @@ which is automatically in scope. (Indeed, all of the utility functions that are available for [Lua filters] are available in custom readers, too.) +Each source item corresponds to a file or stream passed to pandoc +containing its text and name. E.g., if a single file `input.txt` +is passed to pandoc, then the list of sources will contain just a +single element `s`, where `s.name == 'input.txt'` and `s.text` +contains the file contents as a string. + +The sources list, as well as each of its elements, can be +converted to a string via the Lua standard library function +`tostring`. + [Lua filters]: https://pandoc.org/lua-filters.html [`pandoc` module]: https://pandoc.org/lua-filters.html#module-pandoc @@ -34,12 +44,20 @@ A minimal example would be ```lua function Reader(input) - return pandoc.Pandoc({ pandoc.CodeBlock(input) }) + return pandoc.Pandoc({ pandoc.CodeBlock(tostring(input)) }) end ``` -This just returns a document containing a big code block with -all of the input. +This just returns a document containing a big code block with all +of the input. Or, to create a separate code block for each input +file, one might write + +``` lua +function Reader(input) + return pandoc.Pandoc(input:map( + function (s) return pandoc.CodeBlock(s.text) end)) +end +``` In a nontrivial reader, you'll want to parse the input. You can do this using standard Lua library functions @@ -84,7 +102,7 @@ G = P{ "Pandoc", } function Reader(input) - return lpeg.match(G, input) + return lpeg.match(G, tostring(input)) end ``` @@ -277,7 +295,7 @@ function Reader(input, reader_options) local refs = {} local thisref = {} local ids = {} - for line in string.gmatch(input, "[^\n]*") do + for line in string.gmatch(tostring(input), "[^\n]*") do key, val = string.match(line, "([A-Z][A-Z0-9]) %- (.*)") if key == "ER" then -- clean up fields @@ -550,7 +568,7 @@ G = P{ "Doc", } function Reader(input, reader_options) - return lpeg.match(G, input) + return lpeg.match(G, tostring(input)) end ``` @@ -614,7 +632,7 @@ end function Reader(input) - local parsed = json.decode(input) + local parsed = json.decode(tostring(input)) local blocks = {} for _,entry in ipairs(parsed.data.children) do @@ -636,3 +654,24 @@ Similar code can be used to consume JSON output from other APIs. Note that the content of the text fields is markdown, so we convert it using `pandoc.read()`. + +# Example: syntax-highlighted code files + +This is a reader that puts the content of each input file into a +code block, sets the file's extension as the block's class to +enable code highlighting, and places the filename as a header +above each code block. + +``` lua +function to_code_block (source) + local _, lang = pandoc.path.split_extension(source.name) + return pandoc.Div{ + pandoc.Header(1, source.name == '' and '' or source.name), + pandoc.CodeBlock(source.text, {class=lang}), + } +end + +function Reader (input, opts) + return pandoc.Pandoc(input:map(to_code_block)) +end +``` diff --git a/pandoc.cabal b/pandoc.cabal index dcf12bf04..92513b911 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -694,6 +694,7 @@ library Text.Pandoc.Lua.Marshal.Context, Text.Pandoc.Lua.Marshal.PandocError, Text.Pandoc.Lua.Marshal.ReaderOptions, + Text.Pandoc.Lua.Marshal.Sources, Text.Pandoc.Lua.Module.MediaBag, Text.Pandoc.Lua.Module.Pandoc, Text.Pandoc.Lua.Module.System, diff --git a/src/Text/Pandoc/Lua/Marshal/Sources.hs b/src/Text/Pandoc/Lua/Marshal/Sources.hs new file mode 100644 index 000000000..7b5262ab5 --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshal/Sources.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- | +Module : Text.Pandoc.Lua.Marshaling.Sources +Copyright : © 2021 Albert Krewinkel +License : GNU GPL, version 2 or above +Maintainer : Albert Krewinkel + +Marshal 'Sources'. +-} +module Text.Pandoc.Lua.Marshal.Sources + ( pushSources + ) where + +import Data.Text (Text) +import HsLua as Lua +import Text.Pandoc.Lua.Marshal.List (newListMetatable) +import Text.Pandoc.Sources (Sources (..)) +import Text.Parsec (SourcePos, sourceName) + +-- | Pushes the 'Sources' as a list of lazy Lua objects. +pushSources :: LuaError e => Pusher e Sources +pushSources (Sources srcs) = do + pushList (pushUD typeSource) srcs + newListMetatable "pandoc Sources" $ do + pushName "__tostring" + pushHaskellFunction $ do + sources <- forcePeek $ peekList (peekUD typeSource) (nthBottom 1) + pushText . mconcat $ map snd sources + return 1 + rawset (nth 3) + setmetatable (nth 2) + +-- | Source object type. +typeSource :: LuaError e => DocumentedType e (SourcePos, Text) +typeSource = deftype "pandoc input source" + [ operation Tostring $ lambda + ### liftPure snd + <#> udparam typeSource "srcs" "Source to print in native format" + =#> functionResult pushText "string" "Haskell representation" + ] + [ readonly "name" "source name" + (pushString, sourceName . fst) + , readonly "text" "source text" + (pushText, snd) + ] diff --git a/src/Text/Pandoc/Lua/Orphans.hs b/src/Text/Pandoc/Lua/Orphans.hs index eef05bd27..d5b8f2c5d 100644 --- a/src/Text/Pandoc/Lua/Orphans.hs +++ b/src/Text/Pandoc/Lua/Orphans.hs @@ -22,7 +22,9 @@ import Text.Pandoc.Lua.Marshal.CommonState () import Text.Pandoc.Lua.Marshal.Context () import Text.Pandoc.Lua.Marshal.PandocError() import Text.Pandoc.Lua.Marshal.ReaderOptions () +import Text.Pandoc.Lua.Marshal.Sources (pushSources) import Text.Pandoc.Lua.ErrorConversion () +import Text.Pandoc.Sources (Sources) instance Pushable Pandoc where push = pushPandoc @@ -109,3 +111,6 @@ instance Peekable Version where instance {-# OVERLAPPING #-} Peekable Attr where peek = forcePeek . peekAttr + +instance Pushable Sources where + push = pushSources diff --git a/src/Text/Pandoc/Readers/Custom.hs b/src/Text/Pandoc/Readers/Custom.hs index d7336012b..7b6c99ed8 100644 --- a/src/Text/Pandoc/Readers/Custom.hs +++ b/src/Text/Pandoc/Readers/Custom.hs @@ -17,7 +17,6 @@ Supports custom parsers written in Lua which produce a Pandoc AST. module Text.Pandoc.Readers.Custom ( readCustom ) where import Control.Exception import Control.Monad (when) -import Data.Text (Text) import HsLua as Lua hiding (Operation (Div), render) import HsLua.Class.Peekable (PeekError) import Control.Monad.IO.Class (MonadIO) @@ -26,13 +25,13 @@ import Text.Pandoc.Lua (Global (..), runLua, setGlobals) import Text.Pandoc.Lua.Util (dofileWithTraceback) import Text.Pandoc.Options import Text.Pandoc.Class (PandocMonad) -import Text.Pandoc.Sources (ToSources(..), sourcesToText) +import Text.Pandoc.Sources (Sources, ToSources(..)) -- | Convert custom markup to Pandoc. readCustom :: (PandocMonad m, MonadIO m, ToSources s) => FilePath -> ReaderOptions -> s -> m Pandoc -readCustom luaFile opts sources = do - let input = sourcesToText $ toSources sources +readCustom luaFile opts srcs = do + let input = toSources srcs let globals = [ PANDOC_SCRIPT_FILE luaFile ] res <- runLua $ do setGlobals globals @@ -47,8 +46,7 @@ readCustom luaFile opts sources = do Right doc -> return doc parseCustom :: forall e. PeekError e - => Text + => Sources -> ReaderOptions -> LuaE e Pandoc parseCustom = invoke @e "Reader" - -- cgit v1.2.3 From 7a70b87facffe5f2daaaa58af9fadad89b81a9e9 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 17 Dec 2021 17:32:28 +0100 Subject: Lua: add function `pandoc.utils.references` List with all cited references of a document. Closes: #7752 --- doc/lua-filters.md | 32 ++++++++++ pandoc.cabal | 1 + src/Text/Pandoc/Lua/Marshal/Reference.hs | 101 +++++++++++++++++++++++++++++++ src/Text/Pandoc/Lua/Module/Utils.hs | 14 +++++ 4 files changed, 148 insertions(+) create mode 100644 src/Text/Pandoc/Lua/Marshal/Reference.hs (limited to 'src/Text/Pandoc/Lua/Marshal') diff --git a/doc/lua-filters.md b/doc/lua-filters.md index 7b73dd9c5..93595a814 100644 --- a/doc/lua-filters.md +++ b/doc/lua-filters.md @@ -3301,6 +3301,38 @@ Usage: } local newblocks = pandoc.utils.make_sections(true, 1, blocks) +### references {#pandoc.references} + +`references (doc)` + +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. + +The structure used represent reference values corresponds to that +used in CSL JSON; the return value can be use as `references` +metadata, which is one of the values used by pandoc and citeproc +when generating bibliographies. + +Parameters: + +`doc`: +: document ([Pandoc](#type-pandoc)) + +Returns: + +- list of references. (table) + +Usage: + + -- Include all cited references in document + function Pandoc (doc) + doc.meta.references = pandoc.utils.references(doc) + doc.meta.bibliography = nil + return doc + end + ### run\_json\_filter {#pandoc.utils.run_json_filter} `run_json_filter (doc, filter[, args])` diff --git a/pandoc.cabal b/pandoc.cabal index 13db955b9..b09b19144 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -697,6 +697,7 @@ library Text.Pandoc.Lua.Marshal.Context, Text.Pandoc.Lua.Marshal.PandocError, Text.Pandoc.Lua.Marshal.ReaderOptions, + Text.Pandoc.Lua.Marshal.Reference, Text.Pandoc.Lua.Marshal.Sources, Text.Pandoc.Lua.Module.MediaBag, Text.Pandoc.Lua.Module.Pandoc, diff --git a/src/Text/Pandoc/Lua/Marshal/Reference.hs b/src/Text/Pandoc/Lua/Marshal/Reference.hs new file mode 100644 index 000000000..51501836f --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshal/Reference.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- | + Module : Text.Pandoc.Lua.Marshaling.ReaderOptions + Copyright : © 2012-2021 John MacFarlane + © 2017-2021 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + Stability : alpha + +Marshal citeproc 'Reference' values. +-} +module Text.Pandoc.Lua.Marshal.Reference + ( pushReference + ) where + +import Citeproc.Types + ( Date (..), DateParts (..), ItemId (..), Name (..), Reference (..) + , Val (..), Variable, fromVariable + ) +import Control.Monad (forM_) +import HsLua hiding (Name, Reference, pushName, peekName) +import Text.Pandoc.Builder (Inlines, toList) +import Text.Pandoc.Lua.Marshal.Inline (pushInlines) +import Text.Pandoc.Lua.Marshal.List (pushPandocList) + +import qualified Data.Map as Map +import qualified HsLua + +-- | Pushes a ReaderOptions value as userdata object. +pushReference :: LuaError e => Pusher e (Reference Inlines) +pushReference reference = do + pushAsTable [ ("id", pushItemId . referenceId) + , ("type", pushText . referenceType) + ] + reference + forM_ (Map.toList $ referenceVariables reference) $ \(var, val) -> do + pushVariable var + pushVal val + rawset (nth 3) + +-- | Pushes an 'ItemId' as a string. +pushItemId :: Pusher e ItemId +pushItemId = pushText . unItemId + +-- | Pushes a person's 'Name' as a table. +pushName :: LuaError e => Pusher e Name +pushName = pushAsTable + [ ("family" , pushTextOrNil . nameFamily) + , ("given" , pushTextOrNil . nameGiven) + , ("dropping-particle" , pushTextOrNil . nameDroppingParticle) + , ("non-dropping-particle" , pushTextOrNil . nameNonDroppingParticle) + , ("suffix" , pushTextOrNil . nameSuffix) + , ("literal" , pushTextOrNil . nameLiteral) + , ("comma-suffix" , pushBool . nameCommaSuffix) + , ("static-ordering" , pushBool . nameStaticOrdering) + ] + where + pushTextOrNil = \case + Nothing -> pushnil + Just xs -> pushText xs + +-- | Pushes a 'Variable' as string. +pushVariable :: Pusher e Variable +pushVariable = pushText . fromVariable + +-- | Pushes a 'Val', i.e., a variable value. +pushVal :: LuaError e => Pusher e (Val Inlines) +pushVal = \case + TextVal t -> pushText t + FancyVal inlns -> pushInlines $ toList inlns + NumVal i -> pushIntegral i + NamesVal names -> pushPandocList pushName names + DateVal date -> pushDate date + +-- | Pushes a 'Date' as table. +pushDate :: LuaError e => Pusher e Date +pushDate = pushAsTable + [ ("date-parts", pushPandocList pushDateParts . dateParts) + , ("circa", pushBool . dateCirca) + , ("season", maybe pushnil pushIntegral . dateSeason) + , ("literal", maybe pushnil pushText . dateLiteral) + ] + where + -- date parts are integers, but we push them as strings, as meta + -- values can't handle integers yet. + pushDateParts (DateParts dp) = pushPandocList (pushString . show) dp + +-- | Helper funtion to push an object as a table. +pushAsTable :: LuaError e + => [(HsLua.Name, a -> LuaE e ())] + -> a -> LuaE e () +pushAsTable props obj = do + createtable 0 (length props) + forM_ props $ \(name, pushValue) -> do + HsLua.pushName name + pushValue obj + rawset (nth 3) diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 8bb185500..6d0130dc2 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -25,9 +25,11 @@ import Data.Version (Version) import HsLua as Lua import HsLua.Class.Peekable (PeekError) import HsLua.Module.Version (peekVersionFuzzy, pushVersion) +import Text.Pandoc.Citeproc (getReferences) import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError) 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 @@ -95,6 +97,18 @@ documentedModule = Module =#> 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 -- cgit v1.2.3 From cd2bffee1e4c0ca9c999bd37f81732664f9f107a Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Mon, 20 Dec 2021 09:28:38 +0100 Subject: Lua: use more natural representation for Reference values Omit `false` boolean values, push integers as numbers. --- src/Text/Pandoc/Lua/Marshal/Reference.hs | 18 ++++++++++++------ test/Tests/Lua/Module.hs | 2 +- test/lua/module/pandoc-utils.lua | 25 +++++++++++++++++++++++++ 3 files changed, 38 insertions(+), 7 deletions(-) (limited to 'src/Text/Pandoc/Lua/Marshal') diff --git a/src/Text/Pandoc/Lua/Marshal/Reference.hs b/src/Text/Pandoc/Lua/Marshal/Reference.hs index 51501836f..ee297484e 100644 --- a/src/Text/Pandoc/Lua/Marshal/Reference.hs +++ b/src/Text/Pandoc/Lua/Marshal/Reference.hs @@ -55,14 +55,21 @@ pushName = pushAsTable , ("non-dropping-particle" , pushTextOrNil . nameNonDroppingParticle) , ("suffix" , pushTextOrNil . nameSuffix) , ("literal" , pushTextOrNil . nameLiteral) - , ("comma-suffix" , pushBool . nameCommaSuffix) - , ("static-ordering" , pushBool . nameStaticOrdering) + , ("comma-suffix" , pushBoolOrNil . nameCommaSuffix) + , ("static-ordering" , pushBoolOrNil . nameStaticOrdering) ] where pushTextOrNil = \case Nothing -> pushnil Just xs -> pushText xs +-- | Pushes a boolean, but uses @nil@ instead of @false@; table fields +-- are not set unless the value is true. +pushBoolOrNil :: Pusher e Bool +pushBoolOrNil = \case + False -> pushnil + True -> pushBool True + -- | Pushes a 'Variable' as string. pushVariable :: Pusher e Variable pushVariable = pushText . fromVariable @@ -80,14 +87,13 @@ pushVal = \case pushDate :: LuaError e => Pusher e Date pushDate = pushAsTable [ ("date-parts", pushPandocList pushDateParts . dateParts) - , ("circa", pushBool . dateCirca) + , ("circa", pushBoolOrNil . dateCirca) , ("season", maybe pushnil pushIntegral . dateSeason) , ("literal", maybe pushnil pushText . dateLiteral) ] where - -- date parts are integers, but we push them as strings, as meta - -- values can't handle integers yet. - pushDateParts (DateParts dp) = pushPandocList (pushString . show) dp + -- date parts are lists of Int values + pushDateParts (DateParts dp) = pushPandocList pushIntegral dp -- | Helper funtion to push an object as a table. pushAsTable :: LuaError e diff --git a/test/Tests/Lua/Module.hs b/test/Tests/Lua/Module.hs index 8be445f65..e4d1e8bd9 100644 --- a/test/Tests/Lua/Module.hs +++ b/test/Tests/Lua/Module.hs @@ -29,7 +29,7 @@ tests = ("lua" "module" "pandoc-path.lua") , testPandocLua "pandoc.types" ("lua" "module" "pandoc-types.lua") - , testPandocLua "pandoc.util" + , testPandocLua "pandoc.utils" ("lua" "module" "pandoc-utils.lua") ] diff --git a/test/lua/module/pandoc-utils.lua b/test/lua/module/pandoc-utils.lua index 0c3831bb1..7a43e9286 100644 --- a/test/lua/module/pandoc-utils.lua +++ b/test/lua/module/pandoc-utils.lua @@ -62,6 +62,31 @@ return { end), }, + group 'references' { + test('gets references from doc', function () + local ref = { + ['author'] = { + {given = 'Max', family = 'Mustermann'} + }, + ['container-title'] = pandoc.Inlines('JOSS'), + ['id'] = 'test', + ['issued'] = {['date-parts'] = {{2021}}}, + ['title'] = pandoc.Inlines{ + pandoc.Quoted('DoubleQuote', 'Interesting'), + pandoc.Space(), + 'work' + }, + ['type'] = 'article-journal', + } + local nocite = pandoc.Cite( + '@test', + {pandoc.Citation('test', 'NormalCitation')} + ) + local doc = pandoc.Pandoc({}, {nocite = nocite, references = {ref}}) + assert.are_same({ref}, pandoc.utils.references(doc)) + end) + }, + group 'sha1' { test('hashing', function () local ref_hash = '0a0a9f2a6772942557ab5355d76af442f8f65e01' -- cgit v1.2.3