diff options
| -rw-r--r-- | data/pandoc.lua | 275 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/StackInstances.hs | 139 |
2 files changed, 336 insertions, 78 deletions
diff --git a/data/pandoc.lua b/data/pandoc.lua index 6e434d1e7..eab565ca8 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -173,18 +173,23 @@ end --- Meta blocks -- @function MetaBlocks -- @tparam {Block,...} blocks blocks + --- Meta inlines -- @function MetaInlines -- @tparam {Inline,...} inlines inlines + --- Meta list -- @function MetaList -- @tparam {MetaValue,...} meta_values list of meta values + --- Meta boolean -- @function MetaBool -- @tparam boolean bool boolean value + --- Meta map -- @function MetaMap -- @tparam table a string-index map of meta values + --- Meta string -- @function MetaString -- @tparam string str string value @@ -205,17 +210,166 @@ for i = 1, #M.meta_value_types do ) end ---- Inline element class --- @type Inline -M.Inline = Element:make_subtype{} -M.Inline.__call = function (t, ...) +------------------------------------------------------------------------ +-- Block +-- @section Block + +M.Block = Element:make_subtype{} +M.Block.__call = function (t, ...) return t:new(...) end +--- Creates a block quote element +-- @function BlockQuote +-- @tparam {Block,...} content block content +-- @treturn Block block quote element +M.BlockQuote = M.Block:create_constructor( + "BlockQuote", + function(content) return {c = content} end +) + +--- Creates a bullet (i.e. unordered) list. +-- @function BulletList +-- @tparam {{Block,...},...} content list of items +-- @treturn Block block quote element +M.BulletList = M.Block:create_constructor( + "BulletList", + function(content) return {c = content} end +) + +--- Creates a code block element +-- @function CodeBlock +-- @tparam string code code string +-- @tparam[opt] Attributes attributes element attributes +-- @treturn Block code block element +M.CodeBlock = M.Block:create_constructor( + "CodeBlock", + function(code, attributes) return {c = {attributes, code}} end +) + +--- Creates a definition list, containing terms and their explanation. +-- @function DefinitionList +-- @tparam {{{Inline,...},{Block,...}},...} content list of items +-- @treturn Block block quote element +M.DefinitionList = M.Block:create_constructor( + "DefinitionList", + function(content) return {c = content} end +) + +--- Creates a div element +-- @function Div +-- @tparam {Block,...} content block content +-- @tparam[opt] Attributes attributes element attributes +-- @treturn Block code block element +M.Div = M.Block:create_constructor( + "Div", + function(content, attributes) return {c = {attributes, content}} end +) + +--- Creates a block quote element. +-- @function Header +-- @tparam int level header level +-- @tparam Attributes attributes element attributes +-- @tparam {Inline,...} content inline content +-- @treturn Block header element +M.Header = M.Block:create_constructor( + "Header", + function(level, attributes, content) + return {c = {level, attributes, content}} + end +) + +--- Creates a horizontal rule. +-- @function HorizontalRule +-- @treturn Block horizontal rule +M.HorizontalRule = M.Block:create_constructor( + "HorizontalRule", + function() return {} end +) + +--- Creates a line block element. +-- @function LineBlock +-- @tparam {{Inline,...},...} content inline content +-- @treturn Block block quote element +M.LineBlock = M.Block:create_constructor( + "LineBlock", + function(content) return {c = content} end +) + +--- Creates a null element. +-- @function Null +-- @treturn Block null element +M.Null = M.Block:create_constructor( + "Null", + function() return {} end +) + +--- Creates an ordered list. +-- @function OrderedList +-- @tparam {{Block,...},...} items list items +-- @param[opt] listAttributes list parameters +-- @treturn Block +M.OrderedList = M.Block:create_constructor( + "OrderedList", + function(items, listAttributes) + return {c = {listAttributes,items}} + end +) + +--- Creates a para element. +-- @function Para +-- @tparam {Inline,...} content inline content +-- @treturn Block block quote element +M.Para = M.Block:create_constructor( + "Para", + function(content) return {c = content} end +) + +--- Creates a plain element. +-- @function Plain +-- @tparam {Inline,...} content inline content +-- @treturn Block block quote element +M.Plain = M.Block:create_constructor( + "Plain", + function(content) return {c = content} end +) + +--- Creates a raw content block of the specified format. +-- @function RawBlock +-- @tparam string format format of content +-- @tparam string content string content +-- @treturn Block block quote element +M.RawBlock = M.Block:create_constructor( + "RawBlock", + function(format, content) return {c = {format, content}} end +) + +--- Creates a table element. +-- @function Table +-- @tparam {Inline,...} caption table caption +-- @tparam {AlignDefault|AlignLeft|AlignRight|AlignCenter,...} aligns alignments +-- @tparam {int,...} widths column widths +-- @tparam {Block,...} headers header row +-- @tparam {{Block,...}} rows table rows +-- @treturn Block block quote element +M.Table = M.Block:create_constructor( + "Table", + function(caption, aligns, widths, headers, rows) + return {c = {caption, aligns, widths, headers, rows}} + end +) + + ------------------------------------------------------------------------ -- Inline -- @section Inline +--- Inline element class +M.Inline = Element:make_subtype{} +M.Inline.__call = function (t, ...) + return t:new(...) +end + --- Creates a Cite inline element -- @function Cite -- @tparam {Inline,...} content List of inlines @@ -406,42 +560,6 @@ M.Superscript = M.Inline:create_constructor( ------------------------------------------------------------------------ --- Block elements --- @type Block -M.Block = Element:make_subtype{} - ---- Block constructors -M.Block.constructors = { - BlockQuote = true, - BulletList = true, - CodeBlock = true, - DefinitionList = true, - Div = true, - Header = true, - HorizontalRule = true, - HorizontalRule = true, - LineBlock = true, - Null = true, - OrderedList = true, - Para = true, - Plain = true, - RawBlock = true, - Table = true, -} - -local set_of_inline_types = {} -for k, _ in pairs(M.Inline.constructor) do - set_of_inline_types[k] = true -end - -for block_type, _ in pairs(M.Block.constructors) do - M[block_type] = function(...) - return M.Block:new(block_type, ...) - end -end - - ------------------------------------------------------------------------- -- Constants -- @section constants @@ -482,6 +600,81 @@ M.SuppressAuthor.t = "SuppressAuthor" M.NormalCitation = {} M.NormalCitation.t = "NormalCitation" +--- Table cells aligned left. +-- @see Table +M.AlignLeft = {} +M.AlignLeft.t = "AlignLeft" + +--- Table cells right-aligned. +-- @see Table +M.AlignRight = {} +M.AlignRight.t = "AlignRight" + +--- Table cell content is centered. +-- @see Table +M.AlignCenter = {} +M.AlignCenter.t = "AlignCenter" + +--- Table cells are alignment is unaltered. +-- @see Table +M.AlignDefault = {} +M.AlignDefault.t = "AlignDefault" + +--- Default list number delimiters are used. +-- @see OrderedList +M.DefaultDelim = {} +M.DefaultDelim.t = "DefaultDelim" + +--- List numbers are delimited by a period. +-- @see OrderedList +M.Period = {} +M.Period.t = "Period" + +--- List numbers are delimited by a single parenthesis. +-- @see OrderedList +M.OneParen = {} +M.OneParen.t = "OneParen" + +--- List numbers are delimited by a double parentheses. +-- @see OrderedList +M.TwoParens = {} +M.TwoParens.t = "TwoParens" + +--- List are numbered in the default style +-- @see OrderedList +M.DefaultStyle = {} +M.DefaultStyle.t = "DefaultStyle" + +--- List items are numbered as examples. +-- @see OrderedList +M.Example = {} +M.Example.t = "Example" + +--- List are numbered using decimal integers. +-- @see OrderedList +M.Decimal = {} +M.Decimal.t = "Decimal" + +--- List are numbered using lower-case roman numerals. +-- @see OrderedList +M.LowerRoman = {} +M.LowerRoman.t = "LowerRoman" + +--- List are numbered using upper-case roman numerals +-- @see OrderedList +M.UpperRoman = {} +M.UpperRoman.t = "UpperRoman" + +--- List are numbered using lower-case alphabetic characters. +-- @see OrderedList +M.LowerAlpha = {} +M.LowerAlpha.t = "LowerAlpha" + +--- List are numbered using upper-case alphabetic characters. +-- @see OrderedList +M.UpperAlpha = {} +M.UpperAlpha.t = "UpperAlpha" + ------------------------------------------------------------------------ -- Helper Functions @@ -503,7 +696,7 @@ M.NormalCitation.t = "NormalCitation" function M.global_filter() local res = {} for k, v in pairs(_G) do - if M.Inline.constructor[k] or M.Block.constructors[k] or k == "Doc" then + if M.Inline.constructor[k] or M.Block.constructor[k] or M.Block.constructors[k] or k == "Doc" then res[k] = v end end diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs index 6f89bbee1..bafe24201 100644 --- a/src/Text/Pandoc/Lua/StackInstances.hs +++ b/src/Text/Pandoc/Lua/StackInstances.hs @@ -36,25 +36,17 @@ StackValue instances for pandoc types. module Text.Pandoc.Lua.StackInstances () where import Control.Applicative ( (<|>) ) -import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON ) import Scripting.Lua ( LTYPE(..), LuaState, StackValue(..) , call, getglobal2, gettable, ltype, newtable, next, objlen - , pop, pushnil, rawgeti, rawset, rawseti, settable + , pop, pushnil, rawgeti, rawseti, settable ) import Scripting.Lua.Aeson () import Text.Pandoc.Definition - ( Block(..), Inline(..), Meta(..), MetaValue(..), Pandoc(..) - , Citation(..), CitationMode(..), Format(..), MathType(..), QuoteType(..) ) import qualified Data.Map as M import qualified Text.Pandoc.UTF8 as UTF8 -maybeFromJson :: (FromJSON a) => Maybe Value -> Maybe a -maybeFromJson mv = fromJSON <$> mv >>= \case - Success x -> Just x - _ -> Nothing - instance StackValue Pandoc where push lua (Pandoc meta blocks) = do newtable lua @@ -121,16 +113,22 @@ peekContent lua idx = do instance StackValue Block where push lua = \case - BlockQuote blcks -> pushTagged lua "BlockQuote" blcks - BulletList items -> pushTagged lua "BulletList" items - HorizontalRule -> pushTagged' lua "HorizontalRule" - LineBlock blcks -> pushTagged lua "LineBlock" blcks - Null -> pushTagged' lua "Null" - Para blcks -> pushTagged lua "Para" blcks - Plain blcks -> pushTagged lua "Plain" blcks - RawBlock f cs -> pushTagged lua "RawBlock" (f, cs) + BlockQuote blcks -> pushViaConstructor lua "BlockQuote" blcks + BulletList items -> pushViaConstructor lua "BulletList" items + CodeBlock attr code -> pushViaConstructor lua "CodeBlock" code attr + DefinitionList items -> pushViaConstructor lua "DefinitionList" items + Div attr blcks -> pushViaConstructor lua "Div" blcks attr + Header lvl attr inlns -> pushViaConstructor lua "Header" lvl attr inlns + HorizontalRule -> pushViaConstructor lua "HorizontalRule" + LineBlock blcks -> pushViaConstructor lua "LineBlock" blcks + OrderedList lstAttr list -> pushViaConstructor lua "OrderedList" list lstAttr + Null -> pushViaConstructor lua "Null" + Para blcks -> pushViaConstructor lua "Para" blcks + Plain blcks -> pushViaConstructor lua "Plain" blcks + RawBlock f cs -> pushViaConstructor lua "RawBlock" f cs + Table capt aligns widths headers rows -> + pushViaConstructor lua "Table" capt aligns widths headers rows -- fall back to conversion via aeson's Value - x -> push lua (toJSON x) peek lua i = peekBlock lua i valuetype _ = TTABLE @@ -158,6 +156,22 @@ instance StackValue Inline where peek = peekInline valuetype _ = TTABLE +instance StackValue Alignment where + push lua = \case + AlignLeft -> getglobal2 lua "pandoc.AlignLeft" + AlignRight -> getglobal2 lua "pandoc.AlignRight" + AlignCenter -> getglobal2 lua "pandoc.AlignCenter" + AlignDefault -> getglobal2 lua "pandoc.AlignDefault" + peek lua idx = do + tag <- getField lua idx "t" + case tag of + Just "AlignLeft" -> return $ Just AlignLeft + Just "AlignRight" -> return $ Just AlignRight + Just "AlignCenter" -> return $ Just AlignCenter + Just "AlignDefault" -> return $ Just AlignDefault + _ -> return Nothing + valuetype _ = TSTRING + instance StackValue Citation where push lua (Citation cid prefix suffix mode noteNum hash) = pushViaConstructor lua "Citation" cid mode prefix suffix noteNum hash @@ -183,13 +197,51 @@ instance StackValue CitationMode where Just "NormalCitation" -> return $ Just NormalCitation Just "SuppressAuthor" -> return $ Just SuppressAuthor _ -> return Nothing - valuetype _ = TSTRING + valuetype _ = TTABLE instance StackValue Format where push lua (Format f) = push lua f peek lua idx = fmap Format <$> peek lua idx valuetype _ = TSTRING +instance StackValue ListNumberDelim where + push lua = \case + DefaultDelim -> getglobal2 lua "pandoc.DefaultDelim" + Period -> getglobal2 lua "pandoc.Period" + OneParen -> getglobal2 lua "pandoc.OneParen" + TwoParens -> getglobal2 lua "pandoc.TwoParens" + peek lua idx = do + tag <- getField lua idx "t" + case tag of + Just "DefaultDelim" -> return $ Just DefaultDelim + Just "Period" -> return $ Just Period + Just "OneParen" -> return $ Just OneParen + Just "TwoParens" -> return $ Just TwoParens + _ -> return Nothing + valuetype _ = TTABLE + +instance StackValue ListNumberStyle where + push lua = \case + DefaultStyle -> getglobal2 lua "pandoc.DefaultStyle" + LowerRoman -> getglobal2 lua "pandoc.LowerRoman" + UpperRoman -> getglobal2 lua "pandoc.UpperRoman" + LowerAlpha -> getglobal2 lua "pandoc.LowerAlpha" + UpperAlpha -> getglobal2 lua "pandoc.UpperAlpha" + Decimal -> getglobal2 lua "pandoc.Decimal" + Example -> getglobal2 lua "pandoc.Example" + peek lua idx = do + tag <- getField lua idx "t" + case tag of + Just "DefaultStyle" -> return $ Just DefaultStyle + Just "LowerRoman" -> return $ Just LowerRoman + Just "UpperRoman" -> return $ Just UpperRoman + Just "LowerAlpha" -> return $ Just LowerAlpha + Just "UpperAlpha" -> return $ Just UpperAlpha + Just "Decimal" -> return $ Just Decimal + Just "Example" -> return $ Just Example + _ -> return Nothing + valuetype _ = TTABLE + instance StackValue MathType where push lua = \case InlineMath -> getglobal2 lua "pandoc.InlineMath" @@ -249,6 +301,26 @@ instance (StackValue a, StackValue b, StackValue c) => return $ (,,) <$> a <*> b <*> c valuetype _ = TTABLE +instance (StackValue a, StackValue b, StackValue c, + StackValue d, StackValue e) => + StackValue (a, b, c, d, e) + where + push lua (a, b, c, d, e) = do + newtable lua + addIndexedValue lua 1 a + addIndexedValue lua 2 b + addIndexedValue lua 3 c + addIndexedValue lua 4 d + addIndexedValue lua 5 e + peek lua idx = do + a <- getIndexedValue lua idx 1 + b <- getIndexedValue lua idx 2 + c <- getIndexedValue lua idx 3 + d <- getIndexedValue lua idx 4 + e <- getIndexedValue lua idx 5 + return $ (,,,,) <$> a <*> b <*> c <*> d <*> e + valuetype _ = TTABLE + instance (Ord a, StackValue a, StackValue b) => StackValue (M.Map a b) where push lua m = do @@ -307,22 +379,6 @@ pushViaCall lua fn = pushViaCall' lua fn (return ()) 0 pushViaConstructor :: PushViaCall a => LuaState -> String -> a pushViaConstructor lua pandocFn = pushViaCall lua ("pandoc." ++ pandocFn) --- | Push a value to the lua stack, tagged with a given string. This currently --- creates a structure equivalent to what the JSONified value would look like --- when pushed to lua. -pushTagged :: StackValue a => LuaState -> String -> a -> IO () -pushTagged lua tag value = do - newtable lua - addKeyValue lua "t" tag - addKeyValue lua "c" value - -pushTagged' :: LuaState -> String -> IO () -pushTagged' lua tag = do - newtable lua - push lua "t" - push lua tag - rawset lua (-3) - -- | Return the value at the given index as inline if possible. peekInline :: LuaState -> Int -> IO (Maybe Inline) peekInline lua idx = do @@ -366,13 +422,22 @@ peekBlock lua idx = do Just t -> case t of "BlockQuote" -> fmap BlockQuote <$> elementContent "BulletList" -> fmap BulletList <$> elementContent + "CodeBlock" -> fmap (uncurry CodeBlock) <$> elementContent + "DefinitionList" -> fmap DefinitionList <$> elementContent + "Div" -> fmap (uncurry Div) <$> elementContent + "Header" -> fmap (\(lvl, attr, lst) -> Header lvl attr lst) + <$> elementContent "HorizontalRule" -> return (Just HorizontalRule) "LineBlock" -> fmap LineBlock <$> elementContent + "OrderedList" -> fmap (uncurry OrderedList) <$> elementContent "Null" -> return (Just Null) "Para" -> fmap Para <$> elementContent "Plain" -> fmap Plain <$> elementContent - -- fall back to construction via aeson's Value - _ -> maybeFromJson <$> peek lua idx + "RawBlock" -> fmap (uncurry RawBlock) <$> elementContent + "Table" -> fmap (\(capt, aligns, widths, headers, body) -> + Table capt aligns widths headers body) + <$> elementContent + _ -> return Nothing where -- Get the contents of an AST element. elementContent :: StackValue a => IO (Maybe a) |