Merge pull request #3569 from tarleb/lua-destructured-filter-functions

Destructuring lua filter functions

2 files changed, 362 insertions, 164 deletions

diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs
index d7c54b6af..9903d4df6 100644
--- a/src/Text/Pandoc/Lua.hs
+++ b/src/Text/Pandoc/Lua.hs
@@ -15,6 +15,9 @@ You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 -}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {- |
    Module      : Text.Pandoc.Lua
@@ -26,27 +29,24 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
 Pandoc lua utils.
 -}
-module Text.Pandoc.Lua ( runLuaFilter ) where
+module Text.Pandoc.Lua ( runLuaFilter, pushPandocModule ) where
 
 import Control.Monad ( (>=>), when )
 import Control.Monad.Trans ( MonadIO(..) )
-import Data.HashMap.Lazy ( HashMap )
-import Data.Text ( Text, pack, unpack )
-import Data.Text.Encoding ( decodeUtf8 )
+import Data.Map ( Map )
 import Scripting.Lua ( LuaState, StackValue(..) )
-import Scripting.Lua.Aeson ( newstate )
 import Text.Pandoc.Definition ( Block(..), Inline(..), Pandoc(..) )
-import Text.Pandoc.Lua.PandocModule
+import Text.Pandoc.Lua.PandocModule ( pushPandocModule )
 import Text.Pandoc.Lua.StackInstances ()
 import Text.Pandoc.Walk
 
-import qualified Data.HashMap.Lazy as HashMap
+import qualified Data.Map as Map
 import qualified Scripting.Lua as Lua
 
 runLuaFilter :: (MonadIO m)
              => FilePath -> [String] -> Pandoc -> m Pandoc
 runLuaFilter filterPath args pd = liftIO $ do
-  lua <- newstate
+  lua <- Lua.newstate
   Lua.openlibs lua
   -- create table in registry to store filter functions
   Lua.push lua ("PANDOC_FILTER_FUNCTIONS"::String)
@@ -58,12 +58,12 @@ runLuaFilter filterPath args pd = liftIO $ do
   status <- Lua.loadfile lua filterPath
   if (status /= 0)
     then do
-      luaErrMsg <- unpack . decodeUtf8 <$> Lua.tostring lua 1
+      Just luaErrMsg <- Lua.peek lua 1
       error luaErrMsg
     else do
       Lua.call lua 0 1
       Just luaFilters <- Lua.peek lua (-1)
-      Lua.push lua (map pack args)
+      Lua.push lua args
       Lua.setglobal lua "PandocParameters"
       doc <- runAll luaFilters >=> luaFilter lua "filter_doc" $ pd
       Lua.close lua
@@ -86,73 +86,85 @@ walkMWithLuaFilter (LuaFilter lua inlineFnMap blockFnMap docFnMap) =
   walkM (execBlockLuaFilter  lua blockFnMap)  >=>
   walkM (execDocLuaFilter    lua docFnMap)
 
-type InlineFunctionMap = HashMap Text (LuaFilterFunction Inline)
-type BlockFunctionMap  = HashMap Text (LuaFilterFunction Block)
-type DocFunctionMap    = HashMap Text (LuaFilterFunction Pandoc)
+type InlineFunctionMap = Map String (LuaFilterFunction Inline)
+type BlockFunctionMap  = Map String (LuaFilterFunction Block)
+type DocFunctionMap    = Map String (LuaFilterFunction Pandoc)
 data LuaFilter =
   LuaFilter LuaState InlineFunctionMap BlockFunctionMap DocFunctionMap
 
 newtype LuaFilterFunction a = LuaFilterFunction { functionIndex :: Int }
 
 execDocLuaFilter :: LuaState
-                 -> HashMap Text (LuaFilterFunction Pandoc)
+                 -> Map String (LuaFilterFunction Pandoc)
                  -> Pandoc -> IO Pandoc
 execDocLuaFilter lua fnMap x = do
   let docFnName = "Doc"
-  case HashMap.lookup docFnName fnMap of
+  case Map.lookup docFnName fnMap of
     Nothing -> return x
     Just fn -> runLuaFilterFunction lua fn x
 
 execBlockLuaFilter :: LuaState
