packages feed

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 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),+  },+}