Lua: marshal Pandoc values as userdata

This commit is contained in:
Albert Krewinkel 2021-10-20 21:40:07 +02:00 committed by John MacFarlane
parent 9e74826ba9
commit e4287e6c95
4 changed files with 37 additions and 32 deletions

View file

@ -310,26 +310,6 @@ local function ensureAttr(attr)
error('Could not convert to Attr') error('Could not convert to Attr')
end end
------------------------------------------------------------------------
--- Pandoc Document
-- @section document
--- A complete pandoc document
-- @function Pandoc
-- @tparam {Block,...} blocks document content
-- @tparam[opt] Meta meta document meta data
M.Pandoc = AstElement:make_subtype'Pandoc'
M.Pandoc.behavior.clone = M.types.clone.Pandoc
function M.Pandoc:new (blocks, meta)
return {
blocks = ensureList(blocks),
meta = meta or {},
}
end
-- DEPRECATED synonym:
M.Doc = M.Pandoc
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- Meta -- Meta
-- @section Meta -- @section Meta

View file

@ -40,7 +40,7 @@ import Control.Monad ((<$!>), (>=>))
import HsLua hiding (Operation (Div)) import HsLua hiding (Operation (Div))
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Lua.Util (pushViaConstr', pushViaConstructor) import Text.Pandoc.Lua.Util (pushViaConstr', pushViaConstructor)
import Text.Pandoc.Lua.Marshaling.CommonState () import Text.Pandoc.Lua.Marshaling.List (pushPandocList)
import qualified HsLua as Lua import qualified HsLua as Lua
import qualified Text.Pandoc.Lua.Util as LuaUtil import qualified Text.Pandoc.Lua.Util as LuaUtil
@ -49,19 +49,32 @@ instance Pushable Pandoc where
push = pushPandoc push = pushPandoc
pushPandoc :: LuaError e => Pusher e Pandoc pushPandoc :: LuaError e => Pusher e Pandoc
pushPandoc (Pandoc meta blocks) = pushPandoc = pushUD typePandoc
pushViaConstr' "Pandoc" [pushList pushBlock blocks, push meta]
peekPandoc :: LuaError e => Peeker e Pandoc peekPandoc :: LuaError e => Peeker e Pandoc
peekPandoc = fmap (retrieving "Pandoc value") peekPandoc = retrieving "Pandoc value" . peekUD typePandoc
. typeChecked "table" Lua.istable $ \idx -> do
meta <- peekFieldRaw peekMeta "meta" idx typePandoc :: LuaError e => DocumentedType e Pandoc
blks <- peekFieldRaw peekBlocks "blocks" idx typePandoc = deftype "Pandoc"
return $ Pandoc meta blks [ 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"
]
[ 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 instance Pushable Meta where
push (Meta mmap) = push = pushMeta
pushViaConstr' "Meta" [push mmap]
pushMeta :: LuaError e => Pusher e Meta
pushMeta (Meta mmap) = pushViaConstr' "Meta" [push mmap]
peekMeta :: LuaError e => Peeker e Meta peekMeta :: LuaError e => Peeker e Meta
peekMeta idx = retrieving "Meta" $ peekMeta idx = retrieving "Meta" $

View file

@ -15,6 +15,7 @@ module Text.Pandoc.Lua.Module.Pandoc
) where ) where
import Prelude hiding (read) import Prelude hiding (read)
import Control.Applicative (optional)
import Control.Monad ((>=>), when) import Control.Monad ((>=>), when)
import Control.Monad.Except (throwError) import Control.Monad.Except (throwError)
import Data.Default (Default (..)) import Data.Default (Default (..))
@ -23,7 +24,7 @@ import HsLua as Lua hiding (pushModule)
import HsLua.Class.Peekable (PeekError) import HsLua.Class.Peekable (PeekError)
import System.Exit (ExitCode (..)) import System.Exit (ExitCode (..))
import Text.Pandoc.Class.PandocIO (runIO) import Text.Pandoc.Class.PandocIO (runIO)
import Text.Pandoc.Definition (Block, Inline) import Text.Pandoc.Definition
import Text.Pandoc.Lua.Filter (SingletonsList (..), walkInlines, import Text.Pandoc.Lua.Filter (SingletonsList (..), walkInlines,
walkInlineLists, walkBlocks, walkBlockLists) walkInlineLists, walkBlocks, walkBlockLists)
import Text.Pandoc.Lua.Marshaling () import Text.Pandoc.Lua.Marshaling ()
@ -51,6 +52,8 @@ pushModule = do
addFunction "pipe" pipe addFunction "pipe" pipe
addFunction "walk_block" (walkElement peekBlock pushBlock) addFunction "walk_block" (walkElement peekBlock pushBlock)
addFunction "walk_inline" (walkElement peekInline pushInline) addFunction "walk_inline" (walkElement peekInline pushInline)
-- Constructors
addFunction "Pandoc" mkPandoc
return 1 return 1
walkElement :: (Walkable (SingletonsList Inline) a, walkElement :: (Walkable (SingletonsList Inline) a,
@ -142,3 +145,12 @@ pushPipeError pipeErr = do
, if output == mempty then BSL.pack "<no output>" else output , if output == mempty then BSL.pack "<no output>" else output
] ]
return (NumResults 1) return (NumResults 1)
mkPandoc :: PandocLua NumResults
mkPandoc = liftPandocLua $ do
doc <- forcePeek $ do
blks <- peekBlocks (nthBottom 1)
mMeta <- optional $ peekMeta (nthBottom 2)
pure $ Pandoc (fromMaybe nullMeta mMeta) blks
pushPandoc doc
return 1

View file

@ -217,7 +217,7 @@ tests = map (localOption (QuickCheckTests 20))
eitherPandoc <- Catch.try (peek @Pandoc Lua.top) eitherPandoc <- Catch.try (peek @Pandoc Lua.top)
case eitherPandoc of case eitherPandoc of
Left (PandocLuaError msg) -> do Left (PandocLuaError msg) -> do
let expectedMsg = "table expected, got boolean\n" let expectedMsg = "Pandoc expected, got boolean\n"
<> "\twhile retrieving Pandoc value" <> "\twhile retrieving Pandoc value"
Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg
Left e -> error ("Expected a Lua error, but got " <> show e) Left e -> error ("Expected a Lua error, but got " <> show e)