-                   -> HashMap Text (LuaFilterFunction Block)
+                   -> Map String (LuaFilterFunction Block)
                    -> Block -> IO Block
 execBlockLuaFilter lua fnMap x = do
-  let filterOrId constr = case HashMap.lookup constr fnMap of
-                            Nothing -> return x
-                            Just fn -> runLuaFilterFunction lua fn x
+  let runFn :: PushViaFilterFunction Block a => LuaFilterFunction Block -> a
+      runFn fn = runLuaFilterFunction lua fn
+  let tryFilter :: String -> (LuaFilterFunction Block -> IO Block) -> IO Block
+      tryFilter fnName callFilterFn =
+        case Map.lookup fnName fnMap of
+          Nothing -> return x
+          Just fn -> callFilterFn fn
   case x of
-    Plain _          -> filterOrId "Plain"
-    Para _           -> filterOrId "Para"
-    LineBlock _      -> filterOrId "LineBlock"
-    CodeBlock _ _    -> filterOrId "CodeBlock"
-    RawBlock _ _     -> filterOrId "RawBlock"
-    BlockQuote _     -> filterOrId "BlockQuote"
-    OrderedList _ _  -> filterOrId "OrderedList"
-    BulletList _     -> filterOrId "BulletList"
-    DefinitionList _ -> filterOrId "DefinitionList"
-    Header _ _ _     -> filterOrId "Header"
-    HorizontalRule   -> filterOrId "HorizontalRule"
-    Table _ _ _ _ _  -> filterOrId "Table"
-    Div _ _          -> filterOrId "Div"
-    Null             -> filterOrId "Null"
+    HorizontalRule             -> tryFilter "HorizontalRule" runFn
+    Null                       -> tryFilter "Null" runFn
+    BlockQuote blcks           -> tryFilter "BlockQuote" $ \fn -> runFn fn blcks
+    BulletList items           -> tryFilter "BulletList" $ \fn -> runFn fn items
+    CodeBlock attr code        -> tryFilter "CodeBlock" $ \fn -> runFn fn attr code
+    DefinitionList lst         -> tryFilter "DefinitionList" $ \fn -> runFn fn lst
+    Div attr content           -> tryFilter "Div" $ \fn -> runFn fn content attr
+    Header lvl attr inlns      -> tryFilter "Header" $ \fn -> runFn fn lvl inlns attr
+    LineBlock inlns            -> tryFilter "LineBlock" $ \fn -> runFn fn inlns
+    Para inlns                 -> tryFilter "Para" $ \fn -> runFn fn inlns
+    Plain inlns                -> tryFilter "Plain" $ \fn -> runFn fn inlns
+    RawBlock format str        -> tryFilter "RawBlock" $ \fn -> runFn fn format str
+    OrderedList (num,sty,delim) items ->
+      tryFilter "OrderedList" $ \fn -> runFn fn items (num,sty,delim)
+    Table capt aligns widths headers rows ->
+      tryFilter "Table" $ \fn -> runFn fn capt aligns widths headers rows
 
 execInlineLuaFilter :: LuaState
-                    -> HashMap Text (LuaFilterFunction Inline)
+                    -> Map String (LuaFilterFunction Inline)
                     -> Inline -> IO Inline
 execInlineLuaFilter lua fnMap x = do
-  let filterOrId constr = case HashMap.lookup constr fnMap of
-                            Nothing -> return x
-                            Just fn -> runLuaFilterFunction lua fn x
+  let runFn :: PushViaFilterFunction Inline a => LuaFilterFunction Inline -> a
+      runFn fn = runLuaFilterFunction lua fn
+  let tryFilter :: String -> (LuaFilterFunction Inline -> IO Inline) -> IO Inline
+      tryFilter fnName callFilterFn =
+        case Map.lookup fnName fnMap of
+          Nothing -> return x
+          Just fn -> callFilterFn fn
   case x of
