diff options
Diffstat (limited to 'src/Text/Pandoc/Lua')
-rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/AST.hs | 33 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Module/Pandoc.hs | 14 |
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 |