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.
This commit is contained in:
parent
e4287e6c95
commit
8523bb01b2
8 changed files with 272 additions and 188 deletions
155
data/pandoc.lua
155
data/pandoc.lua
|
@ -281,33 +281,12 @@ local function ensureDefinitionPairs (pair)
|
||||||
return {inlines, blocks}
|
return {inlines, blocks}
|
||||||
end
|
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.
|
--- Try hard to turn the arguments into an Attr object.
|
||||||
local function ensureAttr(attr)
|
local function ensureAttr(attr)
|
||||||
if type(attr) == 'table' then
|
if type(attr) == 'userdata' then
|
||||||
if #attr > 0 then return M.Attr(table.unpack(attr)) end
|
return attr
|
||||||
|
|
||||||
-- 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)
|
|
||||||
end
|
end
|
||||||
-- print(arg, ...)
|
return M.Attr(attr)
|
||||||
error('Could not convert to Attr')
|
|
||||||
end
|
end
|
||||||
|
|
||||||
------------------------------------------------------------------------
|
------------------------------------------------------------------------
|
||||||
|
@ -831,134 +810,6 @@ M.Underline = M.Inline:create_constructor(
|
||||||
-- Element components
|
-- Element components
|
||||||
-- @section 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
|
-- Monkey-patch setters for `attr` fields to be more forgiving in the input that
|
||||||
-- results in a valid Attr value.
|
-- results in a valid Attr value.
|
||||||
function augment_attr_setter (setters)
|
function augment_attr_setter (setters)
|
||||||
|
|
|
@ -776,6 +776,7 @@ library
|
||||||
Text.Pandoc.Lua.Init,
|
Text.Pandoc.Lua.Init,
|
||||||
Text.Pandoc.Lua.Marshaling,
|
Text.Pandoc.Lua.Marshaling,
|
||||||
Text.Pandoc.Lua.Marshaling.AST,
|
Text.Pandoc.Lua.Marshaling.AST,
|
||||||
|
Text.Pandoc.Lua.Marshaling.Attr,
|
||||||
Text.Pandoc.Lua.Marshaling.CommonState,
|
Text.Pandoc.Lua.Marshaling.CommonState,
|
||||||
Text.Pandoc.Lua.Marshaling.Context,
|
Text.Pandoc.Lua.Marshaling.Context,
|
||||||
Text.Pandoc.Lua.Marshaling.List,
|
Text.Pandoc.Lua.Marshaling.List,
|
||||||
|
|
|
@ -89,7 +89,6 @@ putConstructorsInRegistry = liftPandocLua $ do
|
||||||
constrsToReg $ Pandoc.Meta mempty
|
constrsToReg $ Pandoc.Meta mempty
|
||||||
constrsToReg $ Pandoc.MetaList mempty
|
constrsToReg $ Pandoc.MetaList mempty
|
||||||
constrsToReg $ Pandoc.Citation mempty mempty mempty Pandoc.AuthorInText 0 0
|
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 "ListAttributes" -- used for ListAttributes type alias
|
||||||
putInReg "List" -- pandoc.List
|
putInReg "List" -- pandoc.List
|
||||||
putInReg "SimpleTable" -- helper for backward-compatible table handling
|
putInReg "SimpleTable" -- helper for backward-compatible table handling
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
@ -40,6 +41,7 @@ import Control.Monad ((<$!>), (>=>))
|
||||||
import HsLua hiding (Operation (Div))
|
import HsLua hiding (Operation (Div))
|
||||||
import Text.Pandoc.Definition
|
import Text.Pandoc.Definition
|
||||||
import Text.Pandoc.Lua.Util (pushViaConstr', pushViaConstructor)
|
import Text.Pandoc.Lua.Util (pushViaConstr', pushViaConstructor)
|
||||||
|
import Text.Pandoc.Lua.Marshaling.Attr (peekAttr, pushAttr)
|
||||||
import Text.Pandoc.Lua.Marshaling.List (pushPandocList)
|
import Text.Pandoc.Lua.Marshaling.List (pushPandocList)
|
||||||
|
|
||||||
import qualified HsLua as Lua
|
import qualified HsLua as Lua
|
||||||
|
@ -413,19 +415,6 @@ peekInline = retrieving "Inline" . \idx -> do
|
||||||
"Superscript"-> mkBlock Superscript peekInlines
|
"Superscript"-> mkBlock Superscript peekInlines
|
||||||
Name tag -> Lua.failPeek ("Unknown inline type: " <> tag)
|
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 :: forall e. LuaError e => ListAttributes -> LuaE e ()
|
||||||
pushListAttributes (start, style, delimiter) =
|
pushListAttributes (start, style, delimiter) =
|
||||||
pushViaConstr' "ListAttributes"
|
pushViaConstr' "ListAttributes"
|
||||||
|
@ -450,3 +439,6 @@ instance Peekable Meta where
|
||||||
|
|
||||||
instance Peekable Pandoc where
|
instance Peekable Pandoc where
|
||||||
peek = forcePeek . peekPandoc
|
peek = forcePeek . peekPandoc
|
||||||
|
|
||||||
|
instance {-# OVERLAPPING #-} Peekable Attr where
|
||||||
|
peek = forcePeek . peekAttr
|
||||||
|
|
225
src/Text/Pandoc/Lua/Marshaling/Attr.hs
Normal file
225
src/Text/Pandoc/Lua/Marshaling/Attr.hs
Normal file
|
@ -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
|
|
@ -29,6 +29,7 @@ import Text.Pandoc.Lua.Filter (SingletonsList (..), walkInlines,
|
||||||
walkInlineLists, walkBlocks, walkBlockLists)
|
walkInlineLists, walkBlocks, walkBlockLists)
|
||||||
import Text.Pandoc.Lua.Marshaling ()
|
import Text.Pandoc.Lua.Marshaling ()
|
||||||
import Text.Pandoc.Lua.Marshaling.AST
|
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.List (List (..))
|
||||||
import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua,
|
import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua,
|
||||||
loadDefaultModule)
|
loadDefaultModule)
|
||||||
|
@ -54,6 +55,8 @@ pushModule = do
|
||||||
addFunction "walk_inline" (walkElement peekInline pushInline)
|
addFunction "walk_inline" (walkElement peekInline pushInline)
|
||||||
-- Constructors
|
-- Constructors
|
||||||
addFunction "Pandoc" mkPandoc
|
addFunction "Pandoc" mkPandoc
|
||||||
|
addFunction "Attr" (liftPandocLua mkAttr)
|
||||||
|
addFunction "AttributeList" (liftPandocLua mkAttributeList)
|
||||||
return 1
|
return 1
|
||||||
|
|
||||||
walkElement :: (Walkable (SingletonsList Inline) a,
|
walkElement :: (Walkable (SingletonsList Inline) a,
|
||||||
|
|
|
@ -204,7 +204,7 @@ tests = map (localOption (QuickCheckTests 20))
|
||||||
[Para [Str "ignored"]])
|
[Para [Str "ignored"]])
|
||||||
Lua.getfield Lua.top "attr"
|
Lua.getfield Lua.top "attr"
|
||||||
Lua.liftIO . assertEqual "no accessor" (("hi", ["moin"], []) :: 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
|
, testCase "module `pandoc.system` is present" . runLuaTest $ do
|
||||||
Lua.getglobal' "pandoc.system"
|
Lua.getglobal' "pandoc.system"
|
||||||
|
|
|
@ -11,34 +11,32 @@ end
|
||||||
return {
|
return {
|
||||||
group 'Attr' {
|
group 'Attr' {
|
||||||
group 'Constructor' {
|
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 ()
|
test('returns null-Attr if no arguments are given', function ()
|
||||||
local attr = pandoc.Attr()
|
local attr = pandoc.Attr()
|
||||||
assert.are_equal(attr.identifier, '')
|
assert.are_equal(attr.identifier, '')
|
||||||
assert.are_same(attr.classes, {})
|
assert.are_same(attr.classes, {})
|
||||||
assert.are_same(attr.attributes, {})
|
assert.are_same(#attr.attributes, 0)
|
||||||
end),
|
end),
|
||||||
test(
|
test(
|
||||||
'accepts string-indexed table or list of pairs as attributes',
|
'accepts string-indexed table or list of pairs as attributes',
|
||||||
function ()
|
function ()
|
||||||
local attributes_list = pandoc.List:new {{'one', '1'}, {'two', '2'}}
|
local attributes_list = {{'one', '1'}, {'two', '2'}}
|
||||||
local attr_from_list = pandoc.Attr('', {}, attributes_list:clone())
|
local attr_from_list = pandoc.Attr('', {}, attributes_list)
|
||||||
|
|
||||||
assert.are_same(
|
assert.are_equal(attr_from_list.attributes.one, '1')
|
||||||
pandoc.List:new(attr_from_list.attributes),
|
assert.are_equal(attr_from_list.attributes.two, '2')
|
||||||
attributes_list
|
|
||||||
)
|
|
||||||
|
|
||||||
local attributes_table = {one = '1', two = '2'}
|
local attributes_table = {one = '1', two = '2'}
|
||||||
local attr_from_table = pandoc.Attr('', {}, attributes_table)
|
local attr_from_table = pandoc.Attr('', {}, attributes_table)
|
||||||
|
assert.are_equal(
|
||||||
local assoc_list_from_table =
|
attr_from_table.attributes,
|
||||||
pandoc.List:new(attr_from_table.attributes)
|
pandoc.AttributeList(attributes_table)
|
||||||
-- 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.one, '1')
|
||||||
|
assert.are_equal(attr_from_table.attributes.two, '2')
|
||||||
end
|
end
|
||||||
)
|
)
|
||||||
},
|
},
|
||||||
|
@ -53,27 +51,41 @@ return {
|
||||||
assert.are_same(attributes[1], {'a', '1'})
|
assert.are_same(attributes[1], {'a', '1'})
|
||||||
assert.are_same(attributes[2], {'b', '2'})
|
assert.are_same(attributes[2], {'b', '2'})
|
||||||
end),
|
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 ()
|
test('adds entries by field name', function ()
|
||||||
local attributes = pandoc.Attr('',{}, {{'c', '1'}, {'d', '2'}}).attributes
|
local attributes = pandoc.Attr('',{}, {{'c', '1'}, {'d', '2'}}).attributes
|
||||||
attributes.e = '3'
|
attributes.e = '3'
|
||||||
assert.are_same(
|
assert.are_same(
|
||||||
|
attributes,
|
||||||
-- checking the full AttributeList would "duplicate" entries
|
-- checking the full AttributeList would "duplicate" entries
|
||||||
setmetatable(attributes, nil),
|
pandoc.AttributeList{{'c', '1'}, {'d', '2'}, {'e', '3'}}
|
||||||
{{'c', '1'}, {'d', '2'}, {'e', '3'}}
|
|
||||||
)
|
)
|
||||||
end),
|
end),
|
||||||
test('deletes entries by field name', function ()
|
test('deletes entries by field name', function ()
|
||||||
local attributes = pandoc.Attr('',{}, {a = '1', b = '2'}).attributes
|
local attributes = pandoc.Attr('',{}, {a = '1', b = '2'}).attributes
|
||||||
attributes.a = nil
|
attributes.a = nil
|
||||||
assert.is_nil(attributes.a)
|
assert.is_nil(attributes.a)
|
||||||
local assoc_list = setmetatable(attributes, nil)
|
assert.are_same(attributes, pandoc.AttributeList{{'b', '2'}})
|
||||||
assert.are_same(assoc_list, {{'b', '2'}})
|
|
||||||
end),
|
end),
|
||||||
test('remains unchanged if deleted key did not exist', function ()
|
test('remains unchanged if deleted key did not exist', function ()
|
||||||
local assoc_list = pandoc.List:new {{'alpha', 'x'}, {'beta', 'y'}}
|
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
|
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),
|
end),
|
||||||
test('gives key-value pairs when iterated-over', function ()
|
test('gives key-value pairs when iterated-over', function ()
|
||||||
local attributes = {width = '11', height = '22', name = 'test'}
|
local attributes = {width = '11', height = '22', name = 'test'}
|
||||||
|
@ -110,6 +122,7 @@ return {
|
||||||
}
|
}
|
||||||
local span = pandoc.Span 'test'
|
local span = pandoc.Span 'test'
|
||||||
span.attr = html_attributes
|
span.attr = html_attributes
|
||||||
|
span = span:clone() -- normalize
|
||||||
assert.are_equal(span.attr.identifier, 'the-id')
|
assert.are_equal(span.attr.identifier, 'the-id')
|
||||||
assert.are_equal(span.attr.classes[1], 'class1')
|
assert.are_equal(span.attr.classes[1], 'class1')
|
||||||
assert.are_equal(span.attr.classes[2], 'class2')
|
assert.are_equal(span.attr.classes[2], 'class2')
|
||||||
|
|
Loading…
Reference in a new issue