-    Cite _ _      -> filterOrId "Cite"
-    Code _ _      -> filterOrId "Code"
-    Emph _        -> filterOrId "Emph"
-    Image _ _ _   -> filterOrId "Image"
-    LineBreak     -> filterOrId "LineBreak"
-    Link _ _ _    -> filterOrId "Link"
-    Math _ _      -> filterOrId "Math"
-    Note _        -> filterOrId "Note"
-    Quoted _ _    -> filterOrId "Quoted"
-    RawInline _ _ -> filterOrId "RawInline"
-    SmallCaps _   -> filterOrId "SmallCaps"
-    SoftBreak     -> filterOrId "SoftBreak"
-    Space         -> filterOrId "Space"
-    Span _ _      -> filterOrId "Span"
-    Str _         -> filterOrId "Str"
-    Strikeout _   -> filterOrId "Strikeout"
-    Strong _      -> filterOrId "Strong"
-    Subscript _   -> filterOrId "Subscript"
-    Superscript _ -> filterOrId "Superscript"
+    LineBreak                 -> tryFilter "LineBreak" runFn
+    SoftBreak                 -> tryFilter "SoftBreak" runFn
+    Space                     -> tryFilter "Space"     runFn
+    Cite cs lst               -> tryFilter "Cite"      $ \fn -> runFn fn lst cs
+    Code attr str             -> tryFilter "Code"      $ \fn -> runFn fn str attr
+    Emph lst                  -> tryFilter "Emph"      $ \fn -> runFn fn lst
+    Math mt lst               -> tryFilter "Math"      $ \fn -> runFn fn lst mt
+    Note blks                 -> tryFilter "Note"      $ \fn -> runFn fn blks
+    Quoted qt lst             -> tryFilter "Quoted"    $ \fn -> runFn fn qt lst
+    RawInline f str           -> tryFilter "RawInline" $ \fn -> runFn fn f str
+    SmallCaps lst             -> tryFilter "SmallCaps" $ \fn -> runFn fn lst
+    Span attr lst             -> tryFilter "Span"      $ \fn -> runFn fn lst attr
+    Str str                   -> tryFilter "Str"       $ \fn -> runFn fn str
+    Strikeout lst             -> tryFilter "Strikeout" $ \fn -> runFn fn lst
+    Strong lst                -> tryFilter "Strong"    $ \fn -> runFn fn lst
+    Subscript lst             -> tryFilter "Subscript" $ \fn -> runFn fn lst
+    Superscript lst           -> tryFilter "Superscript" $ \fn -> runFn fn lst
+    Link attr txt (src, tit)  -> tryFilter "Link" $
+                                 \fn -> runFn fn txt src tit attr
+    Image attr alt (src, tit) -> tryFilter "Image" $
+                                 \fn -> runFn fn alt src tit attr
 
 instance StackValue LuaFilter where
   valuetype _ = Lua.TTABLE
@@ -164,17 +176,33 @@ instance StackValue LuaFilter where
     docFnMap    <- Lua.peek lua i
     return $ LuaFilter lua <$> inlineFnMap <*> blockFnMap <*> docFnMap
 
-runLuaFilterFunction :: (StackValue a)
-                     => LuaState -> LuaFilterFunction a -> a -> IO a
-runLuaFilterFunction lua lf inline = do
-  pushFilterFunction lua lf
-  Lua.push lua inline
-  Lua.call lua 1 1
-  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
+-- | Helper class for pushing a single value to the stack via a lua function.
+-- See @pushViaCall@.
+class PushViaFilterFunction a b where
+  pushViaFilterFunction' :: LuaState -> LuaFilterFunction a -> IO () -> Int -> b
+
+instance (StackValue a) => PushViaFilterFunction a (IO a) where
+  pushViaFilterFunction' lua lf pushArgs num = do
+    pushFilterFunction lua lf
+    pushArgs
+    Lua.call lua num 1
+    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
+
+instance (PushViaFilterFunction a c, StackValue b) =>
+         PushViaFilterFunction a (b -> c) where
+  pushViaFilterFunction' lua lf pushArgs num x =
+    pushViaFilterFunction' lua lf (pushArgs *> push lua x) (num + 1)
+
+-- | Push an value to the stack via a lua filter function. The function is
+-- called with all arguments that are passed to this function and is expected to
+-- return a single value.
+runLuaFilterFunction :: (StackValue a, PushViaFilterFunction a b)
+                     => LuaState -> LuaFilterFunction a -> b
+runLuaFilterFunction lua lf = pushViaFilterFunction' lua lf (return ()) 0
 
 -- | 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 690557788..38f392527 100644
