diff options
Diffstat (limited to 'pandoc-lua-engine/src/Text/Pandoc/Lua/Module')
6 files changed, 845 insertions, 0 deletions
diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/MediaBag.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/MediaBag.hs new file mode 100644 index 000000000..ca028f444 --- /dev/null +++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/MediaBag.hs @@ -0,0 +1,142 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{- | + Module : Text.Pandoc.Lua.Module.MediaBag + Copyright : Copyright © 2017-2022 Albert Krewinkel + License : GNU GPL, version 2 or above + Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> + +The Lua module @pandoc.mediabag@. +-} +module Text.Pandoc.Lua.Module.MediaBag + ( documentedModule + ) where + +import Prelude hiding (lookup) +import Data.Maybe (fromMaybe) +import HsLua ( LuaE, DocumentedFunction, Module (..) + , (<#>), (###), (=#>), (=?>), (#?), defun, functionResult + , opt, parameter, stringParam, textParam) +import Text.Pandoc.Class ( CommonState (..), fetchItem, fillMediaBag + , getMediaBag, modifyCommonState, setMediaBag) +import Text.Pandoc.Error (PandocError) +import Text.Pandoc.Lua.Marshal.Pandoc (peekPandoc, pushPandoc) +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 HsLua as Lua +import qualified Text.Pandoc.MediaBag as MB + +-- +-- MediaBag submodule +-- +documentedModule :: Module PandocError +documentedModule = Module + { moduleName = "pandoc.mediabag" + , moduleDescription = "mediabag access" + , moduleFields = [] + , moduleFunctions = + [ delete + , empty + , fetch + , fill + , insert + , items + , list + , lookup + ] + , moduleOperations = [] + } + +-- | Delete a single item from the media bag. +delete :: DocumentedFunction PandocError +delete = defun "delete" + ### (\fp -> unPandocLua $ modifyCommonState + (\st -> st { stMediaBag = MB.deleteMedia fp (stMediaBag st) })) + <#> stringParam "filepath" "filename of item to delete" + =#> [] + + +-- | Delete all items from the media bag. +empty :: DocumentedFunction PandocError +empty = defun "empty" + ### unPandocLua (modifyCommonState (\st -> st { stMediaBag = mempty })) + =#> [] + +-- | Fill the mediabag with all images in the document that aren't +-- present yet. +fill :: DocumentedFunction PandocError +fill = defun "fill" + ### unPandocLua . fillMediaBag + <#> parameter peekPandoc "Pandoc" "doc" + "document from which to fill the mediabag" + =#> functionResult pushPandoc "Pandoc" "modified document" + #? ("Fills the mediabag with the images in the given document.\n" <> + "An image that cannot be retrieved will be replaced with a Span\n" <> + "of class \"image\" that contains the image description.\n" <> + "" <> + "Images for which the mediabag already contains an item will\n" <> + "not be processed again.") + +-- | Insert a new item into the media bag. +insert :: DocumentedFunction PandocError +insert = defun "insert" + ### (\fp mmime contents -> unPandocLua $ do + mb <- getMediaBag + setMediaBag $ MB.insertMedia fp mmime contents mb + return (Lua.NumResults 0)) + <#> stringParam "filepath" "item file path" + <#> opt (textParam "mimetype" "the item's MIME type") + <#> parameter Lua.peekLazyByteString "string" "contents" "binary contents" + =#> [] + +-- | Returns iterator values to be used with a Lua @for@ loop. +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" + +-- | 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) + <#> stringParam "filepath" "path of item to lookup" + =?> "MIME type and contents" + +-- | Function listing all mediabag items. +list :: DocumentedFunction PandocError +list = defun "list" + ### (unPandocLua (MB.mediaDirectory <$> getMediaBag)) + =#> functionResult (pushPandocList pushEntry) "table" "list of entry triples" + where + pushEntry :: (FilePath, MimeType, Int) -> LuaE PandocError () + pushEntry (fp, mimeType, contentLength) = do + Lua.newtable + 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) + +-- | 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) + <#> textParam "src" "URI to fetch" + =?> "Returns two string values: the fetched contents and the mimetype." diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Pandoc.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Pandoc.hs new file mode 100644 index 000000000..e708f4345 --- /dev/null +++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -0,0 +1,320 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{- | + Module : Text.Pandoc.Lua.Module.Pandoc + Copyright : Copyright © 2017-2022 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> + Stability : alpha + +Pandoc module for lua. +-} +module Text.Pandoc.Lua.Module.Pandoc + ( pushModule + , documentedModule + ) where + +import Prelude hiding (read) +import Control.Applicative ((<|>)) +import Control.Monad (forM_, when) +import Control.Monad.Catch (catch, throwM) +import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr) +import Data.Default (Default (..)) +import Data.Maybe (fromMaybe) +import Data.Proxy (Proxy (Proxy)) +import HsLua hiding (pushModule) +import System.Exit (ExitCode (..)) +import Text.Pandoc.Definition +import Text.Pandoc.Error (PandocError (..)) +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.Marshal.Sources (peekSources) +import Text.Pandoc.Lua.Marshal.WriterOptions ( peekWriterOptions + , pushWriterOptions) +import Text.Pandoc.Lua.Module.Utils (sha1) +import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua), liftPandocLua) +import Text.Pandoc.Options ( ReaderOptions (readerExtensions) + , WriterOptions (writerExtensions) ) +import Text.Pandoc.Process (pipeProcess) +import Text.Pandoc.Readers (Reader (..), getReader, readers) +import Text.Pandoc.Sources (toSources) +import Text.Pandoc.Writers (Writer (..), getWriter, writers) + +import qualified HsLua as Lua +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Char8 as BSL +import qualified Data.Set as Set +import qualified Data.Text as T +import qualified Text.Pandoc.UTF8 as UTF8 + +-- | Push the "pandoc" package to the Lua stack. Requires the `List` +-- module to be loadable. +pushModule :: PandocLua NumResults +pushModule = do + liftPandocLua $ Lua.pushModule documentedModule + 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 = readersField : writersField : + stringConstants ++ [inlineField, blockField] + , moduleOperations = [] + , moduleFunctions = mconcat + [ functions + , otherConstructors + , blockConstructors + , inlineConstructors + , metaValueConstructors + ] + } + +-- | Set of input formats accepted by @read@. +readersField :: Field PandocError +readersField = Field + { fieldName = "readers" + , fieldDescription = T.unlines + [ "Set of formats that pandoc can parse. All keys in this table can" + , "be used as the `format` value in `pandoc.read`." + ] + , fieldPushValue = pushSet pushText $ + Set.fromList (map fst (readers @PandocLua)) + } + +-- | Set of input formats accepted by @write@. +writersField :: Field PandocError +writersField = Field + { fieldName = "writers" + , fieldDescription = T.unlines + [ "Set of formats that pandoc can generate. All keys in this table" + , "can be used as the `format` value in `pandoc.write`." + ] + , fieldPushValue = pushSet pushText $ + Set.fromList (map fst (writers @PandocLua)) + } + +-- | 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." + + , defun "WriterOptions" + ### liftPure id + <#> parameter peekWriterOptions "WriterOptions|table" "opts" + "writer options" + =#> functionResult pushWriterOptions "WriterOptions" "new object" + #? "Creates a new WriterOptions 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 + readerOpts = fromMaybe def mreaderOptions + readAction = getReader formatSpec >>= \case + (TextReader r, es) -> + r readerOpts{readerExtensions = es} + (case content of + Left bs -> toSources $ UTF8.toText bs + Right sources -> sources) + (ByteStringReader r, es) -> + case content of + Left bs -> r readerOpts{readerExtensions = es} + (BSL.fromStrict bs) + Right _ -> liftPandocLua $ Lua.failLua + "Cannot use bytestring reader with Sources" + try (unPandocLua readAction) >>= \case + Right pd -> + -- success, got a Pandoc document + return pd + 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 (\idx -> (Left <$> peekByteString idx) + <|> (Right <$> peekSources idx)) + "string|Sources" "content" "text to parse" + <#> opt (textParam "formatspec" "format and extensions") + <#> opt (parameter 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" + + , defun "write" + ### (\doc mformatspec mwriterOpts -> do + let formatSpec = fromMaybe "html" mformatspec + writerOpts = fromMaybe def mwriterOpts + unPandocLua $ getWriter formatSpec >>= \case + (TextWriter w, es) -> Right <$> + w writerOpts{ writerExtensions = es } doc + (ByteStringWriter w, es) -> Left <$> + w writerOpts{ writerExtensions = es } doc) + <#> parameter peekPandoc "Pandoc" "doc" "document to convert" + <#> opt (textParam "formatspec" "format and extensions") + <#> opt (parameter peekWriterOptions "WriterOptions" "writer_options" + "writer options") + =#> functionResult (either pushLazyByteString pushText) "string" + "result document" + ] + where + walkElement x f = + walkInlineSplicing f x + >>= walkInlinesStraight f + >>= walkBlockSplicing f + >>= walkBlocksStraight f + +data PipeError = PipeError + { pipeErrorCommand :: T.Text + , pipeErrorCode :: Int + , pipeErrorOutput :: BL.ByteString + } + +peekPipeError :: LuaError 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 :: LuaError e => Pusher e PipeError +pushPipeError pipeErr = do + pushAsTable [ ("command" , pushText . pipeErrorCommand) + , ("error_code" , pushIntegral . pipeErrorCode) + , ("output" , pushLazyByteString . pipeErrorOutput) + ] pipeErr + pushPipeErrorMetaTable + Lua.setmetatable (nth 2) + where + pushPipeErrorMetaTable :: LuaError e => LuaE e () + pushPipeErrorMetaTable = do + v <- Lua.newmetatable "pandoc pipe error" + when v $ do + pushName "__tostring" + pushHaskellFunction pipeErrorMessage + rawset (nth 3) + + pipeErrorMessage :: LuaError 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 " + , BSL.pack $ show errorCode + , BSL.pack "): " + , if output == mempty then BSL.pack "<no output>" else output + ] + return (NumResults 1) diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/System.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/System.hs new file mode 100644 index 000000000..70ef1b315 --- /dev/null +++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/System.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{- | + Module : Text.Pandoc.Lua.Module.System + Copyright : © 2019-2022 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> + Stability : alpha + +Pandoc's system Lua module. +-} +module Text.Pandoc.Lua.Module.System + ( documentedModule + ) where + +import HsLua +import HsLua.Module.System + (arch, env, getwd, ls, mkdir, os, rmdir, with_env, with_tmpdir, with_wd) + +-- | Push the pandoc.system module on the Lua stack. +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 "list_directory" ls + , setName "make_directory" mkdir + , setName "remove_directory" rmdir + , setName "with_environment" with_env + , setName "with_temporary_directory" with_tmpdir + , setName "with_working_directory" with_wd + ] + , moduleOperations = [] + } diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Template.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Template.hs new file mode 100644 index 000000000..967fe31a8 --- /dev/null +++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Template.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE OverloadedStrings #-} +{- | + Module : Text.Pandoc.Lua.Module.Template + Copyright : Copyright © 2022 Albert Krewinkel, John MacFarlane + License : GNU GPL, version 2 or above + Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> + +Lua module to handle pandoc templates. +-} +module Text.Pandoc.Lua.Module.Template + ( documentedModule + ) where + +import HsLua +import Text.Pandoc.Error (PandocError) +import Text.Pandoc.Lua.Marshal.Template (pushTemplate) +import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua), liftPandocLua) +import Text.Pandoc.Templates + (compileTemplate, getDefaultTemplate, runWithPartials, runWithDefaultPartials) + +import qualified Data.Text as T + +-- | The "pandoc.template" module. +documentedModule :: Module PandocError +documentedModule = Module + { moduleName = "pandoc.template" + , moduleDescription = T.unlines + [ "Lua functions for pandoc templates." + ] + , moduleFields = [] + , moduleOperations = [] + , moduleFunctions = functions + } + +-- | Template module functions. +functions :: [DocumentedFunction PandocError] +functions = + [ defun "compile" + ### (\template mfilepath -> unPandocLua $ + case mfilepath of + Just fp -> runWithPartials (compileTemplate fp template) + Nothing -> runWithDefaultPartials + (compileTemplate "templates/default" template)) + <#> parameter peekText "string" "template" "template string" + <#> opt (stringParam "templ_path" "template path") + =#> functionResult (either failLua pushTemplate) "pandoc Template" + "compiled template" + + , defun "default" + ### (\mformat -> unPandocLua $ do + let getFORMAT = liftPandocLua $ do + getglobal "FORMAT" + forcePeek $ peekText top `lastly` pop 1 + format <- maybe getFORMAT pure mformat + getDefaultTemplate format) + <#> opt (textParam "writer" + "writer for which the template should be returned.") + =#> functionResult pushText "string" + "string representation of the writer's default template" + + ] diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Types.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Types.hs new file mode 100644 index 000000000..b8d45d93e --- /dev/null +++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Types.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} +{- | + Module : Text.Pandoc.Lua.Module.Types + Copyright : © 2019-2022 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> + Stability : alpha + +Pandoc data type constructors. +-} +module Text.Pandoc.Lua.Module.Types + ( documentedModule + ) where + +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/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Utils.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Utils.hs new file mode 100644 index 000000000..33349870c --- /dev/null +++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Utils.hs @@ -0,0 +1,239 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{- | + Module : Text.Pandoc.Lua.Module.Utils + Copyright : Copyright © 2017-2022 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> + Stability : alpha + +Utility module for Lua, exposing internal helper functions. +-} +module Text.Pandoc.Lua.Module.Utils + ( documentedModule + , sha1 + ) where + +import Control.Applicative ((<|>)) +import Control.Monad ((<$!>)) +import Data.Data (showConstr, toConstr) +import Data.Default (def) +import Data.Maybe (fromMaybe) +import Data.Version (Version) +import HsLua as Lua +import HsLua.Module.Version (peekVersionFuzzy, pushVersion) +import Text.Pandoc.Citeproc (getReferences, processCitations) +import Text.Pandoc.Definition +import Text.Pandoc.Error (PandocError) +import Text.Pandoc.Filter (applyJSONFilter) +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 Text.Pandoc.Builder as B +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. +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" "" + <#> opt (parameter (peekList peekInline) "list of inlines" "inline" "") + =#> functionResult pushInlines "list of inlines" "" + + , defun "citeproc" + ### unPandocLua . processCitations + <#> parameter peekPandoc "Pandoc" "doc" "document" + =#> functionResult pushPandoc "Pandoc" "processed document" + #? T.unwords + [ "Process the citations in the file, replacing them with " + , "rendered citations and adding a bibliography. " + , "See the manual section on citation rendering for details." + ] + + , 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) + applyJSONFilter def args filterPath doc + ) + <#> parameter peekPandoc "Pandoc" "doc" "input document" + <#> parameter peekString "filepath" "filter_path" "path to filter" + <#> opt (parameter (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 :: 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 -> LuaE PandocError NumResults +from_simple_table (SimpleTable capt aligns widths head' body) = do + Lua.push $ Table + nullAttr + (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 | not (null body)] + (TableFoot nullAttr []) + return (NumResults 1) + where + blockListToRow :: [[Block]] -> Row + blockListToRow = Row nullAttr . map (B.simpleCell . B.fromList) + + toColWidth :: Double -> ColWidth + toColWidth 0 = ColWidthDefault + toColWidth w = ColWidth w + +-- | Converts a table into an old/simple table. +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 + 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) + , "." ] |