1 files changed, 204 insertions, 203 deletions
diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs
index d2e3f630a..4eea5bc2f 100644
--- a/src/Text/Pandoc/Lua/StackInstances.hs
+++ b/src/Text/Pandoc/Lua/StackInstances.hs
@@ -33,243 +33,244 @@ StackValue instances for pandoc types.
 module Text.Pandoc.Lua.StackInstances () where
 
 import Control.Applicative ((<|>))
-import Scripting.Lua (LTYPE (..), LuaState, StackValue (..), ltype, newtable,
-                      objlen)
+import Foreign.Lua (Lua, Type (..), FromLuaStack (peek), ToLuaStack (push),
+                    StackIndex, peekEither, throwLuaError)
+import Foreign.Lua.Api (getfield, ltype, newtable, pop, rawlen)
 import Text.Pandoc.Definition
 import Text.Pandoc.Lua.SharedInstances ()
 import Text.Pandoc.Lua.Util (addValue, getTable, pushViaConstructor)
 import Text.Pandoc.Shared (safeRead)
 
-instance StackValue Pandoc where
-  push lua (Pandoc meta blocks) = do
-    newtable lua
-    addValue lua "blocks" blocks
-    addValue lua "meta"   meta
-  peek lua idx = do
-    blocks <- getTable lua idx "blocks"
-    meta   <- getTable lua idx "meta"
-    return $ Pandoc <$> meta <*> blocks
-  valuetype _ = TTABLE
-
-instance StackValue Meta where
-  push lua (Meta mmap) = push lua mmap
-  peek lua idx = fmap Meta <$> peek lua idx
-  valuetype _ = TTABLE
-
-instance StackValue MetaValue where
+instance ToLuaStack Pandoc where
+  push (Pandoc meta blocks) = do
+    newtable
+    addValue "blocks" blocks
+    addValue "meta"   meta
+instance FromLuaStack Pandoc where
+  peek idx = do
+    blocks <- getTable idx "blocks"
+    meta   <- getTable idx "meta"
+    return $ Pandoc meta blocks
+
+instance ToLuaStack Meta where
+  push (Meta mmap) = push mmap
+instance FromLuaStack Meta where
+  peek idx = Meta <$> peek idx
+
+instance ToLuaStack MetaValue where
   push = pushMetaValue
+instance FromLuaStack MetaValue where
   peek = peekMetaValue
-  valuetype = \case
-    MetaBlocks _  -> TTABLE
-    MetaBool _    -> TBOOLEAN
-    MetaInlines _ -> TTABLE
-    MetaList _    -> TTABLE
-    MetaMap _     -> TTABLE
-    MetaString _  -> TSTRING
-
-instance StackValue Block where
+
+instance ToLuaStack Block where
   push = pushBlock
+
+instance FromLuaStack Block where
   peek = peekBlock
-  valuetype _ = TTABLE
 
-instance StackValue Inline where
+-- Inline
+instance ToLuaStack Inline where
   push = pushInline
+
+instance FromLuaStack Inline where
   peek = peekInline