--- a/src/Text/Pandoc/Lua/StackInstances.hs
+++ b/src/Text/Pandoc/Lua/StackInstances.hs
@@ -35,28 +35,22 @@ StackValue instances for pandoc types.
 -}
 module Text.Pandoc.Lua.StackInstances () where
 
-import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON )
+import Control.Applicative ( (<|>) )
 import Scripting.Lua
   ( LTYPE(..), LuaState, StackValue(..)
-  , gettable, newtable, pop, rawgeti, rawset, rawseti, settable
+  , call, getglobal2, gettable, ltype, newtable, next, objlen
+  , pop, pushnil, rawgeti, rawseti, settable
   )
-import Scripting.Lua.Aeson ()
 import Text.Pandoc.Definition
-  ( Block(..), Inline(..), Meta(..), Pandoc(..)
-  , Citation(..), CitationMode(..), Format(..), MathType(..), QuoteType(..) )
 
+import qualified Data.Map as M
 import qualified Text.Pandoc.UTF8 as UTF8
 
-maybeFromJson :: (FromJSON a) => Maybe Value -> Maybe a
-maybeFromJson mv = fromJSON <$> mv >>= \case
-  Success x -> Just x
-  _         -> Nothing
-
 instance StackValue Pandoc where
   push lua (Pandoc meta blocks) = do
     newtable lua
-    setField lua (-1) "blocks" blocks
-    setField lua (-1) "meta"   meta
+    addKeyValue lua "blocks" blocks
+    addKeyValue lua "meta"   meta
   peek lua idx = do
     blocks <- getField lua idx "blocks"
     meta   <- getField lua idx "meta"
@@ -64,57 +58,122 @@ instance StackValue Pandoc where
   valuetype _ = TTABLE
 
 instance StackValue Meta where
-  push lua = push lua . toJSON
-  peek lua = fmap maybeFromJson . peek lua
+  push lua (Meta mmap) = push lua mmap
+  peek lua idx = fmap Meta <$> peek lua idx
   valuetype _ = TTABLE
 
+instance StackValue MetaValue where
+  push lua = \case
+    MetaBlocks blcks  -> pushViaConstructor lua "MetaBlocks" blcks
+    MetaBool b        -> pushViaConstructor lua "MetaBool" b
+    MetaInlines inlns -> pushViaConstructor lua "MetaInlines" inlns
+    MetaList metalist -> pushViaConstructor lua "MetaList" metalist
+    MetaMap metamap   -> pushViaConstructor lua "MetaMap" metamap
+    MetaString cs     -> pushViaConstructor lua "MetaString" cs
+  peek lua idx = do
+    luatype <- ltype lua idx
+    case luatype of
+      TBOOLEAN -> fmap MetaBool <$> peek lua idx
+      TSTRING  -> fmap MetaString <$> peek lua idx
+      TTABLE   -> do
+        tag <- push lua "t"
+               *> gettable lua (idx `adjustIndexBy` 1)
+               *> peek lua (-1)
+               <* pop lua 1
+        case tag of
+          Just "MetaBlocks"  -> fmap MetaBlocks  <$> peekContent lua idx
+          Just "MetaBool"    -> fmap MetaBool    <$> peekContent lua idx
+          Just "MetaMap"     -> fmap MetaMap     <$> peekContent lua idx
+          Just "MetaInlines" -> fmap MetaInlines <$> peekContent lua idx
+          Just "MetaList"    -> fmap MetaList    <$> peekContent lua idx
+          Just "MetaString"  -> fmap MetaString  <$> peekContent lua idx
+          Nothing -> do
+            len <- objlen lua idx
+            if len <= 0
+              then fmap MetaMap <$> peek lua idx
+              else  (fmap MetaInlines <$> peek lua idx)
+                    <|> (fmap MetaBlocks <$> peek lua idx)
+                    <|> (fmap MetaList <$> peek lua idx)
+          _        -> return Nothing
+      _        -> return Nothing
+  valuetype = \case
+    MetaBlocks _  -> TTABLE
+    MetaBool _    -> TBOOLEAN
+    MetaInlines _ -> TTABLE
+    MetaList _    -> TTABLE
+    MetaMap _     -> TTABLE
+    MetaString _  -> TSTRING
+
+peekContent :: StackValue a => LuaState -> Int -> IO (Maybe a)
+peekContent lua idx = do
+  push lua "c"
+  gettable lua (idx `adjustIndexBy` 1)
+  peek lua (-1) <* pop lua 1
+
 instance StackValue Block where
   push lua = \case
