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 +70/−6
- pandoc-lua-marshal.cabal +7/−1
- src/Text/Pandoc/Lua/Marshal/Block.hs +36/−3
- src/Text/Pandoc/Lua/Marshal/Block.hs-boot +31/−4
- src/Text/Pandoc/Lua/Marshal/Cell.hs +89/−19
- src/Text/Pandoc/Lua/Marshal/Filter.hs +123/−0
- src/Text/Pandoc/Lua/Marshal/Inline.hs +35/−5
- src/Text/Pandoc/Lua/Marshal/Inline.hs-boot +32/−4
- src/Text/Pandoc/Lua/Marshal/Pandoc.hs +60/−2
- src/Text/Pandoc/Lua/Marshal/Shared.hs +36/−0
- src/Text/Pandoc/Lua/SpliceList.hs +159/−0
- src/Text/Pandoc/Lua/Walk.hs +160/−0
- test/test-block.lua +126/−17
- test/test-cell.lua +119/−0
- test/test-inline.lua +151/−29
- test/test-pandoc-lua-marshal.hs +14/−0
- test/test-pandoc.lua +32/−0
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'
@@ -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),+ } }