-  valuetype _ = TTABLE
-
-instance StackValue Citation where
-  push lua (Citation cid prefix suffix mode noteNum hash) =
-    pushViaConstructor lua "Citation" cid mode prefix suffix noteNum hash
-  peek lua idx = do
-    id' <- getTable lua idx "citationId"
-    prefix <- getTable lua idx "citationPrefix"
-    suffix <- getTable lua idx "citationSuffix"
-    mode <- getTable lua idx "citationMode"
-    num <- getTable lua idx "citationNoteNum"
-    hash <- getTable lua idx "citationHash"
-    return $ Citation <$> id' <*> prefix <*> suffix <*> mode <*> num <*> hash
-  valuetype _ = TTABLE
-
-instance StackValue Alignment where
-  push lua = push lua . show
-  peek lua idx = (>>= safeRead) <$> peek lua idx
-  valuetype _ = TSTRING
-
-instance StackValue CitationMode where
-  push lua = push lua . show
-  peek lua idx = (>>= safeRead) <$> peek lua idx
-  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 ListNumberDelim where
-  push lua = push lua . show
-  peek lua idx = (>>= safeRead) <$> peek lua idx
-  valuetype _ = TSTRING
-
-instance StackValue ListNumberStyle where
-  push lua = push lua . show
-  peek lua idx = (>>= safeRead) <$> peek lua idx
-  valuetype _ = TSTRING
-
-instance StackValue MathType where
-  push lua = push lua . show
-  peek lua idx = (>>= safeRead) <$> peek lua idx
-  valuetype _ = TSTRING
-
-instance StackValue QuoteType where
-  push lua = push lua . show
-  peek lua idx = (>>= safeRead) <$> peek lua idx
-  valuetype _ = TSTRING
+
+-- Citation
+instance ToLuaStack Citation where
+  push (Citation cid prefix suffix mode noteNum hash) =
+    pushViaConstructor "Citation" cid mode prefix suffix noteNum hash
+
+instance FromLuaStack Citation where
+  peek idx = do
+    id' <- getTable idx "citationId"
+    prefix <- getTable idx "citationPrefix"
+    suffix <- getTable idx "citationSuffix"
+    mode <- getTable idx "citationMode"
+    num <- getTable idx "citationNoteNum"
+    hash <- getTable idx "citationHash"
+    return $ Citation id' prefix suffix mode num hash
+
+instance ToLuaStack Alignment where
+  push = push . show
+instance FromLuaStack Alignment where
+  peek idx = safeRead' =<< peek idx
+
+instance ToLuaStack CitationMode where
+  push = push . show
+instance FromLuaStack CitationMode where
+  peek idx = safeRead' =<< peek idx
+
+instance ToLuaStack Format where
+  push (Format f) = push f
+instance FromLuaStack Format where
+  peek idx = Format <$> peek idx
+
+instance ToLuaStack ListNumberDelim where
+  push = push . show
+instance FromLuaStack ListNumberDelim where
+  peek idx = safeRead' =<< peek idx
+
+instance ToLuaStack ListNumberStyle where
+  push = push . show
+instance FromLuaStack ListNumberStyle where
+  peek idx = safeRead' =<< peek idx
+
+instance ToLuaStack MathType where
+  push = push . show
+instance FromLuaStack MathType where
+  peek idx = safeRead' =<< peek idx
+
+instance ToLuaStack QuoteType where
+  push = push . show
+instance FromLuaStack QuoteType where
+  peek idx = safeRead' =<< peek idx
+
+safeRead' :: Read a => String -> Lua a
+safeRead' s = case safeRead s of
+  Nothing -> throwLuaError ("Could not read: " ++ s)
+  Just x -> return x
 
 -- | Push an meta value element to the top of the lua stack.
-pushMetaValue :: LuaState -> MetaValue -> IO ()
-pushMetaValue lua = \case
-  MetaBlocks blcks  -> pushViaConstructor lua "MetaBlocks" blcks
-  MetaBool bool     -> push lua bool
-  MetaInlines inlns -> pushViaConstructor lua "MetaInlines" inlns
-  MetaList metalist -> pushViaConstructor lua "MetaList" metalist
-  MetaMap metamap   -> pushViaConstructor lua "MetaMap" metamap
-  MetaString str    -> push lua str
+pushMetaValue :: MetaValue -> Lua ()
+pushMetaValue = \case
+  MetaBlocks blcks  -> pushViaConstructor "MetaBlocks" blcks
+  MetaBool bool     -> push bool
+  MetaInlines inlns -> pushViaConstructor "MetaInlines" inlns
+  MetaList metalist -> pushViaConstructor "MetaList" metalist
+  MetaMap metamap   -> pushViaConstructor "MetaMap" metamap
+  MetaString str    -> push str
 
 -- | Interpret the value at the given stack index as meta value.
-peekMetaValue :: LuaState -> Int -> IO (Maybe MetaValue)
-peekMetaValue lua idx = do
+peekMetaValue :: StackIndex -> Lua MetaValue
+peekMetaValue idx = do
   -- Get the contents of an AST element.