-    BlockQuote blcks  -> pushTagged  lua "BlockQuote" blcks
-    BulletList items  -> pushTagged  lua "BulletList" items
-    HorizontalRule    -> pushTagged' lua "HorizontalRule"
-    LineBlock blcks   -> pushTagged  lua "LineBlock" blcks
-    Null              -> pushTagged' lua "Null"
-    Para blcks        -> pushTagged  lua "Para" blcks
-    Plain blcks       -> pushTagged  lua "Plain" blcks
+    BlockQuote blcks         -> pushViaConstructor lua "BlockQuote" blcks
+    BulletList items         -> pushViaConstructor lua "BulletList" items
+    CodeBlock attr code      -> pushViaConstructor lua "CodeBlock" code attr
+    DefinitionList items     -> pushViaConstructor lua "DefinitionList" items
+    Div attr blcks           -> pushViaConstructor lua "Div" blcks attr
+    Header lvl attr inlns    -> pushViaConstructor lua "Header" lvl attr inlns
+    HorizontalRule           -> pushViaConstructor lua "HorizontalRule"
+    LineBlock blcks          -> pushViaConstructor lua "LineBlock" blcks
+    OrderedList lstAttr list -> pushViaConstructor lua "OrderedList" list lstAttr
+    Null                     -> pushViaConstructor lua "Null"
+    Para blcks               -> pushViaConstructor lua "Para" blcks
+    Plain blcks              -> pushViaConstructor lua "Plain" blcks
+    RawBlock f cs            -> pushViaConstructor lua "RawBlock" f cs
+    Table capt aligns widths headers rows ->
+      pushViaConstructor lua "Table" capt aligns widths headers rows
     -- fall back to conversion via aeson's Value
-    x                 -> push lua (toJSON x)
   peek lua i = peekBlock lua i
   valuetype _ = TTABLE
 
 instance StackValue Inline where
   push lua = \case
-    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
+    Cite citations lst       -> pushViaConstructor lua "Cite" lst citations
+    Code attr lst            -> pushViaConstructor lua "Code" lst attr
+    Emph inlns               -> pushViaConstructor lua "Emph" inlns
+    Image attr alt (src,tit) -> pushViaConstructor lua "Image" alt src tit attr
+    LineBreak                -> pushViaConstructor lua "LineBreak"
+    Link attr lst (src,tit)  -> pushViaConstructor lua "Link" lst src tit attr
+    Note blcks               -> pushViaConstructor lua "Note" blcks
+    Math mty str             -> pushViaConstructor lua "Math" mty str
+    Quoted qt inlns          -> pushViaConstructor lua "Quoted" qt inlns
+    RawInline f cs           -> pushViaConstructor lua "RawInline" f cs
+    SmallCaps inlns          -> pushViaConstructor lua "SmallCaps" inlns
+    SoftBreak                -> pushViaConstructor lua "SoftBreak"
+    Space                    -> pushViaConstructor lua "Space"
+    Span attr inlns          -> pushViaConstructor lua "Span" inlns attr
+    Str str                  -> pushViaConstructor lua "Str" str
+    Strikeout inlns          -> pushViaConstructor lua "Strikeout" inlns
+    Strong inlns             -> pushViaConstructor lua "Strong" inlns
+    Subscript inlns          -> pushViaConstructor lua "Subscript" inlns
+    Superscript inlns        -> pushViaConstructor lua "Superscript" inlns
   peek = peekInline
   valuetype _ = TTABLE
 
