Lua: marshal Pandoc values as userdata
This commit is contained in:
parent
9e74826ba9
commit
e4287e6c95
4 changed files with 37 additions and 32 deletions
|
@ -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
|
||||||
|
|
|
@ -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" $
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Add table
Reference in a new issue