packages feed

pandoc-lua-marshal 0.1.0.1 → 0.1.1

raw patch · 17 files changed

+1280/−90 lines, 17 filesdep +containersPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

API changes (from Hackage documentation)

+ Text.Pandoc.Lua.Marshal.Block: walkBlockSplicing :: (LuaError e, Walkable (SpliceList Block) a) => Filter -> a -> LuaE e a
+ Text.Pandoc.Lua.Marshal.Block: walkBlocksStraight :: (LuaError e, Walkable [Block] a) => Filter -> a -> LuaE e a
+ Text.Pandoc.Lua.Marshal.Cell: mkCell :: LuaError e => DocumentedFunction e
+ Text.Pandoc.Lua.Marshal.Cell: peekCellFuzzy :: LuaError e => Peeker e Cell
+ Text.Pandoc.Lua.Marshal.Cell: typeCell :: LuaError e => DocumentedType e Cell
+ Text.Pandoc.Lua.Marshal.Filter: Filter :: Map Name FilterFunction -> Filter
+ Text.Pandoc.Lua.Marshal.Filter: FilterFunction :: Reference -> FilterFunction
+ Text.Pandoc.Lua.Marshal.Filter: baseFunctionName :: forall a. Data a => Proxy a -> Name
+ Text.Pandoc.Lua.Marshal.Filter: getFunctionFor :: forall a. Data a => Filter -> a -> Maybe FilterFunction
+ Text.Pandoc.Lua.Marshal.Filter: listFunctionName :: forall a. Data a => Proxy a -> Name
+ Text.Pandoc.Lua.Marshal.Filter: lookup :: Name -> Filter -> Maybe FilterFunction
+ Text.Pandoc.Lua.Marshal.Filter: member :: Name -> Filter -> Bool
+ Text.Pandoc.Lua.Marshal.Filter: newtype Filter
+ Text.Pandoc.Lua.Marshal.Filter: newtype FilterFunction
+ Text.Pandoc.Lua.Marshal.Filter: peekFilter :: LuaError e => Peeker e Filter
+ Text.Pandoc.Lua.Marshal.Filter: peekFilterFunction :: Peeker e FilterFunction
+ Text.Pandoc.Lua.Marshal.Filter: pushFilterFunction :: LuaError e => FilterFunction -> LuaE e ()
+ Text.Pandoc.Lua.Marshal.Filter: valueFunctionNames :: forall a. Data a => Proxy a -> [Name]
+ Text.Pandoc.Lua.Marshal.Inline: walkInlineSplicing :: (LuaError e, Walkable (SpliceList Inline) a) => Filter -> a -> LuaE e a
+ Text.Pandoc.Lua.Marshal.Inline: walkInlinesStraight :: (LuaError e, Walkable [Inline] a) => Filter -> a -> LuaE e a
+ Text.Pandoc.Lua.Marshal.Pandoc: applyFully :: LuaError e => Filter -> Pandoc -> LuaE e Pandoc

Files