+instance StackValue Alignment where
+  push lua = \case
+    AlignLeft -> getglobal2 lua "pandoc.AlignLeft"
+    AlignRight -> getglobal2 lua "pandoc.AlignRight"
+    AlignCenter -> getglobal2 lua "pandoc.AlignCenter"
+    AlignDefault -> getglobal2 lua "pandoc.AlignDefault"
+  peek lua idx = do
+    tag <- getField lua idx "t"
+    case tag of
+      Just "AlignLeft" -> return $ Just AlignLeft
+      Just "AlignRight" -> return $ Just AlignRight
+      Just "AlignCenter" -> return $ Just AlignCenter
+      Just "AlignDefault" -> return $ Just AlignDefault
+      _ -> return Nothing
+  valuetype _ = TSTRING
+
 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)
+  push lua (Citation cid prefix suffix mode noteNum hash) =
+    pushViaConstructor lua "Citation" cid mode prefix suffix noteNum hash
   peek lua idx = do
     id' <- getField lua idx "citationId"
     prefix <- getField lua idx "citationPrefix"
@@ -122,20 +181,14 @@ instance StackValue Citation where
     mode <- getField lua idx "citationMode"
     num <- getField lua idx "citationNoteNum"
     hash <- getField lua idx "citationHash"
-    return $ Citation
-      <$> id'
-      <*> prefix
-      <*> suffix
-      <*> mode
-      <*> num
-      <*> hash
+    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"
+    AuthorInText   -> getglobal2 lua "pandoc.AuthorInText"
+    NormalCitation -> getglobal2 lua "pandoc.NormalCitation"
+    SuppressAuthor -> getglobal2 lua "pandoc.SuppressAuthor"
   peek lua idx = do
     tag <- getField lua idx "t"
     case tag of
@@ -143,17 +196,55 @@ instance StackValue CitationMode where
       Just "NormalCitation" -> return $ Just NormalCitation
       Just "SuppressAuthor" -> return $ Just SuppressAuthor
       _ -> return Nothing
-  valuetype _ = TSTRING
+  valuetype _ = TTABLE
 
 instance StackValue Format where
   push lua (Format f) = push lua f
   peek lua idx = fmap Format <$> peek lua idx
   valuetype _ = TSTRING
 
+instance StackValue ListNumberDelim where
+  push lua = \case
+    DefaultDelim -> getglobal2 lua "pandoc.DefaultDelim"
+    Period -> getglobal2 lua "pandoc.Period"
+    OneParen -> getglobal2 lua "pandoc.OneParen"
+    TwoParens -> getglobal2 lua "pandoc.TwoParens"
+  peek lua idx = do
+    tag <- getField lua idx "t"
+    case tag of
+      Just "DefaultDelim" -> return $ Just DefaultDelim
+      Just "Period" -> return $ Just Period
+      Just "OneParen" -> return $ Just OneParen
+      Just "TwoParens" -> return $ Just TwoParens
+      _ -> return Nothing
+  valuetype _ = TTABLE
+
+instance StackValue ListNumberStyle where
+  push lua = \case
+    DefaultStyle -> getglobal2 lua "pandoc.DefaultStyle"
+    LowerRoman -> getglobal2 lua "pandoc.LowerRoman"
+    UpperRoman -> getglobal2 lua "pandoc.UpperRoman"
+    LowerAlpha -> getglobal2 lua "pandoc.LowerAlpha"
+    UpperAlpha -> getglobal2 lua "pandoc.UpperAlpha"
+    Decimal -> getglobal2 lua "pandoc.Decimal"
+    Example -> getglobal2 lua "pandoc.Example"
+  peek lua idx = do
+    tag <- getField lua idx "t"
+    case tag of
+      Just "DefaultStyle" -> return $ Just DefaultStyle
+      Just "LowerRoman" -> return $ Just LowerRoman
+      Just "UpperRoman" -> return $ Just UpperRoman
+      Just "LowerAlpha" -> return $ Just LowerAlpha
+      Just "UpperAlpha" -> return $ Just UpperAlpha
+      Just "Decimal" -> return $ Just Decimal
+      Just "Example" -> return $ Just Example
+      _ -> return Nothing
+  valuetype _ = TTABLE
+
 instance StackValue MathType where
   push lua = \case
