diff options
author | Albert Krewinkel <albert@zeitkraut.de> | 2021-10-20 21:40:07 +0200 |
---|---|---|
committer | John MacFarlane <jgm@berkeley.edu> | 2021-10-22 11:16:51 -0700 |
commit | 6a03aca906c1e714aea7e34acdf10105e3272d6b (patch) | |
tree | 335579fc5ad0f69e7f841634d94cc3539d63c397 | |
parent | 8523bb01b24424249aa409ea577388a1ea10d70a (diff) | |
download | pandoc-6a03aca906c1e714aea7e34acdf10105e3272d6b.tar.gz |
Lua: marshal Inline elements as userdata
This includes the following user-facing changes:
- Deprecated inline constructors are removed. These are `DoubleQuoted`,
`SingleQuoted`, `DisplayMath`, and `InlineMath`.
- Attr values are no longer normalized when assigned to an Inline
element property.
- It's no longer possible to access parts of Inline elements via
numerical indexes. E.g., `pandoc.Span('test')[2]` used to give
`pandoc.Str 'test'`, but yields `nil` now. This was undocumented
behavior not intended to be used in user scripts. Use named properties
instead.
- Accessing `.c` to get a JSON-like tuple of all components no longer
works. This was undocumented behavior.
- Only known properties can be set on an element value. Trying to set a
different property will now raise an error.
-rw-r--r-- | data/pandoc.lua | 271 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/AST.hs | 298 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Module/Pandoc.hs | 110 |
3 files changed, 345 insertions, 334 deletions
diff --git a/data/pandoc.lua b/data/pandoc.lua index 059ff9a3a..8fbd2259b 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -540,273 +540,6 @@ M.Table = M.Block:create_constructor( ------------------------------------------------------------------------ --- Inline --- @section Inline - ---- Inline element class -M.Inline = AstElement:make_subtype'Inline' -M.Inline.behavior.clone = M.types.clone.Inline - ---- Creates a Cite inline element --- @function Cite --- @tparam {Inline,...} content List of inlines --- @tparam {Citation,...} citations List of citations --- @treturn Inline citations element -M.Cite = M.Inline:create_constructor( - "Cite", - function(content, citations) - return {c = {ensureList(citations), ensureInlineList(content)}} - end, - {"citations", "content"} -) - ---- Creates a Code inline element --- @function Code --- @tparam string text code string --- @tparam[opt] Attr attr additional attributes --- @treturn Inline code element -M.Code = M.Inline:create_constructor( - "Code", - function(text, attr) return {c = {ensureAttr(attr), text}} end, - {{attr = {"identifier", "classes", "attributes"}}, "text"} -) - ---- Creates an inline element representing emphasised text. --- @function Emph --- @tparam {Inline,..} content inline content --- @treturn Inline emphasis element -M.Emph = M.Inline:create_constructor( - "Emph", - function(content) return {c = ensureInlineList(content)} end, - "content" -) - ---- Creates a Image inline element --- @function Image --- @tparam {Inline,..} caption text used to describe the image --- @tparam string src path to the image file --- @tparam[opt] string title brief image description --- @tparam[opt] Attr attr additional attributes --- @treturn Inline image element -M.Image = M.Inline:create_constructor( - "Image", - function(caption, src, title, attr) - title = title or "" - return {c = {ensureAttr(attr), ensureInlineList(caption), {src, title}}} - end, - {{attr = {"identifier", "classes", "attributes"}}, "caption", {"src", "title"}} -) - ---- Create a LineBreak inline element --- @function LineBreak --- @treturn Inline linebreak element -M.LineBreak = M.Inline:create_constructor( - "LineBreak", - function() return {} end -) - ---- Creates a link inline element, usually a hyperlink. --- @function Link --- @tparam {Inline,..} content text for this link --- @tparam string target the link target --- @tparam[opt] string title brief link description --- @tparam[opt] Attr attr additional attributes --- @treturn Inline image element -M.Link = M.Inline:create_constructor( - "Link", - function(content, target, title, attr) - title = title or "" - attr = ensureAttr(attr) - return {c = {attr, ensureInlineList(content), {target, title}}} - end, - {{attr = {"identifier", "classes", "attributes"}}, "content", {"target", "title"}} -) - ---- Creates a Math element, either inline or displayed. --- @function Math --- @tparam "InlineMath"|"DisplayMath" mathtype rendering specifier --- @tparam string text Math content --- @treturn Inline Math element -M.Math = M.Inline:create_constructor( - "Math", - function(mathtype, text) - return {c = {mathtype, text}} - end, - {"mathtype", "text"} -) ---- Creates a DisplayMath element (DEPRECATED). --- @function DisplayMath --- @tparam string text Math content --- @treturn Inline Math element -M.DisplayMath = M.Inline:create_constructor( - "DisplayMath", - function(text) return M.Math("DisplayMath", text) end, - {"mathtype", "text"} -) ---- Creates an InlineMath inline element (DEPRECATED). --- @function InlineMath --- @tparam string text Math content --- @treturn Inline Math element -M.InlineMath = M.Inline:create_constructor( - "InlineMath", - function(text) return M.Math("InlineMath", text) end, - {"mathtype", "text"} -) - ---- Creates a Note inline element --- @function Note --- @tparam {Block,...} content footnote block content -M.Note = M.Inline:create_constructor( - "Note", - function(content) return {c = ensureList(content)} end, - "content" -) - ---- Creates a Quoted inline element given the quote type and quoted content. --- @function Quoted --- @tparam "DoubleQuote"|"SingleQuote" quotetype type of quotes to be used --- @tparam {Inline,..} content inline content --- @treturn Inline quoted element -M.Quoted = M.Inline:create_constructor( - "Quoted", - function(quotetype, content) - return {c = {quotetype, ensureInlineList(content)}} - end, - {"quotetype", "content"} -) ---- Creates a single-quoted inline element (DEPRECATED). --- @function SingleQuoted --- @tparam {Inline,..} content inline content --- @treturn Inline quoted element --- @see Quoted -M.SingleQuoted = M.Inline:create_constructor( - "SingleQuoted", - function(content) return M.Quoted(M.SingleQuote, content) end, - {"quotetype", "content"} -) ---- Creates a single-quoted inline element (DEPRECATED). --- @function DoubleQuoted --- @tparam {Inline,..} content inline content --- @treturn Inline quoted element --- @see Quoted -M.DoubleQuoted = M.Inline:create_constructor( - "DoubleQuoted", - function(content) return M.Quoted("DoubleQuote", content) end, - {"quotetype", "content"} -) - ---- Creates a RawInline inline element --- @function RawInline --- @tparam string format format of the contents --- @tparam string text string content --- @treturn Inline raw inline element -M.RawInline = M.Inline:create_constructor( - "RawInline", - function(format, text) return {c = {format, text}} end, - {"format", "text"} -) - ---- Creates text rendered in small caps --- @function SmallCaps --- @tparam {Inline,..} content inline content --- @treturn Inline smallcaps element -M.SmallCaps = M.Inline:create_constructor( - "SmallCaps", - function(content) return {c = ensureInlineList(content)} end, - "content" -) - ---- Creates a SoftBreak inline element. --- @function SoftBreak --- @treturn Inline softbreak element -M.SoftBreak = M.Inline:create_constructor( - "SoftBreak", - function() return {} end -) - ---- Create a Space inline element --- @function Space --- @treturn Inline space element -M.Space = M.Inline:create_constructor( - "Space", - function() return {} end -) - ---- Creates a Span inline element --- @function Span --- @tparam {Inline,..} content inline content --- @tparam[opt] Attr attr additional attributes --- @treturn Inline span element -M.Span = M.Inline:create_constructor( - "Span", - function(content, attr) - return {c = {ensureAttr(attr), ensureInlineList(content)}} - end, - {{attr = {"identifier", "classes", "attributes"}}, "content"} -) - ---- Creates a Str inline element --- @function Str --- @tparam string text content --- @treturn Inline string element -M.Str = M.Inline:create_constructor( - "Str", - function(text) return {c = text} end, - "text" -) - ---- Creates text which is striked out. --- @function Strikeout --- @tparam {Inline,..} content inline content --- @treturn Inline strikeout element -M.Strikeout = M.Inline:create_constructor( - "Strikeout", - function(content) return {c = ensureInlineList(content)} end, - "content" -) - ---- Creates a Strong element, whose text is usually displayed in a bold font. --- @function Strong --- @tparam {Inline,..} content inline content --- @treturn Inline strong element -M.Strong = M.Inline:create_constructor( - "Strong", - function(content) return {c = ensureInlineList(content)} end, - "content" -) - ---- Creates a Subscript inline element --- @function Subscript --- @tparam {Inline,..} content inline content --- @treturn Inline subscript element -M.Subscript = M.Inline:create_constructor( - "Subscript", - function(content) return {c = ensureInlineList(content)} end, - "content" -) - ---- Creates a Superscript inline element --- @function Superscript --- @tparam {Inline,..} content inline content --- @treturn Inline superscript element -M.Superscript = M.Inline:create_constructor( - "Superscript", - function(content) return {c = ensureInlineList(content)} end, - "content" -) - ---- Creates an Underline inline element --- @function Underline --- @tparam {Inline,..} content inline content --- @treturn Inline underline element -M.Underline = M.Inline:create_constructor( - "Underline", - function(content) return {c = ensureInlineList(content)} end, - "content" -) - - ------------------------------------------------------------------------- -- Element components -- @section components @@ -823,10 +556,6 @@ end for _, blk in pairs(M.Block.constructor) do augment_attr_setter(blk.behavior.setters) end -for _, inln in pairs(M.Inline.constructor) do - augment_attr_setter(inln.behavior.setters) -end - -- Citation M.Citation = AstElement:make_subtype'Citation' diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 9bb956ba2..1e635483c 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -3,6 +3,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Lua.Marshaling.AST @@ -21,12 +22,18 @@ module Text.Pandoc.Lua.Marshaling.AST , peekBlocks , peekCaption , peekCitation + , peekFormat , peekInline , peekInlines , peekListAttributes , peekMeta , peekMetaValue , peekPandoc + , peekMathType + , peekQuoteType + + , peekFuzzyInlines + , peekFuzzyBlocks , pushAttr , pushBlock @@ -37,9 +44,13 @@ module Text.Pandoc.Lua.Marshaling.AST ) where import Control.Applicative ((<|>), optional) +import Control.Monad.Catch (throwM) import Control.Monad ((<$!>), (>=>)) +import Data.Data (showConstr, toConstr) +import Data.Text (Text) import HsLua hiding (Operation (Div)) import Text.Pandoc.Definition +import Text.Pandoc.Error (PandocError (PandocLuaError)) import Text.Pandoc.Lua.Util (pushViaConstr', pushViaConstructor) import Text.Pandoc.Lua.Marshaling.Attr (peekAttr, pushAttr) import Text.Pandoc.Lua.Marshaling.List (pushPandocList) @@ -94,10 +105,13 @@ instance Pushable Inline where -- Citation instance Pushable Citation where - push (Citation cid prefix suffix mode noteNum hash) = - pushViaConstr' "Citation" - [ push cid, push mode, push prefix, push suffix, push noteNum, push hash - ] + push = pushCitation + +pushCitation :: LuaError e => Pusher e Citation +pushCitation (Citation cid prefix suffix mode noteNum hash) = + pushViaConstr' "Citation" + [ push cid, push mode, push prefix, push suffix, push noteNum, push hash + ] peekCitation :: LuaError e => Peeker e Citation peekCitation = fmap (retrieving "Citation") @@ -119,7 +133,10 @@ instance Pushable CitationMode where push = Lua.push . show instance Pushable Format where - push (Format f) = Lua.push f + push = pushFormat + +pushFormat :: LuaError e => Pusher e Format +pushFormat (Format f) = pushText f peekFormat :: LuaError e => Peeker e Format peekFormat idx = Format <$!> peekText idx @@ -134,7 +151,19 @@ instance Pushable MathType where push = Lua.push . show instance Pushable QuoteType where - push = Lua.push . show + push = pushQuoteType + +pushMathType :: LuaError e => Pusher e MathType +pushMathType = pushString . show + +peekMathType :: LuaError e => Peeker e MathType +peekMathType = peekRead + +pushQuoteType :: LuaError e => Pusher e QuoteType +pushQuoteType = pushString . show + +peekQuoteType :: LuaError e => Peeker e QuoteType +peekQuoteType = peekRead -- | Push an meta value element to the top of the lua stack. pushMetaValue :: LuaError e => MetaValue -> LuaE e () @@ -354,66 +383,213 @@ peekCell = fmap (retrieving "Cell") blks <- peekFieldRaw peekBlocks "contents" idx return $! Cell attr algn rs cs blks +getInlineText :: Inline -> Possible Text +getInlineText = \case + Code _ lst -> Actual lst + Math _ str -> Actual str + RawInline _ raw -> Actual raw + Str s -> Actual s + _ -> Absent + +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 + +data Content + = ContentBlocks [Block] + | ContentInlines [Inline] + +setInlineContent :: Inline -> Content -> Possible Inline +setInlineContent = \case + -- inline content + Cite cs _ -> Actual . Cite cs . inlineContent + Emph _ -> Actual . Emph . inlineContent + Quoted qt _ -> Actual . Quoted qt . inlineContent + SmallCaps _ -> Actual . SmallCaps . inlineContent + Span attr _ -> Actual . Span attr . 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 + where + inlineContent = \case + ContentInlines inlns -> inlns + ContentBlocks _ -> throwM $ + PandocLuaError "expected Inlines, got Blocks" + blockContent = \case + ContentBlocks blks -> blks + ContentInlines [] -> [] + ContentInlines _ -> throwM $ + PandocLuaError "expected Blocks, got Inlines" + +getInlineContent :: Inline -> Possible Content +getInlineContent = \case + Cite _ inlns -> Actual $ ContentInlines inlns + Emph inlns -> Actual $ ContentInlines inlns + Quoted _ inlns -> Actual $ ContentInlines inlns + SmallCaps inlns -> Actual $ ContentInlines inlns + Span _ 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 + +-- title +getInlineTitle :: Inline -> Possible Text +getInlineTitle = \case + Image _ _ (_, tit) -> Actual tit + Link _ _ (_, tit) -> Actual tit + _ -> Absent + +setInlineTitle :: Inline -> Text -> Possible Inline +setInlineTitle = \case + Image attr capt (src, _) -> Actual . Image attr capt . (src,) + Link attr capt (src, _) -> Actual . Link attr capt . (src,) + _ -> const Absent + +-- attr +getInlineAttr :: Inline -> Possible Attr +getInlineAttr = \case + Code attr _ -> Actual attr + Image attr _ _ -> Actual attr + Link attr _ _ -> Actual attr + Span attr _ -> Actual attr + _ -> Absent + +setInlineAttr :: Inline -> Attr -> Possible Inline +setInlineAttr = \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 + +showInline :: LuaError e => DocumentedFunction e +showInline = defun "show" + ### liftPure (show @Inline) + <#> parameter peekInline "inline" "Inline" "Object" + =#> functionResult pushString "string" "stringified Inline" + +pushContent :: LuaError e => Pusher e Content +pushContent = \case + ContentBlocks blks -> pushPandocList pushBlock blks + ContentInlines inlns -> pushPandocList pushInline inlns + +peekContent :: LuaError e => Peeker e Content +peekContent idx = + (ContentInlines <$!> peekList peekInline idx) <|> + (ContentBlocks <$!> peekList peekBlock idx) + +typeInline :: LuaError e => DocumentedType e Inline +typeInline = deftype "Inline" + [ operation Tostring showInline + , operation Eq $ defun "__eq" + ### liftPure2 (==) + <#> parameter peekInline "a" "Inline" "" + <#> parameter peekInline "b" "Inline" "" + =#> functionResult pushBool "boolean" "whether the two are equal" + ] + [ possibleProperty "attr" "element attributes" + (pushAttr, getInlineAttr) + (peekAttr, setInlineAttr) + , possibleProperty "caption" "image caption" + (pushPandocList pushInline, \case + Image _ capt _ -> Actual capt + _ -> Absent) + (peekInlines, \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, getInlineContent) + (peekContent, setInlineContent) + , 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 . Image attr capt . (,title) + _ -> const Absent) + , possibleProperty "title" "title text" + (pushText, getInlineTitle) + (peekText, setInlineTitle) + , 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" + ] + -- | Push an inline element to the top of the lua stack. pushInline :: forall e. LuaError e => Inline -> LuaE e () -pushInline = \case - Cite citations lst -> pushViaConstructor @e "Cite" lst citations - Code attr lst -> pushViaConstr' @e "Code" - [push lst, pushAttr attr] - Emph inlns -> pushViaConstructor @e "Emph" inlns - Underline inlns -> pushViaConstructor @e "Underline" inlns - Image attr alt (src,tit) -> pushViaConstr' @e "Image" - [push alt, push src, push tit, pushAttr attr] - LineBreak -> pushViaConstructor @e "LineBreak" - Link attr lst (src,tit) -> pushViaConstr' @e "Link" - [push lst, push src, push tit, pushAttr attr] - Note blcks -> pushViaConstructor @e "Note" blcks - Math mty str -> pushViaConstructor @e "Math" mty str - Quoted qt inlns -> pushViaConstructor @e "Quoted" qt inlns - RawInline f cs -> pushViaConstructor @e "RawInline" f cs - SmallCaps inlns -> pushViaConstructor @e "SmallCaps" inlns - SoftBreak -> pushViaConstructor @e "SoftBreak" - Space -> pushViaConstructor @e "Space" - Span attr inlns -> pushViaConstr' @e "Span" - [push inlns, pushAttr attr] - Str str -> pushViaConstructor @e "Str" str - Strikeout inlns -> pushViaConstructor @e "Strikeout" inlns - Strong inlns -> pushViaConstructor @e "Strong" inlns - Subscript inlns -> pushViaConstructor @e "Subscript" inlns - Superscript inlns -> pushViaConstructor @e "Superscript" inlns +pushInline = pushUD typeInline -- | Return the value at the given index as inline if possible. peekInline :: forall e. LuaError e => Peeker e Inline -peekInline = retrieving "Inline" . \idx -> do - -- Get the contents of an AST element. - let mkBlock :: (a -> Inline) -> Peeker e a -> Peek e Inline - mkBlock f p = f <$!> peekFieldRaw p "c" idx - LuaUtil.getTag idx >>= \case - "Cite" -> mkBlock (uncurry Cite) $ - peekPair (peekList peekCitation) peekInlines - "Code" -> mkBlock (uncurry Code) (peekPair peekAttr peekText) - "Emph" -> mkBlock Emph peekInlines - "Underline" -> mkBlock Underline peekInlines - "Image" -> mkBlock (\(attr, lst, tgt) -> Image attr lst tgt) - $ peekTriple peekAttr peekInlines - (peekPair peekText peekText) - "Link" -> mkBlock (\(attr, lst, tgt) -> Link attr lst tgt) $ - peekTriple peekAttr peekInlines (peekPair peekText peekText) - "LineBreak" -> return LineBreak - "Note" -> mkBlock Note peekBlocks - "Math" -> mkBlock (uncurry Math) (peekPair peekRead peekText) - "Quoted" -> mkBlock (uncurry Quoted) (peekPair peekRead peekInlines) - "RawInline" -> mkBlock (uncurry RawInline) (peekPair peekFormat peekText) - "SmallCaps" -> mkBlock SmallCaps peekInlines - "SoftBreak" -> return SoftBreak - "Space" -> return Space - "Span" -> mkBlock (uncurry Span) (peekPair peekAttr peekInlines) - "Str" -> mkBlock Str peekText - "Strikeout" -> mkBlock Strikeout peekInlines - "Strong" -> mkBlock Strong peekInlines - "Subscript" -> mkBlock Subscript peekInlines - "Superscript"-> mkBlock Superscript peekInlines - Name tag -> Lua.failPeek ("Unknown inline type: " <> tag) +peekInline = retrieving "Inline" . \idx -> peekUD typeInline idx + +-- | Try extra-hard to return the value at the given index as a list of +-- inlines. +peekFuzzyInlines :: LuaError e => Peeker e [Inline] +peekFuzzyInlines = choice + [ peekList peekInline + , fmap pure . peekInline + , \idx -> pure . Str <$!> peekText idx + ] + +peekFuzzyBlocks :: LuaError e => Peeker e [Block] +peekFuzzyBlocks = choice + [ peekList peekBlock + , fmap pure . peekBlock + , \idx -> pure . Plain . pure . Str <$!> peekText idx + ] + pushListAttributes :: forall e. LuaError e => ListAttributes -> LuaE e () pushListAttributes (start, style, delimiter) = diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index 34317276d..ef1d6f078 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Lua.Module.Pandoc Copyright : Copyright © 2017-2021 Albert Krewinkel @@ -16,7 +17,7 @@ module Text.Pandoc.Lua.Module.Pandoc import Prelude hiding (read) import Control.Applicative (optional) -import Control.Monad ((>=>), when) +import Control.Monad ((>=>), forM_, when) import Control.Monad.Except (throwError) import Data.Default (Default (..)) import Data.Maybe (fromMaybe) @@ -54,11 +55,116 @@ pushModule = do addFunction "walk_block" (walkElement peekBlock pushBlock) addFunction "walk_inline" (walkElement peekInline pushInline) -- Constructors - addFunction "Pandoc" mkPandoc addFunction "Attr" (liftPandocLua mkAttr) addFunction "AttributeList" (liftPandocLua mkAttributeList) + addFunction "Pandoc" mkPandoc + liftPandocLua $ do + let addConstr fn = do + pushName (functionName fn) + pushDocumentedFunction fn + rawset (nth 3) + forM_ inlineConstructors addConstr + -- add constructors to Inlines.constructor + newtable -- constructor + forM_ (inlineConstructors @PandocError) $ \fn -> do + let name = functionName fn + pushName name + pushName name + rawget (nth 4) + rawset (nth 3) + -- set as pandoc.Inline.constructor + pushName "Inline" + newtable *> pushName "constructor" *> pushvalue (nth 4) *> rawset (nth 3) + rawset (nth 4) + pop 1 -- remaining constructor table return 1 +inlineConstructors :: LuaError e => [DocumentedFunction e] +inlineConstructors = + [ defun "Cite" + ### liftPure2 Cite + <#> parameter (peekList peekCitation) "citations" "list of Citations" "" + <#> parameter peekFuzzyInlines "content" "Inline" "placeholder content" + =#> functionResult pushInline "Inline" "cite element" + , defun "Code" + ### liftPure2 (flip Code) + <#> parameter peekText "code" "string" "code string" + <#> parameter peekAttr "attr" "Attr" "additional attributes" + =#> functionResult pushInline "Inline" "code element" + , mkInlinesConstr "Emph" Emph + , defun "Image" + ### liftPure4 (\caption src mtitle mattr -> + let attr = fromMaybe nullAttr mattr + title = fromMaybe mempty mtitle + in Image attr caption (src, title)) + <#> parameter peekFuzzyInlines "Inlines" "caption" "image caption / alt" + <#> parameter peekText "string" "src" "path/URL of the image file" + <#> optionalParameter peekText "string" "title" "brief image description" + <#> optionalParameter peekAttr "Attr" "attr" "image attributes" + =#> functionResult pushInline "Inline" "image element" + , defun "LineBreak" + ### return LineBreak + =#> functionResult pushInline "Inline" "line break" + , defun "Link" + ### liftPure4 (\content target mtitle mattr -> + let attr = fromMaybe nullAttr mattr + title = fromMaybe mempty mtitle + in Link attr content (target, title)) + <#> parameter peekFuzzyInlines "Inlines" "content" "text for this link" + <#> parameter peekText "string" "target" "the link target" + <#> optionalParameter peekText "string" "title" "brief link description" + <#> optionalParameter peekAttr "Attr" "attr" "link attributes" + =#> functionResult pushInline "Inline" "link element" + , defun "Math" + ### liftPure2 Math + <#> parameter peekMathType "quotetype" "Math" "rendering method" + <#> parameter peekText "text" "string" "math content" + =#> functionResult pushInline "Inline" "math element" + , defun "Note" + ### liftPure Note + <#> parameter peekFuzzyBlocks "content" "Blocks" "note content" + =#> functionResult pushInline "Inline" "note" + , defun "Quoted" + ### liftPure2 Quoted + <#> parameter peekQuoteType "quotetype" "QuoteType" "type of quotes" + <#> parameter peekFuzzyInlines "content" "Inlines" "inlines in quotes" + =#> functionResult pushInline "Inline" "quoted element" + , defun "RawInline" + ### liftPure2 RawInline + <#> parameter peekFormat "format" "Format" "format of content" + <#> parameter peekText "text" "string" "string content" + =#> functionResult pushInline "Inline" "raw inline element" + , mkInlinesConstr "SmallCaps" SmallCaps + , defun "SoftSpace" + ### return SoftBreak + =#> functionResult pushInline "Inline" "soft break" + , defun "Space" + ### return Space + =#> functionResult pushInline "Inline" "new space" + , defun "Span" + ### liftPure2 (\inlns mattr -> Span (fromMaybe nullAttr mattr) inlns) + <#> parameter peekFuzzyInlines "content" "Inlines" "inline content" + <#> optionalParameter peekAttr "attr" "Attr" "additional attributes" + =#> functionResult pushInline "Inline" "span element" + , defun "Str" + ### liftPure (\s -> s `seq` Str s) + <#> parameter peekText "text" "string" "" + =#> functionResult pushInline "Inline" "new Str object" + , mkInlinesConstr "Strong" Strong + , mkInlinesConstr "Strikeout" Strikeout + , mkInlinesConstr "Subscript" Subscript + , mkInlinesConstr "Superscript" Superscript + , mkInlinesConstr "Underline" Underline + ] + +mkInlinesConstr :: LuaError e + => Name -> ([Inline] -> Inline) -> DocumentedFunction e +mkInlinesConstr name constr = defun name + ### liftPure (\x -> x `seq` constr x) + <#> parameter peekFuzzyInlines "content" "Inlines" "" + =#> functionResult pushInline "Inline" "new object" + + walkElement :: (Walkable (SingletonsList Inline) a, Walkable (SingletonsList Block) a, Walkable (List Inline) a, |