Lua filter: use custom StackValue Inline instance

Inline elements are no longer pushed and pulled via aeson's Value.

3 files changed, 156 insertions, 31 deletions

diff --git a/data/pandoc.lua b/data/pandoc.lua
index 79729fc35..d705b8566 100644
--- a/data/pandoc.lua
+++ b/data/pandoc.lua
@@ -83,18 +83,14 @@ M.block_types = {
 M.inline_types = {
   "Cite",
   "Code",
-  "DisplayMath",
-  "DoubleQuoted",
   "Emph",
   "Image",
-  "InlineMath",
   "LineBreak",
   "Link",
   "Math",
   "Note",
   "Quoted",
   "RawInline",
-  "SingleQuoted",
   "SmallCaps",
   "SoftBreak",
   "Space",
diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs
index a68810bd7..d7c54b6af 100644
--- a/src/Text/Pandoc/Lua.hs
+++ b/src/Text/Pandoc/Lua.hs
@@ -170,9 +170,11 @@ runLuaFilterFunction lua lf inline = do
   pushFilterFunction lua lf
   Lua.push lua inline
   Lua.call lua 1 1
-  Just res <- Lua.peek lua (-1)
-  Lua.pop lua 1
-  return res
+  mbres <- Lua.peek lua (-1)
+  case mbres of
+    Nothing -> error $ "Error while trying to get a filter's return "
+               ++ "value from lua stack."
+    Just res -> res <$ Lua.pop lua 1
 
 -- | Push the filter function to the top of the stack.
 pushFilterFunction :: Lua.LuaState -> LuaFilterFunction a -> IO ()
diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs
index 07ca06798..690557788 100644
--- a/src/Text/Pandoc/Lua/StackInstances.hs
+++ b/src/Text/Pandoc/Lua/StackInstances.hs
@@ -36,11 +36,15 @@ StackValue instances for pandoc types.
 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
+  ( LTYPE(..), LuaState, StackValue(..)
+  , gettable, newtable, pop, rawgeti, rawset, rawseti, settable
+  )
 import Scripting.Lua.Aeson ()
-import Text.Pandoc.Definition ( Block(..), Inline(..), Meta(..), Pandoc(..) )
+import Text.Pandoc.Definition
+  ( Block(..), Inline(..), Meta(..), Pandoc(..)
+  , Citation(..), CitationMode(..), Format(..), MathType(..), QuoteType(..) )
 
-import qualified Scripting.Lua as Lua
 import qualified Text.Pandoc.UTF8 as UTF8
 
 maybeFromJson :: (FromJSON a) => Maybe Value -> Maybe a
@@ -57,12 +61,12 @@ instance StackValue Pandoc where
     blocks <- getField lua idx "blocks"
     meta   <- getField lua idx "meta"
     return $ Pandoc <$> meta <*> blocks
-  valuetype _ = Lua.TTABLE
+  valuetype _ = TTABLE
 
 instance StackValue Meta where
   push lua = push lua . toJSON
   peek lua = fmap maybeFromJson . peek lua
-  valuetype _ = Lua.TTABLE
+  valuetype _ = TTABLE
 
 instance StackValue Block where
   push lua = \case
@@ -76,24 +80,99 @@ instance StackValue Block where
     -- fall back to conversion via aeson's Value
     x                 -> push lua (toJSON x)
   peek lua i = peekBlock lua i
-  valuetype _ = Lua.TTABLE
+  valuetype _ = TTABLE
 
 instance StackValue Inline where
   push lua = \case
-    Emph inlns        -> pushTagged  lua "Emph" inlns
-    LineBreak         -> pushTagged' lua "LineBreak"
-    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
-    x                 -> push lua (toJSON x)
+    Cite citations lst -> pushTagged  lua "Cite" (citations, lst)
+    Code attr lst      -> pushTagged  lua "Code" (attr, lst)
+    Emph inlns         -> pushTagged  lua "Emph" inlns
+    Image attr lst tgt -> pushTagged  lua "Image" (attr, lst, tgt)
+    LineBreak          -> pushTagged' lua "LineBreak"
+    Link attr lst tgt  -> pushTagged  lua "Link" (attr, lst, tgt)
+    Note blcks         -> pushTagged  lua "Note" blcks
+    Math mty str       -> pushTagged  lua "Math" (mty, str)
+    Quoted qt inlns    -> pushTagged  lua "Quoted" (qt, inlns)
+    RawInline f cs     -> pushTagged  lua "RawInline" (f, cs)
+    SmallCaps inlns    -> pushTagged  lua "SmallCaps" inlns
+    SoftBreak          -> pushTagged' lua "SoftBreak"
+    Space              -> pushTagged' lua "Space"
+    Span attr inlns    -> pushTagged  lua "Span" (attr, inlns)
+    Str str            -> pushTagged  lua "Str" str
+    Strikeout inlns    -> pushTagged  lua "Strikeout" inlns
+    Strong inlns       -> pushTagged  lua "Strong" inlns
+    Subscript inlns    -> pushTagged  lua "Subscript" inlns
+    Superscript inlns  -> pushTagged  lua "Superscript" inlns
   peek = peekInline
-  valuetype _ = Lua.TTABLE
+  valuetype _ = TTABLE
+
+instance StackValue Citation where
+  push lua c = do
+    newtable lua
+    setField lua (-1) "citationId" (citationId c)
+    setField lua (-1) "citationPrefix" (citationPrefix c)
+    setField lua (-1) "citationSuffix" (citationSuffix c)
+    setField lua (-1) "citationMode" (citationMode c)
+    setField lua (-1) "citationNoteNum" (citationNoteNum c)
+    setField lua (-1) "citationHash" (citationHash c)
+  peek lua idx = do
+    id' <- getField lua idx "citationId"
+    prefix <- getField lua idx "citationPrefix"
+    suffix <- getField lua idx "citationSuffix"
+    mode <- getField lua idx "citationMode"
+    num <- getField lua idx "citationNoteNum"
+    hash <- getField lua idx "citationHash"
+    return $ Citation
+      <$> id'
+      <*> prefix
+      <*> suffix
+      <*> mode
+      <*> num
+      <*> hash
+  valuetype _ = TTABLE
+
+instance StackValue CitationMode where
+  push lua = \case
+    AuthorInText   -> pushTagged' lua "AuthorInText"
+    NormalCitation -> pushTagged' lua "NormalCitation"
+    SuppressAuthor -> pushTagged' lua "SuppressAuthor"
+  peek lua idx = do
+    tag <- getField lua idx "t"
+    case tag of
+      Just "AuthorInText"   -> return $ Just AuthorInText
+      Just "NormalCitation" -> return $ Just NormalCitation
+      Just "SuppressAuthor" -> return $ Just SuppressAuthor
+      _ -> return Nothing
+  valuetype _ = TSTRING
+
+instance StackValue Format where
+  push lua (Format f) = push lua f
+  peek lua idx = fmap Format <$> peek lua idx
+  valuetype _ = TSTRING
+
+instance StackValue MathType where
+  push lua = \case
+    InlineMath -> pushTagged' lua "InlineMath"
+    DisplayMath -> pushTagged' lua "DisplayMath"
+  peek lua idx = do
+    res <- getField lua idx "t"
+    case res of
+      Just "InlineMath" -> return $ Just InlineMath
+      Just "DisplayMath" -> return $ Just DisplayMath
+      _ -> return Nothing
+  valuetype _ = TTABLE
+
+instance StackValue QuoteType where
+  push lua = \case
+    SingleQuote -> pushTagged' lua "SingleQuote"
+    DoubleQuote -> pushTagged' lua "DoubleQuote"
+  peek lua idx = do
+    res <- getField lua idx "t"
+    case res of
+      Just "SingleQuote" -> return $ Just SingleQuote
+      Just "DoubleQuote" -> return $ Just DoubleQuote
+      _ -> return Nothing
+  valuetype _ = TTABLE
 
 #if MIN_VERSION_base(4,8,0)
 instance {-# OVERLAPS #-} StackValue [Char] where
@@ -102,7 +181,33 @@ instance StackValue [Char] where
 #endif
   push lua cs = push lua (UTF8.fromString cs)
   peek lua i = fmap UTF8.toString <$> peek lua i
-  valuetype _ = Lua.TSTRING
+  valuetype _ = TSTRING
+
+instance (StackValue a, StackValue b) => StackValue (a, b) where
+  push lua (a, b) = do
+    newtable lua
+    setIntField lua (-1) 1 a
+    setIntField lua (-1) 2 b
+  peek lua idx = do
+    a <- getIntField lua idx 1
+    b <- getIntField lua idx 2
+    return $ (,) <$> a <*> b
+  valuetype _ = TTABLE
+
+instance (StackValue a, StackValue b, StackValue c) =>
+         StackValue (a, b, c)
+ where
+  push lua (a, b, c) = do
+    newtable lua
+    setIntField lua (-1) 1 a
+    setIntField lua (-1) 2 b
+    setIntField lua (-1) 3 c
+  peek lua idx = do
+    a <- getIntField lua idx 1
+    b <- getIntField lua idx 2
+    c <- getIntField lua idx 3
+    return $ (,,) <$> a <*> b <*> c
+  valuetype _ = TTABLE
 
 -- | Push a value to the lua stack, tagged with a given string. This currently
 -- creates a structure equivalent to what the JSONified value would look like
@@ -127,19 +232,28 @@ peekInline lua idx = do
   case tag of
     Nothing -> return Nothing
     Just t -> case t of
+      "Cite"       -> fmap (uncurry Cite) <$> elementContent
+      "Code"       -> fmap (uncurry Code) <$> elementContent
       "Emph"       -> fmap Emph <$> elementContent
+      "Image"      -> fmap (\(attr, lst, tgt) -> Image attr lst tgt)
+                      <$> elementContent
+      "Link"       -> fmap (\(attr, lst, tgt) -> Link attr lst tgt)
+                      <$> elementContent
       "LineBreak"  -> return (Just LineBreak)
       "Note"       -> fmap Note <$> elementContent
+      "Math"       -> fmap (uncurry Math) <$> elementContent
+      "Quoted"     -> fmap (uncurry Quoted) <$> elementContent
+      "RawInline"  -> fmap (uncurry RawInline) <$> elementContent
       "SmallCaps"  -> fmap SmallCaps <$> elementContent
       "SoftBreak"  -> return (Just SoftBreak)
       "Space"      -> return (Just Space)
+      "Span"       -> fmap (uncurry Span) <$> elementContent
       "Str"        -> fmap Str <$> elementContent
       "Strikeout"  -> fmap Strikeout <$> elementContent
       "Strong"     -> fmap Strong <$> elementContent
       "Subscript"  -> fmap Subscript <$> elementContent
       "Superscript"-> fmap Superscript <$> elementContent
-      -- fall back to construction via aeson's Value
-      _ -> maybeFromJson <$> peek lua idx
+      _ -> return Nothing
  where
    -- Get the contents of an AST element.
    elementContent :: StackValue a => IO (Maybe a)
@@ -178,7 +292,7 @@ adjustIndexBy idx n =
 getField :: (StackValue a, StackValue b) => LuaState -> Int -> a -> IO (Maybe b)
 getField lua idx key = do
   push lua key
-  rawget lua (idx `adjustIndexBy` 1)
+  gettable lua (idx `adjustIndexBy` 1)
   peek lua (-1) <* pop lua 1
 
 -- | Set value for key for table at the given index
@@ -186,4 +300,17 @@ 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)
+  settable lua (idx `adjustIndexBy` 2)
+
+-- | Get value behind key from table at given index.
+getIntField :: StackValue a => LuaState -> Int -> Int -> IO (Maybe a)
+getIntField lua idx key =
+  rawgeti lua idx key
+  *> peek lua (-1)
+  <* pop lua 1
+
+-- | Set numeric key/value in table at the given index
+setIntField :: StackValue a => LuaState -> Int -> Int -> a -> IO ()
+setIntField lua idx key value = do
+  push lua value
+  rawseti lua (idx `adjustIndexBy` 1) key