pandoc-lua-marshal 0.2.9 → 0.3.0

raw patch · 16 files changed

+251/−55 lines, 16 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +16/−0
• pandoc-lua-marshal.cabal +2/−1
• src/Text/Pandoc/Lua/Marshal/AST.hs +2/−0
• src/Text/Pandoc/Lua/Marshal/Block.hs +6/−5
• src/Text/Pandoc/Lua/Marshal/Caption.hs +91/−0
• src/Text/Pandoc/Lua/Marshal/Cell.hs +1/−1
• src/Text/Pandoc/Lua/Marshal/Inline.hs +9/−6
• src/Text/Pandoc/Lua/Marshal/Pandoc.hs +25/−1
• src/Text/Pandoc/Lua/Marshal/Row.hs +1/−1
• src/Text/Pandoc/Lua/Marshal/TableFoot.hs +1/−1
• src/Text/Pandoc/Lua/Marshal/TableHead.hs +1/−1
• src/Text/Pandoc/Lua/Marshal/TableParts.hs +2/−30
• test/test-block.lua +23/−8
• test/test-inline.lua +28/−0
• test/test-pandoc-lua-marshal.hs +1/−0
• test/test-pandoc.lua +42/−0

@@ -2,6 +2,22 @@  `pandoc-lua-marshal` uses [PVP Versioning][]. +## 0.3.0++Released 2024-12-07.++  * Add method `normalize` to Pandoc objects.+    This returns a normalized document by merging adjacent spaces in inlines+    and by modifying tables.++  * Push Captions as userdata, move code to separate module.++  * Add tests for RawInline and its properties++  * Allow treatment of custom elements as singleton lists.++  * Remove `pandoc` prefix on table components (jgm/pandoc#8574).+ ## 0.2.9  Released 2024-10-01.

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                pandoc-lua-marshal-version:             0.2.9+version:             0.3.0 synopsis:            Use pandoc types in Lua description:         This package provides functions to marshal and unmarshal                      pandoc document types to and from Lua.@@ -79,6 +79,7 @@                      , 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

@@ -11,6 +11,7 @@   , 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 @@ 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

@@ -36,6 +36,7 @@ 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 @@   ( 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@@ -128,7 +128,7 @@       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 @@ {-# 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)

@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings    #-}+{- |+Copyright               : © 2021-2024 Albert Krewinkel+SPDX-License-Identifier : MIT+Maintainer              : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++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."

@@ -54,7 +54,7 @@  -- | Cell object type. typeCell :: LuaError e => DocumentedType e Cell-typeCell = deftype "pandoc Cell"+typeCell = deftype "Cell"   [ operation Eq $ defun "__eq"      ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))      <#> parameter (optional . peekCell) "Cell" "self" ""

@@ -128,7 +128,9 @@ 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@@ -136,11 +138,12 @@ 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.

@@ -1,4 +1,7 @@+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE LambdaCase           #-} {-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE TypeApplications     #-} {- | Copyright               : © 2021-2024 Albert Krewinkel SPDX-License-Identifier : MIT@@ -25,12 +28,14 @@ import Data.Aeson (encode) import Data.Maybe (fromMaybe) import HsLua+import Text.Pandoc.Definition (Pandoc (..), Meta (..), nullMeta) import Text.Pandoc.Lua.Marshal.Block (peekBlocksFuzzy, pushBlocks) import Text.Pandoc.Lua.Marshal.Filter import Text.Pandoc.Lua.Marshal.MetaValue (peekMetaValue, pushMetaValue) import Text.Pandoc.Lua.Marshal.Shared (walkBlocksAndInlines) import Text.Pandoc.Lua.Walk (applyStraight)-import Text.Pandoc.Definition (Pandoc (..), Meta (..), nullMeta)+import Text.Pandoc.Walk (Walkable (walk))+import qualified Text.Pandoc.Builder as B  -- | Pushes a 'Pandoc' value as userdata. pushPandoc :: LuaError e => Pusher e Pandoc@@ -74,6 +79,11 @@       <#> parameter peekPandoc "Pandoc" "doc" "self"       =#> functionResult pushPandoc "Pandoc" "cloned Pandoc document" +  , method $ defun "normalize"+      ### liftPure normalize+      <#> udparam typePandoc "self" ""+      =#> udresult typePandoc "cloned and normalized document"+   , method $ defun "walk"     ### flip applyFully     <#> parameter peekPandoc "Pandoc" "self" ""@@ -149,3 +159,17 @@   WalkTopdown     -> applyPandocFunction filter' doc                  >>= applyMetaFunction filter'                  >>= walkBlocksAndInlines filter'++-- | Normalize a document+normalize :: (Walkable [B.Inline] a, Walkable B.Block a) => a -> a+normalize =+  let normalizeBlock = \case+        B.Table attr capt specs th tbs tf ->+          let twidth = length specs+              th'  = B.normalizeTableHead twidth th+              tbs' = map (B.normalizeTableBody twidth) tbs+              tf'  = B.normalizeTableFoot twidth tf+          in B.Table attr capt specs th' tbs' tf'+        x -> x+  in walk normalizeBlock .+     walk (B.toList . mconcat . map (B.singleton @B.Inline))

@@ -47,7 +47,7 @@  -- | Row object type. typeRow :: LuaError e => DocumentedType e Row-typeRow = deftype "pandoc Row"+typeRow = deftype "Row"   [ operation Eq $ defun "__eq"      ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))      <#> parameter (optional . peekRow) "Row" "self" ""