-    InlineMath -> pushTagged' lua "InlineMath"
-    DisplayMath -> pushTagged' lua "DisplayMath"
+    InlineMath -> getglobal2 lua "pandoc.InlineMath"
+    DisplayMath -> getglobal2 lua "pandoc.DisplayMath"
   peek lua idx = do
     res <- getField lua idx "t"
     case res of
@@ -164,8 +255,8 @@ instance StackValue MathType where
 
 instance StackValue QuoteType where
   push lua = \case
-    SingleQuote -> pushTagged' lua "SingleQuote"
-    DoubleQuote -> pushTagged' lua "DoubleQuote"
+    SingleQuote -> getglobal2 lua "pandoc.SingleQuote"
+    DoubleQuote -> getglobal2 lua "pandoc.DoubleQuote"
   peek lua idx = do
     res <- getField lua idx "t"
     case res of
@@ -186,11 +277,11 @@ instance StackValue [Char] where
 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
+    addIndexedValue lua 1 a
+    addIndexedValue lua 2 b
   peek lua idx = do
-    a <- getIntField lua idx 1
-    b <- getIntField lua idx 2
+    a <- getIndexedValue lua idx 1
+    b <- getIndexedValue lua idx 2
     return $ (,) <$> a <*> b
   valuetype _ = TTABLE
 
