Allow treatment of custom elements as singleton lists

Author: tarleb

src/Text/Pandoc/Lua/Marshal/Block.hs

@@ -128,7 +128,7 @@ peekBlockMetamethod idx = do
       liftLua (pop 1)   -- drop "__toblock" field
       failPeek "__toblock metafield does not contain a function"
 
--- | Try extra hard to retrieve an Block value from the stack. Treats
+-- | Try extra hard to retrieve a Block value from the stack. Treats
 -- bare strings as @Str@ values.
 peekBlockFuzzy :: LuaError e
                => Peeker e Block
@@ -141,11 +141,12 @@ peekBlockFuzzy idx =
 {-# INLINABLE peekBlockFuzzy #-}
 
 -- | Try extra-hard to return the value at the given index as a list of
--- inlines.
+-- 'Block's.
 peekBlocksFuzzy :: LuaError e
                 => Peeker e [Block]
 peekBlocksFuzzy idx =
-      peekList peekBlockFuzzy idx
+      ((:[]) <$> peekBlockMetamethod idx)
+  <|> peekList peekBlockFuzzy idx
   <|> (pure <$!> peekBlockFuzzy idx)
   <|> (failPeek =<<
        typeMismatchMessage "Block, list of Blocks, or compatible element" idx)

src/Text/Pandoc/Lua/Marshal/Inline.hs

@@ -128,19 +128,22 @@ peekInlineFuzzy :: LuaError e => Peeker e Inline
 peekInlineFuzzy idx = retrieving "Inline" $ liftLua (ltype idx) >>= \case
   TypeString   -> Str <$!> peekText idx
   TypeTable    -> peekInlineMetamethod idx <|> peekInline idx
-  _            -> peekInline idx <|> peekInlineMetamethod idx
+  TypeUserdata -> peekInline idx <|> peekInlineMetamethod idx
+  _type        -> failPeek =<<
+                  typeMismatchMessage "Inline-ish" idx
 {-# INLINABLE peekInlineFuzzy #-}
 
 -- | Try extra-hard to return the value at the given index as a list of
 -- inlines.
 peekInlinesFuzzy :: LuaError e
                  => Peeker e [Inline]
 peekInlinesFuzzy idx = liftLua (ltype idx) >>= \case
-  TypeString -> B.toList . B.text <$> peekText idx
-  _ ->  peekList peekInlineFuzzy idx
-    <|> (pure <$> peekInlineFuzzy idx)
-    <|> (failPeek =<<
-         typeMismatchMessage "Inline, list of Inlines, or string" idx)
+  TypeString   -> B.toList . B.text <$> peekText idx
+  TypeTable    -> ((:[]) <$> peekInlineMetamethod idx)
+                  <|> peekList peekInlineFuzzy idx
+  TypeUserdata -> ((:[]) <$> peekInlineFuzzy idx)
+  _type        -> failPeek =<<
+                  typeMismatchMessage "Inline, list of Inlines, or string" idx
 {-# INLINABLE peekInlinesFuzzy #-}
 
 -- | Inline object type.

test/test-block.lua

@@ -710,6 +710,21 @@ return {
           Blocks{Plain{'b'}, bad_block}
         )
       end),
+
+      test('object with metamethod can be used as singleton list', function ()
+        local function toblock (t)
+          return CodeBlock(t.code, {id = t.id, class = t.class})
+        end
+        local my_code = setmetatable(
+          {code = 'open access', id='opn'},
+          {__toblock = toblock}
+        )
+        assert.are_equal(
+          Div(CodeBlock('open access', {'opn'})),
+          Div(my_code)
+        )
+      end),
+
     }
   }
 }

test/test-inline.lua

@@ -497,6 +497,20 @@ return {
           Inlines(bad_inline)
         )
       end),
+
+      test("objects can be used as singleton lists", function ()
+        local function toinline (t)
+          return Code(t.code, {id = t.id, class = t.class})
+        end
+        local my_code = setmetatable(
+          {code = 'open access', id='opn'},
+          {__toinline = toinline}
+        )
+        assert.are_equal(
+          Inlines(Code('open access', {'opn'})),
+          Inlines(my_code)
+        )
+      end)
     }
   }
 }