-  let elementContent :: StackValue a => IO (Maybe a)
-      elementContent = peek lua idx
-  luatype <- ltype lua idx
+  let elementContent :: FromLuaStack a => Lua a
+      elementContent = peek idx
+  luatype <- ltype idx
   case luatype of
-    TBOOLEAN -> fmap MetaBool <$> peek lua idx
-    TSTRING  -> fmap MetaString <$> peek lua idx
-    TTABLE   -> do
-      tag <- getTable lua idx "t"
+    TypeBoolean -> MetaBool <$> peek idx
+    TypeString  -> MetaString <$> peek idx
+    TypeTable   -> do
+      tag <- getfield idx "t" *> peekEither (-1) <* pop 1
       case tag of
-        Just "MetaBlocks"  -> fmap MetaBlocks  <$> elementContent
-        Just "MetaBool"    -> fmap MetaBool    <$> elementContent
-        Just "MetaMap"     -> fmap MetaMap     <$> elementContent
-        Just "MetaInlines" -> fmap MetaInlines <$> elementContent
-        Just "MetaList"    -> fmap MetaList    <$> elementContent
-        Just "MetaString"  -> fmap MetaString  <$> elementContent
-        Nothing -> do
+        Right "MetaBlocks"  -> MetaBlocks  <$> elementContent
+        Right "MetaBool"    -> MetaBool    <$> elementContent
+        Right "MetaMap"     -> MetaMap     <$> elementContent
+        Right "MetaInlines" -> MetaInlines <$> elementContent
+        Right "MetaList"    -> MetaList    <$> elementContent
+        Right "MetaString"  -> MetaString  <$> elementContent
+        Right t             -> throwLuaError ("Unknown meta tag: " ++ t)
+        Left _ -> do
           -- no meta value tag given, try to guess.
-          len <- objlen lua idx
+          len <- rawlen 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
+            then MetaMap <$> peek idx
+            else  (MetaInlines <$> peek idx)
+                  <|> (MetaBlocks <$> peek idx)
+                  <|> (MetaList <$> peek idx)
+    _        -> throwLuaError ("could not get meta value")
 
 -- | Push an block element to the top of the lua stack.
-pushBlock :: LuaState -> Block -> IO ()
-pushBlock lua = \case
-  BlockQuote blcks         -> pushViaConstructor lua "BlockQuote" blcks
-  BulletList items         -> pushViaConstructor lua "BulletList" items
-  CodeBlock attr code      -> pushViaConstructor lua "CodeBlock" code (LuaAttr attr)
-  DefinitionList items     -> pushViaConstructor lua "DefinitionList" items
-  Div attr blcks           -> pushViaConstructor lua "Div" blcks (LuaAttr attr)
-  Header lvl attr inlns    -> pushViaConstructor lua "Header" lvl inlns (LuaAttr attr)
-  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
+pushBlock :: Block -> Lua ()
+pushBlock = \case
+  BlockQuote blcks         -> pushViaConstructor "BlockQuote" blcks
+  BulletList items         -> pushViaConstructor "BulletList" items
+  CodeBlock attr code      -> pushViaConstructor "CodeBlock" code (LuaAttr attr)
+  DefinitionList items     -> pushViaConstructor "DefinitionList" items
+  Div attr blcks           -> pushViaConstructor "Div" blcks (LuaAttr attr)
+  Header lvl attr inlns    -> pushViaConstructor "Header" lvl inlns (LuaAttr attr)
+  HorizontalRule           -> pushViaConstructor "HorizontalRule"
+  LineBlock blcks          -> pushViaConstructor "LineBlock" blcks
+  OrderedList lstAttr list -> pushViaConstructor "OrderedList" list lstAttr
+  Null                     -> pushViaConstructor "Null"
+  Para blcks               -> pushViaConstructor "Para" blcks
+  Plain blcks              -> pushViaConstructor "Plain" blcks
+  RawBlock f cs            -> pushViaConstructor "RawBlock" f cs
   Table capt aligns widths headers rows ->
-    pushViaConstructor lua "Table" capt aligns widths headers rows
+    pushViaConstructor "Table" capt aligns widths headers rows
 
 -- | Return the value at the given index as block if possible.
