pandoc-lua-marshal (empty) → 0.1.0
raw patch · 34 files changed
+3857/−0 lines, 34 filesdep +QuickCheckdep +basedep +bytestring
Dependencies added: QuickCheck, base, bytestring, exceptions, hslua, hslua-marshalling, lua, pandoc-lua-marshal, pandoc-types, safe, tasty, tasty-hunit, tasty-lua, tasty-quickcheck, text
Files
- CHANGELOG.md +13/−0
- LICENSE +21/−0
- README.md +32/−0
- cbits/listmod.c +295/−0
- pandoc-lua-marshal.cabal +106/−0
- src/Text/Pandoc/Lua/Marshal/AST.hs +45/−0
- src/Text/Pandoc/Lua/Marshal/Alignment.hs +22/−0
- src/Text/Pandoc/Lua/Marshal/Attr.hs +247/−0
- src/Text/Pandoc/Lua/Marshal/Block.hs +384/−0
- src/Text/Pandoc/Lua/Marshal/Block.hs-boot +12/−0
- src/Text/Pandoc/Lua/Marshal/Cell.hs +44/−0
- src/Text/Pandoc/Lua/Marshal/Citation.hs +96/−0
- src/Text/Pandoc/Lua/Marshal/CitationMode.hs +24/−0
- src/Text/Pandoc/Lua/Marshal/Content.hs +82/−0
- src/Text/Pandoc/Lua/Marshal/Format.hs +23/−0
- src/Text/Pandoc/Lua/Marshal/Inline.hs +354/−0
- src/Text/Pandoc/Lua/Marshal/Inline.hs-boot +11/−0
- src/Text/Pandoc/Lua/Marshal/List.hs +56/−0
- src/Text/Pandoc/Lua/Marshal/ListAttributes.hs +96/−0
- src/Text/Pandoc/Lua/Marshal/MathType.hs +22/−0
- src/Text/Pandoc/Lua/Marshal/MetaValue.hs +106/−0
- src/Text/Pandoc/Lua/Marshal/Pandoc.hs +82/−0
- src/Text/Pandoc/Lua/Marshal/QuoteType.hs +22/−0
- src/Text/Pandoc/Lua/Marshal/SimpleTable.hs +98/−0
- src/Text/Pandoc/Lua/Marshal/TableParts.hs +133/−0
- test/test-attr.lua +144/−0
- test/test-block.lua +346/−0
- test/test-citation.lua +111/−0
- test/test-inline.lua +300/−0
- test/test-list.lua +215/−0
- test/test-listattributes.lua +65/−0
- test/test-metavalue.lua +15/−0
- test/test-pandoc-lua-marshal.hs +209/−0
- test/test-pandoc.lua +26/−0
+ CHANGELOG.md view
@@ -0,0 +1,13 @@+# Changelog++`pandoc-lua-marshal` uses [PVP Versioning][1].+The changelog is available [on GitHub][2].++## 0.1.0++Released 2021-11-28.++* Released into the wild. May it live long and prosper.++[1]: https://pvp.haskell.org+[2]: https://github.com/pandoc/pandoc-lua-marshal/releases
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2021 Albert Krewinkel++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,32 @@+# pandoc-lua-marshal++[![GitHub CI][]][1]+[![Hackage][]][2]+[![Stackage Lts][]][3]+[![Stackage Nightly][]][4]+[![MIT license]][5]++Use pandoc types in Lua.++[GitHub CI]: https://github.com/tarleb/pandoc-lua-marshal/workflows/CI/badge.svg+[1]: https://github.com/tarleb/pandoc-lua-marshal/actions+[Hackage]: https://img.shields.io/hackage/v/pandoc-lua-marshal.svg?logo=haskell+[2]: https://hackage.haskell.org/package/pandoc-lua-marshal+[Stackage Lts]: http://stackage.org/package/pandoc-lua-marshal/badge/lts+[3]: https://stackage.org/lts/package/pandoc-lua-marshal+[Stackage Nightly]: https://stackage.org/package/pandoc-lua-marshal/badge/nightly+[4]: https://stackage.org/nightly/package/pandoc-lua-marshal+[MIT license]: https://img.shields.io/badge/license-MIT-blue.svg+[5]: LICENSE++## Description++This package provides functions to marshal and unmarshal pandoc+document types to and from Lua.++The values of most types are pushed to pandoc as "userdata"+objects that wrap a stable pointer to the Haskell value; these+objects come with methods to access and modify their properties.++Sequences are pushed as normal Lua tables, but are augmented with+convenience functions.
+ cbits/listmod.c view
@@ -0,0 +1,295 @@+#include <stdlib.h>+#include "lua.h"+#include "lauxlib.h"+#include "lualib.h"++#define LIST_T "List"++/*+** Placeholder function.+*/+static int missing (lua_State *L) {+ return luaL_error(L,+ "Function should have been overwritten with one from the table module."+ );+}++/* translate a relative table position: negative means back from end */+static lua_Integer posrelat (lua_Integer pos, size_t len) {+ if (pos >= 0) return pos;+ else if (0u - (size_t)pos > len) return 0;+ else return (lua_Integer)len + pos + 1;+}++/*+** Creates a List from a table; uses a fresh, empty table if none is+** given.+*/+static int list_new (lua_State *L) {+ lua_settop(L, 2);+ if (lua_isnoneornil(L, 2)) {+ lua_newtable(L);+ lua_remove(L, 2);+ } else {+ luaL_checktype(L, 2, LUA_TTABLE);+ }+ lua_pushvalue(L, 1);+ lua_setmetatable(L, 2);+ return 1;+}++/*+** Creates a shallow clone of the given list; the clone will contain+** only the list elements, not any other elements that might have been+** present.+*/+static int list_clone (lua_State *L) {+ lua_settop(L, 1);+ luaL_checktype(L, 1, LUA_TTABLE);+ lua_Integer len = luaL_len(L, 1);+ lua_createtable(L, len, 0); /* create new table */+ lua_getmetatable(L, 1);+ lua_setmetatable(L, 2);+ for (lua_Integer i = 1; i <= len; i++) {+ lua_geti(L, 1, i);+ lua_seti(L, 2, i);+ }+ return 1;+}++/*+** Creates a new list that is the concatenation of its two arguments.+** The result has the same metatable as the first operand.+*/+static int list_concat (lua_State *L) {+ lua_settop(L, 2);+ luaL_checktype(L, 1, LUA_TTABLE);+ luaL_checktype(L, 2, LUA_TTABLE);+ lua_Integer len1 = luaL_len(L, 1);+ lua_Integer len2 = luaL_len(L, 2);+ lua_createtable(L, len1 + len2, 0); /* result table */+ if (lua_getmetatable(L, 1)) {+ lua_setmetatable(L, 3);+ }+ for (lua_Integer i = 1; i <= len1; i++) {+ lua_geti(L, 1, i);+ lua_seti(L, 3, i);+ }+ for (lua_Integer i = 1; i <= len2; i++) {+ lua_geti(L, 2, i);+ lua_seti(L, 3, len1 + i);+ }+ return 1;+}++/*+** Appends the second list to the first.+*/+static int list_extend (lua_State *L) {+ lua_settop(L, 2);+ luaL_checktype(L, 1, LUA_TTABLE);+ luaL_checktype(L, 2, LUA_TTABLE);+ lua_Integer len1 = luaL_len(L, 1);+ lua_Integer len2 = luaL_len(L, 2);+ for (lua_Integer i = 1; i <= len2; i++) {+ lua_geti(L, 2, i);+ lua_seti(L, 1, len1 + i);+ }+ return 1;+}++/*+** Removes elements that do not have the desired property.+*/+static int list_filter (lua_State *L) {+ lua_settop(L, 2);+ luaL_checktype(L, 1, LUA_TTABLE);+ luaL_checktype(L, 2, LUA_TFUNCTION);+ luaL_checkstack(L, 4, NULL);+ lua_Integer len = luaL_len(L, 1);+ lua_createtable(L, len, 0); /* create new table */+ lua_getmetatable(L, 1);+ lua_setmetatable(L, 3);+ for (lua_Integer i = 1, j = 0; i <= len; i++) {+ lua_pushvalue(L, 2); /* push predicate function */+ lua_geti(L, 1, i);+ lua_pushinteger(L, i);+ lua_call(L, 2, 1);+ if (lua_toboolean(L, -1)) {+ lua_geti(L, 1, i);+ lua_seti(L, 3, ++j);+ }+ lua_pop(L, 1); /* remove predicate call result */+ }+ return 1;+}++/*+** Returns the first element that is equal to `needle`, along with that+** element's index, or `nil` if no such element exists.+*/+static int list_find (lua_State *L) {+ lua_settop(L, 3);+ luaL_checktype(L, 1, LUA_TTABLE);+ lua_Integer start = luaL_optinteger(L, 3, 1);+ lua_Integer len = luaL_len(L, 1);+ for (lua_Integer i = start; i <= len; i++) {+ lua_geti(L, 1, i);+ if (lua_compare(L, 2, -1, LUA_OPEQ)) {+ lua_pushinteger(L, i);+ return 2;+ }+ }+ lua_pushnil(L);+ return 1;+}++/*+** Returns the first element after the given start index for which the+** predicate function returns a truthy value, along with that element's+** index; returns `nil` if no such element exists.+*/+static int list_find_if (lua_State *L) {+ lua_settop(L, 3);+ luaL_checktype(L, 1, LUA_TTABLE);+ luaL_checktype(L, 2, LUA_TFUNCTION);+ lua_Integer start = luaL_optinteger(L, 3, 1);+ lua_Integer len = luaL_len(L, 1);+ for (lua_Integer i = start; i <= len; i++) {+ lua_pushvalue(L, 2); /* predicate function */+ lua_geti(L, 1, i);+ lua_pushinteger(L, i);+ lua_call(L, 2, 1);+ if (lua_toboolean(L, -1)) {+ lua_geti(L, 1, i);+ lua_pushinteger(L, i);+ return 2;+ }+ lua_pop(L, 1); /* remove predicate call result */+ }+ lua_pushnil(L);+ return 1;+}++/*+** Returns a boolean value indicating whether or not the element exists+** in the given list.+*/+static int list_includes(lua_State *L) {+ lua_settop(L, 3);+ lua_pushcfunction(L, list_find);+ lua_insert(L, 1);+ lua_call(L, 3, 1);+ lua_pushboolean(L, lua_toboolean(L, -1));+ return 1;+}++/*+** Returns a copy of the current list by applying the given function to+** all elements.+*/+static int list_map(lua_State *L) {+ lua_settop(L, 2);+ luaL_checktype(L, 1, LUA_TTABLE);+ luaL_checktype(L, 2, LUA_TFUNCTION);+ lua_Integer len = luaL_len(L, 1);+ lua_createtable(L, len, 0); /* create new table */+ lua_getmetatable(L, 1);+ lua_setmetatable(L, 3);+ for (lua_Integer i = 1; i <= len; i++) {+ lua_pushvalue(L, 2); /* map function */+ lua_geti(L, 1, i);+ lua_pushinteger(L, i);+ lua_call(L, 2, 1);+ lua_seti(L, 3, i);+ }+ return 1;+}++/*+** Pushes the standard `table` module to the stack.+*/+static void pushtablemodule (lua_State *L) {+ lua_getfield(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);+ if (!lua_getfield(L, -1, LUA_TABLIBNAME)) {+ /* apparently it's not been loaded yes. So open it here (but don't+ * 'load' it). */+ lua_pushcfunction(L, luaopen_table);+ lua_pushliteral(L, LUA_TABLIBNAME);+ lua_call(L, 1, 1);+ }+ lua_remove(L, -2); /* remove LOADED table */+}++/*+** Fields to copy from standard `table` package.+*/+static const char *tablelib_functions[] = {+ "insert",+ "remove",+ "sort",+ NULL+};++/*+** Copy fields from standard `table` module to the table at the given+** index.+*/+static void copyfromtablelib (lua_State *L, int idx) {+ int absidx = lua_absindex(L, idx);+ pushtablemodule(L);+ for (const char **name = tablelib_functions; *name != NULL; *name++) {+ if (lua_getfield(L, -1, *name)) {+ lua_setfield(L, absidx, *name);+ } else {+ lua_pop(L, 1);+ }+ }+ lua_pop(L, 1); /* remove table module */+}++static const luaL_Reg list_funcs[] = {+ {"__concat", list_concat},+ {"clone", list_clone},+ {"extend", list_extend},+ {"filter", list_filter},+ {"find", list_find},+ {"find_if", list_find_if},+ {"includes", list_includes},+ {"insert", missing},+ {"map", list_map},+ {"new", list_new},+ {"remove", missing},+ {"sort", missing},+ {NULL, NULL}+};++static const luaL_Reg metareg[] = {+ {"__call", list_new},+ {NULL, NULL}+};++/*+** Creates a new metatable for a new List-like type.+ */+int lualist_newmetatable (lua_State *L, const char *name) {+ if (luaL_newmetatable(L, name)) {+ luaL_setfuncs(L, list_funcs, 0);+ /* use functions from standard table module. */+ copyfromtablelib(L, -1);+ lua_pushvalue(L, -1);+ lua_setfield(L, -2, "__index");+ return 1;+ }+ return 0;+}++int luaopen_list (lua_State *L) {+ luaL_checkversion(L);+ lualist_newmetatable(L, LIST_T);++ lua_newtable(L);+ luaL_setfuncs(L, metareg, 0);+ lua_setmetatable(L, -2);+ return 1;+}
+ pandoc-lua-marshal.cabal view
@@ -0,0 +1,106 @@+cabal-version: 2.4+name: pandoc-lua-marshal+version: 0.1.0+synopsis: Use pandoc types in Lua+description: This package provides functions to marshal and unmarshal+ pandoc document types to and from Lua.+ .+ The values of most types are pushed to pandoc as "userdata"+ objects that wrap a stable pointer to the Haskell value;+ these objects come with methods to access and modify their+ properties.+ .+ Sequences are pushed as normal Lua tables, but are+ augmented with convenience functions.++homepage: https://github.com/pandoc/pandoc-lua-marshal+bug-reports: https://github.com/pandoc/pandoc-lua-marshal/issues+license: MIT+license-file: LICENSE+author: Albert Krewinkel, John MacFarlane+maintainer: Albert Krewinkel <albert@zeitkraut.de>+copyright: © 2017-2021 Albert Krewinkel, John MacFarlane+category: Foreign+build-type: Simple+extra-doc-files: README.md+ , CHANGELOG.md+tested-with: GHC == 8.6.5+ GHC == 8.8.4+ GHC == 8.10.7+ GHC == 9.0.1+ GHC == 9.2.1+extra-source-files: test/test-attr.lua+ , test/test-block.lua+ , test/test-citation.lua+ , test/test-inline.lua+ , test/test-listattributes.lua+ , test/test-list.lua+ , test/test-metavalue.lua+ , test/test-pandoc.lua++source-repository head+ type: git+ location: https://github.com/pandoc/pandoc-lua-marshal.git++common common-options+ build-depends: base >= 4.12 && < 5+ , bytestring >= 0.10 && < 0.12+ , exceptions >= 0.8 && < 0.11+ , lua >= 2.0.2 && < 2.1+ , hslua >= 2.0.1 && < 2.1+ , hslua-marshalling >= 2.0.1 && < 2.1+ , pandoc-types >= 1.22.1 && < 1.23+ , safe >= 0.3 && < 0.4+ , text >= 1.1.1.0 && < 1.3+ + ghc-options: -Wall+ -Wcompat+ -Widentities+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wmissing-export-lists+ -Wpartial-fields+ -Wredundant-constraints+ -fhide-source-paths+ if impl(ghc >= 8.8)+ ghc-options: -Wmissing-deriving-strategies++ default-language: Haskell2010++library+ import: common-options+ hs-source-dirs: src+ c-sources: cbits/listmod.c+ exposed-modules: Text.Pandoc.Lua.Marshal.AST+ , Text.Pandoc.Lua.Marshal.Alignment+ , Text.Pandoc.Lua.Marshal.Attr+ , Text.Pandoc.Lua.Marshal.Block+ , Text.Pandoc.Lua.Marshal.Cell+ , Text.Pandoc.Lua.Marshal.Citation+ , Text.Pandoc.Lua.Marshal.CitationMode+ , Text.Pandoc.Lua.Marshal.Content+ , Text.Pandoc.Lua.Marshal.Format+ , Text.Pandoc.Lua.Marshal.Inline+ , Text.Pandoc.Lua.Marshal.List+ , Text.Pandoc.Lua.Marshal.ListAttributes+ , Text.Pandoc.Lua.Marshal.MathType+ , Text.Pandoc.Lua.Marshal.MetaValue+ , Text.Pandoc.Lua.Marshal.Pandoc+ , Text.Pandoc.Lua.Marshal.QuoteType+ , Text.Pandoc.Lua.Marshal.SimpleTable+ , Text.Pandoc.Lua.Marshal.TableParts++test-suite pandoc-lua-marshal-test+ import: common-options+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: test-pandoc-lua-marshal.hs+ build-depends: pandoc-lua-marshal+ , QuickCheck >= 2.4 && < 2.15+ , tasty >= 0.11+ , tasty-hunit >= 0.9+ , tasty-lua >= 1.0+ , tasty-quickcheck >= 0.8 && < 0.11+ ghc-options: -threaded+ -rtsopts+ -with-rtsopts=-N
+ src/Text/Pandoc/Lua/Marshal/AST.hs view
@@ -0,0 +1,45 @@+{- |+Copyright: (c) 2021 Albert Krewinkel+SPDX-License-Identifier: MIT+Maintainer: Albert Krewinkel <albert@zeitkraut.de>++Use pandoc types in Lua+-}++module Text.Pandoc.Lua.Marshal.AST+ ( module Text.Pandoc.Lua.Marshal.List+ , module Text.Pandoc.Lua.Marshal.Alignment+ , module Text.Pandoc.Lua.Marshal.Attr+ , module Text.Pandoc.Lua.Marshal.Block+ , module Text.Pandoc.Lua.Marshal.Cell+ , module Text.Pandoc.Lua.Marshal.Citation+ , module Text.Pandoc.Lua.Marshal.CitationMode+ , module Text.Pandoc.Lua.Marshal.Content+ , module Text.Pandoc.Lua.Marshal.Format+ , module Text.Pandoc.Lua.Marshal.Inline+ , module Text.Pandoc.Lua.Marshal.ListAttributes+ , module Text.Pandoc.Lua.Marshal.MathType+ , module Text.Pandoc.Lua.Marshal.MetaValue+ , module Text.Pandoc.Lua.Marshal.Pandoc+ , module Text.Pandoc.Lua.Marshal.QuoteType+ , module Text.Pandoc.Lua.Marshal.SimpleTable+ , module Text.Pandoc.Lua.Marshal.TableParts+ ) where++import Text.Pandoc.Lua.Marshal.Alignment+import Text.Pandoc.Lua.Marshal.Attr+import Text.Pandoc.Lua.Marshal.Block+import Text.Pandoc.Lua.Marshal.Cell+import Text.Pandoc.Lua.Marshal.Citation+import Text.Pandoc.Lua.Marshal.CitationMode+import Text.Pandoc.Lua.Marshal.Content+import Text.Pandoc.Lua.Marshal.Format+import Text.Pandoc.Lua.Marshal.Inline+import Text.Pandoc.Lua.Marshal.List+import Text.Pandoc.Lua.Marshal.ListAttributes+import Text.Pandoc.Lua.Marshal.MathType+import Text.Pandoc.Lua.Marshal.MetaValue+import Text.Pandoc.Lua.Marshal.Pandoc+import Text.Pandoc.Lua.Marshal.QuoteType+import Text.Pandoc.Lua.Marshal.SimpleTable+import Text.Pandoc.Lua.Marshal.TableParts
+ src/Text/Pandoc/Lua/Marshal/Alignment.hs view
@@ -0,0 +1,22 @@+{- |+Copyright : © 2021 Albert Krewinkel+SPDX-License-Identifier : MIT+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Marshaling/unmarshaling functions of 'Alignment' values.+-}+module Text.Pandoc.Lua.Marshal.Alignment+ ( peekAlignment+ , pushAlignment+ ) where++import HsLua+import Text.Pandoc.Definition (Alignment)++-- | Retrieves a 'Alignment' value from a string.+peekAlignment :: Peeker e Alignment+peekAlignment = peekRead++-- | Pushes a 'Alignment' value as a string.+pushAlignment :: Pusher e Alignment+pushAlignment = pushString . show
+ src/Text/Pandoc/Lua/Marshal/Attr.hs view
@@ -0,0 +1,247 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{- |+Module : Text.Pandoc.Lua.Marshal.Attr+Copyright : © 2017-2021 Albert Krewinkel, John MacFarlane+License : MIT++Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Helpers to make pandoc's Attr elements usable in Lua, and to get objects+back into Haskell.+-}+module Text.Pandoc.Lua.Marshal.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 Text.Pandoc.Lua.Marshal.List (pushPandocList)+import Safe (atMay)+import Text.Pandoc.Definition (Attr, nullAttr)++import qualified Data.Text as T++-- | Attr object type.+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"]+ ]++-- | Pushes an 'Attr' value as @Attr@ userdata object.+pushAttr :: LuaError e => Pusher e Attr+pushAttr = pushUD typeAttr++-- | Retrieves an associated list of attributes from a table or an+-- @AttributeList@ userdata object.+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"++-- | Pushes an associated list of attributes as @AttributeList@ userdata+-- object.+pushAttribs :: LuaError e => Pusher e [(Text, Text)]+pushAttribs = pushUD typeAttributeList++-- | Constructor functions for 'AttributeList' elements.+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 :: 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"++-- | Retrieves an 'Attr' value from a string, a table, or an @Attr@+-- userdata object. A string is used as an identifier; a table is either+-- an HTML-like set of attributes, or a triple containing the+-- identifier, classes, and attributes.+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"
+ src/Text/Pandoc/Lua/Marshal/Block.hs view
@@ -0,0 +1,384 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{- |++Marshal values of types that make up 'Block' elements.+-}+module Text.Pandoc.Lua.Marshal.Block+ ( -- * Single Block elements+ peekBlock+ , peekBlockFuzzy+ , pushBlock+ -- * List of Blocks+ , peekBlocks+ , peekBlocksFuzzy+ , pushBlocks+ -- * Constructors+ , blockConstructors+ , mkBlocks+ ) where++import Control.Applicative ((<|>))+import Control.Monad.Catch (throwM)+import Control.Monad ((<$!>))+import Data.Data (showConstr, toConstr)+import Data.Maybe (fromMaybe)+import Data.Proxy (Proxy (Proxy))+import Data.Text (Text)+import HsLua hiding (Div)+import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr)+import Text.Pandoc.Lua.Marshal.Content+ ( Content (..), contentTypeDescription, peekContent, pushContent+ , peekDefinitionItem )+import Text.Pandoc.Lua.Marshal.Format (peekFormat, pushFormat)+import Text.Pandoc.Lua.Marshal.Inline (peekInlinesFuzzy)+import Text.Pandoc.Lua.Marshal.List (newListMetatable, pushPandocList)+import Text.Pandoc.Lua.Marshal.ListAttributes (peekListAttributes, pushListAttributes)+import Text.Pandoc.Lua.Marshal.TableParts+ ( peekCaption, pushCaption+ , peekColSpec, pushColSpec+ , peekTableBody, pushTableBody+ , peekTableFoot, pushTableFoot+ , peekTableHead, pushTableHead+ )+import Text.Pandoc.Definition++-- | Pushes an Block value as userdata object.+pushBlock :: LuaError e => Pusher e Block+pushBlock = pushUD typeBlock+{-# INLINE pushBlock #-}++-- | Retrieves an Block value.+peekBlock :: LuaError e => Peeker e Block+peekBlock = peekUD typeBlock+{-# INLINE peekBlock #-}++-- | Retrieves a list of Block values.+peekBlocks :: LuaError e+ => Peeker e [Block]+peekBlocks = peekList peekBlock+{-# INLINABLE peekBlocks #-}++-- | Pushes a list of Block values.+pushBlocks :: LuaError e+ => Pusher e [Block]+pushBlocks xs = do+ pushList pushBlock xs+ newListMetatable "Blocks" $+ pure ()+ setmetatable (nth 2)+{-# INLINABLE pushBlocks #-}++-- | Try extra hard to retrieve an Block value from the stack. Treats+-- bare strings as @Str@ values.+peekBlockFuzzy :: LuaError e+ => Peeker e Block+peekBlockFuzzy = choice+ [ peekBlock+ , \idx -> Plain <$!> peekInlinesFuzzy idx+ ]+{-# INLINABLE peekBlockFuzzy #-}++-- | Try extra-hard to return the value at the given index as a list of+-- inlines.+peekBlocksFuzzy :: LuaError e+ => Peeker e [Block]+peekBlocksFuzzy = choice+ [ peekList peekBlockFuzzy+ , (<$!>) pure . peekBlockFuzzy+ ]+{-# INLINABLE peekBlocksFuzzy #-}++-- | Block object type.+typeBlock :: forall e. 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 (Proxy @e))+ , possibleProperty "foot" "table foot"+ (pushTableFoot, \case {Table _ _ _ _ _ f -> Actual f; _ -> Absent})+ (peekTableFoot, \case+ Table attr c cs h bs _ -> Actual . Table attr c cs h bs+ _ -> 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 :: forall e. LuaError e+ => Proxy e -> 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 . luaException @e $+ "expected Inlines, got " <> contentTypeDescription c+ blockContent = \case+ ContentBlocks blks -> blks+ ContentInlines inlns -> [Plain inlns]+ c -> throwM . luaException @e $+ "expected Blocks, got " <> contentTypeDescription c+ lineContent = \case+ ContentLines lns -> lns+ c -> throwM . luaException @e $+ "expected list of lines (Inlines), got " <> contentTypeDescription c+ defItemContent = \case+ ContentDefItems itms -> itms+ c -> throwM . luaException @e $+ "expected definition items, got " <> contentTypeDescription c+ listItemContent = \case+ ContentBlocks blks -> [blks]+ ContentLines lns -> map ((:[]) . Plain) lns+ ContentListItems itms -> itms+ c -> throwM . luaException @e $+ "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++-- | Constructor functions for 'Block' elements.+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 = parameter peekText "string"+ optAttrParam = optionalParameter peekAttr "attr" "Attr"+ "additional attributes"+++-- | Constructor for a list of `Block` values.+mkBlocks :: LuaError e => DocumentedFunction e+mkBlocks = defun "Blocks"+ ### liftPure id+ <#> parameter peekBlocksFuzzy "Blocks" "blocks" "block elements"+ =#> functionResult pushBlocks "Blocks" "list of block elements"
+ src/Text/Pandoc/Lua/Marshal/Block.hs-boot view
@@ -0,0 +1,12 @@+module Text.Pandoc.Lua.Marshal.Block+ ( peekBlocksFuzzy+ , pushBlocks+ ) where++import HsLua+import Text.Pandoc.Definition++-- | Pushes a list of Block values.+pushBlocks :: LuaError e => Pusher e [Block]++peekBlocksFuzzy :: LuaError e => Peeker e [Block]
+ src/Text/Pandoc/Lua/Marshal/Cell.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}+{- |+Copyright : © 2021 Albert Krewinkel+SPDX-License-Identifier : MIT+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Marshaling/unmarshaling functions of table 'Cell' values.+-}+module Text.Pandoc.Lua.Marshal.Cell+ ( peekCell+ , pushCell+ ) where++import Control.Monad ((<$!>))+import HsLua+import Text.Pandoc.Lua.Marshal.Alignment (peekAlignment, pushAlignment)+import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr)+import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Block+ ( peekBlocksFuzzy, pushBlocks )+import Text.Pandoc.Definition (Cell (..), RowSpan (..), ColSpan (..))++-- | 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+ newtable+ addField "attr" (pushAttr attr)+ addField "alignment" (pushAlignment align)+ addField "row_span" (pushIntegral rowSpan)+ addField "col_span" (pushIntegral colSpan)+ addField "contents" (pushBlocks contents)+ where addField key pusher = pushName key *> pusher *> rawset (nth 3)++-- | Retrieves a table 'Cell' from the stack.+peekCell :: LuaError e => Peeker e Cell+peekCell = fmap (retrieving "Cell")+ . typeChecked "table" istable+ $ \idx -> do+ attr <- peekFieldRaw peekAttr "attr" idx+ algn <- peekFieldRaw peekAlignment "alignment" idx+ rs <- RowSpan <$!> peekFieldRaw peekIntegral "row_span" idx+ cs <- ColSpan <$!> peekFieldRaw peekIntegral "col_span" idx+ blks <- peekFieldRaw peekBlocksFuzzy "contents" idx+ return $! Cell attr algn rs cs blks
+ src/Text/Pandoc/Lua/Marshal/Citation.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE OverloadedStrings #-}+{- |+Copyright : © 2021 Albert Krewinkel+SPDX-License-Identifier : MIT+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Marshaling/unmarshaling functions and constructor for 'Citation' values.+-}+module Text.Pandoc.Lua.Marshal.Citation+ ( -- * Citation+ peekCitation+ , pushCitation+ , typeCitation+ , mkCitation+ ) where++import Control.Applicative (optional)+import Data.Maybe (fromMaybe)+import HsLua as Lua+import Text.Pandoc.Lua.Marshal.CitationMode (peekCitationMode, pushCitationMode)+import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Inline (peekInlinesFuzzy, pushInlines)+import Text.Pandoc.Definition (Citation (..))++-- | Pushes a Citation value as userdata object.+pushCitation :: LuaError e+ => Pusher e Citation+pushCitation = pushUD typeCitation+{-# INLINE pushCitation #-}++-- | Retrieves a Citation value.+peekCitation :: LuaError e+ => Peeker e Citation+peekCitation = peekUD typeCitation+{-# INLINE peekCitation #-}++-- | Citation object type.+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"+ (pushCitationMode, citationMode)+ (peekCitationMode, \citation mode -> citation{ citationMode = mode })+ , property "prefix" "citation prefix"+ (pushInlines, citationPrefix)+ (peekInlinesFuzzy, \citation prefix -> citation{ citationPrefix = prefix })+ , property "suffix" "citation suffix"+ (pushInlines, citationSuffix)+ (peekInlinesFuzzy, \citation suffix -> citation{ citationSuffix = 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"+ ]+{-# INLINABLE typeCitation #-}++-- | Constructor function for 'Citation' elements.+mkCitation :: LuaError e => DocumentedFunction e+mkCitation = 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 peekCitationMode "CitationMode" "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."
+ src/Text/Pandoc/Lua/Marshal/CitationMode.hs view
@@ -0,0 +1,24 @@+{- |+Copyright : © 2021 Albert Krewinkel+SPDX-License-Identifier : MIT+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Marshaling/unmarshaling functions of 'CitationMode' values.+-}+module Text.Pandoc.Lua.Marshal.CitationMode+ ( peekCitationMode+ , pushCitationMode+ ) where++import HsLua+import Text.Pandoc.Definition (CitationMode)++-- | Retrieves a Citation value from a string.+peekCitationMode :: Peeker e CitationMode+peekCitationMode = peekRead+{-# INLINE peekCitationMode #-}++-- | Pushes a CitationMode value as string.+pushCitationMode :: Pusher e CitationMode+pushCitationMode = pushString . show+{-# INLINE pushCitationMode #-}
+ src/Text/Pandoc/Lua/Marshal/Content.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{- |+Copyright : © 2021 Albert Krewinkel+SPDX-License-Identifier : MIT+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Defines a helper type that can handle different types of 'Block' and+'Inline' element contents.+-}+module Text.Pandoc.Lua.Marshal.Content+ ( Content (..)+ , contentTypeDescription+ , peekContent+ , pushContent+ , peekDefinitionItem+ ) where++import Control.Applicative ((<|>))+import Control.Monad ((<$!>))+import HsLua+import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Block+ ( peekBlocksFuzzy, pushBlocks )+import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Inline+ ( peekInlinesFuzzy, pushInlines )+import Text.Pandoc.Lua.Marshal.List (pushPandocList)+import Text.Pandoc.Definition (Inline, Block)++--+-- Content+--++-- | 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]]++-- | Gets the text property of an Inline, if present.+contentTypeDescription :: Content -> String+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)"++-- | Pushes the 'Content' to the stack.+pushContent :: LuaError e => Pusher e Content+pushContent = \case+ ContentBlocks blks -> pushBlocks blks+ ContentInlines inlns -> pushInlines inlns+ ContentLines lns -> pushPandocList pushInlines lns+ ContentDefItems itms -> pushPandocList pushDefinitionItem itms+ ContentListItems itms -> pushPandocList pushBlocks itms++-- | Gets a 'Content' element from the stack.+peekContent :: LuaError e => Peeker e Content+peekContent idx =+ (ContentInlines <$!> peekInlinesFuzzy idx) <|>+ (ContentLines <$!> peekList peekInlinesFuzzy idx) <|>+ (ContentBlocks <$!> peekBlocksFuzzy idx ) <|>+ (ContentListItems <$!> peekList peekBlocksFuzzy idx) <|>+ (ContentDefItems <$!> peekList peekDefinitionItem idx)++-- | Retrieves a single definition item from 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+ ]++-- | Pushes a single definition items on the stack.+pushDefinitionItem :: LuaError e => Pusher e ([Inline], [[Block]])+pushDefinitionItem = pushPair pushInlines+ (pushPandocList pushBlocks)
+ src/Text/Pandoc/Lua/Marshal/Format.hs view
@@ -0,0 +1,23 @@+{- |+Copyright : © 2021 Albert Krewinkel+SPDX-License-Identifier : MIT+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Marshaling/unmarshaling functions of 'Format' values.+-}+module Text.Pandoc.Lua.Marshal.Format+ ( peekFormat+ , pushFormat+ ) where++import Control.Monad ((<$!>))+import HsLua+import Text.Pandoc.Definition (Format (Format))++-- | Retrieves a 'Format' value from a string.+peekFormat :: Peeker e Format+peekFormat idx = Format <$!> peekText idx++-- | Pushes a 'Format' value as a string.+pushFormat :: Pusher e Format+pushFormat (Format f) = pushText f
+ src/Text/Pandoc/Lua/Marshal/Inline.hs view
@@ -0,0 +1,354 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TupleSections #-}+{- |++Marshal values of types that make up 'Inline' elements.+-}+module Text.Pandoc.Lua.Marshal.Inline+ ( -- * Single Inline elements+ peekInline+ , peekInlineFuzzy+ , pushInline+ -- * List of Inlines+ , peekInlines+ , peekInlinesFuzzy+ , pushInlines+ -- * Constructors+ , inlineConstructors+ , mkInlines+ ) where++import Control.Monad.Catch (throwM)+import Control.Monad ((<$!>))+import Data.Data (showConstr, toConstr)+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import HsLua+import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr)+import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Block+ ( peekBlocksFuzzy )+import Text.Pandoc.Lua.Marshal.Citation (peekCitation, pushCitation)+import Text.Pandoc.Lua.Marshal.Content+ ( Content (..), contentTypeDescription, peekContent, pushContent )+import Text.Pandoc.Lua.Marshal.Format (peekFormat, pushFormat)+import Text.Pandoc.Lua.Marshal.List (pushPandocList, newListMetatable)+import Text.Pandoc.Lua.Marshal.MathType (peekMathType, pushMathType)+import Text.Pandoc.Lua.Marshal.QuoteType (peekQuoteType, pushQuoteType)+import Text.Pandoc.Definition ( Inline (..), nullAttr )+import qualified Text.Pandoc.Builder as B++-- | Pushes an Inline value as userdata object.+pushInline :: LuaError e => Pusher e Inline+pushInline = pushUD typeInline+{-# INLINE pushInline #-}++-- | Retrieves an Inline value.+peekInline :: LuaError e => Peeker e Inline+peekInline = peekUD typeInline+{-# INLINE peekInline #-}++-- | Retrieves a list of Inline values.+peekInlines :: LuaError e+ => Peeker e [Inline]+peekInlines = peekList peekInline+{-# INLINABLE peekInlines #-}++-- | Pushes a list of Inline values.+pushInlines :: LuaError e+ => Pusher e [Inline]+pushInlines xs = do+ pushList pushInline xs+ newListMetatable "Inlines" $+ pure ()+ setmetatable (nth 2)+{-# INLINABLE pushInlines #-}++-- | Try extra hard to retrieve an Inline value from the stack. Treats+-- bare strings as @Str@ values.+peekInlineFuzzy :: LuaError e => Peeker e Inline+peekInlineFuzzy idx = retrieving "Inline" $ liftLua (ltype idx) >>= \case+ TypeString -> Str <$!> peekText idx+ _ -> peekInline idx+{-# INLINABLE peekInlineFuzzy #-}++-- | 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+{-# INLINABLE peekInlinesFuzzy #-}++-- | Inline object type.+typeInline :: forall e. LuaError e => DocumentedType e Inline+typeInline = deftype "Inline"+ [ operation Tostring $ lambda+ ### liftPure (show @Inline)+ <#> parameter peekInline "inline" "Inline" "Object"+ =#> functionResult pushString "string" "stringified Inline"+ , 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, \case+ Code attr _ -> Actual attr+ Image attr _ _ -> Actual attr+ Link attr _ _ -> Actual attr+ Span attr _ -> Actual attr+ _ -> Absent)+ (peekAttr, \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)++ , 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, \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)+ (peekContent,+ let inlineContent = \case+ ContentInlines inlns -> inlns+ c -> throwM . luaException @e $+ "expected Inlines, got " <> contentTypeDescription c+ blockContent = \case+ ContentBlocks blks -> blks+ ContentInlines [] -> []+ c -> throwM . luaException @e $+ "expected Blocks, got " <> contentTypeDescription c+ in \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+ )++ , 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, \case+ Image _ _ (_, tit) -> Actual tit+ Link _ _ (_, tit) -> Actual tit+ _ -> Absent)+ (peekText, \case+ Image attr capt (src, _) -> Actual . Image attr capt . (src,)+ Link attr capt (src, _) -> Actual . Link attr capt . (src,)+ _ -> const Absent)++ , 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"+ ]++--+-- Text+--++-- | Gets the text property of an Inline, if present.+getInlineText :: Inline -> Possible Text+getInlineText = \case+ Code _ lst -> Actual lst+ Math _ str -> Actual str+ RawInline _ raw -> Actual raw+ Str s -> Actual s+ _ -> Absent++-- | Sets the text property of an Inline, if present.+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++-- | Constructor functions for 'Inline' elements.+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+ ]+ where+ mkInlinesConstr name constr = defun name+ ### liftPure (\x -> x `seq` constr x)+ <#> parameter peekInlinesFuzzy "Inlines" "content" ""+ =#> functionResult pushInline "Inline" "new object"++-- | Constructor for a list of `Inline` values.+mkInlines :: LuaError e => DocumentedFunction e+mkInlines = defun "Inlines"+ ### liftPure id+ <#> parameter peekInlinesFuzzy "Inlines" "inlines" "inline elements"+ =#> functionResult pushInlines "Inlines" "list of inline elements"
+ src/Text/Pandoc/Lua/Marshal/Inline.hs-boot view
@@ -0,0 +1,11 @@+module Text.Pandoc.Lua.Marshal.Inline+ ( peekInlinesFuzzy+ , pushInlines+ )+where++import HsLua+import Text.Pandoc.Definition (Inline)++peekInlinesFuzzy :: LuaError e => Peeker e [Inline]+pushInlines :: LuaError e => Pusher e [Inline]
+ src/Text/Pandoc/Lua/Marshal/List.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{- |+Copyright : © 2021 Albert Krewinkel+SPDX-License-Identifier : MIT+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Marshaling/unmarshaling functions and constructor for 'ListAttributes'+values.+-}+module Text.Pandoc.Lua.Marshal.List+ ( pushPandocList+ , luaopen_list_ptr+ , pushListModule+ , newListMetatable+ ) where++import Data.ByteString (useAsCString)+import Foreign.C+import HsLua++-- | Pushes a list as a numerically-indexed Lua table, and sets a+-- metatable that offers a number of convenience functions.+pushPandocList :: LuaError e => Pusher e a -> Pusher e [a]+pushPandocList pushItem items = do+ pushList pushItem items+ getmetatable' "List" >>= \case+ TypeTable -> setmetatable (nth 2)+ _ -> failLua "List has not been initialized correctly."++-- | Pointer to the function that opens the List module and pushes it to the+-- stack.+foreign import ccall unsafe "listmod.c &luaopen_list"+ luaopen_list_ptr :: CFunction++-- | Opens the List module and pushes it to the stack.+pushListModule :: LuaError e => LuaE e ()+pushListModule = do+ pushcfunction luaopen_list_ptr+ call 0 1++-- | Creates a new list metatable with the given name.+foreign import ccall "listmod.c lualist_newmetatable"+ lualist_newmetatable :: State -> CString -> IO CInt++-- | Pushes the metatable of the given List type, creating it if+-- necessary. The @setup@ operation is run when the metatable did not+-- exists, was created, and is then at the top of the stack. The+-- operation may modify the table but must be balanced, and must leave+-- the stack as it found it.+newListMetatable :: Name -> LuaE e () {-^ setup -} -> LuaE e ()+newListMetatable (Name name) setup = do+ l <- state+ liftIO (useAsCString name (lualist_newmetatable l)) >>= \case+ 0 -> pure () -- metatable already registered; no need to setup again+ _ -> setup
+ src/Text/Pandoc/Lua/Marshal/ListAttributes.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{- |+Copyright : © 2021 Albert Krewinkel+SPDX-License-Identifier : MIT+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Marshaling/unmarshaling functions and constructor for 'ListAttributes'+values.+-}+module Text.Pandoc.Lua.Marshal.ListAttributes+ ( typeListAttributes+ , peekListAttributes+ , pushListAttributes+ , mkListAttributes+ , peekListNumberDelim+ , pushListNumberDelim+ , peekListNumberStyle+ , pushListNumberStyle+ ) where++import Data.Maybe (fromMaybe)+import HsLua+import Text.Pandoc.Definition+ ( ListAttributes, ListNumberStyle (..), ListNumberDelim (..))++-- | 'ListAttributes' Lua object type.+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"+ (pushListNumberStyle, \(_,style,_) -> style)+ (peekListNumberStyle, \(start,_,delim) -> (start,,delim))+ , property "delimiter" "delimiter of list numbers"+ (pushListNumberDelim, \(_,_,delim) -> delim)+ (peekListNumberDelim, \(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."++-- | Pushes a 'ListNumberDelim' value as string.+pushListNumberDelim :: Pusher e ListNumberDelim+pushListNumberDelim = pushString . show+{-# INLINE pushListNumberDelim #-}++-- | Retrieves a 'ListNumberDelim' value from a string.+peekListNumberDelim :: Peeker e ListNumberDelim+peekListNumberDelim = peekRead+{-# INLINE peekListNumberDelim #-}++-- | Pushes a 'ListNumberStyle' value as string.+pushListNumberStyle :: Pusher e ListNumberStyle+pushListNumberStyle = pushString . show+{-# INLINE pushListNumberStyle #-}++-- | Retrieves a 'ListNumberStyle' value from a string.+peekListNumberStyle :: Peeker e ListNumberStyle+peekListNumberStyle = peekRead+{-# INLINE peekListNumberStyle #-}
+ src/Text/Pandoc/Lua/Marshal/MathType.hs view
@@ -0,0 +1,22 @@+{- |+Copyright : © 2021 Albert Krewinkel+SPDX-License-Identifier : MIT+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Marshaling/unmarshaling functions of 'MathType' values.+-}+module Text.Pandoc.Lua.Marshal.MathType+ ( peekMathType+ , pushMathType+ ) where++import HsLua+import Text.Pandoc.Definition (MathType)++-- | Retrieves a 'MathType' value from a string.+peekMathType :: Peeker e MathType+peekMathType = peekRead++-- | Pushes a 'MathType' value as a string.+pushMathType :: Pusher e MathType+pushMathType = pushString . show
+ src/Text/Pandoc/Lua/Marshal/MetaValue.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{- |+Copyright : © 2021 Albert Krewinkel+SPDX-License-Identifier : MIT+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Marshaling/unmarshaling functions of 'MetaValue' elements.+-}+module Text.Pandoc.Lua.Marshal.MetaValue+ ( peekMetaValue+ , pushMetaValue+ , metaValueConstructors+ ) where++import Control.Applicative ((<|>), optional)+import Control.Monad ((<$!>))+import HsLua+import Text.Pandoc.Lua.Marshal.Block+ ( peekBlock, peekBlocks, peekBlocksFuzzy, pushBlocks )+import Text.Pandoc.Lua.Marshal.Inline+ ( peekInline, peekInlines, peekInlinesFuzzy, pushInlines )+import Text.Pandoc.Lua.Marshal.List (pushPandocList)+import Text.Pandoc.Definition (MetaValue (..))++-- | Push a 'MetaValue' element to the top of the Lua stack.+pushMetaValue :: LuaError e => Pusher e MetaValue+pushMetaValue = \case+ MetaBlocks blcks -> pushBlocks blcks+ MetaBool bool -> pushBool bool+ MetaInlines inlns -> pushInlines inlns+ MetaList metalist -> pushPandocList pushMetaValue metalist+ MetaMap metamap -> pushMap pushText pushMetaValue metamap+ MetaString t -> pushText t++-- | Retrieves the value at the given stack index as 'MetaValue'.+peekMetaValue :: forall e. LuaError e => Peeker e MetaValue+peekMetaValue = retrieving "MetaValue" . \idx -> do+ -- Get the contents of an AST element.++ liftLua (ltype idx) >>= \case+ TypeBoolean -> MetaBool <$!> peekBool idx++ TypeString -> MetaString <$!> peekText idx++ TypeUserdata -> -- Allow singleton Inline or Block elements+ (MetaInlines . (:[]) <$!> peekInline idx) <|>+ (MetaBlocks . (:[]) <$!> peekBlock idx)++ TypeTable -> optional (getName idx) >>= \case+ Just "Inlines" -> MetaInlines <$!> peekInlinesFuzzy idx+ Just "Blocks" -> MetaBlocks <$!> peekBlocksFuzzy idx+ Just "List" -> MetaList <$!> peekList peekMetaValue idx+ _ -> do+ -- no meta value tag given, try to guess.+ len <- liftLua $ rawlen idx+ if len <= 0+ then MetaMap <$!> peekMap peekText peekMetaValue idx+ else (MetaInlines <$!> peekInlines idx)+ <|> (MetaBlocks <$!> peekBlocks idx)+ <|> (MetaList <$!> peekList peekMetaValue idx)++ _ -> failPeek "could not get meta value"++ where+ getName idx = liftLua (getmetafield idx "__name") >>= \case+ TypeNil -> failPeek "no name"+ _ -> peekName idx `lastly` pop 1+++-- | Constructor functions for 'MetaValue' elements.+metaValueConstructors :: LuaError e => [DocumentedFunction e]+metaValueConstructors =+ [ defun "MetaBlocks"+ ### liftPure MetaBlocks+ <#> parameter peekBlocksFuzzy "Blocks" "content" "block content"+ =#> functionResult pushMetaValue "Blocks" "list of Block elements"++ , defun "MetaBool"+ ### liftPure MetaBool+ <#> parameter peekBool "boolean" "bool" "true or false"+ =#> functionResult pushMetaValue "boolean" "input, unchanged"++ , defun "MetaInlines"+ ### liftPure MetaInlines+ <#> parameter peekInlinesFuzzy "Inlines" "inlines" "inline elements"+ =#> functionResult pushMetaValue "Inlines" "list of Inline elements"++ , defun "MetaList"+ ### liftPure MetaList+ <#> parameter (peekList peekMetaValue) "MetaValue|{MetaValue,...}"+ "values" "value, or list of values"+ =#> functionResult pushMetaValue "List" "list of meta values"++ , defun "MetaMap"+ ### liftPure MetaMap+ <#> parameter (peekMap peekText peekMetaValue) "table" "map"+ "string-indexed table"+ =#> functionResult pushMetaValue "table" "map of meta values"++ , defun "MetaString"+ ### liftPure MetaString+ <#> parameter peekText "string" "s" "string value"+ =#> functionResult pushMetaValue "string" "unchanged input"+ ]
+ src/Text/Pandoc/Lua/Marshal/Pandoc.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE OverloadedStrings #-}+{- |+Copyright : © 2021 Albert Krewinkel+SPDX-License-Identifier : MIT+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Marshaling/unmarshaling functions of 'Pandoc' values.+-}+module Text.Pandoc.Lua.Marshal.Pandoc+ ( -- * Pandoc+ peekPandoc+ , pushPandoc+ , mkPandoc+ -- * Meta+ , peekMeta+ , pushMeta+ , mkMeta+ ) where++import Control.Applicative (optional)+import Control.Monad ((<$!>))+import Data.Maybe (fromMaybe)+import HsLua+import Text.Pandoc.Lua.Marshal.Block (peekBlocksFuzzy, pushBlocks)+import Text.Pandoc.Lua.Marshal.MetaValue (peekMetaValue, pushMetaValue)+import Text.Pandoc.Definition (Pandoc (..), Meta (..), nullMeta)++-- | Pushes a 'Pandoc' value as userdata.+pushPandoc :: LuaError e => Pusher e Pandoc+pushPandoc = pushUD typePandoc++-- | Retrieves a 'Pandoc' document from a userdata value.+peekPandoc :: LuaError e => Peeker e Pandoc+peekPandoc = retrieving "Pandoc" . peekUD typePandoc++-- | Pandoc object type.+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"+ (pushBlocks, \(Pandoc _ blks) -> blks)+ (peekBlocksFuzzy, \(Pandoc m _) blks -> Pandoc m blks)+ , property "meta" "document metadata"+ (pushMeta, \(Pandoc meta _) -> meta)+ (peekMeta, \(Pandoc _ blks) meta -> Pandoc meta blks)+ ]++-- | Pushes a 'Meta' value as a string-indexed table.+pushMeta :: LuaError e => Pusher e Meta+pushMeta (Meta mmap) = do+ pushMap pushText pushMetaValue mmap+ _ <- newmetatable "Meta"+ setmetatable (nth 2)++-- | Retrieves a 'Meta' value from a string-indexed table.+peekMeta :: LuaError e => Peeker e Meta+peekMeta idx = retrieving "Meta" $+ Meta <$!> peekMap peekText peekMetaValue idx++-- | Constructor function for 'Pandoc' values.+mkPandoc :: LuaError e => DocumentedFunction e+mkPandoc = 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"++-- | Constructor for 'Meta' values.+mkMeta :: LuaError e => DocumentedFunction e+mkMeta = defun "Meta"+ ### liftPure id+ <#> parameter peekMeta "table" "meta" "table containing meta information"+ =#> functionResult pushMeta "table" "new Meta table"
+ src/Text/Pandoc/Lua/Marshal/QuoteType.hs view
@@ -0,0 +1,22 @@+{- |+Copyright : © 2021 Albert Krewinkel+SPDX-License-Identifier : MIT+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Marshaling/unmarshaling functions of 'QuoteType' values.+-}+module Text.Pandoc.Lua.Marshal.QuoteType+ ( peekQuoteType+ , pushQuoteType+ ) where++import HsLua+import Text.Pandoc.Definition (QuoteType)++-- | Retrieves a 'QuoteType' value from a string.+peekQuoteType :: Peeker e QuoteType+peekQuoteType = peekRead++-- | Pushes a 'QuoteType' value as a string.+pushQuoteType :: Pusher e QuoteType+pushQuoteType = pushString . show
+ src/Text/Pandoc/Lua/Marshal/SimpleTable.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{- |+Copyright : © 2021 Albert Krewinkel+License : MIT+Maintainer : Albert Krewinkel <albert@zeitkraut.de>++Definition and marshaling of the 'SimpleTable' data type used as a+convenience type when dealing with tables.+-}+module Text.Pandoc.Lua.Marshal.SimpleTable+ ( SimpleTable (..)+ , peekSimpleTable+ , pushSimpleTable+ , mkSimpleTable+ )+ where++import HsLua as Lua+import Text.Pandoc.Lua.Marshal.Alignment (peekAlignment, pushAlignment)+import Text.Pandoc.Lua.Marshal.Block (peekBlocksFuzzy, pushBlocks)+import Text.Pandoc.Lua.Marshal.Inline (peekInlinesFuzzy, pushInlines)+import Text.Pandoc.Lua.Marshal.List (pushPandocList)+import Text.Pandoc.Definition++-- | A simple (legacy-style) table.+data SimpleTable = SimpleTable+ { simpleTableCaption :: [Inline]+ , simpleTableAlignments :: [Alignment]+ , simpleTableColumnWidths :: [Double]+ , simpleTableHeader :: [[Block]]+ , simpleTableBody :: [[[Block]]]+ } deriving stock (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"+ (pushInlines, simpleTableCaption)+ (peekInlinesFuzzy, \t capt -> t {simpleTableCaption = capt})+ , property "aligns" "column alignments"+ (pushPandocList pushAlignment, simpleTableAlignments)+ (peekList peekAlignment, \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 pushBlocks++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 peekAlignment) "{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"
+ src/Text/Pandoc/Lua/Marshal/TableParts.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{- |+Copyright : © 2021 Albert Krewinkel+SPDX-License-Identifier : MIT+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Marshaling/unmarshaling functions of types that are used exclusively+with tables.+-}+module Text.Pandoc.Lua.Marshal.TableParts+ ( peekCaption+ , pushCaption+ , peekColSpec+ , pushColSpec+ , peekRow+ , pushRow+ , peekTableBody+ , pushTableBody+ , peekTableFoot+ , pushTableFoot+ , peekTableHead+ , pushTableHead+ ) where++import Control.Applicative (optional)+import Control.Monad ((<$!>))+import HsLua+import Text.Pandoc.Lua.Marshal.Alignment (peekAlignment, pushAlignment)+import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr)+import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Block+ ( peekBlocksFuzzy, pushBlocks )+import Text.Pandoc.Lua.Marshal.Cell (peekCell, pushCell)+import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Inline+ ( peekInlinesFuzzy, pushInlines )+import Text.Pandoc.Lua.Marshal.List (pushPandocList)+import Text.Pandoc.Definition++-- | Push Caption element+pushCaption :: LuaError e => Caption -> LuaE e ()+pushCaption (Caption shortCaption longCaption) = do+ newtable+ addField "short" (maybe pushnil pushInlines shortCaption)+ addField "long" (pushBlocks longCaption)++-- | Peek Caption element+peekCaption :: LuaError e => Peeker e Caption+peekCaption = retrieving "Caption" . \idx -> do+ short <- optional $ peekFieldRaw peekInlinesFuzzy "short" idx+ long <- peekFieldRaw peekBlocksFuzzy "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 pushAlignment pushColWidth++-- | Peek a ColSpec value as a pair of Alignment and ColWidth.+peekColSpec :: LuaError e => Peeker e ColSpec+peekColSpec = peekPair peekAlignment peekColWidth++peekColWidth :: 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) -> push w+ ColWidthDefault -> 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+ newtable+ addField "attr" (pushAttr attr)+ addField "row_head_columns" (pushIntegral rowHeadColumns)+ addField "head" (pushPandocList pushRow head')+ addField "body" (pushPandocList pushRow 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" 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)++-- | Add a value to the table at the top of the stack at a string-index.+addField :: LuaError e => Name -> LuaE e () -> LuaE e ()+addField key pushValue = do+ pushName key+ pushValue+ rawset (nth 3)
+ test/test-attr.lua view
@@ -0,0 +1,144 @@+local tasty = require 'tasty'++local test = tasty.test_case+local group = tasty.test_group+local assert = tasty.assert++return {+ group 'Attr' {+ group 'Constructor' {+ test('Attr is a function', function ()+ assert.are_equal(type(Attr), 'function')+ end),+ test('returns null-Attr if no arguments are given', function ()+ local attr = 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 = 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 = Attr('', {}, attributes_table)+ assert.are_equal(+ attr_from_table.attributes,+ 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 = Attr('')+ assert.are_equal(attr.t, 'Attr')+ assert.are_equal(attr.tag, 'Attr')+ end),+ test('has field `identifier`', function ()+ local attr = Attr 'test'+ assert.are_equal(attr.identifier, 'test')+ end),+ test('can be modified through field `identifier`', function ()+ local attr = Attr 'test'+ attr.identifier = 'new'+ assert.are_equal(attr, Attr 'new')+ end),+ group 'field classes' {+ test('can be read', function ()+ local attr = Attr('', {'one'})+ assert.are_same(attr.classes, {'one'})+ end),+ test('can be set', function ()+ local attr = Attr()+ attr.classes = {'two'}+ assert.are_equal(attr, Attr('', {'two'}))+ end),+ test('contains a pandoc List', function ()+ assert.are_equal(getmetatable(Attr().classes), List)+ end),+ }+ },+ group 'AttributeList' {+ test('allows access via fields', function ()+ local attributes = 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 = 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 = 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 = AttributeList{{'a', '1'}, {'b', '2'}}+ attributes[1] = nil+ assert.are_equal(#attributes, 1)+ end),+ test('adds entries by field name', function ()+ local attributes = Attr('',{}, {{'c', '1'}, {'d', '2'}}).attributes+ attributes.e = '3'+ assert.are_same(+ attributes,+ -- checking the full AttributeList would "duplicate" entries+ AttributeList{{'c', '1'}, {'d', '2'}, {'e', '3'}}+ )+ end),+ test('deletes entries by field name', function ()+ local attributes = Attr('',{}, {a = '1', b = '2'}).attributes+ attributes.a = nil+ assert.is_nil(attributes.a)+ assert.are_same(attributes, AttributeList{{'b', '2'}})+ end),+ test('remains unchanged if deleted key did not exist', function ()+ local assoc_list = List:new {{'alpha', 'x'}, {'beta', 'y'}}+ local attributes = Attr('', {}, assoc_list).attributes+ attributes.a = nil+ local new_assoc_list = 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 = 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 = Attr(html_attributes)+ 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/test-block.lua view
@@ -0,0 +1,346 @@+local tasty = require 'tasty'++local test = tasty.test_case+local group = tasty.test_group+local assert = tasty.assert++return {+ group "Block" {+ group 'BlockQuote' {+ test('access content via property `content`', function ()+ local elem = BlockQuote{'word'}+ assert.are_same(elem.content, {Plain 'word'})+ assert.are_equal(type(elem.content), 'table')++ elem.content = {+ Para{Str 'one'},+ Para{Str 'two'}+ }+ assert.are_equal(+ BlockQuote{+ Para 'one',+ Para 'two'+ },+ elem+ )+ end),+ },+ group 'BulletList' {+ test('access items via property `content`', function ()+ local para = Para 'one'+ local blist = BulletList{{para}}+ assert.are_same({{para}}, blist.content)+ end),+ test('property `content` uses fuzzy marshalling', function ()+ local old = Plain 'old'+ local new = Plain 'new'+ local blist = BulletList{{old}}+ blist.content = {{new}}+ assert.are_same({{new}}, blist:clone().content)+ blist.content = new+ assert.are_same({{new}}, blist:clone().content)+ end),+ },+ group 'CodeBlock' {+ test('access code via property `text`', function ()+ local cb = 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, CodeBlock('return nil'))+ end),+ test('access Attr via property `attr`', function ()+ local cb = CodeBlock('true', {'my-code', {'lua'}})+ assert.are_equal(cb.attr, Attr{'my-code', {'lua'}})+ assert.are_equal(type(cb.attr), 'userdata')++ cb.attr = Attr{'my-other-code', {'java'}}+ assert.are_equal(+ CodeBlock('true', {'my-other-code', {'java'}}),+ cb+ )+ end)+ },+ group 'DefinitionList' {+ test('access items via property `content`', function ()+ local deflist = DefinitionList{+ {'apple', {{Plain 'fruit'}, {Plain 'company'}}},+ {Str 'coffee', 'Best when hot.'}+ }+ assert.are_equal(#deflist.content, 2)+ assert.are_same(deflist.content[1][1], {Str 'apple'})+ assert.are_same(deflist.content[1][2][2],+ {Plain{Str 'company'}})+ assert.are_same(deflist.content[2][2],+ {{Plain{+ Str 'Best', Space(),+ Str 'when', Space(),+ Str 'hot.'}}})+ end),+ test('modify items via property `content`', function ()+ local deflist = DefinitionList{+ {'apple', {{{'fruit'}}, {{'company'}}}}+ }+ deflist.content[1][1] = Str 'orange'+ deflist.content[1][2][1] = {Plain 'tasty fruit'}+ local newlist = DefinitionList{+ { {Str 'orange'},+ {{Plain 'tasty fruit'}, {Plain 'company'}}+ }+ }+ assert.are_equal(deflist, newlist)+ end),+ },+ group 'Div' {+ test('access content via property `content`', function ()+ local elem = Div{BlockQuote{Plain 'word'}}+ assert.are_same(elem.content, {BlockQuote{'word'}})+ assert.are_equal(type(elem.content), 'table')++ elem.content = {+ Para{Str 'one'},+ Para{Str 'two'}+ }+ assert.are_equal(+ Div{+ Para 'one',+ Para 'two'+ },+ elem+ )+ end),+ test('access Attr via property `attr`', function ()+ local div = Div('word', {'my-div', {'sample'}})+ assert.are_equal(div.attr, Attr{'my-div', {'sample'}})+ assert.are_equal(type(div.attr), 'userdata')++ div.attr = Attr{'my-other-div', {'example'}}+ assert.are_equal(+ Div('word', {'my-other-div', {'example'}}),+ div+ )+ end)+ },+ group 'Header' {+ test('access inlines via property `content`', function ()+ local header = Header(1, 'test')+ assert.are_same(header.content, {Str 'test'})++ header.content = {'new text'}+ assert.are_equal(header, Header(1, {'new text'}))+ end),+ test('access Attr via property `attr`', function ()+ local header = Header(1, 'test', {'my-test'})+ assert.are_same(header.attr, Attr{'my-test'})++ header.attr = 'second-test'+ assert.are_equal(header, Header(1, 'test', 'second-test'))+ end),+ test('access level via property `level`', function ()+ local header = Header(3, 'test')+ assert.are_same(header.level, 3)++ header.level = 2+ assert.are_equal(header, Header(2, 'test'))+ end),+ },+ group 'LineBlock' {+ test('access lines via property `content`', function ()+ local spc = Space()+ local lineblock = 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], Str 'Berkeley')+ end),+ test('modifying `content` alter the element', function ()+ local spc = Space()+ local lineblock = LineBlock{+ {'200', spc, 'Main', spc, 'St.'},+ {'Berkeley', spc, 'CA', spc, '94718'}+ }+ lineblock.content[1][1] = '404'+ assert.are_same(+ lineblock:clone().content[1],+ {Str '404', spc, Str 'Main', spc, Str 'St.'}+ )++ lineblock.content = {{'line1'}, {'line2'}}+ assert.are_same(+ lineblock:clone(),+ LineBlock{+ {Str 'line1'},+ {Str 'line2'}+ }+ )+ end)+ },+ group 'Null' {+ test('Can be constructed', function ()+ assert.are_equal(Null().t, 'Null')+ end)+ },+ group 'OrderedList' {+ test('access items via property `content`', function ()+ local para = Plain 'one'+ local olist = OrderedList{{para}}+ assert.are_same({{para}}, olist.content)+ end),+ test('forgiving constructor', function ()+ local plain = Plain 'old'+ local olist = OrderedList({plain}, {3, 'Example', 'Period'})+ local listAttribs = ListAttributes(3, 'Example', 'Period')+ assert.are_same(olist.listAttributes, listAttribs)+ end),+ test('has list attribute aliases', function ()+ local olist = 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 = Para{'Moin, ', Space(), 'Sylt!'}+ assert.are_same(+ para.content,+ {Str 'Moin, ', Space(), Str 'Sylt!'}+ )+ end),+ test('modifying `content` changes the element', function ()+ local para = Para{'Moin, ', Space(), Str 'Sylt!'}++ para.content[3] = 'Hamburg!'+ assert.are_same(+ para:clone().content,+ {Str 'Moin, ', Space(), Str 'Hamburg!'}+ )++ para.content = 'Huh'+ assert.are_same(+ para:clone().content,+ {Str 'Huh'}+ )+ end),+ },+ group 'RawBlock' {+ test('access raw content via property `text`', function ()+ local raw = RawBlock('markdown', '- one')+ assert.are_equal(type(raw.text), 'string')+ assert.are_equal(raw.text, '- one')++ raw.text = '+ one'+ assert.are_equal(raw, RawBlock('markdown', '+ one'))+ end),+ test('access Format via property `format`', function ()+ local raw = RawBlock('markdown', '* hi')+ assert.are_equal(type(raw.format), 'string')+ assert.are_equal(raw.format, 'markdown')++ raw.format = 'org'+ assert.are_equal(RawBlock('org', '* hi'), raw)+ end)+ },+ group 'Table' {+ test('access Attr via property `attr`', function ()+ local caption = {long = {Plain 'cap'}}+ local tbl = Table(caption, {}, {{}, {}}, {}, {{}, {}},+ {'my-tbl', {'a'}})+ assert.are_equal(tbl.attr, Attr{'my-tbl', {'a'}})++ tbl.attr = Attr{'my-other-tbl', {'b'}}+ assert.are_equal(+ Table(caption, {}, {{}, {}}, {}, {{}, {}},+ {'my-other-tbl', {'b'}}),+ tbl+ )+ end),+ test('access caption via property `caption`', function ()+ local caption = {long = {Plain 'cap'}}+ local tbl = Table(caption, {}, {{}, {}}, {}, {{}, {}})+ assert.are_same(tbl.caption, {long = {Plain 'cap'}})++ tbl.caption.short = 'brief'+ tbl.caption.long = {Plain 'extended'}++ local new_caption = {+ short = 'brief',+ long = {Plain 'extended'}+ }+ assert.are_equal(+ Table(new_caption, {}, {{}, {}}, {}, {{}, {}}),+ tbl+ )+ end),+ test('access column specifiers via property `colspecs`', function ()+ local colspecs = {{AlignCenter, 1}}+ local tbl = Table({long = {}}, colspecs, {{}, {}}, {}, {{}, {}})+ assert.are_same(tbl.colspecs, colspecs)++ tbl.colspecs[1][1] = AlignRight+ tbl.colspecs[1][2] = nil++ local new_colspecs = {{AlignRight}}+ assert.are_equal(+ Table({long = {}}, new_colspecs, {{}, {}}, {}, {{}, {}}),+ tbl+ )+ end),+ test('access table head via property `head`', function ()+ local head = {Attr{'tbl-head'}, {}}+ local tbl = Table({long = {}}, {}, head, {}, {{}, {}})+ assert.are_same(tbl.head, head)++ tbl.head[1] = Attr{'table-head'}++ local new_head = {'table-head', {}}+ assert.are_equal(+ Table({long = {}}, {}, new_head, {}, {{}, {}}),+ tbl+ )+ end),+ test('access table head via property `head`', function ()+ local foot = {{id = 'tbl-foot'}, {}}+ local tbl = Table({long = {}}, {}, {{}, {}}, {}, foot)+ assert.are_same(tbl.foot, {Attr('tbl-foot'), {}})++ tbl.foot[1] = Attr{'table-foot'}++ local new_foot = {'table-foot', {}}+ assert.are_equal(+ Table({long = {}}, {}, {{}, {}}, {}, new_foot),+ tbl+ )+ end)+ },+ },+ group "Blocks" {+ test('splits a string into words', function ()+ assert.are_same(+ Blocks 'Absolute Giganten',+ {Plain {Str 'Absolute', Space(), Str 'Giganten'}}+ )+ end),+ test('converts single Block into List', function ()+ assert.are_same(+ Blocks(CodeBlock('return true')),+ {CodeBlock('return true')}+ )+ end),+ test('converts elements in a list into Blocks', function ()+ assert.are_same(+ Blocks{'Berlin', 'Berkeley', Plain 'Zürich'},+ {Plain{Str 'Berlin'}, Plain{Str 'Berkeley'}, Plain{Str 'Zürich'}}+ )+ end),+ test('can be mapped over', function ()+ local words = Blocks{Header(1, 'Program'), CodeBlock 'pandoc'}+ assert.are_same(+ words:map(function (x) return x.t end),+ {'Header', 'CodeBlock'}+ )+ end),+ },+}
+ test/test-citation.lua view
@@ -0,0 +1,111 @@+--+-- Tests for the pandoc types module+--+local tasty = require 'tasty'++local group = tasty.test_group+local test = tasty.test_case+local assert = tasty.assert++return {+ group 'Citation' {+ test('can be cloned', function ()+ local cit = Citation('leibniz', AuthorInText)+ local cloned = cit:clone()+ cit.id = 'newton'+ assert.are_same(cloned.id, 'leibniz')+ assert.are_same(cit.id, 'newton')+ assert.are_same(cit.mode, cloned.mode)+ end),+ group 'field `id`' {+ test('can be read', function ()+ assert.are_equal(+ Citation('einstein1905', 'NormalCitation').id,+ 'einstein1905'+ )+ end),+ test('can be set', function ()+ local c = Citation('einstein1905', 'NormalCitation')+ c.id = 'Poincaré1905'+ assert.are_equal(c, Citation('Poincaré1905', 'NormalCitation'))+ end)+ },+ group 'field `mode`' {+ test('can be read', function ()+ assert.are_equal(+ Citation('einstein1905', 'NormalCitation').mode,+ 'NormalCitation'+ )+ end),+ test('can be set', function ()+ local c = Citation('Poincaré1905', 'NormalCitation')+ c.mode = 'AuthorInText'+ assert.are_equal(c, Citation('Poincaré1905', 'AuthorInText'))+ end)+ },+ group 'field `prefix`' {+ test('can be read', function ()+ assert.are_same(+ Citation('einstein1905', 'NormalCitation', {'x'}).prefix,+ {Str 'x'}+ )+ end),+ test('can be set', function ()+ local c = Citation('Poincaré1905', 'NormalCitation')+ c.prefix = {'y'}+ assert.are_equal(+ c,+ Citation('Poincaré1905', 'NormalCitation', {'y'})+ )+ end),+ },+ group 'field `suffix`' {+ test('can be read', function ()+ assert.are_same(+ Citation('einstein1905', 'NormalCitation', {}, 'is great').suffix,+ {Str 'is', Space(), Str 'great'}+ )+ end),+ test('can be set', function ()+ local c = Citation('Poincaré1905', 'NormalCitation')+ c.suffix = {'why'}+ assert.are_equal(+ c,+ Citation('Poincaré1905', 'NormalCitation', {}, {'why'})+ )+ end),+ },+ group 'field `note_num`' {+ test('can be read', function ()+ assert.are_equal(+ Citation('einstein1905', 'NormalCitation', {}, {}, 7).note_num,+ 7+ )+ end),+ test('can be set', function ()+ local c = Citation('Poincaré1905', 'NormalCitation')+ c.note_num = 23+ assert.are_equal(+ c,+ Citation('Poincaré1905', 'NormalCitation', {}, {}, 23)+ )+ end),+ },+ group 'field `hash`' {+ test('can be read', function ()+ assert.are_equal(+ Citation('einstein1905', 'NormalCitation', {}, {}, 0, 5).hash,+ 5+ )+ end),+ test('can be set', function ()+ local c = Citation('Poincaré1905', 'NormalCitation')+ c.hash = 23+ assert.are_equal(+ c,+ Citation('Poincaré1905', 'NormalCitation', {}, {}, 0, 23)+ )+ end)+ }+ }+}
+ test/test-inline.lua view
@@ -0,0 +1,300 @@+local tasty = require 'tasty'++local test = tasty.test_case+local group = tasty.test_group+local assert = tasty.assert++return {+ group "Inline" {+ group 'Cite' {+ test('has property `content`', function ()+ local cite = Cite({Emph 'important'}, {})+ assert.are_same(cite.content, {Emph {Str 'important'}})++ cite.content = 'boring'+ assert.are_equal(cite, Cite({Str 'boring'}, {}))+ end),+ test('has list of citations in property `cite`', function ()+ local citations = {+ Citation('einstein1905', 'NormalCitation')+ }+ local cite = Cite('relativity', citations)+ assert.are_same(cite.citations, citations)++ local new_citations = {+ citations[1],+ Citation('Poincaré1905', 'NormalCitation')+ }+ cite.citations = new_citations+ assert.are_equal(cite, Cite({'relativity'}, new_citations))+ end),+ },+ group 'Code' {+ test('has property `attr`', function ()+ local code = Code('true', {id='true', foo='bar'})+ assert.are_equal(code.attr, Attr('true', {}, {{'foo', 'bar'}}))++ code.attr = {id='t', fubar='quux'}+ assert.are_equal(+ Code('true', Attr('t', {}, {{'fubar', 'quux'}})),+ code+ )+ end),+ test('has property `text`', function ()+ local code = Code('true')+ assert.are_equal(code.text, 'true')++ code.text = '1 + 1'+ assert.are_equal(Code('1 + 1'), code)+ end),+ },+ group 'Emph' {+ test('has property `content`', function ()+ local elem = Emph{'two', Space(), 'words'}+ assert.are_same(+ elem.content,+ {Str 'two', Space(), Str 'words'}+ )+ elem.content = {'word'}+ assert.are_equal(elem, Emph{'word'})+ end)+ },+ group 'Image' {+ test('has property `caption`', function ()+ local img = Image('example', 'a.png')+ assert.are_same(img.caption, {Str 'example'})++ img.caption = 'A'+ assert.are_equal(img, Image({'A'}, 'a.png'))+ end),+ test('has property `src`', function ()+ local img = Image('example', 'sample.png')+ assert.are_same(img.src, 'sample.png')++ img.src = 'example.svg'+ assert.are_equal(img, Image('example', 'example.svg'))+ end),+ test('has property `title`', function ()+ local img = Image('here', 'img.gif', 'example')+ assert.are_same(img.title, 'example')++ img.title = 'a'+ assert.are_equal(img, Image('here', 'img.gif', 'a'))+ end),+ test('has property `attr`', function ()+ local img = Image('up', 'upwards.png', '', {'up', {'point'}})+ assert.are_same(img.attr, Attr {'up', {'point'}})++ img.attr = Attr {'up', {'point', 'button'}}+ assert.are_equal(+ Image('up', 'upwards.png', nil, {'up', {'point', 'button'}}),+ img+ )+ end)+ },+ group 'Link' {+ test('has property `content`', function ()+ local link = Link('example', 'https://example.org')+ assert.are_same(link.content, {Str 'example'})++ link.content = 'commercial'+ link.target = 'https://example.com'+ assert.are_equal(link, Link('commercial', 'https://example.com'))+ end),+ test('has property `target`', function ()+ local link = Link('example', 'https://example.org')+ assert.are_same(link.content, {Str 'example'})++ link.target = 'https://example.com'+ assert.are_equal(link, Link('example', 'https://example.com'))+ end),+ test('has property `title`', function ()+ local link = Link('here', 'https://example.org', 'example')+ assert.are_same(link.title, 'example')++ link.title = 'a'+ assert.are_equal(link, Link('here', 'https://example.org', 'a'))+ end),+ test('has property `attr`', function ()+ local link = Link('up', '../index.html', '', {'up', {'nav'}})+ assert.are_same(link.attr, Attr {'up', {'nav'}})++ link.attr = Attr {'up', {'nav', 'button'}}+ assert.are_equal(+ Link('up', '../index.html', nil, {'up', {'nav', 'button'}}),+ link+ )+ end)+ },+ group 'Math' {+ test('has property `text`', function ()+ local elem = Math(InlineMath, 'x^2')+ assert.are_same(elem.text, 'x^2')+ elem.text = 'a + b'+ assert.are_equal(elem, Math(InlineMath, 'a + b'))+ end),+ test('has property `mathtype`', function ()+ local elem = Math(InlineMath, 'x^2')+ assert.are_same(elem.mathtype, 'InlineMath')+ elem.mathtype = DisplayMath+ assert.are_equal(elem, Math(DisplayMath, 'x^2'))+ end),+ },+ group 'Note' {+ -- FIXME: waiting for Block support+ -- test('has property `content`', function ()+ -- local elem = Note{Para {'two', Space(), 'words'}}+ -- assert.are_same(+ -- elem.content,+ -- {Para {Str 'two', Space(), Str 'words'}}+ -- )+ -- elem.content = Plain 'word'+ -- assert.are_equal(elem, Note{'word'})+ -- end)+ },+ group 'Quoted' {+ test('has property `content`', function ()+ local elem = Quoted('SingleQuote', Emph{'emph'})+ assert.are_same(+ elem.content,+ {Emph{Str 'emph'}}+ )+ elem.content = {'word'}+ assert.are_equal(elem, Quoted(SingleQuote, {'word'}))+ end),+ test('has property `quotetype`', function ()+ local elem = Quoted('SingleQuote', 'a')+ assert.are_same(elem.quotetype, SingleQuote)+ elem.quotetype = 'DoubleQuote'+ assert.are_equal(elem, Quoted(DoubleQuote, {'a'}))+ end)+ },+ group 'SmallCaps' {+ test('has property `content`', function ()+ local elem = SmallCaps{'two', Space(), 'words'}+ assert.are_same(+ elem.content,+ {Str 'two', Space(), Str 'words'}+ )+ elem.content = {'word'}+ assert.are_equal(elem, SmallCaps{'word'})+ end)+ },+ group 'SoftBreak' {+ test('can be constructed', function ()+ local sb = SoftBreak()+ assert.are_equal(sb.t, 'SoftBreak')+ end)+ },+ group 'Span' {+ test('has property `attr`', function ()+ local elem = Span('one', {'', {'number'}})+ assert.are_same(+ elem.attr,+ Attr('', {'number'})+ )+ elem.attr = {'', {}, {{'a', 'b'}}}+ assert.are_equal(elem, Span({'one'}, {a='b'}))+ end),+ test('has property `content`', function ()+ local elem = Span{'two', Space(), 'words'}+ assert.are_same(+ elem.content,+ {Str 'two', Space(), Str 'words'}+ )+ elem.content = {'word'}+ assert.are_equal(elem, Span{'word'})+ end)+ },+ group 'Str' {+ test('has property `text`', function ()+ local elem = Str 'nein'+ assert.are_same(elem.text, 'nein')+ elem.text = 'doch'+ assert.are_equal(elem, Str 'doch')+ end)+ },+ group 'Strikeout' {+ test('has property `content`', function ()+ local elem = Strikeout{'two', Space(), 'words'}+ assert.are_same(+ elem.content,+ {Str 'two', Space(), Str 'words'}+ )+ elem.content = {'word'}+ assert.are_equal(elem, Strikeout{'word'})+ end)+ },+ group 'Strong' {+ test('has property `content`', function ()+ local elem = Strong{'two', Space(), 'words'}+ assert.are_same(+ elem.content,+ {Str 'two', Space(), Str 'words'}+ )+ elem.content = {'word'}+ assert.are_equal(elem, Strong{'word'})+ end)+ },+ group 'Subscript' {+ test('has property `content`', function ()+ local elem = Subscript{'two', Space(), 'words'}+ assert.are_same(+ elem.content,+ {Str 'two', Space(), Str 'words'}+ )+ elem.content = {'word'}+ assert.are_equal(elem, Subscript{'word'})+ end)+ },+ group 'Superscript' {+ test('has property `content`', function ()+ local elem = Superscript{'two', Space(), 'words'}+ assert.are_same(+ elem.content,+ {Str 'two', Space(), Str 'words'}+ )+ elem.content = {'word'}+ assert.are_equal(elem, Superscript{'word'})+ end)+ },+ group 'Underline' {+ test('has property `content`', function ()+ local elem = Underline{'two', Space(), 'words'}+ assert.are_same(+ elem.content,+ {Str 'two', Space(), Str 'words'}+ )+ elem.content = {'word'}+ assert.are_equal(elem, Underline{'word'})+ end)+ },+ },+ group "Inlines" {+ test('splits a string into words', function ()+ assert.are_same(+ Inlines 'Absolute Giganten',+ {Str 'Absolute', Space(), Str 'Giganten'}+ )+ end),+ test('converts single Inline into List', function ()+ assert.are_same(+ Inlines(Emph{Str'Important'}),+ {Emph{Str'Important'}}+ )+ end),+ test('converts elements in a list into Inlines', function ()+ assert.are_same(+ Inlines{'Molecular', Space(), 'Biology'},+ {Str 'Molecular', Space(), Str 'Biology'}+ )+ end),+ test('can be mapped over', function ()+ local words = Inlines 'good idea'+ assert.are_same(+ words:map(function (x) return x.t end),+ {'Str', 'Space', 'Str'}+ )+ end)+ },+}
+ test/test-list.lua view
@@ -0,0 +1,215 @@+--+-- Tests for the pandoc types module+--+local tasty = require 'tasty'++local group = tasty.test_group+local test = tasty.test_case+local assert = tasty.assert++return {+ group 'List' {+ test('is a table', function ()+ assert.are_equal(type(List), 'table')+ end),+ group 'constructor' {+ test('returns a new list if called without args', function ()+ assert.are_same(List(), {})+ end),+ },++ group 'clone' {+ test('changing the clone does not affect original', function ()+ local orig = List:new {23, 42}+ local copy = orig:clone()+ copy[1] = 5+ assert.are_same({23, 42}, orig)+ assert.are_same({5, 42}, copy)+ end),+ test('result is a list', function ()+ local orig = List:new {23, 42}+ assert.are_equal(List, getmetatable(orig:clone()))+ end),+ },++ group 'extend' {+ test('extends list with other list', function ()+ local primes = List:new {2, 3, 5, 7}+ primes:extend {11, 13, 17}+ assert.are_same({2, 3, 5, 7, 11, 13, 17}, primes)+ end)+ },++ group 'filter' {+ test('keep elements for which property is truthy', function ()+ local is_small_prime = function (x)+ return x == 2 or x == 3 or x == 5 or x == 7+ end+ local numbers = List:new {4, 7, 2, 9, 5, 11}+ assert.are_same(List{7, 2, 5}, numbers:filter(is_small_prime))+ end),+ test('predecate function gets current index as second arg', function ()+ local args = List()+ local collect_args = function (...)+ args[#args+1] = {...}+ return false+ end+ (List{0, 1, 1, 2, 3, 5, 8}):filter(collect_args)+ assert.are_same(+ args,+ List{{0, 1}, {1, 2}, {1, 3}, {2, 4}, {3, 5}, {5, 6}, {8, 7}}+ )+ end)+ },++ group 'find' {+ test('returns element and index if found', function ()+ local list = List:new {5, 23, 71}+ local elem, idx = list:find(71)+ assert.are_same(71, elem)+ assert.are_same(3, idx)+ end),+ test('respects start index', function ()+ local list = List:new {19, 23, 29, 71}+ assert.are_equal(23, list:find(23, 1))+ assert.are_equal(23, list:find(23, 2))+ assert.is_nil(list:find(23, 3))+ end),+ test('returns nil if element not found', function ()+ assert.is_nil((List:new {18, 20, 22, 0, 24}):find('0'))+ end),+ },++ group 'find_if' {+ test('returns element and index if found', function ()+ local perm_prime = List:new {2, 3, 5, 7, 11, 13, 17, 31, 37, 71}+ local elem, idx = perm_prime:find_if(function (x) return x >= 10 end)+ assert.are_same(11, elem)+ assert.are_same(5, idx)+ end),+ test('gets current index as second arg', function ()+ assert.are_equal(+ 5,+ (List{9, 8, 7, 6, 5, 4, 3, 2, 1}):find_if(+ function (x, i) return x == i end+ )+ )+ end),+ test('returns nil if element not found', function ()+ local is_zero = function (n) return n == 0 end+ assert.is_nil((List:new {18, 20, 22, 24, 27}):find_if(is_zero))+ end),+ },++ group 'includes' {+ test('finds elements in list', function ()+ local lst = List:new {'one', 'two', 'three'}+ assert.is_truthy(lst:includes('one'))+ assert.is_truthy(lst:includes('two'))+ assert.is_truthy(lst:includes('three'))+ assert.is_falsy(lst:includes('four'))+ end)+ },++ group 'insert' {+ test('is a function', function ()+ assert.are_equal(type(List.insert), 'function')+ end),+ test('insert value at end of list.', function ()+ local count_norsk = List {'en', 'to', 'tre'}+ count_norsk:insert('fire')+ assert.are_same({'en', 'to', 'tre', 'fire'}, count_norsk)+ end),+ test('insert value in the middle of list.', function ()+ local count_norsk = List {'fem', 'syv'}+ count_norsk:insert(2, 'seks')+ assert.are_same({'fem', 'seks', 'syv'}, count_norsk)+ end)+ },++ group 'map' {+ test('applies function to elements', function ()+ local primes = List:new {2, 3, 5, 7}+ local squares = primes:map(function (x) return x^2 end)+ assert.are_same({4, 9, 25, 49}, squares)+ end),+ test('leaves original list unchanged', function ()+ local primes = List:new {2, 3, 5, 7}+ local squares = primes:map(function (x) return x^2 end)+ assert.are_same({2, 3, 5, 7}, primes)+ end),+ test('map function gets index as second argument', function ()+ local primes = List:new {2, 3, 5, 7}+ local indices = primes:map(function (x, i) return i end)+ assert.are_same(List{1, 2, 3, 4}, indices)+ end)+ },++ group 'new' {+ test('keeps elements in list', function ()+ local test = {1, 1, 2, 3, 5}+ assert.are_same(List:new(test), test)+ end),+ test('return empty list if no argument is given', function ()+ assert.are_same({}, List:new())+ end),+ test('metatable of result is pandoc.List', function ()+ local test = List:new{5}+ assert.are_equal(List, getmetatable(test))+ end)+ },++ group 'remove' {+ test('is a function', function ()+ assert.are_equal(type(List.remove), 'function')+ end),+ test('remove value at end of list.', function ()+ local understand = List {'jeg', 'forstår', 'ikke'}+ local norsk_not = understand:remove()+ assert.are_same({'jeg', 'forstår'}, understand)+ assert.are_equal('ikke', norsk_not)+ end),+ test('remove value at beginning of list.', function ()+ local count_norsk = List {'en', 'to', 'tre'}+ count_norsk:remove(1)+ assert.are_same({'to', 'tre'}, count_norsk)+ end)+ },++ group 'sort' {+ test('is a function', function ()+ assert.are_equal(type(List.sort), 'function')+ end),+ test('sort numeric list', function ()+ local numbers = List {71, 5, -1, 42, 23, 0, 1}+ numbers:sort()+ assert.are_same({-1, 0, 1, 5, 23, 42, 71}, numbers)+ end),+ test('reverse-sort numeric', function ()+ local numbers = List {71, 5, -1, 42, 23, 0, 1}+ numbers:sort(function (x, y) return x > y end)+ assert.are_same({71, 42, 23, 5, 1, 0, -1}, numbers)+ end)+ },+ },+ group 'Operations' {+ group 'concatenation' {+ test('yields a concatenated list', function ()+ assert.are_same(List {3, 4, 5, 6}, List{3, 4} .. List {5, 6})+ end),+ test('does not modify its operands', function ()+ local a = List {54, 74}+ local b = List {90, 2014}+ local result = a .. b+ assert.are_same(a, List{54, 74})+ assert.are_same(b, List{90, 2014})+ end),+ test('sets metatable of first operand on result', function ()+ local result = {1, 4} .. List{9, 16}+ assert.are_equal(nil, getmetatable(result))+ result = List{1, 4} .. {9, 16}+ assert.are_equal(List, getmetatable(result))+ end),+ }+ },+}
+ test/test-listattributes.lua view
@@ -0,0 +1,65 @@+local tasty = require 'tasty'++local test = tasty.test_case+local group = tasty.test_group+local assert = tasty.assert++return {+ group 'ListAttributes' {+ test('has field `start`', function ()+ local la = ListAttributes(7, DefaultStyle, Period)+ assert.are_equal(la.start, 7)+ end),+ test('has field `style`', function ()+ local la = ListAttributes(1, Example, Period)+ assert.are_equal(la.style, 'Example')+ end),+ test('has field `delimiter`', function ()+ local la = ListAttributes(1, Example, Period)+ assert.are_equal(la.delimiter, 'Period')+ end),+ test('can be compared on equality', function ()+ assert.are_equal(+ ListAttributes(2, DefaultStyle, Period),+ ListAttributes(2, DefaultStyle, Period)+ )+ assert.is_falsy(+ ListAttributes(2, DefaultStyle, Period) ==+ ListAttributes(4, DefaultStyle, Period)+ )+ end),+ test('can be modified through `start`', function ()+ local la = ListAttributes(3, Decimal, OneParen)+ la.start = 20+ assert.are_equal(la, ListAttributes(20, Decimal, OneParen))+ end),+ test('can be modified through `style`', function ()+ local la = ListAttributes(3, Decimal, OneParen)+ la.style = LowerRoman+ assert.are_equal(la, ListAttributes(3, LowerRoman, OneParen))+ end),+ test('can be modified through `delimiter`', function ()+ local la = ListAttributes(5, UpperAlpha, DefaultDelim)+ la.delimiter = TwoParens+ assert.are_equal(la, ListAttributes(5, UpperAlpha, TwoParens))+ end),+ test('can be cloned', function ()+ local la = ListAttributes(2, DefaultStyle, Period)+ local cloned = la:clone()+ assert.are_equal(la, cloned)+ la.start = 9+ assert.are_same(cloned.start, 2)+ end),+ group 'Constructor' {+ test('omitting a start numer sets it to 1', function ()+ assert.are_equal(ListAttributes().start, 1)+ end),+ test('omitting a style sets it to DefaultStyle', function ()+ assert.are_equal(ListAttributes(0).style, DefaultStyle)+ end),+ test('omitting a delimiter sets it to DefaultDelim', function ()+ assert.are_equal(ListAttributes(0, UpperRoman).delimiter, DefaultDelim)+ end)+ }+ },+}
+ test/test-metavalue.lua view
@@ -0,0 +1,15 @@+local tasty = require 'tasty'++local test = tasty.test_case+local group = tasty.test_group+local assert = tasty.assert++return {+ group 'MetaValue elements' {+ test('MetaList elements behave like lists', function ()+ local metalist = MetaList{}+ assert.are_equal(type(metalist.insert), 'function')+ assert.are_equal(type(metalist.remove), 'function')+ end),+ }+}
+ test/test-pandoc-lua-marshal.hs view
@@ -0,0 +1,209 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-|+Module : Main+Copyright : © 2017-2021 Albert Krewinkel+License : MIT+Maintainer : Albert Krewinkel <albert+hslua@zeitkraut.de>++Tests for the pandoc types handling in Lua.+-}+module Main (main) where++import Control.Monad (forM_, when)+import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr)+import Data.Proxy (Proxy (Proxy))+import Data.String (fromString)+import HsLua as Lua+import Test.Tasty.QuickCheck (ioProperty, testProperty)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.Lua (translateResultsFromFile)+import Text.Pandoc.Arbitrary ()+import Text.Pandoc.Definition+import Text.Pandoc.Lua.Marshal.AST++main :: IO ()+main = do+ listTests <- run @Lua.Exception $ do+ openlibs+ pushListModule *> setglobal "List"+ translateResultsFromFile "test/test-list.lua"++ listAttributeTests <- run @Lua.Exception $ do+ openlibs+ register' mkListAttributes+ registerConstants (Proxy @ListNumberStyle)+ registerConstants (Proxy @ListNumberDelim)+ translateResultsFromFile "test/test-listattributes.lua"++ attrTests <- run @Lua.Exception $ do+ openlibs+ pushListModule *> setglobal "List"+ register' mkAttr+ register' mkAttributeList+ translateResultsFromFile "test/test-attr.lua"++ citationTests <- run @Lua.Exception $ do+ openlibs+ pushListModule *> setglobal "List"+ register' mkCitation+ registerConstants (Proxy @CitationMode)+ forM_ inlineConstructors register'+ translateResultsFromFile "test/test-citation.lua"++ inlineTests <- run @Lua.Exception $ do+ openlibs+ pushListModule *> setglobal "List"+ register' mkAttr+ register' mkCitation+ register' mkInlines+ registerConstants (Proxy @CitationMode)+ registerConstants (Proxy @MathType)+ registerConstants (Proxy @QuoteType)+ forM_ inlineConstructors register'+ translateResultsFromFile "test/test-inline.lua"++ blockTests <- run @Lua.Exception $ do+ openlibs+ pushListModule *> setglobal "List"+ register' mkAttr+ register' mkBlocks+ register' mkListAttributes+ registerConstants (Proxy @Alignment)+ registerConstants (Proxy @ListNumberStyle)+ registerConstants (Proxy @ListNumberStyle)+ forM_ inlineConstructors register'+ forM_ blockConstructors register'+ translateResultsFromFile "test/test-block.lua"++ simpleTableTests <- run @Lua.Exception $ do+ openlibs+ pushListModule *> setglobal "List"+ register' mkAttr+ register' mkListAttributes+ register' mkSimpleTable+ registerConstants (Proxy @Alignment)+ forM_ inlineConstructors register'+ forM_ blockConstructors register'+ translateResultsFromFile "test/test-simpletable.lua"++ metavalueTests <- run @Lua.Exception $ do+ openlibs+ pushListModule *> setglobal "List"+ forM_ metaValueConstructors register'+ translateResultsFromFile "test/test-metavalue.lua"++ pandocTests <- run @Lua.Exception $ do+ openlibs+ pushListModule *> setglobal "List"+ register' mkMeta+ register' mkPandoc+ forM_ inlineConstructors register'+ forM_ blockConstructors register'+ translateResultsFromFile "test/test-pandoc.lua"++ defaultMain $ testGroup "pandoc-lua-marshal"+ [ roundtrips+ , listTests+ , listAttributeTests+ , attrTests+ , citationTests+ , inlineTests+ , blockTests+ , simpleTableTests+ , metavalueTests+ , pandocTests+ ]++register' :: LuaError e => DocumentedFunction e -> LuaE e ()+register' f = do+ pushDocumentedFunction f+ setglobal (functionName f)++registerConstants :: forall a e. (Data a, LuaError e) => Proxy a -> LuaE e ()+registerConstants proxy =+ forM_ (constructors proxy) $ \c -> do+ pushString c+ setglobal (fromString c)++constructors :: forall a. Data a => Proxy a -> [String]+constructors _ = map showConstr . dataTypeConstrs . dataTypeOf @a $ undefined++--+-- Roundtrips+--++-- | Basic tests+roundtrips :: TestTree+roundtrips = testGroup "Roundtrip through Lua stack"+ [ testProperty "Alignment" $+ ioProperty . roundtripEqual pushAlignment peekAlignment++ , testProperty "Block" $+ ioProperty . roundtripEqual pushBlock peekBlockFuzzy++ , testProperty "[Block]" $+ ioProperty . roundtripEqual pushBlocks peekBlocksFuzzy++ , testProperty "Caption" $+ ioProperty . roundtripEqual pushCaption peekCaption++ , testProperty "Cell" $+ ioProperty . roundtripEqual pushCell peekCell++ , testProperty "Citation" $+ ioProperty . roundtripEqual pushCitation peekCitation++ , testProperty "CitationMode" $+ ioProperty . roundtripEqual pushCitationMode peekCitationMode++ , testProperty "Inline" $+ ioProperty . roundtripEqual pushInline peekInlineFuzzy++ , testProperty "[Inline]" $+ ioProperty . roundtripEqual pushInlines peekInlinesFuzzy++ , testProperty "ListNumberStyle" $+ ioProperty . roundtripEqual pushListNumberStyle peekListNumberStyle++ , testProperty "ListNumberDelim" $+ ioProperty . roundtripEqual pushListNumberDelim peekListNumberDelim++ , testProperty "MathType" $+ ioProperty . roundtripEqual pushMathType peekMathType++ , testProperty "Meta" $+ ioProperty . roundtripEqual pushMeta peekMeta++ , testProperty "Pandoc" $+ ioProperty . roundtripEqual pushPandoc peekPandoc++ , testProperty "Row" $+ ioProperty . roundtripEqual pushRow peekRow++ , testProperty "QuoteType" $+ ioProperty . roundtripEqual pushQuoteType peekQuoteType++ , testProperty "TableBody" $+ ioProperty . roundtripEqual pushTableBody peekTableBody++ , testProperty "TableHead" $+ ioProperty . roundtripEqual pushTableHead peekTableHead+ ]++roundtripEqual :: forall a. Eq a+ => Pusher Lua.Exception a -> Peeker Lua.Exception a+ -> a -> IO Bool+roundtripEqual pushX peekX x = (x ==) <$> roundtripped+ where+ roundtripped :: IO a+ roundtripped = run $ do+ openlibs+ pushListModule <* pop 1+ oldSize <- gettop+ pushX x+ size <- gettop+ when (size - oldSize /= 1) $+ Prelude.error ("Only one value should have been pushed" ++ show size)+ forcePeek $ peekX top
+ test/test-pandoc.lua view
@@ -0,0 +1,26 @@+local tasty = require 'tasty'++local test = tasty.test_case+local group = tasty.test_group+local assert = tasty.assert++return {+ group 'Meta' {+ test('inline list is treated as MetaInlines', function ()+ local meta = Pandoc({}, {test = {Emph 'check'}}).meta+ assert.are_same(meta.test, {Emph{Str 'check'}})+ end),+ test('inline element is treated as MetaInlines singleton', function ()+ local meta = Pandoc({}, {test = Emph 'check'}).meta+ assert.are_same(meta.test, {Emph{Str 'check'}})+ end),+ test('block list is treated as MetaBlocks', function ()+ local meta = Pandoc({}, {test = {Plain 'check'}}).meta+ assert.are_same(meta.test, {Plain{Str 'check'}})+ end),+ test('block element is treated as MetaBlocks singleton', function ()+ local meta = Pandoc({}, {test = Plain 'check'}).meta+ assert.are_same(meta.test, {Plain{Str 'check'}})+ end),+ },+}