@@ -32,7 +32,7 @@  -- | Row object type. typeTableFoot :: LuaError e => DocumentedType e TableFoot-typeTableFoot = deftype "pandoc TableFoot"+typeTableFoot = deftype "TableFoot"   [ operation Eq $ defun "__eq"      ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))      <#> parameter (optional . peekTableFoot) "TableFoot" "self" ""

@@ -32,7 +32,7 @@  -- | Row object type. typeTableHead :: LuaError e => DocumentedType e TableHead-typeTableHead = deftype "pandoc TableHead"+typeTableHead = deftype "TableHead"   [ operation Eq $ defun "__eq"      ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))      <#> parameter (optional . peekTableHead) "TableHead" "self" ""

@@ -9,10 +9,7 @@ with tables. -} module Text.Pandoc.Lua.Marshal.TableParts-  ( peekCaption-  , peekCaptionFuzzy-  , pushCaption-  , peekColSpec+  ( peekColSpec   , pushColSpec   , peekRow   , peekRowFuzzy@@ -29,41 +26,16 @@   , 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

@@ -181,7 +181,7 @@         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 @@       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 @@         )       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'} @@ -710,6 +710,21 @@           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),+     }   } }

@@ -172,6 +172,20 @@         assert.are_equal(elem, Quoted(DoubleQuote, {'a'}))       end)     },+    group 'RawInline' {+      test('has property `format`', function ()+        local elem = RawInline('html', '<mark>nice</mark>')+        assert.are_same(elem.format, 'html')+        elem.format = 'html5'+        assert.are_equal(elem, RawInline('html5', '<mark>nice</mark>'))+      end),+      test('has property `text`', function ()+        local elem = RawInline('html', '<mark>nice</mark>')+        assert.are_same(elem.text, '<mark>nice</mark>')+        elem.text = '<var>x</var>'+        assert.are_equal(elem, RawInline('html', '<var>x</var>'))+      end)+    },     group 'SmallCaps' {       test('has property `content`', function ()         local elem = SmallCaps{'two', Space(), 'words'}@@ -497,6 +511,20 @@           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)     }   } }

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

@@ -60,6 +60,48 @@       assert.are_same(Blocks{'different'}, copy.blocks)     end),   },+  group 'normalize' {+    test('removes repeated whitespace', function ()+      local doc = Pandoc{+        Plain{'before', Space(), SoftBreak(), 'after'}+      }+      assert.are_equal(+        Blocks{Plain{'before', SoftBreak(), 'after'}},+        doc:normalize().blocks+      )+    end),+    test('normalizes table', function ()+      local attr = Attr('test')+      local caption = Blocks('Sample caption')+      local colspecs = {{'AlignDefault', 0.5}, {'AlignLeft', 0.5}}+      local thead = TableHead({Row{Cell'header cell'}})+      local tbody = {+        attr = Attr(),+        body = List{+          Row{Cell'body cell 1', Cell'body cell 2'},+          Row{Cell('hi')},+        },+        head = List{},+        row_head_columns = 0,+      }+      local tfoot = TableFoot()+      local tbl = Table(caption, colspecs, thead, {tbody}, tfoot)+      print(tbl.bodies)+      local expected_body = tbody+      expected_body.body[2].cells:insert(Cell{})+      local doc = Pandoc{tbl}+      assert.are_same(+        Table(+          caption,+          colspecs,+          TableHead({Row{Cell'header cell', Cell{}}}),+          {expected_body},+          tfoot+        ),+        doc:normalize().blocks[1]+      )+    end)+  },   group 'walk' {     test('uses `Meta` function', function ()       local meta = {