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. --- src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs | 37 ++++++++++++--------------- 1 file changed, 16 insertions(+), 21 deletions(-) (limited to 'src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs') diff --git a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs b/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs index 6d43039fa..e9c169dc0 100644 --- a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs +++ b/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Lua.Marshaling.SimpleTable Copyright : © 2020-2021 Albert Krewinkel @@ -16,12 +19,11 @@ module Text.Pandoc.Lua.Marshaling.SimpleTable ) where -import Foreign.Lua (Lua, Peekable, Pushable, StackIndex) +import Control.Monad ((<$!>)) +import HsLua as Lua import Text.Pandoc.Definition -import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor, rawField) -import Text.Pandoc.Lua.Marshaling.AST () - -import qualified Foreign.Lua as Lua +import Text.Pandoc.Lua.Util (pushViaConstructor) +import Text.Pandoc.Lua.Marshaling.AST -- | A simple (legacy-style) table. data SimpleTable = SimpleTable @@ -32,16 +34,10 @@ data SimpleTable = SimpleTable , simpleTableBody :: [[[Block]]] } -instance Pushable SimpleTable where - push = pushSimpleTable - -instance Peekable SimpleTable where - peek = peekSimpleTable - -- | Push a simple table to the stack by calling the -- @pandoc.SimpleTable@ constructor. -pushSimpleTable :: SimpleTable -> Lua () -pushSimpleTable tbl = pushViaConstructor "SimpleTable" +pushSimpleTable :: forall e. LuaError e => SimpleTable -> LuaE e () +pushSimpleTable tbl = pushViaConstructor @e "SimpleTable" (simpleTableCaption tbl) (simpleTableAlignments tbl) (simpleTableColumnWidths tbl) @@ -49,11 +45,10 @@ pushSimpleTable tbl = pushViaConstructor "SimpleTable" (simpleTableBody tbl) -- | Retrieve a simple table from the stack. -peekSimpleTable :: StackIndex -> Lua SimpleTable -peekSimpleTable idx = defineHowTo "get SimpleTable" $ - SimpleTable - <$> rawField idx "caption" - <*> rawField idx "aligns" - <*> rawField idx "widths" - <*> rawField idx "headers" - <*> rawField idx "rows" +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 -- 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 'src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs') 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 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 'src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs') 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