Lua: add function pandoc.utils.references

List with all cited references of a document.

Closes: #7752
This commit is contained in:
Albert Krewinkel 2021-12-17 17:32:28 +01:00 committed by John MacFarlane
parent 61ffa55835
commit 7a70b87fac
4 changed files with 148 additions and 0 deletions

View file

@ -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])`

View file

@ -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,

View file

@ -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 <tarleb+pandoc@moltkeplatz.de>
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)

View file

@ -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