diff options
| author | Albert Krewinkel <albert@zeitkraut.de> | 2021-11-28 02:08:01 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2021-11-27 17:08:01 -0800 |
| commit | 3692a1d1e83703fbf235214f2838cd92683c625c (patch) | |
| tree | 2eb377285e1ca485c03ea60eef1d92ff58827666 | |
| parent | 0d25232bbf2998cccf6ca4b1dc6e8d6f36eb9c60 (diff) | |
| download | pandoc-3692a1d1e83703fbf235214f2838cd92683c625c.tar.gz | |
Lua: use package pandoc-lua-marshal (#7719)
The marshaling functions for pandoc's AST are extracted into a separate
package. The package comes with a number of changes:
- Pandoc's List module was rewritten in C, thereby improving error
messages.
- Lists of `Block` and `Inline` elements are marshaled using the new
list types `Blocks` and `Inlines`, respectively. These types
currently behave identical to the generic List type, but give better
error messages. This also opens up the possibility of adding
element-specific methods to these lists in the future.
- Elements of type `MetaValue` are no longer pushed as values which
have `.t` and `.tag` properties. This was already true for
`MetaString` and `MetaBool` values, which are still marshaled as Lua
strings and booleans, respectively. Affected values:
+ `MetaBlocks` values are marshaled as a `Blocks` list;
+ `MetaInlines` values are marshaled as a `Inlines` list;
+ `MetaList` values are marshaled as a generic pandoc `List`s.
+ `MetaMap` values are marshaled as plain tables and no longer
given any metatable.
- The test suite for marshaled objects and their constructors has
been extended and improved.
- A bug in Citation objects, where setting a citation's suffix
modified it's prefix, has been fixed.
31 files changed, 308 insertions, 2893 deletions
diff --git a/cabal.project b/cabal.project index 669dd74e2..7164f9978 100644 --- a/cabal.project +++ b/cabal.project @@ -3,6 +3,11 @@ tests: True flags: +embed_data_files constraints: aeson >= 2.0.1.0 +source-repository-package + type: git + location: https://github.com/tarleb/pandoc-lua-marshal.git + tag: 56387e543c48cc5518a77c2a271ff211653f2a36 + -- source-repository-package -- type: git -- location: https://github.com/jgm/texmath.git diff --git a/data/pandoc.List.lua b/data/pandoc.List.lua deleted file mode 100644 index b33c30876..000000000 --- a/data/pandoc.List.lua +++ /dev/null @@ -1,142 +0,0 @@ ---[[ -List.lua - -Copyright © 2017–2020 Albert Krewinkel - -Permission to use, copy, modify, and/or distribute this software for any -purpose with or without fee is hereby granted, provided that the above -copyright notice and this permission notice appear in all copies. - -THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ]] - ---- Pandoc's List type and helper methods --- @classmod pandoc.List --- @author Albert Krewinkel --- @copyright © 2017–2020 Albert Krewinkel --- @license MIT -local List = { - _VERSION = "1.0.0" -} - ---- Create a new list. --- @param[opt] o table that should be altered into a list (default: `{}`) --- @return the altered input table -function List:new (o) - o = o or {} - setmetatable(o, self) - self.__index = self - return o -end - ---- Concatenates two lists. --- @param list second list concatenated to the first --- @return a new list containing all elements from list1 and list2 -function List:__concat (list) - local res = List.clone(self) - List.extend(res, list) - return res -end - ---- Returns a (shallow) copy of the list. -function List:clone () - local lst = setmetatable({}, getmetatable(self)) - List.extend(lst, self) - return lst -end - ---- Adds the given list to the end of this list. --- @param list list to appended -function List:extend (list) - for i = 1, #list do - self[#self + 1] = list[i] - end -end - ---- Returns a new list containing all items satisfying a given condition. --- @param pred condition items must satisfy. --- @return a new list containing all items for which `test` was true. -function List:filter (pred) - local res = setmetatable({}, getmetatable(self)) - for i = 1, #self do - if pred(self[i], i) then - res[#res + 1] = self[i] - end - end - return res -end - ---- Returns the value and index of the first occurrence of the given item. --- @param needle item to search for --- @param[opt] init index at which the search is started (default: 1) --- @return first item equal to the needle, or nil if no such item exists. --- @return index of that element -function List:find (needle, init) - return List.find_if(self, function(x) return x == needle end, init) -end - ---- Returns the value and index of the first element for which the predicate ---- holds true. --- @param pred the predicate function --- @param[opt] init index at which the search is started (default: 1) --- @return first item for which `test` succeeds, or nil if no such item exists. --- @return index of that element -function List:find_if (pred, init) - init = (init == nil and 1) or (init < 0 and #self - init) or init - for i = init, #self do - if pred(self[i], i) then - return self[i], i - end - end - return nil -end - ---- Checks if the list has an item equal to the given needle. --- @param needle item to search for --- @param[opt] init index at which the search is started; defaults to 1. --- @return true if a list item is equal to the needle, false otherwise -function List:includes (needle, init) - return not (List.find(self, needle, init) == nil) -end - ---- Insert an element into the list. Alias for `table.insert`. --- @param list list --- @param[opt] pos position at which the new element is to be inserted --- @param value value to insert -List.insert = table.insert - ---- Returns a copy of the current list by applying the given function to --- all elements. --- @param fn function which is applied to all list items. -function List:map (fn) - local res = setmetatable({}, getmetatable(self)) - for i = 1, #self do - res[i] = fn(self[i], i) - end - return res -end - ---- Remove element from list (alias for `table.remove`) --- @param list list --- @param[opt] pos position of the element to be removed (default: #list) --- @return the removed element -List.remove = table.remove - ---- Sort list in-place (alias for `table.sort`) --- @param list list --- @param[opt] comp comparison function; default to `<` operator. -List.sort = table.sort - --- Set metatable with __call metamethod. This allows the use of `List` --- as a constructor function. -local ListMT = { - __call = List.new -} -setmetatable(List, ListMT) - -return List diff --git a/data/pandoc.lua b/data/pandoc.lua deleted file mode 100644 index 7e5ff799b..000000000 --- a/data/pandoc.lua +++ /dev/null @@ -1,247 +0,0 @@ ---[[ -pandoc.lua - -Copyright © 2017–2019 Albert Krewinkel - -Permission to use, copy, modify, and/or distribute this software for any purpose -with or without fee is hereby granted, provided that the above copyright notice -and this permission notice appear in all copies. - -THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH -REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND -FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, -INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS -OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER -TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF -THIS SOFTWARE. -]] - ---- --- Lua functions for pandoc scripts. --- --- @author Albert Krewinkel --- @copyright © 2017–2019 Albert Krewinkel --- @license MIT -local M = {} - --- Re-export bundled modules -M.List = require 'pandoc.List' -M.mediabag = require 'pandoc.mediabag' -M.path = require 'pandoc.path' -M.system = require 'pandoc.system' -M.types = require 'pandoc.types' -M.utils = require 'pandoc.utils' -M.text = require 'text' - --- Local names for modules which this module depends on. -local List = M.List -local utils = M.utils - - ------------------------------------------------------------------------- --- Accessor objects --- --- Create metatables which allow to access numerical indices via accessor --- methods. --- @section --- @local - ---- Create a new table which allows to access numerical indices via accessor --- functions. --- @local -local function create_accessor_behavior (tag) - local behavior = {tag = tag} - behavior.__eq = utils.equals - behavior.__index = function(t, k) - if k == "t" then - return getmetatable(t)["tag"] - end - return getmetatable(t)[k] - end - behavior.__pairs = function (t) - return next, t - end - return behavior -end - - ------------------------------------------------------------------------- --- The base class for types --- @type Type --- @local -local Type = {} -Type.name = 'Type' -Type.__index = Type -Type.behavior = { - __type = Type, - new = function (obj) - obj = obj or {} - setmetatable(obj, self) - return obj - end -} -Type.behavior.__index = Type.behavior - ---- Set a new behavior for the type, inheriting that of the parent type if none ---- is specified explicitly --- @param behavior the behavior object for this type. --- @local -function Type:set_behavior (behavior) - behavior = behavior or {} - behavior.__index = rawget(behavior, '__index') or behavior - behavior.__type = self - if not getmetatable(behavior) and getmetatable(self) then - setmetatable(behavior, getmetatable(self).behavior) - end - self.behavior = behavior -end - ---- Create a new subtype, using the given table as base. --- @param name name of the new type --- @param[opt] behavior behavioral object for the new type. --- @return a new type --- @local -function Type:make_subtype(name, behavior) - local newtype = setmetatable({}, self) - newtype.name = name - newtype.__index = newtype - newtype:set_behavior(behavior) - return newtype -end - - ------------------------------------------------------------------------- --- The base class for pandoc's AST elements. --- @type AstElement --- @local -local AstElement = Type:make_subtype 'AstElement' -AstElement.__call = function(t, ...) - local success, ret = pcall(t.new, t, ...) - if success then - return setmetatable(ret, t.behavior) - else - error(string.format('Constructor for %s failed: %s\n', t.name, ret)) - end -end - ---- Make a new subtype which constructs a new value when called. --- @local -function AstElement:make_subtype(...) - local newtype = Type.make_subtype(self, ...) - newtype.__call = self.__call - return newtype -end - ---- Create a new constructor --- @local --- @param tag Tag used to identify the constructor --- @param fn Function to be called when constructing a new element --- @param accessors names to use as accessors for numerical fields --- @return function that constructs a new element -function AstElement:create_constructor(tag, fn) - local constr = self:make_subtype(tag, create_accessor_behavior(tag)) - function constr:new(...) - return setmetatable(fn(...), self.behavior) - end - self.constructor = self.constructor or {} - self.constructor[tag] = constr - return constr -end - ---- Convert AstElement input into a list if necessary. --- @local -local function ensureList (x) - if x.tag then - -- Lists are not tagged, but all elements are - return List:new{x} - else - return List:new(x) - end -end - ---- Ensure a given object is an Inline element, or convert it into one. --- @local -local function ensureInlineList (x) - if type(x) == 'string' then - return List:new{M.Str(x)} - else - return ensureList(x) - end -end - ------------------------------------------------------------------------- --- Meta --- @section Meta - ---- Create a new Meta object. It sets the metatable of the given table to ---- `Meta`. --- @function Meta --- @tparam meta table table containing document meta information -M.Meta = AstElement:make_subtype'Meta' -M.Meta.behavior.clone = M.types.clone.Meta -function M.Meta:new (meta) return meta end - - ------------------------------------------------------------------------- --- MetaValue --- @section MetaValue -M.MetaValue = AstElement:make_subtype('MetaValue') -M.MetaValue.behavior.clone = M.types.clone.MetaValue - ---- Meta blocks --- @function MetaBlocks --- @tparam {Block,...} blocks blocks -M.MetaBlocks = M.MetaValue:create_constructor( - 'MetaBlocks', - function (content) return ensureList(content) end -) - ---- Meta inlines --- @function MetaInlines --- @tparam {Inline,...} inlines inlines -M.MetaInlines = M.MetaValue:create_constructor( - 'MetaInlines', - function (content) return ensureInlineList(content) end -) - ---- Meta list --- @function MetaList --- @tparam {MetaValue,...} meta_values list of meta values -M.MetaList = M.MetaValue:create_constructor( - 'MetaList', - function (content) - if content.tag == 'MetaList' then - return content - end - return ensureList(content) - end -) -for k, v in pairs(List) do - M.MetaList.behavior[k] = v -end - ---- Meta map --- @function MetaMap --- @tparam table key_value_map a string-indexed map of meta values -M.MetaMap = M.MetaValue:create_constructor( - "MetaMap", - function (mm) return mm end -) - ---- Creates string to be used in meta data. --- Does nothing, lua strings are meta strings. --- @function MetaString --- @tparam string str string value -function M.MetaString(str) - return str -end - ---- Creates boolean to be used in meta data. --- Does nothing, lua booleans are meta booleans. --- @function MetaBool --- @tparam boolean bool boolean value -function M.MetaBool(bool) - return bool -end - -return M diff --git a/pandoc.cabal b/pandoc.cabal index 99962ac4c..e7d1349fc 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -177,10 +177,6 @@ data-files: data/creole.lua -- lua init script data/init.lua - -- pandoc lua module - data/pandoc.lua - -- lua List module - data/pandoc.List.lua -- bash completion template data/bash_completion.tpl -- citeproc @@ -481,6 +477,7 @@ library mtl >= 2.2 && < 2.3, network >= 2.6, network-uri >= 2.6 && < 2.8, + pandoc-lua-marshal >= 0.1 && < 0.2, pandoc-types >= 1.22.1 && < 1.23, parsec >= 3.1 && < 3.2, pretty >= 1.1 && < 1.2, @@ -689,21 +686,16 @@ library Text.Pandoc.Lua.Filter, Text.Pandoc.Lua.Global, Text.Pandoc.Lua.Init, - Text.Pandoc.Lua.Marshaling, - Text.Pandoc.Lua.Marshaling.AST, - Text.Pandoc.Lua.Marshaling.Attr, - Text.Pandoc.Lua.Marshaling.CommonState, - Text.Pandoc.Lua.Marshaling.Context, - Text.Pandoc.Lua.Marshaling.List, - Text.Pandoc.Lua.Marshaling.ListAttributes, - Text.Pandoc.Lua.Marshaling.PandocError, - Text.Pandoc.Lua.Marshaling.ReaderOptions, - Text.Pandoc.Lua.Marshaling.SimpleTable, + Text.Pandoc.Lua.Marshal.CommonState, + Text.Pandoc.Lua.Marshal.Context, + Text.Pandoc.Lua.Marshal.PandocError, + Text.Pandoc.Lua.Marshal.ReaderOptions, Text.Pandoc.Lua.Module.MediaBag, Text.Pandoc.Lua.Module.Pandoc, Text.Pandoc.Lua.Module.System, Text.Pandoc.Lua.Module.Types, Text.Pandoc.Lua.Module.Utils, + Text.Pandoc.Lua.Orphans, Text.Pandoc.Lua.Packages, Text.Pandoc.Lua.PandocLua, Text.Pandoc.Lua.Util, diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs index f0e9e076b..2aa84b7fa 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -20,4 +20,4 @@ module Text.Pandoc.Lua import Text.Pandoc.Lua.Filter (runFilterFile) import Text.Pandoc.Lua.Global (Global (..), setGlobals) import Text.Pandoc.Lua.Init (runLua) -import Text.Pandoc.Lua.Marshaling () +import Text.Pandoc.Lua.Orphans () diff --git a/src/Text/Pandoc/Lua/ErrorConversion.hs b/src/Text/Pandoc/Lua/ErrorConversion.hs index 9c4c990a3..5cb1bf825 100644 --- a/src/Text/Pandoc/Lua/ErrorConversion.hs +++ b/src/Text/Pandoc/Lua/ErrorConversion.hs @@ -19,7 +19,7 @@ import HsLua (LuaError, LuaE, top) import HsLua.Marshalling (resultToEither, runPeek) import HsLua.Class.Peekable (PeekError (..)) import Text.Pandoc.Error (PandocError (PandocLuaError)) -import Text.Pandoc.Lua.Marshaling.PandocError (pushPandocError, peekPandocError) +import Text.Pandoc.Lua.Marshal.PandocError (pushPandocError, peekPandocError) import qualified Data.Text as T import qualified HsLua as Lua diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs index 9fd0ef32c..ba5a14a0d 100644 --- a/src/Text/Pandoc/Lua/Filter.hs +++ b/src/Text/Pandoc/Lua/Filter.hs @@ -33,10 +33,9 @@ import Data.String (IsString (fromString)) import HsLua as Lua import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.Marshaling.AST -import Text.Pandoc.Lua.Marshaling.List (List (..), peekList') -import Text.Pandoc.Lua.Walk (SingletonsList (..)) +import Text.Pandoc.Lua.Marshal.AST +import Text.Pandoc.Lua.Orphans () +import Text.Pandoc.Lua.Walk (List (..), SingletonsList (..)) import Text.Pandoc.Walk (Walkable (walkM)) import qualified Data.Map.Strict as Map @@ -196,7 +195,8 @@ walkInlineLists :: Walkable (List Inline) a => LuaFilter -> a -> LuaE PandocError a walkInlineLists lf = let f :: List Inline -> LuaE PandocError (List Inline) - f = runOnValue listOfInlinesFilterName (peekList' peekInline) lf + f = runOnValue listOfInlinesFilterName peekListOfInlines lf + peekListOfInlines idx = List <$!> (peekInlinesFuzzy idx) in if lf `contains` listOfInlinesFilterName then walkM f else return @@ -214,7 +214,8 @@ walkBlockLists :: Walkable (List Block) a => LuaFilter -> a -> LuaE PandocError a walkBlockLists lf = let f :: List Block -> LuaE PandocError (List Block) - f = runOnValue listOfBlocksFilterName (peekList' peekBlock) lf + f = runOnValue listOfBlocksFilterName peekListOfBlocks lf + peekListOfBlocks idx = List <$!> (peekBlocksFuzzy idx) in if lf `contains` listOfBlocksFilterName then walkM f else return diff --git a/src/Text/Pandoc/Lua/Global.hs b/src/Text/Pandoc/Lua/Global.hs index 05510f45d..c7b50a25f 100644 --- a/src/Text/Pandoc/Lua/Global.hs +++ b/src/Text/Pandoc/Lua/Global.hs @@ -20,9 +20,9 @@ import Paths_pandoc (version) import Text.Pandoc.Class.CommonState (CommonState) import Text.Pandoc.Definition (Pandoc (Pandoc), pandocTypesVersion) import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.Marshaling.CommonState (pushCommonState) -import Text.Pandoc.Lua.Marshaling.ReaderOptions (pushReaderOptionsReadonly) +import Text.Pandoc.Lua.Marshal.CommonState (pushCommonState) +import Text.Pandoc.Lua.Marshal.ReaderOptions (pushReaderOptionsReadonly) +import Text.Pandoc.Lua.Orphans () import Text.Pandoc.Options (ReaderOptions) import qualified Data.Text as Text diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs index 2f113bff2..835da1fc9 100644 --- a/src/Text/Pandoc/Lua/Init.hs +++ b/src/Text/Pandoc/Lua/Init.hs @@ -17,7 +17,6 @@ module Text.Pandoc.Lua.Init import Control.Monad (forM, forM_, when) import Control.Monad.Catch (throwM, try) import Control.Monad.Trans (MonadIO (..)) -import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr) import Data.Maybe (catMaybes) import HsLua as Lua hiding (status, try) import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8) @@ -27,7 +26,6 @@ import Text.Pandoc.Lua.Packages (installPandocPackageSearcher) import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, runPandocLua) import qualified Data.Text as T import qualified Lua.LPeg as LPeg -import qualified Text.Pandoc.Definition as Pandoc import qualified Text.Pandoc.Lua.Module.Pandoc as ModulePandoc -- | Run the lua interpreter, using pandoc's default way of environment @@ -42,6 +40,19 @@ runLua luaOp = do liftIO $ setForeignEncoding enc return res +-- | Modules that are loaded at startup and assigned to fields in the +-- pandoc module. +loadedModules :: [(Name, Name)] +loadedModules = + [ ("pandoc.List", "List") + , ("pandoc.mediabag", "mediabag") + , ("pandoc.path", "path") + , ("pandoc.system", "system") + , ("pandoc.types", "types") + , ("pandoc.utils", "utils") + , ("text", "text") + ] + -- | Initialize the lua state with all required values initLuaState :: PandocLua () initLuaState = do @@ -61,9 +72,13 @@ initLuaState = do Lua.getfield Lua.registryindex Lua.loaded Lua.pushvalue (Lua.nth 2) Lua.setfield (Lua.nth 2) "pandoc" - Lua.pop 1 - -- copy constructors into registry - putConstructorsInRegistry + Lua.pop 1 -- remove LOADED table + -- load modules and add them to the `pandoc` module table. + liftPandocLua $ forM_ loadedModules $ \(pkgname, fieldname) -> do + Lua.getglobal "require" + Lua.pushName pkgname + Lua.call 1 1 + Lua.setfield (nth 2) fieldname -- assign module to global variable liftPandocLua $ Lua.setglobal "pandoc" @@ -122,28 +137,3 @@ initLuaState = do Lua.pushHaskellFunction $ Lua.state >>= liftIO . LPeg.lpeg_searcher Lua.rawseti (Lua.nth 2) . (+1) . fromIntegral =<< Lua.rawlen (Lua.nth 2) Lua.pop 1 -- remove 'package.searchers' from stack - --- | AST elements are marshaled via normal constructor functions in the --- @pandoc@ module. However, accessing Lua globals from Haskell is --- expensive (due to error handling). Accessing the Lua registry is much --- cheaper, which is why the constructor functions are copied into the --- Lua registry and called from there. --- --- This function expects the @pandoc@ module to be at the top of the --- stack. -putConstructorsInRegistry :: PandocLua () -putConstructorsInRegistry = liftPandocLua $ do - constrsToReg $ Pandoc.Meta mempty - constrsToReg $ Pandoc.MetaList mempty - putInReg "List" -- pandoc.List - putInReg "SimpleTable" -- helper for backward-compatible table handling - where - constrsToReg :: Data a => a -> LuaE PandocError () - constrsToReg = mapM_ (putInReg . showConstr) . dataTypeConstrs . dataTypeOf - - putInReg :: String -> LuaE PandocError () - putInReg name = do - Lua.push ("pandoc." ++ name) -- name in registry - Lua.push name -- in pandoc module - Lua.rawget (Lua.nth 3) - Lua.rawset Lua.registryindex diff --git a/src/Text/Pandoc/Lua/Marshaling/CommonState.hs b/src/Text/Pandoc/Lua/Marshal/CommonState.hs index 857551598..a8c0e28d2 100644 --- a/src/Text/Pandoc/Lua/Marshaling/CommonState.hs +++ b/src/Text/Pandoc/Lua/Marshal/CommonState.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {- | - Module : Text.Pandoc.Lua.Marshaling.CommonState + Module : Text.Pandoc.Lua.Marshal.CommonState Copyright : © 2012-2021 John MacFarlane © 2017-2021 Albert Krewinkel License : GNU GPL, version 2 or above @@ -9,7 +9,7 @@ Instances to marshal (push) and unmarshal (peek) the common state. -} -module Text.Pandoc.Lua.Marshaling.CommonState +module Text.Pandoc.Lua.Marshal.CommonState ( typeCommonState , peekCommonState , pushCommonState @@ -20,7 +20,7 @@ import HsLua.Marshalling import HsLua.Packaging import Text.Pandoc.Class (CommonState (..)) import Text.Pandoc.Logging (LogMessage, showLogMessage) -import Text.Pandoc.Lua.Marshaling.List (pushPandocList) +import Text.Pandoc.Lua.Marshal.List (pushPandocList) -- | Lua type used for the @CommonState@ object. typeCommonState :: LuaError e => DocumentedType e CommonState diff --git a/src/Text/Pandoc/Lua/Marshaling/Context.hs b/src/Text/Pandoc/Lua/Marshal/Context.hs index 8ee25565e..17af936e1 100644 --- a/src/Text/Pandoc/Lua/Marshaling/Context.hs +++ b/src/Text/Pandoc/Lua/Marshal/Context.hs @@ -10,7 +10,7 @@ Marshaling instance for doctemplates Context and its components. -} -module Text.Pandoc.Lua.Marshaling.Context () where +module Text.Pandoc.Lua.Marshal.Context () where import qualified HsLua as Lua import HsLua (Pushable) diff --git a/src/Text/Pandoc/Lua/Marshaling/PandocError.hs b/src/Text/Pandoc/Lua/Marshal/PandocError.hs index 6f29a5c89..d1c0ad4f4 100644 --- a/src/Text/Pandoc/Lua/Marshaling/PandocError.hs +++ b/src/Text/Pandoc/Lua/Marshal/PandocError.hs @@ -3,16 +3,16 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {- | - Module : Text.Pandoc.Lua.Marshaling.PandocError + Module : Text.Pandoc.Lua.Marshal.PandocError Copyright : © 2020-2021 Albert Krewinkel License : GNU GPL, version 2 or above Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> Stability : alpha -Marshaling of @'PandocError'@ values. +Marshal of @'PandocError'@ values. -} -module Text.Pandoc.Lua.Marshaling.PandocError +module Text.Pandoc.Lua.Marshal.PandocError ( peekPandocError , pushPandocError , typePandocError diff --git a/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs b/src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs index 91eb22ae9..c20770dba 100644 --- a/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs +++ b/src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs @@ -13,7 +13,7 @@ Marshaling instance for ReaderOptions and its components. -} -module Text.Pandoc.Lua.Marshaling.ReaderOptions +module Text.Pandoc.Lua.Marshal.ReaderOptions ( peekReaderOptions , pushReaderOptions , pushReaderOptionsReadonly @@ -21,7 +21,7 @@ module Text.Pandoc.Lua.Marshaling.ReaderOptions import Data.Default (def) import HsLua as Lua -import Text.Pandoc.Lua.Marshaling.List (pushPandocList) +import Text.Pandoc.Lua.Marshal.List (pushPandocList) import Text.Pandoc.Options (ReaderOptions (..)) -- diff --git a/src/Text/Pandoc/Lua/Marshaling.hs b/src/Text/Pandoc/Lua/Marshaling.hs deleted file mode 100644 index e217b8852..000000000 --- a/src/Text/Pandoc/Lua/Marshaling.hs +++ /dev/null @@ -1,19 +0,0 @@ -{- | - Module : Text.Pandoc.Lua.Marshaling - Copyright : © 2012-2021 John MacFarlane - © 2017-2021 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> - Stability : alpha - -Lua marshaling (pushing) and unmarshaling (peeking) instances. --} -module Text.Pandoc.Lua.Marshaling () where - -import Text.Pandoc.Lua.Marshaling.AST () -import Text.Pandoc.Lua.Marshaling.CommonState () -import Text.Pandoc.Lua.Marshaling.Context () -import Text.Pandoc.Lua.Marshaling.PandocError() -import Text.Pandoc.Lua.Marshaling.ReaderOptions () -import Text.Pandoc.Lua.ErrorConversion () diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs deleted file mode 100644 index 6a0e5d077..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ /dev/null @@ -1,868 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.AST - Copyright : © 2012-2021 John MacFarlane - © 2017-2021 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> - Stability : alpha - -Marshaling/unmarshaling instances for document AST elements. --} -module Text.Pandoc.Lua.Marshaling.AST - ( peekAttr - , peekBlock - , peekBlockFuzzy - , peekBlocks - , peekBlocksFuzzy - , peekCaption - , peekCitation - , peekColSpec - , peekDefinitionItem - , peekFormat - , peekInline - , peekInlineFuzzy - , peekInlines - , peekInlinesFuzzy - , peekMeta - , peekMetaValue - , peekPandoc - , peekMathType - , peekQuoteType - , peekTableBody - , peekTableHead - , peekTableFoot - - , pushAttr - , pushBlock - , pushCitation - , pushInline - , pushInlines - , pushListAttributes - , pushMeta - , pushMetaValue - , pushPandoc - ) where - -import Control.Applicative ((<|>), optional) -import Control.Monad.Catch (throwM) -import Control.Monad ((<$!>)) -import Data.Data (showConstr, toConstr) -import Data.Text (Text) -import Data.Version (Version) -import HsLua hiding (Operation (Div)) -import HsLua.Module.Version (peekVersionFuzzy) -import Text.Pandoc.Definition -import Text.Pandoc.Error (PandocError (PandocLuaError)) -import Text.Pandoc.Lua.Util (pushViaConstr') -import Text.Pandoc.Lua.Marshaling.Attr (peekAttr, pushAttr) -import Text.Pandoc.Lua.Marshaling.List (pushPandocList) -import Text.Pandoc.Lua.Marshaling.ListAttributes - (peekListAttributes, pushListAttributes) - -import qualified HsLua as Lua -import qualified Text.Pandoc.Builder as B -import qualified Text.Pandoc.Lua.Util as LuaUtil - -instance Pushable Pandoc where - push = pushPandoc - -pushPandoc :: LuaError e => Pusher e Pandoc -pushPandoc = pushUD typePandoc - -peekPandoc :: LuaError e => Peeker e Pandoc -peekPandoc = retrieving "Pandoc value" . peekUD typePandoc - -typePandoc :: LuaError e => DocumentedType e Pandoc -typePandoc = deftype "Pandoc" - [ operation Eq $ defun "__eq" - ### liftPure2 (==) - <#> parameter (optional . peekPandoc) "doc1" "pandoc" "" - <#> parameter (optional . peekPandoc) "doc2" "pandoc" "" - =#> functionResult pushBool "boolean" "true iff the two values are equal" - , operation Tostring $ lambda - ### liftPure show - <#> parameter peekPandoc "Pandoc" "doc" "" - =#> functionResult pushString "string" "native Haskell representation" - ] - [ property "blocks" "list of blocks" - (pushPandocList pushBlock, \(Pandoc _ blks) -> blks) - (peekList peekBlock, \(Pandoc m _) blks -> Pandoc m blks) - , property "meta" "document metadata" - (pushMeta, \(Pandoc meta _) -> meta) - (peekMeta, \(Pandoc _ blks) meta -> Pandoc meta blks) - ] - -instance Pushable Meta where - push = pushMeta - -pushMeta :: LuaError e => Pusher e Meta -pushMeta (Meta mmap) = pushViaConstr' "Meta" [push mmap] - -peekMeta :: LuaError e => Peeker e Meta -peekMeta idx = retrieving "Meta" $ - Meta <$!> peekMap peekText peekMetaValue idx - -instance Pushable MetaValue where - push = pushMetaValue - -instance Pushable Block where - push = pushBlock - -typeCitation :: LuaError e => DocumentedType e Citation -typeCitation = deftype "Citation" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> parameter (optional . peekCitation) "Citation" "a" "" - <#> parameter (optional . peekCitation) "Citation" "b" "" - =#> functionResult pushBool "boolean" "true iff the citations are equal" - - , operation Tostring $ lambda - ### liftPure show - <#> parameter peekCitation "Citation" "citation" "" - =#> functionResult pushString "string" "native Haskell representation" - ] - [ property "id" "citation ID / key" - (pushText, citationId) - (peekText, \citation cid -> citation{ citationId = cid }) - , property "mode" "citation mode" - (pushString . show, citationMode) - (peekRead, \citation mode -> citation{ citationMode = mode }) - , property "prefix" "citation prefix" - (pushInlines, citationPrefix) - (peekInlines, \citation prefix -> citation{ citationPrefix = prefix }) - , property "suffix" "citation suffix" - (pushInlines, citationSuffix) - (peekInlines, \citation suffix -> citation{ citationPrefix = suffix }) - , property "note_num" "note number" - (pushIntegral, citationNoteNum) - (peekIntegral, \citation noteNum -> citation{ citationNoteNum = noteNum }) - , property "hash" "hash number" - (pushIntegral, citationHash) - (peekIntegral, \citation hash -> citation{ citationHash = hash }) - , method $ defun "clone" ### return <#> udparam typeCitation "obj" "" - =#> functionResult pushCitation "Citation" "copy of obj" - ] - -pushCitation :: LuaError e => Pusher e Citation -pushCitation = pushUD typeCitation - -peekCitation :: LuaError e => Peeker e Citation -peekCitation = peekUD typeCitation - -instance Pushable Alignment where - push = Lua.pushString . show - -instance Pushable CitationMode where - push = Lua.push . show - -instance Pushable Format where - push = pushFormat - -pushFormat :: LuaError e => Pusher e Format -pushFormat (Format f) = pushText f - -peekFormat :: LuaError e => Peeker e Format -peekFormat idx = Format <$!> peekText idx - -instance Pushable ListNumberDelim where - push = Lua.push . show - -instance Pushable ListNumberStyle where - push = Lua.push . show - -instance Pushable MathType where - push = Lua.push . show - -instance Pushable QuoteType where - push = pushQuoteType - -pushMathType :: LuaError e => Pusher e MathType -pushMathType = pushString . show - -peekMathType :: LuaError e => Peeker e MathType -peekMathType = peekRead - -pushQuoteType :: LuaError e => Pusher e QuoteType -pushQuoteType = pushString . show - -peekQuoteType :: LuaError e => Peeker e QuoteType -peekQuoteType = peekRead - --- | Push an meta value element to the top of the lua stack. -pushMetaValue :: LuaError e => MetaValue -> LuaE e () -pushMetaValue = \case - MetaBlocks blcks -> pushViaConstr' "MetaBlocks" [pushList pushBlock blcks] - MetaBool bool -> Lua.push bool - MetaInlines inlns -> pushViaConstr' "MetaInlines" - [pushList pushInline inlns] - MetaList metalist -> pushViaConstr' "MetaList" - [pushList pushMetaValue metalist] - MetaMap metamap -> pushViaConstr' "MetaMap" - [pushMap pushText pushMetaValue metamap] - MetaString str -> Lua.push str - --- | Interpret the value at the given stack index as meta value. -peekMetaValue :: forall e. LuaError e => Peeker e MetaValue -peekMetaValue = retrieving "MetaValue $ " . \idx -> do - -- Get the contents of an AST element. - let mkMV :: (a -> MetaValue) -> Peeker e a -> Peek e MetaValue - mkMV f p = f <$!> p idx - - peekTagged = \case - "MetaBlocks" -> mkMV MetaBlocks $ - retrieving "MetaBlocks" . peekBlocks - "MetaBool" -> mkMV MetaBool $ - retrieving "MetaBool" . peekBool - "MetaMap" -> mkMV MetaMap $ - retrieving "MetaMap" . peekMap peekText peekMetaValue - "MetaInlines" -> mkMV MetaInlines $ - retrieving "MetaInlines" . peekInlines - "MetaList" -> mkMV MetaList $ - retrieving "MetaList" . peekList peekMetaValue - "MetaString" -> mkMV MetaString $ - retrieving "MetaString" . peekText - (Name t) -> failPeek ("Unknown meta tag: " <> t) - - peekUntagged = do - -- no meta value tag given, try to guess. - len <- liftLua $ Lua.rawlen idx - if len <= 0 - then MetaMap <$!> peekMap peekText peekMetaValue idx - else (MetaInlines <$!> peekInlines idx) - <|> (MetaBlocks <$!> peekBlocks idx) - <|> (MetaList <$!> peekList peekMetaValue idx) - luatype <- liftLua $ Lua.ltype idx - case luatype of - Lua.TypeBoolean -> MetaBool <$!> peekBool idx - Lua.TypeString -> MetaString <$!> peekText idx - Lua.TypeTable -> do - optional (LuaUtil.getTag idx) >>= \case - Just tag -> peekTagged tag - Nothing -> peekUntagged - Lua.TypeUserdata -> -- Allow singleton Inline or Block elements - (MetaInlines . (:[]) <$!> peekInline idx) <|> - (MetaBlocks . (:[]) <$!> peekBlock idx) - _ -> failPeek "could not get meta value" - -typeBlock :: LuaError e => DocumentedType e Block -typeBlock = deftype "Block" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> parameter peekBlockFuzzy "Block" "a" "" - <#> parameter peekBlockFuzzy "Block" "b" "" - =#> boolResult "whether the two values are equal" - , operation Tostring $ lambda - ### liftPure show - <#> udparam typeBlock "self" "" - =#> functionResult pushString "string" "Haskell representation" - ] - [ possibleProperty "attr" "element attributes" - (pushAttr, \case - CodeBlock attr _ -> Actual attr - Div attr _ -> Actual attr - Header _ attr _ -> Actual attr - Table attr _ _ _ _ _ -> Actual attr - _ -> Absent) - (peekAttr, \case - CodeBlock _ code -> Actual . flip CodeBlock code - Div _ blks -> Actual . flip Div blks - Header lvl _ blks -> Actual . (\attr -> Header lvl attr blks) - Table _ c cs h bs f -> Actual . (\attr -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "bodies" "table bodies" - (pushPandocList pushTableBody, \case - Table _ _ _ _ bs _ -> Actual bs - _ -> Absent) - (peekList peekTableBody, \case - Table attr c cs h _ f -> Actual . (\bs -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "caption" "element caption" - (pushCaption, \case {Table _ capt _ _ _ _ -> Actual capt; _ -> Absent}) - (peekCaption, \case - Table attr _ cs h bs f -> Actual . (\c -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "colspecs" "column alignments and widths" - (pushPandocList pushColSpec, \case - Table _ _ cs _ _ _ -> Actual cs - _ -> Absent) - (peekList peekColSpec, \case - Table attr c _ h bs f -> Actual . (\cs -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "content" "element content" - (pushContent, getBlockContent) - (peekContent, setBlockContent) - , possibleProperty "foot" "table foot" - (pushTableFoot, \case {Table _ _ _ _ _ f -> Actual f; _ -> Absent}) - (peekTableFoot, \case - Table attr c cs h bs _ -> Actual . (\f -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "format" "format of raw content" - (pushFormat, \case {RawBlock f _ -> Actual f; _ -> Absent}) - (peekFormat, \case - RawBlock _ txt -> Actual . (`RawBlock` txt) - _ -> const Absent) - , possibleProperty "head" "table head" - (pushTableHead, \case {Table _ _ _ h _ _ -> Actual h; _ -> Absent}) - (peekTableHead, \case - Table attr c cs _ bs f -> Actual . (\h -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "level" "heading level" - (pushIntegral, \case {Header lvl _ _ -> Actual lvl; _ -> Absent}) - (peekIntegral, \case - Header _ attr inlns -> Actual . \lvl -> Header lvl attr inlns - _ -> const Absent) - , possibleProperty "listAttributes" "ordered list attributes" - (pushListAttributes, \case - OrderedList listAttr _ -> Actual listAttr - _ -> Absent) - (peekListAttributes, \case - OrderedList _ content -> Actual . (`OrderedList` content) - _ -> const Absent) - , possibleProperty "text" "text contents" - (pushText, getBlockText) - (peekText, setBlockText) - - , readonly "tag" "type of Block" - (pushString, showConstr . toConstr ) - - , alias "t" "tag" ["tag"] - , alias "c" "content" ["content"] - , alias "identifier" "element identifier" ["attr", "identifier"] - , alias "classes" "element classes" ["attr", "classes"] - , alias "attributes" "other element attributes" ["attr", "attributes"] - , alias "start" "ordered list start number" ["listAttributes", "start"] - , alias "style" "ordered list style" ["listAttributes", "style"] - , alias "delimiter" "numbering delimiter" ["listAttributes", "delimiter"] - - , method $ defun "clone" - ### return - <#> parameter peekBlock "Block" "block" "self" - =#> functionResult pushBlock "Block" "cloned Block" - - , method $ defun "show" - ### liftPure show - <#> parameter peekBlock "Block" "self" "" - =#> functionResult pushString "string" "Haskell string representation" - ] - where - boolResult = functionResult pushBool "boolean" - -getBlockContent :: Block -> Possible Content -getBlockContent = \case - -- inline content - Para inlns -> Actual $ ContentInlines inlns - Plain inlns -> Actual $ ContentInlines inlns - Header _ _ inlns -> Actual $ ContentInlines inlns - -- inline content - BlockQuote blks -> Actual $ ContentBlocks blks - Div _ blks -> Actual $ ContentBlocks blks - -- lines content - LineBlock lns -> Actual $ ContentLines lns - -- list items content - BulletList itms -> Actual $ ContentListItems itms - OrderedList _ itms -> Actual $ ContentListItems itms - -- definition items content - DefinitionList itms -> Actual $ ContentDefItems itms - _ -> Absent - -setBlockContent :: Block -> Content -> Possible Block -setBlockContent = \case - -- inline content - Para _ -> Actual . Para . inlineContent - Plain _ -> Actual . Plain . inlineContent - Header attr lvl _ -> Actual . Header attr lvl . inlineContent - -- block content - BlockQuote _ -> Actual . BlockQuote . blockContent - Div attr _ -> Actual . Div attr . blockContent - -- lines content - LineBlock _ -> Actual . LineBlock . lineContent - -- list items content - BulletList _ -> Actual . BulletList . listItemContent - OrderedList la _ -> Actual . OrderedList la . listItemContent - -- definition items content - DefinitionList _ -> Actual . DefinitionList . defItemContent - _ -> const Absent - where - inlineContent = \case - ContentInlines inlns -> inlns - c -> throwM . PandocLuaError $ "expected Inlines, got " <> - contentTypeDescription c - blockContent = \case - ContentBlocks blks -> blks - ContentInlines inlns -> [Plain inlns] - c -> throwM . PandocLuaError $ "expected Blocks, got " <> - contentTypeDescription c - lineContent = \case - ContentLines lns -> lns - c -> throwM . PandocLuaError $ "expected list of lines, got " <> - contentTypeDescription c - defItemContent = \case - ContentDefItems itms -> itms - c -> throwM . PandocLuaError $ "expected definition items, got " <> - contentTypeDescription c - listItemContent = \case - ContentBlocks blks -> [blks] - ContentLines lns -> map ((:[]) . Plain) lns - ContentListItems itms -> itms - c -> throwM . PandocLuaError $ "expected list of items, got " <> - contentTypeDescription c - -getBlockText :: Block -> Possible Text -getBlockText = \case - CodeBlock _ lst -> Actual lst - RawBlock _ raw -> Actual raw - _ -> Absent - -setBlockText :: Block -> Text -> Possible Block -setBlockText = \case - CodeBlock attr _ -> Actual . CodeBlock attr - RawBlock f _ -> Actual . RawBlock f - _ -> const Absent - --- | Push a block element to the top of the Lua stack. -pushBlock :: forall e. LuaError e => Block -> LuaE e () -pushBlock = pushUD typeBlock - --- | Return the value at the given index as block if possible. -peekBlock :: forall e. LuaError e => Peeker e Block -peekBlock = retrieving "Block" . peekUD typeBlock - --- | Retrieves a list of Block elements. -peekBlocks :: LuaError e => Peeker e [Block] -peekBlocks = peekList peekBlock - -peekInlines :: LuaError e => Peeker e [Inline] -peekInlines = peekList peekInline - -pushInlines :: LuaError e => Pusher e [Inline] -pushInlines = pushPandocList pushInline - --- | Retrieves a single definition item from a the stack; it is expected --- to be a pair of a list of inlines and a list of list of blocks. Uses --- fuzzy parsing, i.e., tries hard to convert mismatching types into the --- expected result. -peekDefinitionItem :: LuaError e => Peeker e ([Inline], [[Block]]) -peekDefinitionItem = peekPair peekInlinesFuzzy $ choice - [ peekList peekBlocksFuzzy - , \idx -> (:[]) <$!> peekBlocksFuzzy idx - ] - --- | Push Caption element -pushCaption :: LuaError e => Caption -> LuaE e () -pushCaption (Caption shortCaption longCaption) = do - Lua.newtable - LuaUtil.addField "short" (Lua.Optional shortCaption) - LuaUtil.addField "long" longCaption - --- | Peek Caption element -peekCaption :: LuaError e => Peeker e Caption -peekCaption = retrieving "Caption" . \idx -> do - short <- optional $ peekFieldRaw peekInlines "short" idx - long <- peekFieldRaw peekBlocks "long" idx - return $! Caption short long - --- | Push a ColSpec value as a pair of Alignment and ColWidth. -pushColSpec :: LuaError e => Pusher e ColSpec -pushColSpec = pushPair (pushString . show) pushColWidth - --- | Peek a ColSpec value as a pair of Alignment and ColWidth. -peekColSpec :: LuaError e => Peeker e ColSpec -peekColSpec = peekPair peekRead peekColWidth - -peekColWidth :: LuaError e => Peeker e ColWidth -peekColWidth = retrieving "ColWidth" . \idx -> do - maybe ColWidthDefault ColWidth <$!> optional (peekRealFloat idx) - --- | Push a ColWidth value by pushing the width as a plain number, or --- @nil@ for ColWidthDefault. -pushColWidth :: LuaError e => Pusher e ColWidth -pushColWidth = \case - (ColWidth w) -> Lua.push w - ColWidthDefault -> Lua.pushnil - --- | Push a table row as a pair of attr and the list of cells. -pushRow :: LuaError e => Pusher e Row -pushRow (Row attr cells) = - pushPair pushAttr (pushPandocList pushCell) (attr, cells) - --- | Push a table row from a pair of attr and the list of cells. -peekRow :: LuaError e => Peeker e Row -peekRow = ((uncurry Row) <$!>) - . retrieving "Row" - . peekPair peekAttr (peekList peekCell) - --- | Pushes a 'TableBody' value as a Lua table with fields @attr@, --- @row_head_columns@, @head@, and @body@. -pushTableBody :: LuaError e => Pusher e TableBody -pushTableBody (TableBody attr (RowHeadColumns rowHeadColumns) head' body) = do - Lua.newtable - LuaUtil.addField "attr" attr - LuaUtil.addField "row_head_columns" rowHeadColumns - LuaUtil.addField "head" head' - LuaUtil.addField "body" body - --- | Retrieves a 'TableBody' value from a Lua table with fields @attr@, --- @row_head_columns@, @head@, and @body@. -peekTableBody :: LuaError e => Peeker e TableBody -peekTableBody = fmap (retrieving "TableBody") - . typeChecked "table" Lua.istable - $ \idx -> TableBody - <$!> peekFieldRaw peekAttr "attr" idx - <*> peekFieldRaw ((fmap RowHeadColumns) . peekIntegral) "row_head_columns" idx - <*> peekFieldRaw (peekList peekRow) "head" idx - <*> peekFieldRaw (peekList peekRow) "body" idx - --- | Push a table head value as the pair of its Attr and rows. -pushTableHead :: LuaError e => Pusher e TableHead -pushTableHead (TableHead attr rows) = - pushPair pushAttr (pushPandocList pushRow) (attr, rows) - --- | Peek a table head value from a pair of Attr and rows. -peekTableHead :: LuaError e => Peeker e TableHead -peekTableHead = ((uncurry TableHead) <$!>) - . retrieving "TableHead" - . peekPair peekAttr (peekList peekRow) - --- | Pushes a 'TableFoot' value as a pair of the Attr value and the list --- of table rows. -pushTableFoot :: LuaError e => Pusher e TableFoot -pushTableFoot (TableFoot attr rows) = - pushPair pushAttr (pushPandocList pushRow) (attr, rows) - --- | Retrieves a 'TableFoot' value from a pair containing an Attr value --- and a list of table rows. -peekTableFoot :: LuaError e => Peeker e TableFoot -peekTableFoot = ((uncurry TableFoot) <$!>) - . retrieving "TableFoot" - . peekPair peekAttr (peekList peekRow) - -instance Pushable Cell where - push = pushCell - -instance Peekable Cell where - peek = forcePeek . peekCell - --- | Push a table cell as a table with fields @attr@, @alignment@, --- @row_span@, @col_span@, and @contents@. -pushCell :: LuaError e => Cell -> LuaE e () -pushCell (Cell attr align (RowSpan rowSpan) (ColSpan colSpan) contents) = do - Lua.newtable - LuaUtil.addField "attr" attr - LuaUtil.addField "alignment" align - LuaUtil.addField "row_span" rowSpan - LuaUtil.addField "col_span" colSpan - LuaUtil.addField "contents" contents - -peekCell :: LuaError e => Peeker e Cell -peekCell = fmap (retrieving "Cell") - . typeChecked "table" Lua.istable - $ \idx -> do - attr <- peekFieldRaw peekAttr "attr" idx - algn <- peekFieldRaw peekRead "alignment" idx - rs <- RowSpan <$!> peekFieldRaw peekIntegral "row_span" idx - cs <- ColSpan <$!> peekFieldRaw peekIntegral "col_span" idx - blks <- peekFieldRaw peekBlocks "contents" idx - return $! Cell attr algn rs cs blks - -getInlineText :: Inline -> Possible Text -getInlineText = \case - Code _ lst -> Actual lst - Math _ str -> Actual str - RawInline _ raw -> Actual raw - Str s -> Actual s - _ -> Absent - -setInlineText :: Inline -> Text -> Possible Inline -setInlineText = \case - Code attr _ -> Actual . Code attr - Math mt _ -> Actual . Math mt - RawInline f _ -> Actual . RawInline f - Str _ -> Actual . Str - _ -> const Absent - --- | Helper type to represent all the different types a `content` --- attribute can have. -data Content - = ContentBlocks [Block] - | ContentInlines [Inline] - | ContentLines [[Inline]] - | ContentDefItems [([Inline], [[Block]])] - | ContentListItems [[Block]] - -contentTypeDescription :: Content -> Text -contentTypeDescription = \case - ContentBlocks {} -> "list of Block items" - ContentInlines {} -> "list of Inline items" - ContentLines {} -> "list of Inline lists (i.e., a list of lines)" - ContentDefItems {} -> "list of definition items items" - ContentListItems {} -> "list items (i.e., list of list of Block elements)" - -pushContent :: LuaError e => Pusher e Content -pushContent = \case - ContentBlocks blks -> pushPandocList pushBlock blks - ContentInlines inlns -> pushPandocList pushInline inlns - ContentLines lns -> pushPandocList (pushPandocList pushInline) lns - ContentDefItems itms -> - let pushItem = pushPair (pushPandocList pushInline) - (pushPandocList (pushPandocList pushBlock)) - in pushPandocList pushItem itms - ContentListItems itms -> - pushPandocList (pushPandocList pushBlock) itms - -peekContent :: LuaError e => Peeker e Content -peekContent idx = - (ContentInlines <$!> peekInlinesFuzzy idx) <|> - (ContentLines <$!> peekList (peekList peekInlineFuzzy) idx) <|> - (ContentBlocks <$!> peekBlocksFuzzy idx ) <|> - (ContentListItems <$!> peekList peekBlocksFuzzy idx) <|> - (ContentDefItems <$!> peekList (peekDefinitionItem) idx) - -setInlineContent :: Inline -> Content -> Possible Inline -setInlineContent = \case - -- inline content - Cite cs _ -> Actual . Cite cs . inlineContent - Emph _ -> Actual . Emph . inlineContent - Link a _ tgt -> Actual . (\inlns -> Link a inlns tgt) . inlineContent - Quoted qt _ -> Actual . Quoted qt . inlineContent - SmallCaps _ -> Actual . SmallCaps . inlineContent - Span attr _ -> Actual . Span attr . inlineContent - Strikeout _ -> Actual . Strikeout . inlineContent - Strong _ -> Actual . Strong . inlineContent - Subscript _ -> Actual . Subscript . inlineContent - Superscript _ -> Actual . Superscript . inlineContent - Underline _ -> Actual . Underline . inlineContent - -- block content - Note _ -> Actual . Note . blockContent - _ -> const Absent - where - inlineContent = \case - ContentInlines inlns -> inlns - c -> throwM . PandocLuaError $ "expected Inlines, got " <> - contentTypeDescription c - blockContent = \case - ContentBlocks blks -> blks - ContentInlines [] -> [] - c -> throwM . PandocLuaError $ "expected Blocks, got " <> - contentTypeDescription c - -getInlineContent :: Inline -> Possible Content -getInlineContent = \case - Cite _ inlns -> Actual $ ContentInlines inlns - Emph inlns -> Actual $ ContentInlines inlns - Link _ inlns _ -> Actual $ ContentInlines inlns - Quoted _ inlns -> Actual $ ContentInlines inlns - SmallCaps inlns -> Actual $ ContentInlines inlns - Span _ inlns -> Actual $ ContentInlines inlns - Strikeout inlns -> Actual $ ContentInlines inlns - Strong inlns -> Actual $ ContentInlines inlns - Subscript inlns -> Actual $ ContentInlines inlns - Superscript inlns -> Actual $ ContentInlines inlns - Underline inlns -> Actual $ ContentInlines inlns - Note blks -> Actual $ ContentBlocks blks - _ -> Absent - --- title -getInlineTitle :: Inline -> Possible Text -getInlineTitle = \case - Image _ _ (_, tit) -> Actual tit - Link _ _ (_, tit) -> Actual tit - _ -> Absent - -setInlineTitle :: Inline -> Text -> Possible Inline -setInlineTitle = \case - Image attr capt (src, _) -> Actual . Image attr capt . (src,) - Link attr capt (src, _) -> Actual . Link attr capt . (src,) - _ -> const Absent - --- attr -getInlineAttr :: Inline -> Possible Attr -getInlineAttr = \case - Code attr _ -> Actual attr - Image attr _ _ -> Actual attr - Link attr _ _ -> Actual attr - Span attr _ -> Actual attr - _ -> Absent - -setInlineAttr :: Inline -> Attr -> Possible Inline -setInlineAttr = \case - Code _ cs -> Actual . (`Code` cs) - Image _ cpt tgt -> Actual . \attr -> Image attr cpt tgt - Link _ cpt tgt -> Actual . \attr -> Link attr cpt tgt - Span _ inlns -> Actual . (`Span` inlns) - _ -> const Absent - -showInline :: LuaError e => DocumentedFunction e -showInline = defun "show" - ### liftPure (show @Inline) - <#> parameter peekInline "inline" "Inline" "Object" - =#> functionResult pushString "string" "stringified Inline" - -typeInline :: LuaError e => DocumentedType e Inline -typeInline = deftype "Inline" - [ operation Tostring showInline - , operation Eq $ defun "__eq" - ### liftPure2 (==) - <#> parameter peekInline "a" "Inline" "" - <#> parameter peekInline "b" "Inline" "" - =#> functionResult pushBool "boolean" "whether the two are equal" - ] - [ possibleProperty "attr" "element attributes" - (pushAttr, getInlineAttr) - (peekAttr, setInlineAttr) - , possibleProperty "caption" "image caption" - (pushPandocList pushInline, \case - Image _ capt _ -> Actual capt - _ -> Absent) - (peekInlinesFuzzy, \case - Image attr _ target -> Actual . (\capt -> Image attr capt target) - _ -> const Absent) - , possibleProperty "citations" "list of citations" - (pushPandocList pushCitation, \case {Cite cs _ -> Actual cs; _ -> Absent}) - (peekList peekCitation, \case - Cite _ inlns -> Actual . (`Cite` inlns) - _ -> const Absent) - , possibleProperty "content" "element contents" - (pushContent, getInlineContent) - (peekContent, setInlineContent) - , possibleProperty "format" "format of raw text" - (pushFormat, \case {RawInline fmt _ -> Actual fmt; _ -> Absent}) - (peekFormat, \case - RawInline _ txt -> Actual . (`RawInline` txt) - _ -> const Absent) - , possibleProperty "mathtype" "math rendering method" - (pushMathType, \case {Math mt _ -> Actual mt; _ -> Absent}) - (peekMathType, \case - Math _ txt -> Actual . (`Math` txt) - _ -> const Absent) - , possibleProperty "quotetype" "type of quotes (single or double)" - (pushQuoteType, \case {Quoted qt _ -> Actual qt; _ -> Absent}) - (peekQuoteType, \case - Quoted _ inlns -> Actual . (`Quoted` inlns) - _ -> const Absent) - , possibleProperty "src" "image source" - (pushText, \case - Image _ _ (src, _) -> Actual src - _ -> Absent) - (peekText, \case - Image attr capt (_, title) -> Actual . Image attr capt . (,title) - _ -> const Absent) - , possibleProperty "target" "link target URL" - (pushText, \case - Link _ _ (tgt, _) -> Actual tgt - _ -> Absent) - (peekText, \case - Link attr capt (_, title) -> Actual . Link attr capt . (,title) - _ -> const Absent) - , possibleProperty "title" "title text" - (pushText, getInlineTitle) - (peekText, setInlineTitle) - , possibleProperty "text" "text contents" - (pushText, getInlineText) - (peekText, setInlineText) - , readonly "tag" "type of Inline" - (pushString, showConstr . toConstr ) - - , alias "t" "tag" ["tag"] - , alias "c" "content" ["content"] - , alias "identifier" "element identifier" ["attr", "identifier"] - , alias "classes" "element classes" ["attr", "classes"] - , alias "attributes" "other element attributes" ["attr", "attributes"] - - , method $ defun "clone" - ### return - <#> parameter peekInline "inline" "Inline" "self" - =#> functionResult pushInline "Inline" "cloned Inline" - ] - --- | Push an inline element to the top of the lua stack. -pushInline :: forall e. LuaError e => Inline -> LuaE e () -pushInline = pushUD typeInline - --- | Return the value at the given index as inline if possible. -peekInline :: forall e. LuaError e => Peeker e Inline -peekInline = retrieving "Inline" . \idx -> peekUD typeInline idx - --- | Try extra hard to retrieve an Inline value from the stack. Treats --- bare strings as @Str@ values. -peekInlineFuzzy :: LuaError e => Peeker e Inline -peekInlineFuzzy = retrieving "Inline" . choice - [ peekUD typeInline - , \idx -> Str <$!> peekText idx - ] - --- | Try extra-hard to return the value at the given index as a list of --- inlines. -peekInlinesFuzzy :: LuaError e => Peeker e [Inline] -peekInlinesFuzzy idx = liftLua (ltype idx) >>= \case - TypeString -> B.toList . B.text <$> peekText idx - _ -> choice - [ peekList peekInlineFuzzy - , fmap pure . peekInlineFuzzy - ] idx - --- | Try extra hard to retrieve a Block value from the stack. Treats bar --- Inline elements as if they were wrapped in 'Plain'. -peekBlockFuzzy :: LuaError e => Peeker e Block -peekBlockFuzzy = choice - [ peekBlock - , (\idx -> Plain <$!> peekInlinesFuzzy idx) - ] - --- | Try extra-hard to return the value at the given index as a list of --- blocks. -peekBlocksFuzzy :: LuaError e => Peeker e [Block] -peekBlocksFuzzy = choice - [ peekList peekBlockFuzzy - , (<$!>) pure . peekBlockFuzzy - ] - --- * Orphan Instances - -instance Pushable Inline where - push = pushInline - -instance Pushable Citation where - push = pushCitation - -instance Pushable Row where - push = pushRow - -instance Pushable TableBody where - push = pushTableBody - -instance Pushable TableFoot where - push = pushTableFoot - -instance Pushable TableHead where - push = pushTableHead - --- These instances exist only for testing. It's a hack to avoid making --- the marshalling modules public. -instance Peekable Inline where - peek = forcePeek . peekInline - -instance Peekable Block where - peek = forcePeek . peekBlock - -instance Peekable Meta where - peek = forcePeek . peekMeta - -instance Peekable Pandoc where - peek = forcePeek . peekPandoc - -instance Peekable Row where - peek = forcePeek . peekRow - -instance Peekable Version where - peek = forcePeek . peekVersionFuzzy - -instance {-# OVERLAPPING #-} Peekable Attr where - peek = forcePeek . peekAttr diff --git a/src/Text/Pandoc/Lua/Marshaling/Attr.hs b/src/Text/Pandoc/Lua/Marshaling/Attr.hs deleted file mode 100644 index 97e702e35..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/Attr.hs +++ /dev/null @@ -1,237 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} -{- | -Module : Text.Pandoc.Lua.Marshaling.Attr -Copyright : © 2012-2021 John MacFarlane - © 2017-2021 Albert Krewinkel -License : GNU GPL, version 2 or above - -Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> -Stability : alpha - -Marshaling/unmarshaling instances for document AST elements. --} -module Text.Pandoc.Lua.Marshaling.Attr - ( typeAttr - , peekAttr - , pushAttr - , mkAttr - , mkAttributeList - ) where - -import Control.Applicative ((<|>), optional) -import Control.Monad ((<$!>)) -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import HsLua -import HsLua.Marshalling.Peekers (peekIndexRaw) -import Safe (atMay) -import Text.Pandoc.Definition (Attr, nullAttr) -import Text.Pandoc.Lua.Marshaling.List (pushPandocList) - -import qualified Data.Text as T - -typeAttr :: LuaError e => DocumentedType e Attr -typeAttr = deftype "Attr" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> parameter peekAttr "a1" "Attr" "" - <#> parameter peekAttr "a2" "Attr" "" - =#> functionResult pushBool "boolean" "whether the two are equal" - , operation Tostring $ lambda - ### liftPure show - <#> parameter peekAttr "Attr" "attr" "" - =#> functionResult pushString "string" "native Haskell representation" - ] - [ property "identifier" "element identifier" - (pushText, \(ident,_,_) -> ident) - (peekText, \(_,cls,kv) -> (,cls,kv)) - , property "classes" "element classes" - (pushPandocList pushText, \(_,classes,_) -> classes) - (peekList peekText, \(ident,_,kv) -> (ident,,kv)) - , property "attributes" "various element attributes" - (pushAttribs, \(_,_,attribs) -> attribs) - (peekAttribs, \(ident,cls,_) -> (ident,cls,)) - , method $ defun "clone" - ### return - <#> parameter peekAttr "attr" "Attr" "" - =#> functionResult pushAttr "Attr" "new Attr element" - , readonly "tag" "element type tag (always 'Attr')" - (pushText, const "Attr") - - , alias "t" "alias for `tag`" ["tag"] - ] - -pushAttr :: LuaError e => Pusher e Attr -pushAttr = pushUD typeAttr - -peekAttribs :: LuaError e => Peeker e [(Text,Text)] -peekAttribs idx = liftLua (ltype idx) >>= \case - TypeUserdata -> peekUD typeAttributeList idx - TypeTable -> liftLua (rawlen idx) >>= \case - 0 -> peekKeyValuePairs peekText peekText idx - _ -> peekList (peekPair peekText peekText) idx - _ -> failPeek "unsupported type" - -pushAttribs :: LuaError e => Pusher e [(Text, Text)] -pushAttribs = pushUD typeAttributeList - -typeAttributeList :: LuaError e => DocumentedType e [(Text, Text)] -typeAttributeList = deftype "AttributeList" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> parameter peekAttribs "a1" "AttributeList" "" - <#> parameter peekAttribs "a2" "AttributeList" "" - =#> functionResult pushBool "boolean" "whether the two are equal" - - , operation Index $ lambda - ### liftPure2 lookupKey - <#> udparam typeAttributeList "t" "attributes list" - <#> parameter peekKey "string|integer" "key" "lookup key" - =#> functionResult (maybe pushnil pushAttribute) "string|table" - "attribute value" - - , operation Newindex $ lambda - ### setKey - <#> udparam typeAttributeList "t" "attributes list" - <#> parameter peekKey "string|integer" "key" "lookup key" - <#> optionalParameter peekAttribute "string|nil" "value" "new value" - =#> [] - - , operation Len $ lambda - ### liftPure length - <#> udparam typeAttributeList "t" "attributes list" - =#> functionResult pushIntegral "integer" "number of attributes in list" - - , operation Pairs $ lambda - ### pushIterator (\(k, v) -> 2 <$ pushText k <* pushText v) - <#> udparam typeAttributeList "t" "attributes list" - =?> "iterator triple" - - , operation Tostring $ lambda - ### liftPure show - <#> udparam typeAttributeList "t" "attributes list" - =#> functionResult pushString "string" "" - ] - [] - -data Key = StringKey Text | IntKey Int - -peekKey :: LuaError e => Peeker e (Maybe Key) -peekKey idx = liftLua (ltype idx) >>= \case - TypeNumber -> Just . IntKey <$!> peekIntegral idx - TypeString -> Just . StringKey <$!> peekText idx - _ -> return Nothing - -data Attribute - = AttributePair (Text, Text) - | AttributeValue Text - -pushAttribute :: LuaError e => Pusher e Attribute -pushAttribute = \case - (AttributePair kv) -> pushPair pushText pushText kv - (AttributeValue v) -> pushText v - --- | Retrieve an 'Attribute'. -peekAttribute :: LuaError e => Peeker e Attribute -peekAttribute idx = (AttributeValue <$!> peekText idx) - <|> (AttributePair <$!> peekPair peekText peekText idx) - -lookupKey :: [(Text,Text)] -> Maybe Key -> Maybe Attribute -lookupKey !kvs = \case - Just (StringKey str) -> AttributeValue <$!> lookup str kvs - Just (IntKey n) -> AttributePair <$!> atMay kvs (n - 1) - Nothing -> Nothing - -setKey :: forall e. LuaError e - => [(Text, Text)] -> Maybe Key -> Maybe Attribute - -> LuaE e () -setKey kvs mbKey mbValue = case mbKey of - Just (StringKey str) -> - case break ((== str) . fst) kvs of - (prefix, _:suffix) -> case mbValue of - Nothing -> setNew $ prefix ++ suffix - Just (AttributeValue value) -> setNew $ prefix ++ (str, value):suffix - _ -> failLua "invalid attribute value" - _ -> case mbValue of - Nothing -> return () - Just (AttributeValue value) -> setNew (kvs ++ [(str, value)]) - _ -> failLua "invalid attribute value" - Just (IntKey idx) -> - case splitAt (idx - 1) kvs of - (prefix, (k,_):suffix) -> setNew $ case mbValue of - Nothing -> prefix ++ suffix - Just (AttributePair kv) -> prefix ++ kv : suffix - Just (AttributeValue v) -> prefix ++ (k, v) : suffix - (prefix, []) -> case mbValue of - Nothing -> setNew prefix - Just (AttributePair kv) -> setNew $ prefix ++ [kv] - _ -> failLua $ "trying to set an attribute key-value pair, " - ++ "but got a single string instead." - - _ -> failLua "invalid attribute key" - where - setNew :: [(Text, Text)] -> LuaE e () - setNew new = - putuserdata (nthBottom 1) (udName @e typeAttributeList) new >>= \case - True -> return () - False -> failLua "failed to modify attributes list" - -peekAttr :: LuaError e => Peeker e Attr -peekAttr idx = retrieving "Attr" $ liftLua (ltype idx) >>= \case - TypeString -> (,[],[]) <$!> peekText idx -- treat string as ID - TypeUserdata -> peekUD typeAttr idx - TypeTable -> peekAttrTable idx - x -> liftLua . failLua $ "Cannot get Attr from " ++ show x - --- | Helper function which gets an Attr from a Lua table. -peekAttrTable :: LuaError e => Peeker e Attr -peekAttrTable idx = do - len' <- liftLua $ rawlen idx - let peekClasses = peekList peekText - if len' > 0 - then do - ident <- peekIndexRaw 1 peekText idx - classes <- fromMaybe [] <$!> optional (peekIndexRaw 2 peekClasses idx) - attribs <- fromMaybe [] <$!> optional (peekIndexRaw 3 peekAttribs idx) - return $ ident `seq` classes `seq` attribs `seq` - (ident, classes, attribs) - else retrieving "HTML-like attributes" $ do - kvs <- peekKeyValuePairs peekText peekText idx - let ident = fromMaybe "" $ lookup "id" kvs - let classes = maybe [] T.words $ lookup "class" kvs - let attribs = filter ((`notElem` ["id", "class"]) . fst) kvs - return $ ident `seq` classes `seq` attribs `seq` - (ident, classes, attribs) - --- | Constructor for 'Attr'. -mkAttr :: LuaError e => DocumentedFunction e -mkAttr = defun "Attr" - ### (ltype (nthBottom 1) >>= \case - TypeString -> forcePeek $ do - mident <- optional (peekText (nthBottom 1)) - mclass <- optional (peekList peekText (nthBottom 2)) - mattribs <- optional (peekAttribs (nthBottom 3)) - return ( fromMaybe "" mident - , fromMaybe [] mclass - , fromMaybe [] mattribs) - TypeTable -> forcePeek $ peekAttrTable (nthBottom 1) - TypeUserdata -> forcePeek $ peekUD typeAttr (nthBottom 1) <|> do - attrList <- peekUD typeAttributeList (nthBottom 1) - return ("", [], attrList) - TypeNil -> pure nullAttr - TypeNone -> pure nullAttr - x -> failLua $ "Cannot create Attr from " ++ show x) - =#> functionResult pushAttr "Attr" "new Attr object" - --- | Constructor for 'AttributeList'. -mkAttributeList :: LuaError e => DocumentedFunction e -mkAttributeList = defun "AttributeList" - ### return - <#> parameter peekAttribs "table|AttributeList" "attribs" "an attribute list" - =#> functionResult (pushUD typeAttributeList) "AttributeList" - "new AttributeList object" diff --git a/src/Text/Pandoc/Lua/Marshaling/List.hs b/src/Text/Pandoc/Lua/Marshaling/List.hs deleted file mode 100644 index 0b145d3a1..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/List.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UndecidableInstances #-} -{- | -Module : Text.Pandoc.Lua.Marshaling.List -Copyright : © 2012-2021 John MacFarlane - © 2017-2021 Albert Krewinkel -License : GNU GPL, version 2 or above -Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> -Stability : alpha - -Marshaling/unmarshaling instances for @pandoc.List@s. --} -module Text.Pandoc.Lua.Marshaling.List - ( List (..) - , peekList' - , pushPandocList - ) where - -import Control.Monad ((<$!>)) -import Data.Data (Data) -import HsLua (LuaError, Peeker, Pusher, Pushable (push), peekList, pushList) -import Text.Pandoc.Walk (Walkable (..)) -import Text.Pandoc.Lua.Util (pushViaConstr') - --- | List wrapper which is marshalled as @pandoc.List@. -newtype List a = List { fromList :: [a] } - deriving (Data, Eq, Show) - -instance Pushable a => Pushable (List a) where - push (List xs) = pushPandocList push xs - --- | Pushes a list as a numerical Lua table, setting a metatable that offers a --- number of convenience functions. -pushPandocList :: LuaError e => Pusher e a -> Pusher e [a] -pushPandocList pushItem xs = pushViaConstr' "List" [pushList pushItem xs] - -peekList' :: LuaError e => Peeker e a -> Peeker e (List a) -peekList' p = (List <$!>) . peekList p - --- List is just a wrapper, so we can reuse the walk instance for --- unwrapped Hasekll lists. -instance Walkable [a] b => Walkable (List a) b where - walkM f = walkM (fmap fromList . f . List) - query f = query (f . List) diff --git a/src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs b/src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs deleted file mode 100644 index 5a6608644..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} -{- | -Module : Text.Pandoc.Lua.Marshaling.ListAttributes -Copyright : © 2021 Albert Krewinkel -License : GNU GPL, version 2 or above -Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> - -Marshaling/unmarshaling functions and constructor for 'ListAttributes' -values. --} -module Text.Pandoc.Lua.Marshaling.ListAttributes - ( typeListAttributes - , peekListAttributes - , pushListAttributes - , mkListAttributes - ) where - -import Data.Maybe (fromMaybe) -import HsLua -import Text.Pandoc.Definition ( ListAttributes, ListNumberStyle (DefaultStyle) - , ListNumberDelim (DefaultDelim)) - -typeListAttributes :: LuaError e => DocumentedType e ListAttributes -typeListAttributes = deftype "ListAttributes" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> parameter peekListAttributes "a" "ListAttributes" "" - <#> parameter peekListAttributes "b" "ListAttributes" "" - =#> functionResult pushBool "boolean" "whether the two are equal" - ] - [ property "start" "number of the first list item" - (pushIntegral, \(start,_,_) -> start) - (peekIntegral, \(_,style,delim) -> (,style,delim)) - , property "style" "style used for list numbering" - (pushString . show, \(_,classes,_) -> classes) - (peekRead, \(start,_,delim) -> (start,,delim)) - , property "delimiter" "delimiter of list numbers" - (pushString . show, \(_,_,delim) -> delim) - (peekRead, \(start,style,_) -> (start,style,)) - , method $ defun "clone" - ### return - <#> udparam typeListAttributes "a" "" - =#> functionResult (pushUD typeListAttributes) "ListAttributes" - "cloned ListAttributes value" - ] - --- | Pushes a 'ListAttributes' value as userdata object. -pushListAttributes :: LuaError e => Pusher e ListAttributes -pushListAttributes = pushUD typeListAttributes - --- | Retrieve a 'ListAttributes' triple, either from userdata or from a --- Lua tuple. -peekListAttributes :: LuaError e => Peeker e ListAttributes -peekListAttributes = retrieving "ListAttributes" . choice - [ peekUD typeListAttributes - , peekTriple peekIntegral peekRead peekRead - ] - --- | Constructor for a new 'ListAttributes' value. -mkListAttributes :: LuaError e => DocumentedFunction e -mkListAttributes = defun "ListAttributes" - ### liftPure3 (\mstart mstyle mdelim -> - ( fromMaybe 1 mstart - , fromMaybe DefaultStyle mstyle - , fromMaybe DefaultDelim mdelim - )) - <#> optionalParameter peekIntegral "integer" "start" "number of first item" - <#> optionalParameter peekRead "string" "style" "list numbering style" - <#> optionalParameter peekRead "string" "delimiter" "list number delimiter" - =#> functionResult pushListAttributes "ListAttributes" "new ListAttributes" - #? "Creates a new ListAttributes object." diff --git a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs b/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs deleted file mode 100644 index 65f5aec8b..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs +++ /dev/null @@ -1,92 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.SimpleTable - Copyright : © 2020-2021 Albert Krewinkel - License : GNU GPL, version 2 or above - Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> - -Definition and marshaling of the 'SimpleTable' data type used as a -convenience type when dealing with tables. --} -module Text.Pandoc.Lua.Marshaling.SimpleTable - ( SimpleTable (..) - , peekSimpleTable - , pushSimpleTable - , mkSimpleTable - ) - where - -import HsLua as Lua -import Text.Pandoc.Definition -import Text.Pandoc.Lua.Marshaling.AST -import Text.Pandoc.Lua.Marshaling.List - --- | A simple (legacy-style) table. -data SimpleTable = SimpleTable - { simpleTableCaption :: [Inline] - , simpleTableAlignments :: [Alignment] - , simpleTableColumnWidths :: [Double] - , simpleTableHeader :: [[Block]] - , simpleTableBody :: [[[Block]]] - } deriving (Eq, Show) - -typeSimpleTable :: LuaError e => DocumentedType e SimpleTable -typeSimpleTable = deftype "SimpleTable" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> udparam typeSimpleTable "a" "" - <#> udparam typeSimpleTable "b" "" - =#> functionResult pushBool "boolean" "whether the two objects are equal" - , operation Tostring $ lambda - ### liftPure show - <#> udparam typeSimpleTable "self" "" - =#> functionResult pushString "string" "Haskell string representation" - ] - [ property "caption" "table caption" - (pushPandocList pushInline, simpleTableCaption) - (peekInlinesFuzzy, \t capt -> t {simpleTableCaption = capt}) - , property "aligns" "column alignments" - (pushPandocList (pushString . show), simpleTableAlignments) - (peekList peekRead, \t aligns -> t{simpleTableAlignments = aligns}) - , property "widths" "relative column widths" - (pushPandocList pushRealFloat, simpleTableColumnWidths) - (peekList peekRealFloat, \t ws -> t{simpleTableColumnWidths = ws}) - , property "headers" "table header" - (pushRow, simpleTableHeader) - (peekRow, \t h -> t{simpleTableHeader = h}) - , property "rows" "table body rows" - (pushPandocList pushRow, simpleTableBody) - (peekList peekRow, \t bs -> t{simpleTableBody = bs}) - - , readonly "t" "type tag (always 'SimpleTable')" - (pushText, const "SimpleTable") - - , alias "header" "alias for `headers`" ["headers"] - ] - where - pushRow = pushPandocList (pushPandocList pushBlock) - -peekRow :: LuaError e => Peeker e [[Block]] -peekRow = peekList peekBlocksFuzzy - --- | Push a simple table to the stack by calling the --- @pandoc.SimpleTable@ constructor. -pushSimpleTable :: forall e. LuaError e => SimpleTable -> LuaE e () -pushSimpleTable = pushUD typeSimpleTable - --- | Retrieve a simple table from the stack. -peekSimpleTable :: forall e. LuaError e => Peeker e SimpleTable -peekSimpleTable = retrieving "SimpleTable" . peekUD typeSimpleTable - --- | Constructor for the 'SimpleTable' type. -mkSimpleTable :: LuaError e => DocumentedFunction e -mkSimpleTable = defun "SimpleTable" - ### liftPure5 SimpleTable - <#> parameter peekInlinesFuzzy "Inlines" "caption" "table caption" - <#> parameter (peekList peekRead) "{Alignment,...}" "align" "column alignments" - <#> parameter (peekList peekRealFloat) "{number,...}" "widths" - "relative column widths" - <#> parameter peekRow "{Blocks,...}" "header" "table header row" - <#> parameter (peekList peekRow) "{{Blocks,...},...}" "body" "table body rows" - =#> functionResult pushSimpleTable "SimpleTable" "new SimpleTable object" diff --git a/src/Text/Pandoc/Lua/Module/MediaBag.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs index 6e595f9e4..fb055101e 100644 --- a/src/Text/Pandoc/Lua/Module/MediaBag.hs +++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs @@ -21,8 +21,8 @@ import Text.Pandoc.Class.CommonState (CommonState (..)) import Text.Pandoc.Class.PandocMonad (fetchItem, getMediaBag, modifyCommonState, setMediaBag) import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.Marshaling.List (pushPandocList) +import Text.Pandoc.Lua.Marshal.List (pushPandocList) +import Text.Pandoc.Lua.Orphans () import Text.Pandoc.Lua.PandocLua (unPandocLua) import Text.Pandoc.MIME (MimeType) diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index a8b111092..085d904cf 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -19,35 +19,28 @@ module Text.Pandoc.Lua.Module.Pandoc ) where import Prelude hiding (read) -import Control.Applicative ((<|>)) -import Control.Monad ((<$!>), forM_, when) +import Control.Monad (forM_, when) import Control.Monad.Catch (catch, throwM) import Control.Monad.Except (throwError) import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr) import Data.Default (Default (..)) import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (Proxy)) -import Data.Text (Text) -import HsLua hiding (Div, pushModule) +import HsLua hiding (pushModule) import HsLua.Class.Peekable (PeekError) import System.Exit (ExitCode (..)) import Text.Pandoc.Class.PandocIO (runIO) import Text.Pandoc.Definition -import Text.Pandoc.Lua.Filter (SingletonsList (..), LuaFilter, peekLuaFilter, +import Text.Pandoc.Lua.Filter (List (..), SingletonsList (..), LuaFilter, + peekLuaFilter, walkInlines, walkInlineLists, walkBlocks, walkBlockLists) -import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.Marshaling.AST -import Text.Pandoc.Lua.Marshaling.Attr (mkAttr, mkAttributeList) -import Text.Pandoc.Lua.Marshaling.List (List (..)) -import Text.Pandoc.Lua.Marshaling.ListAttributes ( mkListAttributes - , peekListAttributes) -import Text.Pandoc.Lua.Marshaling.ReaderOptions ( peekReaderOptions +import Text.Pandoc.Lua.Orphans () +import Text.Pandoc.Lua.Marshal.AST +import Text.Pandoc.Lua.Marshal.ReaderOptions ( peekReaderOptions , pushReaderOptions) -import Text.Pandoc.Lua.Marshaling.SimpleTable (mkSimpleTable) import Text.Pandoc.Lua.Module.Utils (sha1) -import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, - loadDefaultModule) +import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua) import Text.Pandoc.Options (ReaderOptions (readerExtensions)) import Text.Pandoc.Process (pipeProcess) import Text.Pandoc.Readers (Reader (..), getReader) @@ -65,21 +58,6 @@ import Text.Pandoc.Error pushModule :: PandocLua NumResults pushModule = do liftPandocLua $ Lua.pushModule documentedModule - loadDefaultModule "pandoc" - let copyNext = do - hasNext <- next (nth 2) - if not hasNext - then return () - else do - pushvalue (nth 2) - insert (nth 2) - rawset (nth 5) -- pandoc module - copyNext - liftPandocLua $ do - pushnil -- initial key - copyNext - pop 1 - return 1 documentedModule :: Module PandocError @@ -97,6 +75,7 @@ documentedModule = Module , otherConstructors , blockConstructors , inlineConstructors + , metaValueConstructors ] } @@ -132,229 +111,13 @@ pushWithConstructorsSubtable constructors = do rawset (nth 3) pop 1 -- pop constructor table -inlineConstructors :: LuaError e => [DocumentedFunction e] -inlineConstructors = - [ defun "Cite" - ### liftPure2 (flip Cite) - <#> parameter peekInlinesFuzzy "content" "Inline" "placeholder content" - <#> parameter (peekList peekCitation) "citations" "list of Citations" "" - =#> functionResult pushInline "Inline" "cite element" - , defun "Code" - ### liftPure2 (\text mattr -> Code (fromMaybe nullAttr mattr) text) - <#> parameter peekText "code" "string" "code string" - <#> optionalParameter peekAttr "attr" "Attr" "additional attributes" - =#> functionResult pushInline "Inline" "code element" - , mkInlinesConstr "Emph" Emph - , defun "Image" - ### liftPure4 (\caption src mtitle mattr -> - let attr = fromMaybe nullAttr mattr - title = fromMaybe mempty mtitle - in Image attr caption (src, title)) - <#> parameter peekInlinesFuzzy "Inlines" "caption" "image caption / alt" - <#> parameter peekText "string" "src" "path/URL of the image file" - <#> optionalParameter peekText "string" "title" "brief image description" - <#> optionalParameter peekAttr "Attr" "attr" "image attributes" - =#> functionResult pushInline "Inline" "image element" - , defun "LineBreak" - ### return LineBreak - =#> functionResult pushInline "Inline" "line break" - , defun "Link" - ### liftPure4 (\content target mtitle mattr -> - let attr = fromMaybe nullAttr mattr - title = fromMaybe mempty mtitle - in Link attr content (target, title)) - <#> parameter peekInlinesFuzzy "Inlines" "content" "text for this link" - <#> parameter peekText "string" "target" "the link target" - <#> optionalParameter peekText "string" "title" "brief link description" - <#> optionalParameter peekAttr "Attr" "attr" "link attributes" - =#> functionResult pushInline "Inline" "link element" - , defun "Math" - ### liftPure2 Math - <#> parameter peekMathType "quotetype" "Math" "rendering method" - <#> parameter peekText "text" "string" "math content" - =#> functionResult pushInline "Inline" "math element" - , defun "Note" - ### liftPure Note - <#> parameter peekBlocksFuzzy "content" "Blocks" "note content" - =#> functionResult pushInline "Inline" "note" - , defun "Quoted" - ### liftPure2 Quoted - <#> parameter peekQuoteType "quotetype" "QuoteType" "type of quotes" - <#> parameter peekInlinesFuzzy "content" "Inlines" "inlines in quotes" - =#> functionResult pushInline "Inline" "quoted element" - , defun "RawInline" - ### liftPure2 RawInline - <#> parameter peekFormat "format" "Format" "format of content" - <#> parameter peekText "text" "string" "string content" - =#> functionResult pushInline "Inline" "raw inline element" - , mkInlinesConstr "SmallCaps" SmallCaps - , defun "SoftBreak" - ### return SoftBreak - =#> functionResult pushInline "Inline" "soft break" - , defun "Space" - ### return Space - =#> functionResult pushInline "Inline" "new space" - , defun "Span" - ### liftPure2 (\inlns mattr -> Span (fromMaybe nullAttr mattr) inlns) - <#> parameter peekInlinesFuzzy "content" "Inlines" "inline content" - <#> optionalParameter peekAttr "attr" "Attr" "additional attributes" - =#> functionResult pushInline "Inline" "span element" - , defun "Str" - ### liftPure Str - <#> parameter peekText "text" "string" "" - =#> functionResult pushInline "Inline" "new Str object" - , mkInlinesConstr "Strong" Strong - , mkInlinesConstr "Strikeout" Strikeout - , mkInlinesConstr "Subscript" Subscript - , mkInlinesConstr "Superscript" Superscript - , mkInlinesConstr "Underline" Underline - ] - -blockConstructors :: LuaError e => [DocumentedFunction e] -blockConstructors = - [ defun "BlockQuote" - ### liftPure BlockQuote - <#> blocksParam - =#> blockResult "BlockQuote element" - - , defun "BulletList" - ### liftPure BulletList - <#> blockItemsParam "list items" - =#> blockResult "BulletList element" - - , defun "CodeBlock" - ### liftPure2 (\code mattr -> CodeBlock (fromMaybe nullAttr mattr) code) - <#> textParam "text" "code block content" - <#> optAttrParam - =#> blockResult "CodeBlock element" - - , defun "DefinitionList" - ### liftPure DefinitionList - <#> parameter (choice - [ peekList peekDefinitionItem - , \idx -> (:[]) <$!> peekDefinitionItem idx - ]) - "{{Inlines, {Blocks,...}},...}" - "content" "definition items" - =#> blockResult "DefinitionList element" - - , defun "Div" - ### liftPure2 (\content mattr -> Div (fromMaybe nullAttr mattr) content) - <#> blocksParam - <#> optAttrParam - =#> blockResult "Div element" - - , defun "Header" - ### liftPure3 (\lvl content mattr -> - Header lvl (fromMaybe nullAttr mattr) content) - <#> parameter peekIntegral "integer" "level" "heading level" - <#> parameter peekInlinesFuzzy "Inlines" "content" "inline content" - <#> optAttrParam - =#> blockResult "Header element" - - , defun "HorizontalRule" - ### return HorizontalRule - =#> blockResult "HorizontalRule element" - - , defun "LineBlock" - ### liftPure LineBlock - <#> parameter (peekList peekInlinesFuzzy) "{Inlines,...}" "content" "lines" - =#> blockResult "LineBlock element" - - , defun "Null" - ### return Null - =#> blockResult "Null element" - - , defun "OrderedList" - ### liftPure2 (\items mListAttrib -> - let defListAttrib = (1, DefaultStyle, DefaultDelim) - in OrderedList (fromMaybe defListAttrib mListAttrib) items) - <#> blockItemsParam "ordered list items" - <#> optionalParameter peekListAttributes "ListAttributes" "listAttributes" - "specifier for the list's numbering" - =#> blockResult "OrderedList element" - - , defun "Para" - ### liftPure Para - <#> parameter peekInlinesFuzzy "Inlines" "content" "paragraph content" - =#> blockResult "Para element" - - , defun "Plain" - ### liftPure Plain - <#> parameter peekInlinesFuzzy "Inlines" "content" "paragraph content" - =#> blockResult "Plain element" - - , defun "RawBlock" - ### liftPure2 RawBlock - <#> parameter peekFormat "Format" "format" "format of content" - <#> parameter peekText "string" "text" "raw content" - =#> blockResult "RawBlock element" - - , defun "Table" - ### (\capt colspecs thead tbodies tfoot mattr -> - let attr = fromMaybe nullAttr mattr - in return $! attr `seq` capt `seq` colspecs `seq` thead `seq` tbodies - `seq` tfoot `seq` Table attr capt colspecs thead tbodies tfoot) - <#> parameter peekCaption "Caption" "caption" "table caption" - <#> parameter (peekList peekColSpec) "{ColSpec,...}" "colspecs" - "column alignments and widths" - <#> parameter peekTableHead "TableHead" "head" "table head" - <#> parameter (peekList peekTableBody) "{TableBody,...}" "bodies" - "table bodies" - <#> parameter peekTableFoot "TableFoot" "foot" "table foot" - <#> optAttrParam - =#> blockResult "Table element" - ] - where - blockResult = functionResult pushBlock "Block" - blocksParam = parameter peekBlocksFuzzy "Blocks" "content" "block content" - blockItemsParam = parameter peekItemsFuzzy "List of Blocks" "content" - peekItemsFuzzy idx = peekList peekBlocksFuzzy idx - <|> ((:[]) <$!> peekBlocksFuzzy idx) - -textParam :: LuaError e => Text -> Text -> Parameter e Text -textParam = parameter peekText "string" - -optAttrParam :: LuaError e => Parameter e (Maybe Attr) -optAttrParam = optionalParameter peekAttr "attr" "Attr" "additional attributes" - -mkInlinesConstr :: LuaError e - => Name -> ([Inline] -> Inline) -> DocumentedFunction e -mkInlinesConstr name constr = defun name - ### liftPure (\x -> x `seq` constr x) - <#> parameter peekInlinesFuzzy "content" "Inlines" "" - =#> functionResult pushInline "Inline" "new object" - otherConstructors :: LuaError e => [DocumentedFunction e] otherConstructors = - [ defun "Pandoc" - ### liftPure2 (\blocks mMeta -> Pandoc (fromMaybe nullMeta mMeta) blocks) - <#> parameter peekBlocksFuzzy "Blocks" "blocks" "document contents" - <#> optionalParameter peekMeta "Meta" "meta" "document metadata" - =#> functionResult pushPandoc "Pandoc" "new Pandoc document" - - , defun "Citation" - ### (\cid mode mprefix msuffix mnote_num mhash -> - cid `seq` mode `seq` mprefix `seq` msuffix `seq` - mnote_num `seq` mhash `seq` return $! Citation - { citationId = cid - , citationMode = mode - , citationPrefix = fromMaybe mempty mprefix - , citationSuffix = fromMaybe mempty msuffix - , citationNoteNum = fromMaybe 0 mnote_num - , citationHash = fromMaybe 0 mhash - }) - <#> parameter peekText "string" "cid" "citation ID (e.g. bibtex key)" - <#> parameter peekRead "citation mode" "mode" "citation rendering mode" - <#> optionalParameter peekInlinesFuzzy "prefix" "Inlines" "" - <#> optionalParameter peekInlinesFuzzy "suffix" "Inlines" "" - <#> optionalParameter peekIntegral "note_num" "integer" "note number" - <#> optionalParameter peekIntegral "hash" "integer" "hash number" - =#> functionResult pushCitation "Citation" "new citation object" - #? "Creates a single citation." - + [ mkPandoc + , mkMeta , mkAttr , mkAttributeList + , mkCitation , mkListAttributes , mkSimpleTable diff --git a/src/Text/Pandoc/Lua/Module/Types.hs b/src/Text/Pandoc/Lua/Module/Types.hs index 4b37dafd9..f16737f63 100644 --- a/src/Text/Pandoc/Lua/Module/Types.hs +++ b/src/Text/Pandoc/Lua/Module/Types.hs @@ -13,14 +13,11 @@ module Text.Pandoc.Lua.Module.Types ( documentedModule ) where -import HsLua ( LuaE, NumResults, Peeker, Pusher, Module (..), Field (..) - , defun, functionResult, parameter, (###), (<#>), (=#>)) +import HsLua ( Module (..), (###), (<#>), (=#>) + , defun, functionResult, parameter) import HsLua.Module.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.ErrorConversion () -import Text.Pandoc.Lua.Marshaling.AST - -import qualified HsLua as Lua -- | Push the pandoc.types module on the Lua stack. documentedModule :: Module PandocError @@ -28,16 +25,7 @@ documentedModule = Module { moduleName = "pandoc.types" , moduleDescription = "Constructors for types that are not part of the pandoc AST." - , moduleFields = - [ Field - { fieldName = "clone" - , fieldDescription = "DEPRECATED! Helper functions for element cloning." - , fieldPushValue = do - Lua.newtable - addFunction "Meta" $ cloneWith peekMeta pushMeta - addFunction "MetaValue" $ cloneWith peekMetaValue pushMetaValue - } - ] + , moduleFields = [] , moduleFunctions = [ defun "Version" ### return @@ -52,15 +40,3 @@ documentedModule = Module ] , moduleOperations = [] } - where addFunction name fn = do - Lua.pushName name - Lua.pushHaskellFunction fn - Lua.rawset (Lua.nth 3) - -cloneWith :: Peeker PandocError a - -> Pusher PandocError a - -> LuaE PandocError NumResults -cloneWith peeker pusher = do - x <- Lua.forcePeek $ peeker (Lua.nthBottom 1) - pusher x - return (Lua.NumResults 1) diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 6fd707bf8..917f2e627 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -27,14 +27,7 @@ import HsLua.Class.Peekable (PeekError) import HsLua.Module.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.Marshaling.AST - ( peekBlock, peekInline, peekPandoc, pushBlock, pushInline, pushInlines - , pushPandoc, peekAttr, peekMeta, peekMetaValue) -import Text.Pandoc.Lua.Marshaling.ListAttributes (peekListAttributes) -import Text.Pandoc.Lua.Marshaling.List (pushPandocList) -import Text.Pandoc.Lua.Marshaling.SimpleTable - ( SimpleTable (..), peekSimpleTable, pushSimpleTable ) +import Text.Pandoc.Lua.Marshal.AST import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua)) import qualified Data.Digest.Pure.SHA as SHA diff --git a/src/Text/Pandoc/Lua/Orphans.hs b/src/Text/Pandoc/Lua/Orphans.hs new file mode 100644 index 000000000..eef05bd27 --- /dev/null +++ b/src/Text/Pandoc/Lua/Orphans.hs @@ -0,0 +1,111 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE FlexibleInstances #-} +{- | + Module : Text.Pandoc.Lua.Orphans + Copyright : © 2012-2021 John MacFarlane + © 2017-2021 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> + Stability : alpha + +Orphan instances for Lua's Pushable and Peekable type classes. +-} +module Text.Pandoc.Lua.Orphans () where + +import Data.Version (Version) +import HsLua +import HsLua.Module.Version (peekVersionFuzzy) +import Text.Pandoc.Definition +import Text.Pandoc.Lua.Marshal.AST +import Text.Pandoc.Lua.Marshal.CommonState () +import Text.Pandoc.Lua.Marshal.Context () +import Text.Pandoc.Lua.Marshal.PandocError() +import Text.Pandoc.Lua.Marshal.ReaderOptions () +import Text.Pandoc.Lua.ErrorConversion () + +instance Pushable Pandoc where + push = pushPandoc + +instance Pushable Meta where + push = pushMeta + +instance Pushable MetaValue where + push = pushMetaValue + +instance Pushable Block where + push = pushBlock + +instance {-# OVERLAPPING #-} Pushable [Block] where + push = pushBlocks + +instance Pushable Alignment where + push = pushString . show + +instance Pushable CitationMode where + push = pushCitationMode + +instance Pushable Format where + push = pushFormat + +instance Pushable ListNumberDelim where + push = pushString . show + +instance Pushable ListNumberStyle where + push = pushString . show + +instance Pushable MathType where + push = pushMathType + +instance Pushable QuoteType where + push = pushQuoteType + +instance Pushable Cell where + push = pushCell + +instance Peekable Cell where + peek = forcePeek . peekCell + +instance Pushable Inline where + push = pushInline + +instance {-# OVERLAPPING #-} Pushable [Inline] where + push = pushInlines + +instance Pushable Citation where + push = pushCitation + +instance Pushable Row where + push = pushRow + +instance Pushable TableBody where + push = pushTableBody + +instance Pushable TableFoot where + push = pushTableFoot + +instance Pushable TableHead where + push = pushTableHead + +-- These instances exist only for testing. It's a hack to avoid making +-- the marshalling modules public. +instance Peekable Inline where + peek = forcePeek . peekInline + +instance Peekable Block where + peek = forcePeek . peekBlock + +instance Peekable Meta where + peek = forcePeek . peekMeta + +instance Peekable Pandoc where + peek = forcePeek . peekPandoc + +instance Peekable Row where + peek = forcePeek . peekRow + +instance Peekable Version where + peek = forcePeek . peekVersionFuzzy + +instance {-# OVERLAPPING #-} Peekable Attr where + peek = forcePeek . peekAttr diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs index 3a481886a..c36c3c670 100644 --- a/src/Text/Pandoc/Lua/Packages.hs +++ b/src/Text/Pandoc/Lua/Packages.hs @@ -17,7 +17,8 @@ module Text.Pandoc.Lua.Packages import Control.Monad (forM_) import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, loadDefaultModule) +import Text.Pandoc.Lua.Marshal.List (pushListModule) +import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua) import qualified HsLua as Lua import qualified HsLua.Module.Path as Path @@ -45,7 +46,7 @@ installPandocPackageSearcher = liftPandocLua $ do pandocPackageSearcher :: String -> PandocLua Lua.NumResults pandocPackageSearcher pkgName = case pkgName of - "pandoc" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError Pandoc.pushModule + "pandoc" -> pushModuleLoader Pandoc.documentedModule "pandoc.mediabag" -> pushModuleLoader MediaBag.documentedModule "pandoc.path" -> pushModuleLoader Path.documentedModule "pandoc.system" -> pushModuleLoader System.documentedModule @@ -53,7 +54,7 @@ pandocPackageSearcher pkgName = "pandoc.utils" -> pushModuleLoader Utils.documentedModule "text" -> pushModuleLoader Text.documentedModule "pandoc.List" -> pushWrappedHsFun . Lua.toHaskellFunction @PandocError $ - loadDefaultModule pkgName + (Lua.NumResults 1 <$ pushListModule @PandocError) _ -> reportPandocSearcherFailure where pushModuleLoader mdl = liftPandocLua $ do diff --git a/src/Text/Pandoc/Lua/PandocLua.hs b/src/Text/Pandoc/Lua/PandocLua.hs index 6c2ebc622..71fdf8d5c 100644 --- a/src/Text/Pandoc/Lua/PandocLua.hs +++ b/src/Text/Pandoc/Lua/PandocLua.hs @@ -22,20 +22,18 @@ module Text.Pandoc.Lua.PandocLua ( PandocLua (..) , runPandocLua , liftPandocLua - , loadDefaultModule ) where import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow) import Control.Monad.Except (MonadError (catchError, throwError)) import Control.Monad.IO.Class (MonadIO) import HsLua as Lua -import Text.Pandoc.Class.PandocMonad (PandocMonad (..), readDefaultDataFile) -import Text.Pandoc.Error (PandocError (PandocLuaError)) +import Text.Pandoc.Class.PandocMonad (PandocMonad (..)) +import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.Global (Global (..), setGlobals) -import Text.Pandoc.Lua.Marshaling.CommonState (peekCommonState) +import Text.Pandoc.Lua.Marshal.CommonState (peekCommonState) import qualified Control.Monad.Catch as Catch -import qualified Data.Text as T import qualified Text.Pandoc.Class.IO as IO -- | Type providing access to both, pandoc and Lua operations. @@ -75,23 +73,6 @@ instance {-# OVERLAPPING #-} Exposable PandocError (PandocLua NumResults) where instance Pushable a => Exposable PandocError (PandocLua a) where partialApply _narg x = 1 <$ (unPandocLua x >>= Lua.push) --- | Load a pure Lua module included with pandoc. Leaves the result on --- the stack and returns @NumResults 1@. --- --- The script is loaded from the default data directory. We do not load --- from data directories supplied via command line, as this could cause --- scripts to be executed even though they had not been passed explicitly. -loadDefaultModule :: String -> PandocLua NumResults -loadDefaultModule name = do - script <- readDefaultDataFile (name <> ".lua") - result <- liftPandocLua $ Lua.dostring script - if result == Lua.OK - then return (1 :: NumResults) - else do - msg <- liftPandocLua Lua.popValue - let err = "Error while loading `" <> name <> "`.\n" <> msg - throwError $ PandocLuaError (T.pack err) - -- | Global variables which should always be set. defaultGlobals :: PandocMonad m => m [Global] defaultGlobals = do diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs index f35201db0..6d67d340d 100644 --- a/src/Text/Pandoc/Lua/Util.hs +++ b/src/Text/Pandoc/Lua/Util.hs @@ -1,9 +1,4 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Lua.Util Copyright : © 2012-2021 John MacFarlane, @@ -16,14 +11,12 @@ Lua utility functions. -} module Text.Pandoc.Lua.Util - ( getTag - , addField + ( addField , callWithTraceback , dofileWithTraceback - , pushViaConstr' ) where -import Control.Monad (unless, when) +import Control.Monad (when) import HsLua import qualified HsLua as Lua @@ -34,26 +27,6 @@ addField key value = do Lua.push value Lua.rawset (Lua.nth 3) --- | Get the tag of a value. This is an optimized and specialized version of --- @Lua.getfield idx "tag"@. It only checks for the field on the table at index --- @idx@ and on its metatable, also ignoring any @__index@ value on the --- metatable. -getTag :: LuaError e => Peeker e Name -getTag idx = do - -- push metatable or just the table - liftLua $ do - Lua.getmetatable idx >>= \hasMT -> unless hasMT (Lua.pushvalue idx) - Lua.pushName "tag" - Lua.rawget (Lua.nth 2) - Lua.peekName Lua.top `lastly` Lua.pop 2 -- table/metatable and `tag` field - -pushViaConstr' :: forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e () -pushViaConstr' fnname pushArgs = do - pushName @e ("pandoc." <> fnname) - rawget @e registryindex - sequence_ pushArgs - call @e (fromIntegral (length pushArgs)) 1 - -- | Like @'Lua.pcall'@, but uses a predefined error handler which adds a -- traceback on error. pcallWithTraceback :: LuaError e => NumArgs -> NumResults -> LuaE e Status diff --git a/src/Text/Pandoc/Lua/Walk.hs b/src/Text/Pandoc/Lua/Walk.hs index d6d973496..75ed1f471 100644 --- a/src/Text/Pandoc/Lua/Walk.hs +++ b/src/Text/Pandoc/Lua/Walk.hs @@ -1,7 +1,9 @@ -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE UndecidableInstances #-} {- | Module : Text.Pandoc.Lua.Walk Copyright : © 2012-2021 John MacFarlane, @@ -14,13 +16,18 @@ Walking documents in a filter-suitable way. -} module Text.Pandoc.Lua.Walk ( SingletonsList (..) + , List (..) ) where import Control.Monad ((<=<)) +import Data.Data (Data) +import HsLua (Pushable (push)) +import Text.Pandoc.Lua.Marshal.AST (pushBlocks, pushInlines) import Text.Pandoc.Definition import Text.Pandoc.Walk + -- | Helper type which allows to traverse trees in order, while splicing in -- trees. -- @@ -156,3 +163,21 @@ querySingletonsList :: (Monoid c, Walkable (SingletonsList a) a) querySingletonsList f = let f' x = f (SingletonsList [x]) `mappend` query f x in mconcat . map f' + + +-- | List wrapper where each list is processed as a whole, but special +-- pushed to Lua in type-dependent ways. +-- +-- The walk instance is basically that of unwrapped Haskell lists. +newtype List a = List { fromList :: [a] } + deriving (Data, Eq, Show) + +instance Pushable (List Block) where + push (List xs) = pushBlocks xs + +instance Pushable (List Inline) where + push (List xs) = pushInlines xs + +instance Walkable [a] b => Walkable (List a) b where + walkM f = walkM (fmap fromList . f . List) + query f = query (f . List) diff --git a/stack.yaml b/stack.yaml index c77ee622f..71c25c0be 100644 --- a/stack.yaml +++ b/stack.yaml @@ -23,7 +23,7 @@ extra-deps: - hslua-module-version-1.0.0 - hslua-objectorientation-2.0.1 - hslua-packaging-2.0.0 -- lua-2.0.1 +- lua-2.0.2 - tasty-hslua-1.0.0 - tasty-lua-1.0.0 - pandoc-types-1.22.1 @@ -33,6 +33,8 @@ extra-deps: - aeson-pretty-0.8.9 - ipynb-0.1.0.2 - texmath-0.12.3.3 +- git: https://github.com/tarleb/hslua-pandoc-types.git + commit: 56387e543c48cc5518a77c2a271ff211653f2a36 ghc-options: "$locals": -fhide-source-paths -Wno-missing-home-modules resolver: lts-18.10 diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs index 2070695e3..7ef21f933 100644 --- a/test/Tests/Lua.hs +++ b/test/Tests/Lua.hs @@ -238,7 +238,7 @@ tests = map (localOption (QuickCheckTests 20)) case eitherPandoc of Left (PandocLuaError msg) -> do let expectedMsg = "Pandoc expected, got boolean\n" - <> "\twhile retrieving Pandoc value" + <> "\twhile retrieving Pandoc" Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg Left e -> error ("Expected a Lua error, but got " <> show e) Right _ -> error "Getting a Pandoc element from a bool should fail." @@ -266,7 +266,6 @@ roundtripEqual x = (x ==) <$> roundtripped runLuaTest :: HasCallStack => Lua.LuaE PandocError a -> IO a runLuaTest op = runIOorExplode $ do - setUserDataDir (Just "../data") res <- runLua op case res of Left e -> error (show e) diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 2849eedbf..1cf777675 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -8,715 +8,124 @@ function os_is_windows () return package.config:sub(1,1) == '\\' end +-- Constructor behavior is tested in the hslua-pandoc-types module, so +-- we just make sure the functions are present. return { - group 'Attr' { - group 'Constructor' { + group 'Constructors' { + group 'Misc' { test('pandoc.Attr is a function', function () assert.are_equal(type(pandoc.Attr), 'function') end), - test('returns null-Attr if no arguments are given', function () - local attr = pandoc.Attr() - assert.are_equal(attr.identifier, '') - assert.are_same(attr.classes, {}) - assert.are_same(#attr.attributes, 0) - end), - test( - 'accepts string-indexed table or list of pairs as attributes', - function () - local attributes_list = {{'one', '1'}, {'two', '2'}} - local attr_from_list = pandoc.Attr('', {}, attributes_list) - - assert.are_equal(attr_from_list.attributes.one, '1') - assert.are_equal(attr_from_list.attributes.two, '2') - - local attributes_table = {one = '1', two = '2'} - local attr_from_table = pandoc.Attr('', {}, attributes_table) - assert.are_equal( - attr_from_table.attributes, - pandoc.AttributeList(attributes_table) - ) - assert.are_equal(attr_from_table.attributes.one, '1') - assert.are_equal(attr_from_table.attributes.two, '2') - end - ) - }, - group 'Properties' { - test('has t and tag property', function () - local attr = pandoc.Attr('') - assert.are_equal(attr.t, 'Attr') - assert.are_equal(attr.tag, 'Attr') - end) - }, - group 'AttributeList' { - test('allows access via fields', function () - local attributes = pandoc.Attr('', {}, {{'a', '1'}, {'b', '2'}}).attributes - assert.are_equal(attributes.a, '1') - assert.are_equal(attributes.b, '2') - end), - test('allows access to pairs via numerical indexing', function () - local attributes = pandoc.Attr('', {}, {{'a', '1'}, {'b', '2'}}).attributes - assert.are_same(attributes[1], {'a', '1'}) - assert.are_same(attributes[2], {'b', '2'}) - end), - test('allows replacing a pair', function () - local attributes = pandoc.AttributeList{{'a', '1'}, {'b', '2'}} - attributes[1] = {'t','five'} - assert.are_same(attributes[1], {'t', 'five'}) - assert.are_same(attributes[2], {'b', '2'}) - end), - test('allows to remove a pair', function () - local attributes = pandoc.AttributeList{{'a', '1'}, {'b', '2'}} - attributes[1] = nil - assert.are_equal(#attributes, 1) - end), - test('adds entries by field name', function () - local attributes = pandoc.Attr('',{}, {{'c', '1'}, {'d', '2'}}).attributes - attributes.e = '3' - assert.are_same( - attributes, - -- checking the full AttributeList would "duplicate" entries - pandoc.AttributeList{{'c', '1'}, {'d', '2'}, {'e', '3'}} - ) + test('pandoc.AttributeList is a function', function () + assert.are_equal(type(pandoc.AttributeList), 'function') end), - test('deletes entries by field name', function () - local attributes = pandoc.Attr('',{}, {a = '1', b = '2'}).attributes - attributes.a = nil - assert.is_nil(attributes.a) - assert.are_same(attributes, pandoc.AttributeList{{'b', '2'}}) - end), - test('remains unchanged if deleted key did not exist', function () - local assoc_list = pandoc.List:new {{'alpha', 'x'}, {'beta', 'y'}} - local attributes = pandoc.Attr('', {}, assoc_list).attributes - attributes.a = nil - local new_assoc_list = pandoc.List() - for k, v in pairs(attributes) do - new_assoc_list:insert({k, v}) - end - assert.are_same(new_assoc_list, assoc_list) - end), - test('gives key-value pairs when iterated-over', function () - local attributes = {width = '11', height = '22', name = 'test'} - local attr = pandoc.Attr('', {}, attributes) - local count = 0 - for k, v in pairs(attr.attributes) do - assert.are_equal(attributes[k], v) - count = count + 1 - end - assert.are_equal(count, 3) - end) - }, - group 'HTML-like attribute tables' { - test('in element constructor', function () - local html_attributes = { - id = 'the-id', - class = 'class1 class2', - width = '11', - height = '12' - } - local attr = pandoc.Span('test', html_attributes).attr - assert.are_equal(attr.identifier, 'the-id') - assert.are_equal(attr.classes[1], 'class1') - assert.are_equal(attr.classes[2], 'class2') - assert.are_equal(attr.attributes.width, '11') - assert.are_equal(attr.attributes.height, '12') - end), - test('element attr setter', function () - local html_attributes = { - id = 'the-id', - class = 'class1 class2', - width = "11", - height = "12" - } - local span = pandoc.Span 'test' - span.attr = html_attributes - span = span:clone() -- normalize - assert.are_equal(span.attr.identifier, 'the-id') - assert.are_equal(span.attr.classes[1], 'class1') - assert.are_equal(span.attr.classes[2], 'class2') - assert.are_equal(span.attr.attributes.width, '11') - assert.are_equal(span.attr.attributes.height, '12') - end), - test('element attrbutes setter', function () - local attributes = { - width = "11", - height = "12" - } - local span = pandoc.Span 'test' - span.attributes = attributes - assert.are_equal(span.attr.attributes.width, '11') - assert.are_equal(span.attr.attributes.height, '12') - end) - } - }, - group "Inline elements" { - group 'Cite' { - test('has property `content`', function () - local cite = pandoc.Cite({pandoc.Emph 'important'}, {}) - assert.are_same(cite.content, {pandoc.Emph {pandoc.Str 'important'}}) - - cite.content = 'boring' - assert.are_equal(cite, pandoc.Cite({pandoc.Str 'boring'}, {})) - end), - test('has list of citations in property `cite`', function () - local citations = { - pandoc.Citation('einstein1905', 'NormalCitation') - } - local cite = pandoc.Cite('relativity', citations) - assert.are_same(cite.citations, citations) - - local new_citations = { - citations[1], - pandoc.Citation('Poincaré1905', 'NormalCitation') - } - cite.citations = new_citations - assert.are_equal(cite, pandoc.Cite({'relativity'}, new_citations)) + test('pandoc.Citation is a function', function () + assert.are_equal(type(pandoc.Citation), 'function') end), - }, - group 'Code' { - test('has property `attr`', function () - local code = pandoc.Code('true', {id='true', foo='bar'}) - assert.are_equal(code.attr, pandoc.Attr('true', {}, {{'foo', 'bar'}})) - - code.attr = {id='t', fubar='quux'} - assert.are_equal( - pandoc.Code('true', pandoc.Attr('t', {}, {{'fubar', 'quux'}})), - code - ) + test('pandoc.SimpleTable is a function', function () + assert.are_equal(type(pandoc.SimpleTable), 'function') end), - test('has property `text`', function () - local code = pandoc.Code('true') - assert.are_equal(code.text, 'true') - - code.text = '1 + 1' - assert.are_equal(pandoc.Code('1 + 1'), code) + test('pandoc.Meta is a function', function () + assert.are_equal(type(pandoc.Meta), 'function') + end), + test('pandoc.Pandoc is a function', function () + assert.are_equal(type(pandoc.Pandoc), 'function') end), }, - group 'Emph' { - test('has property `content`', function () - local elem = pandoc.Emph{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Emph{'word'}) - end) - }, - group 'Image' { - test('has property `caption`', function () - local img = pandoc.Image('example', 'a.png') - assert.are_same(img.caption, {pandoc.Str 'example'}) - - img.caption = 'A' - assert.are_equal(img, pandoc.Image({'A'}, 'a.png')) + group "Inline elements" { + test('pandoc.AttributeList is a function', function () + assert.are_equal(type(pandoc.Cite), 'function') end), - test('has property `src`', function () - local img = pandoc.Image('example', 'sample.png') - assert.are_same(img.src, 'sample.png') - - img.src = 'example.svg' - assert.are_equal(img, pandoc.Image('example', 'example.svg')) + test('pandoc.AttributeList is a function', function () + assert.are_equal(type(pandoc.Code), 'function') end), - test('has property `title`', function () - local img = pandoc.Image('here', 'img.gif', 'example') - assert.are_same(img.title, 'example') - - img.title = 'a' - assert.are_equal(img, pandoc.Image('here', 'img.gif', 'a')) + test('pandoc.Emph is a function', function () + assert.are_equal(type(pandoc.Emph), 'function') end), - test('has property `attr`', function () - local img = pandoc.Image('up', 'upwards.png', '', {'up', {'point'}}) - assert.are_same(img.attr, pandoc.Attr {'up', {'point'}}) - - img.attr = pandoc.Attr {'up', {'point', 'button'}} - assert.are_equal( - pandoc.Image('up', 'upwards.png', nil, {'up', {'point', 'button'}}), - img - ) - end) - }, - group 'Link' { - test('has property `content`', function () - local link = pandoc.Link('example', 'https://example.org') - assert.are_same(link.content, {pandoc.Str 'example'}) - - link.content = 'commercial' - link.target = 'https://example.com' - assert.are_equal(link, pandoc.Link('commercial', 'https://example.com')) + test('pandoc.Image is a function', function () + assert.are_equal(type(pandoc.Image), 'function') end), - test('has property `target`', function () - local link = pandoc.Link('example', 'https://example.org') - assert.are_same(link.content, {pandoc.Str 'example'}) - - link.target = 'https://example.com' - assert.are_equal(link, pandoc.Link('example', 'https://example.com')) + test('pandoc.Link is a function', function () + assert.are_equal(type(pandoc.Link), 'function') end), - test('has property `title`', function () - local link = pandoc.Link('here', 'https://example.org', 'example') - assert.are_same(link.title, 'example') - - link.title = 'a' - assert.are_equal(link, pandoc.Link('here', 'https://example.org', 'a')) + test('pandoc.Math is a function', function () + assert.are_equal(type(pandoc.Math), 'function') end), - test('has property `attr`', function () - local link = pandoc.Link('up', '../index.html', '', {'up', {'nav'}}) - assert.are_same(link.attr, pandoc.Attr {'up', {'nav'}}) - - link.attr = pandoc.Attr {'up', {'nav', 'button'}} - assert.are_equal( - pandoc.Link('up', '../index.html', nil, {'up', {'nav', 'button'}}), - link - ) - end) - }, - group 'Math' { - test('has property `text`', function () - local elem = pandoc.Math(pandoc.InlineMath, 'x^2') - assert.are_same(elem.text, 'x^2') - elem.text = 'a + b' - assert.are_equal(elem, pandoc.Math(pandoc.InlineMath, 'a + b')) - end), - test('has property `mathtype`', function () - local elem = pandoc.Math(pandoc.InlineMath, 'x^2') - assert.are_same(elem.mathtype, 'InlineMath') - elem.mathtype = pandoc.DisplayMath - assert.are_equal(elem, pandoc.Math(pandoc.DisplayMath, 'x^2')) + test('pandoc.Note is a function', function () + assert.are_equal(type(pandoc.Note), 'function') end), - }, - group 'Note' { - test('has property `content`', function () - local elem = pandoc.Note{pandoc.Para {'two', pandoc.Space(), 'words'}} - assert.are_same( - elem.content, - {pandoc.Para {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'}} - ) - elem.content = pandoc.Plain 'word' - assert.are_equal(elem, pandoc.Note{'word'}) - end) - }, - group 'Quoted' { - test('has property `content`', function () - local elem = pandoc.Quoted('SingleQuote', pandoc.Emph{'emph'}) - assert.are_same( - elem.content, - {pandoc.Emph{pandoc.Str 'emph'}} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Quoted(pandoc.SingleQuote, {'word'})) - end), - test('has property `quotetype`', function () - local elem = pandoc.Quoted('SingleQuote', 'a') - assert.are_same(elem.quotetype, pandoc.SingleQuote) - elem.quotetype = 'DoubleQuote' - assert.are_equal(elem, pandoc.Quoted(pandoc.DoubleQuote, {'a'})) - end) - }, - group 'SmallCaps' { - test('has property `content`', function () - local elem = pandoc.SmallCaps{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.SmallCaps{'word'}) - end) - }, - group 'SoftBreak' { - test('can be constructed', function () - local sb = pandoc.SoftBreak() - assert.are_equal(sb.t, 'SoftBreak') - end) - }, - group 'Span' { - test('has property `attr`', function () - local elem = pandoc.Span('one', {'', {'number'}}) - assert.are_same( - elem.attr, - pandoc.Attr('', {'number'}) - ) - elem.attr = {'', {}, {{'a', 'b'}}} - assert.are_equal(elem, pandoc.Span({'one'}, {a='b'})) - end), - test('has property `content`', function () - local elem = pandoc.Span{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Span{'word'}) - end) - }, - group 'Str' { - test('has property `text`', function () - local elem = pandoc.Str 'nein' - assert.are_same(elem.text, 'nein') - elem.text = 'doch' - assert.are_equal(elem, pandoc.Str 'doch') - end) - }, - group 'Strikeout' { - test('has property `content`', function () - local elem = pandoc.Strikeout{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Strikeout{'word'}) - end) - }, - group 'Strong' { - test('has property `content`', function () - local elem = pandoc.Strong{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Strong{'word'}) - end) - }, - group 'Subscript' { - test('has property `content`', function () - local elem = pandoc.Subscript{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Subscript{'word'}) - end) - }, - group 'Superscript' { - test('has property `content`', function () - local elem = pandoc.Superscript{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Superscript{'word'}) - end) - }, - group 'Underline' { - test('has property `content`', function () - local elem = pandoc.Underline{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Underline{'word'}) - end) - }, - }, - group "Block elements" { - group 'BlockQuote' { - test('access content via property `content`', function () - local elem = pandoc.BlockQuote{'word'} - assert.are_same(elem.content, {pandoc.Plain 'word'}) - assert.are_equal(type(elem.content), 'table') - - elem.content = { - pandoc.Para{pandoc.Str 'one'}, - pandoc.Para{pandoc.Str 'two'} - } - assert.are_equal( - pandoc.BlockQuote{ - pandoc.Para 'one', - pandoc.Para 'two' - }, - elem - ) + test('pandoc.Quoted is a function', function () + assert.are_equal(type(pandoc.Quoted), 'function') end), - }, - group 'BulletList' { - test('access items via property `content`', function () - local para = pandoc.Para 'one' - local blist = pandoc.BulletList{{para}} - assert.are_same({{para}}, blist.content) - end), - test('property `content` uses fuzzy marshalling', function () - local old = pandoc.Plain 'old' - local new = pandoc.Plain 'new' - local blist = pandoc.BulletList{{old}} - blist.content = {{new}} - assert.are_same({{new}}, blist:clone().content) - blist.content = new - assert.are_same({{new}}, blist:clone().content) + test('pandoc.SmallCaps is a function', function () + assert.are_equal(type(pandoc.SmallCaps), 'function') end), - }, - group 'CodeBlock' { - test('access code via property `text`', function () - local cb = pandoc.CodeBlock('return true') - assert.are_equal(cb.text, 'return true') - assert.are_equal(type(cb.text), 'string') - - cb.text = 'return nil' - assert.are_equal(cb, pandoc.CodeBlock('return nil')) + test('pandoc.SoftBreak is a function', function () + assert.are_equal(type(pandoc.SoftBreak), 'function') end), - test('access Attr via property `attr`', function () - local cb = pandoc.CodeBlock('true', {'my-code', {'lua'}}) - assert.are_equal(cb.attr, pandoc.Attr{'my-code', {'lua'}}) - assert.are_equal(type(cb.attr), 'userdata') - - cb.attr = pandoc.Attr{'my-other-code', {'java'}} - assert.are_equal( - pandoc.CodeBlock('true', {'my-other-code', {'java'}}), - cb - ) - end) - }, - group 'DefinitionList' { - test('access items via property `content`', function () - local deflist = pandoc.DefinitionList{ - {'apple', {{pandoc.Plain 'fruit'}, {pandoc.Plain 'company'}}}, - {pandoc.Str 'coffee', 'Best when hot.'} - } - assert.are_equal(#deflist.content, 2) - assert.are_same(deflist.content[1][1], {pandoc.Str 'apple'}) - assert.are_same(deflist.content[1][2][2], - {pandoc.Plain{pandoc.Str 'company'}}) - assert.are_same(deflist.content[2][2], - {{pandoc.Plain{ - pandoc.Str 'Best', pandoc.Space(), - pandoc.Str 'when', pandoc.Space(), - pandoc.Str 'hot.'}}}) - end), - test('modify items via property `content`', function () - local deflist = pandoc.DefinitionList{ - {'apple', {{{'fruit'}}, {{'company'}}}} - } - deflist.content[1][1] = pandoc.Str 'orange' - deflist.content[1][2][1] = {pandoc.Plain 'tasty fruit'} - local newlist = pandoc.DefinitionList{ - { {pandoc.Str 'orange'}, - {{pandoc.Plain 'tasty fruit'}, {pandoc.Plain 'company'}} - } - } - assert.are_equal(deflist, newlist) + test('pandoc.Span is a function', function () + assert.are_equal(type(pandoc.Span), 'function') end), - }, - group 'Div' { - test('access content via property `content`', function () - local elem = pandoc.Div{pandoc.BlockQuote{pandoc.Plain 'word'}} - assert.are_same(elem.content, {pandoc.BlockQuote{'word'}}) - assert.are_equal(type(elem.content), 'table') - - elem.content = { - pandoc.Para{pandoc.Str 'one'}, - pandoc.Para{pandoc.Str 'two'} - } - assert.are_equal( - pandoc.Div{ - pandoc.Para 'one', - pandoc.Para 'two' - }, - elem - ) + test('pandoc.Str is a function', function () + assert.are_equal(type(pandoc.Str), 'function') end), - test('access Attr via property `attr`', function () - local div = pandoc.Div('word', {'my-div', {'sample'}}) - assert.are_equal(div.attr, pandoc.Attr{'my-div', {'sample'}}) - assert.are_equal(type(div.attr), 'userdata') - - div.attr = pandoc.Attr{'my-other-div', {'example'}} - assert.are_equal( - pandoc.Div('word', {'my-other-div', {'example'}}), - div - ) - end) - }, - group 'Header' { - test('access inlines via property `content`', function () - local header = pandoc.Header(1, 'test') - assert.are_same(header.content, {pandoc.Str 'test'}) - - header.content = {'new text'} - assert.are_equal(header, pandoc.Header(1, {'new text'})) + test('pandoc.Strikeout is a function', function () + assert.are_equal(type(pandoc.Strikeout), 'function') end), - test('access Attr via property `attr`', function () - local header = pandoc.Header(1, 'test', {'my-test'}) - assert.are_same(header.attr, pandoc.Attr{'my-test'}) - - header.attr = 'second-test' - assert.are_equal(header, pandoc.Header(1, 'test', 'second-test')) + test('pandoc.Strong is a function', function () + assert.are_equal(type(pandoc.Strong), 'function') end), - test('access level via property `level`', function () - local header = pandoc.Header(3, 'test') - assert.are_same(header.level, 3) - - header.level = 2 - assert.are_equal(header, pandoc.Header(2, 'test')) + test('pandoc.Subscript is a function', function () + assert.are_equal(type(pandoc.Subscript), 'function') end), - }, - group 'LineBlock' { - test('access lines via property `content`', function () - local spc = pandoc.Space() - local lineblock = pandoc.LineBlock{ - {'200', spc, 'Main', spc, 'St.'}, - {'Berkeley', spc, 'CA', spc, '94718'} - } - assert.are_equal(#lineblock.content, 2) -- has two lines - assert.are_same(lineblock.content[2][1], pandoc.Str 'Berkeley') - end), - test('modifying `content` alter the element', function () - local spc = pandoc.Space() - local lineblock = pandoc.LineBlock{ - {'200', spc, 'Main', spc, 'St.'}, - {'Berkeley', spc, 'CA', spc, '94718'} - } - lineblock.content[1][1] = '404' - assert.are_same( - lineblock:clone().content[1], - {pandoc.Str '404', spc, pandoc.Str 'Main', spc, pandoc.Str 'St.'} - ) - - lineblock.content = {{'line1'}, {'line2'}} - assert.are_same( - lineblock:clone(), - pandoc.LineBlock{ - {pandoc.Str 'line1'}, - {pandoc.Str 'line2'} - } - ) - end) - }, - group 'OrderedList' { - test('access items via property `content`', function () - local para = pandoc.Plain 'one' - local olist = pandoc.OrderedList{{para}} - assert.are_same({{para}}, olist.content) - end), - test('forgiving constructor', function () - local plain = pandoc.Plain 'old' - local olist = pandoc.OrderedList({plain}, {3, 'Example', 'Period'}) - local listAttribs = pandoc.ListAttributes(3, 'Example', 'Period') - assert.are_same(olist.listAttributes, listAttribs) - end), - test('has list attribute aliases', function () - local olist = pandoc.OrderedList({}, {4, 'Decimal', 'OneParen'}) - assert.are_equal(olist.start, 4) - assert.are_equal(olist.style, 'Decimal') - assert.are_equal(olist.delimiter, 'OneParen') - end) - }, - group 'Para' { - test('access inline via property `content`', function () - local para = pandoc.Para{'Moin, ', pandoc.Space(), 'Sylt!'} - assert.are_same( - para.content, - {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} - ) + test('pandoc.Superscript is a function', function () + assert.are_equal(type(pandoc.Superscript), 'function') end), - test('modifying `content` changes the element', function () - local para = pandoc.Para{'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} - - para.content[3] = 'Hamburg!' - assert.are_same( - para:clone().content, - {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Hamburg!'} - ) - - para.content = 'Huh' - assert.are_same( - para:clone().content, - {pandoc.Str 'Huh'} - ) + test('pandoc.Underline is a function', function () + assert.are_equal(type(pandoc.Underline), 'function') end), }, - group 'RawBlock' { - test('access raw content via property `text`', function () - local raw = pandoc.RawBlock('markdown', '- one') - assert.are_equal(type(raw.text), 'string') - assert.are_equal(raw.text, '- one') - - raw.text = '+ one' - assert.are_equal(raw, pandoc.RawBlock('markdown', '+ one')) + group "Block elements" { + test('pandoc.BlockQuote is a function', function () + assert.are_equal(type(pandoc.BlockQuote), 'function') end), - test('access Format via property `format`', function () - local raw = pandoc.RawBlock('markdown', '* hi') - assert.are_equal(type(raw.format), 'string') - assert.are_equal(raw.format, 'markdown') - - raw.format = 'org' - assert.are_equal(pandoc.RawBlock('org', '* hi'), raw) - end) - }, - group 'Table' { - test('access Attr via property `attr`', function () - local caption = {long = {pandoc.Plain 'cap'}} - local tbl = pandoc.Table(caption, {}, {{}, {}}, {}, {{}, {}}, - {'my-tbl', {'a'}}) - assert.are_equal(tbl.attr, pandoc.Attr{'my-tbl', {'a'}}) - - tbl.attr = pandoc.Attr{'my-other-tbl', {'b'}} - assert.are_equal( - pandoc.Table(caption, {}, {{}, {}}, {}, {{}, {}}, - {'my-other-tbl', {'b'}}), - tbl - ) + test('pandoc.BulletList is a function', function () + assert.are_equal(type(pandoc.BulletList), 'function') end), - test('access caption via property `caption`', function () - local caption = {long = {pandoc.Plain 'cap'}} - local tbl = pandoc.Table(caption, {}, {{}, {}}, {}, {{}, {}}) - assert.are_same(tbl.caption, {long = {pandoc.Plain 'cap'}}) - - tbl.caption.short = 'brief' - tbl.caption.long = {pandoc.Plain 'extended'} - - local new_caption = { - short = 'brief', - long = {pandoc.Plain 'extended'} - } - assert.are_equal( - pandoc.Table(new_caption, {}, {{}, {}}, {}, {{}, {}}), - tbl - ) + test('pandoc.CodeBlock is a function', function () + assert.are_equal(type(pandoc.CodeBlock), 'function') end), - test('access column specifiers via property `colspecs`', function () - local colspecs = {{pandoc.AlignCenter, 1}} - local tbl = pandoc.Table({long = {}}, colspecs, {{}, {}}, {}, {{}, {}}) - assert.are_same(tbl.colspecs, colspecs) - - tbl.colspecs[1][1] = pandoc.AlignRight - tbl.colspecs[1][2] = nil - - local new_colspecs = {{pandoc.AlignRight}} - assert.are_equal( - pandoc.Table({long = {}}, new_colspecs, {{}, {}}, {}, {{}, {}}), - tbl - ) + test('pandoc.DefinitionList is a function', function () + assert.are_equal(type(pandoc.DefinitionList), 'function') end), - test('access table head via property `head`', function () - local head = {pandoc.Attr{'tbl-head'}, {}} - local tbl = pandoc.Table({long = {}}, {}, head, {}, {{}, {}}) - assert.are_same(tbl.head, head) - - tbl.head[1] = pandoc.Attr{'table-head'} - - local new_head = {'table-head', {}} - assert.are_equal( - pandoc.Table({long = {}}, {}, new_head, {}, {{}, {}}), - tbl - ) + test('pandoc.Div is a function', function () + assert.are_equal(type(pandoc.Div), 'function') end), - test('access table head via property `head`', function () - local foot = {{id = 'tbl-foot'}, {}} - local tbl = pandoc.Table({long = {}}, {}, {{}, {}}, {}, foot) - assert.are_same(tbl.foot, {pandoc.Attr('tbl-foot'), {}}) - - tbl.foot[1] = pandoc.Attr{'table-foot'} - - local new_foot = {'table-foot', {}} - assert.are_equal( - pandoc.Table({long = {}}, {}, {{}, {}}, {}, new_foot), - tbl - ) - end) - }, + test('pandoc.Header is a function', function () + assert.are_equal(type(pandoc.Header), 'function') + end), + test('pandoc.LineBlock is a function', function () + assert.are_equal(type(pandoc.LineBlock), 'function') + end), + test('pandoc.Null is a function', function () + assert.are_equal(type(pandoc.Null), 'function') + end), + test('pandoc.OrderedList is a function', function () + assert.are_equal(type(pandoc.OrderedList), 'function') + end), + test('pandoc.Para is a function', function () + assert.are_equal(type(pandoc.Para), 'function') + end), + test('pandoc.Plain is a function', function () + assert.are_equal(type(pandoc.Plain), 'function') + end), + test('pandoc.RawBlock is a function', function () + assert.are_equal(type(pandoc.Plain), 'function') + end), + test('pandoc.Table is a function', function () + assert.are_equal(type(pandoc.Table), 'function') + end), + } }, group 'MetaValue elements' { test('MetaList elements behave like lists', function () @@ -724,12 +133,6 @@ return { assert.are_equal(type(metalist.insert), 'function') assert.are_equal(type(metalist.remove), 'function') end), - test('MetaList, MetaMap, MetaInlines, MetaBlocks have `t` tag', function () - assert.are_equal((pandoc.MetaList{}).t, 'MetaList') - assert.are_equal((pandoc.MetaMap{}).t, 'MetaMap') - assert.are_equal((pandoc.MetaInlines{}).t, 'MetaInlines') - assert.are_equal((pandoc.MetaBlocks{}).t, 'MetaBlocks') - end), test('`tag` is an alias for `t``', function () assert.are_equal((pandoc.MetaList{}).tag, (pandoc.MetaList{}).t) assert.are_equal((pandoc.MetaMap{}).tag, (pandoc.MetaMap{}).t) @@ -756,81 +159,6 @@ return { end), }, group 'Other types' { - group 'Citation' { - test('checks equality by comparing Haskell values', function() - assert.are_equal( - pandoc.Citation('a', pandoc.NormalCitation), - pandoc.Citation('a', pandoc.NormalCitation) - ) - assert.is_falsy( - pandoc.Citation('a', pandoc.NormalCitation) == - pandoc.Citation('a', pandoc.AuthorInText) - ) - assert.is_falsy( - pandoc.Citation('a', pandoc.NormalCitation) == - pandoc.Citation('b', pandoc.NormalCitation) - ) - end), - }, - group 'SimpleTable' { - test('can access properties', function () - local spc = pandoc.Space() - local caption = {pandoc.Str 'Languages', spc, pandoc.Str 'overview.'} - local aligns = {pandoc.AlignDefault, pandoc.AlignDefault} - local widths = {0, 0} -- let pandoc determine col widths - local headers = {{pandoc.Plain({pandoc.Str "Language"})}, - {pandoc.Plain({pandoc.Str "Typing"})}} - local rows = { - {{pandoc.Plain "Haskell"}, {pandoc.Plain "static"}}, - {{pandoc.Plain "Lua"}, {pandoc.Plain "Dynamic"}}, - } - local simple_table = pandoc.SimpleTable( - caption, - aligns, - widths, - headers, - rows - ) - assert.are_same(simple_table.caption, caption) - assert.are_same(simple_table.aligns, aligns) - assert.are_same(simple_table.widths, widths) - assert.are_same(simple_table.headers, headers) - assert.are_same(simple_table.rows, rows) - end), - test('can modify properties', function () - local new_table = pandoc.SimpleTable( - {'Languages'}, - {pandoc.AlignDefault, pandoc.AlignDefault}, - {0.5, 0.5}, - {{pandoc.Plain({pandoc.Str "Language"})}, - {pandoc.Plain({pandoc.Str "Typing"})}}, - { - {{pandoc.Plain "Haskell"}, {pandoc.Plain "static"}}, - {{pandoc.Plain "Lua"}, {pandoc.Plain "Dynamic"}}, - } - ) - - new_table.caption = {pandoc.Str 'Good', pandoc.Space(), - pandoc.Str 'languages'} - new_table.aligns[1] = pandoc.AlignLeft - new_table.widths = {0, 0} - new_table.headers[2] = {pandoc.Plain{pandoc.Str 'compiled/interpreted'}} - new_table.rows[1][2] = {pandoc.Plain{pandoc.Str 'both'}} - new_table.rows[2][2] = {pandoc.Plain{pandoc.Str 'interpreted'}} - - local expected_table = pandoc.SimpleTable( - {pandoc.Str 'Good', pandoc.Space(), pandoc.Str 'languages'}, - {pandoc.AlignLeft, pandoc.AlignDefault}, - {0, 0}, - {{pandoc.Plain 'Language'}, {pandoc.Plain 'compiled/interpreted'}}, - { - {{pandoc.Plain 'Haskell'}, {pandoc.Plain 'both'}}, - {{pandoc.Plain 'Lua'}, {pandoc.Plain 'interpreted'}} - } - ) - assert.are_same(expected_table, new_table) - end) - }, group 'ReaderOptions' { test('returns a userdata value', function () local opts = pandoc.ReaderOptions {} |