aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Text/Pandoc/Lua/StackInstances.hs83
-rw-r--r--test/Tests/Lua.hs10
2 files changed, 56 insertions, 37 deletions
diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs
index 601868095..07ca06798 100644
--- a/src/Text/Pandoc/Lua/StackInstances.hs
+++ b/src/Text/Pandoc/Lua/StackInstances.hs
@@ -38,7 +38,7 @@ module Text.Pandoc.Lua.StackInstances () where
import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON )
import Scripting.Lua ( LuaState, StackValue(..), newtable, pop, rawget, rawset )
import Scripting.Lua.Aeson ()
-import Text.Pandoc.Definition ( Block(..), Inline(..), Pandoc(..) )
+import Text.Pandoc.Definition ( Block(..), Inline(..), Meta(..), Pandoc(..) )
import qualified Scripting.Lua as Lua
import qualified Text.Pandoc.UTF8 as UTF8
@@ -49,19 +49,30 @@ maybeFromJson mv = fromJSON <$> mv >>= \case
_ -> Nothing
instance StackValue Pandoc where
- push lua = Lua.push lua . toJSON
- peek lua i = maybeFromJson <$> peek lua i
+ push lua (Pandoc meta blocks) = do
+ newtable lua
+ setField lua (-1) "blocks" blocks
+ setField lua (-1) "meta" meta
+ peek lua idx = do
+ blocks <- getField lua idx "blocks"
+ meta <- getField lua idx "meta"
+ return $ Pandoc <$> meta <*> blocks
+ valuetype _ = Lua.TTABLE
+
+instance StackValue Meta where
+ push lua = push lua . toJSON
+ peek lua = fmap maybeFromJson . peek lua
valuetype _ = Lua.TTABLE
instance StackValue Block where
push lua = \case
- BlockQuote blcks -> pushTagged lua "BlockQuote" blcks
- BulletList items -> pushTagged lua "BulletList" items
+ BlockQuote blcks -> pushTagged lua "BlockQuote" blcks
+ BulletList items -> pushTagged lua "BulletList" items
HorizontalRule -> pushTagged' lua "HorizontalRule"
- LineBlock blcks -> pushTagged lua "LineBlock" blcks
+ LineBlock blcks -> pushTagged lua "LineBlock" blcks
Null -> pushTagged' lua "Null"
- Para blcks -> pushTagged lua "Para" blcks
- Plain blcks -> pushTagged lua "Plain" blcks
+ Para blcks -> pushTagged lua "Para" blcks
+ Plain blcks -> pushTagged lua "Plain" blcks
-- fall back to conversion via aeson's Value
x -> push lua (toJSON x)
peek lua i = peekBlock lua i
@@ -69,17 +80,17 @@ instance StackValue Block where
instance StackValue Inline where
push lua = \case
- Emph inlns -> pushTagged lua "Emph" inlns
+ Emph inlns -> pushTagged lua "Emph" inlns
LineBreak -> pushTagged' lua "LineBreak"
- Note blcks -> pushTagged lua "Note" blcks
- SmallCaps inlns -> pushTagged lua "SmallCaps" inlns
+ Note blcks -> pushTagged lua "Note" blcks
+ SmallCaps inlns -> pushTagged lua "SmallCaps" inlns
SoftBreak -> pushTagged' lua "SoftBreak"
Space -> pushTagged' lua "Space"
- Str s -> pushTagged lua "Str" s
- Strikeout inlns -> pushTagged lua "Strikeout" inlns
- Strong inlns -> pushTagged lua "Strong" inlns
- Subscript inlns -> pushTagged lua "Subscript" inlns
- Superscript inlns -> pushTagged lua "Superscript" inlns
+ Str s -> pushTagged lua "Str" s
+ Strikeout inlns -> pushTagged lua "Strikeout" inlns
+ Strong inlns -> pushTagged lua "Strong" inlns
+ Subscript inlns -> pushTagged lua "Subscript" inlns
+ Superscript inlns -> pushTagged lua "Superscript" inlns
x -> push lua (toJSON x)
peek = peekInline
valuetype _ = Lua.TTABLE
@@ -99,12 +110,8 @@ instance StackValue [Char] where
pushTagged :: StackValue a => LuaState -> String -> a -> IO ()
pushTagged lua tag value = do
newtable lua
- push lua "t"
- push lua tag
- rawset lua (-3)
- push lua "c"
- push lua value
- rawset lua (-3)
+ setField lua (-1) "t" tag
+ setField lua (-1) "c" value
pushTagged' :: LuaState -> String -> IO ()
pushTagged' lua tag = do
@@ -116,9 +123,7 @@ pushTagged' lua tag = do
-- | Return the value at the given index as inline if possible.
peekInline :: LuaState -> Int -> IO (Maybe Inline)
peekInline lua idx = do
- push lua "t"
- rawget lua (idx `adjustIndexBy` 1)
- tag <- peek lua (-1) <* pop lua 1
+ tag <- getField lua idx "t"
case tag of
Nothing -> return Nothing
Just t -> case t of
@@ -138,17 +143,12 @@ peekInline lua idx = do
where
-- Get the contents of an AST element.
elementContent :: StackValue a => IO (Maybe a)
- elementContent = do
- push lua "c"
- rawget lua (idx `adjustIndexBy` 1)
- peek lua (-1) <* pop lua 1
+ elementContent = getField lua idx "c"
-- | Return the value at the given index as block if possible.
peekBlock :: LuaState -> Int -> IO (Maybe Block)
peekBlock lua idx = do
- push lua "t"
- rawget lua (idx `adjustIndexBy` 1)
- tag <- peek lua (-1) <* pop lua 1
+ tag <- getField lua idx "t"
case tag of
Nothing -> return Nothing
Just t -> case t of
@@ -164,10 +164,7 @@ peekBlock lua idx = do
where
-- Get the contents of an AST element.
elementContent :: StackValue a => IO (Maybe a)
- elementContent = do
- push lua "c"
- rawget lua (idx `adjustIndexBy` 1)
- peek lua (-1) <* pop lua 1
+ elementContent = getField lua idx "c"
-- | Adjust the stack index, assuming that @n@ new elements have been pushed on
-- the stack.
@@ -176,3 +173,17 @@ adjustIndexBy idx n =
if idx < 0
then idx - n
else idx
+
+-- | Get value behind key from table at given index.
+getField :: (StackValue a, StackValue b) => LuaState -> Int -> a -> IO (Maybe b)
+getField lua idx key = do
+ push lua key
+ rawget lua (idx `adjustIndexBy` 1)
+ peek lua (-1) <* pop lua 1
+
+-- | Set value for key for table at the given index
+setField :: (StackValue a, StackValue b) => LuaState -> Int -> a -> b -> IO ()
+setField lua idx key value = do
+ push lua key
+ push lua value
+ rawset lua (idx `adjustIndexBy` 2)
diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs
index f01784663..64c35b298 100644
--- a/test/Tests/Lua.hs
+++ b/test/Tests/Lua.hs
@@ -7,7 +7,9 @@ import Test.Tasty (TestTree)
import Test.Tasty.HUnit (Assertion, assertEqual, testCase)
import Test.Tasty.QuickCheck (ioProperty, testProperty)
import Text.Pandoc.Arbitrary ()
-import Text.Pandoc.Builder
+import Text.Pandoc.Definition (Block, Inline, Meta, Pandoc)
+import Text.Pandoc.Builder ( (<>), bulletList, doc, emph, linebreak, rawBlock
+ , para, plain, space, str, strong)
import Text.Pandoc.Lua
import qualified Scripting.Lua as Lua
@@ -43,6 +45,12 @@ tests =
, testProperty "block elements can be round-tripped through the lua stack" $
\x -> ioProperty (roundtripEqual (x::Block))
+
+ , testProperty "meta blocks can be round-tripped through the lua stack" $
+ \x -> ioProperty (roundtripEqual (x::Meta))
+
+ , testProperty "documents can be round-tripped through the lua stack" $
+ \x -> ioProperty (roundtripEqual (x::Pandoc))
]
assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-03 20:07:19 +0000