-peekBlock :: LuaState -> Int -> IO (Maybe Block)
-peekBlock lua idx = do
-  tag <- getTable lua idx "t"
+peekBlock :: StackIndex -> Lua Block
+peekBlock idx = do
+  tag <- getTable idx "t"
   case tag of
-    Nothing -> return Nothing
-    Just t -> case t of
-      "BlockQuote"     -> fmap BlockQuote <$> elementContent
-      "BulletList"     -> fmap BulletList <$> elementContent
-      "CodeBlock"      -> fmap (withAttr CodeBlock) <$> elementContent
-      "DefinitionList" -> fmap DefinitionList <$> elementContent
-      "Div"            -> fmap (withAttr Div) <$> elementContent
-      "Header"         -> fmap (\(lvl, LuaAttr attr, lst) -> Header lvl attr lst)
+      "BlockQuote"     -> BlockQuote <$> elementContent
+      "BulletList"     -> BulletList <$> elementContent
+      "CodeBlock"      -> (withAttr CodeBlock) <$> elementContent
+      "DefinitionList" -> DefinitionList <$> elementContent
+      "Div"            -> (withAttr Div) <$> elementContent
+      "Header"         -> (\(lvl, LuaAttr 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
-      "RawBlock"       -> fmap (uncurry RawBlock) <$> elementContent
-      "Table"          -> fmap (\(capt, aligns, widths, headers, body) ->
+      "HorizontalRule" -> return HorizontalRule
+      "LineBlock"      -> LineBlock <$> elementContent
+      "OrderedList"    -> (uncurry OrderedList) <$> elementContent
+      "Null"           -> return Null
+      "Para"           -> Para <$> elementContent
+      "Plain"          -> Plain <$> elementContent
+      "RawBlock"       -> (uncurry RawBlock) <$> elementContent
+      "Table"          -> (\(capt, aligns, widths, headers, body) ->
                                   Table capt aligns widths headers body)
                           <$> elementContent
-      _ -> return Nothing
+      _ -> throwLuaError ("Unknown block type: " ++ tag)
  where
    -- Get the contents of an AST element.
-   elementContent :: StackValue a => IO (Maybe a)
-   elementContent = getTable lua idx "c"
+   elementContent :: FromLuaStack a => Lua a
+   elementContent = getTable idx "c"
 
 -- | Push an inline element to the top of the lua stack.
-pushInline :: LuaState -> Inline -> IO ()
-pushInline lua = \case
-  Cite citations lst       -> pushViaConstructor lua "Cite" lst citations
-  Code attr lst            -> pushViaConstructor lua "Code" lst (LuaAttr attr)
-  Emph inlns               -> pushViaConstructor lua "Emph" inlns
-  Image attr alt (src,tit) -> pushViaConstructor lua "Image" alt src tit (LuaAttr attr)
-  LineBreak                -> pushViaConstructor lua "LineBreak"
-  Link attr lst (src,tit)  -> pushViaConstructor lua "Link" lst src tit (LuaAttr 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 (LuaAttr 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
+pushInline :: Inline -> Lua ()
+pushInline = \case
+  Cite citations lst       -> pushViaConstructor "Cite" lst citations
+  Code attr lst            -> pushViaConstructor "Code" lst (LuaAttr attr)
+  Emph inlns               -> pushViaConstructor "Emph" inlns
+  Image attr alt (src,tit) -> pushViaConstructor "Image" alt src tit (LuaAttr attr)
+  LineBreak                -> pushViaConstructor "LineBreak"
+  Link attr lst (src,tit)  -> pushViaConstructor "Link" lst src tit (LuaAttr attr)
+  Note blcks               -> pushViaConstructor "Note" blcks
+  Math mty str             -> pushViaConstructor "Math" mty str
+  Quoted qt inlns          -> pushViaConstructor "Quoted" qt inlns
+  RawInline f cs           -> pushViaConstructor "RawInline" f cs
+  SmallCaps inlns          -> pushViaConstructor "SmallCaps" inlns
+  SoftBreak                -> pushViaConstructor "SoftBreak"
+  Space                    -> pushViaConstructor "Space"
+  Span attr inlns          -> pushViaConstructor "Span" inlns (LuaAttr attr)
+  Str str                  -> pushViaConstructor "Str" str
+  Strikeout inlns          -> pushViaConstructor "Strikeout" inlns
+  Strong inlns             -> pushViaConstructor "Strong" inlns
+  Subscript inlns          -> pushViaConstructor "Subscript" inlns
+  Superscript inlns        -> pushViaConstructor "Superscript" inlns
 
 -- | Return the value at the given index as inline if possible.
-peekInline :: LuaState -> Int -> IO (Maybe Inline)
-peekInline lua idx = do
-  tag <- getTable lua idx "t"
+peekInline :: StackIndex -> Lua Inline
+peekInline idx = do
+  tag <- getTable idx "t"
   case tag of
-    Nothing -> return Nothing
-    Just t -> case t of
-      "Cite"       -> fmap (uncurry Cite) <$> elementContent
-      "Code"       -> fmap (withAttr Code) <$> elementContent
-      "Emph"       -> fmap Emph <$> elementContent
-      "Image"      -> fmap (\(LuaAttr attr, lst, tgt) -> Image attr lst tgt)
-                      <$> elementContent
-      "Link"       -> fmap (\(LuaAttr 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 (withAttr Span) <$> elementContent
-      "Str"        -> fmap Str <$> elementContent
-      "Strikeout"  -> fmap Strikeout <$> elementContent
-      "Strong"     -> fmap Strong <$> elementContent
-      "Subscript"  -> fmap Subscript <$> elementContent
-      "Superscript"-> fmap Superscript <$> elementContent
-      _ -> return Nothing
+    "Cite"       -> (uncurry Cite) <$> elementContent
+    "Code"       -> (withAttr Code) <$> elementContent
+    "Emph"       -> Emph <$> elementContent
+    "Image"      -> (\(LuaAttr attr, lst, tgt) -> Image attr lst tgt)
+                    <$> elementContent
+    "Link"       -> (\(LuaAttr attr, lst, tgt) -> Link attr lst tgt)
+                    <$> elementContent
+    "LineBreak"  -> return LineBreak
+    "Note"       -> Note <$> elementContent
+    "Math"       -> (uncurry Math) <$> elementContent
+    "Quoted"     -> (uncurry Quoted) <$> elementContent
+    "RawInline"  -> (uncurry RawInline) <$> elementContent
+    "SmallCaps"  -> SmallCaps <$> elementContent
+    "SoftBreak"  -> return SoftBreak
+    "Space"      -> return Space
+    "Span"       -> (withAttr Span) <$> elementContent
+    "Str"        -> Str <$> elementContent
+    "Strikeout"  -> Strikeout <$> elementContent
+    "Strong"     -> Strong <$> elementContent
+    "Subscript"  -> Subscript <$> elementContent
+    "Superscript"-> Superscript <$> elementContent
+    _ -> throwLuaError ("Unknown inline type: " ++ tag)
  where
    -- Get the contents of an AST element.
-   elementContent :: StackValue a => IO (Maybe a)
-   elementContent = getTable lua idx "c"
+   elementContent :: FromLuaStack a => Lua a
+   elementContent = getTable idx "c"
 
 withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b
 withAttr f (attributes, x) = f (fromLuaAttr attributes) x
@@ -277,8 +278,8 @@ withAttr f (attributes, x) = f (fromLuaAttr attributes) x
 -- | Wrapper for Attr
 newtype LuaAttr = LuaAttr { fromLuaAttr :: Attr }
 
-instance StackValue LuaAttr where
-  push lua (LuaAttr (id', classes, kv)) =
-    pushViaConstructor lua "Attr" id' classes kv
-  peek lua idx = fmap LuaAttr <$> peek lua idx
-  valuetype _ = TTABLE
+instance ToLuaStack LuaAttr where
+  push (LuaAttr (id', classes, kv)) =
+    pushViaConstructor "Attr" id' classes kv
+instance FromLuaStack LuaAttr where
+  peek idx = LuaAttr <$> peek idx