Push Captions as userdata, move code to separate module

pandoc-lua-marshal.cabal

@@ -79,6 +79,7 @@ library
                      , Text.Pandoc.Lua.Marshal.Alignment
                      , Text.Pandoc.Lua.Marshal.Attr
                      , Text.Pandoc.Lua.Marshal.Block
+                     , Text.Pandoc.Lua.Marshal.Caption
                      , Text.Pandoc.Lua.Marshal.Cell
                      , Text.Pandoc.Lua.Marshal.Citation
                      , Text.Pandoc.Lua.Marshal.CitationMode

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

@@ -11,6 +11,7 @@ module Text.Pandoc.Lua.Marshal.AST
   , module Text.Pandoc.Lua.Marshal.Alignment
   , module Text.Pandoc.Lua.Marshal.Attr
   , module Text.Pandoc.Lua.Marshal.Block
+  , module Text.Pandoc.Lua.Marshal.Caption
   , module Text.Pandoc.Lua.Marshal.Cell
   , module Text.Pandoc.Lua.Marshal.Citation
   , module Text.Pandoc.Lua.Marshal.CitationMode
@@ -29,6 +30,7 @@ module Text.Pandoc.Lua.Marshal.AST
 import Text.Pandoc.Lua.Marshal.Alignment
 import Text.Pandoc.Lua.Marshal.Attr
 import Text.Pandoc.Lua.Marshal.Block
+import Text.Pandoc.Lua.Marshal.Caption
 import Text.Pandoc.Lua.Marshal.Cell
 import Text.Pandoc.Lua.Marshal.Citation
 import Text.Pandoc.Lua.Marshal.CitationMode

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

@@ -36,6 +36,7 @@ import Data.Proxy (Proxy (Proxy))
 import Data.Text (Text)
 import HsLua hiding (Div)
 import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr)
+import Text.Pandoc.Lua.Marshal.Caption (peekCaptionFuzzy, pushCaption)
 import Text.Pandoc.Lua.Marshal.Content
   ( Content (..), contentTypeDescription, peekContent, pushContent
   , peekDefinitionItem )
@@ -47,8 +48,7 @@ import Text.Pandoc.Lua.Marshal.ListAttributes
   ( peekListAttributes, pushListAttributes )
 import Text.Pandoc.Lua.Marshal.Shared (walkBlocksAndInlines)
 import Text.Pandoc.Lua.Marshal.TableParts
-  ( peekCaptionFuzzy, pushCaption
-  , peekColSpec, pushColSpec
+  ( peekColSpec, pushColSpec
   , peekTableBody, pushTableBody
   , peekTableFoot, pushTableFoot
   , peekTableHead, pushTableHead

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

@@ -0,0 +1,91 @@
+{-# LANGUAGE OverloadedStrings    #-}
+{- |
+Copyright               : © 2021-2024 Albert Krewinkel
+SPDX-License-Identifier : MIT
+Maintainer              : Albert Krewinkel <[email protected]>
+
+Marshaling and unmarshaling of 'Caption' elements.
+-}
+module Text.Pandoc.Lua.Marshal.Caption
+  ( peekCaption
+  , peekCaptionFuzzy
+  , pushCaption
+    -- * Constructor
+  , mkCaption
+  ) where
+
+import Control.Applicative ((<|>), optional)
+import Control.Monad ((<$!>))
+import Data.Aeson (encode)
+import Data.Maybe (fromMaybe)
+import HsLua
+import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Block
+  ( peekBlocksFuzzy, pushBlocks )
+import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Inline
+  ( peekInlinesFuzzy, pushInlines )
+import Text.Pandoc.Definition
+
+-- | Caption object type.
+typeCaption :: LuaError e => DocumentedType e Caption
+typeCaption = deftype "Caption"
+  [ operation Eq $ lambda
+    ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))
+    <#> parameter (optional . peekCaption) "Caption" "a" ""
+    <#> parameter (optional . peekCaption) "Caption" "b" ""
+    =#> functionResult pushBool "boolean" "whether the two are equal"
+  , operation Tostring $ lambda
+    ### liftPure show
+    <#> udparam typeCaption "x" ""
+    =#> functionResult pushString "string" "native Haskell representation"
+  , operation (CustomOperation "__tojson") $ lambda
+    ### liftPure encode
+    <#> udparam typeCaption "self" ""
+    =#> functionResult pushLazyByteString "string" "JSON representation"
+  ]
+  [ property' "short"
+    "Inlines|nil"
+    "short caption used to describe the object"
+      (maybe pushnil pushInlines, \(Caption short _) -> short)
+      (peekNilOr peekInlinesFuzzy, \(Caption _ long) shrt -> Caption shrt long)
+  , property "long" "full caption text"
+      (pushBlocks, \(Caption _ long) -> long)
+      (peekBlocksFuzzy, \(Caption short _) long -> Caption short long)
+  , method $ defun "clone"
+    ### return
+    <#> parameter peekCaption "Caption" "capt" ""
+    =#> functionResult pushCaption "Caption" "cloned Caption element"
+  ]
+
+-- | Push Caption element
+pushCaption :: LuaError e => Pusher e Caption
+pushCaption = pushUD typeCaption
+
+-- | Peek Caption element from userdata.
+peekCaption :: LuaError e => Peeker e Caption
+peekCaption = peekUD typeCaption
+
+-- | Peek Caption element from a table.
+peekCaptionTable :: LuaError e => Peeker e Caption
+peekCaptionTable idx = do
+  short <- optional $ peekFieldRaw peekInlinesFuzzy "short" idx
+  long <- peekFieldRaw peekBlocksFuzzy "long" idx
+  return $! Caption short long
+
+peekCaptionFuzzy :: LuaError e => Peeker e Caption
+peekCaptionFuzzy = retrieving "Caption" . \idx -> do
+      peekCaption idx
+  <|> peekCaptionTable idx
+  <|> (Caption Nothing <$!> peekBlocksFuzzy idx)
+  <|> (failPeek =<<
+       typeMismatchMessage "Caption, list of Blocks, or compatible element" idx)
+
+-- | Constructor for 'Caption'.
+mkCaption :: LuaError e => DocumentedFunction e
+mkCaption = defun "Caption"
+  ### (\mLong short ->
+         let long = fromMaybe mempty mLong
+         in pure (Caption short long))
+  <#> opt (parameter peekBlocksFuzzy "Blocks" "long" "full caption")
+  <#> opt (parameter peekInlinesFuzzy "Inlines" "short" "short summary caption")
+  =#> functionResult pushCaption "Caption" "new Caption object"
+  #? "Creates a new Caption object."

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

