diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/pandoc-lua-marshal.cabal b/pandoc-lua-marshal.cabal --- a/pandoc-lua-marshal.cabal +++ b/pandoc-lua-marshal.cabal @@ -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 diff --git a/src/Text/Pandoc/Lua/Marshal/Block.hs b/src/Text/Pandoc/Lua/Marshal/Block.hs --- a/src/Text/Pandoc/Lua/Marshal/Block.hs +++ b/src/Text/Pandoc/Lua/Marshal/Block.hs @@ -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 diff --git a/src/Text/Pandoc/Lua/Marshal/Block.hs-boot b/src/Text/Pandoc/Lua/Marshal/Block.hs-boot --- a/src/Text/Pandoc/Lua/Marshal/Block.hs-boot +++ b/src/Text/Pandoc/Lua/Marshal/Block.hs-boot @@ -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 diff --git a/src/Text/Pandoc/Lua/Marshal/Cell.hs b/src/Text/Pandoc/Lua/Marshal/Cell.hs --- a/src/Text/Pandoc/Lua/Marshal/Cell.hs +++ b/src/Text/Pandoc/Lua/Marshal/Cell.hs @@ -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" diff --git a/src/Text/Pandoc/Lua/Marshal/Filter.hs b/src/Text/Pandoc/Lua/Marshal/Filter.hs new file mode 100644 --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshal/Filter.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{- | +Copyright : © 2021 Albert Krewinkel +License : MIT +Maintainer : Albert Krewinkel + +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' diff --git a/src/Text/Pandoc/Lua/Marshal/Inline.hs b/src/Text/Pandoc/Lua/Marshal/Inline.hs --- a/src/Text/Pandoc/Lua/Marshal/Inline.hs +++ b/src/Text/Pandoc/Lua/Marshal/Inline.hs @@ -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 diff --git a/src/Text/Pandoc/Lua/Marshal/Inline.hs-boot b/src/Text/Pandoc/Lua/Marshal/Inline.hs-boot --- a/src/Text/Pandoc/Lua/Marshal/Inline.hs-boot +++ b/src/Text/Pandoc/Lua/Marshal/Inline.hs-boot @@ -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 diff --git a/src/Text/Pandoc/Lua/Marshal/Pandoc.hs b/src/Text/Pandoc/Lua/Marshal/Pandoc.hs --- a/src/Text/Pandoc/Lua/Marshal/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Marshal/Pandoc.hs @@ -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' diff --git a/src/Text/Pandoc/Lua/Marshal/Shared.hs b/src/Text/Pandoc/Lua/Marshal/Shared.hs new file mode 100644 --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshal/Shared.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE FlexibleContexts #-} +{- | +Copyright : © 2021 Albert Krewinkel +License : MIT +Maintainer : Albert Krewinkel + +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 diff --git a/src/Text/Pandoc/Lua/SpliceList.hs b/src/Text/Pandoc/Lua/SpliceList.hs new file mode 100644 --- /dev/null +++ b/src/Text/Pandoc/Lua/SpliceList.hs @@ -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 + +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' diff --git a/src/Text/Pandoc/Lua/Walk.hs b/src/Text/Pandoc/Lua/Walk.hs new file mode 100644 --- /dev/null +++ b/src/Text/Pandoc/Lua/Walk.hs @@ -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 + +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 diff --git a/test/test-block.lua b/test/test-block.lua --- a/test/test-block.lua +++ b/test/test-block.lua @@ -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), - }, + } } diff --git a/test/test-cell.lua b/test/test-cell.lua new file mode 100644 --- /dev/null +++ b/test/test-cell.lua @@ -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), + } + }, +} diff --git a/test/test-inline.lua b/test/test-inline.lua --- a/test/test-inline.lua +++ b/test/test-inline.lua @@ -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), + } } diff --git a/test/test-pandoc-lua-marshal.hs b/test/test-pandoc-lua-marshal.hs --- a/test/test-pandoc-lua-marshal.hs +++ b/test/test-pandoc-lua-marshal.hs @@ -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 diff --git a/test/test-pandoc.lua b/test/test-pandoc.lua --- a/test/test-pandoc.lua +++ b/test/test-pandoc.lua @@ -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), + } }