aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/AST.hs33
-rw-r--r--src/Text/Pandoc/Lua/Module/Pandoc.hs14
2 files changed, 36 insertions, 11 deletions
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