@@ -9,10 +9,7 @@ Marshaling/unmarshaling functions of types that are used exclusively
 with tables.
 -}
 module Text.Pandoc.Lua.Marshal.TableParts
-  ( peekCaption
-  , peekCaptionFuzzy
-  , pushCaption
-  , peekColSpec
+  ( peekColSpec
   , pushColSpec
   , peekRow
   , peekRowFuzzy
@@ -29,42 +26,17 @@ module Text.Pandoc.Lua.Marshal.TableParts
   , mkTableHead
   ) where
 
-import Control.Applicative ((<|>), optional)
+import Control.Applicative (optional)
 import Control.Monad ((<$!>))
 import HsLua
 import Text.Pandoc.Lua.Marshal.Alignment (peekAlignment, pushAlignment)
 import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr)
-import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Block
-  ( peekBlocksFuzzy, pushBlocks )
-import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Inline
-  ( peekInlinesFuzzy, pushInlines )
 import Text.Pandoc.Lua.Marshal.List (pushPandocList)
 import Text.Pandoc.Lua.Marshal.Row
 import Text.Pandoc.Lua.Marshal.TableFoot
 import Text.Pandoc.Lua.Marshal.TableHead
 import Text.Pandoc.Definition
 
--- | Push Caption element
-pushCaption :: LuaError e => Caption -> LuaE e ()
-pushCaption (Caption shortCaption longCaption) = do
-  newtable
-  addField "short" (maybe pushnil pushInlines shortCaption)
-  addField "long" (pushBlocks longCaption)
-
--- | Peek Caption element
-peekCaption :: LuaError e => Peeker e Caption
-peekCaption idx = do
-  short <- optional $ peekFieldRaw peekInlinesFuzzy "short" idx
-  long <- peekFieldRaw peekBlocksFuzzy "long" idx
-  return $! Caption short long
-
-peekCaptionFuzzy :: LuaError e => Peeker e Caption
-peekCaptionFuzzy = retrieving "Caption" . \idx -> do
-      peekCaption idx
-  <|> (Caption Nothing <$!> peekBlocksFuzzy idx)
-  <|> (failPeek =<<
-       typeMismatchMessage "Caption, list of Blocks, or compatible element" idx)
-
 -- | Push a ColSpec value as a pair of Alignment and ColWidth.
 pushColSpec :: LuaError e => Pusher e ColSpec
 pushColSpec = pushPair pushAlignment pushColWidth

test/test-block.lua

@@ -181,7 +181,7 @@ return {
         local figure = Figure('word', {short='short', long='caption'})
         assert.are_equal(figure.caption.long, Blocks 'caption')
         assert.are_equal(figure.caption.short, Inlines 'short')
-        assert.are_equal(type(figure.caption), 'table')
+        assert.are_equal(type(figure.caption), 'userdata')
 
         figure.caption = {long = 'One day I was...', short = 'My day'}
         assert.are_equal(
@@ -334,15 +334,15 @@ return {
       test('access caption via property `caption`', function ()
         local caption = {long = {Plain 'cap'}}
         local tbl = Table(caption, {}, TableHead(), {}, TableFoot())
-        assert.are_same(tbl.caption, {long = {Plain 'cap'}})
+        assert.are_same(tbl.caption, Caption{Plain 'cap'})
 
         tbl.caption.short = 'brief'
         tbl.caption.long  = {Plain 'extended'}
 
-        local new_caption = {
-          short = 'brief',
-          long = {Plain 'extended'}
-        }
+        local new_caption = Caption(
+          {Plain 'extended'},
+          'brief'
+        )
         assert.are_equal(
           Table(new_caption, {}, TableHead(), {}, TableFoot()),
           tbl
@@ -395,9 +395,9 @@ return {
         )
       end),
       test('caption field accepts list of blocks', function ()
-        local caption = {long = {Plain 'cap'}}
+        local caption = {Plain 'cap'}
         local tbl = Table(caption, {}, TableHead(), {}, TableFoot())
-        assert.are_same(tbl.caption, {long = {Plain 'cap'}})
+        assert.are_same(tbl.caption.long, {Plain 'cap'})
 
         tbl.caption = {Plain 'extended'}
 

test/test-pandoc-lua-marshal.hs

@@ -53,6 +53,7 @@ main = do
 
   blockTests <- run @Lua.Exception $ do
     registerDefault
+    register' mkCaption
     translateResultsFromFile "test/test-block.lua"
 
   cellTests <- run @Lua.Exception $ do