aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Lua/Module
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Lua/Module')
-rw-r--r--src/Text/Pandoc/Lua/Module/MediaBag.hs157
-rw-r--r--src/Text/Pandoc/Lua/Module/Pandoc.hs285
-rw-r--r--src/Text/Pandoc/Lua/Module/System.hs41
-rw-r--r--src/Text/Pandoc/Lua/Module/Types.hs84
-rw-r--r--src/Text/Pandoc/Lua/Module/Utils.hs293
5 files changed, 520 insertions, 340 deletions
diff --git a/src/Text/Pandoc/Lua/Module/MediaBag.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs
index 3eed50fca..fb055101e 100644
--- a/src/Text/Pandoc/Lua/Module/MediaBag.hs
+++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs
@@ -1,103 +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 Foreign.Lua (Lua, NumResults, Optional)
+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.Lua.Marshaling ()
-import Text.Pandoc.Lua.Marshaling.MediaBag (pushIterator)
-import Text.Pandoc.Lua.PandocLua (PandocLua (..), liftPandocLua, addFunction)
+import Text.Pandoc.Error (PandocError)
+import Text.Pandoc.Lua.Marshal.List (pushPandocList)
+import Text.Pandoc.Lua.Orphans ()
+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 Foreign.Lua as Lua
+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 = getMediaBag >>= liftPandocLua . pushIterator
+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) -> Lua ()
- 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 5c14b3a30..20c2f5af5 100644
--- a/src/Text/Pandoc/Lua/Module/Pandoc.hs
+++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs
@@ -1,5 +1,8 @@
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
{- |
Module : Text.Pandoc.Lua.Module.Pandoc
Copyright : Copyright © 2017-2021 Albert Krewinkel
@@ -12,32 +15,37 @@ Pandoc module for lua.
-}
module Text.Pandoc.Lua.Module.Pandoc
( pushModule
+ , documentedModule
) where
import Prelude hiding (read)
-import Control.Monad (when)
+import Control.Monad (forM_, when)
+import Control.Monad.Catch (catch, throwM)
import Control.Monad.Except (throwError)
+import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr)
import Data.Default (Default (..))
import Data.Maybe (fromMaybe)
-import Foreign.Lua (Lua, NumResults, Optional, Peekable, Pushable)
+import Data.Proxy (Proxy (Proxy))
+import HsLua hiding (pushModule)
+import HsLua.Class.Peekable (PeekError)
import System.Exit (ExitCode (..))
import Text.Pandoc.Class.PandocIO (runIO)
-import Text.Pandoc.Definition (Block, Inline)
-import Text.Pandoc.Lua.Filter (LuaFilter, SingletonsList (..), walkInlines,
- walkInlineLists, walkBlocks, walkBlockLists)
-import Text.Pandoc.Lua.Marshaling ()
-import Text.Pandoc.Lua.Marshaling.List (List (..))
-import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua,
- loadDefaultModule)
-import Text.Pandoc.Walk (Walkable)
+import Text.Pandoc.Definition
+import Text.Pandoc.Lua.Orphans ()
+import Text.Pandoc.Lua.Marshal.AST
+import Text.Pandoc.Lua.Marshal.Filter (peekFilter)
+import Text.Pandoc.Lua.Marshal.ReaderOptions ( peekReaderOptions
+ , pushReaderOptions)
+import Text.Pandoc.Lua.Module.Utils (sha1)
+import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua)
import Text.Pandoc.Options (ReaderOptions (readerExtensions))
import Text.Pandoc.Process (pipeProcess)
import Text.Pandoc.Readers (Reader (..), getReader)
+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
-import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.Lua.Util as LuaUtil
import Text.Pandoc.Error
@@ -45,55 +53,164 @@ import Text.Pandoc.Error
-- module to be loadable.
pushModule :: PandocLua NumResults
pushModule = do
- loadDefaultModule "pandoc"
- addFunction "read" read
- addFunction "pipe" pipe
- addFunction "walk_block" walk_block
- addFunction "walk_inline" walk_inline
+ liftPandocLua $ Lua.pushModule documentedModule
return 1
-walkElement :: (Walkable (SingletonsList Inline) a,
- Walkable (SingletonsList Block) a,
- Walkable (List Inline) a,
- Walkable (List Block) a)
- => a -> LuaFilter -> PandocLua a
-walkElement x f = liftPandocLua $
- walkInlines f x >>= walkInlineLists f >>= walkBlocks f >>= walkBlockLists f
-
-walk_inline :: Inline -> LuaFilter -> PandocLua Inline
-walk_inline = walkElement
-
-walk_block :: Block -> LuaFilter -> PandocLua Block
-walk_block = walkElement
-
-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
- case ec of
- ExitSuccess -> 1 <$ Lua.push output
- ExitFailure n -> Lua.raiseError (PipeError (T.pack command) n output)
+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
+ , metaValueConstructors
+ ]
+ }
+
+-- | 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
+
+otherConstructors :: LuaError e => [DocumentedFunction e]
+otherConstructors =
+ [ mkPandoc
+ , mkMeta
+ , mkAttr
+ , mkAttributeList
+ , mkBlocks
+ , mkCitation
+ , mkCell
+ , mkRow
+ , mkTableHead
+ , mkTableFoot
+ , mkInlines
+ , mkListAttributes
+ , mkSimpleTable
+
+ , defun "ReaderOptions"
+ ### liftPure id
+ <#> parameter peekReaderOptions "ReaderOptions|table" "opts" "reader options"
+ =#> functionResult pushReaderOptions "ReaderOptions" "new object"
+ #? "Creates a new ReaderOptions value."
+ ]
+
+stringConstants :: [Field e]
+stringConstants =
+ let constrs :: forall a. Data a => Proxy a -> [String]
+ constrs _ = map showConstr . dataTypeConstrs . dataTypeOf @a $ undefined
+ 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
+
+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 mreaderOptions -> do
+ let formatSpec = fromMaybe "markdown" mformatspec
+ readerOptions = fromMaybe def mreaderOptions
+ res <- Lua.liftIO . runIO $ getReader formatSpec >>= \case
+ (TextReader r, es) -> r readerOptions{ 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"
+ <#> optionalParameter peekReaderOptions "ReaderOptions" "reader_options"
+ "reader options"
+ =#> functionResult pushPandoc "Pandoc" "result document"
+
+ , sha1
+
+ , defun "walk_block"
+ ### walkElement
+ <#> parameter peekBlockFuzzy "Block" "block" "element to traverse"
+ <#> parameter peekFilter "Filter" "lua_filter" "filter functions"
+ =#> functionResult pushBlock "Block" "modified Block"
+
+ , defun "walk_inline"
+ ### walkElement
+ <#> parameter peekInlineFuzzy "Inline" "inline" "element to traverse"
+ <#> parameter peekFilter "Filter" "lua_filter" "filter functions"
+ =#> functionResult pushInline "Inline" "modified Inline"
+ ]
+ where
+ walkElement x f =
+ walkInlineSplicing f x
+ >>= walkInlinesStraight f
+ >>= walkBlockSplicing f
+ >>= walkBlocksStraight f
data PipeError = PipeError
{ pipeErrorCommand :: T.Text
@@ -101,29 +218,34 @@ data PipeError = PipeError
, pipeErrorOutput :: BL.ByteString
}
-instance Peekable PipeError where
- peek idx =
- PipeError
- <$> (Lua.getfield idx "command" *> Lua.peek (-1) <* Lua.pop 1)
- <*> (Lua.getfield idx "error_code" *> Lua.peek (-1) <* Lua.pop 1)
- <*> (Lua.getfield idx "output" *> Lua.peek (-1) <* Lua.pop 1)
-
-instance Pushable PipeError where
- push pipeErr = do
- Lua.newtable
- LuaUtil.addField "command" (pipeErrorCommand pipeErr)
- LuaUtil.addField "error_code" (pipeErrorCode pipeErr)
- LuaUtil.addField "output" (pipeErrorOutput pipeErr)
- pushPipeErrorMetaTable
- Lua.setmetatable (-2)
- where
- pushPipeErrorMetaTable :: Lua ()
- pushPipeErrorMetaTable = do
- v <- Lua.newmetatable "pandoc pipe error"
- when v $ LuaUtil.addFunction "__tostring" pipeErrorMessage
-
- pipeErrorMessage :: PipeError -> Lua BL.ByteString
- pipeErrorMessage (PipeError cmd errorCode output) = return $ mconcat
+peekPipeError :: PeekError e => StackIndex -> LuaE e PipeError
+peekPipeError idx =
+ PipeError
+ <$> (Lua.getfield idx "command" *> Lua.peek (-1) <* Lua.pop 1)
+ <*> (Lua.getfield idx "error_code" *> Lua.peek (-1) <* Lua.pop 1)
+ <*> (Lua.getfield idx "output" *> Lua.peek (-1) <* Lua.pop 1)
+
+pushPipeError :: PeekError e => Pusher e PipeError
+pushPipeError pipeErr = do
+ Lua.newtable
+ LuaUtil.addField "command" (pipeErrorCommand pipeErr)
+ LuaUtil.addField "error_code" (pipeErrorCode pipeErr)
+ LuaUtil.addField "output" (pipeErrorOutput pipeErr)
+ pushPipeErrorMetaTable
+ Lua.setmetatable (-2)
+ where
+ pushPipeErrorMetaTable :: PeekError e => LuaE e ()
+ pushPipeErrorMetaTable = do
+ v <- Lua.newmetatable "pandoc pipe error"
+ when v $ do
+ pushName "__tostring"
+ pushHaskellFunction pipeErrorMessage
+ rawset (nth 3)
+
+ pipeErrorMessage :: PeekError e => LuaE e NumResults
+ pipeErrorMessage = do
+ (PipeError cmd errorCode output) <- peekPipeError (nthBottom 1)
+ pushByteString . BSL.toStrict . BSL.concat $
[ BSL.pack "Error running "
, BSL.pack $ T.unpack cmd
, BSL.pack " (error code "
@@ -131,3 +253,4 @@ instance Pushable PipeError where
, BSL.pack "): "
, if output == mempty then BSL.pack "<no output>" else output
]
+ return (NumResults 1)
diff --git a/src/Text/Pandoc/Lua/Module/System.hs b/src/Text/Pandoc/Lua/Module/System.hs
index bd35babaf..e329a0125 100644
--- a/src/Text/Pandoc/Lua/Module/System.hs
+++ b/src/Text/Pandoc/Lua/Module/System.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{- |
Module : Text.Pandoc.Lua.Module.System
Copyright : © 2019-2021 Albert Krewinkel
@@ -9,25 +11,28 @@
Pandoc's system Lua module.
-}
module Text.Pandoc.Lua.Module.System
- ( pushModule
+ ( documentedModule
) where
-import Foreign.Lua (Lua, NumResults)
-import Foreign.Lua.Module.System (arch, env, getwd, os,
- with_env, with_tmpdir, with_wd)
-import Text.Pandoc.Lua.Util (addFunction, addField)
-
-import qualified Foreign.Lua as Lua
+import HsLua
+import HsLua.Module.System
+ (arch, env, getwd, os, with_env, with_tmpdir, with_wd)
-- | Push the pandoc.system module on the Lua stack.
-pushModule :: Lua NumResults
-pushModule = do
- Lua.newtable
- addField "arch" arch
- addField "os" os
- addFunction "environment" env
- addFunction "get_working_directory" getwd
- addFunction "with_environment" with_env
- addFunction "with_temporary_directory" with_tmpdir
- addFunction "with_working_directory" with_wd
- 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 bb4f02c3c..f16737f63 100644
--- a/src/Text/Pandoc/Lua/Module/Types.hs
+++ b/src/Text/Pandoc/Lua/Module/Types.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Text.Pandoc.Lua.Module.Types
Copyright : © 2019-2021 Albert Krewinkel
@@ -9,60 +10,33 @@
Pandoc data type constructors.
-}
module Text.Pandoc.Lua.Module.Types
- ( pushModule
+ ( documentedModule
) where
-import Data.Version (Version)
-import Foreign.Lua (Lua, NumResults)
-import Text.Pandoc.Definition
-import Text.Pandoc.Lua.Marshaling.AST (LuaAttr, LuaListAttributes)
-import Text.Pandoc.Lua.Marshaling.Version ()
-import Text.Pandoc.Lua.Util (addFunction)
-
-import qualified Foreign.Lua as Lua
-
--- | Push the pandoc.system module on the Lua stack.
-pushModule :: Lua NumResults
-pushModule = do
- Lua.newtable
- addFunction "Version" (return :: Version -> Lua Version)
- pushCloneTable
- Lua.setfield (Lua.nthFromTop 2) "clone"
- return 1
-
-pushCloneTable :: Lua NumResults
-pushCloneTable = do
- Lua.newtable
- addFunction "Attr" cloneAttr
- addFunction "Block" cloneBlock
- addFunction "Citation" cloneCitation
- addFunction "Inline" cloneInline
- addFunction "Meta" cloneMeta
- addFunction "MetaValue" cloneMetaValue
- addFunction "ListAttributes" cloneListAttributes
- addFunction "Pandoc" clonePandoc
- return 1
-
-cloneAttr :: LuaAttr -> Lua LuaAttr
-cloneAttr = return
-
-cloneBlock :: Block -> Lua Block
-cloneBlock = return
-
-cloneCitation :: Citation -> Lua Citation
-cloneCitation = return
-
-cloneInline :: Inline -> Lua Inline
-cloneInline = return
-
-cloneListAttributes :: LuaListAttributes -> Lua LuaListAttributes
-cloneListAttributes = return
-
-cloneMeta :: Meta -> Lua Meta
-cloneMeta = return
-
-cloneMetaValue :: MetaValue -> Lua MetaValue
-cloneMetaValue = return
-
-clonePandoc :: Pandoc -> Lua Pandoc
-clonePandoc = return
+import HsLua ( Module (..), (###), (<#>), (=#>)
+ , defun, functionResult, parameter)
+import HsLua.Module.Version (peekVersionFuzzy, pushVersion)
+import Text.Pandoc.Error (PandocError)
+import Text.Pandoc.Lua.ErrorConversion ()
+
+-- | Push the pandoc.types module on the Lua stack.
+documentedModule :: Module PandocError
+documentedModule = Module
+ { moduleName = "pandoc.types"
+ , moduleDescription =
+ "Constructors for types that are not part of the pandoc AST."
+ , moduleFields = []
+ , 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 = []
+ }
diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs
index 3ec3afc26..02307cf7a 100644
--- a/src/Text/Pandoc/Lua/Module/Utils.hs
+++ b/src/Text/Pandoc/Lua/Module/Utils.hs
@@ -1,5 +1,7 @@
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
{- |
Module : Text.Pandoc.Lua.Module.Utils
Copyright : Copyright © 2017-2021 Albert Krewinkel
@@ -11,143 +13,194 @@
Utility module for Lua, exposing internal helper functions.
-}
module Text.Pandoc.Lua.Module.Utils
- ( pushModule
+ ( documentedModule
+ , sha1
) where
import Control.Applicative ((<|>))
-import Control.Monad.Catch (try)
+import Control.Monad ((<$!>))
import Data.Data (showConstr, toConstr)
import Data.Default (def)
+import Data.Maybe (fromMaybe)
import Data.Version (Version)
-import Foreign.Lua (Peekable, Lua, NumResults (..))
+import HsLua as Lua
+import HsLua.Module.Version (peekVersionFuzzy, pushVersion)
+import Text.Pandoc.Citeproc (getReferences)
import Text.Pandoc.Definition
import Text.Pandoc.Error (PandocError)
-import Text.Pandoc.Lua.Marshaling ()
-import Text.Pandoc.Lua.Marshaling.SimpleTable
- ( SimpleTable (..)
- , pushSimpleTable
- )
-import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua)
+import Text.Pandoc.Lua.Marshal.AST
+import Text.Pandoc.Lua.Marshal.Reference
+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.Map as Map
import qualified Data.Text as T
-import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.Builder as B
import qualified Text.Pandoc.Filter.JSON as JSONFilter
import qualified Text.Pandoc.Shared as Shared
+import qualified Text.Pandoc.UTF8 as UTF8
import qualified Text.Pandoc.Writers.Shared as Shared
-- | Push the "pandoc.utils" module to the Lua stack.
-pushModule :: PandocLua NumResults
-pushModule = do
- liftPandocLua Lua.newtable
- addFunction "blocks_to_inlines" blocksToInlines
- addFunction "equals" equals
- addFunction "from_simple_table" from_simple_table
- addFunction "make_sections" makeSections
- addFunction "normalize_date" normalizeDate
- addFunction "run_json_filter" runJSONFilter
- addFunction "sha1" sha1
- addFunction "stringify" stringify
- addFunction "to_roman_numeral" toRomanNumeral
- addFunction "to_simple_table" to_simple_table
- addFunction "Version" (return :: Version -> Lua Version)
- return 1
-
--- | Squashes a list of blocks into inlines.
-blocksToInlines :: [Block] -> Lua.Optional [Inline] -> PandocLua [Inline]
-blocksToInlines blks optSep = liftPandocLua $ do
- let sep = maybe Shared.defaultBlocksSeparator B.fromList
- $ Lua.fromOptional optSep
- return $ B.toList (Shared.blocksToInlinesWithSep sep blks)
-
--- | Convert list of Pandoc blocks into sections using Divs.
-makeSections :: Bool -> Lua.Optional Int -> [Block] -> Lua [Block]
-makeSections number baselevel =
- return . Shared.makeSections number (Lua.fromOptional baselevel)
-
--- | Parse a date and convert (if possible) to "YYYY-MM-DD" format. We
--- limit years to the range 1601-9999 (ISO 8601 accepts greater than
--- or equal to 1583, but MS Word only accepts dates starting 1601).
--- Returns nil instead of a string if the conversion failed.
-normalizeDate :: T.Text -> Lua (Lua.Optional T.Text)
-normalizeDate = return . Lua.Optional . Shared.normalizeDate
-
--- | Run a JSON filter on the given document.
-runJSONFilter :: Pandoc
- -> FilePath
- -> Lua.Optional [String]
- -> PandocLua Pandoc
-runJSONFilter doc filterFile optArgs = do
- args <- case Lua.fromOptional optArgs of
- Just x -> return x
- Nothing -> liftPandocLua $ do
- Lua.getglobal "FORMAT"
- (:[]) <$> Lua.popValue
- JSONFilter.apply def args filterFile doc
-
--- | Calculate the hash of the given contents.
-sha1 :: BSL.ByteString
- -> Lua T.Text
-sha1 = return . T.pack . SHA.showDigest . SHA.sha1
+documentedModule :: Module PandocError
+documentedModule = Module
+ { moduleName = "pandoc.utils"
+ , moduleDescription = "pandoc utility functions"
+ , moduleFields = []
+ , moduleOperations = []
+ , moduleFunctions =
+ [ defun "blocks_to_inlines"
+ ### (\blks mSep -> do
+ let sep = maybe Shared.defaultBlocksSeparator B.fromList mSep
+ return $ B.toList (Shared.blocksToInlinesWithSep sep blks))
+ <#> parameter (peekList peekBlock) "list of blocks"
+ "blocks" ""
+ <#> optionalParameter (peekList peekInline) "list of inlines"
+ "inline" ""
+ =#> functionResult pushInlines "list of inlines" ""
+
+ , defun "equals"
+ ### equal
+ <#> parameter pure "AST element" "elem1" ""
+ <#> parameter pure "AST element" "elem2" ""
+ =#> functionResult pushBool "boolean" "true iff elem1 == elem2"
+
+ , defun "make_sections"
+ ### liftPure3 Shared.makeSections
+ <#> parameter peekBool "boolean" "numbering" "add header numbers"
+ <#> parameter (\i -> (Nothing <$ peekNil i) <|> (Just <$!> peekIntegral i))
+ "integer or nil" "baselevel" ""
+ <#> parameter (peekList peekBlock) "list of blocks"
+ "blocks" "document blocks to process"
+ =#> functionResult pushBlocks "list of Blocks"
+ "processes blocks"
+
+ , defun "normalize_date"
+ ### liftPure Shared.normalizeDate
+ <#> parameter peekText "string" "date" "the date string"
+ =#> functionResult (maybe pushnil pushText) "string or nil"
+ "normalized date, or nil if normalization failed."
+ #? T.unwords
+ [ "Parse a date and convert (if possible) to \"YYYY-MM-DD\" format. We"
+ , "limit years to the range 1601-9999 (ISO 8601 accepts greater than"
+ , "or equal to 1583, but MS Word only accepts dates starting 1601)."
+ , "Returns nil instead of a string if the conversion failed."
+ ]
+
+ , sha1
+
+ , defun "Version"
+ ### liftPure (id @Version)
+ <#> parameter peekVersionFuzzy
+ "version string, list of integers, or integer"
+ "v" "version description"
+ =#> functionResult pushVersion "Version" "new Version object"
+ #? "Creates a Version object."
+
+ , defun "references"
+ ### (unPandocLua . getReferences Nothing)
+ <#> parameter peekPandoc "Pandoc" "doc" "document"
+ =#> functionResult (pushPandocList pushReference) "table"
+ "lift of references"
+ #? mconcat
+ [ "Get references defined inline in the metadata and via an external "
+ , "bibliography. Only references that are actually cited in the "
+ , "document (either with a genuine citation or with `nocite`) are "
+ , "returned. URL variables are converted to links."
+ ]
+
+ , defun "run_json_filter"
+ ### (\doc filterPath margs -> do
+ args <- case margs of
+ Just xs -> return xs
+ Nothing -> do
+ Lua.getglobal "FORMAT"
+ (forcePeek ((:[]) <$!> peekString top) <* pop 1)
+ JSONFilter.apply def args filterPath doc
+ )
+ <#> parameter peekPandoc "Pandoc" "doc" "input document"
+ <#> parameter peekString "filepath" "filter_path" "path to filter"
+ <#> optionalParameter (peekList peekString) "list of strings"
+ "args" "arguments to pass to the filter"
+ =#> functionResult pushPandoc "Pandoc" "filtered document"
+
+ , defun "stringify"
+ ### stringify
+ <#> parameter pure "AST element" "elem" "some pandoc AST element"
+ =#> functionResult pushText "string" "stringified element"
+
+ , defun "from_simple_table"
+ ### from_simple_table
+ <#> parameter peekSimpleTable "SimpleTable" "simple_tbl" ""
+ =?> "Simple table"
+
+ , defun "to_roman_numeral"
+ ### liftPure Shared.toRomanNumeral
+ <#> parameter (peekIntegral @Int) "integer" "n" "number smaller than 4000"
+ =#> functionResult pushText "string" "roman numeral"
+ #? "Converts a number < 4000 to uppercase roman numeral."
+
+ , defun "to_simple_table"
+ ### to_simple_table
+ <#> parameter peekTable "Block" "tbl" "a table"
+ =#> functionResult pushSimpleTable "SimpleTable" "SimpleTable object"
+ #? "Converts a table into an old/simple table."
+
+ , defun "type"
+ ### (\idx -> getmetafield idx "__name" >>= \case
+ TypeString -> fromMaybe mempty <$> tostring top
+ _ -> ltype idx >>= typename)
+ <#> parameter pure "any" "object" ""
+ =#> functionResult pushByteString "string" "type of the given value"
+ #? ("Pandoc-friendly version of Lua's default `type` function, " <>
+ "returning the type of a value. If the argument has a " <>
+ "string-valued metafield `__name`, then it gives that string. " <>
+ "Otherwise it behaves just like the normal `type` function.")
+ ]
+ }
+
+-- | 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.
-- Footnotes are skipped (since we don't want their contents in link
-- labels).
-stringify :: AstElement -> PandocLua T.Text
-stringify el = return $ case el of
- PandocElement pd -> Shared.stringify pd
- InlineElement i -> Shared.stringify i
- BlockElement b -> Shared.stringify b
- MetaElement m -> Shared.stringify m
- CitationElement c -> Shared.stringify c
- MetaValueElement m -> stringifyMetaValue m
- _ -> mempty
-
-stringifyMetaValue :: MetaValue -> T.Text
-stringifyMetaValue mv = case mv of
- MetaBool b -> T.toLower $ T.pack (show b)
- MetaString s -> s
- _ -> Shared.stringify mv
-
-equals :: AstElement -> AstElement -> PandocLua Bool
-equals e1 e2 = return (e1 == e2)
-
-data AstElement
- = PandocElement Pandoc
- | MetaElement Meta
- | BlockElement Block
- | InlineElement Inline
- | MetaValueElement MetaValue
- | AttrElement Attr
- | ListAttributesElement ListAttributes
- | CitationElement Citation
- deriving (Eq, Show)
-
-instance Peekable AstElement where
- peek idx = do
- res <- try $ (PandocElement <$> Lua.peek idx)
- <|> (InlineElement <$> Lua.peek idx)
- <|> (BlockElement <$> Lua.peek idx)
- <|> (AttrElement <$> Lua.peek idx)
- <|> (ListAttributesElement <$> Lua.peek idx)
- <|> (MetaElement <$> Lua.peek idx)
- <|> (MetaValueElement <$> Lua.peek idx)
- case res of
- Right x -> return x
- Left (_ :: PandocError) -> Lua.throwMessage
- "Expected an AST element, but could not parse value as such."
+stringify :: LuaError e => StackIndex -> LuaE e T.Text
+stringify idx = forcePeek . retrieving "stringifyable element" $
+ choice
+ [ (fmap Shared.stringify . peekPandoc)
+ , (fmap Shared.stringify . peekInline)
+ , (fmap Shared.stringify . peekBlock)
+ , (fmap Shared.stringify . peekCitation)
+ , (fmap stringifyMetaValue . peekMetaValue)
+ , (fmap (const "") . peekAttr)
+ , (fmap (const "") . peekListAttributes)
+ ] idx
+ where
+ stringifyMetaValue :: MetaValue -> T.Text
+ stringifyMetaValue mv = case mv of
+ MetaBool b -> T.toLower $ T.pack (show b)
+ MetaString s -> s
+ MetaList xs -> mconcat $ map stringifyMetaValue xs
+ MetaMap m -> mconcat $ map (stringifyMetaValue . snd) (Map.toList m)
+ _ -> Shared.stringify mv
-- | Converts an old/simple table into a normal table block element.
-from_simple_table :: SimpleTable -> Lua NumResults
+from_simple_table :: SimpleTable -> LuaE PandocError NumResults
from_simple_table (SimpleTable capt aligns widths head' body) = do
Lua.push $ Table
nullAttr
- (Caption Nothing [Plain capt])
+ (Caption Nothing [Plain capt | not (null capt)])
(zipWith (\a w -> (a, toColWidth w)) aligns widths)
(TableHead nullAttr [blockListToRow head' | not (null head') ])
- [TableBody nullAttr 0 [] $ map blockListToRow body]
+ [TableBody nullAttr 0 [] $ map blockListToRow body | not (null body)]
(TableFoot nullAttr [])
return (NumResults 1)
where
@@ -159,17 +212,19 @@ from_simple_table (SimpleTable capt aligns widths head' body) = do
toColWidth w = ColWidth w
-- | Converts a table into an old/simple table.
-to_simple_table :: Block -> Lua NumResults
+to_simple_table :: Block -> LuaE PandocError SimpleTable
to_simple_table = \case
Table _attr caption specs thead tbodies tfoot -> do
let (capt, aligns, widths, headers, rows) =
Shared.toLegacyTable caption specs thead tbodies tfoot
- pushSimpleTable $ SimpleTable capt aligns widths headers rows
- return (NumResults 1)
- blk ->
- Lua.throwMessage $
- "Expected Table, got " <> showConstr (toConstr blk) <> "."
-
--- | Convert a number < 4000 to uppercase roman numeral.
-toRomanNumeral :: Lua.Integer -> PandocLua T.Text
-toRomanNumeral = return . Shared.toRomanNumeral . fromIntegral
+ return $ SimpleTable capt aligns widths headers rows
+ blk -> Lua.failLua $ mconcat
+ [ "Expected Table, got ", showConstr (toConstr blk), "." ]
+
+peekTable :: LuaError e => Peeker e Block
+peekTable idx = peekBlock idx >>= \case
+ t@(Table {}) -> return t
+ b -> Lua.failPeek $ mconcat
+ [ "Expected Table, got "
+ , UTF8.fromString $ showConstr (toConstr b)
+ , "." ]