aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Lua/Filter.hs33
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/AST.hs1
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/Attr.hs50
-rw-r--r--src/Text/Pandoc/Lua/Module/MediaBag.hs160
-rw-r--r--src/Text/Pandoc/Lua/Module/Pandoc.hs258
-rw-r--r--src/Text/Pandoc/Lua/Module/System.hs44
-rw-r--r--src/Text/Pandoc/Lua/Module/Types.hs56
-rw-r--r--src/Text/Pandoc/Lua/Module/Utils.hs26
-rw-r--r--src/Text/Pandoc/Lua/Packages.hs26
-rw-r--r--src/Text/Pandoc/Lua/PandocLua.hs8
-rw-r--r--src/Text/Pandoc/Lua/Util.hs9
11 files changed, 374 insertions, 297 deletions
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-14 06:33:36 +0000