@@ -199,31 +290,93 @@ instance (StackValue a, StackValue b, StackValue 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
+    addIndexedValue lua 1 a
+    addIndexedValue lua 2 b
+    addIndexedValue lua 3 c
   peek lua idx = do
-    a <- getIntField lua idx 1
-    b <- getIntField lua idx 2
-    c <- getIntField lua idx 3
+    a <- getIndexedValue lua idx 1
+    b <- getIndexedValue lua idx 2
+    c <- getIndexedValue 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
--- when pushed to lua.
-pushTagged :: StackValue a => LuaState -> String -> a -> IO ()
-pushTagged lua tag value = do
-  newtable lua
-  setField lua (-1) "t" tag
-  setField lua (-1) "c" value
-
-pushTagged' :: LuaState -> String -> IO ()
-pushTagged' lua tag = do
-  newtable lua
-  push lua "t"
-  push lua tag
-  rawset lua (-3)
+instance (StackValue a, StackValue b, StackValue c,
+          StackValue d, StackValue e) =>
+         StackValue (a, b, c, d, e)
+ where
+  push lua (a, b, c, d, e) = do
+    newtable lua
+    addIndexedValue lua 1 a
+    addIndexedValue lua 2 b
+    addIndexedValue lua 3 c
+    addIndexedValue lua 4 d
+    addIndexedValue lua 5 e
+  peek lua idx = do
+    a <- getIndexedValue lua idx 1
+    b <- getIndexedValue lua idx 2
+    c <- getIndexedValue lua idx 3
+    d <- getIndexedValue lua idx 4
+    e <- getIndexedValue lua idx 5
+    return $ (,,,,) <$> a <*> b <*> c <*> d <*> e
+  valuetype _ = TTABLE
+
+instance (Ord a, StackValue a, StackValue b) =>
+         StackValue (M.Map a b) where
+  push lua m = do
+    newtable lua
+    mapM_ (uncurry $ addKeyValue lua) $ M.toList m
+  peek lua idx = fmap M.fromList <$> keyValuePairs lua idx
+  valuetype _ = TTABLE
+
+-- | Try reading the value under the given index as a list of key-value pairs.
+keyValuePairs :: (StackValue a, StackValue b)
+         => LuaState -> Int -> IO (Maybe [(a, b)])
+keyValuePairs lua idx = do
+  pushnil lua
+  sequence <$> remainingPairs
+ where
+  remainingPairs = do
+    res <- nextPair
+    case res of
+      Nothing -> return []
+      Just a  -> (a:) <$> remainingPairs
+  nextPair :: (StackValue a, StackValue b) => IO (Maybe (Maybe (a,b)))
+  nextPair = do
+    hasNext <- next lua (idx `adjustIndexBy` 1)
+    if hasNext
+      then do
+        val <- peek lua (-1)
+        key <- peek lua (-2)
+        pop lua 1 -- removes the value, keeps the key
+        return $ Just <$> ((,) <$> key <*> val)
+      else do
+        return Nothing
+
+
+-- | Helper class for pushing a single value to the stack via a lua function.
+-- See @pushViaCall@.
+class PushViaCall a where
+  pushViaCall' :: LuaState -> String -> IO () -> Int -> a
+
+instance PushViaCall (IO ()) where
+  pushViaCall' lua fn pushArgs num = do
+    getglobal2 lua fn
+    pushArgs
+    call lua num 1
+
+instance (StackValue a, PushViaCall b) => PushViaCall (a -> b) where
+  pushViaCall' lua fn pushArgs num x =
+    pushViaCall' lua fn (pushArgs *> push lua x) (num + 1)
+
+-- | Push an value to the stack via a lua function. The lua function is called
+-- with all arguments that are passed to this function and is expected to return
+-- a single value.
+pushViaCall :: PushViaCall a => LuaState -> String -> a
+pushViaCall lua fn = pushViaCall' lua fn (return ()) 0
+
+-- | Call a pandoc element constructor within lua, passing all given arguments.
+pushViaConstructor :: PushViaCall a => LuaState -> String -> a
+pushViaConstructor lua pandocFn = pushViaCall lua ("pandoc." ++ pandocFn)
 
 -- | Return the value at the given index as inline if possible.
 peekInline :: LuaState -> Int -> IO (Maybe Inline)
@@ -268,13 +421,22 @@ peekBlock lua idx = do
     Just t -> case t of
       "BlockQuote"     -> fmap BlockQuote <$> elementContent
       "BulletList"     -> fmap BulletList <$> elementContent
+      "CodeBlock"      -> fmap (uncurry CodeBlock) <$> elementContent
+      "DefinitionList" -> fmap DefinitionList <$> elementContent
+      "Div"            -> fmap (uncurry Div) <$> elementContent
+      "Header"         -> fmap (\(lvl, attr, lst) -> Header lvl attr lst)
+                          <$> elementContent
       "HorizontalRule" -> return (Just HorizontalRule)
       "LineBlock"      -> fmap LineBlock <$> elementContent
+      "OrderedList"    -> fmap (uncurry OrderedList) <$> elementContent
       "Null"           -> return (Just Null)
       "Para"           -> fmap Para <$> elementContent
       "Plain"          -> fmap Plain <$> elementContent
-      -- fall back to construction via aeson's Value
-      _ -> maybeFromJson <$> peek lua idx
+      "RawBlock"       -> fmap (uncurry RawBlock) <$> elementContent
+      "Table"          -> fmap (\(capt, aligns, widths, headers, body) ->
+                                  Table capt aligns widths headers body)
+                          <$> elementContent
+      _ -> return Nothing
  where
    -- Get the contents of an AST element.
    elementContent :: StackValue a => IO (Maybe a)
@@ -296,21 +458,29 @@ getField lua idx key = do
   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
+setKeyValue :: (StackValue a, StackValue b) => LuaState -> Int -> a -> b -> IO ()
+setKeyValue lua idx key value = do
   push lua key
   push lua value
   settable lua (idx `adjustIndexBy` 2)
 
+-- | Add a key-value pair to the table at the top of the stack
+addKeyValue :: (StackValue a, StackValue b) => LuaState -> a -> b -> IO ()
+addKeyValue lua = setKeyValue lua (-1)
+
 -- | Get value behind key from table at given index.
-getIntField :: StackValue a => LuaState -> Int -> Int -> IO (Maybe a)
-getIntField lua idx key =
+getIndexedValue :: StackValue a => LuaState -> Int -> Int -> IO (Maybe a)
+getIndexedValue 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
+setIndexedValue :: StackValue a => LuaState -> Int -> Int -> a -> IO ()
+setIndexedValue lua idx key value = do
   push lua value
   rawseti lua (idx `adjustIndexBy` 1) key
+
+-- | Set numeric key/value in table at the top of the stack.
+addIndexedValue :: StackValue a => LuaState -> Int -> a -> IO ()
+addIndexedValue lua = setIndexedValue lua (-1)