pandoc-lua-marshal-0.2.9/0000755000000000000000000000000007346545000013363 5ustar0000000000000000pandoc-lua-marshal-0.2.9/CHANGELOG.md0000644000000000000000000001752507346545000015206 0ustar0000000000000000# Changelog `pandoc-lua-marshal` uses [PVP Versioning][]. ## 0.2.9 Released 2024-10-01. - Update list module, thereby introducing a new method `iter`; the function returns an iterator that steps through list values on each call. - Added support for `__toinline` and `__toblock` metamethods. If the metamethods are available on a Lua object and return an appropriate value, then that returned value will be used during unmarshalling. ## 0.2.8 Released 2024-09-21. - Update list module, thereby introducing a new method `at` and an extended constructor for List types. ## 0.2.7.1 Released 2024-07-02. - Relaxed the upper bound of tasty-quickcheck, used in tests. Now allows version 0.11. - Update documentation on constructors; the descriptions now match those in the pandoc docs. ## 0.2.7 Released 2024-05-06. - Let the behavior of `content` attributes on BulletList and OrderedList elements match that of the constructor by treating a list of Block elements as a list of single-block items. The following assertion now holds true: ``` lua local content = {pandoc.Plain "one", pandoc.Plain "two"} local bl = pandoc.BulletList{} bl.content = content assert(bl == pandoc.BulletList(content)) ``` ## 0.2.6 Released 2024-03-29. - Fixed a bug that caused problems with empty Block lists in the `content` attributes of *Div*, *Figure*, and *BlockQuote* elements. ## 0.2.5 Released 2024-03-04. - The `clone` method on *Blocks* and *Inlines* elements now creates deep copies of the lists. ## 0.2.4 Released 2024-01-19. - Relaxed upper bound for aeson, allowing aeson-2.2.\*. ## 0.2.3 Released 2024-01-19. - Relaxed upper bound for text, containers, and bytestring, allowing text-2.1, containers-0.7, and bytestring-0.12. ## 0.2.2 Released 2023-03-15. - Add `__tostring` metamethods to *Blocks* and *Inlines*. ## 0.2.1.1 Released 2023-03-13. - The version constraints for hslua packages have been relaxed; other changes in hslua 2.3.\* do not affect this package. ## 0.2.1 Released 2023-02-11. - All userdata types have been given a `__tojson` metamethod. The methods return the default JSON representations of AST objects. ## 0.2.0 Released 2023-01-18. - Depend on pandoc-types 1.23: the `Null` Block constructor has been removed, and a `Figure` constructor has been added. - Support for Lua 5.3 has been dropped; the package now requires hslua 2.2 or later. - The implementation for `List` has been moved to the separate `hslua-list` module. This module no longer contains C code. ## 0.1.7 Released 2022-07-16. - Allow Blocks to be passed as Caption value. The resulting caption has the Blocks as its long version and no short version. - Add `clone` method to Pandoc elements. ## 0.1.6.1 Released 2022-06-10. - Provide better error messages when fuzzy retrieval of Inlines or Blocks fails. - Relax upper bound for text, allow text-2.0. ## 0.1.6 Released 2022-06-03. - Fix `applyFully`: the function always traversed the document type-wise, never topdown. - Avoid shadowing of a function name that was added in hslua-2.2. - Support concatenating of Pandoc values with the `..` operator. ## 0.1.5.1 Released 2022-02-19. - Relax upper bound for lua and hslua. ## 0.1.5 Released 2022-02-17. - Allow any type of callable object as argument to List functions `filter`, `map`, and `find_if`. These previously required the argument to be of type `function`, which was too restrictive. - Inline: the type of Image captions is now `Inlines` instead of `List`. ## 0.1.4 Released 2022-01-29. - Export AttributeList type and marshaling functions from `Text.Pandoc.Marshal.Attr`, namely `typeAttributeList`, `peekAttributeList`, and `pushAttributeList`. - Update to hslua 2.1, making use of the new utility functions. ## 0.1.3.1 Released 2022-01-14. - Fixed a bug in `List.include` that was causing the Lua stack to overflow when the function was applied to long lists. ## 0.1.3 Released 2021-12-23. ### Lua changes - The traversal order of filters can now be selected by setting the key `traverse` to either `'topdown'` or `'typewise'`; the default remains `'typewise'`. Topdown traversals can be cut short by returning `false` as a second value from the filter function. No child-element of the returned element is processed in that case. - All types can be compared. Previously, comparing values of different types would lead to errors in a number of cases. - Lists now have an `__eq` metamethod. List equality is checked by comparing both lists element-wise. Two lists are equal if they have the same type and have equal elements. - If start indices in `List:find` and `List:find_if` are negative the start index is relative to the list length. - TableFoot, TableHead, and Row values are marshaled as userdata objects. ### Haskell code - Text.Pandoc.Lua.Marshal.Filter exports the new type `WalkingOrder`. The type `Filter` now contains the the traversal specifier as a field. - New modules for TableFoot, TableHead, and Row, defining the usual marshaling methods and constructor functions for these types. ## 0.1.2 Released 2021-12-10. - Restored backward compatible retrieval of Rows. Cells can be either a userdata value or a table. ## 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. ## 0.1.0 Released 2021-11-28. - Released into the wild. May it live long and prosper. [PVP Versioning]: https://pvp.haskell.org pandoc-lua-marshal-0.2.9/LICENSE0000644000000000000000000000206607346545000014374 0ustar0000000000000000MIT License Copyright (c) 2021-2024 Albert Krewinkel Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. pandoc-lua-marshal-0.2.9/README.md0000644000000000000000000000230607346545000014643 0ustar0000000000000000# pandoc-lua-marshal [![GitHub CI][]][1] [![Hackage][]][2] [![Stackage Lts][]][3] [![Stackage Nightly][]][4] [![MIT license]][5] Use pandoc types in Lua. [GitHub CI]: https://img.shields.io/github/actions/workflow/status/pandoc/pandoc-lua-marshal/ci.yml?branch=main&logo=github [1]: https://github.com/tarleb/pandoc-lua-marshal/actions [Hackage]: https://img.shields.io/hackage/v/pandoc-lua-marshal.svg?logo=haskell [2]: https://hackage.haskell.org/package/pandoc-lua-marshal [Stackage Lts]: http://stackage.org/package/pandoc-lua-marshal/badge/lts [3]: https://stackage.org/lts/package/pandoc-lua-marshal [Stackage Nightly]: https://stackage.org/package/pandoc-lua-marshal/badge/nightly [4]: https://stackage.org/nightly/package/pandoc-lua-marshal [MIT license]: https://img.shields.io/badge/license-MIT-blue.svg [5]: LICENSE ## Description This package provides functions to marshal and unmarshal pandoc document types to and from Lua. The values of most types are pushed to pandoc as "userdata" objects that wrap a stable pointer to the Haskell value; these objects come with methods to access and modify their properties. Sequences are pushed as normal Lua tables, but are augmented with convenience functions. pandoc-lua-marshal-0.2.9/pandoc-lua-marshal.cabal0000644000000000000000000001245307346545000020024 0ustar0000000000000000cabal-version: 2.4 name: pandoc-lua-marshal version: 0.2.9 synopsis: Use pandoc types in Lua description: This package provides functions to marshal and unmarshal pandoc document types to and from Lua. . The values of most types are pushed to pandoc as "userdata" objects that wrap a stable pointer to the Haskell value; these objects come with methods to access and modify their properties. . Sequences are pushed as normal Lua tables, but are augmented with convenience functions. homepage: https://github.com/pandoc/pandoc-lua-marshal bug-reports: https://github.com/pandoc/pandoc-lua-marshal/issues license: MIT license-file: LICENSE author: Albert Krewinkel, John MacFarlane maintainer: Albert Krewinkel copyright: © 2017-2024 Albert Krewinkel, John MacFarlane category: Foreign build-type: Simple extra-doc-files: README.md , CHANGELOG.md tested-with: GHC == 8.6.5 , GHC == 8.8.4 , GHC == 8.10.7 , GHC == 9.0.2 , GHC == 9.2.5 , GHC == 9.4.4 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 , test/test-metavalue.lua , test/test-pandoc.lua , test/test-simpletable.lua source-repository head type: git location: https://github.com/pandoc/pandoc-lua-marshal.git common common-options build-depends: base >= 4.12 && < 5 , aeson >= 1.5 && < 2.3 , bytestring >= 0.10 && < 0.13 , containers >= 0.6 && < 0.8 , exceptions >= 0.8 && < 0.11 , hslua >= 2.2 && < 2.4 , hslua-list >= 1.1.4 && < 1.2 , hslua-marshalling >= 2.2 && < 2.4 , pandoc-types >= 1.23 && < 1.24 , safe >= 0.3 && < 0.4 , text >= 1.1.1.0 && < 1.3 || >= 2.0 && < 2.2 ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wpartial-fields -Wredundant-constraints -fhide-source-paths if impl(ghc >= 8.8) ghc-options: -Wmissing-deriving-strategies default-language: Haskell2010 library import: common-options hs-source-dirs: src exposed-modules: Text.Pandoc.Lua.Marshal.AST , Text.Pandoc.Lua.Marshal.Alignment , Text.Pandoc.Lua.Marshal.Attr , Text.Pandoc.Lua.Marshal.Block , Text.Pandoc.Lua.Marshal.Cell , 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 , Text.Pandoc.Lua.Marshal.ListAttributes , Text.Pandoc.Lua.Marshal.MathType , Text.Pandoc.Lua.Marshal.MetaValue , Text.Pandoc.Lua.Marshal.Pandoc , Text.Pandoc.Lua.Marshal.QuoteType , Text.Pandoc.Lua.Marshal.Row , Text.Pandoc.Lua.Marshal.SimpleTable , Text.Pandoc.Lua.Marshal.TableFoot , Text.Pandoc.Lua.Marshal.TableHead , Text.Pandoc.Lua.Marshal.TableParts other-modules: Text.Pandoc.Lua.Marshal.Shared , Text.Pandoc.Lua.Topdown , Text.Pandoc.Lua.SpliceList , Text.Pandoc.Lua.Walk build-depends: hslua-list >= 1.1 && < 1.2 test-suite pandoc-lua-marshal-test import: common-options type: exitcode-stdio-1.0 hs-source-dirs: test main-is: test-pandoc-lua-marshal.hs build-depends: pandoc-lua-marshal , QuickCheck >= 2.4 && < 2.16 , tasty >= 0.11 , tasty-hunit >= 0.9 , tasty-lua >= 1.0 , tasty-quickcheck >= 0.8 && < 0.12 ghc-options: -threaded -rtsopts -with-rtsopts=-N pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/0000755000000000000000000000000007346545000020412 5ustar0000000000000000pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/AST.hs0000644000000000000000000000311407346545000021374 0ustar0000000000000000{- | Copyright : © 2021-2024 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Use pandoc types in Lua -} module Text.Pandoc.Lua.Marshal.AST ( module Text.Pandoc.Lua.Marshal.List , module Text.Pandoc.Lua.Marshal.Alignment , module Text.Pandoc.Lua.Marshal.Attr , module Text.Pandoc.Lua.Marshal.Block , module Text.Pandoc.Lua.Marshal.Cell , module Text.Pandoc.Lua.Marshal.Citation , module Text.Pandoc.Lua.Marshal.CitationMode , module Text.Pandoc.Lua.Marshal.Content , module Text.Pandoc.Lua.Marshal.Format , module Text.Pandoc.Lua.Marshal.Inline , module Text.Pandoc.Lua.Marshal.ListAttributes , module Text.Pandoc.Lua.Marshal.MathType , module Text.Pandoc.Lua.Marshal.MetaValue , module Text.Pandoc.Lua.Marshal.Pandoc , module Text.Pandoc.Lua.Marshal.QuoteType , module Text.Pandoc.Lua.Marshal.SimpleTable , module Text.Pandoc.Lua.Marshal.TableParts ) where import Text.Pandoc.Lua.Marshal.Alignment import Text.Pandoc.Lua.Marshal.Attr import Text.Pandoc.Lua.Marshal.Block import Text.Pandoc.Lua.Marshal.Cell import Text.Pandoc.Lua.Marshal.Citation import Text.Pandoc.Lua.Marshal.CitationMode import Text.Pandoc.Lua.Marshal.Content import Text.Pandoc.Lua.Marshal.Format import Text.Pandoc.Lua.Marshal.Inline import Text.Pandoc.Lua.Marshal.List import Text.Pandoc.Lua.Marshal.ListAttributes import Text.Pandoc.Lua.Marshal.MathType import Text.Pandoc.Lua.Marshal.MetaValue import Text.Pandoc.Lua.Marshal.Pandoc import Text.Pandoc.Lua.Marshal.QuoteType import Text.Pandoc.Lua.Marshal.SimpleTable import Text.Pandoc.Lua.Marshal.TableParts pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/Alignment.hs0000644000000000000000000000112507346545000022663 0ustar0000000000000000{- | Copyright : © 2021-2024 Albert Krewinkel SPDX-License-Identifier : MIT Maintainer : Albert Krewinkel Marshaling/unmarshaling functions of 'Alignment' values. -} module Text.Pandoc.Lua.Marshal.Alignment ( peekAlignment , pushAlignment ) where import HsLua import Text.Pandoc.Definition (Alignment) -- | Retrieves a 'Alignment' value from a string. peekAlignment :: Peeker e Alignment peekAlignment = peekRead -- | Pushes a 'Alignment' value as a string. pushAlignment :: Pusher e Alignment pushAlignment = pushString . show pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/Attr.hs0000644000000000000000000002357607346545000021675 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Lua.Marshal.Attr Copyright : © 2017-2021 Albert Krewinkel, John MacFarlane License : MIT Maintainer : Albert Krewinkel Helpers to make pandoc's Attr elements usable in Lua, and to get objects back into Haskell. -} module Text.Pandoc.Lua.Marshal.Attr ( typeAttr , peekAttr , pushAttr , typeAttributeList , pushAttributeList , peekAttributeList , mkAttr , mkAttributeList ) where import Control.Applicative ((<|>), optional) import Control.Monad ((<$!>)) import Data.Aeson (encode) import Data.Maybe (fromMaybe) import Data.Text (Text) import HsLua import HsLua.Marshalling.Peekers (peekIndexRaw) import Text.Pandoc.Lua.Marshal.List (pushPandocList) import Safe (atMay) import Text.Pandoc.Definition (Attr, nullAttr) import qualified Data.Text as T -- | Attr object type. typeAttr :: LuaError e => DocumentedType e Attr typeAttr = deftype "Attr" [ operation Eq $ lambda ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b)) <#> parameter (optional . peekAttr) "a" "Attr" "" <#> parameter (optional . peekAttr) "b" "Attr" "" =#> functionResult pushBool "boolean" "whether the two are equal" , operation Tostring $ lambda ### liftPure show <#> parameter peekAttr "Attr" "attr" "" =#> functionResult pushString "string" "native Haskell representation" , operation (CustomOperation "__tojson") $ lambda ### liftPure encode <#> udparam typeAttr "self" "" =#> functionResult pushLazyByteString "string" "JSON representation" ] [ property "identifier" "element identifier" (pushText, \(ident,_,_) -> ident) (peekText, \(_,cls,kv) -> (,cls,kv)) , property "classes" "element classes" (pushPandocList pushText, \(_,classes,_) -> classes) (peekList peekText, \(ident,_,kv) -> (ident,,kv)) , property "attributes" "various element attributes" (pushAttributeList, \(_,_,attribs) -> attribs) (peekAttributeList, \(ident,cls,_) -> (ident,cls,)) , method $ defun "clone" ### return <#> parameter peekAttr "attr" "Attr" "" =#> functionResult pushAttr "Attr" "new Attr element" , readonly "tag" "element type tag (always 'Attr')" (pushText, const "Attr") , alias "t" "alias for `tag`" ["tag"] ] -- | Pushes an 'Attr' value as @Attr@ userdata object. pushAttr :: LuaError e => Pusher e Attr pushAttr = pushUD typeAttr -- | Retrieves an associated list of attributes from a table or an -- @AttributeList@ userdata object. peekAttributeList :: LuaError e => Peeker e [(Text,Text)] peekAttributeList idx = liftLua (ltype idx) >>= \case TypeUserdata -> peekUD typeAttributeList idx TypeTable -> liftLua (rawlen idx) >>= \case 0 -> peekKeyValuePairs peekText peekText idx _ -> peekList (peekPair peekText peekText) idx _ -> failPeek "unsupported type" -- | Pushes an associated list of attributes as @AttributeList@ userdata -- object. pushAttributeList :: LuaError e => Pusher e [(Text, Text)] pushAttributeList = pushUD typeAttributeList -- | Constructor functions for 'AttributeList' elements. typeAttributeList :: LuaError e => DocumentedType e [(Text, Text)] typeAttributeList = deftype "AttributeList" [ operation Eq $ lambda ### liftPure2 (\a b -> Just True == ((==) <$> a <*> b)) <#> parameter (optional . peekAttributeList) "a" "any" "" <#> parameter (optional . peekAttributeList) "b" "any" "" =#> functionResult pushBool "boolean" "whether the two are equal" , operation Index $ lambda ### liftPure2 lookupKey <#> udparam typeAttributeList "t" "attributes list" <#> parameter peekKey "string|integer" "key" "lookup key" =#> functionResult (maybe pushnil pushAttribute) "string|table" "attribute value" , operation Newindex $ lambda ### setKey <#> udparam typeAttributeList "t" "attributes list" <#> parameter peekKey "string|integer" "key" "lookup key" <#> opt (parameter peekAttribute "string|nil" "value" "new value") =#> [] , operation Len $ lambda ### liftPure length <#> udparam typeAttributeList "t" "attributes list" =#> functionResult pushIntegral "integer" "number of attributes in list" , operation Pairs $ lambda ### pushIterator (\(k, v) -> 2 <$ pushText k <* pushText v) <#> udparam typeAttributeList "t" "attributes list" =?> "iterator triple" , operation Tostring $ lambda ### liftPure show <#> udparam typeAttributeList "t" "attributes list" =#> functionResult pushString "string" "" ] [] data Key = StringKey Text | IntKey Int peekKey :: Peeker e (Maybe Key) peekKey idx = liftLua (ltype idx) >>= \case TypeNumber -> Just . IntKey <$!> peekIntegral idx TypeString -> Just . StringKey <$!> peekText idx _ -> return Nothing data Attribute = AttributePair (Text, Text) | AttributeValue Text pushAttribute :: LuaError e => Pusher e Attribute pushAttribute = \case (AttributePair kv) -> pushPair pushText pushText kv (AttributeValue v) -> pushText v -- | Retrieve an 'Attribute'. peekAttribute :: LuaError e => Peeker e Attribute peekAttribute idx = (AttributeValue <$!> peekText idx) <|> (AttributePair <$!> peekPair peekText peekText idx) lookupKey :: [(Text,Text)] -> Maybe Key -> Maybe Attribute lookupKey !kvs = \case Just (StringKey str) -> AttributeValue <$!> lookup str kvs Just (IntKey n) -> AttributePair <$!> atMay kvs (n - 1) Nothing -> Nothing setKey :: forall e. LuaError e => [(Text, Text)] -> Maybe Key -> Maybe Attribute -> LuaE e () setKey kvs mbKey mbValue = case mbKey of Just (StringKey str) -> case break ((== str) . fst) kvs of (prefix, _:suffix) -> case mbValue of Nothing -> setNew $ prefix ++ suffix Just (AttributeValue value) -> setNew $ prefix ++ (str, value):suffix _ -> failLua "invalid attribute value" _ -> case mbValue of Nothing -> return () Just (AttributeValue value) -> setNew (kvs ++ [(str, value)]) _ -> failLua "invalid attribute value" Just (IntKey idx) -> case splitAt (idx - 1) kvs of (prefix, (k,_):suffix) -> setNew $ case mbValue of Nothing -> prefix ++ suffix Just (AttributePair kv) -> prefix ++ kv : suffix Just (AttributeValue v) -> prefix ++ (k, v) : suffix (prefix, []) -> case mbValue of Nothing -> setNew prefix Just (AttributePair kv) -> setNew $ prefix ++ [kv] _ -> failLua $ "trying to set an attribute key-value pair, " ++ "but got a single string instead." _ -> failLua "invalid attribute key" where setNew :: [(Text, Text)] -> LuaE e () setNew new = putuserdata (nthBottom 1) (udName @e typeAttributeList) new >>= \case True -> return () False -> failLua "failed to modify attributes list" -- | Retrieves an 'Attr' value from a string, a table, or an @Attr@ -- userdata object. A string is used as an identifier; a table is either -- an HTML-like set of attributes, or a triple containing the -- identifier, classes, and attributes. peekAttr :: LuaError e => Peeker e Attr peekAttr idx = retrieving "Attr" $ liftLua (ltype idx) >>= \case TypeString -> (,[],[]) <$!> peekText idx -- treat string as ID TypeUserdata -> peekUD typeAttr idx TypeTable -> peekAttrTable idx x -> liftLua . failLua $ "Cannot get Attr from " ++ show x -- | Helper function which gets an Attr from a Lua table. peekAttrTable :: LuaError e => Peeker e Attr peekAttrTable idx = do len' <- liftLua $ rawlen idx let peekClasses = peekList peekText if len' > 0 then do ident <- peekIndexRaw 1 peekText idx classes <- fromMaybe [] <$!> optional (peekIndexRaw 2 peekClasses idx) attribs <- fromMaybe [] <$!> optional (peekIndexRaw 3 peekAttributeList idx) return $ ident `seq` classes `seq` attribs `seq` (ident, classes, attribs) else retrieving "HTML-like attributes" $ do kvs <- peekKeyValuePairs peekText peekText idx let ident = fromMaybe "" $ lookup "id" kvs let classes = maybe [] T.words $ lookup "class" kvs let attribs = filter ((`notElem` ["id", "class"]) . fst) kvs return $ ident `seq` classes `seq` attribs `seq` (ident, classes, attribs) -- | Constructor for 'Attr'. mkAttr :: LuaError e => DocumentedFunction e mkAttr = defun "Attr" ### (\_ _ _ -> ltype (nthBottom 1) >>= \case TypeString -> forcePeek $ do mident <- optional (peekText (nthBottom 1)) mclass <- optional (peekList peekText (nthBottom 2)) mattribs <- optional (peekAttributeList (nthBottom 3)) return ( fromMaybe "" mident , fromMaybe [] mclass , fromMaybe [] mattribs) TypeTable -> forcePeek $ peekAttrTable (nthBottom 1) TypeUserdata -> forcePeek $ peekUD typeAttr (nthBottom 1) <|> do attrList <- peekUD typeAttributeList (nthBottom 1) return ("", [], attrList) TypeNil -> pure nullAttr TypeNone -> pure nullAttr x -> failLua $ "Cannot create Attr from " ++ show x) <#> opt (parameter pure "string|table|Attr" "identifier" "element identifier") <#> opt (parameter pure "{string,...}" "classes" "element classes") <#> opt (parameter pure "table|AttributeList" "attributes" "table containing string keys and values") =#> functionResult pushAttr "Attr" "new Attr object" #? "Create a new set of attributes" -- | Constructor for 'AttributeList'. mkAttributeList :: LuaError e => DocumentedFunction e mkAttributeList = defun "AttributeList" ### return <#> parameter peekAttributeList "table|AttributeList" "attribs" "an attribute list" =#> functionResult (pushUD typeAttributeList) "AttributeList" "new AttributeList object" pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/Block.hs0000644000000000000000000004466707346545000022021 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {- | Marshal values of types that make up 'Block' elements. -} module Text.Pandoc.Lua.Marshal.Block ( -- * Single Block elements typeBlock , peekBlock , peekBlockFuzzy , pushBlock -- * List of Blocks , peekBlocks , peekBlocksFuzzy , pushBlocks -- * Constructors , blockConstructors , mkBlocks -- * Walk , walkBlockSplicing , walkBlocksStraight ) where import Control.Applicative ((<|>), optional) import Control.Monad.Catch (throwM) import Control.Monad ((<$!>)) import Data.Aeson (encode) import Data.Data (showConstr, toConstr) import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (Proxy)) import Data.Text (Text) import HsLua hiding (Div) import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr) import Text.Pandoc.Lua.Marshal.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.Shared (walkBlocksAndInlines) import Text.Pandoc.Lua.Marshal.TableParts ( peekCaptionFuzzy, pushCaption , peekColSpec, pushColSpec , peekTableBody, pushTableBody , peekTableFoot, pushTableFoot , peekTableHead, pushTableHead ) import Text.Pandoc.Lua.Walk (SpliceList, Walkable, walkStraight, walkSplicing) import Text.Pandoc.Definition -- | Pushes an Block value as userdata object. pushBlock :: LuaError e => Pusher e Block pushBlock = pushUD typeBlock {-# INLINE pushBlock #-} -- | Retrieves an Block value. peekBlock :: LuaError e => Peeker e Block peekBlock = peekUD typeBlock {-# INLINE peekBlock #-} -- | Retrieves a list of Block values. peekBlocks :: LuaError e => Peeker e [Block] peekBlocks = peekList peekBlock {-# INLINABLE peekBlocks #-} -- | Pushes a list of Block values. pushBlocks :: LuaError e => Pusher e [Block] pushBlocks xs = do pushList pushBlock xs 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) pushName "clone" pushDocumentedFunction $ lambda ### return <#> parameter peekBlocksFuzzy "Blocks" "self" "" =#> functionResult pushBlocks "Blocks" "deep copy" rawset (nth 3) pushName "__tostring" pushDocumentedFunction $ lambda ### liftPure show <#> parameter peekBlocksFuzzy "Blocks" "self" "" =#> functionResult pushString "string" "native Haskell representation" rawset (nth 3) pushName "__tojson" pushDocumentedFunction $ lambda ### liftPure encode <#> parameter peekBlocksFuzzy "Blocks" "self" "" =#> functionResult pushLazyByteString "string" "JSON representation" rawset (nth 3) setmetatable (nth 2) {-# INLINABLE pushBlocks #-} -- | Unmarshal a table as Block value by calling the @__toblock@ metamethod -- first. peekBlockMetamethod :: LuaError e => Peeker e Block peekBlockMetamethod idx = do absidx <- liftLua $ absindex idx liftLua (getmetafield absidx "__toblock") >>= \case TypeNil -> failPeek "object has no __toblock metamethod" TypeFunction -> do liftLua (pushvalue absidx) liftLua (pcall 1 1 Nothing) >>= \case OK -> peekBlock top `lastly` pop 1 _err -> do msg <- peekByteString top `lastly` pop 1 failPeek $ "failure in __toblock: " <> msg _otherType -> do liftLua (pop 1) -- drop "__toblock" field failPeek "__toblock metafield does not contain a function" -- | Try extra hard to retrieve an Block value from the stack. Treats -- bare strings as @Str@ values. peekBlockFuzzy :: LuaError e => Peeker e Block peekBlockFuzzy idx = peekBlock idx <|> peekBlockMetamethod idx <|> (Plain <$!> peekInlinesFuzzy idx) <|> (failPeek =<< typeMismatchMessage "Block or list of Inlines" idx) {-# INLINABLE peekBlockFuzzy #-} -- | Try extra-hard to return the value at the given index as a list of -- inlines. peekBlocksFuzzy :: LuaError e => Peeker e [Block] peekBlocksFuzzy idx = peekList peekBlockFuzzy idx <|> (pure <$!> peekBlockFuzzy idx) <|> (failPeek =<< typeMismatchMessage "Block, list of Blocks, or compatible element" idx) {-# INLINABLE peekBlocksFuzzy #-} -- | Block object type. typeBlock :: forall e. LuaError e => DocumentedType e Block typeBlock = deftype "Block" [ operation Eq $ lambda ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b)) <#> parameter (optional . peekBlockFuzzy) "Block" "a" "" <#> parameter (optional . peekBlockFuzzy) "Block" "b" "" =#> boolResult "whether the two values are equal" , operation Tostring $ lambda ### liftPure show <#> udparam typeBlock "self" "" =#> functionResult pushString "string" "Haskell representation" , operation (CustomOperation "__tojson") $ lambda ### liftPure encode <#> udparam typeBlock "self" "" =#> functionResult pushLazyByteString "string" "JSON representation" ] [ possibleProperty "attr" "element attributes" (pushAttr, \case CodeBlock attr _ -> Actual attr Div attr _ -> Actual attr Figure attr _ _ -> Actual attr Header _ attr _ -> Actual attr Table attr _ _ _ _ _ -> Actual attr _ -> Absent) (peekAttr, \case CodeBlock _ code -> Actual . flip CodeBlock code Div _ blks -> Actual . flip Div blks Figure _ capt blks -> Actual . (\attr -> Figure attr capt blks) Header lvl _ blks -> Actual . (\attr -> Header lvl attr blks) Table _ c cs h bs f -> Actual . (\attr -> Table attr c cs h bs f) _ -> const Absent) , possibleProperty "bodies" "table bodies" (pushPandocList pushTableBody, \case Table _ _ _ _ bs _ -> Actual bs _ -> Absent) (peekList peekTableBody, \case Table attr c cs h _ f -> Actual . (\bs -> Table attr c cs h bs f) _ -> const Absent) , possibleProperty "caption" "element caption" (pushCaption, \case Figure _ capt _ -> Actual capt Table _ capt _ _ _ _ -> Actual capt _ -> Absent) (peekCaptionFuzzy, \case Figure attr _ blks -> Actual . (\c -> Figure attr c blks) Table attr _ cs h bs f -> Actual . (\c -> Table attr c cs h bs f) _ -> const Absent) , possibleProperty "colspecs" "column alignments and widths" (pushPandocList pushColSpec, \case Table _ _ cs _ _ _ -> Actual cs _ -> Absent) (peekList peekColSpec, \case Table attr c _ h bs f -> Actual . (\cs -> Table attr c cs h bs f) _ -> const Absent) , possibleProperty "content" "element content" (pushContent, getBlockContent) (peekContent, setBlockContent (Proxy @e)) , possibleProperty "foot" "table foot" (pushTableFoot, \case {Table _ _ _ _ _ f -> Actual f; _ -> Absent}) (peekTableFoot, \case Table attr c cs h bs _ -> Actual . Table attr c cs h bs _ -> const Absent) , possibleProperty "format" "format of raw content" (pushFormat, \case {RawBlock f _ -> Actual f; _ -> Absent}) (peekFormat, \case RawBlock _ txt -> Actual . (`RawBlock` txt) _ -> const Absent) , possibleProperty "head" "table head" (pushTableHead, \case {Table _ _ _ h _ _ -> Actual h; _ -> Absent}) (peekTableHead, \case Table attr c cs _ bs f -> Actual . (\h -> Table attr c cs h bs f) _ -> const Absent) , possibleProperty "level" "heading level" (pushIntegral, \case {Header lvl _ _ -> Actual lvl; _ -> Absent}) (peekIntegral, \case Header _ attr inlns -> Actual . \lvl -> Header lvl attr inlns _ -> const Absent) , possibleProperty "listAttributes" "ordered list attributes" (pushListAttributes, \case OrderedList listAttr _ -> Actual listAttr _ -> Absent) (peekListAttributes, \case OrderedList _ content -> Actual . (`OrderedList` content) _ -> const Absent) , possibleProperty "text" "text contents" (pushText, getBlockText) (peekText, setBlockText) , readonly "tag" "type of Block" (pushString, showConstr . toConstr ) , alias "t" "tag" ["tag"] , alias "c" "content" ["content"] , alias "identifier" "element identifier" ["attr", "identifier"] , alias "classes" "element classes" ["attr", "classes"] , alias "attributes" "other element attributes" ["attr", "attributes"] , alias "start" "ordered list start number" ["listAttributes", "start"] , alias "style" "ordered list style" ["listAttributes", "style"] , alias "delimiter" "numbering delimiter" ["listAttributes", "delimiter"] , method $ defun "clone" ### return <#> parameter peekBlock "Block" "block" "self" =#> functionResult pushBlock "Block" "cloned Block" , method $ defun "show" ### 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" ] getBlockContent :: Block -> Possible Content getBlockContent = \case -- inline content Para inlns -> Actual $ ContentInlines inlns Plain inlns -> Actual $ ContentInlines inlns Header _ _ inlns -> Actual $ ContentInlines inlns -- block content BlockQuote blks -> Actual $ ContentBlocks blks Div _ blks -> Actual $ ContentBlocks blks Figure _ _ blks -> Actual $ ContentBlocks blks -- lines content LineBlock lns -> Actual $ ContentLines lns -- list items content BulletList itms -> Actual $ ContentListItems itms OrderedList _ itms -> Actual $ ContentListItems itms -- definition items content DefinitionList itms -> Actual $ ContentDefItems itms _ -> Absent setBlockContent :: forall e. LuaError e => Proxy e -> Block -> Content -> Possible Block setBlockContent _ = \case -- inline content Para _ -> Actual . Para . inlineContent Plain _ -> Actual . Plain . inlineContent Header attr lvl _ -> Actual . Header attr lvl . inlineContent -- block content BlockQuote _ -> Actual . BlockQuote . blockContent Div attr _ -> Actual . Div attr . blockContent Figure attr c _ -> Actual . Figure attr c . blockContent -- lines content LineBlock _ -> Actual . LineBlock . lineContent -- list items content BulletList _ -> Actual . BulletList . listItemContent OrderedList la _ -> Actual . OrderedList la . listItemContent -- definition items content DefinitionList _ -> Actual . DefinitionList . defItemContent _ -> const Absent where inlineContent = \case ContentInlines inlns -> inlns c -> throwM . luaException @e $ "expected Inlines, got " <> contentTypeDescription c blockContent = \case ContentBlocks blks -> blks ContentInlines [] -> [] ContentInlines inlns -> [Plain inlns] c -> throwM . luaException @e $ "expected Blocks, got " <> contentTypeDescription c lineContent = \case ContentLines lns -> lns c -> throwM . luaException @e $ "expected list of lines (Inlines), got " <> contentTypeDescription c defItemContent = \case ContentDefItems itms -> itms c -> throwM . luaException @e $ "expected definition items, got " <> contentTypeDescription c listItemContent = \case ContentBlocks blks -> map (:[]) blks ContentLines lns -> map ((:[]) . Plain) lns ContentListItems itms -> itms c -> throwM . luaException @e $ "expected list of items, got " <> contentTypeDescription c getBlockText :: Block -> Possible Text getBlockText = \case CodeBlock _ lst -> Actual lst RawBlock _ raw -> Actual raw _ -> Absent setBlockText :: Block -> Text -> Possible Block setBlockText = \case CodeBlock attr _ -> Actual . CodeBlock attr RawBlock f _ -> Actual . RawBlock f _ -> const Absent -- | Constructor functions for 'Block' elements. blockConstructors :: LuaError e => [DocumentedFunction e] blockConstructors = [ defun "BlockQuote" ### liftPure BlockQuote <#> blocksParam =#> blockResult "BlockQuote element" #? "Creates a block quote element" , defun "BulletList" ### liftPure BulletList <#> blockItemsParam "list items" =#> blockResult "BulletList element" #? "Creates a bullet list." , defun "CodeBlock" ### liftPure2 (\code mattr -> CodeBlock (fromMaybe nullAttr mattr) code) <#> textParam "text" "code string" <#> optAttrParam =#> blockResult "CodeBlock element" #? "Creates a code block element." , defun "DefinitionList" ### liftPure DefinitionList <#> parameter (choice [ peekList peekDefinitionItem , \idx -> (:[]) <$!> peekDefinitionItem idx ]) "{{Inlines, {Blocks,...}},...}" "content" "definition items" =#> blockResult "DefinitionList element" #? "Creates a definition list, containing terms and their explanation." , defun "Div" ### liftPure2 (\content mattr -> Div (fromMaybe nullAttr mattr) content) <#> blocksParam <#> optAttrParam =#> blockResult "Div element" #? "Creates a div element" , defun "Figure" ### liftPure3 (\content mcapt mattr -> let attr = fromMaybe nullAttr mattr capt = fromMaybe (Caption mempty mempty) mcapt in Figure attr capt content) <#> parameter peekBlocksFuzzy "Blocks" "content" "figure block content" <#> opt (parameter peekCaptionFuzzy "Caption" "caption" "figure caption") <#> optAttrParam =#> blockResult "Figure object" #? "Creates a [[Figure]] element." , defun "Header" ### liftPure3 (\lvl content mattr -> Header lvl (fromMaybe nullAttr mattr) content) <#> parameter peekIntegral "integer" "level" "heading level" <#> parameter peekInlinesFuzzy "Inlines" "content" "inline content" <#> optAttrParam =#> blockResult "Header element" #? "Creates a header element." , defun "HorizontalRule" ### return HorizontalRule =#> blockResult "HorizontalRule element" #? "Creates a horizontal rule." , defun "LineBlock" ### liftPure LineBlock <#> parameter (peekList peekInlinesFuzzy) "{Inlines,...}" "content" "lines" =#> blockResult "LineBlock element" #? "Creates a line block element." , defun "OrderedList" ### liftPure2 (\items mListAttrib -> let defListAttrib = (1, DefaultStyle, DefaultDelim) in OrderedList (fromMaybe defListAttrib mListAttrib) items) <#> blockItemsParam "list items" <#> opt (parameter peekListAttributes "ListAttributes" "listAttributes" "list parameters") =#> blockResult "OrderedList element" #? "Creates an ordered list." , defun "Para" ### liftPure Para <#> parameter peekInlinesFuzzy "Inlines" "content" "inline content" =#> blockResult "Para element" #? "Creates a para element." , defun "Plain" ### liftPure Plain <#> parameter peekInlinesFuzzy "Inlines" "content" "inline content" =#> blockResult "Plain element" #? "Creates a plain element." , defun "RawBlock" ### liftPure2 RawBlock <#> parameter peekFormat "string" "format" "format of content" <#> textParam "text" "raw content" =#> blockResult "RawBlock element" #? "Creates a raw content block of the specified format." , defun "Table" ### (\capt colspecs thead tbodies tfoot mattr -> let attr = fromMaybe nullAttr mattr in return $! attr `seq` capt `seq` colspecs `seq` thead `seq` tbodies `seq` tfoot `seq` Table attr capt colspecs thead tbodies tfoot) <#> parameter peekCaptionFuzzy "Caption" "caption" "table caption" <#> parameter (peekList peekColSpec) "{ColSpec,...}" "colspecs" "column alignments and widths" <#> parameter peekTableHead "TableHead" "head" "table head" <#> parameter (peekList peekTableBody) "{TableBody,...}" "bodies" "table bodies" <#> parameter peekTableFoot "TableFoot" "foot" "table foot" <#> optAttrParam =#> blockResult "Table element" #? "Creates a table element." ] where blockResult = functionResult pushBlock "Block" blocksParam = parameter peekBlocksFuzzy "Blocks" "content" "block content" blockItemsParam = parameter peekItemsFuzzy "{Blocks,...}" "items" peekItemsFuzzy idx = peekList peekBlocksFuzzy idx <|> ((:[]) <$!> peekBlocksFuzzy idx) optAttrParam = opt (parameter peekAttr "Attr" "attr" "element attributes") -- | Constructor for a list of `Block` values. mkBlocks :: LuaError e => DocumentedFunction e mkBlocks = defun "Blocks" ### liftPure id <#> parameter peekBlocksFuzzy "Blocks" "block_like_elements" ("List where each element can be treated as a [[Block]] value, " <> "or a single such value.") =#> functionResult pushBlocks "Blocks" "list of block elements" #? "Creates a [[Blocks]] list." -- -- 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 pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/Block.hs-boot0000644000000000000000000000224407346545000022743 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} module Text.Pandoc.Lua.Marshal.Block ( -- * 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 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 apandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/Cell.hs0000644000000000000000000001214507346545000021630 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} {- | Copyright : © 2021-2024 Albert Krewinkel SPDX-License-Identifier : MIT Maintainer : Albert Krewinkel Marshaling/unmarshaling functions of table 'Cell' values. -} module Text.Pandoc.Lua.Marshal.Cell ( peekCell , peekCellFuzzy , pushCell , typeCell , mkCell ) where import Control.Applicative (optional) import Control.Monad ((<$!>)) import Data.Aeson (encode) 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.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 = pushUD typeCell -- | Retrieves a 'Cell' object from the stack. peekCell :: LuaError e => Peeker e Cell 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" , operation (CustomOperation "__tojson") $ lambda ### liftPure encode <#> udparam typeCell "self" "" =#> functionResult pushLazyByteString "string" "JSON 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" "cell contents" <#> opt (parameter peekAlignment "Alignment" "align" "text alignment; defaults to `AlignDefault`") <#> opt (parameter peekIntegral "integer" "rowspan" "number of rows occupied by the cell; defaults to `1`") <#> opt (parameter peekIntegral "integer" "colspan" "number of columns occupied by the cell; defaults to `1`") <#> opt (parameter peekAttr "Attr" "attr" "cell attributes") =#> functionResult pushCell "Cell" "new Cell object" #? "Create a new table cell." pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/Citation.hs0000644000000000000000000000763007346545000022526 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Copyright : © 2021-2024 Albert Krewinkel SPDX-License-Identifier : MIT Maintainer : Albert Krewinkel Marshaling/unmarshaling functions and constructor for 'Citation' values. -} module Text.Pandoc.Lua.Marshal.Citation ( -- * Citation peekCitation , pushCitation , typeCitation , mkCitation ) where import Control.Applicative (optional) import Data.Aeson (encode) import Data.Maybe (fromMaybe) import HsLua as Lua import Text.Pandoc.Definition (Citation (..)) import Text.Pandoc.Lua.Marshal.CitationMode (peekCitationMode, pushCitationMode) import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Inline ( peekInlinesFuzzy, pushInlines ) -- | Pushes a Citation value as userdata object. pushCitation :: LuaError e => Pusher e Citation pushCitation = pushUD typeCitation {-# INLINE pushCitation #-} -- | Retrieves a Citation value. peekCitation :: LuaError e => Peeker e Citation peekCitation = peekUD typeCitation {-# INLINE peekCitation #-} -- | Citation object type. typeCitation :: LuaError e => DocumentedType e Citation typeCitation = deftype "Citation" [ operation Eq $ lambda ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b)) <#> parameter (optional . peekCitation) "Citation" "a" "" <#> parameter (optional . peekCitation) "Citation" "b" "" =#> functionResult pushBool "boolean" "true iff the citations are equal" , operation Tostring $ lambda ### liftPure show <#> parameter peekCitation "Citation" "citation" "" =#> functionResult pushString "string" "native Haskell representation" , operation (CustomOperation "__tojson") $ lambda ### liftPure encode <#> udparam typeCitation "self" "" =#> functionResult pushLazyByteString "string" "JSON representation" ] [ property "id" "citation ID / key" (pushText, citationId) (peekText, \citation cid -> citation{ citationId = cid }) , property "mode" "citation mode" (pushCitationMode, citationMode) (peekCitationMode, \citation mode -> citation{ citationMode = mode }) , property "prefix" "citation prefix" (pushInlines, citationPrefix) (peekInlinesFuzzy, \citation prefix -> citation{ citationPrefix = prefix }) , property "suffix" "citation suffix" (pushInlines, citationSuffix) (peekInlinesFuzzy, \citation suffix -> citation{ citationSuffix = suffix }) , property "note_num" "note number" (pushIntegral, citationNoteNum) (peekIntegral, \citation noteNum -> citation{ citationNoteNum = noteNum }) , property "hash" "hash number" (pushIntegral, citationHash) (peekIntegral, \citation hash -> citation{ citationHash = hash }) , method $ defun "clone" ### return <#> udparam typeCitation "obj" "" =#> functionResult pushCitation "Citation" "copy of obj" ] {-# INLINABLE typeCitation #-} -- | Constructor function for 'Citation' elements. mkCitation :: LuaError e => DocumentedFunction e mkCitation = defun "Citation" ### (\cid mode mprefix msuffix mnote_num mhash -> cid `seq` mode `seq` mprefix `seq` msuffix `seq` mnote_num `seq` mhash `seq` return $! Citation { citationId = cid , citationMode = mode , citationPrefix = fromMaybe mempty mprefix , citationSuffix = fromMaybe mempty msuffix , citationNoteNum = fromMaybe 0 mnote_num , citationHash = fromMaybe 0 mhash }) <#> textParam "id" "citation ID (e.g. BibTeX key)" <#> parameter peekCitationMode "CitationMode" "mode" "citation rendering mode" <#> opt (parameter peekInlinesFuzzy "Inlines" "prefix" "") <#> opt (parameter peekInlinesFuzzy "Inlines" "suffix" "") <#> opt (integralParam "note_num" "note number") <#> opt (integralParam "hash" "hash number") =#> functionResult pushCitation "Citation" "new citation object" #? "Creates a single citation." pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/CitationMode.hs0000644000000000000000000000126207346545000023326 0ustar0000000000000000{- | Copyright : © 2021-2024 Albert Krewinkel SPDX-License-Identifier : MIT Maintainer : Albert Krewinkel Marshaling/unmarshaling functions of 'CitationMode' values. -} module Text.Pandoc.Lua.Marshal.CitationMode ( peekCitationMode , pushCitationMode ) where import HsLua import Text.Pandoc.Definition (CitationMode) -- | Retrieves a Citation value from a string. peekCitationMode :: Peeker e CitationMode peekCitationMode = peekRead {-# INLINE peekCitationMode #-} -- | Pushes a CitationMode value as string. pushCitationMode :: Pusher e CitationMode pushCitationMode = pushString . show {-# INLINE pushCitationMode #-} pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/Content.hs0000644000000000000000000000564507346545000022372 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {- | Copyright : © 2021-2024 Albert Krewinkel SPDX-License-Identifier : MIT Maintainer : Albert Krewinkel Defines a helper type that can handle different types of 'Block' and 'Inline' element contents. -} module Text.Pandoc.Lua.Marshal.Content ( Content (..) , contentTypeDescription , peekContent , pushContent , peekDefinitionItem ) where import Control.Applicative ((<|>)) import Control.Monad ((<$!>)) import HsLua import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Block ( peekBlocksFuzzy, pushBlocks ) import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Inline ( peekInlinesFuzzy, pushInlines ) import Text.Pandoc.Lua.Marshal.List (pushPandocList) import Text.Pandoc.Definition (Inline, Block) -- -- Content -- -- | Helper type to represent all the different types a `content` -- attribute can have. data Content = ContentBlocks [Block] | ContentInlines [Inline] | ContentLines [[Inline]] | ContentDefItems [([Inline], [[Block]])] | ContentListItems [[Block]] -- | Returns a human-readable type description; used for error messages. contentTypeDescription :: Content -> String contentTypeDescription = \case ContentBlocks {} -> "list of Block items" ContentInlines {} -> "list of Inline items" ContentLines {} -> "list of Inline lists (i.e., a list of lines)" ContentDefItems {} -> "list of definition items items" ContentListItems {} -> "list items (i.e., list of list of Block elements)" -- | Pushes the 'Content' to the stack. pushContent :: LuaError e => Pusher e Content pushContent = \case ContentBlocks blks -> pushBlocks blks ContentInlines inlns -> pushInlines inlns ContentLines lns -> pushPandocList pushInlines lns ContentDefItems itms -> pushPandocList pushDefinitionItem itms ContentListItems itms -> pushPandocList pushBlocks itms -- | Gets a 'Content' element from the stack. peekContent :: LuaError e => Peeker e Content peekContent idx = (ContentInlines <$!> peekInlinesFuzzy idx) <|> (ContentLines <$!> peekList peekInlinesFuzzy idx) <|> (ContentBlocks <$!> peekBlocksFuzzy idx ) <|> (ContentListItems <$!> peekList peekBlocksFuzzy idx) <|> (ContentDefItems <$!> peekList peekDefinitionItem idx) -- | Retrieves a single definition item from the stack; it is expected -- to be a pair of a list of inlines and a list of list of blocks. Uses -- fuzzy parsing, i.e., tries hard to convert mismatching types into the -- expected result. peekDefinitionItem :: LuaError e => Peeker e ([Inline], [[Block]]) peekDefinitionItem = peekPair peekInlinesFuzzy $ choice [ peekList peekBlocksFuzzy , \idx -> (:[]) <$!> peekBlocksFuzzy idx ] -- | Pushes a single definition items on the stack. pushDefinitionItem :: LuaError e => Pusher e ([Inline], [[Block]]) pushDefinitionItem = pushPair pushInlines (pushPandocList pushBlocks) pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/Filter.hs0000644000000000000000000001173107346545000022176 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {- | Copyright : © 2021-2024 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 (..) , WalkingOrder (..) , 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 ((<|>), optional) import Control.Monad ((<$!>), void) 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) = void $ 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) data Filter = Filter { filterWalkingOrder :: WalkingOrder , filterMap :: Map Name FilterFunction } -- | Description of how an AST should be traversed. data WalkingOrder = WalkForEachType -- ^ Process each type separately, traversing the -- tree bottom-up (leaves to root) for each type. | WalkTopdown -- ^ Traverse the tree top-down, from root to -- leaves and depth first, in a single traversal. -- | 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 walkingSequence <- do _ <- liftLua $ getfield idx "traverse" optional (peekText top) `lastly` pop 1 >>= \case Just "typewise" -> pure WalkForEachType Just "topdown" -> pure WalkTopdown _ -> pure WalkForEachType Filter walkingSequence <$!> foldrM go Map.empty fnNames -- | Looks up a filter function in a Lua 'Filter'. lookup :: Name -> Filter -> Maybe FilterFunction lookup name = (name `Map.lookup`) . filterMap -- | Checks whether the 'Filter' contains a function of the given name. member :: Name -> Filter -> Bool member name = (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) -- | Finds the best filter function for a given element; returns -- 'Nothing' if no such function exists. 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' pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/Format.hs0000644000000000000000000000115507346545000022200 0ustar0000000000000000{- | Copyright : © 2021-2024 Albert Krewinkel SPDX-License-Identifier : MIT Maintainer : Albert Krewinkel Marshaling/unmarshaling functions of 'Format' values. -} module Text.Pandoc.Lua.Marshal.Format ( peekFormat , pushFormat ) where import Control.Monad ((<$!>)) import HsLua import Text.Pandoc.Definition (Format (Format)) -- | Retrieves a 'Format' value from a string. peekFormat :: Peeker e Format peekFormat idx = Format <$!> peekText idx -- | Pushes a 'Format' value as a string. pushFormat :: Pusher e Format pushFormat (Format f) = pushText f pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/Inline.hs0000644000000000000000000004457607346545000022204 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TupleSections #-} {- | Marshal values of types that make up 'Inline' elements. -} module Text.Pandoc.Lua.Marshal.Inline ( typeInline -- * Single Inline elements , peekInline , peekInlineFuzzy , pushInline -- * List of Inlines , peekInlines , peekInlinesFuzzy , pushInlines -- * Constructors , inlineConstructors , mkInlines -- * Walking , walkInlineSplicing , walkInlinesStraight ) where import Control.Applicative ((<|>), optional) import Control.Monad.Catch (throwM) import Control.Monad ((<$!>)) import Data.Aeson (encode) import Data.Data (showConstr, toConstr) 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 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.Lua.Marshal.Shared (walkBlocksAndInlines) import Text.Pandoc.Lua.Walk (SpliceList, Walkable, walkSplicing, walkStraight) import qualified Data.Text as T import qualified Text.Pandoc.Builder as B -- | Pushes an Inline value as userdata object. pushInline :: LuaError e => Pusher e Inline pushInline = pushUD typeInline {-# INLINE pushInline #-} -- | Retrieves an Inline value. peekInline :: LuaError e => Peeker e Inline peekInline = peekUD typeInline {-# INLINE peekInline #-} -- | Retrieves a list of Inline values. peekInlines :: LuaError e => Peeker e [Inline] peekInlines = peekList peekInline {-# INLINABLE peekInlines #-} -- | Pushes a list of Inline values. pushInlines :: LuaError e => Pusher e [Inline] pushInlines xs = do pushList pushInline xs 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) pushName "clone" pushDocumentedFunction $ lambda ### return <#> parameter peekInlinesFuzzy "Inlines" "self" "" =#> functionResult pushInlines "Inlines" "deep copy" rawset (nth 3) pushName "__tostring" pushDocumentedFunction $ lambda ### liftPure show <#> parameter peekInlinesFuzzy "Inlines" "self" "" =#> functionResult pushString "string" "native Haskell representation" rawset (nth 3) pushName "__tojson" pushDocumentedFunction $ lambda ### liftPure encode <#> parameter peekInlinesFuzzy "Inlines" "self" "" =#> functionResult pushLazyByteString "string" "JSON representation" rawset (nth 3) setmetatable (nth 2) {-# INLINABLE pushInlines #-} -- | Unmarshal a value as Inline object by first calling the @__toinline@ -- metamethod on that object. peekInlineMetamethod :: LuaError e => Peeker e Inline peekInlineMetamethod idx = do absidx <- liftLua $ absindex idx liftLua (getmetafield absidx "__toinline") >>= \case TypeNil -> failPeek "object has no __toinline metamethod" TypeFunction -> do liftLua (pushvalue absidx) liftLua (pcall 1 1 Nothing) >>= \case OK -> peekInline top `lastly` pop 1 _err -> do msg <- peekByteString top `lastly` pop 1 failPeek $ "failure in __toinline: " <> msg _otherType -> do liftLua (pop 1) -- drop "__toinline" field failPeek "__toinline metafield does not contain a function" -- | Try extra hard to retrieve an Inline value from the stack. Treats -- bare strings as @Str@ values. peekInlineFuzzy :: LuaError e => Peeker e Inline peekInlineFuzzy idx = retrieving "Inline" $ liftLua (ltype idx) >>= \case TypeString -> Str <$!> peekText idx TypeTable -> peekInlineMetamethod idx <|> peekInline idx _ -> peekInline idx <|> peekInlineMetamethod idx {-# INLINABLE peekInlineFuzzy #-} -- | Try extra-hard to return the value at the given index as a list of -- inlines. peekInlinesFuzzy :: LuaError e => Peeker e [Inline] peekInlinesFuzzy idx = liftLua (ltype idx) >>= \case TypeString -> B.toList . B.text <$> peekText idx _ -> peekList peekInlineFuzzy idx <|> (pure <$> peekInlineFuzzy idx) <|> (failPeek =<< typeMismatchMessage "Inline, list of Inlines, or string" idx) {-# INLINABLE peekInlinesFuzzy #-} -- | Inline object type. typeInline :: forall e. LuaError e => DocumentedType e Inline typeInline = deftype "Inline" [ operation Tostring $ lambda ### liftPure (show @Inline) <#> parameter peekInline "inline" "Inline" "Object" =#> functionResult pushString "string" "stringified Inline" , operation Eq $ defun "__eq" ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b)) <#> parameter (optional . peekInline) "a" "Inline" "" <#> parameter (optional . peekInline) "b" "Inline" "" =#> functionResult pushBool "boolean" "whether the two are equal" , operation (CustomOperation "__tojson") $ lambda ### liftPure encode <#> udparam typeInline "self" "" =#> functionResult pushLazyByteString "string" "JSON representation" ] [ possibleProperty "attr" "element attributes" (pushAttr, \case Code attr _ -> Actual attr Image attr _ _ -> Actual attr Link attr _ _ -> Actual attr Span attr _ -> Actual attr _ -> Absent) (peekAttr, \case Code _ cs -> Actual . (`Code` cs) Image _ cpt tgt -> Actual . \attr -> Image attr cpt tgt Link _ cpt tgt -> Actual . \attr -> Link attr cpt tgt Span _ inlns -> Actual . (`Span` inlns) _ -> const Absent) , possibleProperty "caption" "image caption" (pushInlines, \case Image _ capt _ -> Actual capt _ -> Absent) (peekInlinesFuzzy, \case Image attr _ target -> Actual . (\capt -> Image attr capt target) _ -> const Absent) , possibleProperty "citations" "list of citations" (pushPandocList pushCitation, \case Cite cs _ -> Actual cs _ -> Absent) (peekList peekCitation, \case Cite _ inlns -> Actual . (`Cite` inlns) _ -> const Absent) , possibleProperty "content" "element contents" (pushContent, \case Cite _ inlns -> Actual $ ContentInlines inlns Emph inlns -> Actual $ ContentInlines inlns Link _ inlns _ -> Actual $ ContentInlines inlns Quoted _ inlns -> Actual $ ContentInlines inlns SmallCaps inlns -> Actual $ ContentInlines inlns Span _ inlns -> Actual $ ContentInlines inlns Strikeout inlns -> Actual $ ContentInlines inlns Strong inlns -> Actual $ ContentInlines inlns Subscript inlns -> Actual $ ContentInlines inlns Superscript inlns -> Actual $ ContentInlines inlns Underline inlns -> Actual $ ContentInlines inlns Note blks -> Actual $ ContentBlocks blks _ -> Absent) (peekContent, let inlineContent = \case ContentInlines inlns -> inlns c -> throwM . luaException @e $ "expected Inlines, got " <> contentTypeDescription c blockContent = \case ContentBlocks blks -> blks ContentInlines [] -> [] c -> throwM . luaException @e $ "expected Blocks, got " <> contentTypeDescription c in \case -- inline content Cite cs _ -> Actual . Cite cs . inlineContent Emph _ -> Actual . Emph . inlineContent Link a _ tgt -> Actual . (\inlns -> Link a inlns tgt) . inlineContent Quoted qt _ -> Actual . Quoted qt . inlineContent SmallCaps _ -> Actual . SmallCaps . inlineContent Span attr _ -> Actual . Span attr . inlineContent Strikeout _ -> Actual . Strikeout . inlineContent Strong _ -> Actual . Strong . inlineContent Subscript _ -> Actual . Subscript . inlineContent Superscript _ -> Actual . Superscript . inlineContent Underline _ -> Actual . Underline . inlineContent -- block content Note _ -> Actual . Note . blockContent _ -> const Absent ) , possibleProperty "format" "format of raw text" (pushFormat, \case RawInline fmt _ -> Actual fmt _ -> Absent) (peekFormat, \case RawInline _ txt -> Actual . (`RawInline` txt) _ -> const Absent) , possibleProperty "mathtype" "math rendering method" (pushMathType, \case Math mt _ -> Actual mt _ -> Absent) (peekMathType, \case Math _ txt -> Actual . (`Math` txt) _ -> const Absent) , possibleProperty "quotetype" "type of quotes (single or double)" (pushQuoteType, \case Quoted qt _ -> Actual qt _ -> Absent) (peekQuoteType, \case Quoted _ inlns -> Actual . (`Quoted` inlns) _ -> const Absent) , possibleProperty "src" "image source" (pushText, \case Image _ _ (src, _) -> Actual src _ -> Absent) (peekText, \case Image attr capt (_, title) -> Actual . Image attr capt . (,title) _ -> const Absent) , possibleProperty "target" "link target URL" (pushText, \case Link _ _ (tgt, _) -> Actual tgt _ -> Absent) (peekText, \case Link attr capt (_, title) -> Actual . Link attr capt . (,title) _ -> const Absent) , possibleProperty "title" "title text" (pushText, \case Image _ _ (_, tit) -> Actual tit Link _ _ (_, tit) -> Actual tit _ -> Absent) (peekText, \case Image attr capt (src, _) -> Actual . Image attr capt . (src,) Link attr capt (src, _) -> Actual . Link attr capt . (src,) _ -> const Absent) , possibleProperty "text" "text contents" (pushText, getInlineText) (peekText, setInlineText) , readonly "tag" "type of Inline" (pushString, showConstr . toConstr ) , alias "t" "tag" ["tag"] , alias "c" "content" ["content"] , alias "identifier" "element identifier" ["attr", "identifier"] , alias "classes" "element classes" ["attr", "classes"] , alias "attributes" "other element attributes" ["attr", "attributes"] , method $ defun "clone" ### 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" ] -- -- Text -- -- | Gets the text property of an Inline, if present. getInlineText :: Inline -> Possible Text getInlineText = \case Code _ lst -> Actual lst Math _ str -> Actual str RawInline _ raw -> Actual raw Str s -> Actual s _ -> Absent -- | Sets the text property of an Inline, if present. setInlineText :: Inline -> Text -> Possible Inline setInlineText = \case Code attr _ -> Actual . Code attr Math mt _ -> Actual . Math mt RawInline f _ -> Actual . RawInline f Str _ -> Actual . Str _ -> const Absent -- | Constructor functions for 'Inline' elements. inlineConstructors :: LuaError e => [DocumentedFunction e] inlineConstructors = [ defun "Cite" ### liftPure2 (flip Cite) <#> parameter peekInlinesFuzzy "content" "Inlines" "placeholder content" <#> parameter (peekList peekCitation) "{Citation,...}" "citations" "List of Citations" =#> functionResult pushInline "Inline" "cite element" #? "Creates a Cite inline element" , defun "Code" ### liftPure2 (\text mattr -> Code (fromMaybe nullAttr mattr) text) <#> textParam "code" "code string" <#> opt (parameter peekAttr "Attr" "attr" "additional attributes") =#> functionResult pushInline "Inline" "code element" #? "Creates a Code inline element" , mkInlinesConstr "Emph" Emph #? "Creates an inline element representing emphasized text." , defun "Image" ### liftPure4 (\caption src mtitle mattr -> let attr = fromMaybe nullAttr mattr title = fromMaybe mempty mtitle in Image attr caption (src, title)) <#> parameter peekInlinesFuzzy "Inlines" "caption" "text used to describe the image" <#> textParam "src" "path to the image file" <#> opt (textParam "title" "brief image description") <#> opt (parameter peekAttr "Attr" "attr" "image attributes") =#> functionResult pushInline "Inline" "Image element" #? "Creates an Image element" , defun "LineBreak" ### return LineBreak =#> functionResult pushInline "Inline" "line break" #? "Create a LineBreak inline element" , defun "Link" ### liftPure4 (\content target mtitle mattr -> let attr = fromMaybe nullAttr mattr title = fromMaybe mempty mtitle in Link attr content (target, title)) <#> parameter peekInlinesFuzzy "Inlines" "content" "text for this link" <#> textParam "target" "the link target" <#> opt (textParam "title" "brief link description") <#> opt (parameter peekAttr "Attr" "attr" "link attributes") =#> functionResult pushInline "Inline" "link element" #? "Creates a link inline element, usually a hyperlink." , defun "Math" ### liftPure2 Math <#> parameter peekMathType "MathType" "mathtype" "rendering specifier" <#> textParam "text" "math content" =#> functionResult pushInline "Inline" "math element" #? "Creates a Math element, either inline or displayed." , defun "Note" ### liftPure Note <#> parameter peekBlocksFuzzy "Blocks" "content" "footnote block content" =#> functionResult pushInline "Inline" "note" #? "Creates a Note inline element" , defun "Quoted" ### liftPure2 Quoted <#> parameter peekQuoteType "QuoteType" "quotetype" "type of quotes" <#> parameter peekInlinesFuzzy "Inlines" "content" "inlines in quotes" =#> functionResult pushInline "Inline" "quoted element" #? ("Creates a Quoted inline element given the quote type and " <> "quoted content.") , defun "RawInline" ### liftPure2 RawInline <#> parameter peekFormat "string" "format" "format of content" <#> textParam "text" "string content" =#> functionResult pushInline "Inline" "raw inline element" #? "Creates a raw inline element" , mkInlinesConstr "SmallCaps" SmallCaps #? "Creates text rendered in small caps" , defun "SoftBreak" ### return SoftBreak =#> functionResult pushInline "Inline" "soft break" #? "Creates a SoftBreak inline element." , defun "Space" ### return Space =#> functionResult pushInline "Inline" "new space" #? "Create a Space inline element" , defun "Span" ### liftPure2 (\inlns mattr -> Span (fromMaybe nullAttr mattr) inlns) <#> parameter peekInlinesFuzzy "Inlines" "content" "inline content" <#> opt (parameter peekAttr "Attr" "attr" "additional attributes") =#> functionResult pushInline "Inline" "[[Span]] object" #? "Creates a Span inline element" , defun "Str" ### liftPure Str <#> textParam "text" "" =#> functionResult pushInline "Inline" "[[Str]] object" #? "Creates a Str inline element" , mkInlinesConstr "Strikeout" Strikeout #? "Creates text which is struck out." , mkInlinesConstr "Strong" Strong #? ("Creates a Strong element, whose text is usually displayed in " <> "a bold font.") , mkInlinesConstr "Subscript" Subscript #? "Creates a Subscript inline element" , mkInlinesConstr "Superscript" Superscript #? "Creates a Superscript inline element" , mkInlinesConstr "Underline" Underline #? "Creates an Underline inline element" ] where mkInlinesConstr name constr = defun name ### liftPure (\x -> x `seq` constr x) <#> parameter peekInlinesFuzzy "Inlines" "content" "inline content" =#> functionResult pushInline "Inline" "new object" -- | Constructor for a list of `Inline` values. mkInlines :: LuaError e => DocumentedFunction e mkInlines = defun "Inlines" ### liftPure id <#> parameter peekInlinesFuzzy "Inlines" "inline_like_elements" ("List where each element can be treated as an [[Inline]] " <> "value, or just a single such value.") =#> functionResult pushInlines "Inlines" "list of inline elements" #? T.unlines [ "Converts its argument into an [[Inlines]] list:" , "" , "- copies a list of [[Inline]] elements into a fresh list; any" , " string `s` within the list is treated as `pandoc.Str(s)`;" , "- turns a single [[Inline]] into a singleton list;" , "- splits a string into `Str`-wrapped words, treating" , " interword spaces as `Space`s or `SoftBreak`s." ] -- | 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 pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/Inline.hs-boot0000644000000000000000000000233107346545000023124 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} module Text.Pandoc.Lua.Marshal.Inline ( -- * Single Inline elements peekInline , peekInlineFuzzy , pushInline -- * List of Inlines , peekInlines , peekInlinesFuzzy , pushInlines -- * 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] -- * 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 apandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/List.hs0000644000000000000000000000133407346545000021662 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {- | Copyright : © 2021-2024 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Lua lists with additional methods. -} module Text.Pandoc.Lua.Marshal.List ( module HsLua.List , pushPandocList ) where import HsLua import HsLua.List -- | Pushes a list as a numerically-indexed Lua table, and sets a -- metatable that offers a number of convenience functions. pushPandocList :: LuaError e => Pusher e a -> Pusher e [a] pushPandocList pushItem items = do pushList pushItem items getmetatable' "List" >>= \case TypeTable -> setmetatable (nth 2) _ -> failLua "List has not been initialized correctly." pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/ListAttributes.hs0000644000000000000000000000754307346545000023741 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} {- | Copyright : © 2021-2024 Albert Krewinkel SPDX-License-Identifier : MIT Maintainer : Albert Krewinkel Marshaling/unmarshaling functions and constructor for 'ListAttributes' values. -} module Text.Pandoc.Lua.Marshal.ListAttributes ( typeListAttributes , peekListAttributes , pushListAttributes , mkListAttributes , peekListNumberDelim , pushListNumberDelim , peekListNumberStyle , pushListNumberStyle ) where import Control.Applicative (optional) import Data.Aeson (encode) import Data.Maybe (fromMaybe) import HsLua import Text.Pandoc.Definition ( ListAttributes, ListNumberStyle (..), ListNumberDelim (..)) -- | 'ListAttributes' Lua object type. typeListAttributes :: LuaError e => DocumentedType e ListAttributes typeListAttributes = deftype "ListAttributes" [ operation Eq $ lambda ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b)) <#> parameter (optional . peekListAttributes) "a" "ListAttributes" "" <#> parameter (optional . peekListAttributes) "b" "ListAttributes" "" =#> functionResult pushBool "boolean" "whether the two are equal" , operation (CustomOperation "__tojson") $ lambda ### liftPure encode <#> udparam typeListAttributes "self" "" =#> functionResult pushLazyByteString "string" "JSON representation" ] [ property "start" "number of the first list item" (pushIntegral, \(start,_,_) -> start) (peekIntegral, \(_,style,delim) -> (,style,delim)) , property "style" "style used for list numbering" (pushListNumberStyle, \(_,style,_) -> style) (peekListNumberStyle, \(start,_,delim) -> (start,,delim)) , property "delimiter" "delimiter of list numbers" (pushListNumberDelim, \(_,_,delim) -> delim) (peekListNumberDelim, \(start,style,_) -> (start,style,)) , method $ defun "clone" ### return <#> udparam typeListAttributes "a" "" =#> functionResult (pushUD typeListAttributes) "ListAttributes" "cloned ListAttributes value" ] -- | Pushes a 'ListAttributes' value as userdata object. pushListAttributes :: LuaError e => Pusher e ListAttributes pushListAttributes = pushUD typeListAttributes -- | Retrieve a 'ListAttributes' triple, either from userdata or from a -- Lua tuple. peekListAttributes :: LuaError e => Peeker e ListAttributes peekListAttributes = retrieving "ListAttributes" . choice [ peekUD typeListAttributes , peekTriple peekIntegral peekRead peekRead ] -- | Constructor for a new 'ListAttributes' value. mkListAttributes :: LuaError e => DocumentedFunction e mkListAttributes = defun "ListAttributes" ### liftPure3 (\mstart mstyle mdelim -> ( fromMaybe 1 mstart , fromMaybe DefaultStyle mstyle , fromMaybe DefaultDelim mdelim )) <#> opt (integralParam "start" "number of the first list item") <#> opt (parameter peekRead "string" "style" "style used for list numbering") <#> opt (parameter peekRead "string" "delimiter" "delimiter of list numbers") =#> udresult typeListAttributes "new ListAttributes object" #? "Creates a new ListAttributes object." -- | Pushes a 'ListNumberDelim' value as string. pushListNumberDelim :: Pusher e ListNumberDelim pushListNumberDelim = pushString . show {-# INLINE pushListNumberDelim #-} -- | Retrieves a 'ListNumberDelim' value from a string. peekListNumberDelim :: Peeker e ListNumberDelim peekListNumberDelim = peekRead {-# INLINE peekListNumberDelim #-} -- | Pushes a 'ListNumberStyle' value as string. pushListNumberStyle :: Pusher e ListNumberStyle pushListNumberStyle = pushString . show {-# INLINE pushListNumberStyle #-} -- | Retrieves a 'ListNumberStyle' value from a string. peekListNumberStyle :: Peeker e ListNumberStyle peekListNumberStyle = peekRead {-# INLINE peekListNumberStyle #-} pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/MathType.hs0000644000000000000000000000111007346545000022472 0ustar0000000000000000{- | Copyright : © 2021-2024 Albert Krewinkel SPDX-License-Identifier : MIT Maintainer : Albert Krewinkel Marshaling/unmarshaling functions of 'MathType' values. -} module Text.Pandoc.Lua.Marshal.MathType ( peekMathType , pushMathType ) where import HsLua import Text.Pandoc.Definition (MathType) -- | Retrieves a 'MathType' value from a string. peekMathType :: Peeker e MathType peekMathType = peekRead -- | Pushes a 'MathType' value as a string. pushMathType :: Pusher e MathType pushMathType = pushString . show pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/MetaValue.hs0000644000000000000000000001172107346545000022633 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {- | Copyright : © 2021-2024 Albert Krewinkel SPDX-License-Identifier : MIT Maintainer : Albert Krewinkel Marshaling/unmarshaling functions of 'MetaValue' elements. -} module Text.Pandoc.Lua.Marshal.MetaValue ( peekMetaValue , pushMetaValue , metaValueConstructors ) where import Control.Applicative ((<|>), optional) import Control.Monad ((<$!>)) import HsLua import Text.Pandoc.Lua.Marshal.Block ( peekBlock, peekBlocks, peekBlocksFuzzy, pushBlocks ) import Text.Pandoc.Lua.Marshal.Inline ( peekInline, peekInlines, peekInlinesFuzzy, pushInlines ) import Text.Pandoc.Lua.Marshal.List (pushPandocList) import Text.Pandoc.Definition (MetaValue (..)) import qualified Data.Text as T -- | Push a 'MetaValue' element to the top of the Lua stack. pushMetaValue :: LuaError e => Pusher e MetaValue pushMetaValue = \case MetaBlocks blcks -> pushBlocks blcks MetaBool bool -> pushBool bool MetaInlines inlns -> pushInlines inlns MetaList metalist -> pushPandocList pushMetaValue metalist MetaMap metamap -> pushMap pushText pushMetaValue metamap MetaString t -> pushText t -- | Retrieves the value at the given stack index as 'MetaValue'. peekMetaValue :: forall e. LuaError e => Peeker e MetaValue peekMetaValue = retrieving "MetaValue" . \idx -> do -- Get the contents of an AST element. liftLua (ltype idx) >>= \case TypeBoolean -> MetaBool <$!> peekBool idx TypeString -> MetaString <$!> peekText idx TypeNumber -> MetaString . T.pack <$> (liftLua (isinteger idx) >>= \case False -> show <$!> peekRealFloat @Double idx True -> show <$!> peekIntegral @Prelude.Integer idx) TypeUserdata -> -- Allow singleton Inline or Block elements (MetaInlines . (:[]) <$!> peekInline idx) <|> (MetaBlocks . (:[]) <$!> peekBlock idx) TypeTable -> optional (getName idx) >>= \case Just "Inlines" -> MetaInlines <$!> peekInlinesFuzzy idx Just "Blocks" -> MetaBlocks <$!> peekBlocksFuzzy idx Just "List" -> MetaList <$!> peekList peekMetaValue idx _ -> do -- no meta value tag given, try to guess. len <- liftLua $ rawlen idx if len <= 0 then MetaMap <$!> peekMap peekText peekMetaValue idx else (MetaInlines <$!> peekInlines idx) <|> (MetaBlocks <$!> peekBlocks idx) <|> (MetaList <$!> peekList peekMetaValue idx) _ -> failPeek "could not get meta value" where getName idx = liftLua (getmetafield idx "__name") >>= \case TypeNil -> failPeek "no name" _ -> peekName idx `lastly` pop 1 -- | Constructor functions for 'MetaValue' elements. metaValueConstructors :: LuaError e => [DocumentedFunction e] metaValueConstructors = [ defun "MetaBlocks" ### liftPure MetaBlocks <#> parameter peekBlocksFuzzy "Blocks" "content" "block content" =#> functionResult pushMetaValue "Blocks" "list of Block elements" #? T.unlines [ "Creates a value to be used as a MetaBlocks value in meta" , "data; creates a copy of the input list via `pandoc.Blocks`," , "discarding all non-list keys." ] , defun "MetaBool" ### liftPure MetaBool <#> boolParam "bool" "true or false" =#> functionResult pushMetaValue "boolean" "input, unchanged" , defun "MetaInlines" ### liftPure MetaInlines <#> parameter peekInlinesFuzzy "Inlines" "inlines" "inline elements" =#> functionResult pushMetaValue "Inlines" "list of Inline elements" #? T.unlines [ "Creates a value to be used as a MetaInlines value in meta" , "data; creates a copy of the input list via `pandoc.Inlines`," , "discarding all non-list keys." ] , defun "MetaList" ### liftPure MetaList <#> parameter (peekList peekMetaValue) "MetaValue|{MetaValue,...}" "values" "value, or list of values" =#> functionResult pushMetaValue "List" "list of meta values" #? T.unlines [ "Creates a value to be used as a MetaList in meta data;" , "creates a copy of the input list via `pandoc.List`," , "discarding all non-list keys." ] , defun "MetaMap" ### liftPure MetaMap <#> parameter (peekMap peekText peekMetaValue) "table" "key_value_map" "a string-indexed map of meta values" =#> functionResult pushMetaValue "table" "map of meta values" #? T.unlines [ "Creates a value to be used as a MetaMap in meta data; creates" , "a copy of the input table, keeping only pairs with string" , "keys and discards all other keys." ] , defun "MetaString" ### liftPure MetaString <#> textParam "s" "string value" =#> functionResult pushMetaValue "string" "unchanged input" #? T.unlines [ "Creates a value to be used as a MetaString in meta data; this" , "is the identity function for boolean values and exists only" , "for completeness." ] ] pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/Pandoc.hs0000644000000000000000000001263007346545000022154 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Copyright : © 2021-2024 Albert Krewinkel SPDX-License-Identifier : MIT Maintainer : Albert Krewinkel Marshaling/unmarshaling functions of 'Pandoc' values. -} module Text.Pandoc.Lua.Marshal.Pandoc ( -- * Pandoc typePandoc , peekPandoc , pushPandoc , mkPandoc -- * Meta , peekMeta , pushMeta , mkMeta -- * Filtering , applyFully ) where import Control.Applicative (optional) import Control.Monad ((<$!>)) import Data.Aeson (encode) import Data.Maybe (fromMaybe) import HsLua import Text.Pandoc.Lua.Marshal.Block (peekBlocksFuzzy, pushBlocks) import Text.Pandoc.Lua.Marshal.Filter import Text.Pandoc.Lua.Marshal.MetaValue (peekMetaValue, pushMetaValue) import Text.Pandoc.Lua.Marshal.Shared (walkBlocksAndInlines) import Text.Pandoc.Lua.Walk (applyStraight) import Text.Pandoc.Definition (Pandoc (..), Meta (..), nullMeta) -- | Pushes a 'Pandoc' value as userdata. pushPandoc :: LuaError e => Pusher e Pandoc pushPandoc = pushUD typePandoc -- | Retrieves a 'Pandoc' document from a userdata value. peekPandoc :: LuaError e => Peeker e Pandoc peekPandoc = retrieving "Pandoc" . peekUD typePandoc -- | Pandoc object type. typePandoc :: LuaError e => DocumentedType e Pandoc typePandoc = deftype "Pandoc" [ operation Concat $ lambda ### liftPure2 (<>) <#> parameter peekPandoc "Pandoc" "a" "" <#> parameter peekPandoc "Pandoc" "b" "" =#> functionResult pushPandoc "Pandoc" "combined documents" , operation Eq $ defun "__eq" ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b)) <#> parameter (optional . peekPandoc) "doc1" "pandoc" "" <#> parameter (optional . peekPandoc) "doc2" "pandoc" "" =#> functionResult pushBool "boolean" "true iff the two values are equal" , operation Tostring $ lambda ### liftPure show <#> parameter peekPandoc "Pandoc" "doc" "" =#> functionResult pushString "string" "native Haskell representation" , operation (CustomOperation "__tojson") $ lambda ### liftPure encode <#> udparam typePandoc "self" "" =#> functionResult pushLazyByteString "string" "JSON representation" ] [ property "blocks" "list of blocks" (pushBlocks, \(Pandoc _ blks) -> blks) (peekBlocksFuzzy, \(Pandoc m _) blks -> Pandoc m blks) , property "meta" "document metadata" (pushMeta, \(Pandoc meta _) -> meta) (peekMeta, \(Pandoc _ blks) meta -> Pandoc meta blks) , method $ defun "clone" ### return <#> parameter peekPandoc "Pandoc" "doc" "self" =#> functionResult pushPandoc "Pandoc" "cloned Pandoc document" , method $ defun "walk" ### flip applyFully <#> 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. pushMeta :: LuaError e => Pusher e Meta pushMeta (Meta mmap) = do pushMap pushText pushMetaValue mmap _ <- newmetatable "Meta" setmetatable (nth 2) -- | Retrieves a 'Meta' value from a string-indexed table. peekMeta :: LuaError e => Peeker e Meta peekMeta idx = retrieving "Meta" $ Meta <$!> peekMap peekText peekMetaValue idx -- | Constructor function for 'Pandoc' values. mkPandoc :: LuaError e => DocumentedFunction e mkPandoc = defun "Pandoc" ### liftPure2 (\blocks mMeta -> Pandoc (fromMaybe nullMeta mMeta) blocks) <#> parameter peekBlocksFuzzy "Blocks" "blocks" "document contents" <#> opt (parameter peekMeta "Meta" "meta" "document metadata") =#> functionResult pushPandoc "Pandoc" "new Pandoc document" -- | Constructor for 'Meta' values. mkMeta :: LuaError e => DocumentedFunction e mkMeta = defun "Meta" ### 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' doc = case filterWalkingOrder filter' of WalkForEachType -> walkBlocksAndInlines filter' doc >>= applyMetaFunction filter' >>= applyPandocFunction filter' WalkTopdown -> applyPandocFunction filter' doc >>= applyMetaFunction filter' >>= walkBlocksAndInlines filter' pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/QuoteType.hs0000644000000000000000000000112507346545000022704 0ustar0000000000000000{- | Copyright : © 2021-2024 Albert Krewinkel SPDX-License-Identifier : MIT Maintainer : Albert Krewinkel Marshaling/unmarshaling functions of 'QuoteType' values. -} module Text.Pandoc.Lua.Marshal.QuoteType ( peekQuoteType , pushQuoteType ) where import HsLua import Text.Pandoc.Definition (QuoteType) -- | Retrieves a 'QuoteType' value from a string. peekQuoteType :: Peeker e QuoteType peekQuoteType = peekRead -- | Pushes a 'QuoteType' value as a string. pushQuoteType :: Pusher e QuoteType pushQuoteType = pushString . show pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/Row.hs0000644000000000000000000000722507346545000021523 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} {- | Copyright : © 2021-2024 Albert Krewinkel SPDX-License-Identifier : MIT Maintainer : Albert Krewinkel Marshaling/unmarshaling functions of 'Row' values. -} module Text.Pandoc.Lua.Marshal.Row ( peekRow , peekRowFuzzy , pushRow , typeRow , mkRow ) where import Control.Applicative (optional) import Control.Monad ((<$!>)) import Data.Aeson (encode) import Data.Maybe (fromMaybe) import HsLua import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr) import Text.Pandoc.Lua.Marshal.Cell (peekCellFuzzy, pushCell) import Text.Pandoc.Lua.Marshal.Filter (peekFilter) import Text.Pandoc.Lua.Marshal.List (pushPandocList) import Text.Pandoc.Lua.Marshal.Shared (walkBlocksAndInlines) import Text.Pandoc.Definition -- | Push a table Row as a table with fields @attr@, @alignment@, -- @row_span@, @col_span@, and @contents@. pushRow :: LuaError e => Row -> LuaE e () pushRow = pushUD typeRow -- | Retrieves a 'Cell' object from the stack. peekRow :: LuaError e => Peeker e Row peekRow = peekUD typeRow -- | 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@. peekRowFuzzy :: LuaError e => Peeker e Row peekRowFuzzy idx = liftLua (ltype idx) >>= \case TypeUserdata -> peekRow idx TypeTable -> uncurry Row <$!> peekPair peekAttr (peekList peekCellFuzzy) idx _ -> failPeek =<< typeMismatchMessage "Cell or table" idx -- | Row object type. typeRow :: LuaError e => DocumentedType e Row typeRow = deftype "pandoc Row" [ operation Eq $ defun "__eq" ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b)) <#> parameter (optional . peekRow) "Row" "self" "" <#> parameter (optional . peekRow) "any" "object" "" =#> functionResult pushBool "boolean" "true iff the two values are equal" , operation Tostring $ lambda ### liftPure show <#> parameter peekRow "Row" "self" "" =#> functionResult pushString "string" "native Haskell representation" , operation (CustomOperation "__tojson") $ lambda ### liftPure encode <#> udparam typeRow "self" "" =#> functionResult pushLazyByteString "string" "JSON representation" ] [ property "attr" "row attributes" (pushAttr, \(Row attr _) -> attr) (peekAttr, \(Row _ cells) attr -> Row attr cells) , property "cells" "row cells" (pushPandocList pushCell, \(Row _ cells) -> cells) (peekList peekCellFuzzy, \(Row attr _) cells -> Row attr cells) , alias "identifier" "cell ID" ["attr", "identifier"] , alias "classes" "cell classes" ["attr", "classes"] , alias "attributes" "cell attributes" ["attr", "attributes"] , method $ defun "clone" ### return <#> parameter peekRow "Row" "self" "" =#> functionResult pushRow "Row" "cloned object" , method $ defun "walk" ### flip walkBlocksAndInlines <#> parameter peekRow "Row" "self" "" <#> parameter peekFilter "Filter" "lua_filter" "table of filter functions" =#> functionResult pushRow "Row" "modified cell" ] -- | Constructor function for 'Row' values. mkRow :: LuaError e => DocumentedFunction e mkRow = defun "Row" ### liftPure2 (\mCells mAttr -> Row (fromMaybe nullAttr mAttr) (fromMaybe [] mCells)) <#> opt (parameter (peekList peekCellFuzzy) "{Cell,...}" "cells" "list of table cells in this row") <#> opt (parameter peekAttr "Attr" "attr" "row attributes") =#> functionResult pushRow "Row" "new Row object" #? "Creates a table row." pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/Shared.hs0000644000000000000000000000526107346545000022160 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {- | Copyright : © 2021-2024 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Shared functions used in multiple types. -} module Text.Pandoc.Lua.Marshal.Shared ( -- * Walking walkBlocksAndInlines ) where import Prelude hiding (lookup) import Control.Monad ((>=>)) import HsLua import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Block import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Inline import Text.Pandoc.Lua.Marshal.Filter import Text.Pandoc.Definition import Text.Pandoc.Lua.Topdown import Text.Pandoc.Lua.Walk import Text.Pandoc.Walk -- | Walk blocks and inlines. walkBlocksAndInlines :: (LuaError e, Walkable (SpliceList Block) a, Walkable (SpliceList Inline) a, Walkable [Block] a, Walkable [Inline] a, Walkable Topdown a) => Filter -> a -> LuaE e a walkBlocksAndInlines filter' = case filterWalkingOrder filter' of WalkTopdown -> walkM (applyFilterTopdown filter') WalkForEachType -> walkInlineSplicing filter' >=> walkInlinesStraight filter' >=> walkBlockSplicing filter' >=> walkBlocksStraight filter' -- | Applies a filter by processing the root node(s) first and descending -- towards the leaves depth-first. applyFilterTopdown :: LuaError e => Filter -> Topdown -> LuaE e Topdown applyFilterTopdown filter' topdown@(Topdown _ node) = case node of TBlock x -> case filter' `getFunctionFor` x of Nothing -> pure topdown Just fn -> do (blocks, ctrl) <- applySplicingFunction fn pushBlock peekBlocksFuzzy x pure $ Topdown ctrl $ TBlocks blocks TBlocks xs -> case "Blocks" `lookup` filter' of Nothing -> pure topdown Just fn -> do (blocks, ctrl) <- applyStraightFunction fn pushBlocks peekBlocksFuzzy xs pure $ Topdown ctrl $ TBlocks blocks TInline x -> case filter' `getFunctionFor` x of Nothing -> pure topdown Just fn -> do (inlines, ctrl) <- applySplicingFunction fn pushInline peekInlinesFuzzy x pure $ Topdown ctrl $ TInlines inlines TInlines xs -> case "Inlines" `lookup` filter' of Nothing -> pure topdown Just fn -> do (inlines, ctrl) <- applyStraightFunction fn pushInlines peekInlinesFuzzy xs pure $ Topdown ctrl $ TInlines inlines pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/SimpleTable.hs0000644000000000000000000001065307346545000023154 0ustar0000000000000000{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {- | Copyright : © 2021-2024 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Definition and marshaling of the 'SimpleTable' data type used as a convenience type when dealing with tables. -} module Text.Pandoc.Lua.Marshal.SimpleTable ( SimpleTable (..) , peekSimpleTable , pushSimpleTable , mkSimpleTable ) where import Control.Applicative (optional) import Data.Maybe (fromMaybe) import HsLua as Lua import Text.Pandoc.Lua.Marshal.Alignment (peekAlignment, pushAlignment) import Text.Pandoc.Lua.Marshal.Block (peekBlocksFuzzy, pushBlocks) import Text.Pandoc.Lua.Marshal.Inline (peekInlinesFuzzy, pushInlines) import Text.Pandoc.Lua.Marshal.List (pushPandocList) import Text.Pandoc.Definition import qualified Data.Text as T -- | A simple (legacy-style) table. data SimpleTable = SimpleTable { simpleTableCaption :: [Inline] , simpleTableAlignments :: [Alignment] , simpleTableColumnWidths :: [Double] , simpleTableHeader :: [[Block]] , simpleTableBody :: [[[Block]]] } deriving stock (Eq, Show) typeSimpleTable :: LuaError e => DocumentedType e SimpleTable typeSimpleTable = deftype "SimpleTable" [ operation Eq $ lambda ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b)) <#> parameter (optional . peekSimpleTable) "value" "a" "" <#> parameter (optional . peekSimpleTable) "value" "b" "" =#> functionResult pushBool "boolean" "whether the two objects are equal" , operation Tostring $ lambda ### liftPure show <#> udparam typeSimpleTable "self" "" =#> functionResult pushString "string" "Haskell string representation" ] [ property "caption" "table caption" (pushInlines, simpleTableCaption) (peekInlinesFuzzy, \t capt -> t {simpleTableCaption = capt}) , property "aligns" "column alignments" (pushPandocList pushAlignment, simpleTableAlignments) (peekList peekAlignment, \t aligns -> t{simpleTableAlignments = aligns}) , property "widths" "relative column widths" (pushPandocList pushRealFloat, simpleTableColumnWidths) (peekList peekRealFloat, \t ws -> t{simpleTableColumnWidths = ws}) , property "headers" "table header" (pushRow, simpleTableHeader) (peekRow, \t h -> t{simpleTableHeader = h}) , property "rows" "table body rows" (pushPandocList pushRow, simpleTableBody) (peekList peekRow, \t bs -> t{simpleTableBody = bs}) , readonly "t" "type tag (always 'SimpleTable')" (pushText, const "SimpleTable") , alias "header" "alias for `headers`" ["headers"] ] where pushRow = pushPandocList pushBlocks peekRow :: LuaError e => Peeker e [[Block]] peekRow = peekList peekBlocksFuzzy -- | Push a simple table to the stack by calling the -- @pandoc.SimpleTable@ constructor. pushSimpleTable :: forall e. LuaError e => SimpleTable -> LuaE e () pushSimpleTable = pushUD typeSimpleTable -- | Retrieve a simple table from the stack. peekSimpleTable :: forall e. LuaError e => Peeker e SimpleTable peekSimpleTable = retrieving "SimpleTable" . peekUD typeSimpleTable -- | Constructor for the 'SimpleTable' type. mkSimpleTable :: LuaError e => DocumentedFunction e mkSimpleTable = defun "SimpleTable" ### liftPure5 SimpleTable <#> parameter peekInlinesFuzzy "Inlines" "caption" "table caption" <#> parameter (peekList peekAlignment) "{Alignment,...}" "align" "column alignments" <#> parameter (peekList peekRealFloat) "{number,...}" "widths" "relative column widths" <#> parameter peekRow "{Blocks,...}" "header" "table header row" <#> parameter (peekList peekRow) "{{Blocks,...},...}" "rows" "table rows" =#> functionResult pushSimpleTable "SimpleTable" "new SimpleTable object" #? T.unlines [ "Usage:" , " " , " local caption = \"Overview\"" , " local aligns = {pandoc.AlignDefault, pandoc.AlignDefault}" , " local widths = {0, 0} -- let pandoc determine col widths" , " local headers = {{pandoc.Plain({pandoc.Str \"Language\"})}," , " {pandoc.Plain({pandoc.Str \"Typing\"})}}" , " local rows = {" , " {{pandoc.Plain \"Haskell\"}, {pandoc.Plain \"static\"}}," , " {{pandoc.Plain \"Lua\"}, {pandoc.Plain \"Dynamic\"}}," , " }" , " simple_table = pandoc.SimpleTable(" , " caption," , " aligns," , " widths," , " headers," , " rows" , " )" ] pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/TableFoot.hs0000644000000000000000000000571707346545000022637 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Copyright : © 2021-2024 Albert Krewinkel SPDX-License-Identifier : MIT Maintainer : Albert Krewinkel Marshaling/unmarshaling functions of 'TableFoot' values. -} module Text.Pandoc.Lua.Marshal.TableFoot ( peekTableFoot , pushTableFoot , typeTableFoot , mkTableFoot ) where import Control.Applicative (optional) import Data.Aeson (encode) import Data.Maybe (fromMaybe) import HsLua import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr) import Text.Pandoc.Lua.Marshal.List (pushPandocList) import Text.Pandoc.Lua.Marshal.Row (peekRowFuzzy, pushRow) import Text.Pandoc.Definition -- | Push a TableFoot as a userdata value. pushTableFoot :: LuaError e => TableFoot -> LuaE e () pushTableFoot = pushUD typeTableFoot -- | Retrieves a 'Cell' from the stack. peekTableFoot :: LuaError e => Peeker e TableFoot peekTableFoot = peekUD typeTableFoot -- | Row object type. typeTableFoot :: LuaError e => DocumentedType e TableFoot typeTableFoot = deftype "pandoc TableFoot" [ operation Eq $ defun "__eq" ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b)) <#> parameter (optional . peekTableFoot) "TableFoot" "self" "" <#> parameter (optional . peekTableFoot) "any" "object" "" =#> functionResult pushBool "boolean" "true iff the two values are equal" , operation Tostring $ lambda ### liftPure show <#> parameter peekTableFoot "TableFoot" "self" "" =#> functionResult pushString "string" "native Haskell representation" , operation (CustomOperation "__tojson") $ lambda ### liftPure encode <#> udparam typeTableFoot "self" "" =#> functionResult pushLazyByteString "string" "JSON representation" ] [ property "attr" "table foot attributes" (pushAttr, \(TableFoot attr _) -> attr) (peekAttr, \(TableFoot _ cells) attr -> TableFoot attr cells) , property "rows" "footer rows" (pushPandocList pushRow, \(TableFoot _ rows) -> rows) (peekList peekRowFuzzy, \(TableFoot attr _) rows -> TableFoot attr rows) , alias "identifier" "cell ID" ["attr", "identifier"] , alias "classes" "cell classes" ["attr", "classes"] , alias "attributes" "cell attributes" ["attr", "attributes"] , method $ defun "clone" ### return <#> parameter peekTableFoot "TableFoot" "self" "" =#> functionResult pushTableFoot "TableFoot" "cloned object" ] -- | Constructor function for 'Row' values. mkTableFoot :: LuaError e => DocumentedFunction e mkTableFoot = defun "TableFoot" ### liftPure2 (\mCells mAttr -> TableFoot (fromMaybe nullAttr mAttr) (fromMaybe [] mCells)) <#> opt (parameter (peekList peekRowFuzzy) "{Row,...}" "rows" "list of table rows") <#> opt (parameter peekAttr "Attr" "attr" "table foot attributes") =#> functionResult pushTableFoot "TableFoot" "new TableFoot object" #? "Creates a table foot." pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/TableHead.hs0000644000000000000000000000571507346545000022567 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Copyright : © 2021-2024 Albert Krewinkel SPDX-License-Identifier : MIT Maintainer : Albert Krewinkel Marshaling/unmarshaling functions of 'TableHead' values. -} module Text.Pandoc.Lua.Marshal.TableHead ( peekTableHead , pushTableHead , typeTableHead , mkTableHead ) where import Control.Applicative (optional) import Data.Aeson (encode) import Data.Maybe (fromMaybe) import HsLua import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr) import Text.Pandoc.Lua.Marshal.List (pushPandocList) import Text.Pandoc.Lua.Marshal.Row (peekRowFuzzy, pushRow) import Text.Pandoc.Definition -- | Push a TableHead as a userdata value. pushTableHead :: LuaError e => TableHead -> LuaE e () pushTableHead = pushUD typeTableHead -- | Retrieves a 'Cell' from the stack. peekTableHead :: LuaError e => Peeker e TableHead peekTableHead = peekUD typeTableHead -- | Row object type. typeTableHead :: LuaError e => DocumentedType e TableHead typeTableHead = deftype "pandoc TableHead" [ operation Eq $ defun "__eq" ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b)) <#> parameter (optional . peekTableHead) "TableHead" "self" "" <#> parameter (optional . peekTableHead) "any" "object" "" =#> functionResult pushBool "boolean" "true iff the two values are equal" , operation Tostring $ lambda ### liftPure show <#> parameter peekTableHead "TableHead" "self" "" =#> functionResult pushString "string" "native Haskell representation" , operation (CustomOperation "__tojson") $ lambda ### liftPure encode <#> udparam typeTableHead "self" "" =#> functionResult pushLazyByteString "string" "JSON representation" ] [ property "attr" "table head attributes" (pushAttr, \(TableHead attr _) -> attr) (peekAttr, \(TableHead _ cells) attr -> TableHead attr cells) , property "rows" "header rows" (pushPandocList pushRow, \(TableHead _ rows) -> rows) (peekList peekRowFuzzy, \(TableHead attr _) rows -> TableHead attr rows) , alias "identifier" "cell ID" ["attr", "identifier"] , alias "classes" "cell classes" ["attr", "classes"] , alias "attributes" "cell attributes" ["attr", "attributes"] , method $ defun "clone" ### return <#> parameter peekTableHead "TableHead" "self" "" =#> functionResult pushTableHead "TableHead" "cloned object" ] -- | Constructor function for 'Row' values. mkTableHead :: LuaError e => DocumentedFunction e mkTableHead = defun "TableHead" ### liftPure2 (\mRows mAttr -> TableHead (fromMaybe nullAttr mAttr) (fromMaybe [] mRows)) <#> opt (parameter (peekList peekRowFuzzy) "{Row,...}" "rows" "list of table rows") <#> opt (parameter peekAttr "Attr" "attr" "table head attributes") =#> functionResult pushTableHead "TableHead" "new TableHead object" #? "Creates a table head." pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Marshal/TableParts.hs0000644000000000000000000000746107346545000023017 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {- | Copyright : © 2021-2024 Albert Krewinkel SPDX-License-Identifier : MIT Maintainer : Albert Krewinkel Marshaling/unmarshaling functions of types that are used exclusively with tables. -} module Text.Pandoc.Lua.Marshal.TableParts ( peekCaption , peekCaptionFuzzy , pushCaption , peekColSpec , pushColSpec , peekRow , peekRowFuzzy , pushRow , peekTableBody , pushTableBody , peekTableFoot , pushTableFoot , peekTableHead , pushTableHead -- * Constructors , mkRow , mkTableFoot , mkTableHead ) where import Control.Applicative ((<|>), optional) import Control.Monad ((<$!>)) import HsLua import Text.Pandoc.Lua.Marshal.Alignment (peekAlignment, pushAlignment) import Text.Pandoc.Lua.Marshal.Attr (peekAttr, pushAttr) import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Block ( peekBlocksFuzzy, pushBlocks ) import {-# SOURCE #-} Text.Pandoc.Lua.Marshal.Inline ( peekInlinesFuzzy, pushInlines ) import Text.Pandoc.Lua.Marshal.List (pushPandocList) import Text.Pandoc.Lua.Marshal.Row import Text.Pandoc.Lua.Marshal.TableFoot import Text.Pandoc.Lua.Marshal.TableHead import Text.Pandoc.Definition -- | Push Caption element pushCaption :: LuaError e => Caption -> LuaE e () pushCaption (Caption shortCaption longCaption) = do newtable addField "short" (maybe pushnil pushInlines shortCaption) addField "long" (pushBlocks longCaption) -- | Peek Caption element peekCaption :: LuaError e => Peeker e Caption peekCaption idx = do short <- optional $ peekFieldRaw peekInlinesFuzzy "short" idx long <- peekFieldRaw peekBlocksFuzzy "long" idx return $! Caption short long peekCaptionFuzzy :: LuaError e => Peeker e Caption peekCaptionFuzzy = retrieving "Caption" . \idx -> do peekCaption idx <|> (Caption Nothing <$!> peekBlocksFuzzy idx) <|> (failPeek =<< typeMismatchMessage "Caption, list of Blocks, or compatible element" idx) -- | Push a ColSpec value as a pair of Alignment and ColWidth. pushColSpec :: LuaError e => Pusher e ColSpec pushColSpec = pushPair pushAlignment pushColWidth -- | Peek a ColSpec value as a pair of Alignment and ColWidth. peekColSpec :: LuaError e => Peeker e ColSpec peekColSpec = peekPair peekAlignment peekColWidth peekColWidth :: Peeker e ColWidth peekColWidth = retrieving "ColWidth" . \idx -> do maybe ColWidthDefault ColWidth <$!> optional (peekRealFloat idx) -- | Push a ColWidth value by pushing the width as a plain number, or -- @nil@ for ColWidthDefault. pushColWidth :: LuaError e => Pusher e ColWidth pushColWidth = \case (ColWidth w) -> push w ColWidthDefault -> pushnil -- | Pushes a 'TableBody' value as a Lua table with fields @attr@, -- @row_head_columns@, @head@, and @body@. pushTableBody :: LuaError e => Pusher e TableBody pushTableBody (TableBody attr (RowHeadColumns rowHeadColumns) head' body) = do newtable addField "attr" (pushAttr attr) addField "row_head_columns" (pushIntegral rowHeadColumns) addField "head" (pushPandocList pushRow head') addField "body" (pushPandocList pushRow body) -- | Retrieves a 'TableBody' value from a Lua table with fields @attr@, -- @row_head_columns@, @head@, and @body@. peekTableBody :: LuaError e => Peeker e TableBody peekTableBody = fmap (retrieving "TableBody") . typeChecked "table" istable $ \idx -> TableBody <$!> peekFieldRaw peekAttr "attr" idx <*> peekFieldRaw (fmap RowHeadColumns . peekIntegral) "row_head_columns" idx <*> peekFieldRaw (peekList peekRowFuzzy) "head" idx <*> peekFieldRaw (peekList peekRowFuzzy) "body" idx -- | Add a value to the table at the top of the stack at a string-index. addField :: LuaError e => Name -> LuaE e () -> LuaE e () addField key pushFieldValue = do pushName key pushFieldValue rawset (nth 3) pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/0000755000000000000000000000000007346545000017023 5ustar0000000000000000pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/SpliceList.hs0000644000000000000000000001050407346545000021432 0ustar0000000000000000{-# 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' pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Topdown.hs0000644000000000000000000001020607346545000021010 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {- | Module : Text.Pandoc.Lua.Topdown Copyright : © 2012-2021 John MacFarlane, © 2017-2021 Albert Krewinkel License : GNU GPL, version 2 or above Maintainer : Albert Krewinkel Walk documents in a filter-suitable way, descending from the root towards the leaves. -} module Text.Pandoc.Lua.Topdown ( TraversalNode (..) , Topdown (..) , TraversalControl (..) ) where import Control.Monad ((>=>)) import Text.Pandoc.Definition import Text.Pandoc.Lua.Walk import Text.Pandoc.Walk -- | Helper type to do a preorder traversal of a subtree. data TraversalNode = TBlock Block | TBlocks [Block] | TInline Inline | TInlines [Inline] -- | Type used to traverse a 'Pandoc' AST from top to bottom, i.e., -- processing the root element first and then continue towards the -- leaves depth-first. Aborts the descend if 'topdownControl' is 'Stop'. data Topdown = Topdown { topdownControl :: TraversalControl , topdownNode :: TraversalNode } -- | Extracts a list of 'Inline' elements from a 'TraversalNode'. -- WARNING: This is a partial function and will throw an error if the -- node contains a 'Block' or a list of 'Block's. nodeInlines :: TraversalNode -> [Inline] nodeInlines = \case TInlines xs -> xs TInline x -> [x] _ -> error $ "The 'impossible' has happened." ++ "Please report this as a bug" -- | Extracts a list of 'Block' elements from a 'TraversalNode'. nodeBlocks :: TraversalNode -> [Block] nodeBlocks = \case TBlocks xs -> xs TBlock x -> [x] TInlines xs -> [Plain xs] TInline x -> [Plain [x]] -- | Creates a topdown-walking function for a list of elements. walkTopdownM :: (Monad m, Walkable Topdown a) => ([a] -> TraversalNode) -> (a -> TraversalNode) -> (TraversalNode -> [a]) -> (Topdown -> m Topdown) -> [a] -> m [a] walkTopdownM mkListNode mkElemNode nodeToList f = f . Topdown Continue . mkListNode >=> \case Topdown Stop node -> return $ nodeToList node Topdown Continue node -> mconcat <$> traverse (f . Topdown Continue . mkElemNode >=> \case Topdown Stop node' -> return $ nodeToList node' Topdown Continue node' -> traverse (walkM f) $ nodeToList node') (nodeToList node) -- | Creates a topdown-query function for a list of elements. queryTopdown :: (Monoid a, Walkable Topdown b) => ([b] -> TraversalNode) -> (Topdown -> a) -> [b] -> a queryTopdown mkListNode f xs = f (Topdown Continue $ mkListNode xs) <> mconcat (map (query f) xs) instance {-# OVERLAPPING #-} Walkable Topdown [Block] where walkM = walkTopdownM TBlocks TBlock nodeBlocks query = queryTopdown TBlocks instance {-# OVERLAPPING #-} Walkable Topdown [Inline] where walkM = walkTopdownM TInlines TInline nodeInlines query = queryTopdown TInlines instance Walkable Topdown Block where walkM = walkBlockM query = queryBlock instance Walkable Topdown Inline where walkM = walkInlineM query = queryInline instance Walkable Topdown Pandoc where walkM = walkPandocM query = queryPandoc instance Walkable Topdown Citation where walkM = walkCitationM query = queryCitation instance Walkable Topdown Row where walkM = walkRowM query = queryRow instance Walkable Topdown TableHead where walkM = walkTableHeadM query = queryTableHead instance Walkable Topdown TableBody where walkM = walkTableBodyM query = queryTableBody instance Walkable Topdown TableFoot where walkM = walkTableFootM query = queryTableFoot instance Walkable Topdown Caption where walkM = walkCaptionM query = queryCaption instance Walkable Topdown Cell where walkM = walkCellM query = queryCell instance Walkable Topdown MetaValue where walkM = walkMetaValueM query = queryMetaValue instance Walkable Topdown Meta where walkM f (Meta metamap) = Meta <$> walkM f metamap query f (Meta metamap) = query f metamap pandoc-lua-marshal-0.2.9/src/Text/Pandoc/Lua/Walk.hs0000644000000000000000000001260407346545000020260 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# 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 , TraversalControl (..) , walkSplicing , walkStraight , applyStraight , applySplicing , applyStraightFunction , applySplicingFunction ) where import Prelude hiding (lookup) import Control.Applicative ((<|>)) import Control.Monad ((<$!>)) 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 $ fmap fst . 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 -> fst <$> -- 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, TraversalControl) applyStraightFunction fn pushElement peekElement x = do pushFilterFunction fn pushElement x callTrace 1 2 forcePeek . (`lastly` pop 2) $ (,) <$> ((x <$ peekNil (nth 2)) <|> peekElement (nth 2)) <*> peekTraversalControl 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 -> fst <$> -- 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], TraversalControl) applySplicingFunction fn pushElement peekElements x = do pushFilterFunction fn pushElement x callTrace 1 2 forcePeek . (`lastly` pop 2) $ (,) <$> (liftLua (ltype (nth 2)) >>= \case TypeNil -> pure [x] -- function returned `nil`, keep original value _ -> peekElements (nth 2)) <*> peekTraversalControl top -- -- Helper -- data TraversalControl = Continue | Stop -- | Retrieves a Traversal control value: @nil@ or a truthy value -- translate to 'Continue', @false@ is treated to mean 'Stop'. peekTraversalControl :: Peeker e TraversalControl peekTraversalControl idx = (Continue <$ peekNil idx) <|> (liftLua (toboolean top) >>= \case True -> pure Continue False -> pure Stop) pandoc-lua-marshal-0.2.9/test/0000755000000000000000000000000007346545000014342 5ustar0000000000000000pandoc-lua-marshal-0.2.9/test/test-attr.lua0000644000000000000000000001226207346545000016777 0ustar0000000000000000local tasty = require 'tasty' local test = tasty.test_case local group = tasty.test_group local assert = tasty.assert return { group 'Attr' { group 'Constructor' { test('Attr is a function', function () assert.are_equal(type(Attr), 'function') end), test('returns null-Attr if no arguments are given', function () local attr = Attr() assert.are_equal(attr.identifier, '') assert.are_same(attr.classes, {}) assert.are_same(#attr.attributes, 0) end), test( 'accepts string-indexed table or list of pairs as attributes', function () local attributes_list = {{'one', '1'}, {'two', '2'}} local attr_from_list = Attr('', {}, attributes_list) assert.are_equal(attr_from_list.attributes.one, '1') assert.are_equal(attr_from_list.attributes.two, '2') local attributes_table = {one = '1', two = '2'} local attr_from_table = Attr('', {}, attributes_table) assert.are_equal( attr_from_table.attributes, AttributeList(attributes_table) ) assert.are_equal(attr_from_table.attributes.one, '1') assert.are_equal(attr_from_table.attributes.two, '2') end ) }, group 'Properties' { test('has t and tag property', function () local attr = Attr('') assert.are_equal(attr.t, 'Attr') assert.are_equal(attr.tag, 'Attr') end), test('has field `identifier`', function () local attr = Attr 'test' assert.are_equal(attr.identifier, 'test') end), test('can be modified through field `identifier`', function () local attr = Attr 'test' attr.identifier = 'new' assert.are_equal(attr, Attr 'new') end), group 'field classes' { test('can be read', function () local attr = Attr('', {'one'}) assert.are_same(attr.classes, {'one'}) end), test('can be set', function () local attr = Attr() attr.classes = {'two'} assert.are_equal(attr, Attr('', {'two'})) end), test('contains a pandoc List', function () assert.are_equal(getmetatable(Attr().classes), List) end), } }, group 'AttributeList' { test('allows access via fields', function () local attributes = Attr('', {}, {{'a', '1'}, {'b', '2'}}).attributes assert.are_equal(attributes.a, '1') assert.are_equal(attributes.b, '2') end), test('allows access to pairs via numerical indexing', function () local attributes = Attr('', {}, {{'a', '1'}, {'b', '2'}}).attributes assert.are_same(attributes[1], {'a', '1'}) assert.are_same(attributes[2], {'b', '2'}) end), test('allows replacing a pair', function () local attributes = AttributeList{{'a', '1'}, {'b', '2'}} attributes[1] = {'t','five'} assert.are_same(attributes[1], {'t', 'five'}) assert.are_same(attributes[2], {'b', '2'}) end), test('allows to remove a pair', function () local attributes = AttributeList{{'a', '1'}, {'b', '2'}} attributes[1] = nil assert.are_equal(#attributes, 1) end), test('adds entries by field name', function () local attributes = Attr('',{}, {{'c', '1'}, {'d', '2'}}).attributes attributes.e = '3' assert.are_same( attributes, -- checking the full AttributeList would "duplicate" entries AttributeList{{'c', '1'}, {'d', '2'}, {'e', '3'}} ) end), test('deletes entries by field name', function () local attributes = Attr('',{}, {a = '1', b = '2'}).attributes attributes.a = nil assert.is_nil(attributes.a) assert.are_same(attributes, AttributeList{{'b', '2'}}) end), test('remains unchanged if deleted key did not exist', function () local assoc_list = List:new {{'alpha', 'x'}, {'beta', 'y'}} local attributes = Attr('', {}, assoc_list).attributes attributes.a = nil local new_assoc_list = List() for k, v in pairs(attributes) do new_assoc_list:insert({k, v}) end assert.are_same(new_assoc_list, assoc_list) end), test('gives key-value pairs when iterated-over', function () local attributes = {width = '11', height = '22', name = 'test'} local attr = Attr('', {}, attributes) local count = 0 for k, v in pairs(attr.attributes) do assert.are_equal(attributes[k], v) count = count + 1 end assert.are_equal(count, 3) end) }, group 'HTML-like attribute tables' { test('in element constructor', function () local html_attributes = { id = 'the-id', class = 'class1 class2', width = '11', height = '12' } local attr = Attr(html_attributes) assert.are_equal(attr.identifier, 'the-id') assert.are_equal(attr.classes[1], 'class1') assert.are_equal(attr.classes[2], 'class2') assert.are_equal(attr.attributes.width, '11') assert.are_equal(attr.attributes.height, '12') end), } } } pandoc-lua-marshal-0.2.9/test/test-block.lua0000644000000000000000000005366107346545000017127 0ustar0000000000000000local tasty = require 'tasty' local test = tasty.test_case local group = tasty.test_group local assert = tasty.assert return { group "Block" { group 'BlockQuote' { test('access content via property `content`', function () local elem = BlockQuote{'word'} assert.are_equal(elem.content, Blocks{Plain 'word'}) assert.are_equal(type(elem.content), 'table') elem.content = { Para{Str 'one'}, Para{Str 'two'} } assert.are_equal( BlockQuote{ Para 'one', Para 'two' }, elem ) end), }, group 'BulletList' { test('access items via property `content`', function () local para = Para 'one' local blist = BulletList{{para}} assert.are_equal(List{Blocks{para}}, blist.content) end), test('property `content` is a list of Block lists', function () local items = List{Blocks{Plain 'item 1'}, Blocks{Plain 'item 2'}} local blist = BulletList{} blist.content = items assert.are_equal(items, blist:clone().content) end), test('property `content` uses fuzzy marshalling', function () local new = Plain 'new' local blist = BulletList{{Plain 'old'}} blist.content = {{new}} assert.are_equal(List{Blocks{new}}, blist:clone().content) blist.content = new assert.are_equal(List{Blocks{new}}, blist:clone().content) end), test('property `content` prioritizes lists', function () local blist = BulletList{} local one, two = Para 'one', Plain 'two' blist.content = {one, two} assert.are_equal( List{Blocks{one}, Blocks{two}}, blist:clone().content ) end), test('behavior is consistent with constructor', function () local content = {Para 'one', CodeBlock 'print "Hello"'} local bl1 = BulletList(content) local bl2 = BulletList{} bl2.content = content assert.are_equal(bl1, bl2) end), test('mixing types works', function () local one = Plain 'one' local two = 'two' local blist = BulletList{} blist.content = {one, two} assert.are_same( List{Blocks{one}, Blocks{Plain(two)}}, blist:clone().content ) end), }, group 'CodeBlock' { test('access code via property `text`', function () local cb = CodeBlock('return true') assert.are_equal(cb.text, 'return true') assert.are_equal(type(cb.text), 'string') cb.text = 'return nil' assert.are_equal(cb, CodeBlock('return nil')) end), test('access Attr via property `attr`', function () local cb = CodeBlock('true', {'my-code', {'lua'}}) assert.are_equal(cb.attr, Attr{'my-code', {'lua'}}) assert.are_equal(type(cb.attr), 'userdata') cb.attr = Attr{'my-other-code', {'java'}} assert.are_equal( CodeBlock('true', {'my-other-code', {'java'}}), cb ) end) }, group 'DefinitionList' { test('access items via property `content`', function () local deflist = DefinitionList{ {'apple', {{Plain 'fruit'}, {Plain 'company'}}}, {Str 'coffee', 'Best when hot.'} } assert.are_equal(#deflist.content, 2) assert.are_same(deflist.content[1][1], {Str 'apple'}) assert.are_same(deflist.content[1][2][2], {Plain{Str 'company'}}) assert.are_same(deflist.content[2][2], {{Plain{ Str 'Best', Space(), Str 'when', Space(), Str 'hot.'}}}) end), test('modify items via property `content`', function () local deflist = DefinitionList{ {'apple', {{{'fruit'}}, {{'company'}}}} } deflist.content[1][1] = Str 'orange' deflist.content[1][2][1] = {Plain 'tasty fruit'} local newlist = DefinitionList{ { {Str 'orange'}, {{Plain 'tasty fruit'}, {Plain 'company'}} } } assert.are_equal(deflist, newlist) end), }, group 'Div' { test('access content via property `content`', function () local elem = Div{BlockQuote{Plain 'word'}} assert.are_same(elem.content, {BlockQuote{'word'}}) assert.are_equal(type(elem.content), 'table') elem.content = { Para{Str 'one'}, Para{Str 'two'} } assert.are_equal( Div{ Para 'one', Para 'two' }, elem ) end), test('access Attr via property `attr`', function () local div = Div('word', {'my-div', {'sample'}}) assert.are_equal(div.attr, Attr{'my-div', {'sample'}}) assert.are_equal(type(div.attr), 'userdata') div.attr = Attr{'my-other-div', {'example'}} assert.are_equal( Div('word', {'my-other-div', {'example'}}), div ) end), test('accessing the content does not change the value', function () local div = Div {} assert.are_equal(div, Div{}) x = div.content assert.are_equal(div, Div{}) end) }, group 'Figure' { test('access content via property `content`', function () local elem = Figure{BlockQuote{Plain 'word'}} assert.are_same(elem.content, {BlockQuote{'word'}}) assert.are_equal(type(elem.content), 'table') elem.content = { Para{Str 'one'}, Para{Str 'two'} } assert.are_equal( Figure{ Para 'one', Para 'two' }, elem ) end), test('access caption via property `caption`', function () local figure = Figure('word', {short='short', long='caption'}) assert.are_equal(figure.caption.long, Blocks 'caption') assert.are_equal(figure.caption.short, Inlines 'short') assert.are_equal(type(figure.caption), 'table') figure.caption = {long = 'One day I was...', short = 'My day'} assert.are_equal( Figure('word', {long = 'One day I was...', short = 'My day'}), figure ) end), test('access Attr via property `attr`', function () local figure = Figure('word', {long='caption'}, {'my-fig', {'sample'}}) assert.are_equal(figure.attr, Attr{'my-fig', {'sample'}}) assert.are_equal(type(figure.attr), 'userdata') figure.attr = Attr{'my-other-figure', {'example'}} assert.are_equal( Figure('word', {long='caption'}, {'my-other-figure', {'example'}}), figure ) end) }, group 'Header' { test('access inlines via property `content`', function () local header = Header(1, 'test') assert.are_same(header.content, {Str 'test'}) header.content = {'new text'} assert.are_equal(header, Header(1, {'new text'})) end), test('access Attr via property `attr`', function () local header = Header(1, 'test', {'my-test'}) assert.are_same(header.attr, Attr{'my-test'}) header.attr = 'second-test' assert.are_equal(header, Header(1, 'test', 'second-test')) end), test('access level via property `level`', function () local header = Header(3, 'test') assert.are_same(header.level, 3) header.level = 2 assert.are_equal(header, Header(2, 'test')) end), }, group 'LineBlock' { test('access lines via property `content`', function () local spc = Space() local lineblock = LineBlock{ {'200', spc, 'Main', spc, 'St.'}, {'Berkeley', spc, 'CA', spc, '94718'} } assert.are_equal(#lineblock.content, 2) -- has two lines assert.are_same(lineblock.content[2][1], Str 'Berkeley') end), test('modifying `content` alter the element', function () local spc = Space() local lineblock = LineBlock{ {'200', spc, 'Main', spc, 'St.'}, {'Berkeley', spc, 'CA', spc, '94718'} } lineblock.content[1][1] = '404' assert.are_same( lineblock:clone().content[1], {Str '404', spc, Str 'Main', spc, Str 'St.'} ) lineblock.content = {{'line1'}, {'line2'}} assert.are_same( lineblock:clone(), LineBlock{ {Str 'line1'}, {Str 'line2'} } ) end) }, group 'OrderedList' { test('access items via property `content`', function () local para = Plain 'one' local olist = OrderedList{{para}} assert.are_same({{para}}, olist.content) end), test('forgiving constructor', function () local plain = Plain 'old' local olist = OrderedList({plain}, {3, 'Example', 'Period'}) local listAttribs = ListAttributes(3, 'Example', 'Period') assert.are_same(olist.listAttributes, listAttribs) end), test('has list attribute aliases', function () local olist = OrderedList({}, {4, 'Decimal', 'OneParen'}) assert.are_equal(olist.start, 4) assert.are_equal(olist.style, 'Decimal') assert.are_equal(olist.delimiter, 'OneParen') end) }, group 'Para' { test('access inline via property `content`', function () local para = Para{'Moin, ', Space(), 'Sylt!'} assert.are_same( para.content, {Str 'Moin, ', Space(), Str 'Sylt!'} ) end), test('modifying `content` changes the element', function () local para = Para{'Moin, ', Space(), Str 'Sylt!'} para.content[3] = 'Hamburg!' assert.are_same( para:clone().content, {Str 'Moin, ', Space(), Str 'Hamburg!'} ) para.content = 'Huh' assert.are_same( para:clone().content, {Str 'Huh'} ) end), }, group 'RawBlock' { test('access raw content via property `text`', function () local raw = RawBlock('markdown', '- one') assert.are_equal(type(raw.text), 'string') assert.are_equal(raw.text, '- one') raw.text = '+ one' assert.are_equal(raw, RawBlock('markdown', '+ one')) end), test('access Format via property `format`', function () local raw = RawBlock('markdown', '* hi') assert.are_equal(type(raw.format), 'string') assert.are_equal(raw.format, 'markdown') raw.format = 'org' assert.are_equal(RawBlock('org', '* hi'), raw) end) }, group 'Table' { test('access Attr via property `attr`', function () local caption = {long = {Plain 'cap'}} local tbl = Table(caption, {}, TableHead(), {}, TableFoot(), {'my-tbl', {'a'}}) assert.are_equal(tbl.attr, Attr{'my-tbl', {'a'}}) tbl.attr = Attr{'my-other-tbl', {'b'}} assert.are_equal( Table(caption, {}, TableHead(), {}, TableFoot(), {'my-other-tbl', {'b'}}), tbl ) end), test('access caption via property `caption`', function () local caption = {long = {Plain 'cap'}} local tbl = Table(caption, {}, TableHead(), {}, TableFoot()) assert.are_same(tbl.caption, {long = {Plain 'cap'}}) tbl.caption.short = 'brief' tbl.caption.long = {Plain 'extended'} local new_caption = { short = 'brief', long = {Plain 'extended'} } assert.are_equal( Table(new_caption, {}, TableHead(), {}, TableFoot()), tbl ) end), test('access column specifiers via property `colspecs`', function () local colspecs = {{AlignCenter, 1}} local tbl = Table({long = {}}, colspecs, TableHead(), {}, TableFoot()) assert.are_same(tbl.colspecs, colspecs) tbl.colspecs[1][1] = AlignRight tbl.colspecs[1][2] = nil local new_colspecs = {{AlignRight}} assert.are_equal( Table({long = {}}, new_colspecs, TableHead(), {}, TableFoot()), tbl ) end), test('access table head via property `head`', function () local head = TableHead({Row{Cell'a'}}, Attr('tbl-head')) local tbl = Table({long = {}}, {}, head, {}, TableFoot()) assert.are_same(tbl.head, head) local new_head = head:clone() new_head.attr = Attr{'table-head'} new_head.rows = {Row{Cell{'test'}}} tbl.head = new_head assert.are_equal( Table({long = {}}, {}, new_head, {}, TableFoot()), tbl ) end), test('access table foot via property `foot`', function () local foot = TableFoot({Row{Cell{'test'}}}, {id = 'tbl-foot'}) local tbl = Table({long = {}}, {}, TableHead(), {}, foot) assert.are_same(tbl.foot, foot) local new_foot = foot:clone() new_foot.attr = Attr{'table-foot'} new_foot.rows = {Row{Cell{'test'}}} tbl.foot = new_foot assert.are_equal( Table({long = {}}, {}, TableHead(), {}, new_foot), tbl ) end), test('caption field accepts list of blocks', function () local caption = {long = {Plain 'cap'}} local tbl = Table(caption, {}, TableHead(), {}, TableFoot()) assert.are_same(tbl.caption, {long = {Plain 'cap'}}) tbl.caption = {Plain 'extended'} local new_caption = { short = nil, long = {Plain 'extended'} } assert.are_equal( Table(new_caption, {}, TableHead(), {}, TableFoot()), tbl ) end), }, }, group "Blocks" { 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), test('gives sensible error message', function () assert.error_matches( function() Blocks(nil) end, 'Block, list of Blocks, or compatible element expected' ) end) }, group 'clone' { test('function exists', function () assert.are_equal(type(Blocks({}).clone), 'function') end), test('clones the list', function () local blks = Blocks{Para('One'), CodeBlock 'two'} assert.are_same(blks, blks:clone()) end), test('deep-clones the list', function () local blks = Blocks{Para('one'), CodeBlock 'two'} local copy = blks:clone() copy[1].content[1].text = 'heh' assert.are_same(Blocks{Para('heh'), CodeBlock 'two'}, copy) assert.are_same(Blocks{Para('one'), CodeBlock 'two'}, blks) end) }, group 'tostring' { test('works on an empty list', function () assert.are_equal(tostring(Blocks{}), '[]') end), test('para singleton', function () assert.are_equal( tostring(Blocks{Para 'Hallo'}), '[Para [Str "Hallo"]]' ) 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('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('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('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( {'Str', 'Inlines', 'Para', 'CodeBlock', 'Blocks'}, names ) end), test('topdown traversal works', function () local names = List{} local tbl = Table( {long = {}}, {{AlignCenter, 1}}, TableHead{Row({Cell{'test', Para{'foo', Emph{'bar'}}}}, 'foo')}, {}, TableFoot() ) tbl:walk{ traverse = 'topdown', 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( -- Caption Cell {'Blocks', 'Blocks', 'Plain', 'Inlines', 'Str', 'Para', 'Inlines', 'Str', 'Emph', 'Inlines', 'Str' }, names ) end), test('truncating topdown traversal works', function () local names = List{} local div = Div{ Para{Emph 'a'}, Plain{'b'}, CodeBlock('c') } local filter filter = { traverse = 'topdown', Block = function (b) names:insert(b.t) if b.t == 'Para' then return b, false end end, Inline = function (i) names:insert(i.t) return i:walk(filter), false -- continue 'manually' end, } div:walk(filter) assert.are_same( {'Para', -- Emph is skipped! 'Plain', 'Str', 'CodeBlock', }, names ) end), test('truncating topdown traversal works in inlines', function () local names = List{} local div = Div{ Para{Emph 'a'}, Plain{'b'}, } div:walk { traverse = 'topdown', Block = function (b) names:insert(b.t) if b.t == 'Plain' then return nil, false end end, Emph = function (i) names:insert(i.t) return nil, false end, } assert.are_same( {'Para', 'Emph', -- Str is skipped 'Plain', -- Str is skipped here, too }, names ) end), }, group 'Block marshalling' { test('Inlines are unmarshalled as Plain', function () assert.are_equal(Blocks{Plain{'a'}}, Blocks{Inlines{Str 'a'}}) end), group '__toblock metamethod' { test('metamethod __toblock is called when available', function () local function toblock (t) return CodeBlock(t.code, {id = t.id, class = t.class}) end local my_code = setmetatable( {code = 'open access', id='opn'}, {__toblock = toblock} ) assert.are_equal( Div{CodeBlock('open access', {'opn'})}, Div{my_code} ) end), test("metafield is ignored if it's not a function", function () local bad_block = setmetatable({'a'}, {__toblock = true}) assert.are_equal( Blocks{Plain{'a'}, Plain{'b'}}, Blocks{bad_block, {'b'}} ) end), test("non-Block return values are ignored", function () local function toblock () return "not a block" end local bad_block = setmetatable({'a'}, {__toblock = toblock}) assert.are_equal( Blocks{Plain{'b'}, Plain{'a'}}, Blocks{Plain{'b'}, bad_block} ) end), } } } pandoc-lua-marshal-0.2.9/test/test-cell.lua0000644000000000000000000000706107346545000016745 0ustar0000000000000000local 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), } }, } pandoc-lua-marshal-0.2.9/test/test-citation.lua0000644000000000000000000000615307346545000017641 0ustar0000000000000000-- -- Tests for the pandoc types module -- local tasty = require 'tasty' local group = tasty.test_group local test = tasty.test_case local assert = tasty.assert return { group 'Citation' { test('can be cloned', function () local cit = Citation('leibniz', AuthorInText) local cloned = cit:clone() cit.id = 'newton' assert.are_same(cloned.id, 'leibniz') assert.are_same(cit.id, 'newton') assert.are_same(cit.mode, cloned.mode) end), group 'field `id`' { test('can be read', function () assert.are_equal( Citation('einstein1905', 'NormalCitation').id, 'einstein1905' ) end), test('can be set', function () local c = Citation('einstein1905', 'NormalCitation') c.id = 'Poincaré1905' assert.are_equal(c, Citation('Poincaré1905', 'NormalCitation')) end) }, group 'field `mode`' { test('can be read', function () assert.are_equal( Citation('einstein1905', 'NormalCitation').mode, 'NormalCitation' ) end), test('can be set', function () local c = Citation('Poincaré1905', 'NormalCitation') c.mode = 'AuthorInText' assert.are_equal(c, Citation('Poincaré1905', 'AuthorInText')) end) }, group 'field `prefix`' { test('can be read', function () assert.are_same( Citation('einstein1905', 'NormalCitation', {'x'}).prefix, {Str 'x'} ) end), test('can be set', function () local c = Citation('Poincaré1905', 'NormalCitation') c.prefix = {'y'} assert.are_equal( c, Citation('Poincaré1905', 'NormalCitation', {'y'}) ) end), }, group 'field `suffix`' { test('can be read', function () assert.are_same( Citation('einstein1905', 'NormalCitation', {}, 'is great').suffix, {Str 'is', Space(), Str 'great'} ) end), test('can be set', function () local c = Citation('Poincaré1905', 'NormalCitation') c.suffix = {'why'} assert.are_equal( c, Citation('Poincaré1905', 'NormalCitation', {}, {'why'}) ) end), }, group 'field `note_num`' { test('can be read', function () assert.are_equal( Citation('einstein1905', 'NormalCitation', {}, {}, 7).note_num, 7 ) end), test('can be set', function () local c = Citation('Poincaré1905', 'NormalCitation') c.note_num = 23 assert.are_equal( c, Citation('Poincaré1905', 'NormalCitation', {}, {}, 23) ) end), }, group 'field `hash`' { test('can be read', function () assert.are_equal( Citation('einstein1905', 'NormalCitation', {}, {}, 0, 5).hash, 5 ) end), test('can be set', function () local c = Citation('Poincaré1905', 'NormalCitation') c.hash = 23 assert.are_equal( c, Citation('Poincaré1905', 'NormalCitation', {}, {}, 0, 23) ) end) } } } pandoc-lua-marshal-0.2.9/test/test-inline.lua0000644000000000000000000003623707346545000017313 0ustar0000000000000000local tasty = require 'tasty' local test = tasty.test_case local group = tasty.test_group local assert = tasty.assert return { group "Inline" { group 'Cite' { test('has property `content`', function () local cite = Cite({Emph 'important'}, {}) assert.are_same(cite.content, {Emph {Str 'important'}}) cite.content = 'boring' assert.are_equal(cite, Cite({Str 'boring'}, {})) end), test('has list of citations in property `cite`', function () local citations = { Citation('einstein1905', 'NormalCitation') } local cite = Cite('relativity', citations) assert.are_same(cite.citations, citations) local new_citations = { citations[1], Citation('Poincaré1905', 'NormalCitation') } cite.citations = new_citations assert.are_equal(cite, Cite({'relativity'}, new_citations)) end), }, group 'Code' { test('has property `attr`', function () local code = Code('true', {id='true', foo='bar'}) assert.are_equal(code.attr, Attr('true', {}, {{'foo', 'bar'}})) code.attr = {id='t', fubar='quux'} assert.are_equal( Code('true', Attr('t', {}, {{'fubar', 'quux'}})), code ) end), test('has property `text`', function () local code = Code('true') assert.are_equal(code.text, 'true') code.text = '1 + 1' assert.are_equal(Code('1 + 1'), code) end), }, group 'Emph' { test('has property `content`', function () local elem = Emph{'two', Space(), 'words'} assert.are_same( elem.content, {Str 'two', Space(), Str 'words'} ) elem.content = {'word'} assert.are_equal(elem, Emph{'word'}) end) }, group 'Image' { test('has property `caption` of type Inlines', function () local img = Image('example', 'a.png') assert.are_same(img.caption, {Str 'example'}) img.caption = 'A' assert.are_equal(img, Image({'A'}, 'a.png')) assert.are_equal( Image('example', 'a.png').caption, Inlines('example') ) end), test('has property `src`', function () local img = Image('example', 'sample.png') assert.are_same(img.src, 'sample.png') img.src = 'example.svg' assert.are_equal(img, Image('example', 'example.svg')) end), test('has property `title`', function () local img = Image('here', 'img.gif', 'example') assert.are_same(img.title, 'example') img.title = 'a' assert.are_equal(img, Image('here', 'img.gif', 'a')) end), test('has property `attr`', function () local img = Image('up', 'upwards.png', '', {'up', {'point'}}) assert.are_same(img.attr, Attr {'up', {'point'}}) img.attr = Attr {'up', {'point', 'button'}} assert.are_equal( Image('up', 'upwards.png', nil, {'up', {'point', 'button'}}), img ) end) }, group 'Link' { test('has property `content`', function () local link = Link('example', 'https://example.org') assert.are_same(link.content, {Str 'example'}) link.content = 'commercial' link.target = 'https://example.com' assert.are_equal(link, Link('commercial', 'https://example.com')) end), test('has property `target`', function () local link = Link('example', 'https://example.org') assert.are_same(link.content, {Str 'example'}) link.target = 'https://example.com' assert.are_equal(link, Link('example', 'https://example.com')) end), test('has property `title`', function () local link = Link('here', 'https://example.org', 'example') assert.are_same(link.title, 'example') link.title = 'a' assert.are_equal(link, Link('here', 'https://example.org', 'a')) end), test('has property `attr`', function () local link = Link('up', '../index.html', '', {'up', {'nav'}}) assert.are_same(link.attr, Attr {'up', {'nav'}}) link.attr = Attr {'up', {'nav', 'button'}} assert.are_equal( Link('up', '../index.html', nil, {'up', {'nav', 'button'}}), link ) end) }, group 'Math' { test('has property `text`', function () local elem = Math(InlineMath, 'x^2') assert.are_same(elem.text, 'x^2') elem.text = 'a + b' assert.are_equal(elem, Math(InlineMath, 'a + b')) end), test('has property `mathtype`', function () local elem = Math(InlineMath, 'x^2') assert.are_same(elem.mathtype, 'InlineMath') elem.mathtype = DisplayMath assert.are_equal(elem, Math(DisplayMath, 'x^2')) end), }, group 'Note' { 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 () local elem = Quoted('SingleQuote', Emph{'emph'}) assert.are_same( elem.content, {Emph{Str 'emph'}} ) elem.content = {'word'} assert.are_equal(elem, Quoted(SingleQuote, {'word'})) end), test('has property `quotetype`', function () local elem = Quoted('SingleQuote', 'a') assert.are_same(elem.quotetype, SingleQuote) elem.quotetype = 'DoubleQuote' assert.are_equal(elem, Quoted(DoubleQuote, {'a'})) end) }, group 'SmallCaps' { test('has property `content`', function () local elem = SmallCaps{'two', Space(), 'words'} assert.are_same( elem.content, {Str 'two', Space(), Str 'words'} ) elem.content = {'word'} assert.are_equal(elem, SmallCaps{'word'}) end) }, group 'SoftBreak' { test('can be constructed', function () local sb = SoftBreak() assert.are_equal(sb.t, 'SoftBreak') end) }, group 'Span' { test('has property `attr`', function () local elem = Span('one', {'', {'number'}}) assert.are_same( elem.attr, Attr('', {'number'}) ) elem.attr = {'', {}, {{'a', 'b'}}} assert.are_equal(elem, Span({'one'}, {a='b'})) end), test('has property `content`', function () local elem = Span{'two', Space(), 'words'} assert.are_same( elem.content, {Str 'two', Space(), Str 'words'} ) elem.content = {'word'} assert.are_equal(elem, Span{'word'}) end) }, group 'Str' { test('has property `text`', function () local elem = Str 'nein' assert.are_same(elem.text, 'nein') elem.text = 'doch' assert.are_equal(elem, Str 'doch') end) }, group 'Strikeout' { test('has property `content`', function () local elem = Strikeout{'two', Space(), 'words'} assert.are_same( elem.content, {Str 'two', Space(), Str 'words'} ) elem.content = {'word'} assert.are_equal(elem, Strikeout{'word'}) end) }, group 'Strong' { test('has property `content`', function () local elem = Strong{'two', Space(), 'words'} assert.are_same( elem.content, {Str 'two', Space(), Str 'words'} ) elem.content = {'word'} assert.are_equal(elem, Strong{'word'}) end) }, group 'Subscript' { test('has property `content`', function () local elem = Subscript{'two', Space(), 'words'} assert.are_same( elem.content, {Str 'two', Space(), Str 'words'} ) elem.content = {'word'} assert.are_equal(elem, Subscript{'word'}) end) }, group 'Superscript' { test('has property `content`', function () local elem = Superscript{'two', Space(), 'words'} assert.are_same( elem.content, {Str 'two', Space(), Str 'words'} ) elem.content = {'word'} assert.are_equal(elem, Superscript{'word'}) end) }, group 'Underline' { test('has property `content`', function () local elem = Underline{'two', Space(), 'words'} assert.are_same( elem.content, {Str 'two', Space(), Str 'words'} ) elem.content = {'word'} assert.are_equal(elem, Underline{'word'}) end) }, }, group "Inlines" { 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), test('gives sensible error message', function () assert.error_matches( function() Inlines(nil) end, "Inline, list of Inlines, or string" ) end) }, group 'clone' { test('function exists', function () assert.are_equal(type(Inlines({}).clone), 'function') end), test('clones the list', function () local inlns = Inlines{'Hello,', Space(), 'World!'} assert.are_same(inlns, inlns:clone()) end), test('deep-clones the list', function () local inlns = Inlines{Str 'Hello,', Space(), Str 'World!'} local copy = inlns:clone() copy[1].text = 'Bonjour,' assert.are_same(Inlines{Str 'Bonjour,', Space(), Str 'World!'}, copy) assert.are_same(Inlines{Str 'Hello,', Space(), Str 'World!'}, inlns) end) }, group 'tostring' { test('works on an empty list', function () assert.are_equal( tostring(Inlines{}), '[]' ) end), test('simple inlines', function () assert.are_equal( tostring(Inlines 'Bonjour, Monsieur !'), '[Str "Bonjour,",Space,Str "Monsieur",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('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('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('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), 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, } assert.are_equal( 'Str, Space, Str, Space, Str, Inlines, Para, CodeBlock, Blocks', table.concat(names, ', ') ) end), }, group 'marshalling' { test('bare strings become Str values', function () assert.are_equal(Inlines{'a'}, Inlines{Str 'a'}) end), group '__toinline metamethod' { test('metamethod __toinline is called when available', function () local function toinline (t) return Code(t.code, {id = t.id, class = t.class}) end local my_code = setmetatable( {code = 'open access', id='opn'}, {__toinline = toinline} ) assert.are_equal( Inlines{Code('open access', {'opn'})}, Inlines{my_code} ) end), test("metafield is ignored if it's not a function", function () local bad_inline = setmetatable({'a'}, {__toinline = true}) assert.are_equal( Inlines({'a'}), Inlines(bad_inline) ) end), test("non-Inline return values are ignored", function () local function toinline () return "not an inline" end local bad_inline = setmetatable({'a'}, {__toinline = toinline}) assert.are_equal( Inlines({'a'}), Inlines(bad_inline) ) end), } } } pandoc-lua-marshal-0.2.9/test/test-listattributes.lua0000644000000000000000000000435307346545000021111 0ustar0000000000000000local tasty = require 'tasty' local test = tasty.test_case local group = tasty.test_group local assert = tasty.assert return { group 'ListAttributes' { test('has field `start`', function () local la = ListAttributes(7, DefaultStyle, Period) assert.are_equal(la.start, 7) end), test('has field `style`', function () local la = ListAttributes(1, Example, Period) assert.are_equal(la.style, 'Example') end), test('has field `delimiter`', function () local la = ListAttributes(1, Example, Period) assert.are_equal(la.delimiter, 'Period') end), test('can be compared on equality', function () assert.are_equal( ListAttributes(2, DefaultStyle, Period), ListAttributes(2, DefaultStyle, Period) ) assert.is_falsy( ListAttributes(2, DefaultStyle, Period) == ListAttributes(4, DefaultStyle, Period) ) end), test('can be modified through `start`', function () local la = ListAttributes(3, Decimal, OneParen) la.start = 20 assert.are_equal(la, ListAttributes(20, Decimal, OneParen)) end), test('can be modified through `style`', function () local la = ListAttributes(3, Decimal, OneParen) la.style = LowerRoman assert.are_equal(la, ListAttributes(3, LowerRoman, OneParen)) end), test('can be modified through `delimiter`', function () local la = ListAttributes(5, UpperAlpha, DefaultDelim) la.delimiter = TwoParens assert.are_equal(la, ListAttributes(5, UpperAlpha, TwoParens)) end), test('can be cloned', function () local la = ListAttributes(2, DefaultStyle, Period) local cloned = la:clone() assert.are_equal(la, cloned) la.start = 9 assert.are_same(cloned.start, 2) end), group 'Constructor' { test('omitting a start numer sets it to 1', function () assert.are_equal(ListAttributes().start, 1) end), test('omitting a style sets it to DefaultStyle', function () assert.are_equal(ListAttributes(0).style, DefaultStyle) end), test('omitting a delimiter sets it to DefaultDelim', function () assert.are_equal(ListAttributes(0, UpperRoman).delimiter, DefaultDelim) end) } }, } pandoc-lua-marshal-0.2.9/test/test-metavalue.lua0000644000000000000000000000105607346545000020007 0ustar0000000000000000local tasty = require 'tasty' local test = tasty.test_case local group = tasty.test_group local assert = tasty.assert return { group 'MetaValue elements' { test('MetaList elements behave like lists', function () local metalist = MetaList{} assert.are_equal(type(metalist.insert), 'function') assert.are_equal(type(metalist.remove), 'function') end), test('Numbers are treated as strings', function () local metalist = MetaList{5, 23, 13.37} assert.are_same(metalist, MetaList{'5', '23', '13.37'}) end) } } pandoc-lua-marshal-0.2.9/test/test-pandoc-lua-marshal.hs0000644000000000000000000001340707346545000021330 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-| Module : Main Copyright : © 2017-2021 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Tests for the pandoc types handling in Lua. -} module Main (main) where import Control.Monad (forM_, when) import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr) import Data.Proxy (Proxy (Proxy)) import Data.String (fromString) import HsLua as Lua import Test.Tasty.QuickCheck (ioProperty, testProperty) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.Lua (translateResultsFromFile) import Text.Pandoc.Arbitrary () import Text.Pandoc.Definition import Text.Pandoc.Lua.Marshal.AST main :: IO () main = do listAttributeTests <- run @Lua.Exception $ do openlibs register' mkListAttributes registerConstants (Proxy @ListNumberStyle) registerConstants (Proxy @ListNumberDelim) translateResultsFromFile "test/test-listattributes.lua" attrTests <- run @Lua.Exception $ do openlibs pushListModule *> setglobal "List" register' mkAttr register' mkAttributeList translateResultsFromFile "test/test-attr.lua" citationTests <- run @Lua.Exception $ do openlibs pushListModule *> setglobal "List" register' mkCitation registerConstants (Proxy @CitationMode) forM_ inlineConstructors register' translateResultsFromFile "test/test-citation.lua" inlineTests <- run @Lua.Exception $ do registerDefault translateResultsFromFile "test/test-inline.lua" blockTests <- run @Lua.Exception $ do registerDefault translateResultsFromFile "test/test-block.lua" cellTests <- run @Lua.Exception $ do registerDefault translateResultsFromFile "test/test-cell.lua" simpleTableTests <- run @Lua.Exception $ do registerDefault translateResultsFromFile "test/test-simpletable.lua" metavalueTests <- run @Lua.Exception $ do openlibs pushListModule *> setglobal "List" forM_ metaValueConstructors register' translateResultsFromFile "test/test-metavalue.lua" pandocTests <- run @Lua.Exception $ do registerDefault translateResultsFromFile "test/test-pandoc.lua" defaultMain $ testGroup "pandoc-lua-marshal" [ roundtrips , listAttributeTests , attrTests , citationTests , inlineTests , blockTests , cellTests , simpleTableTests , metavalueTests , pandocTests ] -- | Registers all constructors and string constants in the global -- environment. registerDefault :: LuaError e => LuaE e () registerDefault = do openlibs pushListModule *> setglobal "List" register' mkAttr register' mkBlocks register' mkCell register' mkCitation register' mkInlines register' mkListAttributes register' mkPandoc register' mkRow register' mkSimpleTable register' mkTableHead register' mkTableFoot registerConstants (Proxy @Alignment) registerConstants (Proxy @ListNumberStyle) registerConstants (Proxy @ListNumberStyle) registerConstants (Proxy @MathType) registerConstants (Proxy @QuoteType) forM_ inlineConstructors register' forM_ blockConstructors register' register' :: LuaError e => DocumentedFunction e -> LuaE e () register' f = do pushDocumentedFunction f setglobal (functionName f) registerConstants :: forall a e. (Data a, LuaError e) => Proxy a -> LuaE e () registerConstants proxy = forM_ (constructors proxy) $ \c -> do pushString c setglobal (fromString c) constructors :: forall a. Data a => Proxy a -> [String] constructors _ = map showConstr . dataTypeConstrs . dataTypeOf @a $ undefined -- -- Roundtrips -- -- | Basic tests roundtrips :: TestTree roundtrips = testGroup "Roundtrip through Lua stack" [ testProperty "Alignment" $ ioProperty . roundtripEqual pushAlignment peekAlignment , testProperty "Block" $ ioProperty . roundtripEqual pushBlock peekBlockFuzzy , testProperty "[Block]" $ ioProperty . roundtripEqual pushBlocks peekBlocksFuzzy , testProperty "Caption" $ ioProperty . roundtripEqual pushCaption peekCaption , testProperty "Cell" $ ioProperty . roundtripEqual pushCell peekCell , testProperty "Citation" $ ioProperty . roundtripEqual pushCitation peekCitation , testProperty "CitationMode" $ ioProperty . roundtripEqual pushCitationMode peekCitationMode , testProperty "Inline" $ ioProperty . roundtripEqual pushInline peekInlineFuzzy , testProperty "[Inline]" $ ioProperty . roundtripEqual pushInlines peekInlinesFuzzy , testProperty "ListNumberStyle" $ ioProperty . roundtripEqual pushListNumberStyle peekListNumberStyle , testProperty "ListNumberDelim" $ ioProperty . roundtripEqual pushListNumberDelim peekListNumberDelim , testProperty "MathType" $ ioProperty . roundtripEqual pushMathType peekMathType , testProperty "Meta" $ ioProperty . roundtripEqual pushMeta peekMeta , testProperty "Pandoc" $ ioProperty . roundtripEqual pushPandoc peekPandoc , testProperty "Row" $ ioProperty . roundtripEqual pushRow peekRow , testProperty "QuoteType" $ ioProperty . roundtripEqual pushQuoteType peekQuoteType , testProperty "TableBody" $ ioProperty . roundtripEqual pushTableBody peekTableBody , testProperty "TableHead" $ ioProperty . roundtripEqual pushTableHead peekTableHead ] roundtripEqual :: forall a. Eq a => Pusher Lua.Exception a -> Peeker Lua.Exception a -> a -> IO Bool roundtripEqual pushX peekX x = (x ==) <$> roundtripped where roundtripped :: IO a roundtripped = run $ do openlibs pushListModule <* pop 1 oldSize <- gettop pushX x size <- gettop when (size - oldSize /= 1) $ Prelude.error ("Only one value should have been pushed" ++ show size) forcePeek $ peekX top pandoc-lua-marshal-0.2.9/test/test-pandoc.lua0000644000000000000000000001111207346545000017262 0ustar0000000000000000local tasty = require 'tasty' local test = tasty.test_case local group = tasty.test_group local assert = tasty.assert return { group 'Meta' { test('inline list is treated as MetaInlines', function () local meta = Pandoc({}, {test = {Emph 'check'}}).meta assert.are_same(meta.test, {Emph{Str 'check'}}) end), test('inline element is treated as MetaInlines singleton', function () local meta = Pandoc({}, {test = Emph 'check'}).meta assert.are_same(meta.test, {Emph{Str 'check'}}) end), test('block list is treated as MetaBlocks', function () local meta = Pandoc({}, {test = {Plain 'check'}}).meta assert.are_same(meta.test, {Plain{Str 'check'}}) end), test('block element is treated as MetaBlocks singleton', function () 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 'operations' { test('concatenation', function () local doc1 = Pandoc({Para 'Lovely'}, {title='first'}) local doc2 = Pandoc({Para 'Day'}, {title='second'}) assert.are_equal( Pandoc({Para 'Lovely', Para 'Day'}, {title='second'}), doc1 .. doc2 ) end) }, group 'clone' { test('cloned value is equal to original', function () local doc = Pandoc({'test'}, {foo = 'hi'}) assert.are_same(doc, doc:clone()) end), test('changing the clone does not affect original', function () local orig = Pandoc({'test'}, {foo = 'hi'}) local copy = orig:clone() copy.blocks[1] = Plain 'different' assert.are_same(orig.meta, copy.meta) assert.are_same(Blocks{'test'}, orig.blocks) assert.are_same(Blocks{'different'}, copy.blocks) 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), test('default traversal is typewise, bottom-up', function () local names = List{} local doc = Pandoc( Blocks{ Div{ Plain{Emph 'a'}, Para{'b'}, CodeBlock('c') } }, { test = Blocks 'foo' } ) doc:walk { Block = function (b) names:insert(b.t) end, Inline = function (i) names:insert(i.t) end, Pandoc = function (_) names:insert('Pandoc') end, Meta = function (_) names:insert('Meta') end } assert.are_same( { 'Str', -- in meta value 'Str', -- in Emph 'Emph', 'Str', -- in Para, 'Plain', -- in meta value 'Plain', 'Para', 'CodeBlock', 'Div', 'Meta', 'Pandoc' }, names ) end), test('truncating topdown traversal works', function () local names = List{} local doc = Pandoc( Blocks{ Div{ Plain{Emph 'a'}, Para{'b'}, CodeBlock('c') } }, { test = Blocks 'foo' } ) doc:walk { traverse = 'topdown', Block = function (b) names:insert(b.t) if b.t == 'Para' then return b, false end end, Inline = function (i) names:insert(i.t) end, Pandoc = function (_) names:insert('Pandoc') end, Meta = function (_) names:insert('Meta') end } assert.are_same( { 'Pandoc', 'Meta', 'Plain', 'Str', -- Meta and meta value 'Div', 'Plain', 'Emph', 'Str', 'Para', -- Str is skipped! 'CodeBlock' }, names ) end), } } pandoc-lua-marshal-0.2.9/test/test-simpletable.lua0000644000000000000000000000361707346545000020332 0ustar0000000000000000local tasty = require 'tasty' local test = tasty.test_case local group = tasty.test_group local assert = tasty.assert local default_caption = {Str 'Languages', Space(), Str 'overview.'} local default_aligns = {AlignDefault, AlignDefault} local default_widths = {0, 0} local default_headers = {{Plain({Str "Language"})}, {Plain({Str "Typing"})}} local default_rows = { {{Plain "Haskell"}, {Plain "static"}}, {{Plain "Lua"}, {Plain "Dynamic"}}, } return { group 'SimpleTable' { test('can access properties', function () local simple_table = SimpleTable( default_caption, default_aligns, default_widths, default_headers, default_rows ) assert.are_same(simple_table.caption, default_caption) assert.are_same(simple_table.aligns, default_aligns) assert.are_same(simple_table.widths, default_widths) assert.are_same(simple_table.headers, default_headers) assert.are_same(simple_table.rows, default_rows) end), test('can modify properties', function () local new_table = SimpleTable( default_caption, default_aligns, {0.5, 0.5}, default_headers, default_rows ) new_table.caption = {Str 'Good', Space(), Str 'languages'} new_table.aligns[1] = AlignLeft new_table.widths = {0, 0} new_table.headers[2] = {Plain{Str 'compiled/interpreted'}} new_table.rows[1][2] = {Plain{Str 'both'}} new_table.rows[2][2] = {Plain{Str 'interpreted'}} local expected_table = SimpleTable( {Str 'Good', Space(), Str 'languages'}, {AlignLeft, AlignDefault}, {0, 0}, {{Plain 'Language'}, {Plain 'compiled/interpreted'}}, { {{Plain 'Haskell'}, {Plain 'both'}}, {{Plain 'Lua'}, {Plain 'interpreted'}} } ) assert.are_same(expected_table, new_table) end) }, }