CHANGELOG.md view
@@ -1,19 +1,83 @@ # Changelog -`pandoc-lua-marshal` uses [PVP Versioning][1].-The changelog is available [on GitHub][2].+`pandoc-lua-marshal` uses [PVP Versioning][]. +## 0.1.1++Released 2021-12-10.++### Behavior of Lua objects++-   Lists of Inline values and lists of Block values are now+    pushed with their own metatables (named "Inlines" and+    "Blocks").++-   The types `Block`, `Blocks`, `Inline`, `Inlines`, and+    `Pandoc` now all have a method `walk` that applies a filter+    to the document subtree.++-   Changed behavior for *Cell* values: these are now pushed as+    userdata; the old table-based structure is still accepted+    when retrieving a Cell from the stack.++### Haskell code++-   Module Text.Pandoc.Lua.Marshal.Cell exports the constructor+    function `mkCell`, the type definition `typeCell` and the+    fuzzy peeker `peekCellFuzzy`.++-   Added a new module `Text.Pandoc.Lua.Marshal.Filter` that+    handles Lua filters.++-   Added functions for filtering:++    -   Module Text.Pandoc.Lua.Marshal.Block:+        -   `walkBlockSplicing`: walk an AST element, applying a+            filter on each Block and splicing the result back+            into the list.+        -   `walkBlocks`: walk an AST element, modifying lists of+            Block elements by applying the `Blocks` filter+            function.+    -   Module Text.Pandoc.Lua.Marshal.Inline:+        -   `walkInlineSplicing`: walk an AST element, applying a+            filter on each Inline and splicing the result back+            into the list.+        -   `walkInlines`: walk an AST element, modifying lists+            of Inline elements by applying the `Inlines` filter+            function.++    -   Module Text.Pandoc.Lua.Marshal.Pandoc:+        -   `applyFully`: fully apply a filter on a Pandoc+            document.++-   New internal modules:++    -   Text.Pandoc.Lua.SpliceList: defines a helper type used to+        walk a list of elements in a way that replaces the+        element by splicing the function result back into the+        list.++        The module is a slight rewrite of pandoc’s+        `SingletonsList`.++    -   Text.Pandoc.Lua.Walk: handles walking of the document+        tree while modifying elements via filter functions. This+        is a re-implementation of large parts of pandoc’s+        T.P.Lua.Filter module.++    -   Text.Pandoc.Lua.Marshal.Shared: provides helper functions+        used in multiple Lua type definitions.+ ## 0.1.0.1  Released 2021-11-28. -* Added test-simpletable.lua to the list of extra-source-files.+-   Added test-simpletable.lua to the list of extra-source-files.  ## 0.1.0  Released 2021-11-28. -* Released into the wild. May it live long and prosper.+-   Released into the wild. May it live long and prosper. -[1]: https://pvp.haskell.org-[2]: https://github.com/pandoc/pandoc-lua-marshal/releases+  [PVP Versioning]: https://pvp.haskell.org
pandoc-lua-marshal.cabal view
@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                pandoc-lua-marshal-version:             0.1.0.1+version:             0.1.1 synopsis:            Use pandoc types in Lua description:         This package provides functions to marshal and unmarshal                      pandoc document types to and from Lua.@@ -31,6 +31,7 @@                      GHC == 9.2.1 extra-source-files:  test/test-attr.lua                    , test/test-block.lua+                   , test/test-cell.lua                    , test/test-citation.lua                    , test/test-inline.lua                    , test/test-listattributes.lua@@ -46,6 +47,7 @@ common common-options   build-depends:       base                  >= 4.12     && < 5                      , bytestring            >= 0.10     && < 0.12+                     , containers            >= 0.6      && < 0.7                      , exceptions            >= 0.8      && < 0.11                      , lua                   >= 2.0.2    && < 2.1                      , hslua                 >= 2.0.1    && < 2.1@@ -80,6 +82,7 @@                      , Text.Pandoc.Lua.Marshal.Citation                      , Text.Pandoc.Lua.Marshal.CitationMode                      , Text.Pandoc.Lua.Marshal.Content+                     , Text.Pandoc.Lua.Marshal.Filter                      , Text.Pandoc.Lua.Marshal.Format                      , Text.Pandoc.Lua.Marshal.Inline                      , Text.Pandoc.Lua.Marshal.List@@ -90,6 +93,9 @@                      , Text.Pandoc.Lua.Marshal.QuoteType                      , Text.Pandoc.Lua.Marshal.SimpleTable                      , Text.Pandoc.Lua.Marshal.TableParts+  other-modules:       Text.Pandoc.Lua.Marshal.Shared+                     , Text.Pandoc.Lua.SpliceList+                     , Text.Pandoc.Lua.Walk  test-suite pandoc-lua-marshal-test   import:              common-options
src/Text/Pandoc/Lua/Marshal/Block.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE AllowAmbiguousTypes  #-}+{-# LANGUAGE FlexibleContexts     #-} {-# LANGUAGE LambdaCase           #-} {-# LANGUAGE OverloadedStrings    #-} {-# LANGUAGE ScopedTypeVariables  #-}@@ -18,6 +20,9 @@     -- * Constructors   , blockConstructors   , mkBlocks+    -- * Walk+  , walkBlockSplicing+  , walkBlocksStraight   ) where  import Control.Applicative ((<|>))@@ -32,10 +37,13 @@ import Text.Pandoc.Lua.Marshal.Content   ( Content (..), contentTypeDescription, peekContent, pushContent   , peekDefinitionItem )+import Text.Pandoc.Lua.Marshal.Filter (Filter, peekFilter) import Text.Pandoc.Lua.Marshal.Format (peekFormat, pushFormat) import Text.Pandoc.Lua.Marshal.Inline (peekInlinesFuzzy) import Text.Pandoc.Lua.Marshal.List (newListMetatable, pushPandocList)-import Text.Pandoc.Lua.Marshal.ListAttributes (peekListAttributes, pushListAttributes)+import Text.Pandoc.Lua.Marshal.ListAttributes+  ( peekListAttributes, pushListAttributes )+import Text.Pandoc.Lua.Marshal.Shared (walkBlocksAndInlines) import Text.Pandoc.Lua.Marshal.TableParts   ( peekCaption, pushCaption   , peekColSpec, pushColSpec@@ -43,6 +51,7 @@   , peekTableFoot, pushTableFoot   , peekTableHead, pushTableHead   )+import Text.Pandoc.Lua.Walk (SpliceList, Walkable, walkStraight, walkSplicing) import Text.Pandoc.Definition  -- | Pushes an Block value as userdata object.@@ -66,8 +75,14 @@            => Pusher e [Block] pushBlocks xs = do   pushList pushBlock xs-  newListMetatable "Blocks" $-    pure ()+  newListMetatable "Blocks" $ do+    pushName "walk"+    pushDocumentedFunction $ lambda+      ### flip walkBlocksAndInlines+      <#> parameter peekBlocksFuzzy "Blocks" "self" ""+      <#> parameter peekFilter "Filter" "lua_filter" "table of filter functions"+      =#> functionResult pushBlocks "Blocks" "modified list"+    rawset (nth 3)   setmetatable (nth 2) {-# INLINABLE pushBlocks #-} @@ -191,6 +206,12 @@     ### liftPure show     <#> parameter peekBlock "Block" "self" ""     =#> functionResult pushString "string" "Haskell string representation"++  , method $ defun "walk"+    ### flip walkBlocksAndInlines+    <#> parameter peekBlock "Block" "self" ""+    <#> parameter peekFilter "Filter" "lua_filter" "table of filter functions"+    =#> functionResult pushBlock "Block" "modified element"   ]  where   boolResult = functionResult pushBool "boolean"@@ -382,3 +403,15 @@   ### liftPure id   <#> parameter peekBlocksFuzzy "Blocks" "blocks" "block elements"   =#> functionResult pushBlocks "Blocks" "list of block elements"++--+-- walk+--++walkBlockSplicing :: (LuaError e, Walkable (SpliceList Block) a)+                  => Filter -> a -> LuaE e a+walkBlockSplicing = walkSplicing pushBlock peekBlocksFuzzy++walkBlocksStraight :: (LuaError e, Walkable [Block] a)+                   => Filter -> a -> LuaE e a+walkBlocksStraight = walkStraight "Blocks" pushBlocks peekBlocksFuzzy
src/Text/Pandoc/Lua/Marshal/Block.hs-boot view
@@ -1,12 +1,39 @@+{-# LANGUAGE FlexibleContexts     #-} module Text.Pandoc.Lua.Marshal.Block-  ( peekBlocksFuzzy+  ( -- * Single Block elements+    peekBlock+  , peekBlockFuzzy+  , pushBlock+    -- * List of Blocks+  , peekBlocks+  , peekBlocksFuzzy   , pushBlocks+    -- * Constructors+  , blockConstructors+  , mkBlocks+    -- * Walk+  , walkBlockSplicing+  , walkBlocksStraight   ) where  import HsLua import Text.Pandoc.Definition---- | Pushes a list of Block values.-pushBlocks :: LuaError e => Pusher e [Block]+import Text.Pandoc.Lua.Marshal.Filter (Filter)+import Text.Pandoc.Lua.Walk (SpliceList, Walkable) +-- * Single Block elements+peekBlock      :: LuaError e => Peeker e Block+peekBlockFuzzy :: LuaError e => Peeker e Block+pushBlock      :: LuaError e => Pusher e Block+-- * List of Blocks+peekBlocks      :: LuaError e => Peeker e [Block] peekBlocksFuzzy :: LuaError e => Peeker e [Block]+pushBlocks      :: LuaError e => Pusher e [Block]+-- * Constructors+blockConstructors :: LuaError e => [DocumentedFunction e]+mkBlocks          :: LuaError e => DocumentedFunction e+-- * Walk+walkBlockSplicing  :: (LuaError e, Walkable (SpliceList Block) a)+                   => Filter -> a -> LuaE e a+walkBlocksStraight :: (LuaError e, Walkable [Block] a)+                   => Filter -> a -> LuaE e a
src/Text/Pandoc/Lua/Marshal/Cell.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE LambdaCase           #-} {- | Copyright               : © 2021 Albert Krewinkel SPDX-License-Identifier : MIT@@ -8,37 +9,106 @@ -} module Text.Pandoc.Lua.Marshal.Cell   ( peekCell+  , peekCellFuzzy   , pushCell+  , typeCell+  , mkCell   ) where +import Control.Applicative (optional) import Control.Monad ((<$!>))+import Data.Maybe (fromMaybe) 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 Text.Pandoc.Definition (Cell (..), RowSpan (..), ColSpan (..))+import Text.Pandoc.Lua.Marshal.Filter (peekFilter)+import Text.Pandoc.Lua.Marshal.Shared (walkBlocksAndInlines)+import Text.Pandoc.Definition  -- | Push a table cell as a table with fields @attr@, @alignment@, -- @row_span@, @col_span@, and @contents@. pushCell :: LuaError e => Cell -> LuaE e ()-pushCell (Cell attr align (RowSpan rowSpan) (ColSpan colSpan) contents) = do-  newtable-  addField "attr" (pushAttr attr)-  addField "alignment" (pushAlignment align)-  addField "row_span" (pushIntegral rowSpan)-  addField "col_span" (pushIntegral colSpan)-  addField "contents" (pushBlocks contents)- where addField key pusher = pushName key *> pusher *> rawset (nth 3)+pushCell = pushUD typeCell --- | Retrieves a table 'Cell' from the stack.+-- | Retrieves a 'Cell' object from the stack. peekCell :: LuaError e => Peeker e Cell-peekCell = fmap (retrieving "Cell")-  . typeChecked "table" istable-  $ \idx -> do-  attr <- peekFieldRaw peekAttr "attr" idx-  algn <- peekFieldRaw peekAlignment "alignment" idx-  rs   <- RowSpan <$!> peekFieldRaw peekIntegral "row_span" idx-  cs   <- ColSpan <$!> peekFieldRaw peekIntegral "col_span" idx-  blks <- peekFieldRaw peekBlocksFuzzy "contents" idx-  return $! Cell attr algn rs cs blks+peekCell = peekUD typeCell++-- | Retrieves a 'Cell' from the stack, accepting either a 'pandoc Cell'+-- userdata object or a table with fields @attr@, @alignment@, @row_span@,+-- @col_span@, and @contents@.+peekCellFuzzy :: LuaError e => Peeker e Cell+peekCellFuzzy idx = liftLua (ltype idx) >>= \case+  TypeUserdata -> peekCell idx+  TypeTable -> do+    attr <- peekFieldRaw peekAttr "attr" idx+    algn <- peekFieldRaw peekAlignment "alignment" idx+    rs   <- RowSpan <$!> peekFieldRaw peekIntegral "row_span" idx+    cs   <- ColSpan <$!> peekFieldRaw peekIntegral "col_span" idx+    blks <- peekFieldRaw peekBlocksFuzzy "contents" idx+    return $! Cell attr algn rs cs blks+  _ -> failPeek =<< typeMismatchMessage "Cell or table" idx++-- | Cell object type.+typeCell :: LuaError e => DocumentedType e Cell+typeCell = deftype "pandoc Cell"+  [ operation Eq $ defun "__eq"+     ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))+     <#> parameter (optional . peekCell) "Cell" "self" ""+     <#> parameter (optional . peekCell) "any" "object" ""+     =#> functionResult pushBool "boolean" "true iff the two values are equal"+  , operation Tostring $ lambda+    ### liftPure show+    <#> parameter peekCell "Cell" "self" ""+    =#> functionResult pushString "string" "native Haskell representation"+  ]+  [ property "attr" "cell attributes"+      (pushAttr, \(Cell attr _ _ _ _) -> attr)+      (peekAttr, \(Cell _ align rs cs blks) attr ->+                   Cell attr align rs cs blks)+  , property "alignment" "alignment of cell contents"+      (pushAlignment, \(Cell _ align _ _ _) -> align)+      (peekAlignment, \(Cell attr _ rs cs blks) align ->+                        Cell attr align rs cs blks)+  , property "row_span" "number of rows over which this cell spans"+      (pushIntegral, \(Cell _ _ (RowSpan rs) _ _) -> rs)+      (peekIntegral, \(Cell attr align _ cs blks) rs ->+                       Cell attr align (RowSpan rs) cs blks)+  , property "col_span" "number of columns over which this cell spans"+      (pushIntegral, \(Cell _ _ _ (ColSpan rs) _) -> rs)+      (peekIntegral, \(Cell attr align rs _ blks) cs ->+                       Cell attr align rs (ColSpan cs) blks)+  , property "contents" "cell contents"+      (pushBlocks, \(Cell _ _ _ _ blks) -> blks)+      (peekBlocksFuzzy, \(Cell attr align rs cs _) blks ->+                          Cell attr align rs cs blks)++  , alias "content"    "alias for contents" ["contents"]+  , alias "identifier" "cell ID"         ["attr", "identifier"]+  , alias "classes"    "cell classes"    ["attr", "classes"]+  , alias "attributes" "cell attributes" ["attr", "attributes"]++  , method $ defun "walk"+    ### flip walkBlocksAndInlines+    <#> parameter peekCell "Cell" "self" ""+    <#> parameter peekFilter "Filter" "lua_filter" "table of filter functions"+    =#> functionResult pushCell "Cell" "modified cell"+  ]++-- | Constructor function for 'Cell' values.+mkCell :: LuaError e => DocumentedFunction e+mkCell = defun "Cell"+  ### liftPure5 (\blocks mAlign mRowSpan mColSpan mAttr -> Cell+                  (fromMaybe nullAttr mAttr)+                  (fromMaybe AlignDefault mAlign)+                  (maybe 1 RowSpan mRowSpan)+                  (maybe 1 ColSpan mColSpan)+                  blocks)+  <#> parameter peekBlocksFuzzy "Blocks" "blocks" "document contents"+  <#> optionalParameter peekAlignment "integer" "align" "cell alignment"+  <#> optionalParameter peekIntegral "integer" "row_span" "rows to span"+  <#> optionalParameter peekIntegral "integer" "col_span" "columns to span"+  <#> optionalParameter peekAttr "Attr" "attr" "cell attributes"+  =#> functionResult pushCell "Cell" "new Cell object"
+ src/Text/Pandoc/Lua/Marshal/Filter.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE LambdaCase           #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE TypeApplications     #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{- |+Copyright  : © 2021 Albert Krewinkel+License    : MIT+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Marshaling/unmarshaling functions Lua filters, i.e., tables containing+functions to be called on specific elements.+-}+module Text.Pandoc.Lua.Marshal.Filter+  ( -- * Filters+    Filter (..)+  , peekFilter+  , lookup+  , member+    -- * Individual filter functions+  , FilterFunction (..)+  , peekFilterFunction+  , pushFilterFunction+  , getFunctionFor+    -- * Names in filter functions+  , baseFunctionName+  , listFunctionName+  , valueFunctionNames+  ) where++import Prelude hiding (lookup)+import Control.Applicative ((<|>))+import Control.Monad ((<$!>))+import Data.Data+  ( Data, dataTypeConstrs, dataTypeName, dataTypeOf+  , showConstr, toConstr, tyconUQname )+import Data.Foldable (foldrM)+import Data.Map (Map)+import Data.Proxy (Proxy (Proxy))+import Data.String (IsString (fromString))+import HsLua+import Text.Pandoc.Definition (Pandoc, Meta, Block, Inline)+import qualified Data.Map.Strict as Map++-- | Filter function stored in the registry+newtype FilterFunction = FilterFunction Reference++-- | Pushes a filter function to the stack.+--+-- Filter functions are stored in the registry and retrieved from there.+pushFilterFunction :: LuaError e => FilterFunction -> LuaE e ()+pushFilterFunction (FilterFunction fnRef) =+  getref registryindex fnRef++-- | Retrieves a filter function from the stack.+--+-- The value at the given index must be a function. It is stored in the+-- Lua registry.+peekFilterFunction :: Peeker e FilterFunction+peekFilterFunction = typeChecked "function" isfunction $ \idx -> liftLua $ do+  pushvalue idx+  FilterFunction <$> ref registryindex+++-- | Collection of filter functions (at most one function per element+-- constructor)+newtype Filter = Filter (Map Name FilterFunction)++-- | Retrieves a default `Filter` object from the stack, suitable for+-- filtering a full document.+peekFilter :: LuaError e => Peeker e Filter+peekFilter = peekFilter' $+    baseFunctionName (Proxy @Pandoc)+  : baseFunctionName (Proxy @Meta)+  : baseFunctionName (Proxy @Block)+  : baseFunctionName (Proxy @Inline)+  : listFunctionName (Proxy @Block)+  : listFunctionName (Proxy @Inline)+  :  valueFunctionNames (Proxy @Inline)+  ++ valueFunctionNames (Proxy @Block)++-- | Retrieves a `Filter` object from the stack, fetching all functions+-- in the given list of names.+peekFilter' :: LuaError e => [Name] -> Peeker e Filter+peekFilter' fnNames idx = do+  let go constr acc = liftLua $ do+        _ <- getfield idx constr+        runPeek (peekFilterFunction top `lastly` pop 1) >>= \case+          Success fn -> pure $ Map.insert constr fn acc+          Failure {} -> pure acc+  Filter <$!> foldrM go Map.empty fnNames++-- | Looks up a filter function in a Lua 'Filter'.+lookup :: Name -> Filter -> Maybe FilterFunction+lookup name (Filter filterMap) = name `Map.lookup` filterMap++-- | Checks whether the 'Filter' contains a function of the given name.+member :: Name -> Filter -> Bool+member name (Filter filterMap) = name `Map.member` filterMap++-- | Filter function names for a given type.+valueFunctionNames :: forall a. Data a => Proxy a -> [Name]+valueFunctionNames _ = map (fromString . show) . dataTypeConstrs . dataTypeOf+                     $ (undefined :: a)++-- | The name of a type's base function, which is called if there is no+-- more specific function for a value.+baseFunctionName :: forall a. Data a => Proxy a -> Name+baseFunctionName _ =+  fromString . tyconUQname . dataTypeName . dataTypeOf+  $ (undefined :: a)++-- | The name of the functions that's called on lists of the given type.+listFunctionName :: forall a. Data a => Proxy a -> Name+listFunctionName _ =+  fromString . (++ "s") . tyconUQname . dataTypeName . dataTypeOf+  $ (undefined :: a)++getFunctionFor :: forall a. Data a => Filter -> a -> Maybe FilterFunction+getFunctionFor filter' x =+  let constrName = fromString . showConstr . toConstr $ x+      typeName = fromString . tyconUQname . dataTypeName . dataTypeOf $ x+  in constrName `lookup` filter' <|>+     typeName   `lookup` filter'
src/Text/Pandoc/Lua/Marshal/Inline.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts     #-} {-# LANGUAGE LambdaCase           #-} {-# LANGUAGE OverloadedStrings    #-} {-# LANGUAGE ScopedTypeVariables  #-}@@ -19,6 +20,9 @@     -- * Constructors   , inlineConstructors   , mkInlines+    -- * Walking+  , walkInlineSplicing+  , walkInlinesStraight   ) where  import Control.Monad.Catch (throwM)@@ -27,17 +31,19 @@ import Data.Maybe (fromMaybe) import Data.Text (Text) import HsLua+import Text.Pandoc.Definition (Inline (..), nullAttr) import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr)-import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Block-  ( peekBlocksFuzzy )+import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Block (peekBlocksFuzzy) import Text.Pandoc.Lua.Marshal.Citation (peekCitation, pushCitation) import Text.Pandoc.Lua.Marshal.Content   ( Content (..), contentTypeDescription, peekContent, pushContent )+import Text.Pandoc.Lua.Marshal.Filter (Filter, peekFilter) import Text.Pandoc.Lua.Marshal.Format (peekFormat, pushFormat) import Text.Pandoc.Lua.Marshal.List (pushPandocList, newListMetatable) import Text.Pandoc.Lua.Marshal.MathType (peekMathType, pushMathType) import Text.Pandoc.Lua.Marshal.QuoteType (peekQuoteType, pushQuoteType)-import Text.Pandoc.Definition ( Inline (..), nullAttr )+import Text.Pandoc.Lua.Marshal.Shared (walkBlocksAndInlines)+import Text.Pandoc.Lua.Walk (SpliceList, Walkable, walkSplicing, walkStraight) import qualified Text.Pandoc.Builder as B  -- | Pushes an Inline value as userdata object.@@ -61,8 +67,14 @@             => Pusher e [Inline] pushInlines xs = do   pushList pushInline xs-  newListMetatable "Inlines" $-    pure ()+  newListMetatable "Inlines" $ do+    pushName "walk"+    pushDocumentedFunction $ lambda+      ### flip walkBlocksAndInlines+      <#> parameter peekInlinesFuzzy "Blocks" "self" ""+      <#> parameter peekFilter "Filter" "lua_filter" "table of filter functions"+      =#> functionResult pushInlines "Blocks" "modified list"+    rawset (nth 3)   setmetatable (nth 2) {-# INLINABLE pushInlines #-} @@ -238,6 +250,12 @@       ### return       <#> parameter peekInline "inline" "Inline" "self"       =#> functionResult pushInline "Inline" "cloned Inline"++  , method $ defun "walk"+    ### flip walkBlocksAndInlines+    <#> parameter peekInline "Inline" "self" ""+    <#> parameter peekFilter "Filter" "lua_filter" "table of filter functions"+    =#> functionResult pushInline "Inline" "modified element"   ]  --@@ -352,3 +370,15 @@   ### liftPure id   <#> parameter peekInlinesFuzzy "Inlines" "inlines" "inline elements"   =#> functionResult pushInlines "Inlines" "list of inline elements"++-- | Walks an element of type @a@ and applies the filter to all 'Inline'+-- elements.  The filter result is spliced back into the list.+walkInlineSplicing :: (LuaError e, Walkable (SpliceList Inline) a)+                   => Filter -> a -> LuaE e a+walkInlineSplicing = walkSplicing pushInline peekInlinesFuzzy++-- | Walks an element of type @a@ and applies the filter to all lists of+-- 'Inline' elements.+walkInlinesStraight :: (LuaError e, Walkable [Inline] a)+                    => Filter -> a -> LuaE e a+walkInlinesStraight = walkStraight "Inlines" pushInlines peekInlinesFuzzy
src/Text/Pandoc/Lua/Marshal/Inline.hs-boot view
@@ -1,11 +1,39 @@+{-# LANGUAGE FlexibleContexts     #-} module Text.Pandoc.Lua.Marshal.Inline-  ( peekInlinesFuzzy+  ( -- * Single Inline elements+    peekInline+  , peekInlineFuzzy+  , pushInline+    -- * List of Inlines+  , peekInlines+  , peekInlinesFuzzy   , pushInlines-  )-where+    -- * Constructors+  , inlineConstructors+  , mkInlines+    -- * Walking+  , walkInlineSplicing+  , walkInlinesStraight+  ) where  import HsLua import Text.Pandoc.Definition (Inline)+import Text.Pandoc.Lua.Marshal.Filter (Filter)+import Text.Pandoc.Lua.Walk (SpliceList, Walkable) +-- * Single Inline elements+peekInline       :: LuaError e => Peeker e Inline+peekInlineFuzzy  :: LuaError e => Peeker e Inline+pushInline       :: LuaError e => Pusher e Inline+-- * List of Inlines+peekInlines      :: LuaError e => Peeker e [Inline] peekInlinesFuzzy :: LuaError e => Peeker e [Inline]-pushInlines :: LuaError e => Pusher e [Inline]+pushInlines      :: LuaError e => Pusher e [Inline]+-- * Constructors+inlineConstructors :: LuaError e => [DocumentedFunction e]+mkInlines          :: LuaError e => DocumentedFunction e+-- * Walking+walkInlineSplicing  :: (LuaError e, Walkable (SpliceList Inline) a)+                    => Filter -> a -> LuaE e a+walkInlinesStraight :: (LuaError e, Walkable [Inline] a)+                    => Filter -> a -> LuaE e a
src/Text/Pandoc/Lua/Marshal/Pandoc.hs view
@@ -15,14 +15,21 @@   , peekMeta   , pushMeta   , mkMeta+    -- * Filtering+  , applyFully   ) where  import Control.Applicative (optional)-import Control.Monad ((<$!>))+import Control.Monad ((<$!>), (>=>)) import Data.Maybe (fromMaybe) import HsLua-import Text.Pandoc.Lua.Marshal.Block (peekBlocksFuzzy, pushBlocks)+import Text.Pandoc.Lua.Marshal.Block+  (peekBlocksFuzzy, pushBlocks, walkBlockSplicing, walkBlocksStraight)+import Text.Pandoc.Lua.Marshal.Inline (walkInlineSplicing, walkInlinesStraight)+import Text.Pandoc.Lua.Marshal.Filter (Filter, peekFilter) 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)  -- | Pushes a 'Pandoc' value as userdata.@@ -52,6 +59,15 @@   , property "meta" "document metadata"       (pushMeta, \(Pandoc meta _) -> meta)       (peekMeta, \(Pandoc _ blks) meta -> Pandoc meta blks)++  , method $ defun "walk"+    ### (\doc filter' ->+               walkBlocksAndInlines filter' doc+           >>= applyMetaFunction filter'+           >>= applyPandocFunction filter')+    <#> parameter peekPandoc "Pandoc" "self" ""+    <#> parameter peekFilter "Filter" "lua_filter" "table of filter functions"+    =#> functionResult pushPandoc "Pandoc" "modified element"   ]  -- | Pushes a 'Meta' value as a string-indexed table.@@ -80,3 +96,45 @@   ### liftPure id   <#> parameter peekMeta "table" "meta" "table containing meta information"   =#> functionResult pushMeta "table" "new Meta table"++-- | Applies a filter function to a Pandoc value.+applyPandocFunction :: LuaError e+                          => Filter+                          -> Pandoc -> LuaE e Pandoc+applyPandocFunction = applyStraight pushPandoc peekPandoc++-- | Applies a filter function to a Meta value.+applyMetaFunction :: LuaError e+                        => Filter+                        -> Pandoc -> LuaE e Pandoc+applyMetaFunction filter' (Pandoc meta blocks) = do+  meta' <- applyStraight pushMeta peekMeta filter' meta+  pure (Pandoc meta' blocks)++-- | Apply all components of a Lua filter.+--+-- These operations are run in order:+--+-- - Inline filter functions are applied to Inline elements, splicing+--   the result back into the list of Inline elements+--+-- - The @Inlines@ function is applied to all lists of Inlines.+--+-- - Block filter functions are applied to Block elements, splicing the+--   result back into the list of Block elements+--+-- - The @Blocks@ function is applied to all lists of Blocks.+--+-- - The @Meta@ function is applied to the 'Meta' part.+--+-- - The @Pandoc@ function is applied to the full 'Pandoc' element.+applyFully :: LuaError e+           => Filter+           -> Pandoc -> LuaE e Pandoc+applyFully filter' =+      walkInlineSplicing filter'+  >=> walkInlinesStraight filter'+  >=> walkBlockSplicing filter'+  >=> walkBlocksStraight filter'+  >=> applyMetaFunction filter'+  >=> applyPandocFunction filter'
+ src/Text/Pandoc/Lua/Marshal/Shared.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE FlexibleContexts     #-}+{- |+Copyright   : © 2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Shared functions used in multiple types.+-}+module Text.Pandoc.Lua.Marshal.Shared+  ( -- * Walking+    walkBlocksAndInlines+  ) where++import Control.Monad ((>=>))+import HsLua (LuaE, LuaError)+import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Block+  ( walkBlockSplicing, walkBlocksStraight )+import Text.Pandoc.Lua.Marshal.Filter (Filter)+import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Inline+  ( walkInlineSplicing, walkInlinesStraight )+import Text.Pandoc.Definition+import Text.Pandoc.Lua.Walk (SpliceList, Walkable)++-- | Walk blocks and inlines.+walkBlocksAndInlines :: (LuaError e,+                         Walkable (SpliceList Block) a,+                         Walkable (SpliceList Inline) a,+                         Walkable [Block] a,+                         Walkable [Inline] a)+                     => Filter+                     -> a -> LuaE e a+walkBlocksAndInlines f =+      walkInlineSplicing f+  >=> walkInlinesStraight f+  >=> walkBlockSplicing f+  >=> walkBlocksStraight f
+ src/Text/Pandoc/Lua/SpliceList.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE DeriveTraversable     #-}+{-# LANGUAGE DerivingStrategies    #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{- |+Module      : Text.Pandoc.Lua.Walk+Copyright   : © 2012-2021 John MacFarlane,+              © 2017-2021 Albert Krewinkel+License     : GNU GPL, version 2 or above+Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Walking documents in a filter-suitable way.+-}+module Text.Pandoc.Lua.SpliceList+  ( SpliceList (..)+  )+where++import Control.Monad ((<=<))+import Text.Pandoc.Definition+import Text.Pandoc.Walk++-- | Helper type which allows to traverse trees in order, while splicing+-- in trees.+--+-- The only interesting use of this type is via it's '@Walkable@'+-- instance. That instance makes it possible to walk a Pandoc document+-- (or a subset thereof), while applying a function on each element of+-- an AST element /list/, and have the resulting list spliced back in+-- place of the original element. This is the traversal/splicing method+-- used for Lua filters.+newtype SpliceList a = SpliceList { unSpliceList :: [a] }+  deriving stock (Functor, Foldable, Traversable)++--+-- SpliceList Inline+--+instance {-# OVERLAPPING #-} Walkable (SpliceList Inline) [Inline] where+  walkM = walkSpliceListM+  query = querySpliceList++instance Walkable (SpliceList Inline) Pandoc where+  walkM = walkPandocM+  query = queryPandoc++instance Walkable (SpliceList Inline) Citation where+  walkM = walkCitationM+  query = queryCitation++instance Walkable (SpliceList Inline) Inline where+  walkM = walkInlineM+  query = queryInline++instance Walkable (SpliceList Inline) Block where+  walkM = walkBlockM+  query = queryBlock++instance Walkable (SpliceList Inline) Row where+  walkM = walkRowM+  query = queryRow++instance Walkable (SpliceList Inline) TableHead where+  walkM = walkTableHeadM+  query = queryTableHead++instance Walkable (SpliceList Inline) TableBody where+  walkM = walkTableBodyM+  query = queryTableBody++instance Walkable (SpliceList Inline) TableFoot where+  walkM = walkTableFootM+  query = queryTableFoot++instance Walkable (SpliceList Inline) Caption where+  walkM = walkCaptionM+  query = queryCaption++instance Walkable (SpliceList Inline) Cell where+  walkM = walkCellM+  query = queryCell++instance Walkable (SpliceList Inline) MetaValue where+  walkM = walkMetaValueM+  query = queryMetaValue++instance Walkable (SpliceList Inline) Meta where+  walkM f (Meta metamap) = Meta <$> walkM f metamap+  query f (Meta metamap) = query f metamap++--+-- SpliceList Block+--+instance {-# OVERLAPPING #-} Walkable (SpliceList Block) [Block] where+  walkM = walkSpliceListM+  query = querySpliceList++instance Walkable (SpliceList Block) Pandoc where+  walkM = walkPandocM+  query = queryPandoc++instance Walkable (SpliceList Block) Citation where+  walkM = walkCitationM+  query = queryCitation++instance Walkable (SpliceList Block) Inline where+  walkM = walkInlineM+  query = queryInline++instance Walkable (SpliceList Block) Block where+  walkM = walkBlockM+  query = queryBlock++instance Walkable (SpliceList Block) Row where+  walkM = walkRowM+  query = queryRow++instance Walkable (SpliceList Block) TableHead where+  walkM = walkTableHeadM+  query = queryTableHead++instance Walkable (SpliceList Block) TableBody where+  walkM = walkTableBodyM+  query = queryTableBody++instance Walkable (SpliceList Block) TableFoot where+  walkM = walkTableFootM+  query = queryTableFoot++instance Walkable (SpliceList Block) Caption where+  walkM = walkCaptionM+  query = queryCaption++instance Walkable (SpliceList Block) Cell where+  walkM = walkCellM+  query = queryCell++instance Walkable (SpliceList Block) MetaValue where+  walkM = walkMetaValueM+  query = queryMetaValue++instance Walkable (SpliceList Block) Meta where+  walkM f (Meta metamap) = Meta <$> walkM f metamap+  query f (Meta metamap) = query f metamap+++walkSpliceListM :: (Monad m, Walkable (SpliceList a) a)+                => (SpliceList a -> m (SpliceList a))+                -> [a] -> m [a]+walkSpliceListM f =+  let f' = fmap unSpliceList . f . SpliceList . (:[]) <=< walkM f+  in fmap mconcat . mapM f'++querySpliceList :: (Monoid c, Walkable (SpliceList a) a)+                => (SpliceList a -> c)+                -> [a] -> c+querySpliceList f =+  let f' x = f (SpliceList [x]) `mappend` query f x+  in mconcat . map f'
+ src/Text/Pandoc/Lua/Walk.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{- |+Module      : Text.Pandoc.Lua.Walk+Copyright   : © 2012-2021 John MacFarlane,+              © 2017-2021 Albert Krewinkel+License     : GNU GPL, version 2 or above+Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Walking documents in a filter-suitable way.+-}+module Text.Pandoc.Lua.Walk+  ( SpliceList (..)+  , Walkable+  , walkSplicing+  , walkStraight+  , applyStraight+  , applySplicing+  )+where++import Prelude hiding (lookup)+import Control.Applicative ((<|>))+import Control.Monad ((<$!>), when)+import Data.Data (Data)+import Data.Proxy (Proxy (..))+import HsLua+import Text.Pandoc.Lua.Marshal.Filter+import Text.Pandoc.Lua.SpliceList (SpliceList (..))+import Text.Pandoc.Walk++--+-- Straight+--++-- | Walks an element, modifying all values of type @a@ by applying the+-- given Lua 'Filter'.+walkStraight :: forall e a b. (LuaError e, Walkable a b)+             => Name  -- ^ Name under which the filter function is stored+             -> Pusher e a+             -> Peeker e a+             -> Filter+             -> b -> LuaE e b+walkStraight filterFnName pushElement peekElement filter' =+  case filterFnName `lookup` filter' of+    Nothing ->+      -- There is no filter function, do nothing.+      pure+    Just fn ->+      -- Walk the element with the filter function.+      walkM $ applyStraightFunction fn pushElement peekElement++-- | Applies a filter on an element. The element is pushed to the stack+-- via the given pusher and calls the filter function with that value,+-- leaving the filter function's return value on the stack.+applyStraight :: (LuaError e, Data a)+              => Pusher e a -> Peeker e a -> Filter+              -> a -> LuaE e a+applyStraight pushElement peekElement filter' x = do+  case filter' `getFunctionFor` x of+    Nothing ->+      -- There is no filter function, do nothing.+      pure x+    Just fn -> do+      -- Apply the function+      applyStraightFunction fn pushElement peekElement x++-- | Applies a single filter function on an element. The element is+-- pushed to the stack via the given pusher and calls the filter+-- function with that value, leaving the filter function's return value+-- on the stack.+applyStraightFunction :: LuaError e+                      => FilterFunction -> Pusher e a -> Peeker e a+                      -> a -> LuaE e a+applyStraightFunction fn pushElement peekElement x = do+  pushFilterFunction fn+  pushElement x+  callWithTraceback 1 1+  forcePeek . (`lastly` pop 1) $+    (x <$ peekNil top) <|> peekElement top++--+-- Splicing+--++-- | Walks an element, using a Lua 'Filter' to modify all values of type+-- @a@ that are in a list. The result of the called filter function must+-- be a retrieved as a list, and it is spliced back into the list at the+-- position of the original element. This allows to delete an element,+-- or to replace an element with multiple elements.+walkSplicing :: forall e a b. (LuaError e, Data a, Walkable (SpliceList a) b)+             => Pusher e a+             -> Peeker e [a]+             -> Filter+             -> b -> LuaE e b+walkSplicing pushElement peekElementOrList filter' =+  if any (`member` filter') acceptedNames+  then walkM $ \(SpliceList xs) -> SpliceList <$!> fmap mconcat (mapM f xs)+  else pure+ where+  f :: a -> LuaE e [a]+  f = applySplicing pushElement peekElementOrList filter'++  acceptedNames :: [Name]+  acceptedNames = baseFunctionName (Proxy @a) : valueFunctionNames (Proxy @a)++-- | Applies a filter on an element. The element is pushed to the stack+-- via the given pusher and calls the filter function with that value,+-- leaving the filter function's return value on the stack.+applySplicing :: (LuaError e, Data a)+              => Pusher e a -> Peeker e [a] -> Filter+              -> a -> LuaE e [a]+applySplicing pushElement peekElements filter' x = do+  case filter' `getFunctionFor` x of+    Nothing ->+      -- There is no filter function, do nothing.+      pure [x]+    Just fn -> do+      -- Apply the function+      applySplicingFunction fn pushElement peekElements x++-- | Applies a single filter function on an element. The element is+-- pushed to the stack via the given pusher and calls the filter+-- function with that value, leaving the filter function's return value+-- on the stack.+applySplicingFunction :: LuaError e+                      => FilterFunction -> Pusher e a -> Peeker e [a]+                      -> a -> LuaE e [a]+applySplicingFunction fn pushElement peekElements x = do+  pushFilterFunction fn+  pushElement x+  callWithTraceback 1 1+  forcePeek . (`lastly` pop 1) $ liftLua (ltype top) >>= \case+    TypeNil -> pure [x]  -- function returned `nil`, keep original value+    _       -> peekElements top++--+-- Helper+--++-- | Like @'Lua.call'@, but adds a traceback to the error message (if any).+callWithTraceback :: forall e. LuaError e+                  => NumArgs -> NumResults -> LuaE e ()+callWithTraceback nargs nresults = do+  let traceback' :: LuaE e NumResults+      traceback' = do+        l <- state+        msg <- tostring' (nthBottom 1)+        traceback l (Just msg) 2+        return 1+  tracebackIdx <- absindex (nth (fromNumArgs nargs + 1))+  pushHaskellFunction traceback'+  insert tracebackIdx+  result <- pcall nargs nresults (Just tracebackIdx)+  remove tracebackIdx+  when (result /= OK)+    throwErrorAsException
test/test-block.lua view
@@ -317,30 +317,139 @@     },   },   group "Blocks" {-    test('splits a string into words', function ()-      assert.are_same(-        Blocks 'Absolute Giganten',-        {Plain {Str 'Absolute', Space(), Str 'Giganten'}}+    group 'Constructor' {+      test('splits a string into words', function ()+        assert.are_same(+          Blocks 'Absolute Giganten',+          {Plain {Str 'Absolute', Space(), Str 'Giganten'}}+        )+      end),+      test('converts single Block into List', function ()+        assert.are_same(+          Blocks(CodeBlock('return true')),+          {CodeBlock('return true')}+        )+      end),+      test('converts elements in a list into Blocks', function ()+        assert.are_same(+          Blocks{'Berlin', 'Berkeley', Plain 'Zürich'},+          {Plain{Str 'Berlin'}, Plain{Str 'Berkeley'}, Plain{Str 'Zürich'}}+        )+      end),+      test('can be mapped over', function ()+        local words = Blocks{Header(1, 'Program'), CodeBlock 'pandoc'}+        assert.are_same(+          words:map(function (x) return x.t end),+          {'Header', 'CodeBlock'}+        )+      end),+    },+    group 'walk' {+      test('modifies Inline subelements', function ()+        local blocks = Blocks{Para 'Hello, World!'}+        assert.are_same(+          Blocks{Para 'Hello, Jake!'},+          blocks:walk{+            Str = function (str)+              return str.text == 'World!' and Str('Jake!') or nil+            end+          }+        )+      end),+    }+  },+  group 'walk' {+    test('modifies Inline subelements', function ()+      local para = Para 'Hello, World!'+      local expected = Para 'Hello, John!'+      assert.are_equal(+        expected,+        para:walk{+          Str = function (str)+            return str.text == 'World!' and Str('John!') or nil+          end+        }       )     end),-    test('converts single Block into List', function ()-      assert.are_same(-        Blocks(CodeBlock('return true')),-        {CodeBlock('return true')}+    test('modifies blocks in notes', function ()+      local div = Div{Note{Para 'The proof is trivial.'}}+      assert.are_equal(+        Div{Note{Plain 'The proof is trivial.'}},+        div:walk{+          Para = function (para)+            return Plain(para.content)+          end+        }       )     end),-    test('converts elements in a list into Blocks', function ()-      assert.are_same(-        Blocks{'Berlin', 'Berkeley', Plain 'Zürich'},-        {Plain{Str 'Berlin'}, Plain{Str 'Berkeley'}, Plain{Str 'Zürich'}}+    test('uses `Inlines` for lists of inlines', function ()+      local para = Para{Emph 'Kid A'}+      assert.are_equal(+        Para{Emph 'Kid A+'},+        para:walk{+          Inlines = function (inlns)+            if Span(inlns) == Span 'Kid A' then+              return Span('Kid A+').content+            end+          end+        }       )     end),-    test('can be mapped over', function ()-      local words = Blocks{Header(1, 'Program'), CodeBlock 'pandoc'}+    test('handles inline elements before inline lists', function ()+      local para = Para{Emph 'Red door'}+      assert.are_equal(+        Para{Emph 'Paint it Black'},+        para:walk{+          Inlines = function (inlns)+            if Span(inlns) == Span('Paint it') then+              return inlns .. {Space(), 'Black'}+            end+          end,+          Str = function (str)+            if str == Str 'Red' then+              return 'Paint'+            elseif str == Str 'door' then+              return 'it'+            end+          end+        }+      )+    end),+    test('uses `Blocks` for lists of Blocks', function ()+      local bl = BulletList{{'Overture'}, {'The Grid'}, {'The Son of Flynn'}}+      assert.are_equal(+        BulletList{+          {'Overture', 'by Daft Punk'},+          {'The Grid', 'by Daft Punk'},+          {'The Son of Flynn', 'by Daft Punk'},+        },+        bl:walk{+          Blocks = function (blocks)+            return blocks .. {Plain 'by Daft Punk'}+          end+        }+      )+    end),+    test('uses order Inline -> Inlines -> Block -> Blocks', function ()+      local names = List{}+      Div{Para 'Discovery', CodeBlock 'Homework'}:walk{+        Blocks = function (_)+          names:insert('Blocks')+        end,+        Block = function (b)+          names:insert(b.t)+        end,+        Inline = function (i)+          names:insert(i.t)+        end,+        Inlines = function (_)+          names:insert('Inlines')+        end,+      }       assert.are_same(-        words:map(function (x) return x.t end),-        {'Header', 'CodeBlock'}+        {'Str', 'Inlines', 'Para', 'CodeBlock', 'Blocks'},+        names       )     end),-  },+  } }
+ test/test-cell.lua view
@@ -0,0 +1,119 @@+local tasty = require 'tasty'++local test = tasty.test_case+local group = tasty.test_group+local assert = tasty.assert++return {+  group "Cell" {+    group 'Constructor' {+      test('align defaults to `AlignDefault`', function ()+        local cell = Cell({})+        assert.are_equal(cell.alignment, AlignDefault)+      end),+      test('row span defaults to 1', function ()+        local cell = Cell{}+        assert.are_equal(cell.row_span, 1)+      end),+      test('col span defaults to 1', function ()+        local cell = Cell{}+        assert.are_equal(cell.col_span, 1)+      end),+      test('attr defaults to null Attr', function ()+        local cell = Cell{}+        assert.are_equal(cell.attr, Attr())+      end),+    },+    group 'properties' {+      test('can modify contents', function ()+        local cell = Cell{}+        cell.contents = {Plain 'snow'}+        assert.are_equal(Cell('snow'), cell)+      end),+      test('modify alignment', function ()+        local cell = Cell({}, 'AlignLeft')+        cell.alignment = 'AlignRight'+        assert.are_equal(Cell({}, 'AlignRight'), cell)+      end),+      test('modify row_span', function ()+        local cell = Cell({}, nil, 4)+        cell.row_span = 2+        assert.are_equal(Cell({}, nil, 2), cell)+      end),+      test('modify col_span', function ()+        local cell = Cell({}, nil, nil, 2)+        cell.col_span = 3+        assert.are_equal(Cell({}, nil, nil, 3), cell)+      end),+      test('modify attr', function ()+        local cell = Cell({}, nil, nil, nil, Attr('before'))+        cell.attr = Attr('after')+        assert.are_equal(Cell({}, nil, nil, nil, Attr('after')), cell)+      end),+    },+    group 'aliases' {+      test('identifier', function ()+        local cell = Cell{}+        cell.identifier = 'yep'+        assert.are_same(Cell({}, nil, nil, nil, 'yep'), cell)+      end),+      test('classes', function ()+        local cell = Cell{}+        cell.classes = {'java'}+        assert.are_same(Cell({}, nil, nil, nil, {'', {'java'}}), cell)+      end),+      test('attributes', function ()+        local cell = Cell{}+        cell.attributes.precipitation = 'snow'+        assert.are_same(Cell({}, nil, nil, nil, {precipitation='snow'}), cell)+      end),+    },+    group 'walk' {+      test('modifies Inline subelements', function ()+        local cell = Cell{Para 'Hello, World!'}+        assert.are_same(+          Cell{Para 'Hello, Jake!'},+          cell:walk{+            Str = function (str)+              return str.text == 'World!' and Str('Jake!') or nil+            end+          }+        )+      end),+      test('uses `Inlines` for lists of inlines', function ()+        local cell = Cell{Emph 'Kid A'}+        assert.are_equal(+          Cell{Emph 'Kid A+'},+          cell:walk{+            Inlines = function (inlns)+              if Span(inlns) == Span 'Kid A' then+                return Span('Kid A+').content+              end+            end+          }+        )+      end),+      test('uses order Inline -> Inlines -> Block -> Blocks', function ()+        local names = List{}+        Cell{Para 'Discovery', CodeBlock 'Homework'}:walk{+          Blocks = function (_)+            names:insert('Blocks')+          end,+          Block = function (b)+            names:insert(b.t)+          end,+          Inline = function (i)+            names:insert(i.t)+          end,+          Inlines = function (_)+            names:insert('Inlines')+          end,+        }+        assert.are_same(+          {'Str', 'Inlines', 'Para', 'CodeBlock', 'Blocks'},+          names+        )+      end),+    }+  },+}
test/test-inline.lua view
@@ -141,16 +141,15 @@       end),     },     group 'Note' {-      -- FIXME: waiting for Block support-      -- test('has property `content`', function ()-      --   local elem = Note{Para {'two', Space(), 'words'}}-      --   assert.are_same(-      --     elem.content,-      --     {Para {Str 'two', Space(), Str 'words'}}-      --   )-      --   elem.content = Plain 'word'-      --   assert.are_equal(elem, Note{'word'})-      -- end)+      test('has property `content`', function ()+        local elem = Note{Para {'two', Space(), 'words'}}+        assert.are_same(+          elem.content,+          {Para {Str 'two', Space(), Str 'words'}}+        )+        elem.content = Plain 'word'+        assert.are_equal(elem, Note{'word'})+      end)     },     group 'Quoted' {       test('has property `content`', function ()@@ -271,30 +270,153 @@     },   },   group "Inlines" {-    test('splits a string into words', function ()-      assert.are_same(-        Inlines 'Absolute Giganten',-        {Str 'Absolute', Space(), Str 'Giganten'}+    group 'Constructor' {+      test('splits a string into words', function ()+        assert.are_same(+          Inlines 'Absolute Giganten',+          {Str 'Absolute', Space(), Str 'Giganten'}+        )+      end),+      test('converts single Inline into List', function ()+        assert.are_same(+          Inlines(Emph{Str'Important'}),+          {Emph{Str'Important'}}+        )+      end),+      test('converts elements in a list into Inlines', function ()+        assert.are_same(+          Inlines{'Molecular', Space(), 'Biology'},+          {Str 'Molecular', Space(), Str 'Biology'}+        )+      end),+      test('tabs are treated as space', function ()+        local expected = {+          Str 'Linkin', Space(), Str 'Park', Space(),+          Str '-', Space(), Str 'Papercut'+        }+        assert.are_same(Inlines('Linkin Park\t-\tPapercut'), expected)+      end),+      test('newlines are treated as softbreaks', function ()+        local expected = {+          Str 'Porcupine', Space(), Str 'Tree',+          SoftBreak(), Str '-', SoftBreak(),+          Str 'Blackest',  Space(), Str 'Eyes'+        }+        assert.are_same(+          Inlines('Porcupine Tree\n-\nBlackest Eyes'),+          expected+        )+      end),+      test('can be mapped over', function ()+        local words = Inlines 'good idea'+        assert.are_same(+          words:map(function (x) return x.t end),+          {'Str', 'Space', 'Str'}+        )+      end),+    },+    group 'walk' {+      test('modifies Inline subelements', function ()+        assert.are_same(+          Inlines 'Hello, Jake!',+          (Inlines 'Hello, World!'):walk{+            Str = function (str)+              return str.text == 'World!' and Str('Jake!') or nil+            end+          }+        )+      end),+    }+  },+  group 'walk' {+    test('modifies Inline subelements', function ()+      local span = Span 'Hello, World!'+      local expected = Span 'Hello, John!'+      assert.are_equal(+        expected,+        span:walk{+          Str = function (str)+            return str.text == 'World!' and Str('John!') or nil+          end+        }       )     end),-    test('converts single Inline into List', function ()-      assert.are_same(-        Inlines(Emph{Str'Important'}),-        {Emph{Str'Important'}}+    test('applies filter only on subtree', function ()+      local str = Str 'Hello'+      assert.are_equal(+        Str 'Hello',+        str:walk{+          Str = function (str)+            return str.text == 'Hello' and Str('Goodbye') or nil+          end+        }       )     end),-    test('converts elements in a list into Inlines', function ()-      assert.are_same(-        Inlines{'Molecular', Space(), 'Biology'},-        {Str 'Molecular', Space(), Str 'Biology'}+    test('modifies blocks in notes', function ()+      local note = Note{Para 'The proof is trivial.'}+      assert.are_equal(+        Note{Plain 'The proof is trivial.'},+        note:walk{+          Para = function (para)+            return Plain(para.content)+          end+        }       )     end),-    test('can be mapped over', function ()-      local words = Inlines 'good idea'-      assert.are_same(-        words:map(function (x) return x.t end),-        {'Str', 'Space', 'Str'}+    test('uses `Inlines` for lists of inlines', function ()+      local span = Span{Emph 'Kid A'}+      assert.are_equal(+        Span{Emph 'Kid A+'},+        span:walk{+          Inlines = function (inlns)+            if Span(inlns) == Span 'Kid A' then+              return Inlines 'Kid A+'+            end+          end+        }       )-    end)-  },+    end),+    test('handles inline elements before inline lists', function ()+      local span = Span{Emph 'Red door'}+      assert.are_equal(+        Span{Emph 'Paint it Black'},+        span:walk{+          Inlines = function (inlns)+            if Span(inlns) == Span('Paint it') then+              return inlns .. {Space(), 'Black'}+            end+          end,+          Str = function (str)+            if str == Str 'Red' then+              return 'Paint'+            elseif str == Str 'door' then+              return 'it'+            end+          end+        }+      )+    end),+    test('uses order Inline -> Inlines -> Block -> Blocks', function ()+      local names = List{}+      Note{Para 'Human After All', CodeBlock 'Alive 2007'}:walk{+        Blocks = function (_)+          names:insert('Blocks')+        end,+        Block = function (b)+          names:insert(b.t)+        end,+        Inline = function (i)+          names:insert(i.t)+        end,+        Inlines = function (_)+          names:insert('Inlines')+        end,+      }+      print(names)+      assert.are_equal(+        'Str, Space, Str, Space, Str, Inlines, Para, CodeBlock, Blocks',+        table.concat(names, ', ')+      )+    end),+  } }
test/test-pandoc-lua-marshal.hs view
@@ -62,6 +62,7 @@     registerConstants (Proxy @MathType)     registerConstants (Proxy @QuoteType)     forM_ inlineConstructors register'+    forM_ blockConstructors register'     translateResultsFromFile "test/test-inline.lua"    blockTests <- run @Lua.Exception $ do@@ -77,6 +78,18 @@     forM_ blockConstructors register'     translateResultsFromFile "test/test-block.lua" +  cellTests <- run @Lua.Exception $ do+    openlibs+    pushListModule *> setglobal "List"+    register' mkAttr+    register' mkBlocks+    register' mkCell+    register' mkListAttributes+    registerConstants (Proxy @Alignment)+    forM_ inlineConstructors register'+    forM_ blockConstructors register'+    translateResultsFromFile "test/test-cell.lua"+   simpleTableTests <- run @Lua.Exception $ do     openlibs     pushListModule *> setglobal "List"@@ -111,6 +124,7 @@     , citationTests     , inlineTests     , blockTests+    , cellTests     , simpleTableTests     , metavalueTests     , pandocTests
test/test-pandoc.lua view
@@ -22,5 +22,37 @@       local meta = Pandoc({}, {test = Plain 'check'}).meta       assert.are_same(meta.test, {Plain{Str 'check'}})     end),+    test('string is treated as MetaString', function ()+      local meta = Pandoc({}, {test = 'test'}).meta+      assert.are_equal(meta.test, 'test')+    end),+    test('booleans are treated as MetaBool', function ()+      local meta = Pandoc({}, {test = true}).meta+      assert.are_equal(meta.test, true)+    end),+    test('list of strings becomes MetaList of MetaStrings', function ()+      local meta = Pandoc({}, {zahlen = {'eins', 'zwei', 'drei'}}).meta+      assert.are_same(meta.zahlen, {'eins', 'zwei', 'drei'})+    end),   },+  group 'walk' {+    test('uses `Meta` function', function ()+      local meta = {+        artist = 'Bodi Bill',+        albums = {'Next Time'}+      }+      local doc = Pandoc({}, meta)+      assert.are_equal(+        Pandoc({},+          {artist = 'Bodi Bill', albums = {'Next Time', 'No More Wars'}}+        ),+        doc:walk {+          Meta = function (meta)+            meta.albums:insert('No More Wars')+            return meta+          end+        }+      )+    end),+  } }