diff options
| -rw-r--r-- | data/pandoc.lua | 20 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/AST.hs | 33 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Module/Pandoc.hs | 14 | ||||
| -rw-r--r-- | test/Tests/Lua.hs | 2 |
4 files changed, 37 insertions, 32 deletions
diff --git a/data/pandoc.lua b/data/pandoc.lua index 35ca20a84..173c8c179 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -311,26 +311,6 @@ local function ensureAttr(attr) 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 -- @section Meta diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index eedf00a94..6f97bdd36 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -40,7 +40,7 @@ import Control.Monad ((<$!>), (>=>)) import HsLua hiding (Operation (Div)) import Text.Pandoc.Definition 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 Text.Pandoc.Lua.Util as LuaUtil @@ -49,19 +49,32 @@ instance Pushable Pandoc where push = pushPandoc pushPandoc :: LuaError e => Pusher e Pandoc -pushPandoc (Pandoc meta blocks) = - pushViaConstr' "Pandoc" [pushList pushBlock blocks, push meta] +pushPandoc = pushUD typePandoc peekPandoc :: LuaError e => Peeker e Pandoc -peekPandoc = fmap (retrieving "Pandoc value") - . typeChecked "table" Lua.istable $ \idx -> do - meta <- peekFieldRaw peekMeta "meta" idx - blks <- peekFieldRaw peekBlocks "blocks" idx - return $ Pandoc meta blks +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" + ] + [ 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 (Meta mmap) = - pushViaConstr' "Meta" [push mmap] + 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" $ diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index 0a9ebaec5..84d6be360 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -15,6 +15,7 @@ module Text.Pandoc.Lua.Module.Pandoc ) where import Prelude hiding (read) +import Control.Applicative (optional) import Control.Monad ((>=>), when) import Control.Monad.Except (throwError) import Data.Default (Default (..)) @@ -23,7 +24,7 @@ import HsLua as Lua hiding (pushModule) import HsLua.Class.Peekable (PeekError) import System.Exit (ExitCode (..)) import Text.Pandoc.Class.PandocIO (runIO) -import Text.Pandoc.Definition (Block, Inline) +import Text.Pandoc.Definition import Text.Pandoc.Lua.Filter (SingletonsList (..), walkInlines, walkInlineLists, walkBlocks, walkBlockLists) import Text.Pandoc.Lua.Marshaling () @@ -51,6 +52,8 @@ pushModule = do addFunction "pipe" pipe addFunction "walk_block" (walkElement peekBlock pushBlock) addFunction "walk_inline" (walkElement peekInline pushInline) + -- Constructors + addFunction "Pandoc" mkPandoc return 1 walkElement :: (Walkable (SingletonsList Inline) a, @@ -142,3 +145,12 @@ pushPipeError pipeErr = do , if output == mempty then BSL.pack "<no output>" else output ] 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 diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs index e19f6f9e8..5538915a7 100644 --- a/test/Tests/Lua.hs +++ b/test/Tests/Lua.hs @@ -217,7 +217,7 @@ tests = map (localOption (QuickCheckTests 20)) eitherPandoc <- Catch.try (peek @Pandoc Lua.top) case eitherPandoc of Left (PandocLuaError msg) -> do - let expectedMsg = "table expected, got boolean\n" + let expectedMsg = "Pandoc expected, got boolean\n" <> "\twhile retrieving Pandoc value" Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg Left e -> error ("Expected a Lua error, but got " <> show e) |