diff options
| -rw-r--r-- | data/pandoc.lua | 155 | ||||
| -rw-r--r-- | pandoc.cabal | 1 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Init.hs | 1 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/AST.hs | 18 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/Attr.hs | 225 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Module/Pandoc.hs | 3 | ||||
| -rw-r--r-- | test/Tests/Lua.hs | 2 | ||||
| -rw-r--r-- | test/lua/module/pandoc.lua | 55 |
8 files changed, 272 insertions, 188 deletions
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 <tarleb+pandoc@moltkeplatz.de> +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]<y[1] end) - assert.are_same( - assoc_list_from_table, - attributes_list + 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 ) }, @@ -53,27 +51,41 @@ return { 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 - setmetatable(attributes, nil), - {{'c', '1'}, {'d', '2'}, {'e', '3'}} + pandoc.AttributeList{{'c', '1'}, {'d', '2'}, {'e', '3'}} ) 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) - local assoc_list = setmetatable(attributes, nil) - assert.are_same(assoc_list, {{'b', '2'}}) + 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:clone()).attributes + local attributes = pandoc.Attr('', {}, assoc_list).attributes attributes.a = nil - assert.are_same(pandoc.List:new(attributes), assoc_list) + 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'} @@ -110,6 +122,7 @@ return { } 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') |