diff options
| -rw-r--r-- | data/pandoc.lua | 120 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Filter.hs | 33 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/AST.hs | 1 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/Attr.hs | 50 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Module/MediaBag.hs | 160 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Module/Pandoc.hs | 258 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Module/System.hs | 44 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Module/Types.hs | 56 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Module/Utils.hs | 26 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Packages.hs | 26 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/PandocLua.hs | 8 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Util.hs | 9 | ||||
| -rw-r--r-- | test/lua/module/pandoc.lua | 6 |
13 files changed, 385 insertions, 412 deletions
diff --git a/data/pandoc.lua b/data/pandoc.lua index cc4dc0cab..1f4830858 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -45,125 +45,19 @@ local utils = M.utils -- @section -- @local ---- Create a new indexing function. --- @param template function template --- @param indices list of indices, starting with the most deeply nested --- @return newly created function --- @local -function make_indexing_function(template, ...) - local indices = {...} - local loadstring = loadstring or load - local bracketed = {} - for i = 1, #indices do - local idx = indices[#indices - i + 1] - bracketed[i] = type(idx) == 'number' - and string.format('[%d]', idx) - or string.format('.%s', idx) - end - local fnstr = string.format('return ' .. template, table.concat(bracketed)) - return assert(loadstring(fnstr))() -end - ---- Create accessor functions using a function template. --- @param fn_template function template in which '%s' is replacd with indices --- @param accessors list of accessors --- @return mapping from accessor names to accessor functions --- @local -local function create_accessor_functions (fn_template, accessors) - local res = {} - function add_accessors(acc, ...) - if type(acc) == 'string' then - res[acc] = make_indexing_function(fn_template, ...) - elseif type(acc) == 'table' and #acc == 0 and next(acc) then - -- Named substructure: the given names are accessed via the substructure, - -- but the accessors are also added to the result table, enabling direct - -- access from the parent element. Mainly used for `attr`. - local name, substructure = next(acc) - res[name] = make_indexing_function(fn_template, ...) - for _, subname in ipairs(substructure) do - res[subname] = make_indexing_function(fn_template, subname, ...) - end - else - for i = 1, #(acc or {}) do - add_accessors(acc[i], i, ...) - end - end - end - add_accessors(accessors) - return res -end - ---- Get list of top-level fields from field descriptor table. --- E.g.: `top_level_fields{'foo', {bar='baz'}, {'qux', 'quux'}}` --- gives {'foo, 'bar', 'qux', 'quux'} --- @local -local function top_level_fields (fields) - local result = List:new{} - for _, v in ipairs(fields) do - if type(v) == 'string' then - table.insert(result, v) - elseif type(v) == 'table' and #v == 0 and next(v) then - table.insert(result, (next(v))) - else - result:extend(top_level_fields(v)) - end - end - return result -end - ---- Creates a function which behaves like next, but respects field names. --- @local -local function make_next_function (fields) - local field_indices = {} - for i, f in ipairs(fields) do - field_indices[f] = i - end - - return function (t, field) - local raw_idx = field == nil and 0 or field_indices[field] - local next_field = fields[raw_idx + 1] - return next_field, t[next_field] - end -end - --- Create a new table which allows to access numerical indices via accessor -- functions. -- @local -local function create_accessor_behavior (tag, accessors) +local function create_accessor_behavior (tag) local behavior = {tag = tag} - behavior.getters = create_accessor_functions( - 'function (x) return x.c%s end', - accessors - ) - behavior.setters = create_accessor_functions( - 'function (x, v) x.c%s = v end', - accessors - ) behavior.__eq = utils.equals behavior.__index = function(t, k) - if getmetatable(t).getters[k] then - return getmetatable(t).getters[k](t) - elseif k == "t" then + if k == "t" then return getmetatable(t)["tag"] - else - return getmetatable(t)[k] - end - end - behavior.__newindex = function(t, k, v) - if getmetatable(t).setters[k] then - getmetatable(t).setters[k](t, v) - else - rawset(t, k, v) end end behavior.__pairs = function (t) - if accessors == nil then - return next, t - end - local iterable_fields = type(accessors) == 'string' - and {accessors} - or top_level_fields(accessors) - return make_next_function(iterable_fields), t + return next, t end return behavior end @@ -242,8 +136,8 @@ end -- @param fn Function to be called when constructing a new element -- @param accessors names to use as accessors for numerical fields -- @return function that constructs a new element -function AstElement:create_constructor(tag, fn, accessors) - local constr = self:make_subtype(tag, create_accessor_behavior(tag, accessors)) +function AstElement:create_constructor(tag, fn) + local constr = self:make_subtype(tag, create_accessor_behavior(tag)) function constr:new(...) return setmetatable(fn(...), self.behavior) end @@ -348,8 +242,4 @@ function M.MetaBool(bool) return bool end ------------------------------------------------------------------------- --- Functions which have moved to different modules -M.sha1 = utils.sha1 - return M diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs index 9a06dcac6..9fd0ef32c 100644 --- a/src/Text/Pandoc/Lua/Filter.hs +++ b/src/Text/Pandoc/Lua/Filter.hs @@ -14,6 +14,7 @@ Types and functions for running Lua filters. -} module Text.Pandoc.Lua.Filter ( LuaFilterFunction , LuaFilter + , peekLuaFilter , runFilterFile , walkInlines , walkInlineLists @@ -68,20 +69,24 @@ newtype LuaFilterFunction = LuaFilterFunction Lua.Reference newtype LuaFilter = LuaFilter (Map Name LuaFilterFunction) instance Peekable LuaFilter where - peek idx = do - let constrs = listOfInlinesFilterName - : listOfBlocksFilterName - : metaFilterName - : pandocFilterNames - ++ blockElementNames - ++ inlineElementNames - let go constr acc = do - Lua.getfield idx constr - filterFn <- registerFilterFunction - return $ case filterFn of - Nothing -> acc - Just fn -> Map.insert constr fn acc - LuaFilter <$!> foldrM go Map.empty constrs + peek = Lua.forcePeek . peekLuaFilter + +-- | Retrieves a LuaFilter object from the stack. +peekLuaFilter :: LuaError e => Peeker e LuaFilter +peekLuaFilter idx = do + let constrs = listOfInlinesFilterName + : listOfBlocksFilterName + : metaFilterName + : pandocFilterNames + ++ blockElementNames + ++ inlineElementNames + let go constr acc = Lua.liftLua $ do + Lua.getfield idx constr + filterFn <- registerFilterFunction + return $ case filterFn of + Nothing -> acc + Just fn -> Map.insert constr fn acc + LuaFilter <$!> foldrM go Map.empty constrs -- | Register the function at the top of the stack as a filter function in the -- registry. diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 6bb4fd4e0..aabc9e530 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -45,6 +45,7 @@ module Text.Pandoc.Lua.Marshaling.AST , pushCitation , pushInline , pushListAttributes + , pushMeta , pushMetaValue , pushPandoc ) where diff --git a/src/Text/Pandoc/Lua/Marshaling/Attr.hs b/src/Text/Pandoc/Lua/Marshaling/Attr.hs index 2f1f2406a..a38bc6ec7 100644 --- a/src/Text/Pandoc/Lua/Marshaling/Attr.hs +++ b/src/Text/Pandoc/Lua/Marshaling/Attr.hs @@ -204,26 +204,30 @@ peekAttrTable idx = do return $ ident `seq` classes `seq` attribs `seq` (ident, classes, attribs) -mkAttr :: LuaError e => LuaE e NumResults -mkAttr = do - attr <- ltype (nthBottom 1) >>= \case - TypeString -> forcePeek $ do - mident <- optional (peekText (nthBottom 1)) - mclass <- optional (peekList peekText (nthBottom 2)) - mattribs <- optional (peekAttribs (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 - pushAttr attr - return 1 - -mkAttributeList :: LuaError e => LuaE e NumResults -mkAttributeList = do - attribs <- forcePeek $ peekAttribs (nthBottom 1) - pushUD typeAttributeList attribs - return 1 +-- | 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 (peekAttribs (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) + =#> functionResult pushAttr "Attr" "new Attr object" + +-- | Constructor for 'AttributeList'. +mkAttributeList :: LuaError e => DocumentedFunction e +mkAttributeList = defun "AttributeList" + ### return + <#> parameter peekAttribs "table|AttributeList" "attribs" "an attribute list" + =#> functionResult (pushUD typeAttributeList) "AttributeList" + "new AttributeList object" diff --git a/src/Text/Pandoc/Lua/Module/MediaBag.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs index a1fc40732..6e595f9e4 100644 --- a/src/Text/Pandoc/Lua/Module/MediaBag.hs +++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs @@ -1,112 +1,126 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Lua.Module.MediaBag Copyright : Copyright © 2017-2021 Albert Krewinkel License : GNU GPL, version 2 or above - Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> - Stability : alpha -The lua module @pandoc.mediabag@. +The Lua module @pandoc.mediabag@. -} module Text.Pandoc.Lua.Module.MediaBag - ( pushModule + ( documentedModule ) where import Prelude hiding (lookup) -import Control.Monad (zipWithM_) -import HsLua (LuaE, NumResults, Optional) -import HsLua.Marshalling (pushIterator) +import Data.Maybe (fromMaybe) +import HsLua ( LuaE, DocumentedFunction, Module (..) + , (<#>), (###), (=#>), (=?>), defun, functionResult + , optionalParameter , parameter) import Text.Pandoc.Class.CommonState (CommonState (..)) import Text.Pandoc.Class.PandocMonad (fetchItem, getMediaBag, modifyCommonState, setMediaBag) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.PandocLua (PandocLua (..), liftPandocLua, addFunction) +import Text.Pandoc.Lua.Marshaling.List (pushPandocList) +import Text.Pandoc.Lua.PandocLua (unPandocLua) import Text.Pandoc.MIME (MimeType) import qualified Data.ByteString.Lazy as BL -import qualified Data.Text as T import qualified HsLua as Lua import qualified Text.Pandoc.MediaBag as MB -- -- MediaBag submodule -- -pushModule :: PandocLua NumResults -pushModule = do - liftPandocLua Lua.newtable - addFunction "delete" delete - addFunction "empty" empty - addFunction "insert" insert - addFunction "items" items - addFunction "lookup" lookup - addFunction "list" list - addFunction "fetch" fetch - return 1 +documentedModule :: Module PandocError +documentedModule = Module + { moduleName = "pandoc.mediabag" + , moduleDescription = "mediabag access" + , moduleFields = [] + , moduleFunctions = + [ delete + , empty + , fetch + , insert + , items + , list + , lookup + ] + , moduleOperations = [] + } -- | Delete a single item from the media bag. -delete :: FilePath -> PandocLua NumResults -delete fp = 0 <$ modifyCommonState - (\st -> st { stMediaBag = MB.deleteMedia fp (stMediaBag st) }) +delete :: DocumentedFunction PandocError +delete = defun "delete" + ### (\fp -> unPandocLua $ modifyCommonState + (\st -> st { stMediaBag = MB.deleteMedia fp (stMediaBag st) })) + <#> parameter Lua.peekString "string" "filepath" "filename of item to delete" + =#> [] + -- | Delete all items from the media bag. -empty :: PandocLua NumResults -empty = 0 <$ modifyCommonState (\st -> st { stMediaBag = mempty }) +empty :: DocumentedFunction PandocError +empty = defun "empty" + ### unPandocLua (modifyCommonState (\st -> st { stMediaBag = mempty })) + =#> [] -- | Insert a new item into the media bag. -insert :: FilePath - -> Optional MimeType - -> BL.ByteString - -> PandocLua NumResults -insert fp optionalMime contents = do - mb <- getMediaBag - setMediaBag $ MB.insertMedia fp (Lua.fromOptional optionalMime) contents mb - return (Lua.NumResults 0) +insert :: DocumentedFunction PandocError +insert = defun "insert" + ### (\fp mmime contents -> unPandocLua $ do + mb <- getMediaBag + setMediaBag $ MB.insertMedia fp mmime contents mb + return (Lua.NumResults 0)) + <#> parameter Lua.peekString "string" "filepath" "item file path" + <#> optionalParameter Lua.peekText "string" "mimetype" "the item's MIME type" + <#> parameter Lua.peekLazyByteString "string" "contents" "binary contents" + =?> "Nothing" -- | Returns iterator values to be used with a Lua @for@ loop. -items :: PandocLua NumResults -items = do - mb <- getMediaBag - liftPandocLua $ do - let pushItem (fp, mimetype, contents) = do - Lua.pushString fp - Lua.pushText mimetype - Lua.pushByteString $ BL.toStrict contents - return (Lua.NumResults 3) - pushIterator pushItem (MB.mediaItems mb) +items :: DocumentedFunction PandocError +items = defun "items" + ### (do + mb <-unPandocLua getMediaBag + let pushItem (fp, mimetype, contents) = do + Lua.pushString fp + Lua.pushText mimetype + Lua.pushByteString $ BL.toStrict contents + return (Lua.NumResults 3) + Lua.pushIterator pushItem (MB.mediaItems mb)) + =?> "Iterator triple" -lookup :: FilePath - -> PandocLua NumResults -lookup fp = do - res <- MB.lookupMedia fp <$> getMediaBag - liftPandocLua $ case res of - Nothing -> 1 <$ Lua.pushnil - Just item -> do - Lua.push $ MB.mediaMimeType item - Lua.push $ MB.mediaContents item - return 2 +-- | Function to lookup a value in the mediabag. +lookup :: DocumentedFunction PandocError +lookup = defun "lookup" + ### (\fp -> unPandocLua (MB.lookupMedia fp <$> getMediaBag) >>= \case + Nothing -> 1 <$ Lua.pushnil + Just item -> 2 <$ do + Lua.pushText $ MB.mediaMimeType item + Lua.pushLazyByteString $ MB.mediaContents item) + <#> parameter Lua.peekString "string" "filepath" "path of item to lookup" + =?> "MIME type and contents" -list :: PandocLua NumResults -list = do - dirContents <- MB.mediaDirectory <$> getMediaBag - liftPandocLua $ do - Lua.newtable - zipWithM_ addEntry [1..] dirContents - return 1 +-- | Function listing all mediabag items. +list :: DocumentedFunction PandocError +list = defun "list" + ### (unPandocLua (MB.mediaDirectory <$> getMediaBag)) + =#> functionResult (pushPandocList pushEntry) "table" "list of entry triples" where - addEntry :: Lua.Integer -> (FilePath, MimeType, Int) -> LuaE PandocError () - addEntry idx (fp, mimeType, contentLength) = do + pushEntry :: (FilePath, MimeType, Int) -> LuaE PandocError () + pushEntry (fp, mimeType, contentLength) = do Lua.newtable - Lua.push ("path" :: T.Text) *> Lua.push fp *> Lua.rawset (-3) - Lua.push ("type" :: T.Text) *> Lua.push mimeType *> Lua.rawset (-3) - Lua.push ("length" :: T.Text) *> Lua.push contentLength *> Lua.rawset (-3) - Lua.rawseti (-2) idx + Lua.pushName "path" *> Lua.pushString fp *> Lua.rawset (-3) + Lua.pushName "type" *> Lua.pushText mimeType *> Lua.rawset (-3) + Lua.pushName "length" *> Lua.pushIntegral contentLength *> Lua.rawset (-3) -fetch :: T.Text - -> PandocLua NumResults -fetch src = do - (bs, mimeType) <- fetchItem src - liftPandocLua . Lua.push $ maybe "" T.unpack mimeType - liftPandocLua $ Lua.push bs - return 2 -- returns 2 values: contents, mimetype +-- | Lua function to retrieve a new item. +fetch :: DocumentedFunction PandocError +fetch = defun "fetch" + ### (\src -> do + (bs, mimeType) <- unPandocLua $ fetchItem src + Lua.pushText $ fromMaybe "" mimeType + Lua.pushByteString bs + return 2) + <#> parameter Lua.peekText "string" "src" "URI to fetch" + =?> "Returns two string values: the fetched contents and the mimetype." diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index 7bad3f1a5..6d1ccea04 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -14,11 +15,12 @@ Pandoc module for lua. -} module Text.Pandoc.Lua.Module.Pandoc ( pushModule + , documentedModule ) where import Prelude hiding (read) -import Control.Applicative ((<|>), optional) -import Control.Monad ((>=>), (<$!>), forM_, when) +import Control.Applicative ((<|>)) +import Control.Monad ((<$!>), forM_, when) import Control.Monad.Catch (catch, throwM) import Control.Monad.Except (throwError) import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr) @@ -26,13 +28,14 @@ import Data.Default (Default (..)) import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (Proxy)) import Data.Text (Text) -import HsLua as Lua hiding (Div, pushModule) +import HsLua hiding (Div, pushModule) import HsLua.Class.Peekable (PeekError) import System.Exit (ExitCode (..)) import Text.Pandoc.Class.PandocIO (runIO) import Text.Pandoc.Definition -import Text.Pandoc.Lua.Filter (SingletonsList (..), walkInlines, - walkInlineLists, walkBlocks, walkBlockLists) +import Text.Pandoc.Lua.Filter (SingletonsList (..), LuaFilter, peekLuaFilter, + walkInlines, walkInlineLists, + walkBlocks, walkBlockLists) import Text.Pandoc.Lua.Marshaling () import Text.Pandoc.Lua.Marshaling.AST import Text.Pandoc.Lua.Marshaling.Attr (mkAttr, mkAttributeList) @@ -40,13 +43,15 @@ import Text.Pandoc.Lua.Marshaling.List (List (..)) import Text.Pandoc.Lua.Marshaling.ListAttributes ( mkListAttributes , peekListAttributes) import Text.Pandoc.Lua.Marshaling.SimpleTable (mkSimpleTable) -import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua, +import Text.Pandoc.Lua.Module.Utils (sha1) +import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, loadDefaultModule) import Text.Pandoc.Options (ReaderOptions (readerExtensions)) import Text.Pandoc.Process (pipeProcess) import Text.Pandoc.Readers (Reader (..), getReader) import Text.Pandoc.Walk (Walkable) +import qualified HsLua as Lua import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.Text as T @@ -57,45 +62,74 @@ import Text.Pandoc.Error -- module to be loadable. pushModule :: PandocLua NumResults pushModule = do + liftPandocLua $ Lua.pushModule documentedModule loadDefaultModule "pandoc" - addFunction "read" read - addFunction "pipe" pipe - addFunction "walk_block" (walkElement peekBlock pushBlock) - addFunction "walk_inline" (walkElement peekInline pushInline) - -- Constructors - addFunction "Attr" (liftPandocLua mkAttr) - addFunction "AttributeList" (liftPandocLua mkAttributeList) - addFunction "Pandoc" mkPandoc + let copyNext = do + hasNext <- next (nth 2) + if not hasNext + then return () + else do + pushvalue (nth 2) + insert (nth 2) + rawset (nth 5) -- pandoc module + copyNext liftPandocLua $ do - let addConstr fn = do - pushName (functionName fn) - pushDocumentedFunction fn - rawset (nth 3) - forM_ otherConstructors addConstr - forM_ blockConstructors addConstr - forM_ inlineConstructors addConstr - let addConstructorTable constructors = do - -- add constructors to Inlines.constructor - newtable -- constructor - forM_ constructors $ \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 - addConstructorTable (blockConstructors @PandocError) - addConstructorTable (inlineConstructors @PandocError) - -- Add string constants - forM_ stringConstants $ \c -> do - pushString c *> pushString c *> rawset (nth 3) + pushnil -- initial key + copyNext + pop 1 + return 1 +documentedModule :: Module PandocError +documentedModule = Module + { moduleName = "pandoc" + , moduleDescription = T.unlines + [ "Lua functions for pandoc scripts; includes constructors for" + , "document elements, functions to parse text in a given" + , "format, and functions to filter and modify a subtree." + ] + , moduleFields = stringConstants ++ [inlineField, blockField] + , moduleOperations = [] + , moduleFunctions = mconcat + [ functions + , otherConstructors + , blockConstructors + , inlineConstructors + ] + } + +-- | Inline table field +inlineField :: Field PandocError +inlineField = Field + { fieldName = "Inline" + , fieldDescription = "Inline constructors, nested under 'constructors'." + -- the nesting happens for historical reasons and should probably be + -- changed. + , fieldPushValue = pushWithConstructorsSubtable inlineConstructors + } + +-- | @Block@ module field +blockField :: Field PandocError +blockField = Field + { fieldName = "Block" + , fieldDescription = "Inline constructors, nested under 'constructors'." + -- the nesting happens for historical reasons and should probably be + -- changed. + , fieldPushValue = pushWithConstructorsSubtable blockConstructors + } + +pushWithConstructorsSubtable :: [DocumentedFunction PandocError] + -> LuaE PandocError () +pushWithConstructorsSubtable constructors = do + newtable -- Field table + newtable -- constructor table + pushName "constructor" *> pushvalue (nth 2) *> rawset (nth 4) + forM_ constructors $ \fn -> do + pushName (functionName fn) + pushDocumentedFunction fn + rawset (nth 3) + pop 1 -- pop constructor table + inlineConstructors :: LuaError e => [DocumentedFunction e] inlineConstructors = [ defun "Cite" @@ -291,7 +325,13 @@ mkInlinesConstr name constr = defun name otherConstructors :: LuaError e => [DocumentedFunction e] otherConstructors = - [ defun "Citation" + [ defun "Pandoc" + ### liftPure2 (\blocks mMeta -> Pandoc (fromMaybe nullMeta mMeta) blocks) + <#> parameter peekBlocksFuzzy "Blocks" "blocks" "document contents" + <#> optionalParameter peekMeta "Meta" "meta" "document metadata" + =#> functionResult pushPandoc "Pandoc" "new Pandoc document" + + , defun "Citation" ### (\cid mode mprefix msuffix mnote_num mhash -> cid `seq` mode `seq` mprefix `seq` msuffix `seq` mnote_num `seq` mhash `seq` return $! Citation @@ -311,68 +351,93 @@ otherConstructors = =#> functionResult pushCitation "Citation" "new citation object" #? "Creates a single citation." + , mkAttr + , mkAttributeList , mkListAttributes , mkSimpleTable ] -stringConstants :: [String] +stringConstants :: [Field e] stringConstants = let constrs :: forall a. Data a => Proxy a -> [String] constrs _ = map showConstr . dataTypeConstrs . dataTypeOf @a $ undefined - in constrs (Proxy @ListNumberStyle) - ++ constrs (Proxy @ListNumberDelim) - ++ constrs (Proxy @QuoteType) - ++ constrs (Proxy @MathType) - ++ constrs (Proxy @Alignment) - ++ constrs (Proxy @CitationMode) + nullaryConstructors = mconcat + [ constrs (Proxy @ListNumberStyle) + , constrs (Proxy @ListNumberDelim) + , constrs (Proxy @QuoteType) + , constrs (Proxy @MathType) + , constrs (Proxy @Alignment) + , constrs (Proxy @CitationMode) + ] + toField s = Field + { fieldName = T.pack s + , fieldDescription = T.pack s + , fieldPushValue = pushString s + } + in map toField nullaryConstructors walkElement :: (Walkable (SingletonsList Inline) a, Walkable (SingletonsList Block) a, Walkable (List Inline) a, Walkable (List Block) a) - => Peeker PandocError a -> Pusher PandocError a - -> LuaE PandocError NumResults -walkElement peek' push' = do - x <- forcePeek $ peek' (nthBottom 1) - f <- peek (nthBottom 2) - let walk' = walkInlines f - >=> walkInlineLists f - >=> walkBlocks f - >=> walkBlockLists f - walk' x >>= push' - return (NumResults 1) - -read :: T.Text -> Optional T.Text -> PandocLua NumResults -read content formatSpecOrNil = liftPandocLua $ do - let formatSpec = fromMaybe "markdown" (Lua.fromOptional formatSpecOrNil) - res <- Lua.liftIO . runIO $ - getReader formatSpec >>= \(rdr,es) -> - case rdr of - TextReader r -> - r def{ readerExtensions = es } content - _ -> throwError $ PandocSomeError - "Only textual formats are supported" - case res of - Right pd -> (1 :: NumResults) <$ Lua.push pd -- success, push Pandoc - Left (PandocUnknownReaderError f) -> Lua.raiseError $ - "Unknown reader: " <> f - Left (PandocUnsupportedExtensionError e f) -> Lua.raiseError $ - "Extension " <> e <> " not supported for " <> f - Left e -> Lua.raiseError $ show e - --- | Pipes input through a command. -pipe :: String -- ^ path to executable - -> [String] -- ^ list of arguments - -> BL.ByteString -- ^ input passed to process via stdin - -> PandocLua NumResults -pipe command args input = liftPandocLua $ do - (ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input - `catch` (throwM . PandocIOError "pipe") - case ec of - ExitSuccess -> 1 <$ Lua.push output - ExitFailure n -> do - pushPipeError (PipeError (T.pack command) n output) - Lua.error + => a -> LuaFilter -> LuaE PandocError a +walkElement x f = walkInlines f x + >>= walkInlineLists f + >>= walkBlocks f + >>= walkBlockLists f + +functions :: [DocumentedFunction PandocError] +functions = + [ defun "pipe" + ### (\command args input -> do + (ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input + `catch` (throwM . PandocIOError "pipe") + case ec of + ExitSuccess -> 1 <$ Lua.pushLazyByteString output + ExitFailure n -> do + pushPipeError (PipeError (T.pack command) n output) + Lua.error) + <#> parameter peekString "string" "command" "path to executable" + <#> parameter (peekList peekString) "{string,...}" "args" + "list of arguments" + <#> parameter peekLazyByteString "string" "input" + "input passed to process via stdin" + =?> "output string, or error triple" + + , defun "read" + ### (\content mformatspec -> do + let formatSpec = fromMaybe "markdown" mformatspec + res <- Lua.liftIO . runIO $ getReader formatSpec >>= \case + (TextReader r, es) -> r def{ readerExtensions = es } content + _ -> throwError $ PandocSomeError + "Only textual formats are supported" + case res of + Right pd -> return pd -- success, got a Pandoc document + Left (PandocUnknownReaderError f) -> + Lua.failLua . T.unpack $ "Unknown reader: " <> f + Left (PandocUnsupportedExtensionError e f) -> + Lua.failLua . T.unpack $ + "Extension " <> e <> " not supported for " <> f + Left e -> + throwM e) + <#> parameter peekText "string" "content" "text to parse" + <#> optionalParameter peekText "string" "formatspec" "format and extensions" + =#> functionResult pushPandoc "Pandoc" "result document" + + , sha1 + + , defun "walk_block" + ### walkElement + <#> parameter peekBlockFuzzy "Block" "block" "element to traverse" + <#> parameter peekLuaFilter "LuaFilter" "filter" "filter functions" + =#> functionResult pushBlock "Block" "modified Block" + + , defun "walk_inline" + ### walkElement + <#> parameter peekInlineFuzzy "Inline" "inline" "element to traverse" + <#> parameter peekLuaFilter "LuaFilter" "filter" "filter functions" + =#> functionResult pushInline "Inline" "modified Inline" + ] data PipeError = PipeError { pipeErrorCommand :: T.Text @@ -416,12 +481,3 @@ pushPipeError pipeErr = do , if output == mempty then BSL.pack "<no output>" else output ] return (NumResults 1) - -mkPandoc :: PandocLua NumResults -mkPandoc = liftPandocLua $ do - doc <- forcePeek $ do - blks <- peekBlocksFuzzy (nthBottom 1) - mMeta <- optional $ peekMeta (nthBottom 2) - pure $ Pandoc (fromMaybe nullMeta mMeta) blks - pushPandoc doc - return 1 diff --git a/src/Text/Pandoc/Lua/Module/System.hs b/src/Text/Pandoc/Lua/Module/System.hs index 8589f672c..e329a0125 100644 --- a/src/Text/Pandoc/Lua/Module/System.hs +++ b/src/Text/Pandoc/Lua/Module/System.hs @@ -11,34 +11,28 @@ Pandoc's system Lua module. -} module Text.Pandoc.Lua.Module.System - ( pushModule + ( documentedModule ) where -import HsLua hiding (pushModule) +import HsLua import HsLua.Module.System (arch, env, getwd, os, with_env, with_tmpdir, with_wd) -import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.ErrorConversion () - -import qualified HsLua as Lua -- | Push the pandoc.system module on the Lua stack. -pushModule :: LuaE PandocError NumResults -pushModule = do - Lua.pushModule $ Module - { moduleName = "system" - , moduleDescription = "system functions" - , moduleFields = - [ arch - , os - ] - , moduleFunctions = - [ setName "environment" env - , setName "get_working_directory" getwd - , setName "with_environment" with_env - , setName "with_temporary_directory" with_tmpdir - , setName "with_working_directory" with_wd - ] - , moduleOperations = [] - } - return 1 +documentedModule :: LuaError e => Module e +documentedModule = Module + { moduleName = "pandoc.system" + , moduleDescription = "system functions" + , moduleFields = + [ arch + , os + ] + , moduleFunctions = + [ setName "environment" env + , setName "get_working_directory" getwd + , setName "with_environment" with_env + , setName "with_temporary_directory" with_tmpdir + , setName "with_working_directory" with_wd + ] + , moduleOperations = [] + } diff --git a/src/Text/Pandoc/Lua/Module/Types.hs b/src/Text/Pandoc/Lua/Module/Types.hs index ff4a4e0d5..4b37dafd9 100644 --- a/src/Text/Pandoc/Lua/Module/Types.hs +++ b/src/Text/Pandoc/Lua/Module/Types.hs @@ -10,34 +10,52 @@ Pandoc data type constructors. -} module Text.Pandoc.Lua.Module.Types - ( pushModule + ( documentedModule ) where -import HsLua (LuaE, NumResults, Peeker, Pusher) +import HsLua ( LuaE, NumResults, Peeker, Pusher, Module (..), Field (..) + , defun, functionResult, parameter, (###), (<#>), (=#>)) +import HsLua.Module.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.ErrorConversion () import Text.Pandoc.Lua.Marshaling.AST -import Text.Pandoc.Lua.Util (addFunction) import qualified HsLua as Lua -import qualified HsLua.Module.Version as Version -- | Push the pandoc.types module on the Lua stack. -pushModule :: LuaE PandocError NumResults -pushModule = do - Lua.newtable - Lua.pushName "Version" *> Lua.pushModule Version.documentedModule - *> Lua.rawset (Lua.nth 3) - pushCloneTable - Lua.setfield (Lua.nth 2) "clone" - return 1 - -pushCloneTable :: LuaE PandocError NumResults -pushCloneTable = do - Lua.newtable - addFunction "Meta" $ cloneWith peekMeta Lua.push - addFunction "MetaValue" $ cloneWith peekMetaValue pushMetaValue - return 1 +documentedModule :: Module PandocError +documentedModule = Module + { moduleName = "pandoc.types" + , moduleDescription = + "Constructors for types that are not part of the pandoc AST." + , moduleFields = + [ Field + { fieldName = "clone" + , fieldDescription = "DEPRECATED! Helper functions for element cloning." + , fieldPushValue = do + Lua.newtable + addFunction "Meta" $ cloneWith peekMeta pushMeta + addFunction "MetaValue" $ cloneWith peekMetaValue pushMetaValue + } + ] + , moduleFunctions = + [ defun "Version" + ### return + <#> parameter peekVersionFuzzy "string|integer|{integer,...}|Version" + "version_specifier" + (mconcat [ "either a version string like `'2.7.3'`, " + , "a single integer like `2`, " + , "list of integers like `{2,7,3}`, " + , "or a Version object" + ]) + =#> functionResult pushVersion "Version" "A new Version object." + ] + , moduleOperations = [] + } + where addFunction name fn = do + Lua.pushName name + Lua.pushHaskellFunction fn + Lua.rawset (Lua.nth 3) cloneWith :: Peeker PandocError a -> Pusher PandocError a diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 3602612cb..01ba4eb46 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -13,7 +13,8 @@ Utility module for Lua, exposing internal helper functions. -} module Text.Pandoc.Lua.Module.Utils - ( pushModule + ( documentedModule + , sha1 ) where import Control.Applicative ((<|>)) @@ -21,7 +22,7 @@ import Control.Monad ((<$!>)) import Data.Data (showConstr, toConstr) import Data.Default (def) import Data.Version (Version) -import HsLua as Lua hiding (pushModule) +import HsLua as Lua import HsLua.Class.Peekable (PeekError) import HsLua.Module.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Definition @@ -39,7 +40,6 @@ import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua)) import qualified Data.Digest.Pure.SHA as SHA import qualified Data.ByteString.Lazy as BSL import qualified Data.Text as T -import qualified HsLua.Packaging as Lua import qualified Text.Pandoc.Builder as B import qualified Text.Pandoc.Filter.JSON as JSONFilter import qualified Text.Pandoc.Shared as Shared @@ -47,8 +47,8 @@ import qualified Text.Pandoc.UTF8 as UTF8 import qualified Text.Pandoc.Writers.Shared as Shared -- | Push the "pandoc.utils" module to the Lua stack. -pandocUtilsModule :: Module PandocError -pandocUtilsModule = Module +documentedModule :: Module PandocError +documentedModule = Module { moduleName = "pandoc.utils" , moduleDescription = "pandoc utility functions" , moduleFields = [] @@ -92,12 +92,7 @@ pandocUtilsModule = Module , "Returns nil instead of a string if the conversion failed." ] - , defun "sha1" - ### liftPure (SHA.showDigest . SHA.sha1) - <#> parameter (fmap BSL.fromStrict . peekByteString) "string" - "input" "" - =#> functionResult pushString "string" "hexadecimal hash value" - #? "Compute the hash of the given string value." + , sha1 , defun "Version" ### liftPure (id @Version) @@ -146,8 +141,13 @@ pandocUtilsModule = Module ] } -pushModule :: LuaE PandocError NumResults -pushModule = 1 <$ Lua.pushModule pandocUtilsModule +-- | Documented Lua function to compute the hash of a string. +sha1 :: DocumentedFunction e +sha1 = defun "sha1" + ### liftPure (SHA.showDigest . SHA.sha1) + <#> parameter (fmap BSL.fromStrict . peekByteString) "string" "input" "" + =#> functionResult pushString "string" "hexadecimal hash value" + #? "Compute the hash of the given string value." -- | Convert pandoc structure to a string with formatting removed. diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs index f9bd7abe8..8e5cc96c3 100644 --- a/src/Text/Pandoc/Lua/Packages.hs +++ b/src/Text/Pandoc/Lua/Packages.hs @@ -16,7 +16,6 @@ module Text.Pandoc.Lua.Packages ) where import Control.Monad (forM_) -import HsLua (NumResults) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, loadDefaultModule) @@ -43,24 +42,27 @@ installPandocPackageSearcher = liftPandocLua $ do Lua.rawseti (-2) (i + 1) -- | Load a pandoc module. -pandocPackageSearcher :: String -> PandocLua NumResults +pandocPackageSearcher :: String -> PandocLua Lua.NumResults pandocPackageSearcher pkgName = case pkgName of "pandoc" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError Pandoc.pushModule - "pandoc.mediabag" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError MediaBag.pushModule - "pandoc.path" -> pushWrappedHsFun - (Lua.NumResults 1 <$ Lua.pushModule @PandocError Path.documentedModule) - "pandoc.system" -> pushWrappedHsFun $ Lua.toHaskellFunction System.pushModule - "pandoc.types" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError Types.pushModule - "pandoc.utils" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError Utils.pushModule - "text" -> pushWrappedHsFun - (Lua.NumResults 1 <$ Lua.pushModule @PandocError Text.documentedModule) - "pandoc.List" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError (loadDefaultModule pkgName) + "pandoc.mediabag" -> pushModuleLoader MediaBag.documentedModule + "pandoc.path" -> pushModuleLoader Path.documentedModule + "pandoc.system" -> pushModuleLoader System.documentedModule + "pandoc.types" -> pushModuleLoader Types.documentedModule + "pandoc.utils" -> pushModuleLoader Utils.documentedModule + "text" -> pushModuleLoader Text.documentedModule + "pandoc.List" -> pushWrappedHsFun . Lua.toHaskellFunction @PandocError $ + loadDefaultModule pkgName _ -> reportPandocSearcherFailure where + pushModuleLoader mdl = liftPandocLua $ do + Lua.pushHaskellFunction $ + Lua.NumResults 1 <$ Lua.pushModule @PandocError mdl + return (Lua.NumResults 1) pushWrappedHsFun f = liftPandocLua $ do Lua.pushHaskellFunction f return 1 reportPandocSearcherFailure = liftPandocLua $ do Lua.push ("\n\t" <> pkgName <> "is not one of pandoc's default packages") - return (1 :: NumResults) + return (Lua.NumResults 1) diff --git a/src/Text/Pandoc/Lua/PandocLua.hs b/src/Text/Pandoc/Lua/PandocLua.hs index 12511d088..6c2ebc622 100644 --- a/src/Text/Pandoc/Lua/PandocLua.hs +++ b/src/Text/Pandoc/Lua/PandocLua.hs @@ -22,7 +22,6 @@ module Text.Pandoc.Lua.PandocLua ( PandocLua (..) , runPandocLua , liftPandocLua - , addFunction , loadDefaultModule ) where @@ -76,13 +75,6 @@ instance {-# OVERLAPPING #-} Exposable PandocError (PandocLua NumResults) where instance Pushable a => Exposable PandocError (PandocLua a) where partialApply _narg x = 1 <$ (unPandocLua x >>= Lua.push) --- | Add a function to the table at the top of the stack, using the given name. -addFunction :: Exposable PandocError a => Name -> a -> PandocLua () -addFunction name fn = liftPandocLua $ do - Lua.pushName name - Lua.pushHaskellFunction $ toHaskellFunction fn - Lua.rawset (-3) - -- | Load a pure Lua module included with pandoc. Leaves the result on -- the stack and returns @NumResults 1@. -- diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs index f20bc09e8..f35201db0 100644 --- a/src/Text/Pandoc/Lua/Util.hs +++ b/src/Text/Pandoc/Lua/Util.hs @@ -18,7 +18,6 @@ Lua utility functions. module Text.Pandoc.Lua.Util ( getTag , addField - , addFunction , callWithTraceback , dofileWithTraceback , pushViaConstr' @@ -35,14 +34,6 @@ addField key value = do Lua.push value Lua.rawset (Lua.nth 3) --- | Add a function to the table at the top of the stack, using the --- given name. -addFunction :: Exposable e a => String -> a -> LuaE e () -addFunction name fn = do - Lua.push name - Lua.pushHaskellFunction $ toHaskellFunction fn - Lua.rawset (-3) - -- | Get the tag of a value. This is an optimized and specialized version of -- @Lua.getfield idx "tag"@. It only checks for the field on the table at index -- @idx@ and on its metatable, also ignoring any @__index@ value on the diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 72446db99..6e8257633 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -408,6 +408,12 @@ return { }) assert.are_same(expected, pandoc.read(valid_markdown)) end), + test('unsupported extension', function () + assert.error_matches( + function () pandoc.read('foo', 'gfm+empty_paragraphs') end, + 'Extension empty_paragraphs not supported for gfm' + ) + end), test('failing read', function () assert.error_matches( function () pandoc.read('foo', 'nosuchreader') end, |