From 9e74826ba9ce4139bfdd3f057a79efa8b644e85a Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Wed, 20 Oct 2021 21:40:07 +0200 Subject: Switch to hslua-2.0 The new HsLua version takes a somewhat different approach to marshalling and unmarshalling, relying less on typeclasses and more on specialized types. This allows for better performance and improved error messages. Furthermore, new abstractions allow to document the code and exposed functions. --- test/lua/module/pandoc-types.lua | 25 ------------------------- 1 file changed, 25 deletions(-) (limited to 'test/lua') diff --git a/test/lua/module/pandoc-types.lua b/test/lua/module/pandoc-types.lua index d4e063a5c..d9c9f82ac 100644 --- a/test/lua/module/pandoc-types.lua +++ b/test/lua/module/pandoc-types.lua @@ -55,31 +55,6 @@ return { end), }, - group 'list-like behavior' { - test('can access version component numbers', function () - local version = Version '2.7.3' - assert.is_nil(version[0]) - assert.are_equal(version[1], 2) - assert.are_equal(version[2], 7) - assert.are_equal(version[3], 3) - end), - test('can be iterated over', function () - local version_list = {2, 7, 3} - local final_index = 0 - for i, v in pairs(Version(version_list)) do - assert.are_equal(v, version_list[i]) - final_index = i - end - assert.are_equal(final_index, 3) - end), - test('length is the number of components', function () - assert.are_equal(#(Version '0'), 1) - assert.are_equal(#(Version '1.6'), 2) - assert.are_equal(#(Version '8.7.5'), 3) - assert.are_equal(#(Version '2.9.1.5'), 4) - end) - }, - group 'conversion to string' { test('converting from and to string is a noop', function () local version_string = '1.19.4' -- cgit v1.2.3 From 8523bb01b24424249aa409ea577388a1ea10d70a Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Wed, 20 Oct 2021 21:40:07 +0200 Subject: Lua: marshal Attr values as userdata - Adds a new `pandoc.AttributeList()` constructor, which creates the associative attribute list that is used as the third component of `Attr` values. Values of this type can often be passed to constructors instead of `Attr` values. - `AttributeList` values can no longer be indexed numerically. --- data/pandoc.lua | 155 +---------------------- pandoc.cabal | 1 + src/Text/Pandoc/Lua/Init.hs | 1 - src/Text/Pandoc/Lua/Marshaling/AST.hs | 18 +-- src/Text/Pandoc/Lua/Marshaling/Attr.hs | 225 +++++++++++++++++++++++++++++++++ src/Text/Pandoc/Lua/Module/Pandoc.hs | 3 + test/Tests/Lua.hs | 2 +- test/lua/module/pandoc.lua | 55 +++++--- 8 files changed, 272 insertions(+), 188 deletions(-) create mode 100644 src/Text/Pandoc/Lua/Marshaling/Attr.hs (limited to 'test/lua') diff --git a/data/pandoc.lua b/data/pandoc.lua index 173c8c179..059ff9a3a 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -281,33 +281,12 @@ local function ensureDefinitionPairs (pair) return {inlines, blocks} end ---- Split a string into it's words, using whitespace as separators. -local function words (str) - local ws = {} - for w in str:gmatch("([^%s]+)") do ws[#ws + 1] = w end - return ws -end - --- Try hard to turn the arguments into an Attr object. local function ensureAttr(attr) - if type(attr) == 'table' then - if #attr > 0 then return M.Attr(table.unpack(attr)) end - - -- assume HTML-like key-value pairs - local ident = attr.id or '' - local classes = words(attr.class or '') - local attributes = attr - attributes.id = nil - attributes.class = nil - return M.Attr(ident, classes, attributes) - elseif attr == nil then - return M.Attr() - elseif type(attr) == 'string' then - -- treat argument as ID - return M.Attr(attr) + if type(attr) == 'userdata' then + return attr end - -- print(arg, ...) - error('Could not convert to Attr') + return M.Attr(attr) end ------------------------------------------------------------------------ @@ -831,134 +810,6 @@ M.Underline = M.Inline:create_constructor( -- Element components -- @section components ---- Check if the first element of a pair matches the given value. --- @param x key value to be checked --- @return function returning true iff first element of its argument matches x --- @local -local function assoc_key_equals (x) - return function (y) return y[1] == x end -end - ---- Lookup a value in an associative list --- @function lookup --- @local --- @tparam {{key, value},...} alist associative list --- @param key key for which the associated value is to be looked up -local function lookup(alist, key) - return (List.find_if(alist, assoc_key_equals(key)) or {})[2] -end - ---- Return an iterator which returns key-value pairs of an associative list. --- @function apairs --- @local --- @tparam {{key, value},...} alist associative list -local apairs = function (alist) - local i = 1 - local cur - function nxt () - cur = rawget(alist, i) - if cur then - i = i + 1 - return cur[1], cur[2] - end - return nil - end - return nxt, nil, nil -end - ---- AttributeList, a metatable to allow table-like access to attribute lists --- represented by associative lists. --- @local -local AttributeList = { - __index = function (t, k) - if type(k) == "number" then - return rawget(t, k) - else - return lookup(t, k) - end - end, - - __newindex = function (t, k, v) - local cur, idx = List.find_if(t, assoc_key_equals(k)) - if v == nil and not cur then - -- deleted key does not exists in list - return - elseif v == nil then - table.remove(t, idx) - elseif cur then - cur[2] = v - elseif type(k) == "number" then - rawset(t, k, v) - else - rawset(t, #t + 1, {k, v}) - end - end, - - __pairs = apairs -} - ---- Convert a table to an associative list. The order of key-value pairs in the --- alist is undefined. The table should either contain no numeric keys or --- already be an associative list. --- @local --- @tparam table tbl associative list or table without numeric keys. --- @treturn table associative list -local to_alist = function (tbl) - if #tbl ~= 0 or next(tbl) == nil then - -- probably already an alist - return tbl - end - local alist = {} - local i = 1 - for k, v in pairs(tbl) do - alist[i] = {k, v} - i = i + 1 - end - return alist -end - --- Attr - ---- Create a new set of attributes (Attr). --- @function Attr --- @tparam[opt] string identifier element identifier --- @tparam[opt] {string,...} classes element classes --- @tparam[opt] table attributes table containing string keys and values --- @return element attributes -M.Attr = AstElement:make_subtype'Attr' -function M.Attr:new (identifier, classes, attributes) - identifier = identifier or '' - classes = ensureList(classes or {}) - attributes = setmetatable(to_alist(attributes or {}), AttributeList) - return setmetatable({identifier, classes, attributes}, self.behavior) -end -M.Attr.behavior.clone = M.types.clone.Attr -M.Attr.behavior.tag = 'Attr' -M.Attr.behavior._field_names = {identifier = 1, classes = 2, attributes = 3} -M.Attr.behavior.__eq = utils.equals -M.Attr.behavior.__index = function(t, k) - return (k == 't' and t.tag) or - rawget(t, getmetatable(t)._field_names[k]) or - getmetatable(t)[k] -end -M.Attr.behavior.__newindex = function(t, k, v) - if k == 'attributes' then - rawset(t, 3, setmetatable(to_alist(v or {}), AttributeList)) - elseif getmetatable(t)._field_names[k] then - rawset(t, getmetatable(t)._field_names[k], v) - else - rawset(t, k, v) - end -end -M.Attr.behavior.__pairs = function(t) - local field_names = M.Attr.behavior._field_names - local fields = {} - for name, i in pairs(field_names) do - fields[i] = name - end - return make_next_function(fields), t, nil -end - -- Monkey-patch setters for `attr` fields to be more forgiving in the input that -- results in a valid Attr value. function augment_attr_setter (setters) diff --git a/pandoc.cabal b/pandoc.cabal index 886d3fa9d..9cf609049 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -776,6 +776,7 @@ library Text.Pandoc.Lua.Init, Text.Pandoc.Lua.Marshaling, Text.Pandoc.Lua.Marshaling.AST, + Text.Pandoc.Lua.Marshaling.Attr, Text.Pandoc.Lua.Marshaling.CommonState, Text.Pandoc.Lua.Marshaling.Context, Text.Pandoc.Lua.Marshaling.List, diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs index a9c3695a4..d9b210c55 100644 --- a/src/Text/Pandoc/Lua/Init.hs +++ b/src/Text/Pandoc/Lua/Init.hs @@ -89,7 +89,6 @@ putConstructorsInRegistry = liftPandocLua $ do constrsToReg $ Pandoc.Meta mempty constrsToReg $ Pandoc.MetaList mempty constrsToReg $ Pandoc.Citation mempty mempty mempty Pandoc.AuthorInText 0 0 - putInReg "Attr" -- used for Attr type alias putInReg "ListAttributes" -- used for ListAttributes type alias putInReg "List" -- pandoc.List putInReg "SimpleTable" -- helper for backward-compatible table handling diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 6f97bdd36..9bb956ba2 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -40,6 +41,7 @@ import Control.Monad ((<$!>), (>=>)) import HsLua hiding (Operation (Div)) import Text.Pandoc.Definition import Text.Pandoc.Lua.Util (pushViaConstr', pushViaConstructor) +import Text.Pandoc.Lua.Marshaling.Attr (peekAttr, pushAttr) import Text.Pandoc.Lua.Marshaling.List (pushPandocList) import qualified HsLua as Lua @@ -413,19 +415,6 @@ peekInline = retrieving "Inline" . \idx -> do "Superscript"-> mkBlock Superscript peekInlines Name tag -> Lua.failPeek ("Unknown inline type: " <> tag) -pushAttr :: forall e. LuaError e => Attr -> LuaE e () -pushAttr (id', classes, kv) = pushViaConstr' @e "Attr" - [ pushText id' - , pushList pushText classes - , pushList (pushPair pushText pushText) kv - ] - -peekAttr :: LuaError e => Peeker e Attr -peekAttr = retrieving "Attr" . peekTriple - peekText - (peekList peekText) - (peekList (peekPair peekText peekText)) - pushListAttributes :: forall e. LuaError e => ListAttributes -> LuaE e () pushListAttributes (start, style, delimiter) = pushViaConstr' "ListAttributes" @@ -450,3 +439,6 @@ instance Peekable Meta where instance Peekable Pandoc where peek = forcePeek . peekPandoc + +instance {-# OVERLAPPING #-} Peekable Attr where + peek = forcePeek . peekAttr diff --git a/src/Text/Pandoc/Lua/Marshaling/Attr.hs b/src/Text/Pandoc/Lua/Marshaling/Attr.hs new file mode 100644 index 000000000..1b35e40ad --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshaling/Attr.hs @@ -0,0 +1,225 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{- | +Module : Text.Pandoc.Lua.Marshaling.Attr +Copyright : © 2012-2021 John MacFarlane + © 2017-2021 Albert Krewinkel +License : GNU GPL, version 2 or above + +Maintainer : Albert Krewinkel +Stability : alpha + +Marshaling/unmarshaling instances for document AST elements. +-} +module Text.Pandoc.Lua.Marshaling.Attr + ( typeAttr + , peekAttr + , pushAttr + , mkAttr + , mkAttributeList + ) where + +import Control.Applicative ((<|>), optional) +import Control.Monad ((<$!>)) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import HsLua +import HsLua.Marshalling.Peekers (peekIndexRaw) +import Safe (atMay) +import Text.Pandoc.Definition (Attr, nullAttr) +import Text.Pandoc.Lua.Marshaling.List (pushPandocList) + +import qualified Data.Text as T + +typeAttr :: LuaError e => DocumentedType e Attr +typeAttr = deftype "Attr" + [ operation Eq $ lambda + ### liftPure2 (==) + <#> parameter peekAttr "a1" "Attr" "" + <#> parameter peekAttr "a2" "Attr" "" + =#> functionResult pushBool "boolean" "whether the two are equal" + ] + [ property "identifier" "element identifier" + (pushText, \(ident,_,_) -> ident) + (peekText, \(_,cls,kv) -> (,cls,kv)) + , property "classes" "element classes" + (pushPandocList pushText, \(_,classes,_) -> classes) + (peekList peekText, \(ident,_,kv) -> (ident,,kv)) + , property "attributes" "various element attributes" + (pushAttribs, \(_,_,attribs) -> attribs) + (peekAttribs, \(ident,cls,_) -> (ident,cls,)) + , method $ defun "clone" + ### return + <#> parameter peekAttr "attr" "Attr" "" + =#> functionResult pushAttr "Attr" "new Attr element" + ] + +pushAttr :: LuaError e => Pusher e Attr +pushAttr = pushUD typeAttr + +peekAttribs :: LuaError e => Peeker e [(Text,Text)] +peekAttribs idx = liftLua (ltype idx) >>= \case + TypeUserdata -> peekUD typeAttributeList idx + TypeTable -> liftLua (rawlen idx) >>= \case + 0 -> peekKeyValuePairs peekText peekText idx + _ -> peekList (peekPair peekText peekText) idx + _ -> fail "unsupported type" + +pushAttribs :: LuaError e => Pusher e [(Text, Text)] +pushAttribs = pushUD typeAttributeList + +typeAttributeList :: LuaError e => DocumentedType e [(Text, Text)] +typeAttributeList = deftype "AttributeList" + [ operation Eq $ lambda + ### liftPure2 (==) + <#> parameter peekAttribs "a1" "AttributeList" "" + <#> parameter peekAttribs "a2" "AttributeList" "" + =#> functionResult pushBool "boolean" "whether the two are equal" + + , operation Index $ lambda + ### liftPure2 lookupKey + <#> udparam typeAttributeList "t" "attributes list" + <#> parameter peekKey "string|integer" "key" "lookup key" + =#> functionResult (maybe pushnil pushAttribute) "string|table" + "attribute value" + + , operation Newindex $ lambda + ### setKey + <#> udparam typeAttributeList "t" "attributes list" + <#> parameter peekKey "string|integer" "key" "lookup key" + <#> optionalParameter peekAttribute "string|nil" "value" "new value" + =#> [] + + , operation Len $ lambda + ### liftPure length + <#> udparam typeAttributeList "t" "attributes list" + =#> functionResult pushIntegral "integer" "number of attributes in list" + + , operation Pairs $ lambda + ### pushIterator (\(k, v) -> 2 <$ pushText k <* pushText v) + <#> udparam typeAttributeList "t" "attributes list" + =?> "iterator triple" + + , operation Tostring $ lambda + ### liftPure show + <#> udparam typeAttributeList "t" "attributes list" + =#> functionResult pushString "string" "" + ] + [] + +data Key = StringKey Text | IntKey Int + +peekKey :: LuaError e => Peeker e (Maybe Key) +peekKey idx = liftLua (ltype idx) >>= \case + TypeNumber -> Just . IntKey <$!> peekIntegral idx + TypeString -> Just . StringKey <$!> peekText idx + _ -> return Nothing + +data Attribute + = AttributePair (Text, Text) + | AttributeValue Text + +pushAttribute :: LuaError e => Pusher e Attribute +pushAttribute = \case + (AttributePair kv) -> pushPair pushText pushText kv + (AttributeValue v) -> pushText v + +-- | Retrieve an 'Attribute'. +peekAttribute :: LuaError e => Peeker e Attribute +peekAttribute idx = (AttributeValue <$!> peekText idx) + <|> (AttributePair <$!> peekPair peekText peekText idx) + +lookupKey :: [(Text,Text)] -> Maybe Key -> Maybe Attribute +lookupKey !kvs = \case + Just (StringKey str) -> AttributeValue <$> lookup str kvs + Just (IntKey n) -> AttributePair <$!> atMay kvs (n - 1) + Nothing -> Nothing + +setKey :: forall e. LuaError e + => [(Text, Text)] -> Maybe Key -> Maybe Attribute + -> LuaE e () +setKey kvs mbKey mbValue = case mbKey of + Just (StringKey str) -> + case break ((== str) . fst) kvs of + (prefix, _:suffix) -> case mbValue of + Nothing -> setNew $ prefix ++ suffix + Just (AttributeValue value) -> setNew $ prefix ++ (str, value):suffix + _ -> failLua "invalid attribute value" + _ -> case mbValue of + Nothing -> return () + Just (AttributeValue value) -> setNew (kvs ++ [(str, value)]) + _ -> failLua "invalid attribute value" + Just (IntKey idx) -> + case splitAt (idx - 1) kvs of + (prefix, (k,_):suffix) -> setNew $ case mbValue of + Nothing -> prefix ++ suffix + Just (AttributePair kv) -> prefix ++ kv : suffix + Just (AttributeValue v) -> prefix ++ (k, v) : suffix + (prefix, []) -> case mbValue of + Nothing -> setNew prefix + Just (AttributePair kv) -> setNew $ prefix ++ [kv] + _ -> failLua $ "trying to set an attribute key-value pair, " + ++ "but got a single string instead." + + _ -> failLua "invalid attribute key" + where + setNew :: [(Text, Text)] -> LuaE e () + setNew new = + putuserdata (nthBottom 1) (udName @e typeAttributeList) new >>= \case + True -> return () + False -> failLua "failed to modify attributes list" + +peekAttr :: LuaError e => Peeker e Attr +peekAttr idx = retrieving "Attr" $ liftLua (ltype idx) >>= \case + TypeString -> (,[],[]) <$!> peekText idx -- treat string as ID + TypeUserdata -> peekUD typeAttr idx + TypeTable -> peekAttrTable idx + x -> liftLua . failLua $ "Cannot get Attr from " ++ show x + +-- | Helper function which gets an Attr from a Lua table. +peekAttrTable :: LuaError e => Peeker e Attr +peekAttrTable idx = do + len' <- liftLua $ rawlen idx + let peekClasses = peekList peekText + if len' > 0 + then do + ident <- peekIndexRaw 1 peekText idx + classes <- fromMaybe [] <$!> optional (peekIndexRaw 2 peekClasses idx) + attribs <- fromMaybe [] <$!> optional (peekIndexRaw 3 peekAttribs idx) + return $ ident `seq` classes `seq` attribs `seq` + (ident, classes, attribs) + else retrieving "HTML-like attributes" $ do + kvs <- peekKeyValuePairs peekText peekText idx + let ident = fromMaybe "" $ lookup "id" kvs + let classes = maybe [] T.words $ lookup "class" kvs + let attribs = filter ((`notElem` ["id", "class"]) . fst) kvs + return $ ident `seq` classes `seq` attribs `seq` + (ident, classes, attribs) + +mkAttr :: LuaError e => LuaE e NumResults +mkAttr = do + attr <- ltype (nthBottom 1) >>= \case + TypeString -> forcePeek $ do + mident <- optional (peekText (nthBottom 1)) + mclass <- optional (peekList peekText (nthBottom 2)) + mattribs <- optional (peekAttribs (nthBottom 3)) + return (fromMaybe "" mident, fromMaybe [] mclass, fromMaybe [] mattribs) + TypeTable -> forcePeek $ peekAttrTable (nthBottom 1) + TypeUserdata -> forcePeek $ peekUD typeAttr (nthBottom 1) <|> do + attrList <- peekUD typeAttributeList (nthBottom 1) + return ("", [], attrList) + TypeNil -> pure nullAttr + TypeNone -> pure nullAttr + x -> failLua $ "Cannot create Attr from " ++ show x + pushAttr attr + return 1 + +mkAttributeList :: LuaError e => LuaE e NumResults +mkAttributeList = do + attribs <- forcePeek $ peekAttribs (nthBottom 1) + pushUD typeAttributeList attribs + return 1 diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index 84d6be360..34317276d 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -29,6 +29,7 @@ import Text.Pandoc.Lua.Filter (SingletonsList (..), walkInlines, walkInlineLists, walkBlocks, walkBlockLists) import Text.Pandoc.Lua.Marshaling () import Text.Pandoc.Lua.Marshaling.AST +import Text.Pandoc.Lua.Marshaling.Attr (mkAttr, mkAttributeList) import Text.Pandoc.Lua.Marshaling.List (List (..)) import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua, loadDefaultModule) @@ -54,6 +55,8 @@ pushModule = do addFunction "walk_inline" (walkElement peekInline pushInline) -- Constructors addFunction "Pandoc" mkPandoc + addFunction "Attr" (liftPandocLua mkAttr) + addFunction "AttributeList" (liftPandocLua mkAttributeList) return 1 walkElement :: (Walkable (SingletonsList Inline) a, diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs index 5538915a7..d3694d8a9 100644 --- a/test/Tests/Lua.hs +++ b/test/Tests/Lua.hs @@ -204,7 +204,7 @@ tests = map (localOption (QuickCheckTests 20)) [Para [Str "ignored"]]) Lua.getfield Lua.top "attr" Lua.liftIO . assertEqual "no accessor" (("hi", ["moin"], []) :: Attr) - =<< Lua.peek Lua.top + =<< Lua.peek @Attr Lua.top , testCase "module `pandoc.system` is present" . runLuaTest $ do Lua.getglobal' "pandoc.system" diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index fa1748c18..a1bcd53fe 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -11,34 +11,32 @@ end return { group 'Attr' { group 'Constructor' { + test('pandoc.Attr is a function', function () + assert.are_equal(type(pandoc.Attr), 'function') + end), test('returns null-Attr if no arguments are given', function () local attr = pandoc.Attr() assert.are_equal(attr.identifier, '') assert.are_same(attr.classes, {}) - assert.are_same(attr.attributes, {}) + assert.are_same(#attr.attributes, 0) end), test( 'accepts string-indexed table or list of pairs as attributes', function () - local attributes_list = pandoc.List:new {{'one', '1'}, {'two', '2'}} - local attr_from_list = pandoc.Attr('', {}, attributes_list:clone()) + local attributes_list = {{'one', '1'}, {'two', '2'}} + local attr_from_list = pandoc.Attr('', {}, attributes_list) - assert.are_same( - pandoc.List:new(attr_from_list.attributes), - attributes_list - ) + assert.are_equal(attr_from_list.attributes.one, '1') + assert.are_equal(attr_from_list.attributes.two, '2') local attributes_table = {one = '1', two = '2'} local attr_from_table = pandoc.Attr('', {}, attributes_table) - - local assoc_list_from_table = - pandoc.List:new(attr_from_table.attributes) - -- won't work in general, but does in this special case - table.sort(assoc_list_from_table, function(x, y) return x[1] Date: Sun, 24 Oct 2021 22:49:34 +0200 Subject: Lua: marshal Citation values as userdata objects --- data/pandoc.lua | 23 ------------------ src/Text/Pandoc/Lua/Marshaling/AST.hs | 45 +++++++++++++++++++++++------------ src/Text/Pandoc/Lua/Module/Pandoc.hs | 23 ++++++++++++++++++ src/Text/Pandoc/Lua/Module/Types.hs | 1 - test/lua/module/pandoc.lua | 2 ++ 5 files changed, 55 insertions(+), 39 deletions(-) (limited to 'test/lua') diff --git a/data/pandoc.lua b/data/pandoc.lua index 8fbd2259b..47343b28c 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -557,29 +557,6 @@ for _, blk in pairs(M.Block.constructor) do augment_attr_setter(blk.behavior.setters) end --- Citation -M.Citation = AstElement:make_subtype'Citation' -M.Citation.behavior.clone = M.types.clone.Citation - ---- Creates a single citation. --- @function Citation --- @tparam string id citation identifier (like a bibtex key) --- @tparam AuthorInText|SuppressAuthor|NormalCitation mode citation mode --- @tparam[opt] {Inline,...} prefix citation prefix --- @tparam[opt] {Inline,...} suffix citation suffix --- @tparam[opt] int note_num note number --- @tparam[opt] int hash hash number -function M.Citation:new (id, mode, prefix, suffix, note_num, hash) - return { - id = id, - mode = mode, - prefix = ensureList(prefix or {}), - suffix = ensureList(suffix or {}), - note_num = note_num or 0, - hash = hash or 0, - } -end - -- ListAttributes M.ListAttributes = AstElement:make_subtype 'ListAttributes' M.ListAttributes.behavior.clone = M.types.clone.ListAttributes diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 5791b39c1..e436ffffc 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -37,6 +37,7 @@ module Text.Pandoc.Lua.Marshaling.AST , pushAttr , pushBlock + , pushCitation , pushInline , pushListAttributes , pushMetaValue @@ -109,24 +110,35 @@ instance Pushable Inline where instance Pushable Citation where push = pushCitation -pushCitation :: LuaError e => Pusher e Citation -pushCitation (Citation cid prefix suffix mode noteNum hash) = - pushViaConstr' "Citation" - [ push cid, push mode, push prefix, push suffix, push noteNum, push hash +typeCitation :: LuaError e => DocumentedType e Citation +typeCitation = deftype "Citation" [] + [ property "id" "citation ID / key" + (pushText, citationId) + (peekText, \citation cid -> citation{ citationId = cid }) + , property "mode" "citation mode" + (pushString . show, citationMode) + (peekRead, \citation mode -> citation{ citationMode = mode }) + , property "prefix" "citation prefix" + (pushInlines, citationPrefix) + (peekInlines, \citation prefix -> citation{ citationPrefix = prefix }) + , property "suffix" "citation suffix" + (pushInlines, citationSuffix) + (peekInlines, \citation suffix -> citation{ citationPrefix = suffix }) + , property "note_num" "note number" + (pushIntegral, citationNoteNum) + (peekIntegral, \citation noteNum -> citation{ citationNoteNum = noteNum }) + , property "hash" "hash number" + (pushIntegral, citationHash) + (peekIntegral, \citation hash -> citation{ citationHash = hash }) + , method $ defun "clone" ### return <#> udparam typeCitation "obj" "" + =#> functionResult pushCitation "Citation" "copy of obj" ] -peekCitation :: LuaError e => Peeker e Citation -peekCitation = fmap (retrieving "Citation") - . typeChecked "table" Lua.istable $ \idx -> do - idx' <- liftLua $ absindex idx - Citation - <$!> peekFieldRaw peekText "id" idx' - <*> peekFieldRaw (peekList peekInline) "prefix" idx' - <*> peekFieldRaw (peekList peekInline) "suffix" idx' - <*> peekFieldRaw peekRead "mode" idx' - <*> peekFieldRaw peekIntegral "note_num" idx' - <*> peekFieldRaw peekIntegral "hash" idx' +pushCitation :: LuaError e => Pusher e Citation +pushCitation = pushUD typeCitation +peekCitation :: LuaError e => Peeker e Citation +peekCitation = peekUD typeCitation instance Pushable Alignment where push = Lua.pushString . show @@ -289,6 +301,9 @@ peekBlocks = peekList peekBlock peekInlines :: LuaError e => Peeker e [Inline] peekInlines = peekList peekInline +pushInlines :: LuaError e => Pusher e [Inline] +pushInlines = pushPandocList pushInline + -- | Push Caption element pushCaption :: LuaError e => Caption -> LuaE e () pushCaption (Caption shortCaption longCaption) = do diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index eeadfa340..bc9ddc5e5 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -64,6 +64,7 @@ pushModule = do pushName (functionName fn) pushDocumentedFunction fn rawset (nth 3) + forM_ otherConstructors addConstr forM_ inlineConstructors addConstr -- add constructors to Inlines.constructor newtable -- constructor @@ -165,6 +166,28 @@ mkInlinesConstr name constr = defun name <#> parameter peekFuzzyInlines "content" "Inlines" "" =#> functionResult pushInline "Inline" "new object" +otherConstructors :: LuaError e => [DocumentedFunction e] +otherConstructors = + [ defun "Citation" + ### (\cid mode mprefix msuffix mnote_num mhash -> + cid `seq` mode `seq` mprefix `seq` msuffix `seq` + mnote_num `seq` mhash `seq` return $! Citation + { citationId = cid + , citationMode = mode + , citationPrefix = fromMaybe mempty mprefix + , citationSuffix = fromMaybe mempty msuffix + , citationNoteNum = fromMaybe 0 mnote_num + , citationHash = fromMaybe 0 mhash + }) + <#> parameter peekText "string" "cid" "citation ID (e.g. bibtex key)" + <#> parameter peekRead "citation mode" "mode" "citation rendering mode" + <#> optionalParameter peekFuzzyInlines "prefix" "Inlines" "" + <#> optionalParameter peekFuzzyInlines "suffix" "Inlines" "" + <#> optionalParameter peekIntegral "note_num" "integer" "note number" + <#> optionalParameter peekIntegral "hash" "integer" "hash number" + =#> functionResult pushCitation "Citation" "new citation object" + #? "Creates a single citation." + ] walkElement :: (Walkable (SingletonsList Inline) a, Walkable (SingletonsList Block) a, diff --git a/src/Text/Pandoc/Lua/Module/Types.hs b/src/Text/Pandoc/Lua/Module/Types.hs index 7307c6e88..4a7d14d2f 100644 --- a/src/Text/Pandoc/Lua/Module/Types.hs +++ b/src/Text/Pandoc/Lua/Module/Types.hs @@ -37,7 +37,6 @@ pushCloneTable = do Lua.newtable addFunction "Attr" $ cloneWith peekAttr pushAttr addFunction "Block" $ cloneWith peekBlock pushBlock - addFunction "Citation" $ cloneWith peekCitation Lua.push addFunction "Inline" $ cloneWith peekInline pushInline addFunction "Meta" $ cloneWith peekMeta Lua.push addFunction "MetaValue" $ cloneWith peekMetaValue pushMetaValue diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index a1bcd53fe..ba6d2a1df 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -176,6 +176,8 @@ return { local cloned = cite:clone() cite.id = 'newton' assert.are_same(cloned.id, 'leibniz') + assert.are_same(cite.id, 'newton') + assert.are_same(cite.mode, cloned.mode) end), }, -- cgit v1.2.3 From a493c7029cf2bc8490d96fff04b0a0c624987601 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 26 Oct 2021 14:40:10 +0200 Subject: Lua: marshal Block values as userdata objects Properties of Block values are marshalled lazily, which generally improves performance considerably. Script users may also notice the following differences: - Block element properties can no longer be accessed by numerical indexing of the `.c` field. The `.c` property now serves as an alias for `.content`, so some filter that used this undocumented method for property access may continue to work, while others will need to be updated and use proper property names. - The marshalled Block elements now have a `show` method, and a `__tostring` metamethod. Both return the Haskell string representation of the element. - Block values now have the Lua type `userdata` instead of `table`. --- data/pandoc.lua | 205 ---------------- src/Text/Pandoc/Lua/Init.hs | 4 - src/Text/Pandoc/Lua/Marshaling/AST.hs | 431 +++++++++++++++++++++++++--------- src/Text/Pandoc/Lua/Module/Pandoc.hs | 168 ++++++++++--- src/Text/Pandoc/Lua/Module/Types.hs | 4 - test/lua/module/pandoc.lua | 120 ++++++++++ 6 files changed, 581 insertions(+), 351 deletions(-) (limited to 'test/lua') diff --git a/data/pandoc.lua b/data/pandoc.lua index 47343b28c..a20ce1e8c 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -273,22 +273,6 @@ local function ensureInlineList (x) end end ---- Ensure that the given object is a definition pair, convert if necessary. --- @local -local function ensureDefinitionPairs (pair) - local inlines = ensureInlineList(pair[1] or {}) - local blocks = ensureList(pair[2] or {}):map(ensureList) - return {inlines, blocks} -end - ---- Try hard to turn the arguments into an Attr object. -local function ensureAttr(attr) - if type(attr) == 'userdata' then - return attr - end - return M.Attr(attr) -end - ------------------------------------------------------------------------ -- Meta -- @section Meta @@ -364,199 +348,10 @@ function M.MetaBool(bool) return bool end ------------------------------------------------------------------------- --- Blocks --- @section Block - ---- Block elements -M.Block = AstElement:make_subtype'Block' -M.Block.behavior.clone = M.types.clone.Block - ---- Creates a block quote element --- @function BlockQuote --- @tparam {Block,...} content block content --- @treturn Block block quote element -M.BlockQuote = M.Block:create_constructor( - "BlockQuote", - function(content) return {c = ensureList(content)} end, - "content" -) - ---- Creates a bullet (i.e. unordered) list. --- @function BulletList --- @tparam {{Block,...},...} content list of items --- @treturn Block bullet list element -M.BulletList = M.Block:create_constructor( - "BulletList", - function(content) return {c = ensureList(content):map(ensureList)} end, - "content" -) - ---- Creates a code block element --- @function CodeBlock --- @tparam string text code string --- @tparam[opt] Attr attr element attributes --- @treturn Block code block element -M.CodeBlock = M.Block:create_constructor( - "CodeBlock", - function(text, attr) return {c = {ensureAttr(attr), text}} end, - {{attr = {"identifier", "classes", "attributes"}}, "text"} -) - ---- Creates a definition list, containing terms and their explanation. --- @function DefinitionList --- @tparam {{{Inline,...},{{Block,...}}},...} content list of items --- @treturn Block definition list element -M.DefinitionList = M.Block:create_constructor( - "DefinitionList", - function(content) - return {c = ensureList(content):map(ensureDefinitionPairs)} - end, - "content" -) - ---- Creates a div element --- @function Div --- @tparam {Block,...} content block content --- @tparam[opt] Attr attr element attributes --- @treturn Block div element -M.Div = M.Block:create_constructor( - "Div", - function(content, attr) - return {c = {ensureAttr(attr), ensureList(content)}} - end, - {{attr = {"identifier", "classes", "attributes"}}, "content"} -) - ---- Creates a header element. --- @function Header --- @tparam int level header level --- @tparam {Inline,...} content inline content --- @tparam[opt] Attr attr element attributes --- @treturn Block header element -M.Header = M.Block:create_constructor( - "Header", - function(level, content, attr) - return {c = {level, ensureAttr(attr), ensureInlineList(content)}} - end, - {"level", {attr = {"identifier", "classes", "attributes"}}, "content"} -) - ---- Creates a horizontal rule. --- @function HorizontalRule --- @treturn Block horizontal rule -M.HorizontalRule = M.Block:create_constructor( - "HorizontalRule", - function() return {} end -) - ---- Creates a line block element. --- @function LineBlock --- @tparam {{Inline,...},...} content inline content --- @treturn Block line block element -M.LineBlock = M.Block:create_constructor( - "LineBlock", - function(content) return {c = ensureList(content):map(ensureInlineList)} end, - "content" -) - ---- Creates a null element. --- @function Null --- @treturn Block null element -M.Null = M.Block:create_constructor( - "Null", - function() return {} end -) - ---- Creates an ordered list. --- @function OrderedList --- @tparam {{Block,...},...} items list items --- @param[opt] listAttributes list parameters --- @treturn Block ordered list element -M.OrderedList = M.Block:create_constructor( - "OrderedList", - function(items, listAttributes) - listAttributes = listAttributes or M.ListAttributes() - return {c = {listAttributes, ensureList(items):map(ensureList)}} - end, - {{listAttributes = {"start", "style", "delimiter"}}, "content"} -) - ---- Creates a para element. --- @function Para --- @tparam {Inline,...} content inline content --- @treturn Block paragraph element -M.Para = M.Block:create_constructor( - "Para", - function(content) return {c = ensureInlineList(content)} end, - "content" -) - ---- Creates a plain element. --- @function Plain --- @tparam {Inline,...} content inline content --- @treturn Block plain element -M.Plain = M.Block:create_constructor( - "Plain", - function(content) return {c = ensureInlineList(content)} end, - "content" -) - ---- Creates a raw content block of the specified format. --- @function RawBlock --- @tparam string format format of content --- @tparam string text string content --- @treturn Block raw block element -M.RawBlock = M.Block:create_constructor( - "RawBlock", - function(format, text) return {c = {format, text}} end, - {"format", "text"} -) - ---- Creates a table element. --- @function Table --- @tparam Caption caption table caption --- @tparam {ColSpec,...} colspecs column alignments and widths --- @tparam TableHead head table head --- @tparam {TableBody,..} bodies table bodies --- @treturn TableFoot foot table foot --- @tparam[opt] Attr attr attributes -M.Table = M.Block:create_constructor( - "Table", - function(caption, colspecs, head, bodies, foot, attr) - return { - c = { - ensureAttr(attr), - caption, - List:new(colspecs), - head, - List:new(bodies), - foot - } - } - end, - {"attr", "caption", "colspecs", "head", "bodies", "foot"} -) - - ------------------------------------------------------------------------ -- Element components -- @section components --- Monkey-patch setters for `attr` fields to be more forgiving in the input that --- results in a valid Attr value. -function augment_attr_setter (setters) - if setters.attr then - local orig = setters.attr - setters.attr = function(k, v) - orig(k, ensureAttr(v)) - end - end -end -for _, blk in pairs(M.Block.constructor) do - augment_attr_setter(blk.behavior.setters) -end - -- ListAttributes M.ListAttributes = AstElement:make_subtype 'ListAttributes' M.ListAttributes.behavior.clone = M.types.clone.ListAttributes diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs index d9b210c55..60475e25c 100644 --- a/src/Text/Pandoc/Lua/Init.hs +++ b/src/Text/Pandoc/Lua/Init.hs @@ -83,12 +83,8 @@ initLuaState = do -- stack. putConstructorsInRegistry :: PandocLua () putConstructorsInRegistry = liftPandocLua $ do - constrsToReg $ Pandoc.Pandoc mempty mempty - constrsToReg $ Pandoc.Str mempty - constrsToReg $ Pandoc.Para mempty constrsToReg $ Pandoc.Meta mempty constrsToReg $ Pandoc.MetaList mempty - constrsToReg $ Pandoc.Citation mempty mempty mempty Pandoc.AuthorInText 0 0 putInReg "ListAttributes" -- used for ListAttributes type alias putInReg "List" -- pandoc.List putInReg "SimpleTable" -- helper for backward-compatible table handling diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index e436ffffc..22c78bff9 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -19,21 +19,27 @@ Marshaling/unmarshaling instances for document AST elements. module Text.Pandoc.Lua.Marshaling.AST ( peekAttr , peekBlock + , peekBlockFuzzy , peekBlocks + , peekBlocksFuzzy , peekCaption , peekCitation + , peekColSpec + , peekDefinitionItem , peekFormat , peekInline + , peekInlineFuzzy , peekInlines + , peekInlinesFuzzy , peekListAttributes , peekMeta , peekMetaValue , peekPandoc , peekMathType , peekQuoteType - - , peekFuzzyInlines - , peekFuzzyBlocks + , peekTableBody + , peekTableHead + , peekTableFoot , pushAttr , pushBlock @@ -46,7 +52,7 @@ module Text.Pandoc.Lua.Marshaling.AST import Control.Applicative ((<|>), optional) import Control.Monad.Catch (throwM) -import Control.Monad ((<$!>), (>=>)) +import Control.Monad ((<$!>)) import Data.Data (showConstr, toConstr) import Data.Text (Text) import Data.Version (Version) @@ -54,7 +60,7 @@ import HsLua hiding (Operation (Div)) import HsLua.Module.Version (peekVersionFuzzy) import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError (PandocLuaError)) -import Text.Pandoc.Lua.Util (pushViaConstr', pushViaConstructor) +import Text.Pandoc.Lua.Util (pushViaConstr') import Text.Pandoc.Lua.Marshaling.Attr (peekAttr, pushAttr) import Text.Pandoc.Lua.Marshaling.List (pushPandocList) @@ -102,14 +108,6 @@ instance Pushable MetaValue where instance Pushable Block where push = pushBlock --- Inline -instance Pushable Inline where - push = pushInline - --- Citation -instance Pushable Citation where - push = pushCitation - typeCitation :: LuaError e => DocumentedType e Citation typeCitation = deftype "Citation" [] [ property "id" "citation ID / key" @@ -232,69 +230,188 @@ peekMetaValue = retrieving "MetaValue $ " . \idx -> do Nothing -> peekUntagged _ -> failPeek "could not get meta value" +typeBlock :: LuaError e => DocumentedType e Block +typeBlock = deftype "Block" + [ operation Eq $ lambda + ### liftPure2 (==) + <#> parameter peekBlockFuzzy "Block" "a" "" + <#> parameter peekBlockFuzzy "Block" "b" "" + =#> boolResult "whether the two values are equal" + , operation Tostring $ lambda + ### liftPure show + <#> udparam typeBlock "self" "" + =#> functionResult pushString "string" "Haskell representation" + ] + [ possibleProperty "attr" "element attributes" + (pushAttr, \case + CodeBlock attr _ -> Actual attr + Div attr _ -> Actual attr + Header _ attr _ -> Actual attr + Table attr _ _ _ _ _ -> Actual attr + _ -> Absent) + (peekAttr, \case + CodeBlock _ code -> Actual . flip CodeBlock code + Div _ blks -> Actual . flip Div blks + Header lvl _ blks -> Actual . (\attr -> Header lvl attr blks) + Table _ c cs h bs f -> Actual . (\attr -> Table attr c cs h bs f) + _ -> const Absent) + , possibleProperty "bodies" "table bodies" + (pushPandocList pushTableBody, \case + Table _ _ _ _ bs _ -> Actual bs + _ -> Absent) + (peekList peekTableBody, \case + Table attr c cs h _ f -> Actual . (\bs -> Table attr c cs h bs f) + _ -> const Absent) + , possibleProperty "caption" "element caption" + (pushCaption, \case {Table _ capt _ _ _ _ -> Actual capt; _ -> Absent}) + (peekCaption, \case + Table attr _ cs h bs f -> Actual . (\c -> Table attr c cs h bs f) + _ -> const Absent) + , possibleProperty "colspecs" "column alignments and widths" + (pushPandocList pushColSpec, \case + Table _ _ cs _ _ _ -> Actual cs + _ -> Absent) + (peekList peekColSpec, \case + Table attr c _ h bs f -> Actual . (\cs -> Table attr c cs h bs f) + _ -> const Absent) + , possibleProperty "content" "element content" + (pushContent, getBlockContent) + (peekContent, setBlockContent) + , possibleProperty "foot" "table foot" + (pushTableFoot, \case {Table _ _ _ _ _ f -> Actual f; _ -> Absent}) + (peekTableFoot, \case + Table attr c cs h bs _ -> Actual . (\f -> Table attr c cs h bs f) + _ -> const Absent) + , possibleProperty "format" "format of raw content" + (pushFormat, \case {RawBlock f _ -> Actual f; _ -> Absent}) + (peekFormat, \case + RawBlock _ txt -> Actual . (`RawBlock` txt) + _ -> const Absent) + , possibleProperty "head" "table head" + (pushTableHead, \case {Table _ _ _ h _ _ -> Actual h; _ -> Absent}) + (peekTableHead, \case + Table attr c cs _ bs f -> Actual . (\h -> Table attr c cs h bs f) + _ -> const Absent) + , possibleProperty "level" "heading level" + (pushIntegral, \case {Header lvl _ _ -> Actual lvl; _ -> Absent}) + (peekIntegral, \case + Header _ attr inlns -> Actual . \lvl -> Header lvl attr inlns + _ -> const Absent) + , possibleProperty "listAttributes" "ordered list attributes" + (pushListAttributes, \case + OrderedList listAttr _ -> Actual listAttr + _ -> Absent) + (peekListAttributes, \case + OrderedList _ content -> Actual . (`OrderedList` content) + _ -> const Absent) + , possibleProperty "text" "text contents" + (pushText, getBlockText) + (peekText, setBlockText) + + , readonly "tag" "type of Block" + (pushString, showConstr . toConstr ) + + , alias "t" "tag" ["tag"] + , alias "c" "content" ["content"] + , alias "identifier" "element identifier" ["attr", "identifier"] + , alias "classes" "element classes" ["attr", "classes"] + , alias "attributes" "other element attributes" ["attr", "attributes"] + , alias "start" "ordered list start number" ["listAttributes", "start"] + , alias "style" "ordered list style" ["listAttributes", "style"] + , alias "delimiter" "numbering delimiter" ["listAttributes", "delimiter"] + + , method $ defun "clone" + ### return + <#> parameter peekBlock "Block" "block" "self" + =#> functionResult pushBlock "Block" "cloned Block" + + , method $ defun "show" + ### liftPure show + <#> parameter peekBlock "Block" "self" "" + =#> functionResult pushString "string" "Haskell string representation" + ] + where + boolResult = functionResult pushBool "boolean" + +getBlockContent :: Block -> Possible Content +getBlockContent = \case + -- inline content + Para inlns -> Actual $ ContentInlines inlns + Plain inlns -> Actual $ ContentInlines inlns + -- inline content + BlockQuote blks -> Actual $ ContentBlocks blks + Div _ blks -> Actual $ ContentBlocks blks + -- lines content + LineBlock lns -> Actual $ ContentLines lns + -- list items content + BulletList itms -> Actual $ ContentListItems itms + OrderedList _ itms -> Actual $ ContentListItems itms + -- definition items content + DefinitionList itms -> Actual $ ContentDefItems itms + _ -> Absent + +setBlockContent :: Block -> Content -> Possible Block +setBlockContent = \case + -- inline content + Para _ -> Actual . Para . inlineContent + Plain _ -> Actual . Plain . inlineContent + -- block content + BlockQuote _ -> Actual . BlockQuote . blockContent + Div attr _ -> Actual . Div attr . blockContent + -- lines content + LineBlock _ -> Actual . LineBlock . lineContent + -- list items content + BulletList _ -> Actual . BulletList . listItemContent + OrderedList la _ -> Actual . OrderedList la . listItemContent + -- definition items content + DefinitionList _ -> Actual . DefinitionList . defItemContent + _ -> const Absent + where + inlineContent = \case + ContentInlines inlns -> inlns + c -> throwM . PandocLuaError $ "expected Inlines, got " <> + contentTypeDescription c + blockContent = \case + ContentBlocks blks -> blks + ContentInlines inlns -> [Plain inlns] + c -> throwM . PandocLuaError $ "expected Blocks, got " <> + contentTypeDescription c + lineContent = \case + ContentLines lns -> lns + c -> throwM . PandocLuaError $ "expected list of lines, got " <> + contentTypeDescription c + defItemContent = \case + ContentDefItems itms -> itms + c -> throwM . PandocLuaError $ "expected definition items, got " <> + contentTypeDescription c + listItemContent = \case + ContentBlocks blks -> [blks] + ContentLines lns -> map ((:[]) . Plain) lns + ContentListItems itms -> itms + c -> throwM . PandocLuaError $ "expected list of items, got " <> + contentTypeDescription c + +getBlockText :: Block -> Possible Text +getBlockText = \case + CodeBlock _ lst -> Actual lst + RawBlock _ raw -> Actual raw + _ -> Absent + +setBlockText :: Block -> Text -> Possible Block +setBlockText = \case + CodeBlock attr _ -> Actual . CodeBlock attr + RawBlock f _ -> Actual . RawBlock f + _ -> const Absent + -- | Push a block element to the top of the Lua stack. pushBlock :: forall e. LuaError e => Block -> LuaE e () -pushBlock = \case - BlockQuote blcks -> pushViaConstructor @e "BlockQuote" blcks - BulletList items -> pushViaConstructor @e "BulletList" items - CodeBlock attr code -> pushViaConstr' @e "CodeBlock" - [ push code, pushAttr attr ] - DefinitionList items -> pushViaConstructor @e "DefinitionList" items - Div attr blcks -> pushViaConstr' @e "Div" - [push blcks, pushAttr attr] - Header lvl attr inlns -> pushViaConstr' @e "Header" - [push lvl, push inlns, pushAttr attr] - HorizontalRule -> pushViaConstructor @e "HorizontalRule" - LineBlock blcks -> pushViaConstructor @e "LineBlock" blcks - OrderedList lstAttr list -> pushViaConstr' @e "OrderedList" - [ push list, pushListAttributes @e lstAttr ] - Null -> pushViaConstructor @e "Null" - Para blcks -> pushViaConstructor @e "Para" blcks - Plain blcks -> pushViaConstructor @e "Plain" blcks - RawBlock f cs -> pushViaConstructor @e "RawBlock" f cs - Table attr blkCapt specs thead tbody tfoot -> - pushViaConstr' @e "Table" - [ pushCaption blkCapt, push specs, push thead, push tbody - , push tfoot, pushAttr attr] +pushBlock = pushUD typeBlock -- | Return the value at the given index as block if possible. peekBlock :: forall e. LuaError e => Peeker e Block -peekBlock = fmap (retrieving "Block") - . typeChecked "table" Lua.istable - $ \idx -> do - -- Get the contents of an AST element. - let mkBlock :: (a -> Block) -> Peeker e a -> Peek e Block - mkBlock f p = f <$!> peekFieldRaw p "c" idx - LuaUtil.getTag idx >>= \case - "BlockQuote" -> mkBlock BlockQuote peekBlocks - "BulletList" -> mkBlock BulletList (peekList peekBlocks) - "CodeBlock" -> mkBlock (uncurry CodeBlock) - (peekPair peekAttr peekText) - "DefinitionList" -> mkBlock DefinitionList - (peekList (peekPair peekInlines (peekList peekBlocks))) - "Div" -> mkBlock (uncurry Div) (peekPair peekAttr peekBlocks) - "Header" -> mkBlock (\(lvl, attr, lst) -> Header lvl attr lst) - (peekTriple peekIntegral peekAttr peekInlines) - "HorizontalRule" -> return HorizontalRule - "LineBlock" -> mkBlock LineBlock (peekList peekInlines) - "OrderedList" -> mkBlock (uncurry OrderedList) - (peekPair peekListAttributes (peekList peekBlocks)) - "Null" -> return Null - "Para" -> mkBlock Para peekInlines - "Plain" -> mkBlock Plain peekInlines - "RawBlock" -> mkBlock (uncurry RawBlock) - (peekPair peekFormat peekText) - "Table" -> mkBlock id - (retrieving "Table" . (liftLua . absindex >=> (\idx' -> cleanup $ do - attr <- liftLua (rawgeti idx' 1) *> peekAttr top - capt <- liftLua (rawgeti idx' 2) *> peekCaption top - cs <- liftLua (rawgeti idx' 3) *> peekList peekColSpec top - thead <- liftLua (rawgeti idx' 4) *> peekTableHead top - tbods <- liftLua (rawgeti idx' 5) *> peekList peekTableBody top - tfoot <- liftLua (rawgeti idx' 6) *> peekTableFoot top - return $! Table attr capt cs thead tbods tfoot))) - Name tag -> failPeek ("Unknown block type: " <> tag) +peekBlock = retrieving "Block" . peekUD typeBlock +-- | Retrieves a list of Block elements. peekBlocks :: LuaError e => Peeker e [Block] peekBlocks = peekList peekBlock @@ -304,6 +421,16 @@ peekInlines = peekList peekInline pushInlines :: LuaError e => Pusher e [Inline] pushInlines = pushPandocList pushInline +-- | Retrieves a single definition item from a the stack; it is expected +-- to be a pair of a list of inlines and a list of list of blocks. Uses +-- fuzzy parsing, i.e., tries hard to convert mismatching types into the +-- expected result. +peekDefinitionItem :: LuaError e => Peeker e ([Inline], [[Block]]) +peekDefinitionItem = peekPair peekInlinesFuzzy $ choice + [ peekList peekBlocksFuzzy + , \idx -> (:[]) <$!> peekBlocksFuzzy idx + ] + -- | Push Caption element pushCaption :: LuaError e => Caption -> LuaE e () pushCaption (Caption shortCaption longCaption) = do @@ -318,37 +445,48 @@ peekCaption = retrieving "Caption" . \idx -> do long <- peekFieldRaw peekBlocks "long" idx return $! Caption short long -peekColWidth :: LuaError e => Peeker e ColWidth -peekColWidth = retrieving "ColWidth" . \idx -> do - maybe ColWidthDefault ColWidth <$!> optional (peekRealFloat idx) +-- | Push a ColSpec value as a pair of Alignment and ColWidth. +pushColSpec :: LuaError e => Pusher e ColSpec +pushColSpec = pushPair (pushString . show) pushColWidth +-- | Peek a ColSpec value as a pair of Alignment and ColWidth. peekColSpec :: LuaError e => Peeker e ColSpec peekColSpec = peekPair peekRead peekColWidth -instance Pushable ColWidth where - push = \case - (ColWidth w) -> Lua.push w - ColWidthDefault -> Lua.pushnil +peekColWidth :: LuaError e => Peeker e ColWidth +peekColWidth = retrieving "ColWidth" . \idx -> do + maybe ColWidthDefault ColWidth <$!> optional (peekRealFloat idx) -instance Pushable Row where - push (Row attr cells) = Lua.push (attr, cells) +-- | Push a ColWidth value by pushing the width as a plain number, or +-- @nil@ for ColWidthDefault. +pushColWidth :: LuaError e => Pusher e ColWidth +pushColWidth = \case + (ColWidth w) -> Lua.push w + ColWidthDefault -> Lua.pushnil -instance Peekable Row where - peek = forcePeek . peekRow +-- | Push a table row as a pair of attr and the list of cells. +pushRow :: LuaError e => Pusher e Row +pushRow (Row attr cells) = + pushPair pushAttr (pushPandocList pushCell) (attr, cells) +-- | Push a table row from a pair of attr and the list of cells. peekRow :: LuaError e => Peeker e Row peekRow = ((uncurry Row) <$!>) . retrieving "Row" . peekPair peekAttr (peekList peekCell) -instance Pushable TableBody where - push (TableBody attr (RowHeadColumns rowHeadColumns) head' body) = do +-- | Pushes a 'TableBody' value as a Lua table with fields @attr@, +-- @row_head_columns@, @head@, and @body@. +pushTableBody :: LuaError e => Pusher e TableBody +pushTableBody (TableBody attr (RowHeadColumns rowHeadColumns) head' body) = do Lua.newtable LuaUtil.addField "attr" attr LuaUtil.addField "row_head_columns" rowHeadColumns LuaUtil.addField "head" head' LuaUtil.addField "body" body +-- | Retrieves a 'TableBody' value from a Lua table with fields @attr@, +-- @row_head_columns@, @head@, and @body@. peekTableBody :: LuaError e => Peeker e TableBody peekTableBody = fmap (retrieving "TableBody") . typeChecked "table" Lua.istable @@ -358,17 +496,25 @@ peekTableBody = fmap (retrieving "TableBody") <*> peekFieldRaw (peekList peekRow) "head" idx <*> peekFieldRaw (peekList peekRow) "body" idx -instance Pushable TableHead where - push (TableHead attr rows) = Lua.push (attr, rows) +-- | Push a table head value as the pair of its Attr and rows. +pushTableHead :: LuaError e => Pusher e TableHead +pushTableHead (TableHead attr rows) = + pushPair pushAttr (pushPandocList pushRow) (attr, rows) +-- | Peek a table head value from a pair of Attr and rows. peekTableHead :: LuaError e => Peeker e TableHead peekTableHead = ((uncurry TableHead) <$!>) . retrieving "TableHead" . peekPair peekAttr (peekList peekRow) -instance Pushable TableFoot where - push (TableFoot attr cells) = Lua.push (attr, cells) +-- | Pushes a 'TableFoot' value as a pair of the Attr value and the list +-- of table rows. +pushTableFoot :: LuaError e => Pusher e TableFoot +pushTableFoot (TableFoot attr rows) = + pushPair pushAttr (pushPandocList pushRow) (attr, rows) +-- | Retrieves a 'TableFoot' value from a pair containing an Attr value +-- and a list of table rows. peekTableFoot :: LuaError e => Peeker e TableFoot peekTableFoot = ((uncurry TableFoot) <$!>) . retrieving "TableFoot" @@ -380,6 +526,8 @@ instance Pushable Cell where instance Peekable Cell where peek = forcePeek . peekCell +-- | Push a table cell as a table with fields @attr@, @alignment@, +-- @row_span@, @col_span@, and @contents@. pushCell :: LuaError e => Cell -> LuaE e () pushCell (Cell attr align (RowSpan rowSpan) (ColSpan colSpan) contents) = do Lua.newtable @@ -416,9 +564,42 @@ setInlineText = \case Str _ -> Actual . Str _ -> const Absent +-- | Helper type to represent all the different types a `content` +-- attribute can have. data Content = ContentBlocks [Block] | ContentInlines [Inline] + | ContentLines [[Inline]] + | ContentDefItems [([Inline], [[Block]])] + | ContentListItems [[Block]] + +contentTypeDescription :: Content -> Text +contentTypeDescription = \case + ContentBlocks {} -> "list of Block items" + ContentInlines {} -> "list of Inline items" + ContentLines {} -> "list of Inline lists (i.e., a list of lines)" + ContentDefItems {} -> "list of definition items items" + ContentListItems {} -> "list items (i.e., list of list of Block elements)" + +pushContent :: LuaError e => Pusher e Content +pushContent = \case + ContentBlocks blks -> pushPandocList pushBlock blks + ContentInlines inlns -> pushPandocList pushInline inlns + ContentLines lns -> pushPandocList (pushPandocList pushInline) lns + ContentDefItems itms -> + let pushItem = pushPair (pushPandocList pushInline) + (pushPandocList (pushPandocList pushBlock)) + in pushPandocList pushItem itms + ContentListItems itms -> + pushPandocList (pushPandocList pushBlock) itms + +peekContent :: LuaError e => Peeker e Content +peekContent idx = + (ContentInlines <$!> peekInlinesFuzzy idx) <|> + (ContentLines <$!> peekList (peekList peekInlineFuzzy) idx) <|> + (ContentBlocks <$!> peekBlocksFuzzy idx ) <|> + (ContentListItems <$!> peekList peekBlocksFuzzy idx) <|> + (ContentDefItems <$!> peekList (peekDefinitionItem) idx) setInlineContent :: Inline -> Content -> Possible Inline setInlineContent = \case @@ -438,13 +619,13 @@ setInlineContent = \case where inlineContent = \case ContentInlines inlns -> inlns - ContentBlocks _ -> throwM $ - PandocLuaError "expected Inlines, got Blocks" + c -> throwM . PandocLuaError $ "expected Inlines, got " <> + contentTypeDescription c blockContent = \case ContentBlocks blks -> blks ContentInlines [] -> [] - ContentInlines _ -> throwM $ - PandocLuaError "expected Blocks, got Inlines" + c -> throwM . PandocLuaError $ "expected Blocks, got " <> + contentTypeDescription c getInlineContent :: Inline -> Possible Content getInlineContent = \case @@ -496,16 +677,6 @@ showInline = defun "show" <#> parameter peekInline "inline" "Inline" "Object" =#> functionResult pushString "string" "stringified Inline" -pushContent :: LuaError e => Pusher e Content -pushContent = \case - ContentBlocks blks -> pushPandocList pushBlock blks - ContentInlines inlns -> pushPandocList pushInline inlns - -peekContent :: LuaError e => Peeker e Content -peekContent idx = - (ContentInlines <$!> peekList peekInline idx) <|> - (ContentBlocks <$!> peekList peekBlock idx) - typeInline :: LuaError e => DocumentedType e Inline typeInline = deftype "Inline" [ operation Tostring showInline @@ -591,22 +762,37 @@ pushInline = pushUD typeInline peekInline :: forall e. LuaError e => Peeker e Inline peekInline = retrieving "Inline" . \idx -> peekUD typeInline idx +-- | Try extra hard to retrieve an Inline value from the stack. Treats +-- bare strings as @Str@ values. +peekInlineFuzzy :: LuaError e => Peeker e Inline +peekInlineFuzzy = retrieving "Inline" . choice + [ peekUD typeInline + , \idx -> Str <$!> peekText idx + ] + -- | Try extra-hard to return the value at the given index as a list of -- inlines. -peekFuzzyInlines :: LuaError e => Peeker e [Inline] -peekFuzzyInlines = choice - [ peekList peekInline - , fmap pure . peekInline - , \idx -> pure . Str <$!> peekText idx +peekInlinesFuzzy :: LuaError e => Peeker e [Inline] +peekInlinesFuzzy = choice + [ peekList peekInlineFuzzy + , fmap pure . peekInlineFuzzy ] -peekFuzzyBlocks :: LuaError e => Peeker e [Block] -peekFuzzyBlocks = choice - [ peekList peekBlock - , fmap pure . peekBlock - , \idx -> pure . Plain . pure . Str <$!> peekText idx +-- | Try extra hard to retrieve a Block value from the stack. Treats bar +-- Inline elements as if they were wrapped in 'Plain'. +peekBlockFuzzy :: LuaError e => Peeker e Block +peekBlockFuzzy = choice + [ peekBlock + , (\idx -> Plain <$!> peekInlinesFuzzy idx) ] +-- | Try extra-hard to return the value at the given index as a list of +-- blocks. +peekBlocksFuzzy :: LuaError e => Peeker e [Block] +peekBlocksFuzzy = choice + [ peekList peekBlockFuzzy + , (<$!>) pure . peekBlockFuzzy + ] pushListAttributes :: forall e. LuaError e => ListAttributes -> LuaE e () pushListAttributes (start, style, delimiter) = @@ -619,6 +805,26 @@ peekListAttributes = retrieving "ListAttributes" . peekTriple peekRead peekRead +-- * Orphan Instances + +instance Pushable Inline where + push = pushInline + +instance Pushable Citation where + push = pushCitation + +instance Pushable Row where + push = pushRow + +instance Pushable TableBody where + push = pushTableBody + +instance Pushable TableFoot where + push = pushTableFoot + +instance Pushable TableHead where + push = pushTableHead + -- These instances exist only for testing. It's a hack to avoid making -- the marshalling modules public. instance Peekable Inline where @@ -633,6 +839,9 @@ instance Peekable Meta where instance Peekable Pandoc where peek = forcePeek . peekPandoc +instance Peekable Row where + peek = forcePeek . peekRow + instance Peekable Version where peek = forcePeek . peekVersionFuzzy diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index bc9ddc5e5..f08914eba 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -16,13 +16,14 @@ module Text.Pandoc.Lua.Module.Pandoc ) where import Prelude hiding (read) -import Control.Applicative (optional) -import Control.Monad ((>=>), forM_, when) +import Control.Applicative ((<|>), optional) +import Control.Monad ((>=>), (<$!>), forM_, when) import Control.Monad.Catch (catch, throwM) import Control.Monad.Except (throwError) import Data.Default (Default (..)) import Data.Maybe (fromMaybe) -import HsLua as Lua hiding (pushModule) +import Data.Text (Text) +import HsLua as Lua hiding (Div, pushModule) import HsLua.Class.Peekable (PeekError) import System.Exit (ExitCode (..)) import Text.Pandoc.Class.PandocIO (runIO) @@ -65,20 +66,25 @@ pushModule = do pushDocumentedFunction fn rawset (nth 3) forM_ otherConstructors addConstr + forM_ blockConstructors addConstr forM_ inlineConstructors addConstr - -- add constructors to Inlines.constructor - newtable -- constructor - forM_ (inlineConstructors @PandocError) $ \fn -> do - let name = functionName fn - pushName name - pushName name - rawget (nth 4) - rawset (nth 3) - -- set as pandoc.Inline.constructor - pushName "Inline" - newtable *> pushName "constructor" *> pushvalue (nth 4) *> rawset (nth 3) - rawset (nth 4) - pop 1 -- remaining constructor table + let addConstructorTable constructors = do + -- add constructors to Inlines.constructor + newtable -- constructor + forM_ constructors $ \fn -> do + let name = functionName fn + pushName name + pushName name + rawget (nth 4) + rawset (nth 3) + -- set as pandoc.Inline.constructor + pushName "Inline" + newtable *> pushName "constructor" *> + pushvalue (nth 4) *> rawset (nth 3) + rawset (nth 4) + pop 1 -- remaining constructor table + addConstructorTable (blockConstructors @PandocError) + addConstructorTable (inlineConstructors @PandocError) return 1 inlineConstructors :: LuaError e => [DocumentedFunction e] @@ -86,7 +92,7 @@ inlineConstructors = [ defun "Cite" ### liftPure2 Cite <#> parameter (peekList peekCitation) "citations" "list of Citations" "" - <#> parameter peekFuzzyInlines "content" "Inline" "placeholder content" + <#> parameter peekInlinesFuzzy "content" "Inline" "placeholder content" =#> functionResult pushInline "Inline" "cite element" , defun "Code" ### liftPure2 (flip Code) @@ -99,7 +105,7 @@ inlineConstructors = let attr = fromMaybe nullAttr mattr title = fromMaybe mempty mtitle in Image attr caption (src, title)) - <#> parameter peekFuzzyInlines "Inlines" "caption" "image caption / alt" + <#> parameter peekInlinesFuzzy "Inlines" "caption" "image caption / alt" <#> parameter peekText "string" "src" "path/URL of the image file" <#> optionalParameter peekText "string" "title" "brief image description" <#> optionalParameter peekAttr "Attr" "attr" "image attributes" @@ -112,7 +118,7 @@ inlineConstructors = let attr = fromMaybe nullAttr mattr title = fromMaybe mempty mtitle in Link attr content (target, title)) - <#> parameter peekFuzzyInlines "Inlines" "content" "text for this link" + <#> parameter peekInlinesFuzzy "Inlines" "content" "text for this link" <#> parameter peekText "string" "target" "the link target" <#> optionalParameter peekText "string" "title" "brief link description" <#> optionalParameter peekAttr "Attr" "attr" "link attributes" @@ -124,12 +130,12 @@ inlineConstructors = =#> functionResult pushInline "Inline" "math element" , defun "Note" ### liftPure Note - <#> parameter peekFuzzyBlocks "content" "Blocks" "note content" + <#> parameter peekBlocksFuzzy "content" "Blocks" "note content" =#> functionResult pushInline "Inline" "note" , defun "Quoted" ### liftPure2 Quoted <#> parameter peekQuoteType "quotetype" "QuoteType" "type of quotes" - <#> parameter peekFuzzyInlines "content" "Inlines" "inlines in quotes" + <#> parameter peekInlinesFuzzy "content" "Inlines" "inlines in quotes" =#> functionResult pushInline "Inline" "quoted element" , defun "RawInline" ### liftPure2 RawInline @@ -145,11 +151,11 @@ inlineConstructors = =#> functionResult pushInline "Inline" "new space" , defun "Span" ### liftPure2 (\inlns mattr -> Span (fromMaybe nullAttr mattr) inlns) - <#> parameter peekFuzzyInlines "content" "Inlines" "inline content" + <#> parameter peekInlinesFuzzy "content" "Inlines" "inline content" <#> optionalParameter peekAttr "attr" "Attr" "additional attributes" =#> functionResult pushInline "Inline" "span element" , defun "Str" - ### liftPure (\s -> s `seq` Str s) + ### liftPure Str <#> parameter peekText "text" "string" "" =#> functionResult pushInline "Inline" "new Str object" , mkInlinesConstr "Strong" Strong @@ -159,11 +165,119 @@ inlineConstructors = , mkInlinesConstr "Underline" Underline ] +blockConstructors :: LuaError e => [DocumentedFunction e] +blockConstructors = + [ defun "BlockQuote" + ### liftPure BlockQuote + <#> blocksParam + =#> blockResult "BlockQuote element" + + , defun "BulletList" + ### liftPure BulletList + <#> blockItemsParam "list items" + =#> blockResult "BulletList element" + + , defun "CodeBlock" + ### liftPure2 (\code mattr -> CodeBlock (fromMaybe nullAttr mattr) code) + <#> textParam "text" "code block content" + <#> optAttrParam + =#> blockResult "CodeBlock element" + + , defun "DefinitionList" + ### liftPure DefinitionList + <#> parameter (choice + [ peekList peekDefinitionItem + , \idx -> (:[]) <$!> peekDefinitionItem idx + ]) + "{{Inlines, {Blocks,...}},...}" + "content" "definition items" + =#> blockResult "DefinitionList element" + + , defun "Div" + ### liftPure2 (\content mattr -> Div (fromMaybe nullAttr mattr) content) + <#> blocksParam + <#> optAttrParam + =#> blockResult "Div element" + + , defun "Header" + ### liftPure3 (\lvl content mattr -> + Header lvl (fromMaybe nullAttr mattr) content) + <#> parameter peekIntegral "integer" "level" "heading level" + <#> parameter peekInlinesFuzzy "Inlines" "content" "inline content" + <#> optAttrParam + =#> blockResult "Header element" + + , defun "HorizontalRule" + ### return HorizontalRule + =#> blockResult "HorizontalRule element" + + , defun "LineBlock" + ### liftPure LineBlock + <#> parameter (peekList peekInlinesFuzzy) "{Inlines,...}" "content" "lines" + =#> blockResult "LineBlock element" + + , defun "Null" + ### return Null + =#> blockResult "Null element" + + , defun "OrderedList" + ### liftPure2 (\items mListAttrib -> + let defListAttrib = (1, DefaultStyle, DefaultDelim) + in OrderedList (fromMaybe defListAttrib mListAttrib) items) + <#> blockItemsParam "ordered list items" + <#> optionalParameter peekListAttributes "ListAttributes" "listAttributes" + "specifier for the list's numbering" + =#> blockResult "OrderedList element" + + , defun "Para" + ### liftPure Para + <#> parameter peekInlinesFuzzy "Inlines" "content" "paragraph content" + =#> blockResult "Para element" + + , defun "Plain" + ### liftPure Plain + <#> parameter peekInlinesFuzzy "Inlines" "content" "paragraph content" + =#> blockResult "Plain element" + + , defun "RawBlock" + ### liftPure2 RawBlock + <#> parameter peekFormat "Format" "format" "format of content" + <#> parameter peekText "string" "text" "raw content" + =#> blockResult "RawBlock element" + + , defun "Table" + ### (\capt colspecs thead tbodies tfoot mattr -> + let attr = fromMaybe nullAttr mattr + in return $! attr `seq` capt `seq` colspecs `seq` thead `seq` tbodies + `seq` tfoot `seq` Table attr capt colspecs thead tbodies tfoot) + <#> parameter peekCaption "Caption" "caption" "table caption" + <#> parameter (peekList peekColSpec) "{ColSpec,...}" "colspecs" + "column alignments and widths" + <#> parameter peekTableHead "TableHead" "head" "table head" + <#> parameter (peekList peekTableBody) "{TableBody,...}" "bodies" + "table bodies" + <#> parameter peekTableFoot "TableFoot" "foot" "table foot" + <#> optAttrParam + =#> blockResult "Table element" + ] + where + blockResult = functionResult pushBlock "Block" + blocksParam = parameter peekBlocksFuzzy "Blocks" "content" "block content" + blockItemsParam = parameter peekItemsFuzzy "List of Blocks" "content" + peekItemsFuzzy idx = peekList peekBlocksFuzzy idx + <|> ((:[]) <$!> peekBlocksFuzzy idx) + +textParam :: LuaError e => Text -> Text -> Parameter e Text +textParam = parameter peekText "string" + +optAttrParam :: LuaError e => Parameter e (Maybe Attr) +optAttrParam = optionalParameter peekAttr "attr" "Attr" "additional attributes" + mkInlinesConstr :: LuaError e => Name -> ([Inline] -> Inline) -> DocumentedFunction e mkInlinesConstr name constr = defun name ### liftPure (\x -> x `seq` constr x) - <#> parameter peekFuzzyInlines "content" "Inlines" "" + <#> parameter peekInlinesFuzzy "content" "Inlines" "" =#> functionResult pushInline "Inline" "new object" otherConstructors :: LuaError e => [DocumentedFunction e] @@ -181,8 +295,8 @@ otherConstructors = }) <#> parameter peekText "string" "cid" "citation ID (e.g. bibtex key)" <#> parameter peekRead "citation mode" "mode" "citation rendering mode" - <#> optionalParameter peekFuzzyInlines "prefix" "Inlines" "" - <#> optionalParameter peekFuzzyInlines "suffix" "Inlines" "" + <#> optionalParameter peekInlinesFuzzy "prefix" "Inlines" "" + <#> optionalParameter peekInlinesFuzzy "suffix" "Inlines" "" <#> optionalParameter peekIntegral "note_num" "integer" "note number" <#> optionalParameter peekIntegral "hash" "integer" "hash number" =#> functionResult pushCitation "Citation" "new citation object" @@ -283,7 +397,7 @@ pushPipeError pipeErr = do mkPandoc :: PandocLua NumResults mkPandoc = liftPandocLua $ do doc <- forcePeek $ do - blks <- peekBlocks (nthBottom 1) + blks <- peekBlocksFuzzy (nthBottom 1) mMeta <- optional $ peekMeta (nthBottom 2) pure $ Pandoc (fromMaybe nullMeta mMeta) blks pushPandoc doc diff --git a/src/Text/Pandoc/Lua/Module/Types.hs b/src/Text/Pandoc/Lua/Module/Types.hs index 4a7d14d2f..fb09235de 100644 --- a/src/Text/Pandoc/Lua/Module/Types.hs +++ b/src/Text/Pandoc/Lua/Module/Types.hs @@ -35,13 +35,9 @@ pushModule = do pushCloneTable :: LuaE PandocError NumResults pushCloneTable = do Lua.newtable - addFunction "Attr" $ cloneWith peekAttr pushAttr - addFunction "Block" $ cloneWith peekBlock pushBlock - addFunction "Inline" $ cloneWith peekInline pushInline addFunction "Meta" $ cloneWith peekMeta Lua.push addFunction "MetaValue" $ cloneWith peekMetaValue pushMetaValue addFunction "ListAttributes" $ cloneWith peekListAttributes pushListAttributes - addFunction "Pandoc" $ cloneWith peekPandoc pushPandoc return 1 cloneWith :: Peeker PandocError a diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index ba6d2a1df..173c9bb29 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -98,6 +98,126 @@ return { assert.are_equal(count, 3) end) }, + group "Block elements" { + group "BulletList" { + test('access items via property `content`', function () + local para = pandoc.Para 'one' + local blist = pandoc.BulletList{{para}} + assert.are_same({{para}}, blist.content) + end), + test('property `content` uses fuzzy marshalling', function () + local old = pandoc.Plain 'old' + local new = pandoc.Plain 'new' + local blist = pandoc.BulletList{{old}} + blist.content = {{new}} + assert.are_same({{new}}, blist:clone().content) + blist.content = new + assert.are_same({{new}}, blist:clone().content) + end), + }, + group "OrderedList" { + test('access items via property `content`', function () + local para = pandoc.Plain 'one' + local olist = pandoc.OrderedList{{para}} + assert.are_same({{para}}, olist.content) + end), + test('forgiving constructor', function () + local plain = pandoc.Plain 'old' + local olist = pandoc.OrderedList({plain}, {3, 'Example', 'Period'}) + local listAttribs = pandoc.ListAttributes(3, 'Example', 'Period') + assert.are_same(olist.listAttributes, listAttribs) + end), + test('has list attribute aliases', function () + local olist = pandoc.OrderedList({}, {4, 'Decimal', 'OneParen'}) + assert.are_equal(olist.start, 4) + assert.are_equal(olist.style, 'Decimal') + assert.are_equal(olist.delimiter, 'OneParen') + end) + }, + group 'DefinitionList' { + test('access items via property `content`', function () + local deflist = pandoc.DefinitionList{ + {'apple', {{pandoc.Plain 'fruit'}, {pandoc.Plain 'company'}}}, + {pandoc.Str 'coffee', 'Best when hot.'} + } + assert.are_equal(#deflist.content, 2) + assert.are_same(deflist.content[1][1], {pandoc.Str 'apple'}) + assert.are_same(deflist.content[1][2][2], + {pandoc.Plain{pandoc.Str 'company'}}) + assert.are_same(deflist.content[2][2], + {{pandoc.Plain{pandoc.Str 'Best when hot.'}}}) + end), + test('modify items via property `content`', function () + local deflist = pandoc.DefinitionList{ + {'apple', {{{'fruit'}}, {{'company'}}}} + } + deflist.content[1][1] = pandoc.Str 'orange' + deflist.content[1][2][1] = {pandoc.Plain 'tasty fruit'} + local newlist = pandoc.DefinitionList{ + { {pandoc.Str 'orange'}, + {{pandoc.Plain 'tasty fruit'}, {pandoc.Plain 'company'}} + } + } + assert.are_equal(deflist, newlist) + end), + }, + group 'Para' { + test('access inline via property `content`', function () + local para = pandoc.Para{'Moin, ', pandoc.Space(), 'Sylt!'} + assert.are_same( + para.content, + {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} + ) + end), + test('modifying `content` changes the element', function () + local para = pandoc.Para{'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} + + para.content[3] = 'Hamburg!' + assert.are_same( + para:clone().content, + {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Hamburg!'} + ) + + para.content = 'Huh' + assert.are_same( + para:clone().content, + {pandoc.Str 'Huh'} + ) + end), + }, + group 'LineBlock' { + test('access lines via property `content`', function () + local spc = pandoc.Space() + local lineblock = pandoc.LineBlock{ + {'200', spc, 'Main', spc, 'St.'}, + {'Berkeley', spc, 'CA', spc, '94718'} + } + assert.are_equal(#lineblock.content, 2) -- has two lines + assert.are_same(lineblock.content[2][1], pandoc.Str 'Berkeley') + end), + test('modifying `content` alter the element', function () + local spc = pandoc.Space() + local lineblock = pandoc.LineBlock{ + {'200', spc, 'Main', spc, 'St.'}, + {'Berkeley', spc, 'CA', spc, '94718'} + } + lineblock.content[1][1] = '404' + assert.are_same( + lineblock:clone().content[1], + {pandoc.Str '404', spc, pandoc.Str 'Main', spc, pandoc.Str 'St.'} + ) + + lineblock.content = {{'line1'}, {'line2'}} + assert.are_same( + lineblock:clone(), + pandoc.LineBlock{ + {pandoc.Str 'line1'}, + {pandoc.Str 'line2'} + } + ) + end) + } + }, group 'HTML-like attribute tables' { test('in element constructor', function () local html_attributes = { -- cgit v1.2.3 From b95e864ecfc0a0ef96fa09d4118c8e6b4033784c Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 26 Oct 2021 21:39:24 +0200 Subject: Lua: marshal SimpleTable values as userdata objects --- data/pandoc.lua | 24 --------- src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs | 74 ++++++++++++++++++++------- src/Text/Pandoc/Lua/Module/Pandoc.hs | 2 + src/Text/Pandoc/Lua/Util.hs | 28 ---------- test/lua/module/pandoc.lua | 61 ++++++++++++++++++++++ 5 files changed, 119 insertions(+), 70 deletions(-) (limited to 'test/lua') diff --git a/data/pandoc.lua b/data/pandoc.lua index 294fed99e..cc4dc0cab 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -348,30 +348,6 @@ function M.MetaBool(bool) return bool end ------------------------------------------------------------------------- --- Legacy and compatibility types --- - ---- Creates a simple (old style) table element. --- @function SimpleTable --- @tparam {Inline,...} caption table caption --- @tparam {AlignDefault|AlignLeft|AlignRight|AlignCenter,...} aligns alignments --- @tparam {int,...} widths column widths --- @tparam {Block,...} headers header row --- @tparam {{Block,...}} rows table rows --- @treturn Block table element -M.SimpleTable = function(caption, aligns, widths, headers, rows) - return { - caption = ensureInlineList(caption), - aligns = List:new(aligns), - widths = List:new(widths), - headers = List:new(headers), - rows = List:new(rows), - tag = "SimpleTable", - t = "SimpleTable", - } -end - ------------------------------------------------------------------------ -- Functions which have moved to different modules M.sha1 = utils.sha1 diff --git a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs b/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs index e9c169dc0..65f5aec8b 100644 --- a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs +++ b/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs @@ -1,13 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Lua.Marshaling.SimpleTable Copyright : © 2020-2021 Albert Krewinkel License : GNU GPL, version 2 or above - Maintainer : Albert Krewinkel - Stability : alpha Definition and marshaling of the 'SimpleTable' data type used as a convenience type when dealing with tables. @@ -16,14 +13,14 @@ module Text.Pandoc.Lua.Marshaling.SimpleTable ( SimpleTable (..) , peekSimpleTable , pushSimpleTable + , mkSimpleTable ) where -import Control.Monad ((<$!>)) import HsLua as Lua import Text.Pandoc.Definition -import Text.Pandoc.Lua.Util (pushViaConstructor) import Text.Pandoc.Lua.Marshaling.AST +import Text.Pandoc.Lua.Marshaling.List -- | A simple (legacy-style) table. data SimpleTable = SimpleTable @@ -32,23 +29,64 @@ data SimpleTable = SimpleTable , simpleTableColumnWidths :: [Double] , simpleTableHeader :: [[Block]] , simpleTableBody :: [[[Block]]] - } + } deriving (Eq, Show) + +typeSimpleTable :: LuaError e => DocumentedType e SimpleTable +typeSimpleTable = deftype "SimpleTable" + [ operation Eq $ lambda + ### liftPure2 (==) + <#> udparam typeSimpleTable "a" "" + <#> udparam typeSimpleTable "b" "" + =#> functionResult pushBool "boolean" "whether the two objects are equal" + , operation Tostring $ lambda + ### liftPure show + <#> udparam typeSimpleTable "self" "" + =#> functionResult pushString "string" "Haskell string representation" + ] + [ property "caption" "table caption" + (pushPandocList pushInline, simpleTableCaption) + (peekInlinesFuzzy, \t capt -> t {simpleTableCaption = capt}) + , property "aligns" "column alignments" + (pushPandocList (pushString . show), simpleTableAlignments) + (peekList peekRead, \t aligns -> t{simpleTableAlignments = aligns}) + , property "widths" "relative column widths" + (pushPandocList pushRealFloat, simpleTableColumnWidths) + (peekList peekRealFloat, \t ws -> t{simpleTableColumnWidths = ws}) + , property "headers" "table header" + (pushRow, simpleTableHeader) + (peekRow, \t h -> t{simpleTableHeader = h}) + , property "rows" "table body rows" + (pushPandocList pushRow, simpleTableBody) + (peekList peekRow, \t bs -> t{simpleTableBody = bs}) + + , readonly "t" "type tag (always 'SimpleTable')" + (pushText, const "SimpleTable") + + , alias "header" "alias for `headers`" ["headers"] + ] + where + pushRow = pushPandocList (pushPandocList pushBlock) + +peekRow :: LuaError e => Peeker e [[Block]] +peekRow = peekList peekBlocksFuzzy -- | Push a simple table to the stack by calling the -- @pandoc.SimpleTable@ constructor. pushSimpleTable :: forall e. LuaError e => SimpleTable -> LuaE e () -pushSimpleTable tbl = pushViaConstructor @e "SimpleTable" - (simpleTableCaption tbl) - (simpleTableAlignments tbl) - (simpleTableColumnWidths tbl) - (simpleTableHeader tbl) - (simpleTableBody tbl) +pushSimpleTable = pushUD typeSimpleTable -- | Retrieve a simple table from the stack. peekSimpleTable :: forall e. LuaError e => Peeker e SimpleTable -peekSimpleTable idx = retrieving "SimpleTable" $ SimpleTable - <$!> peekFieldRaw peekInlines "caption" idx - <*> peekFieldRaw (peekList peekRead) "aligns" idx - <*> peekFieldRaw (peekList peekRealFloat) "widths" idx - <*> peekFieldRaw (peekList peekBlocks) "headers" idx - <*> peekFieldRaw (peekList (peekList peekBlocks)) "rows" idx +peekSimpleTable = retrieving "SimpleTable" . peekUD typeSimpleTable + +-- | Constructor for the 'SimpleTable' type. +mkSimpleTable :: LuaError e => DocumentedFunction e +mkSimpleTable = defun "SimpleTable" + ### liftPure5 SimpleTable + <#> parameter peekInlinesFuzzy "Inlines" "caption" "table caption" + <#> parameter (peekList peekRead) "{Alignment,...}" "align" "column alignments" + <#> parameter (peekList peekRealFloat) "{number,...}" "widths" + "relative column widths" + <#> parameter peekRow "{Blocks,...}" "header" "table header row" + <#> parameter (peekList peekRow) "{{Blocks,...},...}" "body" "table body rows" + =#> functionResult pushSimpleTable "SimpleTable" "new SimpleTable object" diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index 458795029..7bad3f1a5 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -39,6 +39,7 @@ import Text.Pandoc.Lua.Marshaling.Attr (mkAttr, mkAttributeList) import Text.Pandoc.Lua.Marshaling.List (List (..)) import Text.Pandoc.Lua.Marshaling.ListAttributes ( mkListAttributes , peekListAttributes) +import Text.Pandoc.Lua.Marshaling.SimpleTable (mkSimpleTable) import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua, loadDefaultModule) import Text.Pandoc.Options (ReaderOptions (readerExtensions)) @@ -311,6 +312,7 @@ otherConstructors = #? "Creates a single citation." , mkListAttributes + , mkSimpleTable ] stringConstants :: [String] diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs index 50157189f..f20bc09e8 100644 --- a/src/Text/Pandoc/Lua/Util.hs +++ b/src/Text/Pandoc/Lua/Util.hs @@ -19,7 +19,6 @@ module Text.Pandoc.Lua.Util ( getTag , addField , addFunction - , pushViaConstructor , callWithTraceback , dofileWithTraceback , pushViaConstr' @@ -44,33 +43,6 @@ addFunction name fn = do Lua.pushHaskellFunction $ toHaskellFunction fn Lua.rawset (-3) --- | Helper class for pushing a single value to the stack via a lua --- function. See @pushViaCall@. -class LuaError e => PushViaCall e a where - pushViaCall' :: LuaError e => Name -> LuaE e () -> NumArgs -> a - -instance LuaError e => PushViaCall e (LuaE e ()) where - pushViaCall' fn pushArgs num = do - Lua.pushName @e fn - Lua.rawget Lua.registryindex - pushArgs - Lua.call num 1 - -instance (LuaError e, Pushable a, PushViaCall e b) => - PushViaCall e (a -> b) where - pushViaCall' fn pushArgs num x = - pushViaCall' @e fn (pushArgs *> Lua.push x) (num + 1) - --- | Push an value to the stack via a lua function. The lua function is called --- with all arguments that are passed to this function and is expected to return --- a single value. -pushViaCall :: forall e a. LuaError e => PushViaCall e a => Name -> a -pushViaCall fn = pushViaCall' @e fn (return ()) 0 - --- | Call a pandoc element constructor within Lua, passing all given arguments. -pushViaConstructor :: forall e a. LuaError e => PushViaCall e a => Name -> a -pushViaConstructor pandocFn = pushViaCall @e ("pandoc." <> pandocFn) - -- | Get the tag of a value. This is an optimized and specialized version of -- @Lua.getfield idx "tag"@. It only checks for the field on the table at index -- @idx@ and on its metatable, also ignoring any @__index@ value on the diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 173c9bb29..9b6e360f3 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -261,6 +261,67 @@ return { end) } }, + group 'Other types' { + group 'SimpleTable' { + test('can access properties', function () + local spc = pandoc.Space() + local caption = {pandoc.Str 'Languages', spc, pandoc.Str 'overview.'} + local aligns = {pandoc.AlignDefault, pandoc.AlignDefault} + local widths = {0, 0} -- let pandoc determine col widths + local headers = {{pandoc.Plain({pandoc.Str "Language"})}, + {pandoc.Plain({pandoc.Str "Typing"})}} + local rows = { + {{pandoc.Plain "Haskell"}, {pandoc.Plain "static"}}, + {{pandoc.Plain "Lua"}, {pandoc.Plain "Dynamic"}}, + } + local simple_table = pandoc.SimpleTable( + caption, + aligns, + widths, + headers, + rows + ) + assert.are_same(simple_table.caption, caption) + assert.are_same(simple_table.aligns, aligns) + assert.are_same(simple_table.widths, widths) + assert.are_same(simple_table.headers, headers) + assert.are_same(simple_table.rows, rows) + end), + test('can modify properties', function () + local new_table = pandoc.SimpleTable( + {'Languages'}, + {pandoc.AlignDefault, pandoc.AlignDefault}, + {0.5, 0.5}, + {{pandoc.Plain({pandoc.Str "Language"})}, + {pandoc.Plain({pandoc.Str "Typing"})}}, + { + {{pandoc.Plain "Haskell"}, {pandoc.Plain "static"}}, + {{pandoc.Plain "Lua"}, {pandoc.Plain "Dynamic"}}, + } + ) + + new_table.caption = {pandoc.Str 'Good', pandoc.Space(), + pandoc.Str 'languages'} + new_table.aligns[1] = pandoc.AlignLeft + new_table.widths = {0, 0} + new_table.headers[2] = {pandoc.Plain{pandoc.Str 'compiled/interpreted'}} + new_table.rows[1][2] = {pandoc.Plain{pandoc.Str 'both'}} + new_table.rows[2][2] = {pandoc.Plain{pandoc.Str 'interpreted'}} + + local expected_table = pandoc.SimpleTable( + {pandoc.Str 'Good', pandoc.Space(), pandoc.Str 'languages'}, + {pandoc.AlignLeft, pandoc.AlignDefault}, + {0, 0}, + {{pandoc.Plain 'Language'}, {pandoc.Plain 'compiled/interpreted'}}, + { + {{pandoc.Plain 'Haskell'}, {pandoc.Plain 'both'}}, + {{pandoc.Plain 'Lua'}, {pandoc.Plain 'interpreted'}} + } + ) + assert.are_same(expected_table, new_table) + end) + } + }, group 'clone' { test('clones Attr', function () -- cgit v1.2.3 From 7fcf1d61843cde87627b09730fbad01c7a9031be Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Wed, 27 Oct 2021 22:24:39 +0200 Subject: Lua: re-add `t` and `tag` property to Attr values Removal of these properties from Attr values was a regression. --- src/Text/Pandoc/Lua/Marshaling/Attr.hs | 4 ++++ test/lua/module/pandoc.lua | 7 +++++++ 2 files changed, 11 insertions(+) (limited to 'test/lua') diff --git a/src/Text/Pandoc/Lua/Marshaling/Attr.hs b/src/Text/Pandoc/Lua/Marshaling/Attr.hs index 1b35e40ad..f69acc61e 100644 --- a/src/Text/Pandoc/Lua/Marshaling/Attr.hs +++ b/src/Text/Pandoc/Lua/Marshaling/Attr.hs @@ -56,6 +56,10 @@ typeAttr = deftype "Attr" ### return <#> parameter peekAttr "attr" "Attr" "" =#> functionResult pushAttr "Attr" "new Attr element" + , readonly "tag" "element type tag (always 'Attr')" + (pushText, const "Attr") + + , alias "t" "alias for `tag`" ["tag"] ] pushAttr :: LuaError e => Pusher e Attr diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 9b6e360f3..9d0663696 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -40,6 +40,13 @@ return { end ) }, + group 'Properties' { + test('has t and tag property', function () + local attr = pandoc.Attr('') + assert.are_equal(attr.t, 'Attr') + assert.are_equal(attr.tag, 'Attr') + end) + }, group 'AttributeList' { test('allows access via fields', function () local attributes = pandoc.Attr('', {}, {{'a', '1'}, {'b', '2'}}).attributes -- cgit v1.2.3 From e1cf0ad1bef439da829068b4c5104d81692e860d Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Thu, 28 Oct 2021 14:10:54 +0200 Subject: Lua: fix placement of tests for Block elements in pandoc module tests --- test/lua/module/pandoc.lua | 240 ++++++++++++++++++++++----------------------- 1 file changed, 120 insertions(+), 120 deletions(-) (limited to 'test/lua') diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 9d0663696..72446db99 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -105,126 +105,6 @@ return { assert.are_equal(count, 3) end) }, - group "Block elements" { - group "BulletList" { - test('access items via property `content`', function () - local para = pandoc.Para 'one' - local blist = pandoc.BulletList{{para}} - assert.are_same({{para}}, blist.content) - end), - test('property `content` uses fuzzy marshalling', function () - local old = pandoc.Plain 'old' - local new = pandoc.Plain 'new' - local blist = pandoc.BulletList{{old}} - blist.content = {{new}} - assert.are_same({{new}}, blist:clone().content) - blist.content = new - assert.are_same({{new}}, blist:clone().content) - end), - }, - group "OrderedList" { - test('access items via property `content`', function () - local para = pandoc.Plain 'one' - local olist = pandoc.OrderedList{{para}} - assert.are_same({{para}}, olist.content) - end), - test('forgiving constructor', function () - local plain = pandoc.Plain 'old' - local olist = pandoc.OrderedList({plain}, {3, 'Example', 'Period'}) - local listAttribs = pandoc.ListAttributes(3, 'Example', 'Period') - assert.are_same(olist.listAttributes, listAttribs) - end), - test('has list attribute aliases', function () - local olist = pandoc.OrderedList({}, {4, 'Decimal', 'OneParen'}) - assert.are_equal(olist.start, 4) - assert.are_equal(olist.style, 'Decimal') - assert.are_equal(olist.delimiter, 'OneParen') - end) - }, - group 'DefinitionList' { - test('access items via property `content`', function () - local deflist = pandoc.DefinitionList{ - {'apple', {{pandoc.Plain 'fruit'}, {pandoc.Plain 'company'}}}, - {pandoc.Str 'coffee', 'Best when hot.'} - } - assert.are_equal(#deflist.content, 2) - assert.are_same(deflist.content[1][1], {pandoc.Str 'apple'}) - assert.are_same(deflist.content[1][2][2], - {pandoc.Plain{pandoc.Str 'company'}}) - assert.are_same(deflist.content[2][2], - {{pandoc.Plain{pandoc.Str 'Best when hot.'}}}) - end), - test('modify items via property `content`', function () - local deflist = pandoc.DefinitionList{ - {'apple', {{{'fruit'}}, {{'company'}}}} - } - deflist.content[1][1] = pandoc.Str 'orange' - deflist.content[1][2][1] = {pandoc.Plain 'tasty fruit'} - local newlist = pandoc.DefinitionList{ - { {pandoc.Str 'orange'}, - {{pandoc.Plain 'tasty fruit'}, {pandoc.Plain 'company'}} - } - } - assert.are_equal(deflist, newlist) - end), - }, - group 'Para' { - test('access inline via property `content`', function () - local para = pandoc.Para{'Moin, ', pandoc.Space(), 'Sylt!'} - assert.are_same( - para.content, - {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} - ) - end), - test('modifying `content` changes the element', function () - local para = pandoc.Para{'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} - - para.content[3] = 'Hamburg!' - assert.are_same( - para:clone().content, - {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Hamburg!'} - ) - - para.content = 'Huh' - assert.are_same( - para:clone().content, - {pandoc.Str 'Huh'} - ) - end), - }, - group 'LineBlock' { - test('access lines via property `content`', function () - local spc = pandoc.Space() - local lineblock = pandoc.LineBlock{ - {'200', spc, 'Main', spc, 'St.'}, - {'Berkeley', spc, 'CA', spc, '94718'} - } - assert.are_equal(#lineblock.content, 2) -- has two lines - assert.are_same(lineblock.content[2][1], pandoc.Str 'Berkeley') - end), - test('modifying `content` alter the element', function () - local spc = pandoc.Space() - local lineblock = pandoc.LineBlock{ - {'200', spc, 'Main', spc, 'St.'}, - {'Berkeley', spc, 'CA', spc, '94718'} - } - lineblock.content[1][1] = '404' - assert.are_same( - lineblock:clone().content[1], - {pandoc.Str '404', spc, pandoc.Str 'Main', spc, pandoc.Str 'St.'} - ) - - lineblock.content = {{'line1'}, {'line2'}} - assert.are_same( - lineblock:clone(), - pandoc.LineBlock{ - {pandoc.Str 'line1'}, - {pandoc.Str 'line2'} - } - ) - end) - } - }, group 'HTML-like attribute tables' { test('in element constructor', function () local html_attributes = { @@ -268,6 +148,126 @@ return { end) } }, + group "Block elements" { + group "BulletList" { + test('access items via property `content`', function () + local para = pandoc.Para 'one' + local blist = pandoc.BulletList{{para}} + assert.are_same({{para}}, blist.content) + end), + test('property `content` uses fuzzy marshalling', function () + local old = pandoc.Plain 'old' + local new = pandoc.Plain 'new' + local blist = pandoc.BulletList{{old}} + blist.content = {{new}} + assert.are_same({{new}}, blist:clone().content) + blist.content = new + assert.are_same({{new}}, blist:clone().content) + end), + }, + group "OrderedList" { + test('access items via property `content`', function () + local para = pandoc.Plain 'one' + local olist = pandoc.OrderedList{{para}} + assert.are_same({{para}}, olist.content) + end), + test('forgiving constructor', function () + local plain = pandoc.Plain 'old' + local olist = pandoc.OrderedList({plain}, {3, 'Example', 'Period'}) + local listAttribs = pandoc.ListAttributes(3, 'Example', 'Period') + assert.are_same(olist.listAttributes, listAttribs) + end), + test('has list attribute aliases', function () + local olist = pandoc.OrderedList({}, {4, 'Decimal', 'OneParen'}) + assert.are_equal(olist.start, 4) + assert.are_equal(olist.style, 'Decimal') + assert.are_equal(olist.delimiter, 'OneParen') + end) + }, + group 'DefinitionList' { + test('access items via property `content`', function () + local deflist = pandoc.DefinitionList{ + {'apple', {{pandoc.Plain 'fruit'}, {pandoc.Plain 'company'}}}, + {pandoc.Str 'coffee', 'Best when hot.'} + } + assert.are_equal(#deflist.content, 2) + assert.are_same(deflist.content[1][1], {pandoc.Str 'apple'}) + assert.are_same(deflist.content[1][2][2], + {pandoc.Plain{pandoc.Str 'company'}}) + assert.are_same(deflist.content[2][2], + {{pandoc.Plain{pandoc.Str 'Best when hot.'}}}) + end), + test('modify items via property `content`', function () + local deflist = pandoc.DefinitionList{ + {'apple', {{{'fruit'}}, {{'company'}}}} + } + deflist.content[1][1] = pandoc.Str 'orange' + deflist.content[1][2][1] = {pandoc.Plain 'tasty fruit'} + local newlist = pandoc.DefinitionList{ + { {pandoc.Str 'orange'}, + {{pandoc.Plain 'tasty fruit'}, {pandoc.Plain 'company'}} + } + } + assert.are_equal(deflist, newlist) + end), + }, + group 'Para' { + test('access inline via property `content`', function () + local para = pandoc.Para{'Moin, ', pandoc.Space(), 'Sylt!'} + assert.are_same( + para.content, + {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} + ) + end), + test('modifying `content` changes the element', function () + local para = pandoc.Para{'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} + + para.content[3] = 'Hamburg!' + assert.are_same( + para:clone().content, + {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Hamburg!'} + ) + + para.content = 'Huh' + assert.are_same( + para:clone().content, + {pandoc.Str 'Huh'} + ) + end), + }, + group 'LineBlock' { + test('access lines via property `content`', function () + local spc = pandoc.Space() + local lineblock = pandoc.LineBlock{ + {'200', spc, 'Main', spc, 'St.'}, + {'Berkeley', spc, 'CA', spc, '94718'} + } + assert.are_equal(#lineblock.content, 2) -- has two lines + assert.are_same(lineblock.content[2][1], pandoc.Str 'Berkeley') + end), + test('modifying `content` alter the element', function () + local spc = pandoc.Space() + local lineblock = pandoc.LineBlock{ + {'200', spc, 'Main', spc, 'St.'}, + {'Berkeley', spc, 'CA', spc, '94718'} + } + lineblock.content[1][1] = '404' + assert.are_same( + lineblock:clone().content[1], + {pandoc.Str '404', spc, pandoc.Str 'Main', spc, pandoc.Str 'St.'} + ) + + lineblock.content = {{'line1'}, {'line2'}} + assert.are_same( + lineblock:clone(), + pandoc.LineBlock{ + {pandoc.Str 'line1'}, + {pandoc.Str 'line2'} + } + ) + end) + }, + }, group 'Other types' { group 'SimpleTable' { test('can access properties', function () -- cgit v1.2.3 From f4d9b443d8b44b802d564a64280cbe9ea89dacc8 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 29 Oct 2021 17:08:03 +0200 Subject: Lua: use hslua module abstraction where possible This will make it easier to generate module documentation in the future. --- data/pandoc.lua | 120 +-------------- src/Text/Pandoc/Lua/Filter.hs | 33 +++-- src/Text/Pandoc/Lua/Marshaling/AST.hs | 1 + src/Text/Pandoc/Lua/Marshaling/Attr.hs | 50 ++++--- src/Text/Pandoc/Lua/Module/MediaBag.hs | 160 ++++++++++---------- src/Text/Pandoc/Lua/Module/Pandoc.hs | 258 ++++++++++++++++++++------------- src/Text/Pandoc/Lua/Module/System.hs | 44 +++--- src/Text/Pandoc/Lua/Module/Types.hs | 56 ++++--- src/Text/Pandoc/Lua/Module/Utils.hs | 26 ++-- src/Text/Pandoc/Lua/Packages.hs | 26 ++-- src/Text/Pandoc/Lua/PandocLua.hs | 8 - src/Text/Pandoc/Lua/Util.hs | 9 -- test/lua/module/pandoc.lua | 6 + 13 files changed, 385 insertions(+), 412 deletions(-) (limited to 'test/lua') diff --git a/data/pandoc.lua b/data/pandoc.lua index cc4dc0cab..1f4830858 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -45,125 +45,19 @@ local utils = M.utils -- @section -- @local ---- Create a new indexing function. --- @param template function template --- @param indices list of indices, starting with the most deeply nested --- @return newly created function --- @local -function make_indexing_function(template, ...) - local indices = {...} - local loadstring = loadstring or load - local bracketed = {} - for i = 1, #indices do - local idx = indices[#indices - i + 1] - bracketed[i] = type(idx) == 'number' - and string.format('[%d]', idx) - or string.format('.%s', idx) - end - local fnstr = string.format('return ' .. template, table.concat(bracketed)) - return assert(loadstring(fnstr))() -end - ---- Create accessor functions using a function template. --- @param fn_template function template in which '%s' is replacd with indices --- @param accessors list of accessors --- @return mapping from accessor names to accessor functions --- @local -local function create_accessor_functions (fn_template, accessors) - local res = {} - function add_accessors(acc, ...) - if type(acc) == 'string' then - res[acc] = make_indexing_function(fn_template, ...) - elseif type(acc) == 'table' and #acc == 0 and next(acc) then - -- Named substructure: the given names are accessed via the substructure, - -- but the accessors are also added to the result table, enabling direct - -- access from the parent element. Mainly used for `attr`. - local name, substructure = next(acc) - res[name] = make_indexing_function(fn_template, ...) - for _, subname in ipairs(substructure) do - res[subname] = make_indexing_function(fn_template, subname, ...) - end - else - for i = 1, #(acc or {}) do - add_accessors(acc[i], i, ...) - end - end - end - add_accessors(accessors) - return res -end - ---- Get list of top-level fields from field descriptor table. --- E.g.: `top_level_fields{'foo', {bar='baz'}, {'qux', 'quux'}}` --- gives {'foo, 'bar', 'qux', 'quux'} --- @local -local function top_level_fields (fields) - local result = List:new{} - for _, v in ipairs(fields) do - if type(v) == 'string' then - table.insert(result, v) - elseif type(v) == 'table' and #v == 0 and next(v) then - table.insert(result, (next(v))) - else - result:extend(top_level_fields(v)) - end - end - return result -end - ---- Creates a function which behaves like next, but respects field names. --- @local -local function make_next_function (fields) - local field_indices = {} - for i, f in ipairs(fields) do - field_indices[f] = i - end - - return function (t, field) - local raw_idx = field == nil and 0 or field_indices[field] - local next_field = fields[raw_idx + 1] - return next_field, t[next_field] - end -end - --- Create a new table which allows to access numerical indices via accessor -- functions. -- @local -local function create_accessor_behavior (tag, accessors) +local function create_accessor_behavior (tag) local behavior = {tag = tag} - behavior.getters = create_accessor_functions( - 'function (x) return x.c%s end', - accessors - ) - behavior.setters = create_accessor_functions( - 'function (x, v) x.c%s = v end', - accessors - ) behavior.__eq = utils.equals behavior.__index = function(t, k) - if getmetatable(t).getters[k] then - return getmetatable(t).getters[k](t) - elseif k == "t" then + if k == "t" then return getmetatable(t)["tag"] - else - return getmetatable(t)[k] - end - end - behavior.__newindex = function(t, k, v) - if getmetatable(t).setters[k] then - getmetatable(t).setters[k](t, v) - else - rawset(t, k, v) end end behavior.__pairs = function (t) - if accessors == nil then - return next, t - end - local iterable_fields = type(accessors) == 'string' - and {accessors} - or top_level_fields(accessors) - return make_next_function(iterable_fields), t + return next, t end return behavior end @@ -242,8 +136,8 @@ end -- @param fn Function to be called when constructing a new element -- @param accessors names to use as accessors for numerical fields -- @return function that constructs a new element -function AstElement:create_constructor(tag, fn, accessors) - local constr = self:make_subtype(tag, create_accessor_behavior(tag, accessors)) +function AstElement:create_constructor(tag, fn) + local constr = self:make_subtype(tag, create_accessor_behavior(tag)) function constr:new(...) return setmetatable(fn(...), self.behavior) end @@ -348,8 +242,4 @@ function M.MetaBool(bool) return bool end ------------------------------------------------------------------------- --- Functions which have moved to different modules -M.sha1 = utils.sha1 - return M diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs index 9a06dcac6..9fd0ef32c 100644 --- a/src/Text/Pandoc/Lua/Filter.hs +++ b/src/Text/Pandoc/Lua/Filter.hs @@ -14,6 +14,7 @@ Types and functions for running Lua filters. -} module Text.Pandoc.Lua.Filter ( LuaFilterFunction , LuaFilter + , peekLuaFilter , runFilterFile , walkInlines , walkInlineLists @@ -68,20 +69,24 @@ newtype LuaFilterFunction = LuaFilterFunction Lua.Reference newtype LuaFilter = LuaFilter (Map Name LuaFilterFunction) instance Peekable LuaFilter where - peek idx = do - let constrs = listOfInlinesFilterName - : listOfBlocksFilterName - : metaFilterName - : pandocFilterNames - ++ blockElementNames - ++ inlineElementNames - let go constr acc = do - Lua.getfield idx constr - filterFn <- registerFilterFunction - return $ case filterFn of - Nothing -> acc - Just fn -> Map.insert constr fn acc - LuaFilter <$!> foldrM go Map.empty constrs + peek = Lua.forcePeek . peekLuaFilter + +-- | Retrieves a LuaFilter object from the stack. +peekLuaFilter :: LuaError e => Peeker e LuaFilter +peekLuaFilter idx = do + let constrs = listOfInlinesFilterName + : listOfBlocksFilterName + : metaFilterName + : pandocFilterNames + ++ blockElementNames + ++ inlineElementNames + let go constr acc = Lua.liftLua $ do + Lua.getfield idx constr + filterFn <- registerFilterFunction + return $ case filterFn of + Nothing -> acc + Just fn -> Map.insert constr fn acc + LuaFilter <$!> foldrM go Map.empty constrs -- | Register the function at the top of the stack as a filter function in the -- registry. diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 6bb4fd4e0..aabc9e530 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -45,6 +45,7 @@ module Text.Pandoc.Lua.Marshaling.AST , pushCitation , pushInline , pushListAttributes + , pushMeta , pushMetaValue , pushPandoc ) where diff --git a/src/Text/Pandoc/Lua/Marshaling/Attr.hs b/src/Text/Pandoc/Lua/Marshaling/Attr.hs index 2f1f2406a..a38bc6ec7 100644 --- a/src/Text/Pandoc/Lua/Marshaling/Attr.hs +++ b/src/Text/Pandoc/Lua/Marshaling/Attr.hs @@ -204,26 +204,30 @@ peekAttrTable idx = do return $ ident `seq` classes `seq` attribs `seq` (ident, classes, attribs) -mkAttr :: LuaError e => LuaE e NumResults -mkAttr = do - attr <- ltype (nthBottom 1) >>= \case - TypeString -> forcePeek $ do - mident <- optional (peekText (nthBottom 1)) - mclass <- optional (peekList peekText (nthBottom 2)) - mattribs <- optional (peekAttribs (nthBottom 3)) - return (fromMaybe "" mident, fromMaybe [] mclass, fromMaybe [] mattribs) - TypeTable -> forcePeek $ peekAttrTable (nthBottom 1) - TypeUserdata -> forcePeek $ peekUD typeAttr (nthBottom 1) <|> do - attrList <- peekUD typeAttributeList (nthBottom 1) - return ("", [], attrList) - TypeNil -> pure nullAttr - TypeNone -> pure nullAttr - x -> failLua $ "Cannot create Attr from " ++ show x - pushAttr attr - return 1 - -mkAttributeList :: LuaError e => LuaE e NumResults -mkAttributeList = do - attribs <- forcePeek $ peekAttribs (nthBottom 1) - pushUD typeAttributeList attribs - return 1 +-- | Constructor for 'Attr'. +mkAttr :: LuaError e => DocumentedFunction e +mkAttr = defun "Attr" + ### (ltype (nthBottom 1) >>= \case + TypeString -> forcePeek $ do + mident <- optional (peekText (nthBottom 1)) + mclass <- optional (peekList peekText (nthBottom 2)) + mattribs <- optional (peekAttribs (nthBottom 3)) + return ( fromMaybe "" mident + , fromMaybe [] mclass + , fromMaybe [] mattribs) + TypeTable -> forcePeek $ peekAttrTable (nthBottom 1) + TypeUserdata -> forcePeek $ peekUD typeAttr (nthBottom 1) <|> do + attrList <- peekUD typeAttributeList (nthBottom 1) + return ("", [], attrList) + TypeNil -> pure nullAttr + TypeNone -> pure nullAttr + x -> failLua $ "Cannot create Attr from " ++ show x) + =#> functionResult pushAttr "Attr" "new Attr object" + +-- | Constructor for 'AttributeList'. +mkAttributeList :: LuaError e => DocumentedFunction e +mkAttributeList = defun "AttributeList" + ### return + <#> parameter peekAttribs "table|AttributeList" "attribs" "an attribute list" + =#> functionResult (pushUD typeAttributeList) "AttributeList" + "new AttributeList object" diff --git a/src/Text/Pandoc/Lua/Module/MediaBag.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs index a1fc40732..6e595f9e4 100644 --- a/src/Text/Pandoc/Lua/Module/MediaBag.hs +++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs @@ -1,112 +1,126 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Lua.Module.MediaBag Copyright : Copyright © 2017-2021 Albert Krewinkel License : GNU GPL, version 2 or above - Maintainer : Albert Krewinkel - Stability : alpha -The lua module @pandoc.mediabag@. +The Lua module @pandoc.mediabag@. -} module Text.Pandoc.Lua.Module.MediaBag - ( pushModule + ( documentedModule ) where import Prelude hiding (lookup) -import Control.Monad (zipWithM_) -import HsLua (LuaE, NumResults, Optional) -import HsLua.Marshalling (pushIterator) +import Data.Maybe (fromMaybe) +import HsLua ( LuaE, DocumentedFunction, Module (..) + , (<#>), (###), (=#>), (=?>), defun, functionResult + , optionalParameter , parameter) import Text.Pandoc.Class.CommonState (CommonState (..)) import Text.Pandoc.Class.PandocMonad (fetchItem, getMediaBag, modifyCommonState, setMediaBag) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.PandocLua (PandocLua (..), liftPandocLua, addFunction) +import Text.Pandoc.Lua.Marshaling.List (pushPandocList) +import Text.Pandoc.Lua.PandocLua (unPandocLua) import Text.Pandoc.MIME (MimeType) import qualified Data.ByteString.Lazy as BL -import qualified Data.Text as T import qualified HsLua as Lua import qualified Text.Pandoc.MediaBag as MB -- -- MediaBag submodule -- -pushModule :: PandocLua NumResults -pushModule = do - liftPandocLua Lua.newtable - addFunction "delete" delete - addFunction "empty" empty - addFunction "insert" insert - addFunction "items" items - addFunction "lookup" lookup - addFunction "list" list - addFunction "fetch" fetch - return 1 +documentedModule :: Module PandocError +documentedModule = Module + { moduleName = "pandoc.mediabag" + , moduleDescription = "mediabag access" + , moduleFields = [] + , moduleFunctions = + [ delete + , empty + , fetch + , insert + , items + , list + , lookup + ] + , moduleOperations = [] + } -- | Delete a single item from the media bag. -delete :: FilePath -> PandocLua NumResults -delete fp = 0 <$ modifyCommonState - (\st -> st { stMediaBag = MB.deleteMedia fp (stMediaBag st) }) +delete :: DocumentedFunction PandocError +delete = defun "delete" + ### (\fp -> unPandocLua $ modifyCommonState + (\st -> st { stMediaBag = MB.deleteMedia fp (stMediaBag st) })) + <#> parameter Lua.peekString "string" "filepath" "filename of item to delete" + =#> [] + -- | Delete all items from the media bag. -empty :: PandocLua NumResults -empty = 0 <$ modifyCommonState (\st -> st { stMediaBag = mempty }) +empty :: DocumentedFunction PandocError +empty = defun "empty" + ### unPandocLua (modifyCommonState (\st -> st { stMediaBag = mempty })) + =#> [] -- | Insert a new item into the media bag. -insert :: FilePath - -> Optional MimeType - -> BL.ByteString - -> PandocLua NumResults -insert fp optionalMime contents = do - mb <- getMediaBag - setMediaBag $ MB.insertMedia fp (Lua.fromOptional optionalMime) contents mb - return (Lua.NumResults 0) +insert :: DocumentedFunction PandocError +insert = defun "insert" + ### (\fp mmime contents -> unPandocLua $ do + mb <- getMediaBag + setMediaBag $ MB.insertMedia fp mmime contents mb + return (Lua.NumResults 0)) + <#> parameter Lua.peekString "string" "filepath" "item file path" + <#> optionalParameter Lua.peekText "string" "mimetype" "the item's MIME type" + <#> parameter Lua.peekLazyByteString "string" "contents" "binary contents" + =?> "Nothing" -- | Returns iterator values to be used with a Lua @for@ loop. -items :: PandocLua NumResults -items = do - mb <- getMediaBag - liftPandocLua $ do - let pushItem (fp, mimetype, contents) = do - Lua.pushString fp - Lua.pushText mimetype - Lua.pushByteString $ BL.toStrict contents - return (Lua.NumResults 3) - pushIterator pushItem (MB.mediaItems mb) +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" -lookup :: FilePath - -> PandocLua NumResults -lookup fp = do - res <- MB.lookupMedia fp <$> getMediaBag - liftPandocLua $ case res of - Nothing -> 1 <$ Lua.pushnil - Just item -> do - Lua.push $ MB.mediaMimeType item - Lua.push $ MB.mediaContents item - return 2 +-- | 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) + <#> parameter Lua.peekString "string" "filepath" "path of item to lookup" + =?> "MIME type and contents" -list :: PandocLua NumResults -list = do - dirContents <- MB.mediaDirectory <$> getMediaBag - liftPandocLua $ do - Lua.newtable - zipWithM_ addEntry [1..] dirContents - return 1 +-- | Function listing all mediabag items. +list :: DocumentedFunction PandocError +list = defun "list" + ### (unPandocLua (MB.mediaDirectory <$> getMediaBag)) + =#> functionResult (pushPandocList pushEntry) "table" "list of entry triples" where - addEntry :: Lua.Integer -> (FilePath, MimeType, Int) -> LuaE PandocError () - addEntry idx (fp, mimeType, contentLength) = do + pushEntry :: (FilePath, MimeType, Int) -> LuaE PandocError () + pushEntry (fp, mimeType, contentLength) = do Lua.newtable - Lua.push ("path" :: T.Text) *> Lua.push fp *> Lua.rawset (-3) - Lua.push ("type" :: T.Text) *> Lua.push mimeType *> Lua.rawset (-3) - Lua.push ("length" :: T.Text) *> Lua.push contentLength *> Lua.rawset (-3) - Lua.rawseti (-2) idx + 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) -fetch :: T.Text - -> PandocLua NumResults -fetch src = do - (bs, mimeType) <- fetchItem src - liftPandocLua . Lua.push $ maybe "" T.unpack mimeType - liftPandocLua $ Lua.push bs - return 2 -- returns 2 values: contents, mimetype +-- | 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) + <#> parameter Lua.peekText "string" "src" "URI to fetch" + =?> "Returns two string values: the fetched contents and the mimetype." diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index 7bad3f1a5..6d1ccea04 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -14,11 +15,12 @@ Pandoc module for lua. -} module Text.Pandoc.Lua.Module.Pandoc ( pushModule + , documentedModule ) where import Prelude hiding (read) -import Control.Applicative ((<|>), optional) -import Control.Monad ((>=>), (<$!>), forM_, when) +import Control.Applicative ((<|>)) +import Control.Monad ((<$!>), forM_, when) import Control.Monad.Catch (catch, throwM) import Control.Monad.Except (throwError) import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr) @@ -26,13 +28,14 @@ import Data.Default (Default (..)) import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (Proxy)) import Data.Text (Text) -import HsLua as Lua hiding (Div, pushModule) +import HsLua hiding (Div, pushModule) import HsLua.Class.Peekable (PeekError) import System.Exit (ExitCode (..)) import Text.Pandoc.Class.PandocIO (runIO) import Text.Pandoc.Definition -import Text.Pandoc.Lua.Filter (SingletonsList (..), walkInlines, - walkInlineLists, walkBlocks, walkBlockLists) +import Text.Pandoc.Lua.Filter (SingletonsList (..), LuaFilter, peekLuaFilter, + walkInlines, walkInlineLists, + walkBlocks, walkBlockLists) import Text.Pandoc.Lua.Marshaling () import Text.Pandoc.Lua.Marshaling.AST import Text.Pandoc.Lua.Marshaling.Attr (mkAttr, mkAttributeList) @@ -40,13 +43,15 @@ import Text.Pandoc.Lua.Marshaling.List (List (..)) import Text.Pandoc.Lua.Marshaling.ListAttributes ( mkListAttributes , peekListAttributes) import Text.Pandoc.Lua.Marshaling.SimpleTable (mkSimpleTable) -import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua, +import Text.Pandoc.Lua.Module.Utils (sha1) +import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, loadDefaultModule) import Text.Pandoc.Options (ReaderOptions (readerExtensions)) import Text.Pandoc.Process (pipeProcess) import Text.Pandoc.Readers (Reader (..), getReader) import Text.Pandoc.Walk (Walkable) +import qualified HsLua as Lua import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.Text as T @@ -57,45 +62,74 @@ import Text.Pandoc.Error -- module to be loadable. pushModule :: PandocLua NumResults pushModule = do + liftPandocLua $ Lua.pushModule documentedModule loadDefaultModule "pandoc" - addFunction "read" read - addFunction "pipe" pipe - addFunction "walk_block" (walkElement peekBlock pushBlock) - addFunction "walk_inline" (walkElement peekInline pushInline) - -- Constructors - addFunction "Attr" (liftPandocLua mkAttr) - addFunction "AttributeList" (liftPandocLua mkAttributeList) - addFunction "Pandoc" mkPandoc + let copyNext = do + hasNext <- next (nth 2) + if not hasNext + then return () + else do + pushvalue (nth 2) + insert (nth 2) + rawset (nth 5) -- pandoc module + copyNext liftPandocLua $ do - let addConstr fn = do - pushName (functionName fn) - pushDocumentedFunction fn - rawset (nth 3) - forM_ otherConstructors addConstr - forM_ blockConstructors addConstr - forM_ inlineConstructors addConstr - let addConstructorTable constructors = do - -- add constructors to Inlines.constructor - newtable -- constructor - forM_ constructors $ \fn -> do - let name = functionName fn - pushName name - pushName name - rawget (nth 4) - rawset (nth 3) - -- set as pandoc.Inline.constructor - pushName "Inline" - newtable *> pushName "constructor" *> - pushvalue (nth 4) *> rawset (nth 3) - rawset (nth 4) - pop 1 -- remaining constructor table - addConstructorTable (blockConstructors @PandocError) - addConstructorTable (inlineConstructors @PandocError) - -- Add string constants - forM_ stringConstants $ \c -> do - pushString c *> pushString c *> rawset (nth 3) + pushnil -- initial key + copyNext + pop 1 + 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 = stringConstants ++ [inlineField, blockField] + , moduleOperations = [] + , moduleFunctions = mconcat + [ functions + , otherConstructors + , blockConstructors + , inlineConstructors + ] + } + +-- | 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 + inlineConstructors :: LuaError e => [DocumentedFunction e] inlineConstructors = [ defun "Cite" @@ -291,7 +325,13 @@ mkInlinesConstr name constr = defun name otherConstructors :: LuaError e => [DocumentedFunction e] otherConstructors = - [ defun "Citation" + [ defun "Pandoc" + ### liftPure2 (\blocks mMeta -> Pandoc (fromMaybe nullMeta mMeta) blocks) + <#> parameter peekBlocksFuzzy "Blocks" "blocks" "document contents" + <#> optionalParameter peekMeta "Meta" "meta" "document metadata" + =#> functionResult pushPandoc "Pandoc" "new Pandoc document" + + , defun "Citation" ### (\cid mode mprefix msuffix mnote_num mhash -> cid `seq` mode `seq` mprefix `seq` msuffix `seq` mnote_num `seq` mhash `seq` return $! Citation @@ -311,68 +351,93 @@ otherConstructors = =#> functionResult pushCitation "Citation" "new citation object" #? "Creates a single citation." + , mkAttr + , mkAttributeList , mkListAttributes , mkSimpleTable ] -stringConstants :: [String] +stringConstants :: [Field e] stringConstants = let constrs :: forall a. Data a => Proxy a -> [String] constrs _ = map showConstr . dataTypeConstrs . dataTypeOf @a $ undefined - in constrs (Proxy @ListNumberStyle) - ++ constrs (Proxy @ListNumberDelim) - ++ constrs (Proxy @QuoteType) - ++ constrs (Proxy @MathType) - ++ constrs (Proxy @Alignment) - ++ constrs (Proxy @CitationMode) + 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 walkElement :: (Walkable (SingletonsList Inline) a, Walkable (SingletonsList Block) a, Walkable (List Inline) a, Walkable (List Block) a) - => Peeker PandocError a -> Pusher PandocError a - -> LuaE PandocError NumResults -walkElement peek' push' = do - x <- forcePeek $ peek' (nthBottom 1) - f <- peek (nthBottom 2) - let walk' = walkInlines f - >=> walkInlineLists f - >=> walkBlocks f - >=> walkBlockLists f - walk' x >>= push' - return (NumResults 1) - -read :: T.Text -> Optional T.Text -> PandocLua NumResults -read content formatSpecOrNil = liftPandocLua $ do - let formatSpec = fromMaybe "markdown" (Lua.fromOptional formatSpecOrNil) - res <- Lua.liftIO . runIO $ - getReader formatSpec >>= \(rdr,es) -> - case rdr of - TextReader r -> - r def{ readerExtensions = es } content - _ -> throwError $ PandocSomeError - "Only textual formats are supported" - case res of - Right pd -> (1 :: NumResults) <$ Lua.push pd -- success, push Pandoc - Left (PandocUnknownReaderError f) -> Lua.raiseError $ - "Unknown reader: " <> f - Left (PandocUnsupportedExtensionError e f) -> Lua.raiseError $ - "Extension " <> e <> " not supported for " <> f - Left e -> Lua.raiseError $ show e - --- | Pipes input through a command. -pipe :: String -- ^ path to executable - -> [String] -- ^ list of arguments - -> BL.ByteString -- ^ input passed to process via stdin - -> PandocLua NumResults -pipe command args input = liftPandocLua $ do - (ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input - `catch` (throwM . PandocIOError "pipe") - case ec of - ExitSuccess -> 1 <$ Lua.push output - ExitFailure n -> do - pushPipeError (PipeError (T.pack command) n output) - Lua.error + => a -> LuaFilter -> LuaE PandocError a +walkElement x f = walkInlines f x + >>= walkInlineLists f + >>= walkBlocks f + >>= walkBlockLists f + +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 -> do + let formatSpec = fromMaybe "markdown" mformatspec + res <- Lua.liftIO . runIO $ getReader formatSpec >>= \case + (TextReader r, es) -> r def{ readerExtensions = es } content + _ -> throwError $ PandocSomeError + "Only textual formats are supported" + case res of + Right pd -> return pd -- success, got a Pandoc document + 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 peekText "string" "content" "text to parse" + <#> optionalParameter peekText "string" "formatspec" "format and extensions" + =#> functionResult pushPandoc "Pandoc" "result document" + + , sha1 + + , defun "walk_block" + ### walkElement + <#> parameter peekBlockFuzzy "Block" "block" "element to traverse" + <#> parameter peekLuaFilter "LuaFilter" "filter" "filter functions" + =#> functionResult pushBlock "Block" "modified Block" + + , defun "walk_inline" + ### walkElement + <#> parameter peekInlineFuzzy "Inline" "inline" "element to traverse" + <#> parameter peekLuaFilter "LuaFilter" "filter" "filter functions" + =#> functionResult pushInline "Inline" "modified Inline" + ] data PipeError = PipeError { pipeErrorCommand :: T.Text @@ -416,12 +481,3 @@ pushPipeError pipeErr = do , if output == mempty then BSL.pack "" else output ] return (NumResults 1) - -mkPandoc :: PandocLua NumResults -mkPandoc = liftPandocLua $ do - doc <- forcePeek $ do - blks <- peekBlocksFuzzy (nthBottom 1) - mMeta <- optional $ peekMeta (nthBottom 2) - pure $ Pandoc (fromMaybe nullMeta mMeta) blks - pushPandoc doc - return 1 diff --git a/src/Text/Pandoc/Lua/Module/System.hs b/src/Text/Pandoc/Lua/Module/System.hs index 8589f672c..e329a0125 100644 --- a/src/Text/Pandoc/Lua/Module/System.hs +++ b/src/Text/Pandoc/Lua/Module/System.hs @@ -11,34 +11,28 @@ Pandoc's system Lua module. -} module Text.Pandoc.Lua.Module.System - ( pushModule + ( documentedModule ) where -import HsLua hiding (pushModule) +import HsLua import HsLua.Module.System (arch, env, getwd, os, with_env, with_tmpdir, with_wd) -import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.ErrorConversion () - -import qualified HsLua as Lua -- | Push the pandoc.system module on the Lua stack. -pushModule :: LuaE PandocError NumResults -pushModule = do - Lua.pushModule $ Module - { moduleName = "system" - , moduleDescription = "system functions" - , moduleFields = - [ arch - , os - ] - , moduleFunctions = - [ setName "environment" env - , setName "get_working_directory" getwd - , setName "with_environment" with_env - , setName "with_temporary_directory" with_tmpdir - , setName "with_working_directory" with_wd - ] - , moduleOperations = [] - } - return 1 +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 "with_environment" with_env + , setName "with_temporary_directory" with_tmpdir + , setName "with_working_directory" with_wd + ] + , moduleOperations = [] + } diff --git a/src/Text/Pandoc/Lua/Module/Types.hs b/src/Text/Pandoc/Lua/Module/Types.hs index ff4a4e0d5..4b37dafd9 100644 --- a/src/Text/Pandoc/Lua/Module/Types.hs +++ b/src/Text/Pandoc/Lua/Module/Types.hs @@ -10,34 +10,52 @@ Pandoc data type constructors. -} module Text.Pandoc.Lua.Module.Types - ( pushModule + ( documentedModule ) where -import HsLua (LuaE, NumResults, Peeker, Pusher) +import HsLua ( LuaE, NumResults, Peeker, Pusher, Module (..), Field (..) + , defun, functionResult, parameter, (###), (<#>), (=#>)) +import HsLua.Module.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.ErrorConversion () import Text.Pandoc.Lua.Marshaling.AST -import Text.Pandoc.Lua.Util (addFunction) import qualified HsLua as Lua -import qualified HsLua.Module.Version as Version -- | Push the pandoc.types module on the Lua stack. -pushModule :: LuaE PandocError NumResults -pushModule = do - Lua.newtable - Lua.pushName "Version" *> Lua.pushModule Version.documentedModule - *> Lua.rawset (Lua.nth 3) - pushCloneTable - Lua.setfield (Lua.nth 2) "clone" - return 1 - -pushCloneTable :: LuaE PandocError NumResults -pushCloneTable = do - Lua.newtable - addFunction "Meta" $ cloneWith peekMeta Lua.push - addFunction "MetaValue" $ cloneWith peekMetaValue pushMetaValue - return 1 +documentedModule :: Module PandocError +documentedModule = Module + { moduleName = "pandoc.types" + , moduleDescription = + "Constructors for types that are not part of the pandoc AST." + , moduleFields = + [ Field + { fieldName = "clone" + , fieldDescription = "DEPRECATED! Helper functions for element cloning." + , fieldPushValue = do + Lua.newtable + addFunction "Meta" $ cloneWith peekMeta pushMeta + addFunction "MetaValue" $ cloneWith peekMetaValue pushMetaValue + } + ] + , 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 = [] + } + where addFunction name fn = do + Lua.pushName name + Lua.pushHaskellFunction fn + Lua.rawset (Lua.nth 3) cloneWith :: Peeker PandocError a -> Pusher PandocError a diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 3602612cb..01ba4eb46 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -13,7 +13,8 @@ Utility module for Lua, exposing internal helper functions. -} module Text.Pandoc.Lua.Module.Utils - ( pushModule + ( documentedModule + , sha1 ) where import Control.Applicative ((<|>)) @@ -21,7 +22,7 @@ import Control.Monad ((<$!>)) import Data.Data (showConstr, toConstr) import Data.Default (def) import Data.Version (Version) -import HsLua as Lua hiding (pushModule) +import HsLua as Lua import HsLua.Class.Peekable (PeekError) import HsLua.Module.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Definition @@ -39,7 +40,6 @@ 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.Text as T -import qualified HsLua.Packaging as Lua import qualified Text.Pandoc.Builder as B import qualified Text.Pandoc.Filter.JSON as JSONFilter import qualified Text.Pandoc.Shared as Shared @@ -47,8 +47,8 @@ import qualified Text.Pandoc.UTF8 as UTF8 import qualified Text.Pandoc.Writers.Shared as Shared -- | Push the "pandoc.utils" module to the Lua stack. -pandocUtilsModule :: Module PandocError -pandocUtilsModule = Module +documentedModule :: Module PandocError +documentedModule = Module { moduleName = "pandoc.utils" , moduleDescription = "pandoc utility functions" , moduleFields = [] @@ -92,12 +92,7 @@ pandocUtilsModule = Module , "Returns nil instead of a string if the conversion failed." ] - , 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." + , sha1 , defun "Version" ### liftPure (id @Version) @@ -146,8 +141,13 @@ pandocUtilsModule = Module ] } -pushModule :: LuaE PandocError NumResults -pushModule = 1 <$ Lua.pushModule pandocUtilsModule +-- | 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. diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs index f9bd7abe8..8e5cc96c3 100644 --- a/src/Text/Pandoc/Lua/Packages.hs +++ b/src/Text/Pandoc/Lua/Packages.hs @@ -16,7 +16,6 @@ module Text.Pandoc.Lua.Packages ) where import Control.Monad (forM_) -import HsLua (NumResults) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, loadDefaultModule) @@ -43,24 +42,27 @@ installPandocPackageSearcher = liftPandocLua $ do Lua.rawseti (-2) (i + 1) -- | Load a pandoc module. -pandocPackageSearcher :: String -> PandocLua NumResults +pandocPackageSearcher :: String -> PandocLua Lua.NumResults pandocPackageSearcher pkgName = case pkgName of "pandoc" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError Pandoc.pushModule - "pandoc.mediabag" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError MediaBag.pushModule - "pandoc.path" -> pushWrappedHsFun - (Lua.NumResults 1 <$ Lua.pushModule @PandocError Path.documentedModule) - "pandoc.system" -> pushWrappedHsFun $ Lua.toHaskellFunction System.pushModule - "pandoc.types" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError Types.pushModule - "pandoc.utils" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError Utils.pushModule - "text" -> pushWrappedHsFun - (Lua.NumResults 1 <$ Lua.pushModule @PandocError Text.documentedModule) - "pandoc.List" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError (loadDefaultModule pkgName) + "pandoc.mediabag" -> pushModuleLoader MediaBag.documentedModule + "pandoc.path" -> pushModuleLoader Path.documentedModule + "pandoc.system" -> pushModuleLoader System.documentedModule + "pandoc.types" -> pushModuleLoader Types.documentedModule + "pandoc.utils" -> pushModuleLoader Utils.documentedModule + "text" -> pushModuleLoader Text.documentedModule + "pandoc.List" -> pushWrappedHsFun . Lua.toHaskellFunction @PandocError $ + loadDefaultModule pkgName _ -> reportPandocSearcherFailure where + pushModuleLoader mdl = liftPandocLua $ do + Lua.pushHaskellFunction $ + Lua.NumResults 1 <$ Lua.pushModule @PandocError mdl + return (Lua.NumResults 1) pushWrappedHsFun f = liftPandocLua $ do Lua.pushHaskellFunction f return 1 reportPandocSearcherFailure = liftPandocLua $ do Lua.push ("\n\t" <> pkgName <> "is not one of pandoc's default packages") - return (1 :: NumResults) + return (Lua.NumResults 1) diff --git a/src/Text/Pandoc/Lua/PandocLua.hs b/src/Text/Pandoc/Lua/PandocLua.hs index 12511d088..6c2ebc622 100644 --- a/src/Text/Pandoc/Lua/PandocLua.hs +++ b/src/Text/Pandoc/Lua/PandocLua.hs @@ -22,7 +22,6 @@ module Text.Pandoc.Lua.PandocLua ( PandocLua (..) , runPandocLua , liftPandocLua - , addFunction , loadDefaultModule ) where @@ -76,13 +75,6 @@ instance {-# OVERLAPPING #-} Exposable PandocError (PandocLua NumResults) where instance Pushable a => Exposable PandocError (PandocLua a) where partialApply _narg x = 1 <$ (unPandocLua x >>= Lua.push) --- | Add a function to the table at the top of the stack, using the given name. -addFunction :: Exposable PandocError a => Name -> a -> PandocLua () -addFunction name fn = liftPandocLua $ do - Lua.pushName name - Lua.pushHaskellFunction $ toHaskellFunction fn - Lua.rawset (-3) - -- | Load a pure Lua module included with pandoc. Leaves the result on -- the stack and returns @NumResults 1@. -- diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs index f20bc09e8..f35201db0 100644 --- a/src/Text/Pandoc/Lua/Util.hs +++ b/src/Text/Pandoc/Lua/Util.hs @@ -18,7 +18,6 @@ Lua utility functions. module Text.Pandoc.Lua.Util ( getTag , addField - , addFunction , callWithTraceback , dofileWithTraceback , pushViaConstr' @@ -35,14 +34,6 @@ addField key value = do Lua.push value Lua.rawset (Lua.nth 3) --- | Add a function to the table at the top of the stack, using the --- given name. -addFunction :: Exposable e a => String -> a -> LuaE e () -addFunction name fn = do - Lua.push name - Lua.pushHaskellFunction $ toHaskellFunction fn - Lua.rawset (-3) - -- | Get the tag of a value. This is an optimized and specialized version of -- @Lua.getfield idx "tag"@. It only checks for the field on the table at index -- @idx@ and on its metatable, also ignoring any @__index@ value on the diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 72446db99..6e8257633 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -408,6 +408,12 @@ return { }) assert.are_same(expected, pandoc.read(valid_markdown)) end), + test('unsupported extension', function () + assert.error_matches( + function () pandoc.read('foo', 'gfm+empty_paragraphs') end, + 'Extension empty_paragraphs not supported for gfm' + ) + end), test('failing read', function () assert.error_matches( function () pandoc.read('foo', 'nosuchreader') end, -- cgit v1.2.3 From 3de8f4fdc552c7ba103ec30ef79ea42ec674a8cc Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sun, 31 Oct 2021 11:12:53 +0100 Subject: Lua: re-add `content` property to Link elements This was a regression introduced in version 2.15. Fixes: #7647 --- src/Text/Pandoc/Lua/Marshaling/AST.hs | 2 ++ test/lua/module/pandoc.lua | 10 ++++++++++ 2 files changed, 12 insertions(+) (limited to 'test/lua') diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index aabc9e530..07b11b3ea 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -608,6 +608,7 @@ setInlineContent = \case -- inline content Cite cs _ -> Actual . Cite cs . inlineContent Emph _ -> Actual . Emph . inlineContent + Link a _ tgt -> Actual . (\inlns -> Link a inlns tgt) . inlineContent Quoted qt _ -> Actual . Quoted qt . inlineContent SmallCaps _ -> Actual . SmallCaps . inlineContent Span attr _ -> Actual . Span attr . inlineContent @@ -633,6 +634,7 @@ getInlineContent :: Inline -> Possible Content getInlineContent = \case Cite _ inlns -> Actual $ ContentInlines inlns Emph inlns -> Actual $ ContentInlines inlns + Link _ inlns _ -> Actual $ ContentInlines inlns Quoted _ inlns -> Actual $ ContentInlines inlns SmallCaps inlns -> Actual $ ContentInlines inlns Span _ inlns -> Actual $ ContentInlines inlns diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 6e8257633..b18a01faa 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -148,6 +148,16 @@ return { end) } }, + group "Inline elements" { + test('Link has property `content`', function () + local link = pandoc.Link('example', 'https://example.org') + assert.are_same(link.content, {pandoc.Str 'example'}) + + link.content = 'commercial' + link.target = 'https://example.com' + assert.are_equal(link, pandoc.Link('commercial', 'https://example.com')) + end) + }, group "Block elements" { group "BulletList" { test('access items via property `content`', function () -- cgit v1.2.3 From 96e76d4cd475fe479ae6fb36bd6feee1cc6ff39f Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Mon, 1 Nov 2021 08:14:44 +0100 Subject: Lua: restore List behavior of MetaList Fixes a regression introduced in 2.16 which had MetaList elements loose the `pandoc.List` properties. Fixes #7650 --- data/pandoc.lua | 1 + test/lua/module/pandoc.lua | 13 +++++++++++++ 2 files changed, 14 insertions(+) (limited to 'test/lua') diff --git a/data/pandoc.lua b/data/pandoc.lua index 1f4830858..d4bd955aa 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -55,6 +55,7 @@ local function create_accessor_behavior (tag) if k == "t" then return getmetatable(t)["tag"] end + return getmetatable(t)[k] end behavior.__pairs = function (t) return next, t diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index b18a01faa..4e0b5188e 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -278,6 +278,19 @@ return { end) }, }, + group 'MetaValue elements' { + test('MetaList elements behave like lists', function () + local metalist = pandoc.MetaList{} + assert.are_equal(type(metalist.insert), 'function') + assert.are_equal(type(metalist.remove), 'function') + end), + test('MetaList, MetaMap, MetaInlines, MetaBlocks have `t` tag', function () + assert.are_equal((pandoc.MetaList{}).t, 'MetaList') + assert.are_equal((pandoc.MetaMap{}).t, 'MetaMap') + assert.are_equal((pandoc.MetaInlines{}).t, 'MetaInlines') + assert.are_equal((pandoc.MetaBlocks{}).t, 'MetaBlocks') + end) + }, group 'Other types' { group 'SimpleTable' { test('can access properties', function () -- cgit v1.2.3 From 759aa5095101351bc2e4d2c4629df945b743e7db Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Mon, 1 Nov 2021 15:43:51 +0100 Subject: Lua: restore `content` property on Header elements --- src/Text/Pandoc/Lua/Marshaling/AST.hs | 2 ++ test/lua/module/pandoc.lua | 23 +++++++++++++++++++++++ 2 files changed, 25 insertions(+) (limited to 'test/lua') diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 07b11b3ea..883a6dce2 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -340,6 +340,7 @@ getBlockContent = \case -- inline content Para inlns -> Actual $ ContentInlines inlns Plain inlns -> Actual $ ContentInlines inlns + Header _ _ inlns -> Actual $ ContentInlines inlns -- inline content BlockQuote blks -> Actual $ ContentBlocks blks Div _ blks -> Actual $ ContentBlocks blks @@ -357,6 +358,7 @@ setBlockContent = \case -- inline content Para _ -> Actual . Para . inlineContent Plain _ -> Actual . Plain . inlineContent + Header attr lvl _ -> Actual . Header attr lvl . inlineContent -- block content BlockQuote _ -> Actual . BlockQuote . blockContent Div attr _ -> Actual . Div attr . blockContent diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 4e0b5188e..21a6de2de 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -245,6 +245,29 @@ return { ) end), }, + group 'Header' { + test('access inlines via property `content`', function () + local header = pandoc.Header(1, 'test') + assert.are_same(header.content, {pandoc.Str 'test'}) + + header.content = {'new text'} + assert.are_equal(header, pandoc.Header(1, 'new text')) + end), + test('access Attr via property `attr`', function () + local header = pandoc.Header(1, 'test', {'my-test'}) + assert.are_same(header.attr, pandoc.Attr{'my-test'}) + + header.attr = 'second-test' + assert.are_equal(header, pandoc.Header(1, 'test', 'second-test')) + end), + test('access level via property `level`', function () + local header = pandoc.Header(3, 'test') + assert.are_same(header.level, 3) + + header.level = 2 + assert.are_equal(header, pandoc.Header(2, 'test')) + end), + }, group 'LineBlock' { test('access lines via property `content`', function () local spc = pandoc.Space() -- cgit v1.2.3 From 3a0ac52f7b23b555a7eeb9e3df10536b809f95ac Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 2 Nov 2021 09:55:38 +0100 Subject: Lua tests: ensure Block elements have expected properties --- test/lua/module/pandoc.lua | 238 ++++++++++++++++++++++++++++++++++++++------- 1 file changed, 202 insertions(+), 36 deletions(-) (limited to 'test/lua') diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 21a6de2de..a0b888c74 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -159,7 +159,26 @@ return { end) }, group "Block elements" { - group "BulletList" { + group 'BlockQuote' { + test('access content via property `content`', function () + local elem = pandoc.BlockQuote{'word'} + assert.are_same(elem.content, {pandoc.Plain 'word'}) + assert.are_equal(type(elem.content), 'table') + + elem.content = { + pandoc.Para{pandoc.Str 'one'}, + pandoc.Para{pandoc.Str 'two'} + } + assert.are_equal( + pandoc.BlockQuote{ + pandoc.Para 'one', + pandoc.Para 'two' + }, + elem + ) + end), + }, + group 'BulletList' { test('access items via property `content`', function () local para = pandoc.Para 'one' local blist = pandoc.BulletList{{para}} @@ -175,23 +194,25 @@ return { assert.are_same({{new}}, blist:clone().content) end), }, - group "OrderedList" { - test('access items via property `content`', function () - local para = pandoc.Plain 'one' - local olist = pandoc.OrderedList{{para}} - assert.are_same({{para}}, olist.content) - end), - test('forgiving constructor', function () - local plain = pandoc.Plain 'old' - local olist = pandoc.OrderedList({plain}, {3, 'Example', 'Period'}) - local listAttribs = pandoc.ListAttributes(3, 'Example', 'Period') - assert.are_same(olist.listAttributes, listAttribs) + group 'CodeBlock' { + test('access code via property `text`', function () + local cb = pandoc.CodeBlock('return true') + assert.are_equal(cb.text, 'return true') + assert.are_equal(type(cb.text), 'string') + + cb.text = 'return nil' + assert.are_equal(cb, pandoc.CodeBlock('return nil')) end), - test('has list attribute aliases', function () - local olist = pandoc.OrderedList({}, {4, 'Decimal', 'OneParen'}) - assert.are_equal(olist.start, 4) - assert.are_equal(olist.style, 'Decimal') - assert.are_equal(olist.delimiter, 'OneParen') + test('access Attr via property `attr`', function () + local cb = pandoc.CodeBlock('true', {'my-code', {'lua'}}) + assert.are_equal(cb.attr, pandoc.Attr{'my-code', {'lua'}}) + assert.are_equal(type(cb.attr), 'userdata') + + cb.attr = pandoc.Attr{'my-other-code', {'java'}} + assert.are_equal( + pandoc.CodeBlock('true', {'my-other-code', {'java'}}), + cb + ) end) }, group 'DefinitionList' { @@ -221,29 +242,35 @@ return { assert.are_equal(deflist, newlist) end), }, - group 'Para' { - test('access inline via property `content`', function () - local para = pandoc.Para{'Moin, ', pandoc.Space(), 'Sylt!'} - assert.are_same( - para.content, - {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} + group 'Div' { + test('access content via property `content`', function () + local elem = pandoc.Div{pandoc.BlockQuote{pandoc.Plain 'word'}} + assert.are_same(elem.content, {pandoc.BlockQuote{'word'}}) + assert.are_equal(type(elem.content), 'table') + + elem.content = { + pandoc.Para{pandoc.Str 'one'}, + pandoc.Para{pandoc.Str 'two'} + } + assert.are_equal( + pandoc.Div{ + pandoc.Para 'one', + pandoc.Para 'two' + }, + elem ) end), - test('modifying `content` changes the element', function () - local para = pandoc.Para{'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} + test('access Attr via property `attr`', function () + local div = pandoc.Div('word', {'my-div', {'sample'}}) + assert.are_equal(div.attr, pandoc.Attr{'my-div', {'sample'}}) + assert.are_equal(type(div.attr), 'userdata') - para.content[3] = 'Hamburg!' - assert.are_same( - para:clone().content, - {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Hamburg!'} + div.attr = pandoc.Attr{'my-other-div', {'example'}} + assert.are_equal( + pandoc.Div('word', {'my-other-div', {'example'}}), + div ) - - para.content = 'Huh' - assert.are_same( - para:clone().content, - {pandoc.Str 'Huh'} - ) - end), + end) }, group 'Header' { test('access inlines via property `content`', function () @@ -300,6 +327,139 @@ return { ) end) }, + group 'OrderedList' { + test('access items via property `content`', function () + local para = pandoc.Plain 'one' + local olist = pandoc.OrderedList{{para}} + assert.are_same({{para}}, olist.content) + end), + test('forgiving constructor', function () + local plain = pandoc.Plain 'old' + local olist = pandoc.OrderedList({plain}, {3, 'Example', 'Period'}) + local listAttribs = pandoc.ListAttributes(3, 'Example', 'Period') + assert.are_same(olist.listAttributes, listAttribs) + end), + test('has list attribute aliases', function () + local olist = pandoc.OrderedList({}, {4, 'Decimal', 'OneParen'}) + assert.are_equal(olist.start, 4) + assert.are_equal(olist.style, 'Decimal') + assert.are_equal(olist.delimiter, 'OneParen') + end) + }, + group 'Para' { + test('access inline via property `content`', function () + local para = pandoc.Para{'Moin, ', pandoc.Space(), 'Sylt!'} + assert.are_same( + para.content, + {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} + ) + end), + test('modifying `content` changes the element', function () + local para = pandoc.Para{'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} + + para.content[3] = 'Hamburg!' + assert.are_same( + para:clone().content, + {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Hamburg!'} + ) + + para.content = 'Huh' + assert.are_same( + para:clone().content, + {pandoc.Str 'Huh'} + ) + end), + }, + group 'RawBlock' { + test('access raw content via property `text`', function () + local raw = pandoc.RawBlock('markdown', '- one') + assert.are_equal(type(raw.text), 'string') + assert.are_equal(raw.text, '- one') + + raw.text = '+ one' + assert.are_equal(raw, pandoc.RawBlock('markdown', '+ one')) + end), + test('access Format via property `format`', function () + local raw = pandoc.RawBlock('markdown', '* hi') + assert.are_equal(type(raw.format), 'string') + assert.are_equal(raw.format, 'markdown') + + raw.format = 'org' + assert.are_equal(pandoc.RawBlock('org', '* hi'), raw) + end) + }, + group 'Table' { + test('access Attr via property `attr`', function () + local caption = {long = {pandoc.Plain 'cap'}} + local tbl = pandoc.Table(caption, {}, {{}, {}}, {}, {{}, {}}, + {'my-tbl', {'a'}}) + assert.are_equal(tbl.attr, pandoc.Attr{'my-tbl', {'a'}}) + + tbl.attr = pandoc.Attr{'my-other-tbl', {'b'}} + assert.are_equal( + pandoc.Table(caption, {}, {{}, {}}, {}, {{}, {}}, + {'my-other-tbl', {'b'}}), + tbl + ) + end), + test('access caption via property `caption`', function () + local caption = {long = {pandoc.Plain 'cap'}} + local tbl = pandoc.Table(caption, {}, {{}, {}}, {}, {{}, {}}) + assert.are_same(tbl.caption, {long = {pandoc.Plain 'cap'}}) + + tbl.caption.short = 'brief' + tbl.caption.long = {pandoc.Plain 'extended'} + + local new_caption = { + short = 'brief', + long = {pandoc.Plain 'extended'} + } + assert.are_equal( + pandoc.Table(new_caption, {}, {{}, {}}, {}, {{}, {}}), + tbl + ) + end), + test('access column specifiers via property `colspecs`', function () + local colspecs = {{pandoc.AlignCenter, 1}} + local tbl = pandoc.Table({long = {}}, colspecs, {{}, {}}, {}, {{}, {}}) + assert.are_same(tbl.colspecs, colspecs) + + tbl.colspecs[1][1] = pandoc.AlignRight + tbl.colspecs[1][2] = nil + + local new_colspecs = {{pandoc.AlignRight}} + assert.are_equal( + pandoc.Table({long = {}}, new_colspecs, {{}, {}}, {}, {{}, {}}), + tbl + ) + end), + test('access table head via property `head`', function () + local head = {pandoc.Attr{'tbl-head'}, {}} + local tbl = pandoc.Table({long = {}}, {}, head, {}, {{}, {}}) + assert.are_same(tbl.head, head) + + tbl.head[1] = pandoc.Attr{'table-head'} + + local new_head = {'table-head', {}} + assert.are_equal( + pandoc.Table({long = {}}, {}, new_head, {}, {{}, {}}), + tbl + ) + end), + test('access table head via property `head`', function () + local foot = {{id = 'tbl-foot'}, {}} + local tbl = pandoc.Table({long = {}}, {}, {{}, {}}, {}, foot) + assert.are_same(tbl.foot, {pandoc.Attr('tbl-foot'), {}}) + + tbl.foot[1] = pandoc.Attr{'table-foot'} + + local new_foot = {'table-foot', {}} + assert.are_equal( + pandoc.Table({long = {}}, {}, {{}, {}}, {}, new_foot), + tbl + ) + end) + }, }, group 'MetaValue elements' { test('MetaList elements behave like lists', function () @@ -312,6 +472,12 @@ return { assert.are_equal((pandoc.MetaMap{}).t, 'MetaMap') assert.are_equal((pandoc.MetaInlines{}).t, 'MetaInlines') assert.are_equal((pandoc.MetaBlocks{}).t, 'MetaBlocks') + end), + test('`tag` is an alias for `t``', function () + assert.are_equal((pandoc.MetaList{}).tag, (pandoc.MetaList{}).t) + assert.are_equal((pandoc.MetaMap{}).tag, (pandoc.MetaMap{}).t) + assert.are_equal((pandoc.MetaInlines{}).tag, (pandoc.MetaInlines{}).t) + assert.are_equal((pandoc.MetaBlocks{}).tag, (pandoc.MetaBlocks{}).t) end) }, group 'Other types' { -- cgit v1.2.3 From 210e4c98b0d09dd8e25c108dda14fdb17ba90192 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 2 Nov 2021 16:49:50 +0100 Subject: Lua: allow to compare, show Citation values Comparisons of Citation values are performed in Haskell; values are equal if they represent the same Haskell value. Converting a Citation value to a string now yields its native Haskell string representation. --- src/Text/Pandoc/Lua/Marshaling/AST.hs | 13 ++++++++++++- test/lua/module/pandoc.lua | 16 ++++++++++++++++ 2 files changed, 28 insertions(+), 1 deletion(-) (limited to 'test/lua') diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 883a6dce2..469dd4285 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -111,7 +111,18 @@ instance Pushable Block where push = pushBlock typeCitation :: LuaError e => DocumentedType e Citation -typeCitation = deftype "Citation" [] +typeCitation = deftype "Citation" + [ operation Eq $ lambda + ### liftPure2 (==) + <#> parameter (optional . peekCitation) "Citation" "a" "" + <#> parameter (optional . peekCitation) "Citation" "b" "" + =#> functionResult pushBool "boolean" "true iff the citations are equal" + + , operation Tostring $ lambda + ### liftPure show + <#> parameter peekCitation "Citation" "citation" "" + =#> functionResult pushString "string" "native Haskell representation" + ] [ property "id" "citation ID / key" (pushText, citationId) (peekText, \citation cid -> citation{ citationId = cid }) diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index a0b888c74..4792e0949 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -481,6 +481,22 @@ return { end) }, group 'Other types' { + group 'Citation' { + test('checks equality by comparing Haskell values', function() + assert.are_equal( + pandoc.Citation('a', pandoc.NormalCitation), + pandoc.Citation('a', pandoc.NormalCitation) + ) + assert.is_falsy( + pandoc.Citation('a', pandoc.NormalCitation) == + pandoc.Citation('a', pandoc.AuthorInText) + ) + assert.is_falsy( + pandoc.Citation('a', pandoc.NormalCitation) == + pandoc.Citation('b', pandoc.NormalCitation) + ) + end), + }, group 'SimpleTable' { test('can access properties', function () local spc = pandoc.Space() -- cgit v1.2.3 From c467f0fed109c362faa733c1a258a26bc6aba5cd Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 2 Nov 2021 17:21:29 +0100 Subject: Lua: allow omitting the 2nd parameter in pandoc.Code constructor Fixes a regression introduced in 2.15 which required users to always specify an Attr value when constructing a Code element. --- src/Text/Pandoc/Lua/Module/Pandoc.hs | 4 +- test/lua/module/pandoc.lua | 82 +++++++++++++++++++++++++++++++++--- 2 files changed, 77 insertions(+), 9 deletions(-) (limited to 'test/lua') diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index 6d1ccea04..f09159b4e 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -138,9 +138,9 @@ inlineConstructors = <#> parameter peekInlinesFuzzy "content" "Inline" "placeholder content" =#> functionResult pushInline "Inline" "cite element" , defun "Code" - ### liftPure2 (flip Code) + ### liftPure2 (\text mattr -> Code (fromMaybe nullAttr mattr) text) <#> parameter peekText "code" "string" "code string" - <#> parameter peekAttr "attr" "Attr" "additional attributes" + <#> optionalParameter peekAttr "attr" "Attr" "additional attributes" =#> functionResult pushInline "Inline" "code element" , mkInlinesConstr "Emph" Emph , defun "Image" diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 4792e0949..057d24202 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -149,14 +149,82 @@ return { } }, group "Inline elements" { - test('Link has property `content`', function () - local link = pandoc.Link('example', 'https://example.org') - assert.are_same(link.content, {pandoc.Str 'example'}) + group 'Cite' { + test('has property `content`', function () + local cite = pandoc.Cite({}, {pandoc.Emph 'important'}) + assert.are_same(cite.content, {pandoc.Emph {pandoc.Str 'important'}}) - link.content = 'commercial' - link.target = 'https://example.com' - assert.are_equal(link, pandoc.Link('commercial', 'https://example.com')) - end) + cite.content = 'boring' + assert.are_equal(cite, pandoc.Cite({}, {pandoc.Str 'boring'})) + end), + test('has list of citations in property `cite`', function () + local citations = { + pandoc.Citation('einstein1905', 'NormalCitation') + } + local cite = pandoc.Cite(citations, 'relativity') + assert.are_same(cite.citations, citations) + + local new_citations = { + citations[1], + pandoc.Citation('Poincaré1905', 'NormalCitation') + } + cite.citations = new_citations + assert.are_equal(cite, pandoc.Cite(new_citations, {'relativity'})) + end), + }, + group 'Code' { + test('has property `attr`', function () + local code = pandoc.Code('true', {id='true', foo='bar'}) + assert.are_equal(code.attr, pandoc.Attr('true', {}, {{'foo', 'bar'}})) + + code.attr = {id='t', fubar='quux'} + assert.are_equal( + pandoc.Code('true', pandoc.Attr('t', {}, {{'fubar', 'quux'}})), + code + ) + end), + test('has property `text`', function () + local code = pandoc.Code('true') + -- assert.are_equal(code.text, 'true') + + -- code.text = '1 + 1' + -- assert.are_equal(pandoc.Code('1 + 1'), code) + end), + }, + group 'Link' { + test('has property `content`', function () + local link = pandoc.Link('example', 'https://example.org') + assert.are_same(link.content, {pandoc.Str 'example'}) + + link.content = 'commercial' + link.target = 'https://example.com' + assert.are_equal(link, pandoc.Link('commercial', 'https://example.com')) + end), + test('has property `target`', function () + local link = pandoc.Link('example', 'https://example.org') + assert.are_same(link.content, {pandoc.Str 'example'}) + + link.target = 'https://example.com' + assert.are_equal(link, pandoc.Link('example', 'https://example.com')) + end), + test('has property `title`', function () + local link = pandoc.Link('here', 'https://example.org', 'example') + assert.are_same(link.title, 'example') + + link.title = 'a' + assert.are_equal(link, pandoc.Link('here', 'https://example.org', 'a')) + end), + test('has property `attr`', function () + local link = pandoc.Link('up', '../index.html', '', {'up', {'nav'}}) + assert.are_same(link.attr, pandoc.Attr {'up', {'nav'}}) + + link.attr = pandoc.Attr {'up', {'nav', 'button'}} + assert.are_equal( + pandoc.Link('up', '../index.html', nil, {'up', {'nav', 'button'}}), + link + ) + end) + } }, group "Block elements" { group 'BlockQuote' { -- cgit v1.2.3 From b26f950ccaa0a1a973b282a516bd80295536feb2 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 2 Nov 2021 17:25:47 +0100 Subject: Lua: display Attr values using their native Haskell representation --- src/Text/Pandoc/Lua/Marshaling/Attr.hs | 4 ++++ test/lua/module/pandoc.lua | 6 +++--- 2 files changed, 7 insertions(+), 3 deletions(-) (limited to 'test/lua') diff --git a/src/Text/Pandoc/Lua/Marshaling/Attr.hs b/src/Text/Pandoc/Lua/Marshaling/Attr.hs index a38bc6ec7..97e702e35 100644 --- a/src/Text/Pandoc/Lua/Marshaling/Attr.hs +++ b/src/Text/Pandoc/Lua/Marshaling/Attr.hs @@ -42,6 +42,10 @@ typeAttr = deftype "Attr" <#> parameter peekAttr "a1" "Attr" "" <#> parameter peekAttr "a2" "Attr" "" =#> functionResult pushBool "boolean" "whether the two are equal" + , operation Tostring $ lambda + ### liftPure show + <#> parameter peekAttr "Attr" "attr" "" + =#> functionResult pushString "string" "native Haskell representation" ] [ property "identifier" "element identifier" (pushText, \(ident,_,_) -> ident) diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 057d24202..9f5f5c771 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -185,10 +185,10 @@ return { end), test('has property `text`', function () local code = pandoc.Code('true') - -- assert.are_equal(code.text, 'true') + assert.are_equal(code.text, 'true') - -- code.text = '1 + 1' - -- assert.are_equal(pandoc.Code('1 + 1'), code) + code.text = '1 + 1' + assert.are_equal(pandoc.Code('1 + 1'), code) end), }, group 'Link' { -- cgit v1.2.3 From cce49c5d4b7429ca3455d356dff59f404f7e6d4b Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 2 Nov 2021 17:38:49 +0100 Subject: Lua: be more forgiving when retrieving the Image `caption` property Fixes a regression introduced in 2.15. --- src/Text/Pandoc/Lua/Marshaling/AST.hs | 2 +- test/lua/module/pandoc.lua | 9 +++++++++ 2 files changed, 10 insertions(+), 1 deletion(-) (limited to 'test/lua') diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 469dd4285..4363f7e4f 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -710,7 +710,7 @@ typeInline = deftype "Inline" (pushPandocList pushInline, \case Image _ capt _ -> Actual capt _ -> Absent) - (peekInlines, \case + (peekInlinesFuzzy, \case Image attr _ target -> Actual . (\capt -> Image attr capt target) _ -> const Absent) , possibleProperty "citations" "list of citations" diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 9f5f5c771..be1cbbde1 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -191,6 +191,15 @@ return { assert.are_equal(pandoc.Code('1 + 1'), code) end), }, + group 'Image' { + test('has property `caption`', function () + local img = pandoc.Image('example', 'a.png') + assert.are_same(img.caption, {pandoc.Str 'example'}) + + img.caption = {pandoc.Str 'A'} + assert.are_equal(img, pandoc.Image({pandoc.Str 'A'}, 'a.png')) + end), + }, group 'Link' { test('has property `content`', function () local link = pandoc.Link('example', 'https://example.org') -- cgit v1.2.3 From 421fd736d4ee11815f1b8acc123c1d0f9e9136c7 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 2 Nov 2021 21:22:59 +0100 Subject: Lua: re-add `content` property to Strikeout elements Fixes a regression introduced in 2.15. --- src/Text/Pandoc/Lua/Marshaling/AST.hs | 2 + test/lua/module/pandoc.lua | 96 +++++++++++++++++++++++++++++++++-- 2 files changed, 95 insertions(+), 3 deletions(-) (limited to 'test/lua') diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 4363f7e4f..e73ff43b5 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -625,6 +625,7 @@ setInlineContent = \case Quoted qt _ -> Actual . Quoted qt . inlineContent SmallCaps _ -> Actual . SmallCaps . inlineContent Span attr _ -> Actual . Span attr . inlineContent + Strikeout _ -> Actual . Strikeout . inlineContent Strong _ -> Actual . Strong . inlineContent Subscript _ -> Actual . Subscript . inlineContent Superscript _ -> Actual . Superscript . inlineContent @@ -651,6 +652,7 @@ getInlineContent = \case Quoted _ inlns -> Actual $ ContentInlines inlns SmallCaps inlns -> Actual $ ContentInlines inlns Span _ inlns -> Actual $ ContentInlines inlns + Strikeout inlns -> Actual $ ContentInlines inlns Strong inlns -> Actual $ ContentInlines inlns Subscript inlns -> Actual $ ContentInlines inlns Superscript inlns -> Actual $ ContentInlines inlns diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index be1cbbde1..ba2b823f8 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -191,14 +191,49 @@ return { assert.are_equal(pandoc.Code('1 + 1'), code) end), }, + group 'Emph' { + test('has property `content`', function () + local elem = pandoc.Emph{'two', pandoc.Space(), 'words'} + assert.are_same( + elem.content, + {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} + ) + elem.content = {'word'} + assert.are_equal(elem, pandoc.Emph{'word'}) + end) + }, group 'Image' { test('has property `caption`', function () local img = pandoc.Image('example', 'a.png') assert.are_same(img.caption, {pandoc.Str 'example'}) - img.caption = {pandoc.Str 'A'} - assert.are_equal(img, pandoc.Image({pandoc.Str 'A'}, 'a.png')) + img.caption = 'A' + assert.are_equal(img, pandoc.Image({'A'}, 'a.png')) end), + test('has property `src`', function () + local img = pandoc.Image('example', 'sample.png') + assert.are_same(img.src, 'sample.png') + + img.src = 'example.svg' + assert.are_equal(img, pandoc.Image('example', 'example.svg')) + end), + test('has property `title`', function () + local img = pandoc.Image('here', 'img.gif', 'example') + assert.are_same(img.title, 'example') + + img.title = 'a' + assert.are_equal(img, pandoc.Image('here', 'img.gif', 'a')) + end), + test('has property `attr`', function () + local img = pandoc.Image('up', 'upwards.png', '', {'up', {'point'}}) + assert.are_same(img.attr, pandoc.Attr {'up', {'point'}}) + + img.attr = pandoc.Attr {'up', {'point', 'button'}} + assert.are_equal( + pandoc.Image('up', 'upwards.png', nil, {'up', {'point', 'button'}}), + img + ) + end) }, group 'Link' { test('has property `content`', function () @@ -233,7 +268,62 @@ return { link ) end) - } + }, + group 'Strikeout' { + test('has property `content`', function () + local elem = pandoc.Strikeout{'two', pandoc.Space(), 'words'} + assert.are_same( + elem.content, + {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} + ) + elem.content = {'word'} + assert.are_equal(elem, pandoc.Strikeout{'word'}) + end) + }, + group 'Strong' { + test('has property `content`', function () + local elem = pandoc.Strong{'two', pandoc.Space(), 'words'} + assert.are_same( + elem.content, + {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} + ) + elem.content = {'word'} + assert.are_equal(elem, pandoc.Strong{'word'}) + end) + }, + group 'Subscript' { + test('has property `content`', function () + local elem = pandoc.Subscript{'two', pandoc.Space(), 'words'} + assert.are_same( + elem.content, + {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} + ) + elem.content = {'word'} + assert.are_equal(elem, pandoc.Subscript{'word'}) + end) + }, + group 'Superscript' { + test('has property `content`', function () + local elem = pandoc.Superscript{'two', pandoc.Space(), 'words'} + assert.are_same( + elem.content, + {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} + ) + elem.content = {'word'} + assert.are_equal(elem, pandoc.Superscript{'word'}) + end) + }, + group 'Underline' { + test('has property `content`', function () + local elem = pandoc.Underline{'two', pandoc.Space(), 'words'} + assert.are_same( + elem.content, + {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} + ) + elem.content = {'word'} + assert.are_equal(elem, pandoc.Underline{'word'}) + end) + }, }, group "Block elements" { group 'BlockQuote' { -- cgit v1.2.3 From dbc654e4a7877dacf02c91ee9dcd567194682efa Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 2 Nov 2021 21:40:37 +0100 Subject: Lua tests: ensure Inline elements have all expected properties --- test/lua/module/pandoc.lua | 81 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 81 insertions(+) (limited to 'test/lua') diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index ba2b823f8..fac95d27f 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -269,6 +269,87 @@ return { ) end) }, + group 'Math' { + test('has property `text`', function () + local elem = pandoc.Math(pandoc.InlineMath, 'x^2') + assert.are_same(elem.text, 'x^2') + elem.text = 'a + b' + assert.are_equal(elem, pandoc.Math(pandoc.InlineMath, 'a + b')) + end), + test('has property `mathtype`', function () + local elem = pandoc.Math(pandoc.InlineMath, 'x^2') + assert.are_same(elem.mathtype, 'InlineMath') + elem.mathtype = pandoc.DisplayMath + assert.are_equal(elem, pandoc.Math(pandoc.DisplayMath, 'x^2')) + end), + }, + group 'Note' { + test('has property `content`', function () + local elem = pandoc.Note{pandoc.Para {'two', pandoc.Space(), 'words'}} + assert.are_same( + elem.content, + {pandoc.Para {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'}} + ) + elem.content = pandoc.Plain 'word' + assert.are_equal(elem, pandoc.Note{'word'}) + end) + }, + group 'Quoted' { + test('has property `content`', function () + local elem = pandoc.Quoted('SingleQuote', pandoc.Emph{'emph'}) + assert.are_same( + elem.content, + {pandoc.Emph{pandoc.Str 'emph'}} + ) + elem.content = {'word'} + assert.are_equal(elem, pandoc.Quoted(pandoc.SingleQuote, {'word'})) + end), + test('has property `quotetype`', function () + local elem = pandoc.Quoted('SingleQuote', 'a') + assert.are_same(elem.quotetype, pandoc.SingleQuote) + elem.quotetype = 'DoubleQuote' + assert.are_equal(elem, pandoc.Quoted(pandoc.DoubleQuote, {'a'})) + end) + }, + group 'SmallCaps' { + test('has property `content`', function () + local elem = pandoc.SmallCaps{'two', pandoc.Space(), 'words'} + assert.are_same( + elem.content, + {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} + ) + elem.content = {'word'} + assert.are_equal(elem, pandoc.SmallCaps{'word'}) + end) + }, + group 'Span' { + test('has property `attr`', function () + local elem = pandoc.Span('one', {'', {'number'}}) + assert.are_same( + elem.attr, + pandoc.Attr('', {'number'}) + ) + elem.attr = {'', {}, {{'a', 'b'}}} + assert.are_equal(elem, pandoc.Span({'one'}, {a='b'})) + end), + test('has property `content`', function () + local elem = pandoc.Span{'two', pandoc.Space(), 'words'} + assert.are_same( + elem.content, + {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} + ) + elem.content = {'word'} + assert.are_equal(elem, pandoc.Span{'word'}) + end) + }, + group 'Str' { + test('has property `text`', function () + local elem = pandoc.Str 'nein' + assert.are_same(elem.text, 'nein') + elem.text = 'doch' + assert.are_equal(elem, pandoc.Str 'doch') + end) + }, group 'Strikeout' { test('has property `content`', function () local elem = pandoc.Strikeout{'two', pandoc.Space(), 'words'} -- cgit v1.2.3 From 45bcd7d3f1c78d08d20db3b6929421c896fa869a Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 2 Nov 2021 21:53:08 +0100 Subject: Lua: fix typo in SoftBreak constructor --- src/Text/Pandoc/Lua/Module/Pandoc.hs | 2 +- test/lua/module/pandoc.lua | 6 ++++++ 2 files changed, 7 insertions(+), 1 deletion(-) (limited to 'test/lua') diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index f09159b4e..33432b4d8 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -186,7 +186,7 @@ inlineConstructors = <#> parameter peekText "text" "string" "string content" =#> functionResult pushInline "Inline" "raw inline element" , mkInlinesConstr "SmallCaps" SmallCaps - , defun "SoftSpace" + , defun "SoftBreak" ### return SoftBreak =#> functionResult pushInline "Inline" "soft break" , defun "Space" diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index fac95d27f..4da663f07 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -322,6 +322,12 @@ return { assert.are_equal(elem, pandoc.SmallCaps{'word'}) end) }, + group 'SoftBreak' { + test('can be constructed', function () + local sb = pandoc.SoftBreak() + assert.are_equal(sb.t, 'SoftBreak') + end) + }, group 'Span' { test('has property `attr`', function () local elem = pandoc.Span('one', {'', {'number'}}) -- cgit v1.2.3 From 6b462e59332242c18ea38a721ae672b88f33d621 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 6 Nov 2021 11:00:26 +0100 Subject: Lua: allow to pass custom reader options to `pandoc.read` Reader options can now be passed as an optional third argument to `pandoc.read`. The object can either be a table or a ReaderOptions value like `PANDOC_READER_OPTIONS`. Creating new ReaderOptions objects is possible through the new constructor `pandoc.ReaderOptions`. Closes: #7656 --- doc/lua-filters.md | 42 +++++++- src/Text/Pandoc/Lua/Global.hs | 4 +- src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs | 129 +++++++++++++++++------- src/Text/Pandoc/Lua/Module/Pandoc.hs | 16 ++- test/lua/module/pandoc.lua | 30 +++++- 5 files changed, 177 insertions(+), 44 deletions(-) (limited to 'test/lua') diff --git a/doc/lua-filters.md b/doc/lua-filters.md index e9a121f50..ba5f58120 100644 --- a/doc/lua-filters.md +++ b/doc/lua-filters.md @@ -2742,7 +2742,33 @@ format, and functions to filter and modify a subtree. [`sha1`]{#pandoc.sha1} : Alias for [`pandoc.utils.sha1`](#pandoc.utils.sha1) - (DEPRECATED). + (DEPRECATED, use `pandoc.utils.sha1` instead). + +## Other constructors + +[`ReaderOptions (opts)`]{#pandoc.readeroptions} + +: Creates a new [ReaderOptions] value. + + Parameters + + `opts`: + : Either a table with a subset of the properties of a + [ReaderOptions] object, or another ReaderOptions object. + Uses the defaults specified in the manual for all + properties that are not explicitly specified. Throws an + error if a table contains properties which are not present + in a ReaderOptions object. ([ReaderOptions]|table) + + Returns: new [ReaderOptions] object + + Usage: + + -- copy of the reader options that were defined on the command line. + local cli_opts = pandoc.ReaderOptions(PANDOC_READER_OPTIONS) + + -- default reader options, but columns set to 66. + local short_colums_opts = pandoc.ReaderOptions {columns = 66} ## Helper functions @@ -2815,17 +2841,23 @@ Returns: the transformed inline element ### read {#pandoc.read} -`read (markup[, format])` +`read (markup[, format[, reader_options]])` Parse the given string into a Pandoc document. Parameters: `markup`: -: the markup to be parsed +: the markup to be parsed (string) `format`: -: format specification, defaults to `"markdown"`. +: format specification, defaults to `"markdown"` (string) + +`reader_options`: +: options passed to the reader; may be a ReaderOptions object or + a table with a subset of the keys and values of a + ReaderOptions object; defaults to the default values + documented in the manual. ([ReaderOptions]|table) Returns: pandoc document @@ -2838,6 +2870,8 @@ Usage: -- The inline element in that block is an `Emph` assert(block.content[1].t == "Emph") +[ReaderOptions]: #type-readeroptions + # Module pandoc.utils This module exposes internal pandoc functions and utility diff --git a/src/Text/Pandoc/Lua/Global.hs b/src/Text/Pandoc/Lua/Global.hs index 23b3a8284..05510f45d 100644 --- a/src/Text/Pandoc/Lua/Global.hs +++ b/src/Text/Pandoc/Lua/Global.hs @@ -22,7 +22,7 @@ import Text.Pandoc.Definition (Pandoc (Pandoc), pandocTypesVersion) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.Marshaling () import Text.Pandoc.Lua.Marshaling.CommonState (pushCommonState) -import Text.Pandoc.Lua.Marshaling.ReaderOptions (pushReaderOptions) +import Text.Pandoc.Lua.Marshaling.ReaderOptions (pushReaderOptionsReadonly) import Text.Pandoc.Options (ReaderOptions) import qualified Data.Text as Text @@ -55,7 +55,7 @@ setGlobal global = case global of pushUD typePandocLazy doc Lua.setglobal "PANDOC_DOCUMENT" PANDOC_READER_OPTIONS ropts -> do - pushReaderOptions ropts + pushReaderOptionsReadonly ropts Lua.setglobal "PANDOC_READER_OPTIONS" PANDOC_SCRIPT_FILE filePath -> do Lua.push filePath diff --git a/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs b/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs index 2cc39ee3a..b19c209e8 100644 --- a/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs +++ b/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -15,8 +16,10 @@ Marshaling instance for ReaderOptions and its components. module Text.Pandoc.Lua.Marshaling.ReaderOptions ( peekReaderOptions , pushReaderOptions + , pushReaderOptionsReadonly ) where +import Data.Default (def) import HsLua as Lua import Text.Pandoc.Lua.Marshaling.List (pushPandocList) import Text.Pandoc.Options (ReaderOptions (..)) @@ -25,47 +28,103 @@ 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 = peekUD typeReaderOptions +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 "pandoc ReaderOptions" - [ operation Tostring luaShow +typeReaderOptions = deftype "ReaderOptions" + [ operation Tostring $ lambda + ### liftPure show + <#> udparam typeReaderOptions "opts" "options to print in native format" + =#> functionResult pushString "string" "Haskell representation" ] - [ readonly "extensions" "" - ( pushString . show - , readerExtensions) - , readonly "standalone" "" - ( pushBool - , readerStandalone) - , readonly "columns" "" - ( pushIntegral - , readerColumns) - , readonly "tab_stop" "" - ( pushIntegral - , readerTabStop) - , readonly "indented_code_classes" "" - ( pushPandocList pushText - , readerIndentedCodeClasses) - , readonly "abbreviations" "" - ( pushSet pushText - , readerAbbreviations) - , readonly "track_changes" "" - ( pushString . show - , readerTrackChanges) - , readonly "strip_comments" "" - ( pushBool - , readerStripComments) - , readonly "default_image_extension" "" - ( pushText - , readerDefaultImageExtension) + 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 }) ] -luaShow :: LuaError e => DocumentedFunction e -luaShow = defun "__tostring" - ### liftPure show - <#> udparam typeReaderOptions "state" "object to print in native format" - =#> functionResult pushString "string" "Haskell representation" +-- | Retrieves a 'ReaderOptions' object from a table on the stack, using +-- the default values for all missing fields. +-- +-- Internally, this push the defaults 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 diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index 33432b4d8..8f42a2988 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -42,6 +42,8 @@ import Text.Pandoc.Lua.Marshaling.Attr (mkAttr, mkAttributeList) import Text.Pandoc.Lua.Marshaling.List (List (..)) import Text.Pandoc.Lua.Marshaling.ListAttributes ( mkListAttributes , peekListAttributes) +import Text.Pandoc.Lua.Marshaling.ReaderOptions ( peekReaderOptions + , pushReaderOptions) import Text.Pandoc.Lua.Marshaling.SimpleTable (mkSimpleTable) import Text.Pandoc.Lua.Module.Utils (sha1) import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, @@ -355,6 +357,12 @@ otherConstructors = , mkAttributeList , mkListAttributes , mkSimpleTable + + , defun "ReaderOptions" + ### liftPure id + <#> parameter peekReaderOptions "ReaderOptions|table" "opts" "reader options" + =#> functionResult pushReaderOptions "ReaderOptions" "new object" + #? "Creates a new ReaderOptions value." ] stringConstants :: [Field e] @@ -405,10 +413,12 @@ functions = =?> "output string, or error triple" , defun "read" - ### (\content mformatspec -> do + ### (\content mformatspec mreaderOptions -> do let formatSpec = fromMaybe "markdown" mformatspec + readerOptions = fromMaybe def mreaderOptions res <- Lua.liftIO . runIO $ getReader formatSpec >>= \case - (TextReader r, es) -> r def{ readerExtensions = es } content + (TextReader r, es) -> r readerOptions{ readerExtensions = es } + content _ -> throwError $ PandocSomeError "Only textual formats are supported" case res of @@ -422,6 +432,8 @@ functions = throwM e) <#> parameter peekText "string" "content" "text to parse" <#> optionalParameter peekText "string" "formatspec" "format and extensions" + <#> optionalParameter peekReaderOptions "ReaderOptions" "reader_options" + "reader options" =#> functionResult pushPandoc "Pandoc" "result document" , sha1 diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 4da663f07..5a58914ef 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -809,7 +809,25 @@ return { ) assert.are_same(expected_table, new_table) end) - } + }, + group 'ReaderOptions' { + test('returns a userdata value', function () + local opts = pandoc.ReaderOptions {} + assert.are_equal(type(opts), 'userdata') + end), + test('can construct from table', function () + local opts = pandoc.ReaderOptions {columns = 66} + assert.are_equal(opts.columns, 66) + end), + test('can construct from other ReaderOptions value', function () + local orig = pandoc.ReaderOptions{columns = 65} + local copy = pandoc.ReaderOptions(orig) + for k, v in pairs(orig) do + assert.are_same(copy[k], v) + end + assert.are_equal(copy.columns, 65) + end), + }, }, group 'clone' { @@ -896,6 +914,16 @@ return { 'Extension empty_paragraphs not supported for gfm' ) end), + test('read with other indented code classes', function() + local indented_code = ' return true' + local expected = pandoc.Pandoc({ + pandoc.CodeBlock('return true', {class='foo'}) + }) + assert.are_same( + expected, + pandoc.read(indented_code, 'markdown', {indented_code_classes={'foo'}}) + ) + end), test('failing read', function () assert.error_matches( function () pandoc.read('foo', 'nosuchreader') end, -- cgit v1.2.3 From d4c73d5e6536535015f953ba2e5c3b83979819af Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 9 Nov 2021 14:43:18 +0100 Subject: Lua: fix argument order in constructor `pandoc.Cite`. This restores the old behavior; argument order had been switched accidentally in pandoc 2.15. --- src/Text/Pandoc/Lua/Module/Pandoc.hs | 4 ++-- test/lua/module/pandoc.lua | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) (limited to 'test/lua') diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index 8f42a2988..a8b111092 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -135,9 +135,9 @@ pushWithConstructorsSubtable constructors = do inlineConstructors :: LuaError e => [DocumentedFunction e] inlineConstructors = [ defun "Cite" - ### liftPure2 Cite - <#> parameter (peekList peekCitation) "citations" "list of Citations" "" + ### liftPure2 (flip Cite) <#> parameter peekInlinesFuzzy "content" "Inline" "placeholder content" + <#> parameter (peekList peekCitation) "citations" "list of Citations" "" =#> functionResult pushInline "Inline" "cite element" , defun "Code" ### liftPure2 (\text mattr -> Code (fromMaybe nullAttr mattr) text) diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 5a58914ef..4f4a9b27e 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -151,17 +151,17 @@ return { group "Inline elements" { group 'Cite' { test('has property `content`', function () - local cite = pandoc.Cite({}, {pandoc.Emph 'important'}) + local cite = pandoc.Cite({pandoc.Emph 'important'}, {}) assert.are_same(cite.content, {pandoc.Emph {pandoc.Str 'important'}}) cite.content = 'boring' - assert.are_equal(cite, pandoc.Cite({}, {pandoc.Str 'boring'})) + assert.are_equal(cite, pandoc.Cite({pandoc.Str 'boring'}, {})) end), test('has list of citations in property `cite`', function () local citations = { pandoc.Citation('einstein1905', 'NormalCitation') } - local cite = pandoc.Cite(citations, 'relativity') + local cite = pandoc.Cite('relativity', citations) assert.are_same(cite.citations, citations) local new_citations = { @@ -169,7 +169,7 @@ return { pandoc.Citation('Poincaré1905', 'NormalCitation') } cite.citations = new_citations - assert.are_equal(cite, pandoc.Cite(new_citations, {'relativity'})) + assert.are_equal(cite, pandoc.Cite({'relativity'}, new_citations)) end), }, group 'Code' { -- cgit v1.2.3 From 0c0945b93c2ae502c0629d93e9ad520dbe17c625 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 23 Nov 2021 18:30:48 +0100 Subject: Lua: split strings into words when treating them as Inline list (#7712) Using a Lua string where a list of inlines is expected will cause the string to be split into words, replacing spaces and tabs into `pandoc.Space()` elements and newlines into `pandoc.SoftBreak()`. The previous behavior was to treat the string `s` as `{pandoc.Str(s)}`. The old behavior can be recovered by wrapping the string into a table `{s}`. --- src/Text/Pandoc/Lua/Marshaling/AST.hs | 11 +++++++---- test/lua/module/pandoc.lua | 28 ++++++++++++++++++++++++++-- 2 files changed, 33 insertions(+), 6 deletions(-) (limited to 'test/lua') diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 568b610cc..31d040c83 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -67,6 +67,7 @@ import Text.Pandoc.Lua.Marshaling.ListAttributes (peekListAttributes, pushListAttributes) import qualified HsLua as Lua +import qualified Text.Pandoc.Builder as B import qualified Text.Pandoc.Lua.Util as LuaUtil instance Pushable Pandoc where @@ -796,10 +797,12 @@ peekInlineFuzzy = retrieving "Inline" . choice -- | Try extra-hard to return the value at the given index as a list of -- inlines. peekInlinesFuzzy :: LuaError e => Peeker e [Inline] -peekInlinesFuzzy = choice - [ peekList peekInlineFuzzy - , fmap pure . peekInlineFuzzy - ] +peekInlinesFuzzy idx = liftLua (ltype idx) >>= \case + TypeString -> B.toList . B.text <$> peekText idx + _ -> choice + [ peekList peekInlineFuzzy + , fmap pure . peekInlineFuzzy + ] idx -- | Try extra hard to retrieve a Block value from the stack. Treats bar -- Inline elements as if they were wrapped in 'Plain'. diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 4f4a9b27e..b191bcb3c 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -480,7 +480,10 @@ return { assert.are_same(deflist.content[1][2][2], {pandoc.Plain{pandoc.Str 'company'}}) assert.are_same(deflist.content[2][2], - {{pandoc.Plain{pandoc.Str 'Best when hot.'}}}) + {{pandoc.Plain{ + pandoc.Str 'Best', pandoc.Space(), + pandoc.Str 'when', pandoc.Space(), + pandoc.Str 'hot.'}}}) end), test('modify items via property `content`', function () local deflist = pandoc.DefinitionList{ @@ -532,7 +535,7 @@ return { assert.are_same(header.content, {pandoc.Str 'test'}) header.content = {'new text'} - assert.are_equal(header, pandoc.Header(1, 'new text')) + assert.are_equal(header, pandoc.Header(1, {'new text'})) end), test('access Attr via property `attr`', function () local header = pandoc.Header(1, 'test', {'my-test'}) @@ -968,5 +971,26 @@ return { ) assert.are_equal('1234', table.concat(acc)) end) + }, + + group 'Marshal' { + group 'Inlines' { + test('Strings are broken into words', function () + assert.are_equal( + pandoc.Emph 'Nice, init?', + pandoc.Emph{pandoc.Str 'Nice,', pandoc.Space(), pandoc.Str 'init?'} + ) + end) + }, + group 'Blocks' { + test('Strings are broken into words and wrapped in Plain', function () + assert.are_equal( + pandoc.Div{ + pandoc.Plain{pandoc.Str 'Nice,', pandoc.Space(), pandoc.Str 'init?'} + }, + pandoc.Div{'Nice, init?'} + ) + end) + } } } -- cgit v1.2.3 From bffd74323cfd91f5c44ca34e09633247d1d28954 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 23 Nov 2021 18:32:53 +0100 Subject: Lua: add function `pandoc.utils.text` (#7710) The function converts a string to `Inlines`, treating interword spaces as `Space`s or `SoftBreak`s. If you want a `Str` with literal spaces, use `pandoc.Str`. Closes: #7709 --- doc/lua-filters.md | 18 ++++++++++++++++++ src/Text/Pandoc/Lua/Marshaling/AST.hs | 1 + src/Text/Pandoc/Lua/Module/Utils.hs | 12 ++++++++++-- test/lua/module/pandoc-utils.lua | 28 ++++++++++++++++++++++++++++ 4 files changed, 57 insertions(+), 2 deletions(-) (limited to 'test/lua') diff --git a/doc/lua-filters.md b/doc/lua-filters.md index 9fc90a13f..db5d1ccac 100644 --- a/doc/lua-filters.md +++ b/doc/lua-filters.md @@ -3082,6 +3082,24 @@ Usage: -- outputs "Moin" print(pandoc.utils.stringify(inline)) +### text {#pandoc.utils.text} + +`text (words)` + +Converts a string to `Inlines`, treating interword spaces as +`Space`s or `SoftBreak`s. If you want a single `Str` with literal +spaces, use `pandoc.Str`. + +Parameters: + +`words` +: markup-less text (string) + +Returns: + +- List of inline elements split into words (Inlines) + + ### to\_roman\_numeral {#pandoc.utils.to_roman_numeral} `to_roman_numeral (integer)` diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 31d040c83..9cf683055 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -44,6 +44,7 @@ module Text.Pandoc.Lua.Marshaling.AST , pushBlock , pushCitation , pushInline + , pushInlines , pushListAttributes , pushMeta , pushMetaValue diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 01ba4eb46..6fd707bf8 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -29,8 +29,8 @@ import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.Marshaling () import Text.Pandoc.Lua.Marshaling.AST - ( peekBlock, peekInline, peekPandoc, pushBlock, pushInline, pushPandoc - , peekAttr, peekMeta, peekMetaValue) + ( peekBlock, peekInline, peekPandoc, pushBlock, pushInline, pushInlines + , pushPandoc, peekAttr, peekMeta, peekMetaValue) import Text.Pandoc.Lua.Marshaling.ListAttributes (peekListAttributes) import Text.Pandoc.Lua.Marshaling.List (pushPandocList) import Text.Pandoc.Lua.Marshaling.SimpleTable @@ -122,6 +122,14 @@ documentedModule = Module <#> parameter peekAstElement "AST element" "elem" "some pandoc AST element" =#> functionResult pushText "string" "stringified element" + , defun "text" + ### liftPure (B.toList . B.text) + <#> parameter peekText "string" "words" "markup-less inlines text" + =#> functionResult pushInlines "Inlines" "list of inline elements" + #? ("Converts a string to `Inlines`, treating interword spaces as " <> + "`Space`s or `SoftBreak`s. If you want a `Str` with literal " <> + "spaces, use `pandoc.Str`.") + , defun "from_simple_table" ### from_simple_table <#> parameter peekSimpleTable "SimpleTable" "simple_tbl" "" diff --git a/test/lua/module/pandoc-utils.lua b/test/lua/module/pandoc-utils.lua index 9bd903f2d..21f550177 100644 --- a/test/lua/module/pandoc-utils.lua +++ b/test/lua/module/pandoc-utils.lua @@ -82,6 +82,34 @@ return { end) }, + group 'text' { + test('string is converted to inlines', function () + local expected = { + pandoc.Str 'Madness', pandoc.Space(), pandoc.Str '-', pandoc.Space(), + pandoc.Str 'Our', pandoc.Space(), pandoc.Str 'House' + } + assert.are_same(pandoc.utils.text('Madness - Our House'), expected) + end), + test('tabs are treated as space', function () + local expected = { + pandoc.Str 'Linkin', pandoc.Space(), pandoc.Str 'Park', pandoc.Space(), + pandoc.Str '-', pandoc.Space(), pandoc.Str 'Papercut' + } + assert.are_same(pandoc.utils.text('Linkin Park\t-\tPapercut'), expected) + end), + test('newlines are treated as softbreaks', function () + local expected = { + pandoc.Str 'Porcupine', pandoc.Space(), pandoc.Str 'Tree', + pandoc.SoftBreak(), pandoc.Str '-', pandoc.SoftBreak(), + pandoc.Str 'Blackest', pandoc.Space(), pandoc.Str 'Eyes' + } + assert.are_same( + pandoc.utils.text('Porcupine Tree\n-\nBlackest Eyes'), + expected + ) + end), + }, + group 'to_roman_numeral' { test('convertes number', function () assert.are_equal('MDCCCLXXXVIII', utils.to_roman_numeral(1888)) -- cgit v1.2.3 From a8638894ab698cc0e49757a2732e383b652834bc Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Wed, 24 Nov 2021 16:41:52 +0100 Subject: Lua: allow single elements as singleton MetaBlocks/MetaInlines Single elements should always be treated as singleton lists in the Lua subsystem. --- src/Text/Pandoc/Lua/Marshaling/AST.hs | 3 +++ test/lua/module/pandoc.lua | 20 +++++++++++++++++++- 2 files changed, 22 insertions(+), 1 deletion(-) (limited to 'test/lua') diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 9cf683055..6a0e5d077 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -247,6 +247,9 @@ peekMetaValue = retrieving "MetaValue $ " . \idx -> do optional (LuaUtil.getTag idx) >>= \case Just tag -> peekTagged tag Nothing -> peekUntagged + Lua.TypeUserdata -> -- Allow singleton Inline or Block elements + (MetaInlines . (:[]) <$!> peekInline idx) <|> + (MetaBlocks . (:[]) <$!> peekBlock idx) _ -> failPeek "could not get meta value" typeBlock :: LuaError e => DocumentedType e Block diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index b191bcb3c..2849eedbf 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -735,7 +735,25 @@ return { assert.are_equal((pandoc.MetaMap{}).tag, (pandoc.MetaMap{}).t) assert.are_equal((pandoc.MetaInlines{}).tag, (pandoc.MetaInlines{}).t) assert.are_equal((pandoc.MetaBlocks{}).tag, (pandoc.MetaBlocks{}).t) - end) + end), + }, + group 'Meta' { + test('inline list is treated as MetaInlines', function () + local meta = pandoc.Pandoc({}, {test = {pandoc.Emph 'check'}}).meta + assert.are_same(meta.test, {pandoc.Emph{pandoc.Str 'check'}}) + end), + test('inline element is treated as MetaInlines singleton', function () + local meta = pandoc.Pandoc({}, {test = pandoc.Emph 'check'}).meta + assert.are_same(meta.test, {pandoc.Emph{pandoc.Str 'check'}}) + end), + test('block list is treated as MetaBlocks', function () + local meta = pandoc.Pandoc({}, {test = {pandoc.Plain 'check'}}).meta + assert.are_same(meta.test, {pandoc.Plain{pandoc.Str 'check'}}) + end), + test('block element is treated as MetaBlocks singleton', function () + local meta = pandoc.Pandoc({}, {test = pandoc.Plain 'check'}).meta + assert.are_same(meta.test, {pandoc.Plain{pandoc.Str 'check'}}) + end), }, group 'Other types' { group 'Citation' { -- cgit v1.2.3 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. --- cabal.project | 5 + data/pandoc.List.lua | 142 ---- data/pandoc.lua | 247 ------- pandoc.cabal | 20 +- src/Text/Pandoc/Lua.hs | 2 +- src/Text/Pandoc/Lua/ErrorConversion.hs | 2 +- src/Text/Pandoc/Lua/Filter.hs | 13 +- src/Text/Pandoc/Lua/Global.hs | 6 +- src/Text/Pandoc/Lua/Init.hs | 50 +- 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 ++++ src/Text/Pandoc/Lua/Marshaling.hs | 19 - src/Text/Pandoc/Lua/Marshaling/AST.hs | 868 ----------------------- src/Text/Pandoc/Lua/Marshaling/Attr.hs | 237 ------- src/Text/Pandoc/Lua/Marshaling/CommonState.hs | 70 -- src/Text/Pandoc/Lua/Marshaling/Context.hs | 28 - src/Text/Pandoc/Lua/Marshaling/List.hs | 48 -- src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs | 72 -- src/Text/Pandoc/Lua/Marshaling/PandocError.hs | 51 -- src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs | 133 ---- src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs | 92 --- src/Text/Pandoc/Lua/Module/MediaBag.hs | 4 +- src/Text/Pandoc/Lua/Module/Pandoc.hs | 261 +------ src/Text/Pandoc/Lua/Module/Types.hs | 30 +- src/Text/Pandoc/Lua/Module/Utils.hs | 9 +- src/Text/Pandoc/Lua/Orphans.hs | 111 +++ src/Text/Pandoc/Lua/Packages.hs | 7 +- src/Text/Pandoc/Lua/PandocLua.hs | 25 +- src/Text/Pandoc/Lua/Util.hs | 31 +- src/Text/Pandoc/Lua/Walk.hs | 31 +- stack.yaml | 4 +- test/Tests/Lua.hs | 3 +- test/lua/module/pandoc.lua | 844 +++------------------- 35 files changed, 581 insertions(+), 3166 deletions(-) delete mode 100644 data/pandoc.List.lua delete mode 100644 data/pandoc.lua 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 delete mode 100644 src/Text/Pandoc/Lua/Marshaling.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/AST.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/Attr.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/CommonState.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/Context.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/List.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/PandocError.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs create mode 100644 src/Text/Pandoc/Lua/Orphans.hs (limited to 'test/lua') diff --git a/cabal.project b/cabal.project index 669dd74e2..7164f9978 100644 --- a/cabal.project +++ b/cabal.project @@ -3,6 +3,11 @@ tests: True flags: +embed_data_files constraints: aeson >= 2.0.1.0 +source-repository-package + type: git + location: https://github.com/tarleb/pandoc-lua-marshal.git + tag: 56387e543c48cc5518a77c2a271ff211653f2a36 + -- source-repository-package -- type: git -- location: https://github.com/jgm/texmath.git diff --git a/data/pandoc.List.lua b/data/pandoc.List.lua deleted file mode 100644 index b33c30876..000000000 --- a/data/pandoc.List.lua +++ /dev/null @@ -1,142 +0,0 @@ ---[[ -List.lua - -Copyright © 2017–2020 Albert Krewinkel - -Permission to use, copy, modify, and/or distribute this software for any -purpose with or without fee is hereby granted, provided that the above -copyright notice and this permission notice appear in all copies. - -THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ]] - ---- Pandoc's List type and helper methods --- @classmod pandoc.List --- @author Albert Krewinkel --- @copyright © 2017–2020 Albert Krewinkel --- @license MIT -local List = { - _VERSION = "1.0.0" -} - ---- Create a new list. --- @param[opt] o table that should be altered into a list (default: `{}`) --- @return the altered input table -function List:new (o) - o = o or {} - setmetatable(o, self) - self.__index = self - return o -end - ---- Concatenates two lists. --- @param list second list concatenated to the first --- @return a new list containing all elements from list1 and list2 -function List:__concat (list) - local res = List.clone(self) - List.extend(res, list) - return res -end - ---- Returns a (shallow) copy of the list. -function List:clone () - local lst = setmetatable({}, getmetatable(self)) - List.extend(lst, self) - return lst -end - ---- Adds the given list to the end of this list. --- @param list list to appended -function List:extend (list) - for i = 1, #list do - self[#self + 1] = list[i] - end -end - ---- Returns a new list containing all items satisfying a given condition. --- @param pred condition items must satisfy. --- @return a new list containing all items for which `test` was true. -function List:filter (pred) - local res = setmetatable({}, getmetatable(self)) - for i = 1, #self do - if pred(self[i], i) then - res[#res + 1] = self[i] - end - end - return res -end - ---- Returns the value and index of the first occurrence of the given item. --- @param needle item to search for --- @param[opt] init index at which the search is started (default: 1) --- @return first item equal to the needle, or nil if no such item exists. --- @return index of that element -function List:find (needle, init) - return List.find_if(self, function(x) return x == needle end, init) -end - ---- Returns the value and index of the first element for which the predicate ---- holds true. --- @param pred the predicate function --- @param[opt] init index at which the search is started (default: 1) --- @return first item for which `test` succeeds, or nil if no such item exists. --- @return index of that element -function List:find_if (pred, init) - init = (init == nil and 1) or (init < 0 and #self - init) or init - for i = init, #self do - if pred(self[i], i) then - return self[i], i - end - end - return nil -end - ---- Checks if the list has an item equal to the given needle. --- @param needle item to search for --- @param[opt] init index at which the search is started; defaults to 1. --- @return true if a list item is equal to the needle, false otherwise -function List:includes (needle, init) - return not (List.find(self, needle, init) == nil) -end - ---- Insert an element into the list. Alias for `table.insert`. --- @param list list --- @param[opt] pos position at which the new element is to be inserted --- @param value value to insert -List.insert = table.insert - ---- Returns a copy of the current list by applying the given function to --- all elements. --- @param fn function which is applied to all list items. -function List:map (fn) - local res = setmetatable({}, getmetatable(self)) - for i = 1, #self do - res[i] = fn(self[i], i) - end - return res -end - ---- Remove element from list (alias for `table.remove`) --- @param list list --- @param[opt] pos position of the element to be removed (default: #list) --- @return the removed element -List.remove = table.remove - ---- Sort list in-place (alias for `table.sort`) --- @param list list --- @param[opt] comp comparison function; default to `<` operator. -List.sort = table.sort - --- Set metatable with __call metamethod. This allows the use of `List` --- as a constructor function. -local ListMT = { - __call = List.new -} -setmetatable(List, ListMT) - -return List diff --git a/data/pandoc.lua b/data/pandoc.lua deleted file mode 100644 index 7e5ff799b..000000000 --- a/data/pandoc.lua +++ /dev/null @@ -1,247 +0,0 @@ ---[[ -pandoc.lua - -Copyright © 2017–2019 Albert Krewinkel - -Permission to use, copy, modify, and/or distribute this software for any purpose -with or without fee is hereby granted, provided that the above copyright notice -and this permission notice appear in all copies. - -THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH -REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND -FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, -INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS -OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER -TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF -THIS SOFTWARE. -]] - ---- --- Lua functions for pandoc scripts. --- --- @author Albert Krewinkel --- @copyright © 2017–2019 Albert Krewinkel --- @license MIT -local M = {} - --- Re-export bundled modules -M.List = require 'pandoc.List' -M.mediabag = require 'pandoc.mediabag' -M.path = require 'pandoc.path' -M.system = require 'pandoc.system' -M.types = require 'pandoc.types' -M.utils = require 'pandoc.utils' -M.text = require 'text' - --- Local names for modules which this module depends on. -local List = M.List -local utils = M.utils - - ------------------------------------------------------------------------- --- Accessor objects --- --- Create metatables which allow to access numerical indices via accessor --- methods. --- @section --- @local - ---- Create a new table which allows to access numerical indices via accessor --- functions. --- @local -local function create_accessor_behavior (tag) - local behavior = {tag = tag} - behavior.__eq = utils.equals - behavior.__index = function(t, k) - if k == "t" then - return getmetatable(t)["tag"] - end - return getmetatable(t)[k] - end - behavior.__pairs = function (t) - return next, t - end - return behavior -end - - ------------------------------------------------------------------------- --- The base class for types --- @type Type --- @local -local Type = {} -Type.name = 'Type' -Type.__index = Type -Type.behavior = { - __type = Type, - new = function (obj) - obj = obj or {} - setmetatable(obj, self) - return obj - end -} -Type.behavior.__index = Type.behavior - ---- Set a new behavior for the type, inheriting that of the parent type if none ---- is specified explicitly --- @param behavior the behavior object for this type. --- @local -function Type:set_behavior (behavior) - behavior = behavior or {} - behavior.__index = rawget(behavior, '__index') or behavior - behavior.__type = self - if not getmetatable(behavior) and getmetatable(self) then - setmetatable(behavior, getmetatable(self).behavior) - end - self.behavior = behavior -end - ---- Create a new subtype, using the given table as base. --- @param name name of the new type --- @param[opt] behavior behavioral object for the new type. --- @return a new type --- @local -function Type:make_subtype(name, behavior) - local newtype = setmetatable({}, self) - newtype.name = name - newtype.__index = newtype - newtype:set_behavior(behavior) - return newtype -end - - ------------------------------------------------------------------------- --- The base class for pandoc's AST elements. --- @type AstElement --- @local -local AstElement = Type:make_subtype 'AstElement' -AstElement.__call = function(t, ...) - local success, ret = pcall(t.new, t, ...) - if success then - return setmetatable(ret, t.behavior) - else - error(string.format('Constructor for %s failed: %s\n', t.name, ret)) - end -end - ---- Make a new subtype which constructs a new value when called. --- @local -function AstElement:make_subtype(...) - local newtype = Type.make_subtype(self, ...) - newtype.__call = self.__call - return newtype -end - ---- Create a new constructor --- @local --- @param tag Tag used to identify the constructor --- @param fn Function to be called when constructing a new element --- @param accessors names to use as accessors for numerical fields --- @return function that constructs a new element -function AstElement:create_constructor(tag, fn) - local constr = self:make_subtype(tag, create_accessor_behavior(tag)) - function constr:new(...) - return setmetatable(fn(...), self.behavior) - end - self.constructor = self.constructor or {} - self.constructor[tag] = constr - return constr -end - ---- Convert AstElement input into a list if necessary. --- @local -local function ensureList (x) - if x.tag then - -- Lists are not tagged, but all elements are - return List:new{x} - else - return List:new(x) - end -end - ---- Ensure a given object is an Inline element, or convert it into one. --- @local -local function ensureInlineList (x) - if type(x) == 'string' then - return List:new{M.Str(x)} - else - return ensureList(x) - end -end - ------------------------------------------------------------------------- --- Meta --- @section Meta - ---- Create a new Meta object. It sets the metatable of the given table to ---- `Meta`. --- @function Meta --- @tparam meta table table containing document meta information -M.Meta = AstElement:make_subtype'Meta' -M.Meta.behavior.clone = M.types.clone.Meta -function M.Meta:new (meta) return meta end - - ------------------------------------------------------------------------- --- MetaValue --- @section MetaValue -M.MetaValue = AstElement:make_subtype('MetaValue') -M.MetaValue.behavior.clone = M.types.clone.MetaValue - ---- Meta blocks --- @function MetaBlocks --- @tparam {Block,...} blocks blocks -M.MetaBlocks = M.MetaValue:create_constructor( - 'MetaBlocks', - function (content) return ensureList(content) end -) - ---- Meta inlines --- @function MetaInlines --- @tparam {Inline,...} inlines inlines -M.MetaInlines = M.MetaValue:create_constructor( - 'MetaInlines', - function (content) return ensureInlineList(content) end -) - ---- Meta list --- @function MetaList --- @tparam {MetaValue,...} meta_values list of meta values -M.MetaList = M.MetaValue:create_constructor( - 'MetaList', - function (content) - if content.tag == 'MetaList' then - return content - end - return ensureList(content) - end -) -for k, v in pairs(List) do - M.MetaList.behavior[k] = v -end - ---- Meta map --- @function MetaMap --- @tparam table key_value_map a string-indexed map of meta values -M.MetaMap = M.MetaValue:create_constructor( - "MetaMap", - function (mm) return mm end -) - ---- Creates string to be used in meta data. --- Does nothing, lua strings are meta strings. --- @function MetaString --- @tparam string str string value -function M.MetaString(str) - return str -end - ---- Creates boolean to be used in meta data. --- Does nothing, lua booleans are meta booleans. --- @function MetaBool --- @tparam boolean bool boolean value -function M.MetaBool(bool) - return bool -end - -return M diff --git a/pandoc.cabal b/pandoc.cabal index 99962ac4c..e7d1349fc 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -177,10 +177,6 @@ data-files: data/creole.lua -- lua init script data/init.lua - -- pandoc lua module - data/pandoc.lua - -- lua List module - data/pandoc.List.lua -- bash completion template data/bash_completion.tpl -- citeproc @@ -481,6 +477,7 @@ library mtl >= 2.2 && < 2.3, network >= 2.6, network-uri >= 2.6 && < 2.8, + pandoc-lua-marshal >= 0.1 && < 0.2, pandoc-types >= 1.22.1 && < 1.23, parsec >= 3.1 && < 3.2, pretty >= 1.1 && < 1.2, @@ -689,21 +686,16 @@ library Text.Pandoc.Lua.Filter, Text.Pandoc.Lua.Global, Text.Pandoc.Lua.Init, - Text.Pandoc.Lua.Marshaling, - Text.Pandoc.Lua.Marshaling.AST, - Text.Pandoc.Lua.Marshaling.Attr, - Text.Pandoc.Lua.Marshaling.CommonState, - Text.Pandoc.Lua.Marshaling.Context, - Text.Pandoc.Lua.Marshaling.List, - Text.Pandoc.Lua.Marshaling.ListAttributes, - Text.Pandoc.Lua.Marshaling.PandocError, - Text.Pandoc.Lua.Marshaling.ReaderOptions, - Text.Pandoc.Lua.Marshaling.SimpleTable, + Text.Pandoc.Lua.Marshal.CommonState, + Text.Pandoc.Lua.Marshal.Context, + Text.Pandoc.Lua.Marshal.PandocError, + Text.Pandoc.Lua.Marshal.ReaderOptions, Text.Pandoc.Lua.Module.MediaBag, Text.Pandoc.Lua.Module.Pandoc, Text.Pandoc.Lua.Module.System, Text.Pandoc.Lua.Module.Types, Text.Pandoc.Lua.Module.Utils, + Text.Pandoc.Lua.Orphans, Text.Pandoc.Lua.Packages, Text.Pandoc.Lua.PandocLua, Text.Pandoc.Lua.Util, diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs index f0e9e076b..2aa84b7fa 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -20,4 +20,4 @@ module Text.Pandoc.Lua import Text.Pandoc.Lua.Filter (runFilterFile) import Text.Pandoc.Lua.Global (Global (..), setGlobals) import Text.Pandoc.Lua.Init (runLua) -import Text.Pandoc.Lua.Marshaling () +import Text.Pandoc.Lua.Orphans () diff --git a/src/Text/Pandoc/Lua/ErrorConversion.hs b/src/Text/Pandoc/Lua/ErrorConversion.hs index 9c4c990a3..5cb1bf825 100644 --- a/src/Text/Pandoc/Lua/ErrorConversion.hs +++ b/src/Text/Pandoc/Lua/ErrorConversion.hs @@ -19,7 +19,7 @@ import HsLua (LuaError, LuaE, top) import HsLua.Marshalling (resultToEither, runPeek) import HsLua.Class.Peekable (PeekError (..)) import Text.Pandoc.Error (PandocError (PandocLuaError)) -import Text.Pandoc.Lua.Marshaling.PandocError (pushPandocError, peekPandocError) +import Text.Pandoc.Lua.Marshal.PandocError (pushPandocError, peekPandocError) import qualified Data.Text as T import qualified HsLua as Lua diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs index 9fd0ef32c..ba5a14a0d 100644 --- a/src/Text/Pandoc/Lua/Filter.hs +++ b/src/Text/Pandoc/Lua/Filter.hs @@ -33,10 +33,9 @@ import Data.String (IsString (fromString)) import HsLua as Lua import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.Marshaling.AST -import Text.Pandoc.Lua.Marshaling.List (List (..), peekList') -import Text.Pandoc.Lua.Walk (SingletonsList (..)) +import Text.Pandoc.Lua.Marshal.AST +import Text.Pandoc.Lua.Orphans () +import Text.Pandoc.Lua.Walk (List (..), SingletonsList (..)) import Text.Pandoc.Walk (Walkable (walkM)) import qualified Data.Map.Strict as Map @@ -196,7 +195,8 @@ walkInlineLists :: Walkable (List Inline) a => LuaFilter -> a -> LuaE PandocError a walkInlineLists lf = let f :: List Inline -> LuaE PandocError (List Inline) - f = runOnValue listOfInlinesFilterName (peekList' peekInline) lf + f = runOnValue listOfInlinesFilterName peekListOfInlines lf + peekListOfInlines idx = List <$!> (peekInlinesFuzzy idx) in if lf `contains` listOfInlinesFilterName then walkM f else return @@ -214,7 +214,8 @@ walkBlockLists :: Walkable (List Block) a => LuaFilter -> a -> LuaE PandocError a walkBlockLists lf = let f :: List Block -> LuaE PandocError (List Block) - f = runOnValue listOfBlocksFilterName (peekList' peekBlock) lf + f = runOnValue listOfBlocksFilterName peekListOfBlocks lf + peekListOfBlocks idx = List <$!> (peekBlocksFuzzy idx) in if lf `contains` listOfBlocksFilterName then walkM f else return diff --git a/src/Text/Pandoc/Lua/Global.hs b/src/Text/Pandoc/Lua/Global.hs index 05510f45d..c7b50a25f 100644 --- a/src/Text/Pandoc/Lua/Global.hs +++ b/src/Text/Pandoc/Lua/Global.hs @@ -20,9 +20,9 @@ import Paths_pandoc (version) import Text.Pandoc.Class.CommonState (CommonState) import Text.Pandoc.Definition (Pandoc (Pandoc), pandocTypesVersion) import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.Marshaling.CommonState (pushCommonState) -import Text.Pandoc.Lua.Marshaling.ReaderOptions (pushReaderOptionsReadonly) +import Text.Pandoc.Lua.Marshal.CommonState (pushCommonState) +import Text.Pandoc.Lua.Marshal.ReaderOptions (pushReaderOptionsReadonly) +import Text.Pandoc.Lua.Orphans () import Text.Pandoc.Options (ReaderOptions) import qualified Data.Text as Text diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs index 2f113bff2..835da1fc9 100644 --- a/src/Text/Pandoc/Lua/Init.hs +++ b/src/Text/Pandoc/Lua/Init.hs @@ -17,7 +17,6 @@ module Text.Pandoc.Lua.Init import Control.Monad (forM, forM_, when) import Control.Monad.Catch (throwM, try) import Control.Monad.Trans (MonadIO (..)) -import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr) import Data.Maybe (catMaybes) import HsLua as Lua hiding (status, try) import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8) @@ -27,7 +26,6 @@ import Text.Pandoc.Lua.Packages (installPandocPackageSearcher) import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, runPandocLua) import qualified Data.Text as T import qualified Lua.LPeg as LPeg -import qualified Text.Pandoc.Definition as Pandoc import qualified Text.Pandoc.Lua.Module.Pandoc as ModulePandoc -- | Run the lua interpreter, using pandoc's default way of environment @@ -42,6 +40,19 @@ runLua luaOp = do liftIO $ setForeignEncoding enc return res +-- | Modules that are loaded at startup and assigned to fields in the +-- pandoc module. +loadedModules :: [(Name, Name)] +loadedModules = + [ ("pandoc.List", "List") + , ("pandoc.mediabag", "mediabag") + , ("pandoc.path", "path") + , ("pandoc.system", "system") + , ("pandoc.types", "types") + , ("pandoc.utils", "utils") + , ("text", "text") + ] + -- | Initialize the lua state with all required values initLuaState :: PandocLua () initLuaState = do @@ -61,9 +72,13 @@ initLuaState = do Lua.getfield Lua.registryindex Lua.loaded Lua.pushvalue (Lua.nth 2) Lua.setfield (Lua.nth 2) "pandoc" - Lua.pop 1 - -- copy constructors into registry - putConstructorsInRegistry + Lua.pop 1 -- remove LOADED table + -- load modules and add them to the `pandoc` module table. + liftPandocLua $ forM_ loadedModules $ \(pkgname, fieldname) -> do + Lua.getglobal "require" + Lua.pushName pkgname + Lua.call 1 1 + Lua.setfield (nth 2) fieldname -- assign module to global variable liftPandocLua $ Lua.setglobal "pandoc" @@ -122,28 +137,3 @@ initLuaState = do Lua.pushHaskellFunction $ Lua.state >>= liftIO . LPeg.lpeg_searcher Lua.rawseti (Lua.nth 2) . (+1) . fromIntegral =<< Lua.rawlen (Lua.nth 2) Lua.pop 1 -- remove 'package.searchers' from stack - --- | AST elements are marshaled via normal constructor functions in the --- @pandoc@ module. However, accessing Lua globals from Haskell is --- expensive (due to error handling). Accessing the Lua registry is much --- cheaper, which is why the constructor functions are copied into the --- Lua registry and called from there. --- --- This function expects the @pandoc@ module to be at the top of the --- stack. -putConstructorsInRegistry :: PandocLua () -putConstructorsInRegistry = liftPandocLua $ do - constrsToReg $ Pandoc.Meta mempty - constrsToReg $ Pandoc.MetaList mempty - putInReg "List" -- pandoc.List - putInReg "SimpleTable" -- helper for backward-compatible table handling - where - constrsToReg :: Data a => a -> LuaE PandocError () - constrsToReg = mapM_ (putInReg . showConstr) . dataTypeConstrs . dataTypeOf - - putInReg :: String -> LuaE PandocError () - putInReg name = do - Lua.push ("pandoc." ++ name) -- name in registry - Lua.push name -- in pandoc module - Lua.rawget (Lua.nth 3) - Lua.rawset Lua.registryindex 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 diff --git a/src/Text/Pandoc/Lua/Marshaling.hs b/src/Text/Pandoc/Lua/Marshaling.hs deleted file mode 100644 index e217b8852..000000000 --- a/src/Text/Pandoc/Lua/Marshaling.hs +++ /dev/null @@ -1,19 +0,0 @@ -{- | - Module : Text.Pandoc.Lua.Marshaling - Copyright : © 2012-2021 John MacFarlane - © 2017-2021 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel - Stability : alpha - -Lua marshaling (pushing) and unmarshaling (peeking) instances. --} -module Text.Pandoc.Lua.Marshaling () where - -import Text.Pandoc.Lua.Marshaling.AST () -import Text.Pandoc.Lua.Marshaling.CommonState () -import Text.Pandoc.Lua.Marshaling.Context () -import Text.Pandoc.Lua.Marshaling.PandocError() -import Text.Pandoc.Lua.Marshaling.ReaderOptions () -import Text.Pandoc.Lua.ErrorConversion () diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs deleted file mode 100644 index 6a0e5d077..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ /dev/null @@ -1,868 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.AST - Copyright : © 2012-2021 John MacFarlane - © 2017-2021 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel - Stability : alpha - -Marshaling/unmarshaling instances for document AST elements. --} -module Text.Pandoc.Lua.Marshaling.AST - ( peekAttr - , peekBlock - , peekBlockFuzzy - , peekBlocks - , peekBlocksFuzzy - , peekCaption - , peekCitation - , peekColSpec - , peekDefinitionItem - , peekFormat - , peekInline - , peekInlineFuzzy - , peekInlines - , peekInlinesFuzzy - , peekMeta - , peekMetaValue - , peekPandoc - , peekMathType - , peekQuoteType - , peekTableBody - , peekTableHead - , peekTableFoot - - , pushAttr - , pushBlock - , pushCitation - , pushInline - , pushInlines - , pushListAttributes - , pushMeta - , pushMetaValue - , pushPandoc - ) where - -import Control.Applicative ((<|>), optional) -import Control.Monad.Catch (throwM) -import Control.Monad ((<$!>)) -import Data.Data (showConstr, toConstr) -import Data.Text (Text) -import Data.Version (Version) -import HsLua hiding (Operation (Div)) -import HsLua.Module.Version (peekVersionFuzzy) -import Text.Pandoc.Definition -import Text.Pandoc.Error (PandocError (PandocLuaError)) -import Text.Pandoc.Lua.Util (pushViaConstr') -import Text.Pandoc.Lua.Marshaling.Attr (peekAttr, pushAttr) -import Text.Pandoc.Lua.Marshaling.List (pushPandocList) -import Text.Pandoc.Lua.Marshaling.ListAttributes - (peekListAttributes, pushListAttributes) - -import qualified HsLua as Lua -import qualified Text.Pandoc.Builder as B -import qualified Text.Pandoc.Lua.Util as LuaUtil - -instance Pushable Pandoc where - push = pushPandoc - -pushPandoc :: LuaError e => Pusher e Pandoc -pushPandoc = pushUD typePandoc - -peekPandoc :: LuaError e => Peeker e Pandoc -peekPandoc = retrieving "Pandoc value" . peekUD typePandoc - -typePandoc :: LuaError e => DocumentedType e Pandoc -typePandoc = deftype "Pandoc" - [ operation Eq $ defun "__eq" - ### liftPure2 (==) - <#> parameter (optional . peekPandoc) "doc1" "pandoc" "" - <#> parameter (optional . peekPandoc) "doc2" "pandoc" "" - =#> functionResult pushBool "boolean" "true iff the two values are equal" - , operation Tostring $ lambda - ### liftPure show - <#> parameter peekPandoc "Pandoc" "doc" "" - =#> functionResult pushString "string" "native Haskell representation" - ] - [ property "blocks" "list of blocks" - (pushPandocList pushBlock, \(Pandoc _ blks) -> blks) - (peekList peekBlock, \(Pandoc m _) blks -> Pandoc m blks) - , property "meta" "document metadata" - (pushMeta, \(Pandoc meta _) -> meta) - (peekMeta, \(Pandoc _ blks) meta -> Pandoc meta blks) - ] - -instance Pushable Meta where - push = pushMeta - -pushMeta :: LuaError e => Pusher e Meta -pushMeta (Meta mmap) = pushViaConstr' "Meta" [push mmap] - -peekMeta :: LuaError e => Peeker e Meta -peekMeta idx = retrieving "Meta" $ - Meta <$!> peekMap peekText peekMetaValue idx - -instance Pushable MetaValue where - push = pushMetaValue - -instance Pushable Block where - push = pushBlock - -typeCitation :: LuaError e => DocumentedType e Citation -typeCitation = deftype "Citation" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> parameter (optional . peekCitation) "Citation" "a" "" - <#> parameter (optional . peekCitation) "Citation" "b" "" - =#> functionResult pushBool "boolean" "true iff the citations are equal" - - , operation Tostring $ lambda - ### liftPure show - <#> parameter peekCitation "Citation" "citation" "" - =#> functionResult pushString "string" "native Haskell representation" - ] - [ property "id" "citation ID / key" - (pushText, citationId) - (peekText, \citation cid -> citation{ citationId = cid }) - , property "mode" "citation mode" - (pushString . show, citationMode) - (peekRead, \citation mode -> citation{ citationMode = mode }) - , property "prefix" "citation prefix" - (pushInlines, citationPrefix) - (peekInlines, \citation prefix -> citation{ citationPrefix = prefix }) - , property "suffix" "citation suffix" - (pushInlines, citationSuffix) - (peekInlines, \citation suffix -> citation{ citationPrefix = suffix }) - , property "note_num" "note number" - (pushIntegral, citationNoteNum) - (peekIntegral, \citation noteNum -> citation{ citationNoteNum = noteNum }) - , property "hash" "hash number" - (pushIntegral, citationHash) - (peekIntegral, \citation hash -> citation{ citationHash = hash }) - , method $ defun "clone" ### return <#> udparam typeCitation "obj" "" - =#> functionResult pushCitation "Citation" "copy of obj" - ] - -pushCitation :: LuaError e => Pusher e Citation -pushCitation = pushUD typeCitation - -peekCitation :: LuaError e => Peeker e Citation -peekCitation = peekUD typeCitation - -instance Pushable Alignment where - push = Lua.pushString . show - -instance Pushable CitationMode where - push = Lua.push . show - -instance Pushable Format where - push = pushFormat - -pushFormat :: LuaError e => Pusher e Format -pushFormat (Format f) = pushText f - -peekFormat :: LuaError e => Peeker e Format -peekFormat idx = Format <$!> peekText idx - -instance Pushable ListNumberDelim where - push = Lua.push . show - -instance Pushable ListNumberStyle where - push = Lua.push . show - -instance Pushable MathType where - push = Lua.push . show - -instance Pushable QuoteType where - push = pushQuoteType - -pushMathType :: LuaError e => Pusher e MathType -pushMathType = pushString . show - -peekMathType :: LuaError e => Peeker e MathType -peekMathType = peekRead - -pushQuoteType :: LuaError e => Pusher e QuoteType -pushQuoteType = pushString . show - -peekQuoteType :: LuaError e => Peeker e QuoteType -peekQuoteType = peekRead - --- | Push an meta value element to the top of the lua stack. -pushMetaValue :: LuaError e => MetaValue -> LuaE e () -pushMetaValue = \case - MetaBlocks blcks -> pushViaConstr' "MetaBlocks" [pushList pushBlock blcks] - MetaBool bool -> Lua.push bool - MetaInlines inlns -> pushViaConstr' "MetaInlines" - [pushList pushInline inlns] - MetaList metalist -> pushViaConstr' "MetaList" - [pushList pushMetaValue metalist] - MetaMap metamap -> pushViaConstr' "MetaMap" - [pushMap pushText pushMetaValue metamap] - MetaString str -> Lua.push str - --- | Interpret the value at the given stack index as meta value. -peekMetaValue :: forall e. LuaError e => Peeker e MetaValue -peekMetaValue = retrieving "MetaValue $ " . \idx -> do - -- Get the contents of an AST element. - let mkMV :: (a -> MetaValue) -> Peeker e a -> Peek e MetaValue - mkMV f p = f <$!> p idx - - peekTagged = \case - "MetaBlocks" -> mkMV MetaBlocks $ - retrieving "MetaBlocks" . peekBlocks - "MetaBool" -> mkMV MetaBool $ - retrieving "MetaBool" . peekBool - "MetaMap" -> mkMV MetaMap $ - retrieving "MetaMap" . peekMap peekText peekMetaValue - "MetaInlines" -> mkMV MetaInlines $ - retrieving "MetaInlines" . peekInlines - "MetaList" -> mkMV MetaList $ - retrieving "MetaList" . peekList peekMetaValue - "MetaString" -> mkMV MetaString $ - retrieving "MetaString" . peekText - (Name t) -> failPeek ("Unknown meta tag: " <> t) - - peekUntagged = do - -- no meta value tag given, try to guess. - len <- liftLua $ Lua.rawlen idx - if len <= 0 - then MetaMap <$!> peekMap peekText peekMetaValue idx - else (MetaInlines <$!> peekInlines idx) - <|> (MetaBlocks <$!> peekBlocks idx) - <|> (MetaList <$!> peekList peekMetaValue idx) - luatype <- liftLua $ Lua.ltype idx - case luatype of - Lua.TypeBoolean -> MetaBool <$!> peekBool idx - Lua.TypeString -> MetaString <$!> peekText idx - Lua.TypeTable -> do - optional (LuaUtil.getTag idx) >>= \case - Just tag -> peekTagged tag - Nothing -> peekUntagged - Lua.TypeUserdata -> -- Allow singleton Inline or Block elements - (MetaInlines . (:[]) <$!> peekInline idx) <|> - (MetaBlocks . (:[]) <$!> peekBlock idx) - _ -> failPeek "could not get meta value" - -typeBlock :: LuaError e => DocumentedType e Block -typeBlock = deftype "Block" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> parameter peekBlockFuzzy "Block" "a" "" - <#> parameter peekBlockFuzzy "Block" "b" "" - =#> boolResult "whether the two values are equal" - , operation Tostring $ lambda - ### liftPure show - <#> udparam typeBlock "self" "" - =#> functionResult pushString "string" "Haskell representation" - ] - [ possibleProperty "attr" "element attributes" - (pushAttr, \case - CodeBlock attr _ -> Actual attr - Div attr _ -> Actual attr - Header _ attr _ -> Actual attr - Table attr _ _ _ _ _ -> Actual attr - _ -> Absent) - (peekAttr, \case - CodeBlock _ code -> Actual . flip CodeBlock code - Div _ blks -> Actual . flip Div blks - Header lvl _ blks -> Actual . (\attr -> Header lvl attr blks) - Table _ c cs h bs f -> Actual . (\attr -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "bodies" "table bodies" - (pushPandocList pushTableBody, \case - Table _ _ _ _ bs _ -> Actual bs - _ -> Absent) - (peekList peekTableBody, \case - Table attr c cs h _ f -> Actual . (\bs -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "caption" "element caption" - (pushCaption, \case {Table _ capt _ _ _ _ -> Actual capt; _ -> Absent}) - (peekCaption, \case - Table attr _ cs h bs f -> Actual . (\c -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "colspecs" "column alignments and widths" - (pushPandocList pushColSpec, \case - Table _ _ cs _ _ _ -> Actual cs - _ -> Absent) - (peekList peekColSpec, \case - Table attr c _ h bs f -> Actual . (\cs -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "content" "element content" - (pushContent, getBlockContent) - (peekContent, setBlockContent) - , possibleProperty "foot" "table foot" - (pushTableFoot, \case {Table _ _ _ _ _ f -> Actual f; _ -> Absent}) - (peekTableFoot, \case - Table attr c cs h bs _ -> Actual . (\f -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "format" "format of raw content" - (pushFormat, \case {RawBlock f _ -> Actual f; _ -> Absent}) - (peekFormat, \case - RawBlock _ txt -> Actual . (`RawBlock` txt) - _ -> const Absent) - , possibleProperty "head" "table head" - (pushTableHead, \case {Table _ _ _ h _ _ -> Actual h; _ -> Absent}) - (peekTableHead, \case - Table attr c cs _ bs f -> Actual . (\h -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "level" "heading level" - (pushIntegral, \case {Header lvl _ _ -> Actual lvl; _ -> Absent}) - (peekIntegral, \case - Header _ attr inlns -> Actual . \lvl -> Header lvl attr inlns - _ -> const Absent) - , possibleProperty "listAttributes" "ordered list attributes" - (pushListAttributes, \case - OrderedList listAttr _ -> Actual listAttr - _ -> Absent) - (peekListAttributes, \case - OrderedList _ content -> Actual . (`OrderedList` content) - _ -> const Absent) - , possibleProperty "text" "text contents" - (pushText, getBlockText) - (peekText, setBlockText) - - , readonly "tag" "type of Block" - (pushString, showConstr . toConstr ) - - , alias "t" "tag" ["tag"] - , alias "c" "content" ["content"] - , alias "identifier" "element identifier" ["attr", "identifier"] - , alias "classes" "element classes" ["attr", "classes"] - , alias "attributes" "other element attributes" ["attr", "attributes"] - , alias "start" "ordered list start number" ["listAttributes", "start"] - , alias "style" "ordered list style" ["listAttributes", "style"] - , alias "delimiter" "numbering delimiter" ["listAttributes", "delimiter"] - - , method $ defun "clone" - ### return - <#> parameter peekBlock "Block" "block" "self" - =#> functionResult pushBlock "Block" "cloned Block" - - , method $ defun "show" - ### liftPure show - <#> parameter peekBlock "Block" "self" "" - =#> functionResult pushString "string" "Haskell string representation" - ] - where - boolResult = functionResult pushBool "boolean" - -getBlockContent :: Block -> Possible Content -getBlockContent = \case - -- inline content - Para inlns -> Actual $ ContentInlines inlns - Plain inlns -> Actual $ ContentInlines inlns - Header _ _ inlns -> Actual $ ContentInlines inlns - -- inline content - BlockQuote blks -> Actual $ ContentBlocks blks - Div _ blks -> Actual $ ContentBlocks blks - -- lines content - LineBlock lns -> Actual $ ContentLines lns - -- list items content - BulletList itms -> Actual $ ContentListItems itms - OrderedList _ itms -> Actual $ ContentListItems itms - -- definition items content - DefinitionList itms -> Actual $ ContentDefItems itms - _ -> Absent - -setBlockContent :: Block -> Content -> Possible Block -setBlockContent = \case - -- inline content - Para _ -> Actual . Para . inlineContent - Plain _ -> Actual . Plain . inlineContent - Header attr lvl _ -> Actual . Header attr lvl . inlineContent - -- block content - BlockQuote _ -> Actual . BlockQuote . blockContent - Div attr _ -> Actual . Div attr . blockContent - -- lines content - LineBlock _ -> Actual . LineBlock . lineContent - -- list items content - BulletList _ -> Actual . BulletList . listItemContent - OrderedList la _ -> Actual . OrderedList la . listItemContent - -- definition items content - DefinitionList _ -> Actual . DefinitionList . defItemContent - _ -> const Absent - where - inlineContent = \case - ContentInlines inlns -> inlns - c -> throwM . PandocLuaError $ "expected Inlines, got " <> - contentTypeDescription c - blockContent = \case - ContentBlocks blks -> blks - ContentInlines inlns -> [Plain inlns] - c -> throwM . PandocLuaError $ "expected Blocks, got " <> - contentTypeDescription c - lineContent = \case - ContentLines lns -> lns - c -> throwM . PandocLuaError $ "expected list of lines, got " <> - contentTypeDescription c - defItemContent = \case - ContentDefItems itms -> itms - c -> throwM . PandocLuaError $ "expected definition items, got " <> - contentTypeDescription c - listItemContent = \case - ContentBlocks blks -> [blks] - ContentLines lns -> map ((:[]) . Plain) lns - ContentListItems itms -> itms - c -> throwM . PandocLuaError $ "expected list of items, got " <> - contentTypeDescription c - -getBlockText :: Block -> Possible Text -getBlockText = \case - CodeBlock _ lst -> Actual lst - RawBlock _ raw -> Actual raw - _ -> Absent - -setBlockText :: Block -> Text -> Possible Block -setBlockText = \case - CodeBlock attr _ -> Actual . CodeBlock attr - RawBlock f _ -> Actual . RawBlock f - _ -> const Absent - --- | Push a block element to the top of the Lua stack. -pushBlock :: forall e. LuaError e => Block -> LuaE e () -pushBlock = pushUD typeBlock - --- | Return the value at the given index as block if possible. -peekBlock :: forall e. LuaError e => Peeker e Block -peekBlock = retrieving "Block" . peekUD typeBlock - --- | Retrieves a list of Block elements. -peekBlocks :: LuaError e => Peeker e [Block] -peekBlocks = peekList peekBlock - -peekInlines :: LuaError e => Peeker e [Inline] -peekInlines = peekList peekInline - -pushInlines :: LuaError e => Pusher e [Inline] -pushInlines = pushPandocList pushInline - --- | Retrieves a single definition item from a the stack; it is expected --- to be a pair of a list of inlines and a list of list of blocks. Uses --- fuzzy parsing, i.e., tries hard to convert mismatching types into the --- expected result. -peekDefinitionItem :: LuaError e => Peeker e ([Inline], [[Block]]) -peekDefinitionItem = peekPair peekInlinesFuzzy $ choice - [ peekList peekBlocksFuzzy - , \idx -> (:[]) <$!> peekBlocksFuzzy idx - ] - --- | Push Caption element -pushCaption :: LuaError e => Caption -> LuaE e () -pushCaption (Caption shortCaption longCaption) = do - Lua.newtable - LuaUtil.addField "short" (Lua.Optional shortCaption) - LuaUtil.addField "long" longCaption - --- | Peek Caption element -peekCaption :: LuaError e => Peeker e Caption -peekCaption = retrieving "Caption" . \idx -> do - short <- optional $ peekFieldRaw peekInlines "short" idx - long <- peekFieldRaw peekBlocks "long" idx - return $! Caption short long - --- | Push a ColSpec value as a pair of Alignment and ColWidth. -pushColSpec :: LuaError e => Pusher e ColSpec -pushColSpec = pushPair (pushString . show) pushColWidth - --- | Peek a ColSpec value as a pair of Alignment and ColWidth. -peekColSpec :: LuaError e => Peeker e ColSpec -peekColSpec = peekPair peekRead peekColWidth - -peekColWidth :: LuaError e => Peeker e ColWidth -peekColWidth = retrieving "ColWidth" . \idx -> do - maybe ColWidthDefault ColWidth <$!> optional (peekRealFloat idx) - --- | Push a ColWidth value by pushing the width as a plain number, or --- @nil@ for ColWidthDefault. -pushColWidth :: LuaError e => Pusher e ColWidth -pushColWidth = \case - (ColWidth w) -> Lua.push w - ColWidthDefault -> Lua.pushnil - --- | Push a table row as a pair of attr and the list of cells. -pushRow :: LuaError e => Pusher e Row -pushRow (Row attr cells) = - pushPair pushAttr (pushPandocList pushCell) (attr, cells) - --- | Push a table row from a pair of attr and the list of cells. -peekRow :: LuaError e => Peeker e Row -peekRow = ((uncurry Row) <$!>) - . retrieving "Row" - . peekPair peekAttr (peekList peekCell) - --- | Pushes a 'TableBody' value as a Lua table with fields @attr@, --- @row_head_columns@, @head@, and @body@. -pushTableBody :: LuaError e => Pusher e TableBody -pushTableBody (TableBody attr (RowHeadColumns rowHeadColumns) head' body) = do - Lua.newtable - LuaUtil.addField "attr" attr - LuaUtil.addField "row_head_columns" rowHeadColumns - LuaUtil.addField "head" head' - LuaUtil.addField "body" body - --- | Retrieves a 'TableBody' value from a Lua table with fields @attr@, --- @row_head_columns@, @head@, and @body@. -peekTableBody :: LuaError e => Peeker e TableBody -peekTableBody = fmap (retrieving "TableBody") - . typeChecked "table" Lua.istable - $ \idx -> TableBody - <$!> peekFieldRaw peekAttr "attr" idx - <*> peekFieldRaw ((fmap RowHeadColumns) . peekIntegral) "row_head_columns" idx - <*> peekFieldRaw (peekList peekRow) "head" idx - <*> peekFieldRaw (peekList peekRow) "body" idx - --- | Push a table head value as the pair of its Attr and rows. -pushTableHead :: LuaError e => Pusher e TableHead -pushTableHead (TableHead attr rows) = - pushPair pushAttr (pushPandocList pushRow) (attr, rows) - --- | Peek a table head value from a pair of Attr and rows. -peekTableHead :: LuaError e => Peeker e TableHead -peekTableHead = ((uncurry TableHead) <$!>) - . retrieving "TableHead" - . peekPair peekAttr (peekList peekRow) - --- | Pushes a 'TableFoot' value as a pair of the Attr value and the list --- of table rows. -pushTableFoot :: LuaError e => Pusher e TableFoot -pushTableFoot (TableFoot attr rows) = - pushPair pushAttr (pushPandocList pushRow) (attr, rows) - --- | Retrieves a 'TableFoot' value from a pair containing an Attr value --- and a list of table rows. -peekTableFoot :: LuaError e => Peeker e TableFoot -peekTableFoot = ((uncurry TableFoot) <$!>) - . retrieving "TableFoot" - . peekPair peekAttr (peekList peekRow) - -instance Pushable Cell where - push = pushCell - -instance Peekable Cell where - peek = forcePeek . peekCell - --- | Push a table cell as a table with fields @attr@, @alignment@, --- @row_span@, @col_span@, and @contents@. -pushCell :: LuaError e => Cell -> LuaE e () -pushCell (Cell attr align (RowSpan rowSpan) (ColSpan colSpan) contents) = do - Lua.newtable - LuaUtil.addField "attr" attr - LuaUtil.addField "alignment" align - LuaUtil.addField "row_span" rowSpan - LuaUtil.addField "col_span" colSpan - LuaUtil.addField "contents" contents - -peekCell :: LuaError e => Peeker e Cell -peekCell = fmap (retrieving "Cell") - . typeChecked "table" Lua.istable - $ \idx -> do - attr <- peekFieldRaw peekAttr "attr" idx - algn <- peekFieldRaw peekRead "alignment" idx - rs <- RowSpan <$!> peekFieldRaw peekIntegral "row_span" idx - cs <- ColSpan <$!> peekFieldRaw peekIntegral "col_span" idx - blks <- peekFieldRaw peekBlocks "contents" idx - return $! Cell attr algn rs cs blks - -getInlineText :: Inline -> Possible Text -getInlineText = \case - Code _ lst -> Actual lst - Math _ str -> Actual str - RawInline _ raw -> Actual raw - Str s -> Actual s - _ -> Absent - -setInlineText :: Inline -> Text -> Possible Inline -setInlineText = \case - Code attr _ -> Actual . Code attr - Math mt _ -> Actual . Math mt - RawInline f _ -> Actual . RawInline f - Str _ -> Actual . Str - _ -> const Absent - --- | Helper type to represent all the different types a `content` --- attribute can have. -data Content - = ContentBlocks [Block] - | ContentInlines [Inline] - | ContentLines [[Inline]] - | ContentDefItems [([Inline], [[Block]])] - | ContentListItems [[Block]] - -contentTypeDescription :: Content -> Text -contentTypeDescription = \case - ContentBlocks {} -> "list of Block items" - ContentInlines {} -> "list of Inline items" - ContentLines {} -> "list of Inline lists (i.e., a list of lines)" - ContentDefItems {} -> "list of definition items items" - ContentListItems {} -> "list items (i.e., list of list of Block elements)" - -pushContent :: LuaError e => Pusher e Content -pushContent = \case - ContentBlocks blks -> pushPandocList pushBlock blks - ContentInlines inlns -> pushPandocList pushInline inlns - ContentLines lns -> pushPandocList (pushPandocList pushInline) lns - ContentDefItems itms -> - let pushItem = pushPair (pushPandocList pushInline) - (pushPandocList (pushPandocList pushBlock)) - in pushPandocList pushItem itms - ContentListItems itms -> - pushPandocList (pushPandocList pushBlock) itms - -peekContent :: LuaError e => Peeker e Content -peekContent idx = - (ContentInlines <$!> peekInlinesFuzzy idx) <|> - (ContentLines <$!> peekList (peekList peekInlineFuzzy) idx) <|> - (ContentBlocks <$!> peekBlocksFuzzy idx ) <|> - (ContentListItems <$!> peekList peekBlocksFuzzy idx) <|> - (ContentDefItems <$!> peekList (peekDefinitionItem) idx) - -setInlineContent :: Inline -> Content -> Possible Inline -setInlineContent = \case - -- inline content - Cite cs _ -> Actual . Cite cs . inlineContent - Emph _ -> Actual . Emph . inlineContent - Link a _ tgt -> Actual . (\inlns -> Link a inlns tgt) . inlineContent - Quoted qt _ -> Actual . Quoted qt . inlineContent - SmallCaps _ -> Actual . SmallCaps . inlineContent - Span attr _ -> Actual . Span attr . inlineContent - Strikeout _ -> Actual . Strikeout . inlineContent - Strong _ -> Actual . Strong . inlineContent - Subscript _ -> Actual . Subscript . inlineContent - Superscript _ -> Actual . Superscript . inlineContent - Underline _ -> Actual . Underline . inlineContent - -- block content - Note _ -> Actual . Note . blockContent - _ -> const Absent - where - inlineContent = \case - ContentInlines inlns -> inlns - c -> throwM . PandocLuaError $ "expected Inlines, got " <> - contentTypeDescription c - blockContent = \case - ContentBlocks blks -> blks - ContentInlines [] -> [] - c -> throwM . PandocLuaError $ "expected Blocks, got " <> - contentTypeDescription c - -getInlineContent :: Inline -> Possible Content -getInlineContent = \case - Cite _ inlns -> Actual $ ContentInlines inlns - Emph inlns -> Actual $ ContentInlines inlns - Link _ inlns _ -> Actual $ ContentInlines inlns - Quoted _ inlns -> Actual $ ContentInlines inlns - SmallCaps inlns -> Actual $ ContentInlines inlns - Span _ inlns -> Actual $ ContentInlines inlns - Strikeout inlns -> Actual $ ContentInlines inlns - Strong inlns -> Actual $ ContentInlines inlns - Subscript inlns -> Actual $ ContentInlines inlns - Superscript inlns -> Actual $ ContentInlines inlns - Underline inlns -> Actual $ ContentInlines inlns - Note blks -> Actual $ ContentBlocks blks - _ -> Absent - --- title -getInlineTitle :: Inline -> Possible Text -getInlineTitle = \case - Image _ _ (_, tit) -> Actual tit - Link _ _ (_, tit) -> Actual tit - _ -> Absent - -setInlineTitle :: Inline -> Text -> Possible Inline -setInlineTitle = \case - Image attr capt (src, _) -> Actual . Image attr capt . (src,) - Link attr capt (src, _) -> Actual . Link attr capt . (src,) - _ -> const Absent - --- attr -getInlineAttr :: Inline -> Possible Attr -getInlineAttr = \case - Code attr _ -> Actual attr - Image attr _ _ -> Actual attr - Link attr _ _ -> Actual attr - Span attr _ -> Actual attr - _ -> Absent - -setInlineAttr :: Inline -> Attr -> Possible Inline -setInlineAttr = \case - Code _ cs -> Actual . (`Code` cs) - Image _ cpt tgt -> Actual . \attr -> Image attr cpt tgt - Link _ cpt tgt -> Actual . \attr -> Link attr cpt tgt - Span _ inlns -> Actual . (`Span` inlns) - _ -> const Absent - -showInline :: LuaError e => DocumentedFunction e -showInline = defun "show" - ### liftPure (show @Inline) - <#> parameter peekInline "inline" "Inline" "Object" - =#> functionResult pushString "string" "stringified Inline" - -typeInline :: LuaError e => DocumentedType e Inline -typeInline = deftype "Inline" - [ operation Tostring showInline - , operation Eq $ defun "__eq" - ### liftPure2 (==) - <#> parameter peekInline "a" "Inline" "" - <#> parameter peekInline "b" "Inline" "" - =#> functionResult pushBool "boolean" "whether the two are equal" - ] - [ possibleProperty "attr" "element attributes" - (pushAttr, getInlineAttr) - (peekAttr, setInlineAttr) - , possibleProperty "caption" "image caption" - (pushPandocList pushInline, \case - Image _ capt _ -> Actual capt - _ -> Absent) - (peekInlinesFuzzy, \case - Image attr _ target -> Actual . (\capt -> Image attr capt target) - _ -> const Absent) - , possibleProperty "citations" "list of citations" - (pushPandocList pushCitation, \case {Cite cs _ -> Actual cs; _ -> Absent}) - (peekList peekCitation, \case - Cite _ inlns -> Actual . (`Cite` inlns) - _ -> const Absent) - , possibleProperty "content" "element contents" - (pushContent, getInlineContent) - (peekContent, setInlineContent) - , possibleProperty "format" "format of raw text" - (pushFormat, \case {RawInline fmt _ -> Actual fmt; _ -> Absent}) - (peekFormat, \case - RawInline _ txt -> Actual . (`RawInline` txt) - _ -> const Absent) - , possibleProperty "mathtype" "math rendering method" - (pushMathType, \case {Math mt _ -> Actual mt; _ -> Absent}) - (peekMathType, \case - Math _ txt -> Actual . (`Math` txt) - _ -> const Absent) - , possibleProperty "quotetype" "type of quotes (single or double)" - (pushQuoteType, \case {Quoted qt _ -> Actual qt; _ -> Absent}) - (peekQuoteType, \case - Quoted _ inlns -> Actual . (`Quoted` inlns) - _ -> const Absent) - , possibleProperty "src" "image source" - (pushText, \case - Image _ _ (src, _) -> Actual src - _ -> Absent) - (peekText, \case - Image attr capt (_, title) -> Actual . Image attr capt . (,title) - _ -> const Absent) - , possibleProperty "target" "link target URL" - (pushText, \case - Link _ _ (tgt, _) -> Actual tgt - _ -> Absent) - (peekText, \case - Link attr capt (_, title) -> Actual . Link attr capt . (,title) - _ -> const Absent) - , possibleProperty "title" "title text" - (pushText, getInlineTitle) - (peekText, setInlineTitle) - , possibleProperty "text" "text contents" - (pushText, getInlineText) - (peekText, setInlineText) - , readonly "tag" "type of Inline" - (pushString, showConstr . toConstr ) - - , alias "t" "tag" ["tag"] - , alias "c" "content" ["content"] - , alias "identifier" "element identifier" ["attr", "identifier"] - , alias "classes" "element classes" ["attr", "classes"] - , alias "attributes" "other element attributes" ["attr", "attributes"] - - , method $ defun "clone" - ### return - <#> parameter peekInline "inline" "Inline" "self" - =#> functionResult pushInline "Inline" "cloned Inline" - ] - --- | Push an inline element to the top of the lua stack. -pushInline :: forall e. LuaError e => Inline -> LuaE e () -pushInline = pushUD typeInline - --- | Return the value at the given index as inline if possible. -peekInline :: forall e. LuaError e => Peeker e Inline -peekInline = retrieving "Inline" . \idx -> peekUD typeInline idx - --- | Try extra hard to retrieve an Inline value from the stack. Treats --- bare strings as @Str@ values. -peekInlineFuzzy :: LuaError e => Peeker e Inline -peekInlineFuzzy = retrieving "Inline" . choice - [ peekUD typeInline - , \idx -> Str <$!> peekText idx - ] - --- | Try extra-hard to return the value at the given index as a list of --- inlines. -peekInlinesFuzzy :: LuaError e => Peeker e [Inline] -peekInlinesFuzzy idx = liftLua (ltype idx) >>= \case - TypeString -> B.toList . B.text <$> peekText idx - _ -> choice - [ peekList peekInlineFuzzy - , fmap pure . peekInlineFuzzy - ] idx - --- | Try extra hard to retrieve a Block value from the stack. Treats bar --- Inline elements as if they were wrapped in 'Plain'. -peekBlockFuzzy :: LuaError e => Peeker e Block -peekBlockFuzzy = choice - [ peekBlock - , (\idx -> Plain <$!> peekInlinesFuzzy idx) - ] - --- | Try extra-hard to return the value at the given index as a list of --- blocks. -peekBlocksFuzzy :: LuaError e => Peeker e [Block] -peekBlocksFuzzy = choice - [ peekList peekBlockFuzzy - , (<$!>) pure . peekBlockFuzzy - ] - --- * Orphan Instances - -instance Pushable Inline where - push = pushInline - -instance Pushable Citation where - push = pushCitation - -instance Pushable Row where - push = pushRow - -instance Pushable TableBody where - push = pushTableBody - -instance Pushable TableFoot where - push = pushTableFoot - -instance Pushable TableHead where - push = pushTableHead - --- These instances exist only for testing. It's a hack to avoid making --- the marshalling modules public. -instance Peekable Inline where - peek = forcePeek . peekInline - -instance Peekable Block where - peek = forcePeek . peekBlock - -instance Peekable Meta where - peek = forcePeek . peekMeta - -instance Peekable Pandoc where - peek = forcePeek . peekPandoc - -instance Peekable Row where - peek = forcePeek . peekRow - -instance Peekable Version where - peek = forcePeek . peekVersionFuzzy - -instance {-# OVERLAPPING #-} Peekable Attr where - peek = forcePeek . peekAttr diff --git a/src/Text/Pandoc/Lua/Marshaling/Attr.hs b/src/Text/Pandoc/Lua/Marshaling/Attr.hs deleted file mode 100644 index 97e702e35..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/Attr.hs +++ /dev/null @@ -1,237 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} -{- | -Module : Text.Pandoc.Lua.Marshaling.Attr -Copyright : © 2012-2021 John MacFarlane - © 2017-2021 Albert Krewinkel -License : GNU GPL, version 2 or above - -Maintainer : Albert Krewinkel -Stability : alpha - -Marshaling/unmarshaling instances for document AST elements. --} -module Text.Pandoc.Lua.Marshaling.Attr - ( typeAttr - , peekAttr - , pushAttr - , mkAttr - , mkAttributeList - ) where - -import Control.Applicative ((<|>), optional) -import Control.Monad ((<$!>)) -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import HsLua -import HsLua.Marshalling.Peekers (peekIndexRaw) -import Safe (atMay) -import Text.Pandoc.Definition (Attr, nullAttr) -import Text.Pandoc.Lua.Marshaling.List (pushPandocList) - -import qualified Data.Text as T - -typeAttr :: LuaError e => DocumentedType e Attr -typeAttr = deftype "Attr" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> parameter peekAttr "a1" "Attr" "" - <#> parameter peekAttr "a2" "Attr" "" - =#> functionResult pushBool "boolean" "whether the two are equal" - , operation Tostring $ lambda - ### liftPure show - <#> parameter peekAttr "Attr" "attr" "" - =#> functionResult pushString "string" "native Haskell representation" - ] - [ property "identifier" "element identifier" - (pushText, \(ident,_,_) -> ident) - (peekText, \(_,cls,kv) -> (,cls,kv)) - , property "classes" "element classes" - (pushPandocList pushText, \(_,classes,_) -> classes) - (peekList peekText, \(ident,_,kv) -> (ident,,kv)) - , property "attributes" "various element attributes" - (pushAttribs, \(_,_,attribs) -> attribs) - (peekAttribs, \(ident,cls,_) -> (ident,cls,)) - , method $ defun "clone" - ### return - <#> parameter peekAttr "attr" "Attr" "" - =#> functionResult pushAttr "Attr" "new Attr element" - , readonly "tag" "element type tag (always 'Attr')" - (pushText, const "Attr") - - , alias "t" "alias for `tag`" ["tag"] - ] - -pushAttr :: LuaError e => Pusher e Attr -pushAttr = pushUD typeAttr - -peekAttribs :: LuaError e => Peeker e [(Text,Text)] -peekAttribs idx = liftLua (ltype idx) >>= \case - TypeUserdata -> peekUD typeAttributeList idx - TypeTable -> liftLua (rawlen idx) >>= \case - 0 -> peekKeyValuePairs peekText peekText idx - _ -> peekList (peekPair peekText peekText) idx - _ -> failPeek "unsupported type" - -pushAttribs :: LuaError e => Pusher e [(Text, Text)] -pushAttribs = pushUD typeAttributeList - -typeAttributeList :: LuaError e => DocumentedType e [(Text, Text)] -typeAttributeList = deftype "AttributeList" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> parameter peekAttribs "a1" "AttributeList" "" - <#> parameter peekAttribs "a2" "AttributeList" "" - =#> functionResult pushBool "boolean" "whether the two are equal" - - , operation Index $ lambda - ### liftPure2 lookupKey - <#> udparam typeAttributeList "t" "attributes list" - <#> parameter peekKey "string|integer" "key" "lookup key" - =#> functionResult (maybe pushnil pushAttribute) "string|table" - "attribute value" - - , operation Newindex $ lambda - ### setKey - <#> udparam typeAttributeList "t" "attributes list" - <#> parameter peekKey "string|integer" "key" "lookup key" - <#> optionalParameter peekAttribute "string|nil" "value" "new value" - =#> [] - - , operation Len $ lambda - ### liftPure length - <#> udparam typeAttributeList "t" "attributes list" - =#> functionResult pushIntegral "integer" "number of attributes in list" - - , operation Pairs $ lambda - ### pushIterator (\(k, v) -> 2 <$ pushText k <* pushText v) - <#> udparam typeAttributeList "t" "attributes list" - =?> "iterator triple" - - , operation Tostring $ lambda - ### liftPure show - <#> udparam typeAttributeList "t" "attributes list" - =#> functionResult pushString "string" "" - ] - [] - -data Key = StringKey Text | IntKey Int - -peekKey :: LuaError e => Peeker e (Maybe Key) -peekKey idx = liftLua (ltype idx) >>= \case - TypeNumber -> Just . IntKey <$!> peekIntegral idx - TypeString -> Just . StringKey <$!> peekText idx - _ -> return Nothing - -data Attribute - = AttributePair (Text, Text) - | AttributeValue Text - -pushAttribute :: LuaError e => Pusher e Attribute -pushAttribute = \case - (AttributePair kv) -> pushPair pushText pushText kv - (AttributeValue v) -> pushText v - --- | Retrieve an 'Attribute'. -peekAttribute :: LuaError e => Peeker e Attribute -peekAttribute idx = (AttributeValue <$!> peekText idx) - <|> (AttributePair <$!> peekPair peekText peekText idx) - -lookupKey :: [(Text,Text)] -> Maybe Key -> Maybe Attribute -lookupKey !kvs = \case - Just (StringKey str) -> AttributeValue <$!> lookup str kvs - Just (IntKey n) -> AttributePair <$!> atMay kvs (n - 1) - Nothing -> Nothing - -setKey :: forall e. LuaError e - => [(Text, Text)] -> Maybe Key -> Maybe Attribute - -> LuaE e () -setKey kvs mbKey mbValue = case mbKey of - Just (StringKey str) -> - case break ((== str) . fst) kvs of - (prefix, _:suffix) -> case mbValue of - Nothing -> setNew $ prefix ++ suffix - Just (AttributeValue value) -> setNew $ prefix ++ (str, value):suffix - _ -> failLua "invalid attribute value" - _ -> case mbValue of - Nothing -> return () - Just (AttributeValue value) -> setNew (kvs ++ [(str, value)]) - _ -> failLua "invalid attribute value" - Just (IntKey idx) -> - case splitAt (idx - 1) kvs of - (prefix, (k,_):suffix) -> setNew $ case mbValue of - Nothing -> prefix ++ suffix - Just (AttributePair kv) -> prefix ++ kv : suffix - Just (AttributeValue v) -> prefix ++ (k, v) : suffix - (prefix, []) -> case mbValue of - Nothing -> setNew prefix - Just (AttributePair kv) -> setNew $ prefix ++ [kv] - _ -> failLua $ "trying to set an attribute key-value pair, " - ++ "but got a single string instead." - - _ -> failLua "invalid attribute key" - where - setNew :: [(Text, Text)] -> LuaE e () - setNew new = - putuserdata (nthBottom 1) (udName @e typeAttributeList) new >>= \case - True -> return () - False -> failLua "failed to modify attributes list" - -peekAttr :: LuaError e => Peeker e Attr -peekAttr idx = retrieving "Attr" $ liftLua (ltype idx) >>= \case - TypeString -> (,[],[]) <$!> peekText idx -- treat string as ID - TypeUserdata -> peekUD typeAttr idx - TypeTable -> peekAttrTable idx - x -> liftLua . failLua $ "Cannot get Attr from " ++ show x - --- | Helper function which gets an Attr from a Lua table. -peekAttrTable :: LuaError e => Peeker e Attr -peekAttrTable idx = do - len' <- liftLua $ rawlen idx - let peekClasses = peekList peekText - if len' > 0 - then do - ident <- peekIndexRaw 1 peekText idx - classes <- fromMaybe [] <$!> optional (peekIndexRaw 2 peekClasses idx) - attribs <- fromMaybe [] <$!> optional (peekIndexRaw 3 peekAttribs idx) - return $ ident `seq` classes `seq` attribs `seq` - (ident, classes, attribs) - else retrieving "HTML-like attributes" $ do - kvs <- peekKeyValuePairs peekText peekText idx - let ident = fromMaybe "" $ lookup "id" kvs - let classes = maybe [] T.words $ lookup "class" kvs - let attribs = filter ((`notElem` ["id", "class"]) . fst) kvs - return $ ident `seq` classes `seq` attribs `seq` - (ident, classes, attribs) - --- | Constructor for 'Attr'. -mkAttr :: LuaError e => DocumentedFunction e -mkAttr = defun "Attr" - ### (ltype (nthBottom 1) >>= \case - TypeString -> forcePeek $ do - mident <- optional (peekText (nthBottom 1)) - mclass <- optional (peekList peekText (nthBottom 2)) - mattribs <- optional (peekAttribs (nthBottom 3)) - return ( fromMaybe "" mident - , fromMaybe [] mclass - , fromMaybe [] mattribs) - TypeTable -> forcePeek $ peekAttrTable (nthBottom 1) - TypeUserdata -> forcePeek $ peekUD typeAttr (nthBottom 1) <|> do - attrList <- peekUD typeAttributeList (nthBottom 1) - return ("", [], attrList) - TypeNil -> pure nullAttr - TypeNone -> pure nullAttr - x -> failLua $ "Cannot create Attr from " ++ show x) - =#> functionResult pushAttr "Attr" "new Attr object" - --- | Constructor for 'AttributeList'. -mkAttributeList :: LuaError e => DocumentedFunction e -mkAttributeList = defun "AttributeList" - ### return - <#> parameter peekAttribs "table|AttributeList" "attribs" "an attribute list" - =#> functionResult (pushUD typeAttributeList) "AttributeList" - "new AttributeList object" diff --git a/src/Text/Pandoc/Lua/Marshaling/CommonState.hs b/src/Text/Pandoc/Lua/Marshaling/CommonState.hs deleted file mode 100644 index 857551598..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/CommonState.hs +++ /dev/null @@ -1,70 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.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.Marshaling.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.Marshaling.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/Marshaling/Context.hs b/src/Text/Pandoc/Lua/Marshaling/Context.hs deleted file mode 100644 index 8ee25565e..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/Context.hs +++ /dev/null @@ -1,28 +0,0 @@ -{-# 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.Marshaling.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/Marshaling/List.hs b/src/Text/Pandoc/Lua/Marshaling/List.hs deleted file mode 100644 index 0b145d3a1..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/List.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UndecidableInstances #-} -{- | -Module : Text.Pandoc.Lua.Marshaling.List -Copyright : © 2012-2021 John MacFarlane - © 2017-2021 Albert Krewinkel -License : GNU GPL, version 2 or above -Maintainer : Albert Krewinkel -Stability : alpha - -Marshaling/unmarshaling instances for @pandoc.List@s. --} -module Text.Pandoc.Lua.Marshaling.List - ( List (..) - , peekList' - , pushPandocList - ) where - -import Control.Monad ((<$!>)) -import Data.Data (Data) -import HsLua (LuaError, Peeker, Pusher, Pushable (push), peekList, pushList) -import Text.Pandoc.Walk (Walkable (..)) -import Text.Pandoc.Lua.Util (pushViaConstr') - --- | List wrapper which is marshalled as @pandoc.List@. -newtype List a = List { fromList :: [a] } - deriving (Data, Eq, Show) - -instance Pushable a => Pushable (List a) where - push (List xs) = pushPandocList push xs - --- | Pushes a list as a numerical Lua table, setting a metatable that offers a --- number of convenience functions. -pushPandocList :: LuaError e => Pusher e a -> Pusher e [a] -pushPandocList pushItem xs = pushViaConstr' "List" [pushList pushItem xs] - -peekList' :: LuaError e => Peeker e a -> Peeker e (List a) -peekList' p = (List <$!>) . peekList p - --- List is just a wrapper, so we can reuse the walk instance for --- unwrapped Hasekll lists. -instance Walkable [a] b => Walkable (List a) b where - walkM f = walkM (fmap fromList . f . List) - query f = query (f . List) diff --git a/src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs b/src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs deleted file mode 100644 index 5a6608644..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} -{- | -Module : Text.Pandoc.Lua.Marshaling.ListAttributes -Copyright : © 2021 Albert Krewinkel -License : GNU GPL, version 2 or above -Maintainer : Albert Krewinkel - -Marshaling/unmarshaling functions and constructor for 'ListAttributes' -values. --} -module Text.Pandoc.Lua.Marshaling.ListAttributes - ( typeListAttributes - , peekListAttributes - , pushListAttributes - , mkListAttributes - ) where - -import Data.Maybe (fromMaybe) -import HsLua -import Text.Pandoc.Definition ( ListAttributes, ListNumberStyle (DefaultStyle) - , ListNumberDelim (DefaultDelim)) - -typeListAttributes :: LuaError e => DocumentedType e ListAttributes -typeListAttributes = deftype "ListAttributes" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> parameter peekListAttributes "a" "ListAttributes" "" - <#> parameter peekListAttributes "b" "ListAttributes" "" - =#> functionResult pushBool "boolean" "whether the two are equal" - ] - [ property "start" "number of the first list item" - (pushIntegral, \(start,_,_) -> start) - (peekIntegral, \(_,style,delim) -> (,style,delim)) - , property "style" "style used for list numbering" - (pushString . show, \(_,classes,_) -> classes) - (peekRead, \(start,_,delim) -> (start,,delim)) - , property "delimiter" "delimiter of list numbers" - (pushString . show, \(_,_,delim) -> delim) - (peekRead, \(start,style,_) -> (start,style,)) - , method $ defun "clone" - ### return - <#> udparam typeListAttributes "a" "" - =#> functionResult (pushUD typeListAttributes) "ListAttributes" - "cloned ListAttributes value" - ] - --- | Pushes a 'ListAttributes' value as userdata object. -pushListAttributes :: LuaError e => Pusher e ListAttributes -pushListAttributes = pushUD typeListAttributes - --- | Retrieve a 'ListAttributes' triple, either from userdata or from a --- Lua tuple. -peekListAttributes :: LuaError e => Peeker e ListAttributes -peekListAttributes = retrieving "ListAttributes" . choice - [ peekUD typeListAttributes - , peekTriple peekIntegral peekRead peekRead - ] - --- | Constructor for a new 'ListAttributes' value. -mkListAttributes :: LuaError e => DocumentedFunction e -mkListAttributes = defun "ListAttributes" - ### liftPure3 (\mstart mstyle mdelim -> - ( fromMaybe 1 mstart - , fromMaybe DefaultStyle mstyle - , fromMaybe DefaultDelim mdelim - )) - <#> optionalParameter peekIntegral "integer" "start" "number of first item" - <#> optionalParameter peekRead "string" "style" "list numbering style" - <#> optionalParameter peekRead "string" "delimiter" "list number delimiter" - =#> functionResult pushListAttributes "ListAttributes" "new ListAttributes" - #? "Creates a new ListAttributes object." diff --git a/src/Text/Pandoc/Lua/Marshaling/PandocError.hs b/src/Text/Pandoc/Lua/Marshaling/PandocError.hs deleted file mode 100644 index 6f29a5c89..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/PandocError.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.PandocError - Copyright : © 2020-2021 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel - Stability : alpha - -Marshaling of @'PandocError'@ values. --} -module Text.Pandoc.Lua.Marshaling.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/Marshaling/ReaderOptions.hs b/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs deleted file mode 100644 index 91eb22ae9..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs +++ /dev/null @@ -1,133 +0,0 @@ -{-# 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.Marshaling.ReaderOptions - ( peekReaderOptions - , pushReaderOptions - , pushReaderOptionsReadonly - ) where - -import Data.Default (def) -import HsLua as Lua -import Text.Pandoc.Lua.Marshaling.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 diff --git a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs b/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs deleted file mode 100644 index 65f5aec8b..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs +++ /dev/null @@ -1,92 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.SimpleTable - Copyright : © 2020-2021 Albert Krewinkel - License : GNU GPL, version 2 or above - Maintainer : Albert Krewinkel - -Definition and marshaling of the 'SimpleTable' data type used as a -convenience type when dealing with tables. --} -module Text.Pandoc.Lua.Marshaling.SimpleTable - ( SimpleTable (..) - , peekSimpleTable - , pushSimpleTable - , mkSimpleTable - ) - where - -import HsLua as Lua -import Text.Pandoc.Definition -import Text.Pandoc.Lua.Marshaling.AST -import Text.Pandoc.Lua.Marshaling.List - --- | A simple (legacy-style) table. -data SimpleTable = SimpleTable - { simpleTableCaption :: [Inline] - , simpleTableAlignments :: [Alignment] - , simpleTableColumnWidths :: [Double] - , simpleTableHeader :: [[Block]] - , simpleTableBody :: [[[Block]]] - } deriving (Eq, Show) - -typeSimpleTable :: LuaError e => DocumentedType e SimpleTable -typeSimpleTable = deftype "SimpleTable" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> udparam typeSimpleTable "a" "" - <#> udparam typeSimpleTable "b" "" - =#> functionResult pushBool "boolean" "whether the two objects are equal" - , operation Tostring $ lambda - ### liftPure show - <#> udparam typeSimpleTable "self" "" - =#> functionResult pushString "string" "Haskell string representation" - ] - [ property "caption" "table caption" - (pushPandocList pushInline, simpleTableCaption) - (peekInlinesFuzzy, \t capt -> t {simpleTableCaption = capt}) - , property "aligns" "column alignments" - (pushPandocList (pushString . show), simpleTableAlignments) - (peekList peekRead, \t aligns -> t{simpleTableAlignments = aligns}) - , property "widths" "relative column widths" - (pushPandocList pushRealFloat, simpleTableColumnWidths) - (peekList peekRealFloat, \t ws -> t{simpleTableColumnWidths = ws}) - , property "headers" "table header" - (pushRow, simpleTableHeader) - (peekRow, \t h -> t{simpleTableHeader = h}) - , property "rows" "table body rows" - (pushPandocList pushRow, simpleTableBody) - (peekList peekRow, \t bs -> t{simpleTableBody = bs}) - - , readonly "t" "type tag (always 'SimpleTable')" - (pushText, const "SimpleTable") - - , alias "header" "alias for `headers`" ["headers"] - ] - where - pushRow = pushPandocList (pushPandocList pushBlock) - -peekRow :: LuaError e => Peeker e [[Block]] -peekRow = peekList peekBlocksFuzzy - --- | Push a simple table to the stack by calling the --- @pandoc.SimpleTable@ constructor. -pushSimpleTable :: forall e. LuaError e => SimpleTable -> LuaE e () -pushSimpleTable = pushUD typeSimpleTable - --- | Retrieve a simple table from the stack. -peekSimpleTable :: forall e. LuaError e => Peeker e SimpleTable -peekSimpleTable = retrieving "SimpleTable" . peekUD typeSimpleTable - --- | Constructor for the 'SimpleTable' type. -mkSimpleTable :: LuaError e => DocumentedFunction e -mkSimpleTable = defun "SimpleTable" - ### liftPure5 SimpleTable - <#> parameter peekInlinesFuzzy "Inlines" "caption" "table caption" - <#> parameter (peekList peekRead) "{Alignment,...}" "align" "column alignments" - <#> parameter (peekList peekRealFloat) "{number,...}" "widths" - "relative column widths" - <#> parameter peekRow "{Blocks,...}" "header" "table header row" - <#> parameter (peekList peekRow) "{{Blocks,...},...}" "body" "table body rows" - =#> functionResult pushSimpleTable "SimpleTable" "new SimpleTable object" diff --git a/src/Text/Pandoc/Lua/Module/MediaBag.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs index 6e595f9e4..fb055101e 100644 --- a/src/Text/Pandoc/Lua/Module/MediaBag.hs +++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs @@ -21,8 +21,8 @@ import Text.Pandoc.Class.CommonState (CommonState (..)) import Text.Pandoc.Class.PandocMonad (fetchItem, getMediaBag, modifyCommonState, setMediaBag) import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.Marshaling.List (pushPandocList) +import Text.Pandoc.Lua.Marshal.List (pushPandocList) +import Text.Pandoc.Lua.Orphans () import Text.Pandoc.Lua.PandocLua (unPandocLua) import Text.Pandoc.MIME (MimeType) diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index a8b111092..085d904cf 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -19,35 +19,28 @@ module Text.Pandoc.Lua.Module.Pandoc ) where import Prelude hiding (read) -import Control.Applicative ((<|>)) -import Control.Monad ((<$!>), forM_, when) +import Control.Monad (forM_, when) import Control.Monad.Catch (catch, throwM) import Control.Monad.Except (throwError) import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr) import Data.Default (Default (..)) import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (Proxy)) -import Data.Text (Text) -import HsLua hiding (Div, pushModule) +import HsLua hiding (pushModule) import HsLua.Class.Peekable (PeekError) import System.Exit (ExitCode (..)) import Text.Pandoc.Class.PandocIO (runIO) import Text.Pandoc.Definition -import Text.Pandoc.Lua.Filter (SingletonsList (..), LuaFilter, peekLuaFilter, +import Text.Pandoc.Lua.Filter (List (..), SingletonsList (..), LuaFilter, + peekLuaFilter, walkInlines, walkInlineLists, walkBlocks, walkBlockLists) -import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.Marshaling.AST -import Text.Pandoc.Lua.Marshaling.Attr (mkAttr, mkAttributeList) -import Text.Pandoc.Lua.Marshaling.List (List (..)) -import Text.Pandoc.Lua.Marshaling.ListAttributes ( mkListAttributes - , peekListAttributes) -import Text.Pandoc.Lua.Marshaling.ReaderOptions ( peekReaderOptions +import Text.Pandoc.Lua.Orphans () +import Text.Pandoc.Lua.Marshal.AST +import Text.Pandoc.Lua.Marshal.ReaderOptions ( peekReaderOptions , pushReaderOptions) -import Text.Pandoc.Lua.Marshaling.SimpleTable (mkSimpleTable) import Text.Pandoc.Lua.Module.Utils (sha1) -import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, - loadDefaultModule) +import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua) import Text.Pandoc.Options (ReaderOptions (readerExtensions)) import Text.Pandoc.Process (pipeProcess) import Text.Pandoc.Readers (Reader (..), getReader) @@ -65,21 +58,6 @@ import Text.Pandoc.Error pushModule :: PandocLua NumResults pushModule = do liftPandocLua $ Lua.pushModule documentedModule - loadDefaultModule "pandoc" - let copyNext = do - hasNext <- next (nth 2) - if not hasNext - then return () - else do - pushvalue (nth 2) - insert (nth 2) - rawset (nth 5) -- pandoc module - copyNext - liftPandocLua $ do - pushnil -- initial key - copyNext - pop 1 - return 1 documentedModule :: Module PandocError @@ -97,6 +75,7 @@ documentedModule = Module , otherConstructors , blockConstructors , inlineConstructors + , metaValueConstructors ] } @@ -132,229 +111,13 @@ pushWithConstructorsSubtable constructors = do rawset (nth 3) pop 1 -- pop constructor table -inlineConstructors :: LuaError e => [DocumentedFunction e] -inlineConstructors = - [ defun "Cite" - ### liftPure2 (flip Cite) - <#> parameter peekInlinesFuzzy "content" "Inline" "placeholder content" - <#> parameter (peekList peekCitation) "citations" "list of Citations" "" - =#> functionResult pushInline "Inline" "cite element" - , defun "Code" - ### liftPure2 (\text mattr -> Code (fromMaybe nullAttr mattr) text) - <#> parameter peekText "code" "string" "code string" - <#> optionalParameter peekAttr "attr" "Attr" "additional attributes" - =#> functionResult pushInline "Inline" "code element" - , mkInlinesConstr "Emph" Emph - , defun "Image" - ### liftPure4 (\caption src mtitle mattr -> - let attr = fromMaybe nullAttr mattr - title = fromMaybe mempty mtitle - in Image attr caption (src, title)) - <#> parameter peekInlinesFuzzy "Inlines" "caption" "image caption / alt" - <#> parameter peekText "string" "src" "path/URL of the image file" - <#> optionalParameter peekText "string" "title" "brief image description" - <#> optionalParameter peekAttr "Attr" "attr" "image attributes" - =#> functionResult pushInline "Inline" "image element" - , defun "LineBreak" - ### return LineBreak - =#> functionResult pushInline "Inline" "line break" - , defun "Link" - ### liftPure4 (\content target mtitle mattr -> - let attr = fromMaybe nullAttr mattr - title = fromMaybe mempty mtitle - in Link attr content (target, title)) - <#> parameter peekInlinesFuzzy "Inlines" "content" "text for this link" - <#> parameter peekText "string" "target" "the link target" - <#> optionalParameter peekText "string" "title" "brief link description" - <#> optionalParameter peekAttr "Attr" "attr" "link attributes" - =#> functionResult pushInline "Inline" "link element" - , defun "Math" - ### liftPure2 Math - <#> parameter peekMathType "quotetype" "Math" "rendering method" - <#> parameter peekText "text" "string" "math content" - =#> functionResult pushInline "Inline" "math element" - , defun "Note" - ### liftPure Note - <#> parameter peekBlocksFuzzy "content" "Blocks" "note content" - =#> functionResult pushInline "Inline" "note" - , defun "Quoted" - ### liftPure2 Quoted - <#> parameter peekQuoteType "quotetype" "QuoteType" "type of quotes" - <#> parameter peekInlinesFuzzy "content" "Inlines" "inlines in quotes" - =#> functionResult pushInline "Inline" "quoted element" - , defun "RawInline" - ### liftPure2 RawInline - <#> parameter peekFormat "format" "Format" "format of content" - <#> parameter peekText "text" "string" "string content" - =#> functionResult pushInline "Inline" "raw inline element" - , mkInlinesConstr "SmallCaps" SmallCaps - , defun "SoftBreak" - ### return SoftBreak - =#> functionResult pushInline "Inline" "soft break" - , defun "Space" - ### return Space - =#> functionResult pushInline "Inline" "new space" - , defun "Span" - ### liftPure2 (\inlns mattr -> Span (fromMaybe nullAttr mattr) inlns) - <#> parameter peekInlinesFuzzy "content" "Inlines" "inline content" - <#> optionalParameter peekAttr "attr" "Attr" "additional attributes" - =#> functionResult pushInline "Inline" "span element" - , defun "Str" - ### liftPure Str - <#> parameter peekText "text" "string" "" - =#> functionResult pushInline "Inline" "new Str object" - , mkInlinesConstr "Strong" Strong - , mkInlinesConstr "Strikeout" Strikeout - , mkInlinesConstr "Subscript" Subscript - , mkInlinesConstr "Superscript" Superscript - , mkInlinesConstr "Underline" Underline - ] - -blockConstructors :: LuaError e => [DocumentedFunction e] -blockConstructors = - [ defun "BlockQuote" - ### liftPure BlockQuote - <#> blocksParam - =#> blockResult "BlockQuote element" - - , defun "BulletList" - ### liftPure BulletList - <#> blockItemsParam "list items" - =#> blockResult "BulletList element" - - , defun "CodeBlock" - ### liftPure2 (\code mattr -> CodeBlock (fromMaybe nullAttr mattr) code) - <#> textParam "text" "code block content" - <#> optAttrParam - =#> blockResult "CodeBlock element" - - , defun "DefinitionList" - ### liftPure DefinitionList - <#> parameter (choice - [ peekList peekDefinitionItem - , \idx -> (:[]) <$!> peekDefinitionItem idx - ]) - "{{Inlines, {Blocks,...}},...}" - "content" "definition items" - =#> blockResult "DefinitionList element" - - , defun "Div" - ### liftPure2 (\content mattr -> Div (fromMaybe nullAttr mattr) content) - <#> blocksParam - <#> optAttrParam - =#> blockResult "Div element" - - , defun "Header" - ### liftPure3 (\lvl content mattr -> - Header lvl (fromMaybe nullAttr mattr) content) - <#> parameter peekIntegral "integer" "level" "heading level" - <#> parameter peekInlinesFuzzy "Inlines" "content" "inline content" - <#> optAttrParam - =#> blockResult "Header element" - - , defun "HorizontalRule" - ### return HorizontalRule - =#> blockResult "HorizontalRule element" - - , defun "LineBlock" - ### liftPure LineBlock - <#> parameter (peekList peekInlinesFuzzy) "{Inlines,...}" "content" "lines" - =#> blockResult "LineBlock element" - - , defun "Null" - ### return Null - =#> blockResult "Null element" - - , defun "OrderedList" - ### liftPure2 (\items mListAttrib -> - let defListAttrib = (1, DefaultStyle, DefaultDelim) - in OrderedList (fromMaybe defListAttrib mListAttrib) items) - <#> blockItemsParam "ordered list items" - <#> optionalParameter peekListAttributes "ListAttributes" "listAttributes" - "specifier for the list's numbering" - =#> blockResult "OrderedList element" - - , defun "Para" - ### liftPure Para - <#> parameter peekInlinesFuzzy "Inlines" "content" "paragraph content" - =#> blockResult "Para element" - - , defun "Plain" - ### liftPure Plain - <#> parameter peekInlinesFuzzy "Inlines" "content" "paragraph content" - =#> blockResult "Plain element" - - , defun "RawBlock" - ### liftPure2 RawBlock - <#> parameter peekFormat "Format" "format" "format of content" - <#> parameter peekText "string" "text" "raw content" - =#> blockResult "RawBlock element" - - , defun "Table" - ### (\capt colspecs thead tbodies tfoot mattr -> - let attr = fromMaybe nullAttr mattr - in return $! attr `seq` capt `seq` colspecs `seq` thead `seq` tbodies - `seq` tfoot `seq` Table attr capt colspecs thead tbodies tfoot) - <#> parameter peekCaption "Caption" "caption" "table caption" - <#> parameter (peekList peekColSpec) "{ColSpec,...}" "colspecs" - "column alignments and widths" - <#> parameter peekTableHead "TableHead" "head" "table head" - <#> parameter (peekList peekTableBody) "{TableBody,...}" "bodies" - "table bodies" - <#> parameter peekTableFoot "TableFoot" "foot" "table foot" - <#> optAttrParam - =#> blockResult "Table element" - ] - where - blockResult = functionResult pushBlock "Block" - blocksParam = parameter peekBlocksFuzzy "Blocks" "content" "block content" - blockItemsParam = parameter peekItemsFuzzy "List of Blocks" "content" - peekItemsFuzzy idx = peekList peekBlocksFuzzy idx - <|> ((:[]) <$!> peekBlocksFuzzy idx) - -textParam :: LuaError e => Text -> Text -> Parameter e Text -textParam = parameter peekText "string" - -optAttrParam :: LuaError e => Parameter e (Maybe Attr) -optAttrParam = optionalParameter peekAttr "attr" "Attr" "additional attributes" - -mkInlinesConstr :: LuaError e - => Name -> ([Inline] -> Inline) -> DocumentedFunction e -mkInlinesConstr name constr = defun name - ### liftPure (\x -> x `seq` constr x) - <#> parameter peekInlinesFuzzy "content" "Inlines" "" - =#> functionResult pushInline "Inline" "new object" - otherConstructors :: LuaError e => [DocumentedFunction e] otherConstructors = - [ defun "Pandoc" - ### liftPure2 (\blocks mMeta -> Pandoc (fromMaybe nullMeta mMeta) blocks) - <#> parameter peekBlocksFuzzy "Blocks" "blocks" "document contents" - <#> optionalParameter peekMeta "Meta" "meta" "document metadata" - =#> functionResult pushPandoc "Pandoc" "new Pandoc document" - - , defun "Citation" - ### (\cid mode mprefix msuffix mnote_num mhash -> - cid `seq` mode `seq` mprefix `seq` msuffix `seq` - mnote_num `seq` mhash `seq` return $! Citation - { citationId = cid - , citationMode = mode - , citationPrefix = fromMaybe mempty mprefix - , citationSuffix = fromMaybe mempty msuffix - , citationNoteNum = fromMaybe 0 mnote_num - , citationHash = fromMaybe 0 mhash - }) - <#> parameter peekText "string" "cid" "citation ID (e.g. bibtex key)" - <#> parameter peekRead "citation mode" "mode" "citation rendering mode" - <#> optionalParameter peekInlinesFuzzy "prefix" "Inlines" "" - <#> optionalParameter peekInlinesFuzzy "suffix" "Inlines" "" - <#> optionalParameter peekIntegral "note_num" "integer" "note number" - <#> optionalParameter peekIntegral "hash" "integer" "hash number" - =#> functionResult pushCitation "Citation" "new citation object" - #? "Creates a single citation." - + [ mkPandoc + , mkMeta , mkAttr , mkAttributeList + , mkCitation , mkListAttributes , mkSimpleTable diff --git a/src/Text/Pandoc/Lua/Module/Types.hs b/src/Text/Pandoc/Lua/Module/Types.hs index 4b37dafd9..f16737f63 100644 --- a/src/Text/Pandoc/Lua/Module/Types.hs +++ b/src/Text/Pandoc/Lua/Module/Types.hs @@ -13,14 +13,11 @@ module Text.Pandoc.Lua.Module.Types ( documentedModule ) where -import HsLua ( LuaE, NumResults, Peeker, Pusher, Module (..), Field (..) - , defun, functionResult, parameter, (###), (<#>), (=#>)) +import HsLua ( Module (..), (###), (<#>), (=#>) + , defun, functionResult, parameter) import HsLua.Module.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.ErrorConversion () -import Text.Pandoc.Lua.Marshaling.AST - -import qualified HsLua as Lua -- | Push the pandoc.types module on the Lua stack. documentedModule :: Module PandocError @@ -28,16 +25,7 @@ documentedModule = Module { moduleName = "pandoc.types" , moduleDescription = "Constructors for types that are not part of the pandoc AST." - , moduleFields = - [ Field - { fieldName = "clone" - , fieldDescription = "DEPRECATED! Helper functions for element cloning." - , fieldPushValue = do - Lua.newtable - addFunction "Meta" $ cloneWith peekMeta pushMeta - addFunction "MetaValue" $ cloneWith peekMetaValue pushMetaValue - } - ] + , moduleFields = [] , moduleFunctions = [ defun "Version" ### return @@ -52,15 +40,3 @@ documentedModule = Module ] , moduleOperations = [] } - where addFunction name fn = do - Lua.pushName name - Lua.pushHaskellFunction fn - Lua.rawset (Lua.nth 3) - -cloneWith :: Peeker PandocError a - -> Pusher PandocError a - -> LuaE PandocError NumResults -cloneWith peeker pusher = do - x <- Lua.forcePeek $ peeker (Lua.nthBottom 1) - pusher x - return (Lua.NumResults 1) diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 6fd707bf8..917f2e627 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -27,14 +27,7 @@ import HsLua.Class.Peekable (PeekError) import HsLua.Module.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.Marshaling.AST - ( peekBlock, peekInline, peekPandoc, pushBlock, pushInline, pushInlines - , pushPandoc, peekAttr, peekMeta, peekMetaValue) -import Text.Pandoc.Lua.Marshaling.ListAttributes (peekListAttributes) -import Text.Pandoc.Lua.Marshaling.List (pushPandocList) -import Text.Pandoc.Lua.Marshaling.SimpleTable - ( SimpleTable (..), peekSimpleTable, pushSimpleTable ) +import Text.Pandoc.Lua.Marshal.AST import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua)) import qualified Data.Digest.Pure.SHA as SHA diff --git a/src/Text/Pandoc/Lua/Orphans.hs b/src/Text/Pandoc/Lua/Orphans.hs new file mode 100644 index 000000000..eef05bd27 --- /dev/null +++ b/src/Text/Pandoc/Lua/Orphans.hs @@ -0,0 +1,111 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE FlexibleInstances #-} +{- | + Module : Text.Pandoc.Lua.Orphans + Copyright : © 2012-2021 John MacFarlane + © 2017-2021 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + Stability : alpha + +Orphan instances for Lua's Pushable and Peekable type classes. +-} +module Text.Pandoc.Lua.Orphans () where + +import Data.Version (Version) +import HsLua +import HsLua.Module.Version (peekVersionFuzzy) +import Text.Pandoc.Definition +import Text.Pandoc.Lua.Marshal.AST +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.ErrorConversion () + +instance Pushable Pandoc where + push = pushPandoc + +instance Pushable Meta where + push = pushMeta + +instance Pushable MetaValue where + push = pushMetaValue + +instance Pushable Block where + push = pushBlock + +instance {-# OVERLAPPING #-} Pushable [Block] where + push = pushBlocks + +instance Pushable Alignment where + push = pushString . show + +instance Pushable CitationMode where + push = pushCitationMode + +instance Pushable Format where + push = pushFormat + +instance Pushable ListNumberDelim where + push = pushString . show + +instance Pushable ListNumberStyle where + push = pushString . show + +instance Pushable MathType where + push = pushMathType + +instance Pushable QuoteType where + push = pushQuoteType + +instance Pushable Cell where + push = pushCell + +instance Peekable Cell where + peek = forcePeek . peekCell + +instance Pushable Inline where + push = pushInline + +instance {-# OVERLAPPING #-} Pushable [Inline] where + push = pushInlines + +instance Pushable Citation where + push = pushCitation + +instance Pushable Row where + push = pushRow + +instance Pushable TableBody where + push = pushTableBody + +instance Pushable TableFoot where + push = pushTableFoot + +instance Pushable TableHead where + push = pushTableHead + +-- These instances exist only for testing. It's a hack to avoid making +-- the marshalling modules public. +instance Peekable Inline where + peek = forcePeek . peekInline + +instance Peekable Block where + peek = forcePeek . peekBlock + +instance Peekable Meta where + peek = forcePeek . peekMeta + +instance Peekable Pandoc where + peek = forcePeek . peekPandoc + +instance Peekable Row where + peek = forcePeek . peekRow + +instance Peekable Version where + peek = forcePeek . peekVersionFuzzy + +instance {-# OVERLAPPING #-} Peekable Attr where + peek = forcePeek . peekAttr diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs index 3a481886a..c36c3c670 100644 --- a/src/Text/Pandoc/Lua/Packages.hs +++ b/src/Text/Pandoc/Lua/Packages.hs @@ -17,7 +17,8 @@ module Text.Pandoc.Lua.Packages import Control.Monad (forM_) import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, loadDefaultModule) +import Text.Pandoc.Lua.Marshal.List (pushListModule) +import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua) import qualified HsLua as Lua import qualified HsLua.Module.Path as Path @@ -45,7 +46,7 @@ installPandocPackageSearcher = liftPandocLua $ do pandocPackageSearcher :: String -> PandocLua Lua.NumResults pandocPackageSearcher pkgName = case pkgName of - "pandoc" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError Pandoc.pushModule + "pandoc" -> pushModuleLoader Pandoc.documentedModule "pandoc.mediabag" -> pushModuleLoader MediaBag.documentedModule "pandoc.path" -> pushModuleLoader Path.documentedModule "pandoc.system" -> pushModuleLoader System.documentedModule @@ -53,7 +54,7 @@ pandocPackageSearcher pkgName = "pandoc.utils" -> pushModuleLoader Utils.documentedModule "text" -> pushModuleLoader Text.documentedModule "pandoc.List" -> pushWrappedHsFun . Lua.toHaskellFunction @PandocError $ - loadDefaultModule pkgName + (Lua.NumResults 1 <$ pushListModule @PandocError) _ -> reportPandocSearcherFailure where pushModuleLoader mdl = liftPandocLua $ do diff --git a/src/Text/Pandoc/Lua/PandocLua.hs b/src/Text/Pandoc/Lua/PandocLua.hs index 6c2ebc622..71fdf8d5c 100644 --- a/src/Text/Pandoc/Lua/PandocLua.hs +++ b/src/Text/Pandoc/Lua/PandocLua.hs @@ -22,20 +22,18 @@ module Text.Pandoc.Lua.PandocLua ( PandocLua (..) , runPandocLua , liftPandocLua - , loadDefaultModule ) where import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow) import Control.Monad.Except (MonadError (catchError, throwError)) import Control.Monad.IO.Class (MonadIO) import HsLua as Lua -import Text.Pandoc.Class.PandocMonad (PandocMonad (..), readDefaultDataFile) -import Text.Pandoc.Error (PandocError (PandocLuaError)) +import Text.Pandoc.Class.PandocMonad (PandocMonad (..)) +import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.Global (Global (..), setGlobals) -import Text.Pandoc.Lua.Marshaling.CommonState (peekCommonState) +import Text.Pandoc.Lua.Marshal.CommonState (peekCommonState) import qualified Control.Monad.Catch as Catch -import qualified Data.Text as T import qualified Text.Pandoc.Class.IO as IO -- | Type providing access to both, pandoc and Lua operations. @@ -75,23 +73,6 @@ instance {-# OVERLAPPING #-} Exposable PandocError (PandocLua NumResults) where instance Pushable a => Exposable PandocError (PandocLua a) where partialApply _narg x = 1 <$ (unPandocLua x >>= Lua.push) --- | Load a pure Lua module included with pandoc. Leaves the result on --- the stack and returns @NumResults 1@. --- --- The script is loaded from the default data directory. We do not load --- from data directories supplied via command line, as this could cause --- scripts to be executed even though they had not been passed explicitly. -loadDefaultModule :: String -> PandocLua NumResults -loadDefaultModule name = do - script <- readDefaultDataFile (name <> ".lua") - result <- liftPandocLua $ Lua.dostring script - if result == Lua.OK - then return (1 :: NumResults) - else do - msg <- liftPandocLua Lua.popValue - let err = "Error while loading `" <> name <> "`.\n" <> msg - throwError $ PandocLuaError (T.pack err) - -- | Global variables which should always be set. defaultGlobals :: PandocMonad m => m [Global] defaultGlobals = do diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs index f35201db0..6d67d340d 100644 --- a/src/Text/Pandoc/Lua/Util.hs +++ b/src/Text/Pandoc/Lua/Util.hs @@ -1,9 +1,4 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Lua.Util Copyright : © 2012-2021 John MacFarlane, @@ -16,14 +11,12 @@ Lua utility functions. -} module Text.Pandoc.Lua.Util - ( getTag - , addField + ( addField , callWithTraceback , dofileWithTraceback - , pushViaConstr' ) where -import Control.Monad (unless, when) +import Control.Monad (when) import HsLua import qualified HsLua as Lua @@ -34,26 +27,6 @@ addField key value = do Lua.push value Lua.rawset (Lua.nth 3) --- | Get the tag of a value. This is an optimized and specialized version of --- @Lua.getfield idx "tag"@. It only checks for the field on the table at index --- @idx@ and on its metatable, also ignoring any @__index@ value on the --- metatable. -getTag :: LuaError e => Peeker e Name -getTag idx = do - -- push metatable or just the table - liftLua $ do - Lua.getmetatable idx >>= \hasMT -> unless hasMT (Lua.pushvalue idx) - Lua.pushName "tag" - Lua.rawget (Lua.nth 2) - Lua.peekName Lua.top `lastly` Lua.pop 2 -- table/metatable and `tag` field - -pushViaConstr' :: forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e () -pushViaConstr' fnname pushArgs = do - pushName @e ("pandoc." <> fnname) - rawget @e registryindex - sequence_ pushArgs - call @e (fromIntegral (length pushArgs)) 1 - -- | Like @'Lua.pcall'@, but uses a predefined error handler which adds a -- traceback on error. pcallWithTraceback :: LuaError e => NumArgs -> NumResults -> LuaE e Status diff --git a/src/Text/Pandoc/Lua/Walk.hs b/src/Text/Pandoc/Lua/Walk.hs index d6d973496..75ed1f471 100644 --- a/src/Text/Pandoc/Lua/Walk.hs +++ b/src/Text/Pandoc/Lua/Walk.hs @@ -1,7 +1,9 @@ -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE UndecidableInstances #-} {- | Module : Text.Pandoc.Lua.Walk Copyright : © 2012-2021 John MacFarlane, @@ -14,13 +16,18 @@ Walking documents in a filter-suitable way. -} module Text.Pandoc.Lua.Walk ( SingletonsList (..) + , List (..) ) where import Control.Monad ((<=<)) +import Data.Data (Data) +import HsLua (Pushable (push)) +import Text.Pandoc.Lua.Marshal.AST (pushBlocks, pushInlines) import Text.Pandoc.Definition import Text.Pandoc.Walk + -- | Helper type which allows to traverse trees in order, while splicing in -- trees. -- @@ -156,3 +163,21 @@ querySingletonsList :: (Monoid c, Walkable (SingletonsList a) a) querySingletonsList f = let f' x = f (SingletonsList [x]) `mappend` query f x in mconcat . map f' + + +-- | List wrapper where each list is processed as a whole, but special +-- pushed to Lua in type-dependent ways. +-- +-- The walk instance is basically that of unwrapped Haskell lists. +newtype List a = List { fromList :: [a] } + deriving (Data, Eq, Show) + +instance Pushable (List Block) where + push (List xs) = pushBlocks xs + +instance Pushable (List Inline) where + push (List xs) = pushInlines xs + +instance Walkable [a] b => Walkable (List a) b where + walkM f = walkM (fmap fromList . f . List) + query f = query (f . List) diff --git a/stack.yaml b/stack.yaml index c77ee622f..71c25c0be 100644 --- a/stack.yaml +++ b/stack.yaml @@ -23,7 +23,7 @@ extra-deps: - hslua-module-version-1.0.0 - hslua-objectorientation-2.0.1 - hslua-packaging-2.0.0 -- lua-2.0.1 +- lua-2.0.2 - tasty-hslua-1.0.0 - tasty-lua-1.0.0 - pandoc-types-1.22.1 @@ -33,6 +33,8 @@ extra-deps: - aeson-pretty-0.8.9 - ipynb-0.1.0.2 - texmath-0.12.3.3 +- git: https://github.com/tarleb/hslua-pandoc-types.git + commit: 56387e543c48cc5518a77c2a271ff211653f2a36 ghc-options: "$locals": -fhide-source-paths -Wno-missing-home-modules resolver: lts-18.10 diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs index 2070695e3..7ef21f933 100644 --- a/test/Tests/Lua.hs +++ b/test/Tests/Lua.hs @@ -238,7 +238,7 @@ tests = map (localOption (QuickCheckTests 20)) case eitherPandoc of Left (PandocLuaError msg) -> do let expectedMsg = "Pandoc expected, got boolean\n" - <> "\twhile retrieving Pandoc value" + <> "\twhile retrieving Pandoc" Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg Left e -> error ("Expected a Lua error, but got " <> show e) Right _ -> error "Getting a Pandoc element from a bool should fail." @@ -266,7 +266,6 @@ roundtripEqual x = (x ==) <$> roundtripped runLuaTest :: HasCallStack => Lua.LuaE PandocError a -> IO a runLuaTest op = runIOorExplode $ do - setUserDataDir (Just "../data") res <- runLua op case res of Left e -> error (show e) diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 2849eedbf..1cf777675 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -8,715 +8,124 @@ function os_is_windows () return package.config:sub(1,1) == '\\' end +-- Constructor behavior is tested in the hslua-pandoc-types module, so +-- we just make sure the functions are present. return { - group 'Attr' { - group 'Constructor' { + group 'Constructors' { + group 'Misc' { test('pandoc.Attr is a function', function () assert.are_equal(type(pandoc.Attr), 'function') end), - test('returns null-Attr if no arguments are given', function () - local attr = pandoc.Attr() - assert.are_equal(attr.identifier, '') - assert.are_same(attr.classes, {}) - assert.are_same(#attr.attributes, 0) - end), - test( - 'accepts string-indexed table or list of pairs as attributes', - function () - local attributes_list = {{'one', '1'}, {'two', '2'}} - local attr_from_list = pandoc.Attr('', {}, attributes_list) - - assert.are_equal(attr_from_list.attributes.one, '1') - assert.are_equal(attr_from_list.attributes.two, '2') - - local attributes_table = {one = '1', two = '2'} - local attr_from_table = pandoc.Attr('', {}, attributes_table) - assert.are_equal( - attr_from_table.attributes, - pandoc.AttributeList(attributes_table) - ) - assert.are_equal(attr_from_table.attributes.one, '1') - assert.are_equal(attr_from_table.attributes.two, '2') - end - ) - }, - group 'Properties' { - test('has t and tag property', function () - local attr = pandoc.Attr('') - assert.are_equal(attr.t, 'Attr') - assert.are_equal(attr.tag, 'Attr') - end) - }, - group 'AttributeList' { - test('allows access via fields', function () - local attributes = pandoc.Attr('', {}, {{'a', '1'}, {'b', '2'}}).attributes - assert.are_equal(attributes.a, '1') - assert.are_equal(attributes.b, '2') - end), - test('allows access to pairs via numerical indexing', function () - local attributes = pandoc.Attr('', {}, {{'a', '1'}, {'b', '2'}}).attributes - assert.are_same(attributes[1], {'a', '1'}) - assert.are_same(attributes[2], {'b', '2'}) - end), - test('allows replacing a pair', function () - local attributes = pandoc.AttributeList{{'a', '1'}, {'b', '2'}} - attributes[1] = {'t','five'} - assert.are_same(attributes[1], {'t', 'five'}) - assert.are_same(attributes[2], {'b', '2'}) - end), - test('allows to remove a pair', function () - local attributes = pandoc.AttributeList{{'a', '1'}, {'b', '2'}} - attributes[1] = nil - assert.are_equal(#attributes, 1) - end), - test('adds entries by field name', function () - local attributes = pandoc.Attr('',{}, {{'c', '1'}, {'d', '2'}}).attributes - attributes.e = '3' - assert.are_same( - attributes, - -- checking the full AttributeList would "duplicate" entries - pandoc.AttributeList{{'c', '1'}, {'d', '2'}, {'e', '3'}} - ) + test('pandoc.AttributeList is a function', function () + assert.are_equal(type(pandoc.AttributeList), 'function') end), - test('deletes entries by field name', function () - local attributes = pandoc.Attr('',{}, {a = '1', b = '2'}).attributes - attributes.a = nil - assert.is_nil(attributes.a) - assert.are_same(attributes, pandoc.AttributeList{{'b', '2'}}) - end), - test('remains unchanged if deleted key did not exist', function () - local assoc_list = pandoc.List:new {{'alpha', 'x'}, {'beta', 'y'}} - local attributes = pandoc.Attr('', {}, assoc_list).attributes - attributes.a = nil - local new_assoc_list = pandoc.List() - for k, v in pairs(attributes) do - new_assoc_list:insert({k, v}) - end - assert.are_same(new_assoc_list, assoc_list) - end), - test('gives key-value pairs when iterated-over', function () - local attributes = {width = '11', height = '22', name = 'test'} - local attr = pandoc.Attr('', {}, attributes) - local count = 0 - for k, v in pairs(attr.attributes) do - assert.are_equal(attributes[k], v) - count = count + 1 - end - assert.are_equal(count, 3) - end) - }, - group 'HTML-like attribute tables' { - test('in element constructor', function () - local html_attributes = { - id = 'the-id', - class = 'class1 class2', - width = '11', - height = '12' - } - local attr = pandoc.Span('test', html_attributes).attr - assert.are_equal(attr.identifier, 'the-id') - assert.are_equal(attr.classes[1], 'class1') - assert.are_equal(attr.classes[2], 'class2') - assert.are_equal(attr.attributes.width, '11') - assert.are_equal(attr.attributes.height, '12') - end), - test('element attr setter', function () - local html_attributes = { - id = 'the-id', - class = 'class1 class2', - width = "11", - height = "12" - } - local span = pandoc.Span 'test' - span.attr = html_attributes - span = span:clone() -- normalize - assert.are_equal(span.attr.identifier, 'the-id') - assert.are_equal(span.attr.classes[1], 'class1') - assert.are_equal(span.attr.classes[2], 'class2') - assert.are_equal(span.attr.attributes.width, '11') - assert.are_equal(span.attr.attributes.height, '12') - end), - test('element attrbutes setter', function () - local attributes = { - width = "11", - height = "12" - } - local span = pandoc.Span 'test' - span.attributes = attributes - assert.are_equal(span.attr.attributes.width, '11') - assert.are_equal(span.attr.attributes.height, '12') - end) - } - }, - group "Inline elements" { - group 'Cite' { - test('has property `content`', function () - local cite = pandoc.Cite({pandoc.Emph 'important'}, {}) - assert.are_same(cite.content, {pandoc.Emph {pandoc.Str 'important'}}) - - cite.content = 'boring' - assert.are_equal(cite, pandoc.Cite({pandoc.Str 'boring'}, {})) - end), - test('has list of citations in property `cite`', function () - local citations = { - pandoc.Citation('einstein1905', 'NormalCitation') - } - local cite = pandoc.Cite('relativity', citations) - assert.are_same(cite.citations, citations) - - local new_citations = { - citations[1], - pandoc.Citation('Poincaré1905', 'NormalCitation') - } - cite.citations = new_citations - assert.are_equal(cite, pandoc.Cite({'relativity'}, new_citations)) + test('pandoc.Citation is a function', function () + assert.are_equal(type(pandoc.Citation), 'function') end), - }, - group 'Code' { - test('has property `attr`', function () - local code = pandoc.Code('true', {id='true', foo='bar'}) - assert.are_equal(code.attr, pandoc.Attr('true', {}, {{'foo', 'bar'}})) - - code.attr = {id='t', fubar='quux'} - assert.are_equal( - pandoc.Code('true', pandoc.Attr('t', {}, {{'fubar', 'quux'}})), - code - ) + test('pandoc.SimpleTable is a function', function () + assert.are_equal(type(pandoc.SimpleTable), 'function') end), - test('has property `text`', function () - local code = pandoc.Code('true') - assert.are_equal(code.text, 'true') - - code.text = '1 + 1' - assert.are_equal(pandoc.Code('1 + 1'), code) + test('pandoc.Meta is a function', function () + assert.are_equal(type(pandoc.Meta), 'function') + end), + test('pandoc.Pandoc is a function', function () + assert.are_equal(type(pandoc.Pandoc), 'function') end), }, - group 'Emph' { - test('has property `content`', function () - local elem = pandoc.Emph{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Emph{'word'}) - end) - }, - group 'Image' { - test('has property `caption`', function () - local img = pandoc.Image('example', 'a.png') - assert.are_same(img.caption, {pandoc.Str 'example'}) - - img.caption = 'A' - assert.are_equal(img, pandoc.Image({'A'}, 'a.png')) + group "Inline elements" { + test('pandoc.AttributeList is a function', function () + assert.are_equal(type(pandoc.Cite), 'function') end), - test('has property `src`', function () - local img = pandoc.Image('example', 'sample.png') - assert.are_same(img.src, 'sample.png') - - img.src = 'example.svg' - assert.are_equal(img, pandoc.Image('example', 'example.svg')) + test('pandoc.AttributeList is a function', function () + assert.are_equal(type(pandoc.Code), 'function') end), - test('has property `title`', function () - local img = pandoc.Image('here', 'img.gif', 'example') - assert.are_same(img.title, 'example') - - img.title = 'a' - assert.are_equal(img, pandoc.Image('here', 'img.gif', 'a')) + test('pandoc.Emph is a function', function () + assert.are_equal(type(pandoc.Emph), 'function') end), - test('has property `attr`', function () - local img = pandoc.Image('up', 'upwards.png', '', {'up', {'point'}}) - assert.are_same(img.attr, pandoc.Attr {'up', {'point'}}) - - img.attr = pandoc.Attr {'up', {'point', 'button'}} - assert.are_equal( - pandoc.Image('up', 'upwards.png', nil, {'up', {'point', 'button'}}), - img - ) - end) - }, - group 'Link' { - test('has property `content`', function () - local link = pandoc.Link('example', 'https://example.org') - assert.are_same(link.content, {pandoc.Str 'example'}) - - link.content = 'commercial' - link.target = 'https://example.com' - assert.are_equal(link, pandoc.Link('commercial', 'https://example.com')) + test('pandoc.Image is a function', function () + assert.are_equal(type(pandoc.Image), 'function') end), - test('has property `target`', function () - local link = pandoc.Link('example', 'https://example.org') - assert.are_same(link.content, {pandoc.Str 'example'}) - - link.target = 'https://example.com' - assert.are_equal(link, pandoc.Link('example', 'https://example.com')) + test('pandoc.Link is a function', function () + assert.are_equal(type(pandoc.Link), 'function') end), - test('has property `title`', function () - local link = pandoc.Link('here', 'https://example.org', 'example') - assert.are_same(link.title, 'example') - - link.title = 'a' - assert.are_equal(link, pandoc.Link('here', 'https://example.org', 'a')) + test('pandoc.Math is a function', function () + assert.are_equal(type(pandoc.Math), 'function') end), - test('has property `attr`', function () - local link = pandoc.Link('up', '../index.html', '', {'up', {'nav'}}) - assert.are_same(link.attr, pandoc.Attr {'up', {'nav'}}) - - link.attr = pandoc.Attr {'up', {'nav', 'button'}} - assert.are_equal( - pandoc.Link('up', '../index.html', nil, {'up', {'nav', 'button'}}), - link - ) - end) - }, - group 'Math' { - test('has property `text`', function () - local elem = pandoc.Math(pandoc.InlineMath, 'x^2') - assert.are_same(elem.text, 'x^2') - elem.text = 'a + b' - assert.are_equal(elem, pandoc.Math(pandoc.InlineMath, 'a + b')) - end), - test('has property `mathtype`', function () - local elem = pandoc.Math(pandoc.InlineMath, 'x^2') - assert.are_same(elem.mathtype, 'InlineMath') - elem.mathtype = pandoc.DisplayMath - assert.are_equal(elem, pandoc.Math(pandoc.DisplayMath, 'x^2')) + test('pandoc.Note is a function', function () + assert.are_equal(type(pandoc.Note), 'function') end), - }, - group 'Note' { - test('has property `content`', function () - local elem = pandoc.Note{pandoc.Para {'two', pandoc.Space(), 'words'}} - assert.are_same( - elem.content, - {pandoc.Para {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'}} - ) - elem.content = pandoc.Plain 'word' - assert.are_equal(elem, pandoc.Note{'word'}) - end) - }, - group 'Quoted' { - test('has property `content`', function () - local elem = pandoc.Quoted('SingleQuote', pandoc.Emph{'emph'}) - assert.are_same( - elem.content, - {pandoc.Emph{pandoc.Str 'emph'}} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Quoted(pandoc.SingleQuote, {'word'})) - end), - test('has property `quotetype`', function () - local elem = pandoc.Quoted('SingleQuote', 'a') - assert.are_same(elem.quotetype, pandoc.SingleQuote) - elem.quotetype = 'DoubleQuote' - assert.are_equal(elem, pandoc.Quoted(pandoc.DoubleQuote, {'a'})) - end) - }, - group 'SmallCaps' { - test('has property `content`', function () - local elem = pandoc.SmallCaps{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.SmallCaps{'word'}) - end) - }, - group 'SoftBreak' { - test('can be constructed', function () - local sb = pandoc.SoftBreak() - assert.are_equal(sb.t, 'SoftBreak') - end) - }, - group 'Span' { - test('has property `attr`', function () - local elem = pandoc.Span('one', {'', {'number'}}) - assert.are_same( - elem.attr, - pandoc.Attr('', {'number'}) - ) - elem.attr = {'', {}, {{'a', 'b'}}} - assert.are_equal(elem, pandoc.Span({'one'}, {a='b'})) - end), - test('has property `content`', function () - local elem = pandoc.Span{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Span{'word'}) - end) - }, - group 'Str' { - test('has property `text`', function () - local elem = pandoc.Str 'nein' - assert.are_same(elem.text, 'nein') - elem.text = 'doch' - assert.are_equal(elem, pandoc.Str 'doch') - end) - }, - group 'Strikeout' { - test('has property `content`', function () - local elem = pandoc.Strikeout{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Strikeout{'word'}) - end) - }, - group 'Strong' { - test('has property `content`', function () - local elem = pandoc.Strong{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Strong{'word'}) - end) - }, - group 'Subscript' { - test('has property `content`', function () - local elem = pandoc.Subscript{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Subscript{'word'}) - end) - }, - group 'Superscript' { - test('has property `content`', function () - local elem = pandoc.Superscript{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Superscript{'word'}) - end) - }, - group 'Underline' { - test('has property `content`', function () - local elem = pandoc.Underline{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Underline{'word'}) - end) - }, - }, - group "Block elements" { - group 'BlockQuote' { - test('access content via property `content`', function () - local elem = pandoc.BlockQuote{'word'} - assert.are_same(elem.content, {pandoc.Plain 'word'}) - assert.are_equal(type(elem.content), 'table') - - elem.content = { - pandoc.Para{pandoc.Str 'one'}, - pandoc.Para{pandoc.Str 'two'} - } - assert.are_equal( - pandoc.BlockQuote{ - pandoc.Para 'one', - pandoc.Para 'two' - }, - elem - ) + test('pandoc.Quoted is a function', function () + assert.are_equal(type(pandoc.Quoted), 'function') end), - }, - group 'BulletList' { - test('access items via property `content`', function () - local para = pandoc.Para 'one' - local blist = pandoc.BulletList{{para}} - assert.are_same({{para}}, blist.content) - end), - test('property `content` uses fuzzy marshalling', function () - local old = pandoc.Plain 'old' - local new = pandoc.Plain 'new' - local blist = pandoc.BulletList{{old}} - blist.content = {{new}} - assert.are_same({{new}}, blist:clone().content) - blist.content = new - assert.are_same({{new}}, blist:clone().content) + test('pandoc.SmallCaps is a function', function () + assert.are_equal(type(pandoc.SmallCaps), 'function') end), - }, - group 'CodeBlock' { - test('access code via property `text`', function () - local cb = pandoc.CodeBlock('return true') - assert.are_equal(cb.text, 'return true') - assert.are_equal(type(cb.text), 'string') - - cb.text = 'return nil' - assert.are_equal(cb, pandoc.CodeBlock('return nil')) + test('pandoc.SoftBreak is a function', function () + assert.are_equal(type(pandoc.SoftBreak), 'function') end), - test('access Attr via property `attr`', function () - local cb = pandoc.CodeBlock('true', {'my-code', {'lua'}}) - assert.are_equal(cb.attr, pandoc.Attr{'my-code', {'lua'}}) - assert.are_equal(type(cb.attr), 'userdata') - - cb.attr = pandoc.Attr{'my-other-code', {'java'}} - assert.are_equal( - pandoc.CodeBlock('true', {'my-other-code', {'java'}}), - cb - ) - end) - }, - group 'DefinitionList' { - test('access items via property `content`', function () - local deflist = pandoc.DefinitionList{ - {'apple', {{pandoc.Plain 'fruit'}, {pandoc.Plain 'company'}}}, - {pandoc.Str 'coffee', 'Best when hot.'} - } - assert.are_equal(#deflist.content, 2) - assert.are_same(deflist.content[1][1], {pandoc.Str 'apple'}) - assert.are_same(deflist.content[1][2][2], - {pandoc.Plain{pandoc.Str 'company'}}) - assert.are_same(deflist.content[2][2], - {{pandoc.Plain{ - pandoc.Str 'Best', pandoc.Space(), - pandoc.Str 'when', pandoc.Space(), - pandoc.Str 'hot.'}}}) - end), - test('modify items via property `content`', function () - local deflist = pandoc.DefinitionList{ - {'apple', {{{'fruit'}}, {{'company'}}}} - } - deflist.content[1][1] = pandoc.Str 'orange' - deflist.content[1][2][1] = {pandoc.Plain 'tasty fruit'} - local newlist = pandoc.DefinitionList{ - { {pandoc.Str 'orange'}, - {{pandoc.Plain 'tasty fruit'}, {pandoc.Plain 'company'}} - } - } - assert.are_equal(deflist, newlist) + test('pandoc.Span is a function', function () + assert.are_equal(type(pandoc.Span), 'function') end), - }, - group 'Div' { - test('access content via property `content`', function () - local elem = pandoc.Div{pandoc.BlockQuote{pandoc.Plain 'word'}} - assert.are_same(elem.content, {pandoc.BlockQuote{'word'}}) - assert.are_equal(type(elem.content), 'table') - - elem.content = { - pandoc.Para{pandoc.Str 'one'}, - pandoc.Para{pandoc.Str 'two'} - } - assert.are_equal( - pandoc.Div{ - pandoc.Para 'one', - pandoc.Para 'two' - }, - elem - ) + test('pandoc.Str is a function', function () + assert.are_equal(type(pandoc.Str), 'function') end), - test('access Attr via property `attr`', function () - local div = pandoc.Div('word', {'my-div', {'sample'}}) - assert.are_equal(div.attr, pandoc.Attr{'my-div', {'sample'}}) - assert.are_equal(type(div.attr), 'userdata') - - div.attr = pandoc.Attr{'my-other-div', {'example'}} - assert.are_equal( - pandoc.Div('word', {'my-other-div', {'example'}}), - div - ) - end) - }, - group 'Header' { - test('access inlines via property `content`', function () - local header = pandoc.Header(1, 'test') - assert.are_same(header.content, {pandoc.Str 'test'}) - - header.content = {'new text'} - assert.are_equal(header, pandoc.Header(1, {'new text'})) + test('pandoc.Strikeout is a function', function () + assert.are_equal(type(pandoc.Strikeout), 'function') end), - test('access Attr via property `attr`', function () - local header = pandoc.Header(1, 'test', {'my-test'}) - assert.are_same(header.attr, pandoc.Attr{'my-test'}) - - header.attr = 'second-test' - assert.are_equal(header, pandoc.Header(1, 'test', 'second-test')) + test('pandoc.Strong is a function', function () + assert.are_equal(type(pandoc.Strong), 'function') end), - test('access level via property `level`', function () - local header = pandoc.Header(3, 'test') - assert.are_same(header.level, 3) - - header.level = 2 - assert.are_equal(header, pandoc.Header(2, 'test')) + test('pandoc.Subscript is a function', function () + assert.are_equal(type(pandoc.Subscript), 'function') end), - }, - group 'LineBlock' { - test('access lines via property `content`', function () - local spc = pandoc.Space() - local lineblock = pandoc.LineBlock{ - {'200', spc, 'Main', spc, 'St.'}, - {'Berkeley', spc, 'CA', spc, '94718'} - } - assert.are_equal(#lineblock.content, 2) -- has two lines - assert.are_same(lineblock.content[2][1], pandoc.Str 'Berkeley') - end), - test('modifying `content` alter the element', function () - local spc = pandoc.Space() - local lineblock = pandoc.LineBlock{ - {'200', spc, 'Main', spc, 'St.'}, - {'Berkeley', spc, 'CA', spc, '94718'} - } - lineblock.content[1][1] = '404' - assert.are_same( - lineblock:clone().content[1], - {pandoc.Str '404', spc, pandoc.Str 'Main', spc, pandoc.Str 'St.'} - ) - - lineblock.content = {{'line1'}, {'line2'}} - assert.are_same( - lineblock:clone(), - pandoc.LineBlock{ - {pandoc.Str 'line1'}, - {pandoc.Str 'line2'} - } - ) - end) - }, - group 'OrderedList' { - test('access items via property `content`', function () - local para = pandoc.Plain 'one' - local olist = pandoc.OrderedList{{para}} - assert.are_same({{para}}, olist.content) - end), - test('forgiving constructor', function () - local plain = pandoc.Plain 'old' - local olist = pandoc.OrderedList({plain}, {3, 'Example', 'Period'}) - local listAttribs = pandoc.ListAttributes(3, 'Example', 'Period') - assert.are_same(olist.listAttributes, listAttribs) - end), - test('has list attribute aliases', function () - local olist = pandoc.OrderedList({}, {4, 'Decimal', 'OneParen'}) - assert.are_equal(olist.start, 4) - assert.are_equal(olist.style, 'Decimal') - assert.are_equal(olist.delimiter, 'OneParen') - end) - }, - group 'Para' { - test('access inline via property `content`', function () - local para = pandoc.Para{'Moin, ', pandoc.Space(), 'Sylt!'} - assert.are_same( - para.content, - {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} - ) + test('pandoc.Superscript is a function', function () + assert.are_equal(type(pandoc.Superscript), 'function') end), - test('modifying `content` changes the element', function () - local para = pandoc.Para{'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} - - para.content[3] = 'Hamburg!' - assert.are_same( - para:clone().content, - {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Hamburg!'} - ) - - para.content = 'Huh' - assert.are_same( - para:clone().content, - {pandoc.Str 'Huh'} - ) + test('pandoc.Underline is a function', function () + assert.are_equal(type(pandoc.Underline), 'function') end), }, - group 'RawBlock' { - test('access raw content via property `text`', function () - local raw = pandoc.RawBlock('markdown', '- one') - assert.are_equal(type(raw.text), 'string') - assert.are_equal(raw.text, '- one') - - raw.text = '+ one' - assert.are_equal(raw, pandoc.RawBlock('markdown', '+ one')) + group "Block elements" { + test('pandoc.BlockQuote is a function', function () + assert.are_equal(type(pandoc.BlockQuote), 'function') end), - test('access Format via property `format`', function () - local raw = pandoc.RawBlock('markdown', '* hi') - assert.are_equal(type(raw.format), 'string') - assert.are_equal(raw.format, 'markdown') - - raw.format = 'org' - assert.are_equal(pandoc.RawBlock('org', '* hi'), raw) - end) - }, - group 'Table' { - test('access Attr via property `attr`', function () - local caption = {long = {pandoc.Plain 'cap'}} - local tbl = pandoc.Table(caption, {}, {{}, {}}, {}, {{}, {}}, - {'my-tbl', {'a'}}) - assert.are_equal(tbl.attr, pandoc.Attr{'my-tbl', {'a'}}) - - tbl.attr = pandoc.Attr{'my-other-tbl', {'b'}} - assert.are_equal( - pandoc.Table(caption, {}, {{}, {}}, {}, {{}, {}}, - {'my-other-tbl', {'b'}}), - tbl - ) + test('pandoc.BulletList is a function', function () + assert.are_equal(type(pandoc.BulletList), 'function') end), - test('access caption via property `caption`', function () - local caption = {long = {pandoc.Plain 'cap'}} - local tbl = pandoc.Table(caption, {}, {{}, {}}, {}, {{}, {}}) - assert.are_same(tbl.caption, {long = {pandoc.Plain 'cap'}}) - - tbl.caption.short = 'brief' - tbl.caption.long = {pandoc.Plain 'extended'} - - local new_caption = { - short = 'brief', - long = {pandoc.Plain 'extended'} - } - assert.are_equal( - pandoc.Table(new_caption, {}, {{}, {}}, {}, {{}, {}}), - tbl - ) + test('pandoc.CodeBlock is a function', function () + assert.are_equal(type(pandoc.CodeBlock), 'function') end), - test('access column specifiers via property `colspecs`', function () - local colspecs = {{pandoc.AlignCenter, 1}} - local tbl = pandoc.Table({long = {}}, colspecs, {{}, {}}, {}, {{}, {}}) - assert.are_same(tbl.colspecs, colspecs) - - tbl.colspecs[1][1] = pandoc.AlignRight - tbl.colspecs[1][2] = nil - - local new_colspecs = {{pandoc.AlignRight}} - assert.are_equal( - pandoc.Table({long = {}}, new_colspecs, {{}, {}}, {}, {{}, {}}), - tbl - ) + test('pandoc.DefinitionList is a function', function () + assert.are_equal(type(pandoc.DefinitionList), 'function') end), - test('access table head via property `head`', function () - local head = {pandoc.Attr{'tbl-head'}, {}} - local tbl = pandoc.Table({long = {}}, {}, head, {}, {{}, {}}) - assert.are_same(tbl.head, head) - - tbl.head[1] = pandoc.Attr{'table-head'} - - local new_head = {'table-head', {}} - assert.are_equal( - pandoc.Table({long = {}}, {}, new_head, {}, {{}, {}}), - tbl - ) + test('pandoc.Div is a function', function () + assert.are_equal(type(pandoc.Div), 'function') end), - test('access table head via property `head`', function () - local foot = {{id = 'tbl-foot'}, {}} - local tbl = pandoc.Table({long = {}}, {}, {{}, {}}, {}, foot) - assert.are_same(tbl.foot, {pandoc.Attr('tbl-foot'), {}}) - - tbl.foot[1] = pandoc.Attr{'table-foot'} - - local new_foot = {'table-foot', {}} - assert.are_equal( - pandoc.Table({long = {}}, {}, {{}, {}}, {}, new_foot), - tbl - ) - end) - }, + test('pandoc.Header is a function', function () + assert.are_equal(type(pandoc.Header), 'function') + end), + test('pandoc.LineBlock is a function', function () + assert.are_equal(type(pandoc.LineBlock), 'function') + end), + test('pandoc.Null is a function', function () + assert.are_equal(type(pandoc.Null), 'function') + end), + test('pandoc.OrderedList is a function', function () + assert.are_equal(type(pandoc.OrderedList), 'function') + end), + test('pandoc.Para is a function', function () + assert.are_equal(type(pandoc.Para), 'function') + end), + test('pandoc.Plain is a function', function () + assert.are_equal(type(pandoc.Plain), 'function') + end), + test('pandoc.RawBlock is a function', function () + assert.are_equal(type(pandoc.Plain), 'function') + end), + test('pandoc.Table is a function', function () + assert.are_equal(type(pandoc.Table), 'function') + end), + } }, group 'MetaValue elements' { test('MetaList elements behave like lists', function () @@ -724,12 +133,6 @@ return { assert.are_equal(type(metalist.insert), 'function') assert.are_equal(type(metalist.remove), 'function') end), - test('MetaList, MetaMap, MetaInlines, MetaBlocks have `t` tag', function () - assert.are_equal((pandoc.MetaList{}).t, 'MetaList') - assert.are_equal((pandoc.MetaMap{}).t, 'MetaMap') - assert.are_equal((pandoc.MetaInlines{}).t, 'MetaInlines') - assert.are_equal((pandoc.MetaBlocks{}).t, 'MetaBlocks') - end), test('`tag` is an alias for `t``', function () assert.are_equal((pandoc.MetaList{}).tag, (pandoc.MetaList{}).t) assert.are_equal((pandoc.MetaMap{}).tag, (pandoc.MetaMap{}).t) @@ -756,81 +159,6 @@ return { end), }, group 'Other types' { - group 'Citation' { - test('checks equality by comparing Haskell values', function() - assert.are_equal( - pandoc.Citation('a', pandoc.NormalCitation), - pandoc.Citation('a', pandoc.NormalCitation) - ) - assert.is_falsy( - pandoc.Citation('a', pandoc.NormalCitation) == - pandoc.Citation('a', pandoc.AuthorInText) - ) - assert.is_falsy( - pandoc.Citation('a', pandoc.NormalCitation) == - pandoc.Citation('b', pandoc.NormalCitation) - ) - end), - }, - group 'SimpleTable' { - test('can access properties', function () - local spc = pandoc.Space() - local caption = {pandoc.Str 'Languages', spc, pandoc.Str 'overview.'} - local aligns = {pandoc.AlignDefault, pandoc.AlignDefault} - local widths = {0, 0} -- let pandoc determine col widths - local headers = {{pandoc.Plain({pandoc.Str "Language"})}, - {pandoc.Plain({pandoc.Str "Typing"})}} - local rows = { - {{pandoc.Plain "Haskell"}, {pandoc.Plain "static"}}, - {{pandoc.Plain "Lua"}, {pandoc.Plain "Dynamic"}}, - } - local simple_table = pandoc.SimpleTable( - caption, - aligns, - widths, - headers, - rows - ) - assert.are_same(simple_table.caption, caption) - assert.are_same(simple_table.aligns, aligns) - assert.are_same(simple_table.widths, widths) - assert.are_same(simple_table.headers, headers) - assert.are_same(simple_table.rows, rows) - end), - test('can modify properties', function () - local new_table = pandoc.SimpleTable( - {'Languages'}, - {pandoc.AlignDefault, pandoc.AlignDefault}, - {0.5, 0.5}, - {{pandoc.Plain({pandoc.Str "Language"})}, - {pandoc.Plain({pandoc.Str "Typing"})}}, - { - {{pandoc.Plain "Haskell"}, {pandoc.Plain "static"}}, - {{pandoc.Plain "Lua"}, {pandoc.Plain "Dynamic"}}, - } - ) - - new_table.caption = {pandoc.Str 'Good', pandoc.Space(), - pandoc.Str 'languages'} - new_table.aligns[1] = pandoc.AlignLeft - new_table.widths = {0, 0} - new_table.headers[2] = {pandoc.Plain{pandoc.Str 'compiled/interpreted'}} - new_table.rows[1][2] = {pandoc.Plain{pandoc.Str 'both'}} - new_table.rows[2][2] = {pandoc.Plain{pandoc.Str 'interpreted'}} - - local expected_table = pandoc.SimpleTable( - {pandoc.Str 'Good', pandoc.Space(), pandoc.Str 'languages'}, - {pandoc.AlignLeft, pandoc.AlignDefault}, - {0, 0}, - {{pandoc.Plain 'Language'}, {pandoc.Plain 'compiled/interpreted'}}, - { - {{pandoc.Plain 'Haskell'}, {pandoc.Plain 'both'}}, - {{pandoc.Plain 'Lua'}, {pandoc.Plain 'interpreted'}} - } - ) - assert.are_same(expected_table, new_table) - end) - }, group 'ReaderOptions' { test('returns a userdata value', function () local opts = pandoc.ReaderOptions {} -- cgit v1.2.3 From b9222e5cb1d8d1d3217f65c6a91886b897956dde Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sun, 28 Nov 2021 15:07:30 +0100 Subject: Lua: add constructors `pandoc.Blocks` and `pandoc.Inlines` The functions convert their argument into a list of Block and Inline values, respectively. --- doc/lua-filters.md | 37 +++++++++++++++++++++++++++++++++++- src/Text/Pandoc/Lua/Module/Pandoc.hs | 2 ++ test/lua/module/pandoc.lua | 6 ++++++ 3 files changed, 44 insertions(+), 1 deletion(-) (limited to 'test/lua') diff --git a/doc/lua-filters.md b/doc/lua-filters.md index db5d1ccac..f24a66579 100644 --- a/doc/lua-filters.md +++ b/doc/lua-filters.md @@ -2074,7 +2074,7 @@ format, and functions to filter and modify a subtree. Returns: [MetaBool] object -## Blocks +## Block [`BlockQuote (content)`]{#pandoc.blockquote} @@ -2254,6 +2254,20 @@ format, and functions to filter and modify a subtree. Returns: [Table](#type-table) object +## Blocks + +[`Blocks (block_like_elements)`]{#pandoc.blocks} + +: Creates a [Blocks](#type-blocks) list. + + Parameters: + + `block_like_elements`: + : List where each element can be treated as a [Block] + value, or a single such value. + + Returns: [Blocks] list + ## Inline [`Cite (content, citations)`]{#pandoc.cite} @@ -2543,6 +2557,27 @@ format, and functions to filter and modify a subtree. Returns: [Underline](#type-underline) object +## Inlines + +[`Inlines (inline_like_elements)`]{#pandoc.inlines} + +: Converts its argument into an [Inlines](#type-inlines) list: + + - copies a list of [Inline] elements into a fresh list; any + string `s` within the list is treated as `pandoc.Str(s)`; + - turns a single [Inline] into a singleton list; + - splits a string into `Str`-wrapped words, treating + interword spaces as `Space`s or `SoftBreak`s. + + Parameters: + + `inline_like_elements`: + : List where each element can be treated as an [Inline] + values, or just a single such value. + + Returns: [Inlines] list + + ## Element components [`Attr ([identifier[, classes[, attributes]]])`]{#pandoc.attr} diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index 085d904cf..e932ca59a 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -117,7 +117,9 @@ otherConstructors = , mkMeta , mkAttr , mkAttributeList + , mkBlocks , mkCitation + , mkInlines , mkListAttributes , mkSimpleTable diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 1cf777675..892ffee03 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -19,9 +19,15 @@ return { test('pandoc.AttributeList is a function', function () assert.are_equal(type(pandoc.AttributeList), 'function') end), + test('pandoc.Blocks is a function', function () + assert.are_equal(type(pandoc.Blocks), 'function') + end), test('pandoc.Citation is a function', function () assert.are_equal(type(pandoc.Citation), 'function') end), + test('pandoc.Inlines is a function', function () + assert.are_equal(type(pandoc.Inlines), 'function') + end), test('pandoc.SimpleTable is a function', function () assert.are_equal(type(pandoc.SimpleTable), 'function') end), -- cgit v1.2.3 From fa838deefc6badc62b9ca4d93aba55e9fbd747ec Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Mon, 29 Nov 2021 18:12:30 +0100 Subject: Lua: remove `pandoc.utils.text` (#7720) The new `pandoc.Inlines` function behaves identical on string input, but allows other Inlines-like arguments as well. The `pandoc.utils.text` function could be written as function pandoc.utils.text (x) assert(type(x) == 'string') return pandoc.Inlines(x) end --- doc/lua-filters.md | 18 ------------------ src/Text/Pandoc/Lua/Module/Utils.hs | 8 -------- test/lua/module/pandoc-utils.lua | 28 ---------------------------- 3 files changed, 54 deletions(-) (limited to 'test/lua') diff --git a/doc/lua-filters.md b/doc/lua-filters.md index ff56e1a8e..ac682a90d 100644 --- a/doc/lua-filters.md +++ b/doc/lua-filters.md @@ -3121,24 +3121,6 @@ Usage: -- outputs "Moin" print(pandoc.utils.stringify(inline)) -### text {#pandoc.utils.text} - -`text (words)` - -Converts a string to `Inlines`, treating interword spaces as -`Space`s or `SoftBreak`s. If you want a single `Str` with literal -spaces, use `pandoc.Str`. - -Parameters: - -`words` -: markup-less text (string) - -Returns: - -- List of inline elements split into words (Inlines) - - ### to\_roman\_numeral {#pandoc.utils.to_roman_numeral} `to_roman_numeral (integer)` diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 917f2e627..8bb185500 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -115,14 +115,6 @@ documentedModule = Module <#> parameter peekAstElement "AST element" "elem" "some pandoc AST element" =#> functionResult pushText "string" "stringified element" - , defun "text" - ### liftPure (B.toList . B.text) - <#> parameter peekText "string" "words" "markup-less inlines text" - =#> functionResult pushInlines "Inlines" "list of inline elements" - #? ("Converts a string to `Inlines`, treating interword spaces as " <> - "`Space`s or `SoftBreak`s. If you want a `Str` with literal " <> - "spaces, use `pandoc.Str`.") - , defun "from_simple_table" ### from_simple_table <#> parameter peekSimpleTable "SimpleTable" "simple_tbl" "" diff --git a/test/lua/module/pandoc-utils.lua b/test/lua/module/pandoc-utils.lua index 21f550177..9bd903f2d 100644 --- a/test/lua/module/pandoc-utils.lua +++ b/test/lua/module/pandoc-utils.lua @@ -82,34 +82,6 @@ return { end) }, - group 'text' { - test('string is converted to inlines', function () - local expected = { - pandoc.Str 'Madness', pandoc.Space(), pandoc.Str '-', pandoc.Space(), - pandoc.Str 'Our', pandoc.Space(), pandoc.Str 'House' - } - assert.are_same(pandoc.utils.text('Madness - Our House'), expected) - end), - test('tabs are treated as space', function () - local expected = { - pandoc.Str 'Linkin', pandoc.Space(), pandoc.Str 'Park', pandoc.Space(), - pandoc.Str '-', pandoc.Space(), pandoc.Str 'Papercut' - } - assert.are_same(pandoc.utils.text('Linkin Park\t-\tPapercut'), expected) - end), - test('newlines are treated as softbreaks', function () - local expected = { - pandoc.Str 'Porcupine', pandoc.Space(), pandoc.Str 'Tree', - pandoc.SoftBreak(), pandoc.Str '-', pandoc.SoftBreak(), - pandoc.Str 'Blackest', pandoc.Space(), pandoc.Str 'Eyes' - } - assert.are_same( - pandoc.utils.text('Porcupine Tree\n-\nBlackest Eyes'), - expected - ) - end), - }, - group 'to_roman_numeral' { test('convertes number', function () assert.are_equal('MDCCCLXXXVIII', utils.to_roman_numeral(1888)) -- cgit v1.2.3 From fa643ba6d78fd97f0a779840dca32bfea3b296f8 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Mon, 6 Dec 2021 16:55:19 +0100 Subject: Lua: update to latest pandoc-lua-marshal (0.1.1) - `walk` methods are added to `Block` and `Inline` values; the methods are similar to `pandoc.utils.walk_block` and `pandoc.utils.walk_inline`, but apply to filter also to the element itself, and therefore return a list of element instead of a single element. - Functions of name `Doc` are no longer accepted as alternatives for `Pandoc` filter functions. This functionality was undocumented. --- cabal.project | 5 + doc/lua-filters.md | 181 +++++++++++++++++++++++++- pandoc.cabal | 3 +- src/Text/Pandoc/Lua/Filter.hs | 238 +++-------------------------------- src/Text/Pandoc/Lua/Module/Pandoc.hs | 28 ++--- src/Text/Pandoc/Lua/Walk.hs | 183 --------------------------- stack.yaml | 3 +- test/lua/implicit-doc-filter.lua | 2 +- 8 files changed, 211 insertions(+), 432 deletions(-) delete mode 100644 src/Text/Pandoc/Lua/Walk.hs (limited to 'test/lua') diff --git a/cabal.project b/cabal.project index 99c3a7815..63c967594 100644 --- a/cabal.project +++ b/cabal.project @@ -3,6 +3,11 @@ tests: True flags: +embed_data_files constraints: aeson >= 2.0.1.0 +source-repository-package + type: git + location: https://github.com/pandoc/pandoc-lua-marshal.git + tag: c24be07a51a6fd5ea2e1ec244b8caf220cea5ce4 + -- source-repository-package -- type: git -- location: https://github.com/jgm/texmath.git diff --git a/doc/lua-filters.md b/doc/lua-filters.md index ac682a90d..fb13f4915 100644 --- a/doc/lua-filters.md +++ b/doc/lua-filters.md @@ -523,8 +523,9 @@ will output: This is the filter we use when converting `MANUAL.txt` to man pages. It converts level-1 headers to uppercase (using -`walk_block` to transform inline elements inside headers), -removes footnotes, and replaces links with regular text. +[`walk`](#type-block:walk) to transform inline elements inside +headers), removes footnotes, and replaces links with regular +text. ``` lua -- we use preloaded text to get a UTF-8 aware 'upper' function @@ -532,10 +533,11 @@ local text = require('text') function Header(el) if el.level == 1 then - return pandoc.walk_block(el, { + return el:walk { Str = function(el) return pandoc.Str(text.upper(el.text)) - end }) + end + } end end @@ -611,7 +613,7 @@ wordcount = { function Pandoc(el) -- skip metadata, just count body: - pandoc.walk_block(pandoc.Div(el.blocks), wordcount) + el.blocks:walk(wordcount) print(words .. " words in body") os.exit(0) end @@ -793,6 +795,35 @@ determined via [`pandoc.utils.equals`]. `meta` : document meta information ([Meta] object) + +### walk {#type-pandoc:walk} + +`walk(self, lua_filter)` + +Applies a Lua filter to the Pandoc element. Just as for +full-document filters, the order in which elements are handled +are Inline → Inlines → Block → Blocks → Meta → Pandoc. + +Parameters: + +`self` +: the element ([Pandoc](#type-pandoc)) + +`lua_filter` +: map of filter functions (table) + +Result: + +- filtered document ([Pandoc][]) + +Usage: + + -- returns `pandoc.Pandoc{pandoc.Para{pandoc.Str 'Bye'}}` + return pandoc.Pandoc{pandoc.Para('Hi')}:walk { + Str = function (_) return 'Bye' end, + } + + ## Meta {#type-meta} Meta information on a document; string-indexed collection of @@ -834,6 +865,40 @@ or `pandoc.Blocks`. Object equality is determined via [`pandoc.utils.equals`]. +### Common Methods + +#### walk {#type-block:walk} + +`walk(self, lua_filter)` + +Applies a Lua filter to the block element. Just as for +full-document filters, the order in which elements are handled +are Inline → Inlines → Block → Blocks. + +Note that the filter is applied to the subtree, but not to the +element itself. The rationale is that the element might be +deleted by the filter, leading to possibly unexpected results. + +Parameters: + +`self` +: the element ([Block](#type-block)) + +`lua_filter` +: map of filter functions (table) + +Result: + +- filtered block ([Block][]) + +Usage: + + -- returns `pandoc.Para{pandoc.Str 'Bye'}` + return pandoc.Para('Hi'):walk { + Str = function (_) return 'Bye' end, + } + + ### BlockQuote {#type-blockquote} A block quote element. @@ -1141,11 +1206,80 @@ into Blocks wherever a value of this type is expected: the string into words (see [Inlines](#type-inlines)), and then wrapping the result into a Plain singleton. +### Methods + +Lists of type `Blocks` share all methods available in generic +lists, see the [`pandoc.List` module](#module-pandoc.list). + +Additionally, the following methods are available on Blocks +values: + +#### walk {#type-blocks:walk} + +`walk(self, lua_filter)` + +Applies a Lua filter to the Blocks list. Just as for +full-document filters, the order in which elements are handled +are are Inline → Inlines → Block → Blocks. The filter is applied +to all list items *and* to the list itself. + +Parameters: + +`self` +: the list ([Blocks](#type-blocks)) + +`lua_filter` +: map of filter functions (table) + +Result: + +- filtered list ([Blocks](#type-blocks)) + +Usage: + + -- returns `pandoc.Blocks{pandoc.Para('Salve!')}` + return pandoc.Blocks{pandoc.Plain('Salve!)}:walk { + Plain = function (p) return pandoc.Para(p.content) end, + } + ## Inline {#type-inline} Object equality is determined by checking the Haskell representation for equality. +### Common Methods + +#### walk {#type-inline:walk} + +`walk(self, lua_filter)` + +Applies a Lua filter to the Inline element. Just as for +full-document filters, the order in which elements are handled +are are Inline → Inlines → Block → Blocks. + +Note that the filter is applied to the subtree, but *not* to the +element itself. The rationale is that the element might be +deleted by the filter, leading to possibly unexpected results. + +Parameters: + +`self` +: the element ([Inline](#type-inline)) + +`lua_filter` +: map of filter functions (table) + +Result: + +- filtered inline element ([Inline][]) + +Usage: + + -- returns `pandoc.SmallCaps('SPQR)` + return pandoc.SmallCaps('spqr'):walk { + Str = function (s) return string.upper(s.text) end, + } + ### Cite {#type-cite} Citation. @@ -1526,6 +1660,43 @@ into Blocks wherever a value of this type is expected: into [SoftBreak](#type-softbreak) elements, and other whitespace characters into [Spaces](#type-space). +### Methods + +Lists of type `Inlines` share all methods available in generic +lists, see the [`pandoc.List` module](#module-pandoc.list). + +Additionally, the following methods are available on *Inlines* +values: + +#### walk {#type-inlines:walk} + +`walk(self, lua_filter)` + +Applies a Lua filter to the Inlines list. Just as for +full-document filters, the order in which elements are handled +are are Inline → Inlines → Block → Blocks. The filter is applied +to all list items *and* to the list itself. + +Parameters: + +`self` +: the list ([Inlines](#type-inlines)) + +`lua_filter` +: map of filter functions (table) + +Result: + +- filtered list ([Inlines](#type-inlines)) + +Usage: + + -- returns `pandoc.Inlines{pandoc.SmallCaps('SPQR)}` + return pandoc.Inlines{pandoc.Emph('spqr')}:walk { + Str = function (s) return string.upper(s.text) end, + Emph = function (e) return pandoc.SmallCaps(e.content) end, + } + ## Element components diff --git a/pandoc.cabal b/pandoc.cabal index 74f67c403..2abc75b87 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -481,7 +481,7 @@ library mtl >= 2.2 && < 2.3, network >= 2.6, network-uri >= 2.6 && < 2.8, - pandoc-lua-marshal >= 0.1.0.1 && < 0.2, + pandoc-lua-marshal >= 0.1.1 && < 0.2, pandoc-types >= 1.22.1 && < 1.23, parsec >= 3.1 && < 3.2, pretty >= 1.1 && < 1.2, @@ -703,7 +703,6 @@ library Text.Pandoc.Lua.Packages, Text.Pandoc.Lua.PandocLua, Text.Pandoc.Lua.Util, - Text.Pandoc.Lua.Walk, Text.Pandoc.XML.Light, Text.Pandoc.XML.Light.Types, Text.Pandoc.XML.Light.Proc, diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs index ba5a14a0d..9910424d8 100644 --- a/src/Text/Pandoc/Lua/Filter.hs +++ b/src/Text/Pandoc/Lua/Filter.hs @@ -12,242 +12,36 @@ Stability : alpha Types and functions for running Lua filters. -} -module Text.Pandoc.Lua.Filter ( LuaFilterFunction - , LuaFilter - , peekLuaFilter - , runFilterFile - , walkInlines - , walkInlineLists - , walkBlocks - , walkBlockLists - , module Text.Pandoc.Lua.Walk - ) where -import Control.Applicative ((<|>)) -import Control.Monad (mplus, (>=>), (<$!>)) -import Data.Data (Data, DataType, dataTypeConstrs, dataTypeName, dataTypeOf, - showConstr, toConstr, tyconUQname) -import Data.Foldable (foldrM) -import Data.List (foldl') -import Data.Map (Map) -import Data.String (IsString (fromString)) +module Text.Pandoc.Lua.Filter + ( runFilterFile + ) where +import Control.Monad ((>=>), (<$!>)) import HsLua as Lua import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError) +import Text.Pandoc.Lua.ErrorConversion () import Text.Pandoc.Lua.Marshal.AST -import Text.Pandoc.Lua.Orphans () -import Text.Pandoc.Lua.Walk (List (..), SingletonsList (..)) -import Text.Pandoc.Walk (Walkable (walkM)) +import Text.Pandoc.Lua.Marshal.Filter -import qualified Data.Map.Strict as Map import qualified Text.Pandoc.Lua.Util as LuaUtil -- | Transform document using the filter defined in the given file. runFilterFile :: FilePath -> Pandoc -> LuaE PandocError Pandoc runFilterFile filterPath doc = do - oldtop <- Lua.gettop + oldtop <- gettop stat <- LuaUtil.dofileWithTraceback filterPath if stat /= Lua.OK - then Lua.throwErrorAsException + then throwErrorAsException else do - newtop <- Lua.gettop + newtop <- gettop -- Use the returned filters, or the implicitly defined global -- filter if nothing was returned. - luaFilters <- if newtop - oldtop >= 1 - then Lua.peek Lua.top - else Lua.pushglobaltable *> fmap (:[]) Lua.popValue + luaFilters <- forcePeek $ + if newtop - oldtop >= 1 + then peekList peekFilter top + else (:[]) <$!> (liftLua pushglobaltable *> peekFilter top) + settop oldtop runAll luaFilters doc -runAll :: [LuaFilter] -> Pandoc -> LuaE PandocError Pandoc -runAll = foldr ((>=>) . walkMWithLuaFilter) return - --- | Filter function stored in the registry -newtype LuaFilterFunction = LuaFilterFunction Lua.Reference - --- | Collection of filter functions (at most one function per element --- constructor) -newtype LuaFilter = LuaFilter (Map Name LuaFilterFunction) - -instance Peekable LuaFilter where - peek = Lua.forcePeek . peekLuaFilter - --- | Retrieves a LuaFilter object from the stack. -peekLuaFilter :: LuaError e => Peeker e LuaFilter -peekLuaFilter idx = do - let constrs = listOfInlinesFilterName - : listOfBlocksFilterName - : metaFilterName - : pandocFilterNames - ++ blockElementNames - ++ inlineElementNames - let go constr acc = Lua.liftLua $ do - Lua.getfield idx constr - filterFn <- registerFilterFunction - return $ case filterFn of - Nothing -> acc - Just fn -> Map.insert constr fn acc - LuaFilter <$!> foldrM go Map.empty constrs - --- | Register the function at the top of the stack as a filter function in the --- registry. -registerFilterFunction :: LuaError e => LuaE e (Maybe LuaFilterFunction) -registerFilterFunction = do - isFn <- Lua.isfunction Lua.top - if isFn - then Just . LuaFilterFunction <$> Lua.ref Lua.registryindex - else Nothing <$ Lua.pop 1 - --- | Retrieve filter function from registry and push it to the top of the stack. -pushFilterFunction :: LuaFilterFunction -> LuaE PandocError () -pushFilterFunction (LuaFilterFunction fnRef) = - Lua.getref Lua.registryindex fnRef - --- | Fetch either a list of elements from the stack. If there is a single --- element instead of a list, fetch that element as a singleton list. If the top --- of the stack is nil, return the default element that was passed to this --- function. If none of these apply, raise an error. -elementOrList :: Peeker PandocError a -> a -> LuaE PandocError [a] -elementOrList p x = do - elementUnchanged <- Lua.isnil top - if elementUnchanged - then [x] <$ pop 1 - else forcePeek . (`lastly` pop 1) $ (((:[]) <$!> p top) <|> peekList p top) - --- | Fetches a single element; returns the fallback if the value is @nil@. -singleElement :: forall a e. (LuaError e) => Peeker e a -> a -> LuaE e a -singleElement p x = do - elementUnchanged <- Lua.isnil top - if elementUnchanged - then x <$ Lua.pop 1 - else forcePeek $ p top `lastly` pop 1 - --- | Pop and return a value from the stack; if the value at the top of --- the stack is @nil@, return the fallback element. -popOption :: Peeker PandocError a -> a -> LuaE PandocError a -popOption peeker fallback = forcePeek . (`lastly` pop 1) $ - (fallback <$ peekNil top) <|> peeker top - --- | Apply filter on a sequence of AST elements. Both lists and single --- value are accepted as filter function return values. -runOnSequence :: forall a. (Data a, Pushable a) - => Peeker PandocError a -> LuaFilter -> SingletonsList a - -> LuaE PandocError (SingletonsList a) -runOnSequence peeker (LuaFilter fnMap) (SingletonsList xs) = - SingletonsList <$> mconcatMapM tryFilter xs - where - tryFilter :: a -> LuaE PandocError [a] - tryFilter x = - let filterFnName = fromString $ showConstr (toConstr x) - catchAllName = fromString . tyconUQname $ dataTypeName (dataTypeOf x) - in case Map.lookup filterFnName fnMap <|> Map.lookup catchAllName fnMap of - Just fn -> runFilterFunction fn x *> elementOrList peeker x - Nothing -> return [x] - --- | Try filtering the given value without type error corrections on --- the return value. -runOnValue :: (Data a, Pushable a) - => Name -> Peeker PandocError a - -> LuaFilter -> a - -> LuaE PandocError a -runOnValue filterFnName peeker (LuaFilter fnMap) x = - case Map.lookup filterFnName fnMap of - Just fn -> runFilterFunction fn x *> popOption peeker x - Nothing -> return x - --- | Push a value to the stack via a Lua filter function. The filter --- function is called with the given element as argument and is expected --- to return an element. Alternatively, the function can return nothing --- or nil, in which case the element is left unchanged. -runFilterFunction :: Pushable a - => LuaFilterFunction -> a -> LuaE PandocError () -runFilterFunction lf x = do - pushFilterFunction lf - Lua.push x - LuaUtil.callWithTraceback 1 1 - -walkMWithLuaFilter :: LuaFilter -> Pandoc -> LuaE PandocError Pandoc -walkMWithLuaFilter f = - walkInlines f - >=> walkInlineLists f - >=> walkBlocks f - >=> walkBlockLists f - >=> walkMeta f - >=> walkPandoc f - -mconcatMapM :: (Monad m) => (a -> m [a]) -> [a] -> m [a] -mconcatMapM f = fmap mconcat . mapM f - -hasOneOf :: LuaFilter -> [Name] -> Bool -hasOneOf (LuaFilter fnMap) = any (`Map.member` fnMap) - -contains :: LuaFilter -> Name -> Bool -contains (LuaFilter fnMap) = (`Map.member` fnMap) - -walkInlines :: Walkable (SingletonsList Inline) a - => LuaFilter -> a -> LuaE PandocError a -walkInlines lf = - let f :: SingletonsList Inline -> LuaE PandocError (SingletonsList Inline) - f = runOnSequence peekInline lf - in if lf `hasOneOf` inlineElementNames - then walkM f - else return - -walkInlineLists :: Walkable (List Inline) a - => LuaFilter -> a -> LuaE PandocError a -walkInlineLists lf = - let f :: List Inline -> LuaE PandocError (List Inline) - f = runOnValue listOfInlinesFilterName peekListOfInlines lf - peekListOfInlines idx = List <$!> (peekInlinesFuzzy idx) - in if lf `contains` listOfInlinesFilterName - then walkM f - else return - -walkBlocks :: Walkable (SingletonsList Block) a - => LuaFilter -> a -> LuaE PandocError a -walkBlocks lf = - let f :: SingletonsList Block -> LuaE PandocError (SingletonsList Block) - f = runOnSequence peekBlock lf - in if lf `hasOneOf` blockElementNames - then walkM f - else return - -walkBlockLists :: Walkable (List Block) a - => LuaFilter -> a -> LuaE PandocError a -walkBlockLists lf = - let f :: List Block -> LuaE PandocError (List Block) - f = runOnValue listOfBlocksFilterName peekListOfBlocks lf - peekListOfBlocks idx = List <$!> (peekBlocksFuzzy idx) - in if lf `contains` listOfBlocksFilterName - then walkM f - else return - -walkMeta :: LuaFilter -> Pandoc -> LuaE PandocError Pandoc -walkMeta lf (Pandoc m bs) = do - m' <- runOnValue "Meta" peekMeta lf m - return $ Pandoc m' bs - -walkPandoc :: LuaFilter -> Pandoc -> LuaE PandocError Pandoc -walkPandoc (LuaFilter fnMap) = - case foldl' mplus Nothing (map (`Map.lookup` fnMap) pandocFilterNames) of - Just fn -> \x -> runFilterFunction fn x *> singleElement peekPandoc x - Nothing -> return - -constructorsFor :: DataType -> [Name] -constructorsFor x = map (fromString . show) (dataTypeConstrs x) - -inlineElementNames :: [Name] -inlineElementNames = "Inline" : constructorsFor (dataTypeOf (Str mempty)) - -blockElementNames :: [Name] -blockElementNames = "Block" : constructorsFor (dataTypeOf (Para [])) - -listOfInlinesFilterName :: Name -listOfInlinesFilterName = "Inlines" - -listOfBlocksFilterName :: Name -listOfBlocksFilterName = "Blocks" - -metaFilterName :: Name -metaFilterName = "Meta" - -pandocFilterNames :: [Name] -pandocFilterNames = ["Pandoc", "Doc"] +runAll :: [Filter] -> Pandoc -> LuaE PandocError Pandoc +runAll = foldr ((>=>) . applyFully) return diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index e932ca59a..529a28cf8 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -31,20 +31,16 @@ import HsLua.Class.Peekable (PeekError) import System.Exit (ExitCode (..)) import Text.Pandoc.Class.PandocIO (runIO) import Text.Pandoc.Definition -import Text.Pandoc.Lua.Filter (List (..), SingletonsList (..), LuaFilter, - peekLuaFilter, - walkInlines, walkInlineLists, - walkBlocks, walkBlockLists) 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) + , pushReaderOptions) import Text.Pandoc.Lua.Module.Utils (sha1) import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua) import Text.Pandoc.Options (ReaderOptions (readerExtensions)) import Text.Pandoc.Process (pipeProcess) import Text.Pandoc.Readers (Reader (..), getReader) -import Text.Pandoc.Walk (Walkable) import qualified HsLua as Lua import qualified Data.ByteString.Lazy as BL @@ -149,16 +145,6 @@ stringConstants = } in map toField nullaryConstructors -walkElement :: (Walkable (SingletonsList Inline) a, - Walkable (SingletonsList Block) a, - Walkable (List Inline) a, - Walkable (List Block) a) - => a -> LuaFilter -> LuaE PandocError a -walkElement x f = walkInlines f x - >>= walkInlineLists f - >>= walkBlocks f - >>= walkBlockLists f - functions :: [DocumentedFunction PandocError] functions = [ defun "pipe" @@ -206,15 +192,21 @@ functions = , defun "walk_block" ### walkElement <#> parameter peekBlockFuzzy "Block" "block" "element to traverse" - <#> parameter peekLuaFilter "LuaFilter" "filter" "filter functions" + <#> parameter peekFilter "Filter" "lua_filter" "filter functions" =#> functionResult pushBlock "Block" "modified Block" , defun "walk_inline" ### walkElement <#> parameter peekInlineFuzzy "Inline" "inline" "element to traverse" - <#> parameter peekLuaFilter "LuaFilter" "filter" "filter functions" + <#> parameter peekFilter "Filter" "lua_filter" "filter functions" =#> functionResult pushInline "Inline" "modified Inline" ] + where + walkElement x f = + walkInlineSplicing f x + >>= walkInlinesStraight f + >>= walkBlockSplicing f + >>= walkBlocksStraight f data PipeError = PipeError { pipeErrorCommand :: T.Text diff --git a/src/Text/Pandoc/Lua/Walk.hs b/src/Text/Pandoc/Lua/Walk.hs deleted file mode 100644 index 75ed1f471..000000000 --- a/src/Text/Pandoc/Lua/Walk.hs +++ /dev/null @@ -1,183 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE UndecidableInstances #-} -{- | -Module : Text.Pandoc.Lua.Walk -Copyright : © 2012-2021 John MacFarlane, - © 2017-2021 Albert Krewinkel -License : GNU GPL, version 2 or above -Maintainer : Albert Krewinkel -Stability : alpha - -Walking documents in a filter-suitable way. --} -module Text.Pandoc.Lua.Walk - ( SingletonsList (..) - , List (..) - ) -where - -import Control.Monad ((<=<)) -import Data.Data (Data) -import HsLua (Pushable (push)) -import Text.Pandoc.Lua.Marshal.AST (pushBlocks, pushInlines) -import Text.Pandoc.Definition -import Text.Pandoc.Walk - - --- | Helper type which allows to traverse trees in order, while splicing in --- trees. --- --- The only interesting use of this type is via it's '@Walkable@' instance. That --- instance makes it possible to walk a Pandoc document (or a subset thereof), --- while applying a function on each element of an AST element /list/, and have --- the resulting list spliced back in place of the original element. This is the --- traversal/splicing method used for Lua filters. -newtype SingletonsList a = SingletonsList { singletonsList :: [a] } - deriving (Functor, Foldable, Traversable) - --- --- SingletonsList Inline --- -instance {-# OVERLAPPING #-} Walkable (SingletonsList Inline) [Inline] where - walkM = walkSingletonsListM - query = querySingletonsList - -instance Walkable (SingletonsList Inline) Pandoc where - walkM = walkPandocM - query = queryPandoc - -instance Walkable (SingletonsList Inline) Citation where - walkM = walkCitationM - query = queryCitation - -instance Walkable (SingletonsList Inline) Inline where - walkM = walkInlineM - query = queryInline - -instance Walkable (SingletonsList Inline) Block where - walkM = walkBlockM - query = queryBlock - -instance Walkable (SingletonsList Inline) Row where - walkM = walkRowM - query = queryRow - -instance Walkable (SingletonsList Inline) TableHead where - walkM = walkTableHeadM - query = queryTableHead - -instance Walkable (SingletonsList Inline) TableBody where - walkM = walkTableBodyM - query = queryTableBody - -instance Walkable (SingletonsList Inline) TableFoot where - walkM = walkTableFootM - query = queryTableFoot - -instance Walkable (SingletonsList Inline) Caption where - walkM = walkCaptionM - query = queryCaption - -instance Walkable (SingletonsList Inline) Cell where - walkM = walkCellM - query = queryCell - -instance Walkable (SingletonsList Inline) MetaValue where - walkM = walkMetaValueM - query = queryMetaValue - -instance Walkable (SingletonsList Inline) Meta where - walkM f (Meta metamap) = Meta <$> walkM f metamap - query f (Meta metamap) = query f metamap - --- --- SingletonsList Block --- -instance {-# OVERLAPPING #-} Walkable (SingletonsList Block) [Block] where - walkM = walkSingletonsListM - query = querySingletonsList - -instance Walkable (SingletonsList Block) Pandoc where - walkM = walkPandocM - query = queryPandoc - -instance Walkable (SingletonsList Block) Citation where - walkM = walkCitationM - query = queryCitation - -instance Walkable (SingletonsList Block) Inline where - walkM = walkInlineM - query = queryInline - -instance Walkable (SingletonsList Block) Block where - walkM = walkBlockM - query = queryBlock - -instance Walkable (SingletonsList Block) Row where - walkM = walkRowM - query = queryRow - -instance Walkable (SingletonsList Block) TableHead where - walkM = walkTableHeadM - query = queryTableHead - -instance Walkable (SingletonsList Block) TableBody where - walkM = walkTableBodyM - query = queryTableBody - -instance Walkable (SingletonsList Block) TableFoot where - walkM = walkTableFootM - query = queryTableFoot - -instance Walkable (SingletonsList Block) Caption where - walkM = walkCaptionM - query = queryCaption - -instance Walkable (SingletonsList Block) Cell where - walkM = walkCellM - query = queryCell - -instance Walkable (SingletonsList Block) MetaValue where - walkM = walkMetaValueM - query = queryMetaValue - -instance Walkable (SingletonsList Block) Meta where - walkM f (Meta metamap) = Meta <$> walkM f metamap - query f (Meta metamap) = query f metamap - - -walkSingletonsListM :: (Monad m, Walkable (SingletonsList a) a) - => (SingletonsList a -> m (SingletonsList a)) - -> [a] -> m [a] -walkSingletonsListM f = - let f' = fmap singletonsList . f . SingletonsList . (:[]) <=< walkM f - in fmap mconcat . mapM f' - -querySingletonsList :: (Monoid c, Walkable (SingletonsList a) a) - => (SingletonsList a -> c) - -> [a] -> c -querySingletonsList f = - let f' x = f (SingletonsList [x]) `mappend` query f x - in mconcat . map f' - - --- | List wrapper where each list is processed as a whole, but special --- pushed to Lua in type-dependent ways. --- --- The walk instance is basically that of unwrapped Haskell lists. -newtype List a = List { fromList :: [a] } - deriving (Data, Eq, Show) - -instance Pushable (List Block) where - push (List xs) = pushBlocks xs - -instance Pushable (List Inline) where - push (List xs) = pushInlines xs - -instance Walkable [a] b => Walkable (List a) b where - walkM f = walkM (fmap fromList . f . List) - query f = query (f . List) diff --git a/stack.yaml b/stack.yaml index 45215123b..e1eb606b8 100644 --- a/stack.yaml +++ b/stack.yaml @@ -26,7 +26,6 @@ extra-deps: - lua-2.0.2 - tasty-hslua-1.0.0 - tasty-lua-1.0.0 -- pandoc-lua-marshal-0.1.0.1 - pandoc-types-1.22.1 - commonmark-0.2.1.1 - commonmark-extensions-0.2.2 @@ -37,6 +36,8 @@ extra-deps: - unicode-data-0.2.0 - git: https://github.com/jgm/ipynb.git commit: 00246af10885c2ad4413ace4f69a7e6c88297a08 +- git: https://github.com/pandoc/pandoc-lua-marshal.git + commit: c24be07a51a6fd5ea2e1ec244b8caf220cea5ce4 ghc-options: "$locals": -fhide-source-paths -Wno-missing-home-modules resolver: lts-18.10 diff --git a/test/lua/implicit-doc-filter.lua b/test/lua/implicit-doc-filter.lua index 253462d1c..f053dc1b2 100644 --- a/test/lua/implicit-doc-filter.lua +++ b/test/lua/implicit-doc-filter.lua @@ -1,4 +1,4 @@ -function Doc (doc) +function Pandoc (doc) local meta = {} local hello = { pandoc.Str "Hello,", pandoc.Space(), pandoc.Str "World!" } local blocks = { pandoc.Para(hello) } -- cgit v1.2.3 From dc3dcc2ccd3435ca88cf1eaeea05f62806f066d6 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sun, 19 Dec 2021 14:31:52 +0100 Subject: Lua: fixup, should have been part of previous commit --- src/Text/Pandoc/Lua/Module/Pandoc.hs | 3 +++ test/lua/module/pandoc-utils.lua | 6 +++--- 2 files changed, 6 insertions(+), 3 deletions(-) (limited to 'test/lua') diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index ac159ae0d..20c2f5af5 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -116,6 +116,9 @@ otherConstructors = , mkBlocks , mkCitation , mkCell + , mkRow + , mkTableHead + , mkTableFoot , mkInlines , mkListAttributes , mkSimpleTable diff --git a/test/lua/module/pandoc-utils.lua b/test/lua/module/pandoc-utils.lua index 9bd903f2d..0c3831bb1 100644 --- a/test/lua/module/pandoc-utils.lua +++ b/test/lua/module/pandoc-utils.lua @@ -106,14 +106,14 @@ return { {long = {pandoc.Plain { pandoc.Str "the", pandoc.Space(), pandoc.Str "caption"}}}, {{pandoc.AlignDefault, nil}}, - {pandoc.Attr(), {{pandoc.Attr(), {simple_cell{pandoc.Plain "head1"}}}}}, + pandoc.TableHead{pandoc.Row{simple_cell{pandoc.Plain "head1"}}}, {{ attr = pandoc.Attr(), - body = {{pandoc.Attr(), {simple_cell{pandoc.Plain "cell1"}}}}, + body = {pandoc.Row{simple_cell{pandoc.Plain "cell1"}}}, head = {}, row_head_columns = 0 }}, - {pandoc.Attr(), {}}, + pandoc.TableFoot(), pandoc.Attr() ) local stbl = utils.to_simple_table(tbl) -- 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 'test/lua') 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 From d7cab5198269fbbdbc40f54a2ad7aeb83fee619f Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 21 Dec 2021 09:40:23 +0100 Subject: Lua: add new library function `pandoc.utils.type`. The function behaves like the default `type` function from Lua's standard library, but is aware of pandoc userdata types. A typical use-case would be to determine the type of a metadata value. --- doc/lua-filters.md | 36 ++++++++++++++++++++++++++++++++- src/Text/Pandoc/Lua/Module/Utils.hs | 12 +++++++++++ test/lua/module/pandoc-utils.lua | 40 +++++++++++++++++++++++++++++++++++++ 3 files changed, 87 insertions(+), 1 deletion(-) (limited to 'test/lua') diff --git a/doc/lua-filters.md b/doc/lua-filters.md index 901fd6be8..e5ea90104 100644 --- a/doc/lua-filters.md +++ b/doc/lua-filters.md @@ -1863,7 +1863,8 @@ Fields: Column alignment and width specification for a single table column. -This is a pair with the following components: +This is a pair, i.e., a plain table, with the following +components: 1. cell alignment ([Alignment]). 2. table column width, as a fraction of the total table width @@ -3507,6 +3508,39 @@ Usage: -- create normal table block again table = pandoc.utils.from_simple_table(simple) +### type {#pandoc.utils.type} + +`type (value)` + +Pandoc-friendly version of Lua's default `type` function, +returning the type of a value. This function works with all types +listed in section [Lua type reference][], except if noted +otherwise. + +The function works by checking the metafield `__name`. If the +argument has a string-valued metafield `__name`, then it returns +that string. Otherwise it behaves just like the normal `type` +function. + +Parameters: + +`value` +: any Lua value + +Returns: + +- type of the given value (string) + +Usage: + + -- Prints one of 'string', 'boolean', 'Inlines', 'Blocks', + -- 'table', and 'nil', corresponding to the Haskell constructors + -- MetaString, MetaBool, MetaInlines, MetaBlocks, MetaMap, + -- and an unset value, respectively. + function Meta (meta) + print('type of metavalue `author`:', pandoc.utils.type(meta.author)) + end + # Module pandoc.mediabag The `pandoc.mediabag` module allows accessing pandoc's media diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 439a9a50b..c1bb42410 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -21,6 +21,7 @@ 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.Class.Peekable (PeekError) @@ -145,6 +146,17 @@ documentedModule = Module <#> 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.") ] } diff --git a/test/lua/module/pandoc-utils.lua b/test/lua/module/pandoc-utils.lua index 7a43e9286..104adfe4c 100644 --- a/test/lua/module/pandoc-utils.lua +++ b/test/lua/module/pandoc-utils.lua @@ -116,6 +116,46 @@ return { end) }, + group 'type' { + test('nil', function () + assert.are_equal(utils.type(nil), 'nil') + end), + test('boolean', function () + assert.are_equal(utils.type(true), 'boolean') + assert.are_equal(utils.type(false), 'boolean') + end), + test('number', function () + assert.are_equal(utils.type(5), 'number') + assert.are_equal(utils.type(-3.02), 'number') + end), + test('string', function () + assert.are_equal(utils.type(''), 'string') + assert.are_equal(utils.type('asdf'), 'string') + end), + test('plain table', function () + assert.are_equal(utils.type({}), 'table') + end), + test('List', function () + assert.are_equal(utils.type(pandoc.List{}), 'List') + end), + test('Inline', function () + assert.are_equal(utils.type(pandoc.Str 'a'), 'Inline') + assert.are_equal(utils.type(pandoc.Emph 'emphasized'), 'Inline') + end), + test('Inlines', function () + assert.are_equal(utils.type(pandoc.Inlines{pandoc.Str 'a'}), 'Inlines') + assert.are_equal(utils.type(pandoc.Inlines{pandoc.Emph 'b'}), 'Inlines') + end), + test('Blocks', function () + assert.are_equal(utils.type(pandoc.Para 'a'), 'Block') + assert.are_equal(utils.type(pandoc.CodeBlock 'true'), 'Block') + end), + test('Inlines', function () + assert.are_equal(utils.type(pandoc.Blocks{'a'}), 'Blocks') + assert.are_equal(utils.type(pandoc.Blocks{pandoc.CodeBlock 'b'}), 'Blocks') + end), + }, + group 'to_simple_table' { test('convertes Table', function () function simple_cell (blocks) -- cgit v1.2.3 From 1c389bf6b6236cefcadac3c2eefe62eb6c884863 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 21 Dec 2021 17:12:56 +0100 Subject: Lua: add tests for pandoc.utils.equals --- test/lua/module/pandoc-utils.lua | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) (limited to 'test/lua') diff --git a/test/lua/module/pandoc-utils.lua b/test/lua/module/pandoc-utils.lua index 104adfe4c..db363ebe6 100644 --- a/test/lua/module/pandoc-utils.lua +++ b/test/lua/module/pandoc-utils.lua @@ -39,6 +39,46 @@ return { end) }, + group 'equals' { + test('compares Pandoc elements', function () + assert.is_truthy( + utils.equals(pandoc.Pandoc{'foo'}, pandoc.Pandoc{'foo'}) + ) + end), + test('compares Block elements', function () + assert.is_truthy( + utils.equals(pandoc.Plain{'foo'}, pandoc.Plain{'foo'}) + ) + assert.is_falsy( + utils.equals(pandoc.Para{'foo'}, pandoc.Plain{'foo'}) + ) + end), + test('compares Inline elements', function () + assert.is_truthy( + utils.equals(pandoc.Emph{'foo'}, pandoc.Emph{'foo'}) + ) + assert.is_falsy( + utils.equals(pandoc.Emph{'foo'}, pandoc.Strong{'foo'}) + ) + end), + test('compares Inline with Block elements', function () + assert.is_falsy( + utils.equals(pandoc.Emph{'foo'}, pandoc.Plain{'foo'}) + ) + assert.is_falsy( + utils.equals(pandoc.Para{'foo'}, pandoc.Strong{'foo'}) + ) + end), + test('compares Pandoc with Block elements', function () + assert.is_falsy( + utils.equals(pandoc.Pandoc{'foo'}, pandoc.Plain{'foo'}) + ) + assert.is_falsy( + utils.equals(pandoc.Para{'foo'}, pandoc.Pandoc{'foo'}) + ) + end), + }, + group 'make_sections' { test('sanity check', function () local blks = { -- cgit v1.2.3 From edb04a78dba3490dc28ef68d5133b0220a0426fa Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 21 Dec 2021 21:25:16 +0100 Subject: Lua tests: add more tests for `pandoc.utils.stringify`. --- test/lua/module/pandoc-utils.lua | 47 ++++++++++++++++++++++++++++++++++++++-- 1 file changed, 45 insertions(+), 2 deletions(-) (limited to 'test/lua') diff --git a/test/lua/module/pandoc-utils.lua b/test/lua/module/pandoc-utils.lua index db363ebe6..73886346c 100644 --- a/test/lua/module/pandoc-utils.lua +++ b/test/lua/module/pandoc-utils.lua @@ -135,7 +135,7 @@ return { }, group 'stringify' { - test('inlines', function () + test('Inline', function () local inline = pandoc.Emph{ pandoc.Str 'Cogito', pandoc.Space(), @@ -144,7 +144,50 @@ return { pandoc.Str 'sum.', } assert.are_equal('Cogito ergo sum.', utils.stringify(inline)) - end) + end), + test('Block', function () + local block = pandoc.Para{ + pandoc.Str 'Make', + pandoc.Space(), + pandoc.Str 'it', + pandoc.Space(), + pandoc.Str 'so.', + } + assert.are_equal('Make it so.', utils.stringify(block)) + end), + test('boolean', function () + assert.are_equal('true', utils.stringify(true)) + assert.are_equal('false', utils.stringify(false)) + end), + test('number', function () + assert.are_equal('5', utils.stringify(5)) + assert.are_equal('23.23', utils.stringify(23.23)) + end), + test('Attr', function () + local attr = pandoc.Attr('foo', {'bar'}, {a = 'b'}) + assert.are_equal('', utils.stringify(attr)) + end), + test('List', function () + local list = pandoc.List{pandoc.Str 'a', pandoc.Blocks('b')} + assert.are_equal('ab', utils.stringify(list)) + end), + test('Blocks', function () + local blocks = pandoc.Blocks{pandoc.Para 'a', pandoc.Header(1, 'b')} + assert.are_equal('ab', utils.stringify(blocks)) + end), + test('Inlines', function () + local inlines = pandoc.Inlines{pandoc.Str 'a', pandoc.Subscript('b')} + assert.are_equal('ab', utils.stringify(inlines)) + end), + test('Meta', function () + local meta = pandoc.Meta{ + a = pandoc.Inlines 'a text', + b = 'movie', + c = pandoc.List{pandoc.Inlines{pandoc.Str '!'}} + } + -- nested MetaString values are not stringified. + assert.are_equal('a text!', utils.stringify(meta)) + end), }, group 'to_roman_numeral' { -- cgit v1.2.3 From 0bdf37315766eb4b785002ffaf38cdb724628e7a Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 21 Dec 2021 21:50:13 +0100 Subject: Lua: simplify code of pandoc.utils.stringify Minor behavior change: plain strings nested in tables are now included in the result string. --- src/Text/Pandoc/Lua/Module/Utils.hs | 62 +++++++++++++------------------------ test/lua/module/pandoc-utils.lua | 7 ++--- 2 files changed, 25 insertions(+), 44 deletions(-) (limited to 'test/lua') diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 24fd3402e..eabb2b532 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -24,7 +24,6 @@ import Data.Default (def) import Data.Maybe (fromMaybe) 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 @@ -35,6 +34,7 @@ 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.Filter.JSON as JSONFilter @@ -126,8 +126,8 @@ documentedModule = Module =#> functionResult pushPandoc "Pandoc" "filtered document" , defun "stringify" - ### unPandocLua . stringify - <#> parameter peekAstElement "AST element" "elem" "some pandoc AST element" + ### stringify + <#> parameter pure "AST element" "elem" "some pandoc AST element" =#> functionResult pushText "string" "stringified element" , defun "from_simple_table" @@ -172,43 +172,25 @@ sha1 = defun "sha1" -- | Convert pandoc structure to a string with formatting removed. -- Footnotes are skipped (since we don't want their contents in link -- labels). -stringify :: AstElement -> PandocLua T.Text -stringify el = return $ case el of - PandocElement pd -> Shared.stringify pd - InlineElement i -> Shared.stringify i - BlockElement b -> Shared.stringify b - MetaElement m -> Shared.stringify m - CitationElement c -> Shared.stringify c - MetaValueElement m -> stringifyMetaValue m - _ -> mempty - -stringifyMetaValue :: MetaValue -> T.Text -stringifyMetaValue mv = case mv of - MetaBool b -> T.toLower $ T.pack (show b) - MetaString s -> s - _ -> Shared.stringify mv - -data AstElement - = PandocElement Pandoc - | MetaElement Meta - | BlockElement Block - | InlineElement Inline - | MetaValueElement MetaValue - | AttrElement Attr - | ListAttributesElement ListAttributes - | CitationElement Citation - deriving (Eq, Show) - -peekAstElement :: PeekError e => Peeker e AstElement -peekAstElement = retrieving "pandoc AST element" . choice - [ (fmap PandocElement . peekPandoc) - , (fmap InlineElement . peekInline) - , (fmap BlockElement . peekBlock) - , (fmap MetaValueElement . peekMetaValue) - , (fmap AttrElement . peekAttr) - , (fmap ListAttributesElement . peekListAttributes) - , (fmap MetaElement . peekMeta) - ] +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 diff --git a/test/lua/module/pandoc-utils.lua b/test/lua/module/pandoc-utils.lua index 73886346c..0475e96ec 100644 --- a/test/lua/module/pandoc-utils.lua +++ b/test/lua/module/pandoc-utils.lua @@ -181,12 +181,11 @@ return { end), test('Meta', function () local meta = pandoc.Meta{ - a = pandoc.Inlines 'a text', - b = 'movie', + a = pandoc.Inlines 'funny and ', + b = 'good movie', c = pandoc.List{pandoc.Inlines{pandoc.Str '!'}} } - -- nested MetaString values are not stringified. - assert.are_equal('a text!', utils.stringify(meta)) + assert.are_equal('funny and good movie!', utils.stringify(meta)) end), }, -- cgit v1.2.3 From fbd2c8e376eea5eccc0b799f8e48d10c7ab8b6d9 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 25 Dec 2021 20:47:29 +0100 Subject: Lua: improve handling of empty caption, body by `from_simple_table` Create truly empty table caption and body when these are empty in the simple table. Fixes: #7776 --- src/Text/Pandoc/Lua/Module/Utils.hs | 4 ++-- test/lua/module/pandoc-utils.lua | 27 +++++++++++++++++++++++++++ 2 files changed, 29 insertions(+), 2 deletions(-) (limited to 'test/lua') diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index eabb2b532..02307cf7a 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -197,10 +197,10 @@ 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]) + (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] + [TableBody nullAttr 0 [] $ map blockListToRow body | not (null body)] (TableFoot nullAttr []) return (NumResults 1) where diff --git a/test/lua/module/pandoc-utils.lua b/test/lua/module/pandoc-utils.lua index 0475e96ec..4cf2c84a7 100644 --- a/test/lua/module/pandoc-utils.lua +++ b/test/lua/module/pandoc-utils.lua @@ -302,5 +302,32 @@ return { -- reversible assert.are_same(simple_table, utils.to_simple_table(tbl)) end), + test('empty caption', function () + local simple_table = pandoc.SimpleTable( + {}, + {pandoc.AlignDefault}, + {0}, + {{pandoc.Plain 'a'}}, + {{{pandoc.Plain 'b'}}} + ) + local tbl = utils.from_simple_table(simple_table) + assert.are_equal( + pandoc.Blocks{}, + tbl.caption.long + ) + assert.is_nil(tbl.caption.short) + end), + test('empty body', function () + local simple_table = pandoc.SimpleTable( + pandoc.Inlines('a nice caption'), + {pandoc.AlignDefault}, + {0}, + {{pandoc.Plain 'a'}}, + {} + ) + local tbl = utils.from_simple_table(simple_table) + tbl.bodies:map(print) + assert.are_same(pandoc.List(), tbl.bodies) + end), } } -- cgit v1.2.3