diff options
| author | Albert Krewinkel <[email protected]> | 2022-09-29 17:24:31 +0200 |
|---|---|---|
| committer | John MacFarlane <[email protected]> | 2022-09-30 08:33:40 -0700 |
| commit | 5be9052f5fb7283372b3d5497bef499718a34992 (patch) | |
| tree | 80e5805786ef7ab08f363135861e1aa9c8868f6f /src/Text | |
| parent | 79980eee4a1854921d7fb8b14848894b53cc21a7 (diff) | |
[API Change] Extract Lua code into new package pandoc-lua-engine
The flag 'lua53` must now be used with that package if pandoc is to be
compiled against Lua 5.3.
Diffstat (limited to 'src/Text')
24 files changed, 0 insertions, 2595 deletions
diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs deleted file mode 100644 index d6134fc01..000000000 --- a/src/Text/Pandoc/Lua.hs +++ /dev/null @@ -1,52 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} -{- | - Module : Text.Pandoc.Lua - Copyright : Copyright © 2017-2022 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel <[email protected]> - Stability : alpha - -Running pandoc Lua filters. --} -module Text.Pandoc.Lua - ( -- * High-level functions - applyFilter - , readCustom - , writeCustom - -- * Low-level functions - , Global(..) - , setGlobals - , runLua - , runLuaNoEnv - -- * Engine - , getEngine - ) where - -import Control.Monad.IO.Class (MonadIO (liftIO)) -import HsLua.Core (getglobal, openlibs, run, top, tostring) -import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.Filter (applyFilter) -import Text.Pandoc.Lua.Global (Global (..), setGlobals) -import Text.Pandoc.Lua.Init (runLua, runLuaNoEnv) -import Text.Pandoc.Lua.Reader (readCustom) -import Text.Pandoc.Lua.Writer (writeCustom) -import Text.Pandoc.Lua.Orphans () -import Text.Pandoc.Scripting (ScriptingEngine (..)) -import qualified Text.Pandoc.UTF8 as UTF8 - --- | Constructs the Lua scripting engine. -getEngine :: MonadIO m => m ScriptingEngine -getEngine = do - versionName <- liftIO . run @PandocError $ do - openlibs - getglobal "_VERSION" - tostring top - pure $ ScriptingEngine - { engineName = maybe "Lua (unknown version)" UTF8.toText versionName - , engineApplyFilter = applyFilter - , engineReadCustom = readCustom - , engineWriteCustom = writeCustom - } diff --git a/src/Text/Pandoc/Lua/ErrorConversion.hs b/src/Text/Pandoc/Lua/ErrorConversion.hs deleted file mode 100644 index 3968eba84..000000000 --- a/src/Text/Pandoc/Lua/ErrorConversion.hs +++ /dev/null @@ -1,40 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- | - Module : Text.Pandoc.Lua.ErrorConversion - Copyright : © 2020-2022 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel <[email protected]> - Stability : alpha - -Define how Lua errors are converted into @'PandocError'@ Haskell -exceptions, and /vice versa/. --} -module Text.Pandoc.Lua.ErrorConversion - ( addContextToException - ) where - -import HsLua (LuaError, LuaE, resultToEither, runPeek, top) -import Text.Pandoc.Error (PandocError (PandocLuaError)) -import Text.Pandoc.Lua.Marshal.PandocError (pushPandocError, peekPandocError) - -import qualified Data.Text as T -import qualified HsLua as Lua - -addContextToException :: () -addContextToException = undefined - --- | Retrieve a @'PandocError'@ from the Lua stack. -popPandocError :: LuaE PandocError PandocError -popPandocError = do - errResult <- runPeek $ peekPandocError top - case resultToEither errResult of - Right x -> return x - Left err -> return $ PandocLuaError (T.pack err) - --- Ensure conversions between Lua errors and 'PandocError' exceptions --- are possible. -instance LuaError PandocError where - popException = popPandocError - pushException = pushPandocError - luaException = PandocLuaError . T.pack diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs deleted file mode 100644 index c019095f8..000000000 --- a/src/Text/Pandoc/Lua/Filter.hs +++ /dev/null @@ -1,81 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE IncoherentInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{- | -Module : Text.Pandoc.Lua.Filter -Copyright : © 2012-2022 John MacFarlane, - © 2017-2022 Albert Krewinkel -License : GNU GPL, version 2 or above -Maintainer : Albert Krewinkel <[email protected]> -Stability : alpha - -Types and functions for running Lua filters. --} -module Text.Pandoc.Lua.Filter - ( applyFilter - ) where -import Control.Monad ((>=>), (<$!>)) -import HsLua as Lua -import Text.Pandoc.Definition -import Text.Pandoc.Filter (Environment (..)) -import Text.Pandoc.Lua.ErrorConversion () -import Text.Pandoc.Lua.Marshal.AST -import Text.Pandoc.Lua.Marshal.Filter -import Text.Pandoc.Lua.Global (Global (..), setGlobals) -import Text.Pandoc.Lua.Init (runLua) -import Control.Exception (throw) -import qualified Data.Text as T -import Text.Pandoc.Class (PandocMonad) -import Control.Monad.Trans (MonadIO) -import Text.Pandoc.Error (PandocError (PandocFilterError, PandocLuaError)) - --- | Transform document using the filter defined in the given file. -runFilterFile :: FilePath -> Pandoc -> LuaE PandocError Pandoc -runFilterFile filterPath doc = do - oldtop <- gettop - stat <- dofileTrace filterPath - if stat /= Lua.OK - then throwErrorAsException - else do - newtop <- gettop - -- Use the returned filters, or the implicitly defined global - -- filter if nothing was returned. - luaFilters <- forcePeek $ - if newtop - oldtop >= 1 - then peekList peekFilter top - else (:[]) <$!> (liftLua pushglobaltable *> peekFilter top) - settop oldtop - runAll luaFilters doc - -runAll :: [Filter] -> Pandoc -> LuaE PandocError Pandoc -runAll = foldr ((>=>) . applyFully) return - --- | Run the Lua filter in @filterPath@ for a transformation to the --- target format (first element in args). Pandoc uses Lua init files to --- setup the Lua interpreter. -applyFilter :: (PandocMonad m, MonadIO m) - => Environment - -> [String] - -> FilePath - -> Pandoc - -> m Pandoc -applyFilter fenv args fp doc = do - let globals = [ FORMAT $ case args of - x:_ -> T.pack x - _ -> "" - , PANDOC_READER_OPTIONS (envReaderOptions fenv) - , PANDOC_WRITER_OPTIONS (envWriterOptions fenv) - , PANDOC_SCRIPT_FILE fp - ] - runLua >=> forceResult fp $ do - setGlobals globals - runFilterFile fp doc - -forceResult :: (PandocMonad m, MonadIO m) - => FilePath -> Either PandocError Pandoc -> m Pandoc -forceResult fp eitherResult = case eitherResult of - Right x -> return x - Left err -> throw . PandocFilterError (T.pack fp) $ case err of - PandocLuaError msg -> msg - _ -> T.pack $ show err diff --git a/src/Text/Pandoc/Lua/Global.hs b/src/Text/Pandoc/Lua/Global.hs deleted file mode 100644 index 702ba7bd5..000000000 --- a/src/Text/Pandoc/Lua/Global.hs +++ /dev/null @@ -1,74 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{- | - Module : Text.Pandoc.Lua - Copyright : Copyright © 2017-2022 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel <[email protected]> - Stability : alpha - -Pandoc's Lua globals. --} -module Text.Pandoc.Lua.Global - ( Global (..) - , setGlobals - ) where - -import HsLua as Lua -import HsLua.Module.Version (pushVersion) -import Text.Pandoc.Class (CommonState) -import Text.Pandoc.Definition (Pandoc, pandocTypesVersion) -import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.Marshal.CommonState (pushCommonState) -import Text.Pandoc.Lua.Marshal.Pandoc (pushPandoc) -import Text.Pandoc.Lua.Marshal.ReaderOptions (pushReaderOptionsReadonly) -import Text.Pandoc.Lua.Marshal.WriterOptions (pushWriterOptions) -import Text.Pandoc.Lua.Orphans () -import Text.Pandoc.Options (ReaderOptions, WriterOptions) -import Text.Pandoc.Shared (pandocVersion) - -import qualified Data.Text as Text - --- | Permissible global Lua variables. -data Global = - FORMAT Text.Text - | PANDOC_API_VERSION - | PANDOC_DOCUMENT Pandoc - | PANDOC_READER_OPTIONS ReaderOptions - | PANDOC_WRITER_OPTIONS WriterOptions - | PANDOC_SCRIPT_FILE FilePath - | PANDOC_STATE CommonState - | PANDOC_VERSION - -- Cannot derive instance of Data because of CommonState - --- | Set all given globals. -setGlobals :: [Global] -> LuaE PandocError () -setGlobals = mapM_ setGlobal - -setGlobal :: Global -> LuaE PandocError () -setGlobal global = case global of - -- This could be simplified if Global was an instance of Data. - FORMAT format -> do - Lua.pushText format - Lua.setglobal "FORMAT" - PANDOC_API_VERSION -> do - pushVersion pandocTypesVersion - Lua.setglobal "PANDOC_API_VERSION" - PANDOC_DOCUMENT doc -> do - pushPandoc doc - Lua.setglobal "PANDOC_DOCUMENT" - PANDOC_READER_OPTIONS ropts -> do - pushReaderOptionsReadonly ropts - Lua.setglobal "PANDOC_READER_OPTIONS" - PANDOC_WRITER_OPTIONS wopts -> do - pushWriterOptions wopts - Lua.setglobal "PANDOC_WRITER_OPTIONS" - PANDOC_SCRIPT_FILE filePath -> do - Lua.pushString filePath - Lua.setglobal "PANDOC_SCRIPT_FILE" - PANDOC_STATE commonState -> do - pushCommonState commonState - Lua.setglobal "PANDOC_STATE" - PANDOC_VERSION -> do - pushVersion pandocVersion - Lua.setglobal "PANDOC_VERSION" diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs deleted file mode 100644 index caa490d52..000000000 --- a/src/Text/Pandoc/Lua/Init.hs +++ /dev/null @@ -1,167 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{- | - Module : Text.Pandoc.Lua - Copyright : Copyright © 2017-2022 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel <[email protected]> - Stability : alpha - -Functions to initialize the Lua interpreter. --} -module Text.Pandoc.Lua.Init - ( runLua - , runLuaNoEnv - ) where - -import Control.Monad (forM, forM_, when) -import Control.Monad.Catch (throwM, try) -import Control.Monad.Trans (MonadIO (..)) -import Data.Maybe (catMaybes) -import HsLua as Lua hiding (status, try) -import Text.Pandoc.Class (PandocMonad, readDataFile) -import Text.Pandoc.Error (PandocError (PandocLuaError)) -import Text.Pandoc.Lua.Marshal.List (newListMetatable, pushListModule) -import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, runPandocLua) -import qualified Data.ByteString.Char8 as Char8 -import qualified Data.Text as T -import qualified Lua.LPeg as LPeg -import qualified HsLua.Aeson -import qualified HsLua.Module.DocLayout as Module.Layout -import qualified HsLua.Module.Path as Module.Path -import qualified HsLua.Module.Text as Module.Text -import qualified Text.Pandoc.Lua.Module.Pandoc as Module.Pandoc -import qualified Text.Pandoc.Lua.Module.MediaBag as Pandoc.MediaBag -import qualified Text.Pandoc.Lua.Module.System as Pandoc.System -import qualified Text.Pandoc.Lua.Module.Template as Pandoc.Template -import qualified Text.Pandoc.Lua.Module.Types as Pandoc.Types -import qualified Text.Pandoc.Lua.Module.Utils as Pandoc.Utils - --- | Run the lua interpreter, using pandoc's default way of environment --- initialization. -runLua :: (PandocMonad m, MonadIO m) - => LuaE PandocError a -> m (Either PandocError a) -runLua action = - runPandocLua . try $ do - initLuaState - liftPandocLua action - --- | Like 'runLua', but ignores all environment variables like @LUA_PATH@. -runLuaNoEnv :: (PandocMonad m, MonadIO m) - => LuaE PandocError a -> m (Either PandocError a) -runLuaNoEnv action = - runPandocLua . try $ do - liftPandocLua $ do - -- This is undocumented, but works -- the code is adapted from the - -- `lua.c` sources for the default interpreter. - Lua.pushboolean True - Lua.setfield Lua.registryindex "LUA_NOENV" - initLuaState - liftPandocLua action - --- | Modules that are loaded at startup and assigned to fields in the --- pandoc module. --- --- Note that @pandoc.List@ is not included here for technical reasons; --- it must be handled separately. -loadedModules :: [Module PandocError] -loadedModules = - [ Pandoc.MediaBag.documentedModule - , Pandoc.System.documentedModule - , Pandoc.Template.documentedModule - , Pandoc.Types.documentedModule - , Pandoc.Utils.documentedModule - , Module.Layout.documentedModule { moduleName = "pandoc.layout" } - , Module.Path.documentedModule { moduleName = "pandoc.path" } - , Module.Text.documentedModule - ] - --- | Initialize the lua state with all required values -initLuaState :: PandocLua () -initLuaState = do - liftPandocLua Lua.openlibs - initJsonMetatable - initPandocModule - installLpegSearcher - setGlobalModules - loadInitScript "init.lua" - where - initPandocModule :: PandocLua () - initPandocModule = liftPandocLua $ do - -- Push module table - registerModule Module.Pandoc.documentedModule - -- load modules and add them to the `pandoc` module table. - forM_ loadedModules $ \mdl -> do - registerModule mdl - let fieldname (Name mdlname) = Name . - maybe mdlname snd . Char8.uncons . snd $ - Char8.break (== '.') mdlname - Lua.setfield (nth 2) (fieldname $ moduleName mdl) - -- pandoc.List is low-level and must be opened differently. - requirehs "pandoc.List" (const pushListModule) - setfield (nth 2) "List" - -- assign module to global variable - Lua.setglobal "pandoc" - - loadInitScript :: FilePath -> PandocLua () - loadInitScript scriptFile = do - script <- readDataFile scriptFile - status <- liftPandocLua $ Lua.dostring script - when (status /= Lua.OK) . liftPandocLua $ do - err <- popException - let prefix = "Couldn't load '" <> T.pack scriptFile <> "':\n" - throwM . PandocLuaError . (prefix <>) $ case err of - PandocLuaError msg -> msg - _ -> T.pack $ show err - - setGlobalModules :: PandocLua () - setGlobalModules = liftPandocLua $ do - let globalModules = - [ ("lpeg", LPeg.luaopen_lpeg_ptr) -- must be loaded first - , ("re", LPeg.luaopen_re_ptr) -- re depends on lpeg - ] - loadedBuiltInModules <- fmap catMaybes . forM globalModules $ - \(pkgname, luaopen) -> do - Lua.pushcfunction luaopen - usedBuiltIn <- Lua.pcall 0 1 Nothing >>= \case - OK -> do -- all good, loading succeeded - -- register as loaded module so later modules can rely on this - Lua.getfield Lua.registryindex Lua.loaded - Lua.pushvalue (Lua.nth 2) - Lua.setfield (Lua.nth 2) pkgname - Lua.pop 1 -- pop _LOADED - return True - _ -> do -- built-in library failed, load system lib - Lua.pop 1 -- ignore error message - -- Try loading via the normal package loading mechanism. - Lua.getglobal "require" - Lua.pushName pkgname - Lua.call 1 1 -- Throws an exception if loading failed again! - return False - - -- Module on top of stack. Register as global - Lua.setglobal pkgname - return $ if usedBuiltIn then Just pkgname else Nothing - - -- Remove module entry from _LOADED table in registry if we used a - -- built-in library. This ensures that later calls to @require@ will - -- prefer the shared library, if any. - forM_ loadedBuiltInModules $ \pkgname -> do - Lua.getfield Lua.registryindex Lua.loaded - Lua.pushnil - Lua.setfield (Lua.nth 2) pkgname - Lua.pop 1 -- registry - - installLpegSearcher :: PandocLua () - installLpegSearcher = liftPandocLua $ do - Lua.getglobal' "package.searchers" - Lua.pushHaskellFunction $ Lua.state >>= liftIO . LPeg.lpeg_searcher - Lua.rawseti (Lua.nth 2) . (+1) . fromIntegral =<< Lua.rawlen (Lua.nth 2) - Lua.pop 1 -- remove 'package.searchers' from stack - --- | Setup the metatable that's assigned to Lua tables that were created --- from/via JSON arrays. -initJsonMetatable :: PandocLua () -initJsonMetatable = liftPandocLua $ do - newListMetatable HsLua.Aeson.jsonarray (pure ()) diff --git a/src/Text/Pandoc/Lua/Marshal/CommonState.hs b/src/Text/Pandoc/Lua/Marshal/CommonState.hs deleted file mode 100644 index 74ce69887..000000000 --- a/src/Text/Pandoc/Lua/Marshal/CommonState.hs +++ /dev/null @@ -1,68 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{- | - Module : Text.Pandoc.Lua.Marshal.CommonState - Copyright : © 2012-2022 John MacFarlane - © 2017-2022 Albert Krewinkel - License : GNU GPL, version 2 or above - Maintainer : Albert Krewinkel <[email protected]> - Stability : alpha - -Instances to marshal (push) and unmarshal (peek) the common state. --} -module Text.Pandoc.Lua.Marshal.CommonState - ( typeCommonState - , peekCommonState - , pushCommonState - ) where - -import HsLua -import Text.Pandoc.Class (CommonState (..)) -import Text.Pandoc.Logging (LogMessage, showLogMessage) -import Text.Pandoc.Lua.Marshal.List (pushPandocList) - --- | Lua type used for the @CommonState@ object. -typeCommonState :: LuaError e => DocumentedType e CommonState -typeCommonState = deftype "pandoc CommonState" [] - [ readonly "input_files" "input files passed to pandoc" - (pushPandocList pushString, stInputFiles) - - , readonly "output_file" "the file to which pandoc will write" - (maybe pushnil pushString, stOutputFile) - - , readonly "log" "list of log messages" - (pushPandocList (pushUD typeLogMessage), stLog) - - , readonly "request_headers" "headers to add for HTTP requests" - (pushPandocList (pushPair pushText pushText), stRequestHeaders) - - , readonly "resource_path" - "path to search for resources like included images" - (pushPandocList pushString, stResourcePath) - - , readonly "source_url" "absolute URL + dir of 1st source file" - (maybe pushnil pushText, stSourceURL) - - , readonly "user_data_dir" "directory to search for data files" - (maybe pushnil pushString, stUserDataDir) - - , readonly "trace" "controls whether tracing messages are issued" - (pushBool, stTrace) - - , readonly "verbosity" "verbosity level" - (pushString . show, stVerbosity) - ] - -peekCommonState :: LuaError e => Peeker e CommonState -peekCommonState = peekUD typeCommonState - -pushCommonState :: LuaError e => Pusher e CommonState -pushCommonState = pushUD typeCommonState - -typeLogMessage :: LuaError e => DocumentedType e LogMessage -typeLogMessage = deftype "pandoc LogMessage" - [ operation Index $ defun "__tostring" - ### liftPure showLogMessage - <#> udparam typeLogMessage "msg" "object" - =#> functionResult pushText "string" "stringified log message" - ] - mempty -- no members diff --git a/src/Text/Pandoc/Lua/Marshal/Context.hs b/src/Text/Pandoc/Lua/Marshal/Context.hs deleted file mode 100644 index 126f3a82d..000000000 --- a/src/Text/Pandoc/Lua/Marshal/Context.hs +++ /dev/null @@ -1,28 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.Context - Copyright : © 2012-2022 John MacFarlane - © 2017-2022 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel <[email protected]> - Stability : alpha - -Marshaling instance for doctemplates Context and its components. --} -module Text.Pandoc.Lua.Marshal.Context () where - -import qualified HsLua as Lua -import HsLua (Pushable) -import Text.DocTemplates (Context(..), Val(..), TemplateTarget) -import Text.DocLayout (render) - -instance (TemplateTarget a, Pushable a) => Pushable (Context a) where - push (Context m) = Lua.push m - -instance (TemplateTarget a, Pushable a) => Pushable (Val a) where - push NullVal = Lua.push () - push (BoolVal b) = Lua.push b - push (MapVal ctx) = Lua.push ctx - push (ListVal xs) = Lua.push xs - push (SimpleVal d) = Lua.push $ render Nothing d diff --git a/src/Text/Pandoc/Lua/Marshal/PandocError.hs b/src/Text/Pandoc/Lua/Marshal/PandocError.hs deleted file mode 100644 index 7f83f2fc0..000000000 --- a/src/Text/Pandoc/Lua/Marshal/PandocError.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{- | - Module : Text.Pandoc.Lua.Marshal.PandocError - Copyright : © 2020-2022 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel <[email protected]> - Stability : alpha - -Marshal of @'PandocError'@ values. --} -module Text.Pandoc.Lua.Marshal.PandocError - ( peekPandocError - , pushPandocError - , typePandocError - ) - where - -import HsLua (LuaError, Peeker, Pusher, liftLua, pushString) -import HsLua.Packaging -import Text.Pandoc.Error (PandocError (PandocLuaError)) - -import qualified HsLua as Lua -import qualified Text.Pandoc.UTF8 as UTF8 - --- | Lua userdata type definition for PandocError. -typePandocError :: LuaError e => DocumentedType e PandocError -typePandocError = deftype "PandocError" - [ operation Tostring $ defun "__tostring" - ### liftPure (show @PandocError) - <#> udparam typePandocError "obj" "PandocError object" - =#> functionResult pushString "string" "string representation of error." - ] - mempty -- no members - --- | Peek a @'PandocError'@ element to the Lua stack. -pushPandocError :: LuaError e => Pusher e PandocError -pushPandocError = pushUD typePandocError - --- | Retrieve a @'PandocError'@ from the Lua stack. -peekPandocError :: LuaError e => Peeker e PandocError -peekPandocError idx = Lua.retrieving "PandocError" $ - liftLua (Lua.ltype idx) >>= \case - Lua.TypeUserdata -> peekUD typePandocError idx - _ -> do - msg <- liftLua $ Lua.state >>= \l -> Lua.liftIO (Lua.popErrorMessage l) - return $ PandocLuaError (UTF8.toText msg) diff --git a/src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs b/src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs deleted file mode 100644 index bec7d81bf..000000000 --- a/src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs +++ /dev/null @@ -1,137 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.ReaderOptions - Copyright : © 2012-2022 John MacFarlane - © 2017-2022 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel <[email protected]> - Stability : alpha - -Marshaling instance for ReaderOptions and its components. --} -module Text.Pandoc.Lua.Marshal.ReaderOptions - ( peekReaderOptions - , pushReaderOptions - , pushReaderOptionsReadonly - ) where - -import Data.Default (def) -import HsLua as Lua -#if !MIN_VERSION_hslua(2,2,0) -import HsLua.Aeson (peekViaJSON, pushViaJSON) -#endif -import Text.Pandoc.Lua.Marshal.List (pushPandocList) -import Text.Pandoc.Options (ReaderOptions (..)) - --- --- Reader Options --- - --- | Retrieve a ReaderOptions value, either from a normal ReaderOptions --- value, from a read-only object, or from a table with the same --- keys as a ReaderOptions object. -peekReaderOptions :: LuaError e => Peeker e ReaderOptions -peekReaderOptions = retrieving "ReaderOptions" . \idx -> - liftLua (ltype idx) >>= \case - TypeUserdata -> choice [ peekUD typeReaderOptions - , peekUD typeReaderOptionsReadonly - ] - idx - TypeTable -> peekReaderOptionsTable idx - _ -> failPeek =<< - typeMismatchMessage "ReaderOptions userdata or table" idx - --- | Pushes a ReaderOptions value as userdata object. -pushReaderOptions :: LuaError e => Pusher e ReaderOptions -pushReaderOptions = pushUD typeReaderOptions - --- | Pushes a ReaderOptions object, but makes it read-only. -pushReaderOptionsReadonly :: LuaError e => Pusher e ReaderOptions -pushReaderOptionsReadonly = pushUD typeReaderOptionsReadonly - --- | ReaderOptions object type for read-only values. -typeReaderOptionsReadonly :: LuaError e => DocumentedType e ReaderOptions -typeReaderOptionsReadonly = deftype "ReaderOptions (read-only)" - [ operation Tostring $ lambda - ### liftPure show - <#> udparam typeReaderOptions "opts" "options to print in native format" - =#> functionResult pushString "string" "Haskell representation" - , operation Newindex $ lambda - ### (failLua "This ReaderOptions value is read-only.") - =?> "Throws an error when called, i.e., an assignment is made." - ] - readerOptionsMembers - --- | 'ReaderOptions' object type. -typeReaderOptions :: LuaError e => DocumentedType e ReaderOptions -typeReaderOptions = deftype "ReaderOptions" - [ operation Tostring $ lambda - ### liftPure show - <#> udparam typeReaderOptions "opts" "options to print in native format" - =#> functionResult pushString "string" "Haskell representation" - ] - readerOptionsMembers - --- | Member properties of 'ReaderOptions' Lua values. -readerOptionsMembers :: LuaError e - => [Member e (DocumentedFunction e) ReaderOptions] -readerOptionsMembers = - [ property "abbreviations" "" - (pushSet pushText, readerAbbreviations) - (peekSet peekText, \opts x -> opts{ readerAbbreviations = x }) - , property "columns" "" - (pushIntegral, readerColumns) - (peekIntegral, \opts x -> opts{ readerColumns = x }) - , property "default_image_extension" "" - (pushText, readerDefaultImageExtension) - (peekText, \opts x -> opts{ readerDefaultImageExtension = x }) - , property "extensions" "" - (pushViaJSON, readerExtensions) - (peekViaJSON, \opts x -> opts{ readerExtensions = x }) - , property "indented_code_classes" "" - (pushPandocList pushText, readerIndentedCodeClasses) - (peekList peekText, \opts x -> opts{ readerIndentedCodeClasses = x }) - , property "standalone" "" - (pushBool, readerStandalone) - (peekBool, \opts x -> opts{ readerStandalone = x }) - , property "strip_comments" "" - (pushBool, readerStripComments) - (peekBool, \opts x -> opts{ readerStripComments = x }) - , property "tab_stop" "" - (pushIntegral, readerTabStop) - (peekIntegral, \opts x -> opts{ readerTabStop = x }) - , property "track_changes" "" - (pushViaJSON, readerTrackChanges) - (choice [peekRead, peekViaJSON], \opts x -> opts{ readerTrackChanges = x }) - ] - --- | Retrieves a 'ReaderOptions' object from a table on the stack, using --- the default values for all missing fields. --- --- Internally, this pushes the default reader options, sets each --- key/value pair of the table in the userdata value, then retrieves the --- object again. This will update all fields and complain about unknown --- keys. -peekReaderOptionsTable :: LuaError e => Peeker e ReaderOptions -peekReaderOptionsTable idx = retrieving "ReaderOptions (table)" $ do - liftLua $ do - absidx <- absindex idx - pushUD typeReaderOptions def - let setFields = do - next absidx >>= \case - False -> return () -- all fields were copied - True -> do - pushvalue (nth 2) *> insert (nth 2) - settable (nth 4) -- set in userdata object - setFields - pushnil -- first key - setFields - peekUD typeReaderOptions top `lastly` pop 1 - -instance Pushable ReaderOptions where - push = pushReaderOptions diff --git a/src/Text/Pandoc/Lua/Marshal/Reference.hs b/src/Text/Pandoc/Lua/Marshal/Reference.hs deleted file mode 100644 index c23bfef9f..000000000 --- a/src/Text/Pandoc/Lua/Marshal/Reference.hs +++ /dev/null @@ -1,96 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.ReaderOptions - Copyright : © 2012-2022 John MacFarlane - © 2017-2022 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel <[email protected]> - Stability : alpha - -Marshal citeproc 'Reference' values. --} -module Text.Pandoc.Lua.Marshal.Reference - ( pushReference - ) where - -import Citeproc.Types - ( Date (..), DateParts (..), ItemId (..), Name (..), Reference (..) - , Val (..), Variable, fromVariable - ) -import Control.Monad (forM_) -import HsLua hiding (Name, Reference, pushName, peekName) -import Text.Pandoc.Builder (Inlines, toList) -import Text.Pandoc.Lua.Marshal.Inline (pushInlines) -import Text.Pandoc.Lua.Marshal.List (pushPandocList) - -import qualified Data.Map as Map - --- | Pushes a ReaderOptions value as userdata object. -pushReference :: LuaError e => Pusher e (Reference Inlines) -pushReference reference = do - pushAsTable [ ("id", pushItemId . referenceId) - , ("type", pushText . referenceType) - ] - reference - forM_ (Map.toList $ referenceVariables reference) $ \(var, val) -> do - pushVariable var - pushVal val - rawset (nth 3) - --- | Pushes an 'ItemId' as a string. -pushItemId :: Pusher e ItemId -pushItemId = pushText . unItemId - --- | Pushes a person's 'Name' as a table. -pushName :: LuaError e => Pusher e Name -pushName = pushAsTable - [ ("family" , pushTextOrNil . nameFamily) - , ("given" , pushTextOrNil . nameGiven) - , ("dropping-particle" , pushTextOrNil . nameDroppingParticle) - , ("non-dropping-particle" , pushTextOrNil . nameNonDroppingParticle) - , ("suffix" , pushTextOrNil . nameSuffix) - , ("literal" , pushTextOrNil . nameLiteral) - , ("comma-suffix" , pushBoolOrNil . nameCommaSuffix) - , ("static-ordering" , pushBoolOrNil . nameStaticOrdering) - ] - where - pushTextOrNil = \case - Nothing -> pushnil - Just xs -> pushText xs - --- | Pushes a boolean, but uses @nil@ instead of @false@; table fields --- are not set unless the value is true. -pushBoolOrNil :: Pusher e Bool -pushBoolOrNil = \case - False -> pushnil - True -> pushBool True - --- | Pushes a 'Variable' as string. -pushVariable :: Pusher e Variable -pushVariable = pushText . fromVariable - --- | Pushes a 'Val', i.e., a variable value. -pushVal :: LuaError e => Pusher e (Val Inlines) -pushVal = \case - TextVal t -> pushText t - FancyVal inlns -> pushInlines $ toList inlns - NumVal i -> pushIntegral i - NamesVal names -> pushPandocList pushName names - DateVal date -> pushDate date - _ -> pushText mempty - --- | Pushes a 'Date' as table. -pushDate :: LuaError e => Pusher e Date -pushDate = pushAsTable - [ ("date-parts", pushPandocList pushDateParts . dateParts) - , ("circa", pushBoolOrNil . dateCirca) - , ("season", maybe pushnil pushIntegral . dateSeason) - , ("literal", maybe pushnil pushText . dateLiteral) - ] - where - -- date parts are lists of Int values - pushDateParts (DateParts dp) = pushPandocList pushIntegral dp diff --git a/src/Text/Pandoc/Lua/Marshal/Sources.hs b/src/Text/Pandoc/Lua/Marshal/Sources.hs deleted file mode 100644 index 3b3b58329..000000000 --- a/src/Text/Pandoc/Lua/Marshal/Sources.hs +++ /dev/null @@ -1,56 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- | -Module : Text.Pandoc.Lua.Marshaling.Sources -Copyright : © 2021-2022 Albert Krewinkel -License : GNU GPL, version 2 or above -Maintainer : Albert Krewinkel <[email protected]> - -Marshal 'Sources'. --} -module Text.Pandoc.Lua.Marshal.Sources - ( peekSources - , pushSources - ) where - -import Control.Monad ((<$!>)) -import Data.Text (Text) -import HsLua as Lua -import Text.Pandoc.Lua.Marshal.List (newListMetatable) -import Text.Pandoc.Sources (Sources (..), toSources) -import Text.Parsec (SourcePos, sourceName) - --- | Pushes the 'Sources' as a list of lazy Lua objects. -pushSources :: LuaError e => Pusher e Sources -pushSources (Sources srcs) = do - pushList (pushUD typeSource) srcs - newListMetatable "pandoc Sources" $ do - pushName "__tostring" - pushHaskellFunction $ do - sources <- forcePeek $ peekList (peekUD typeSource) (nthBottom 1) - pushText . mconcat $ map snd sources - return 1 - rawset (nth 3) - setmetatable (nth 2) - --- | Retrieves sources from the stack. -peekSources :: LuaError e => Peeker e Sources -peekSources idx = liftLua (ltype idx) >>= \case - TypeString -> toSources <$!> peekText idx - TypeTable -> Sources <$!> peekList (peekUD typeSource) idx - _ -> Sources . (:[]) <$!> peekUD typeSource idx - --- | Source object type. -typeSource :: LuaError e => DocumentedType e (SourcePos, Text) -typeSource = deftype "pandoc input source" - [ operation Tostring $ lambda - ### liftPure snd - <#> udparam typeSource "srcs" "Source to print in native format" - =#> functionResult pushText "string" "Haskell representation" - ] - [ readonly "name" "source name" - (pushString, sourceName . fst) - , readonly "text" "source text" - (pushText, snd) - ] diff --git a/src/Text/Pandoc/Lua/Marshal/Template.hs b/src/Text/Pandoc/Lua/Marshal/Template.hs deleted file mode 100644 index 56878b109..000000000 --- a/src/Text/Pandoc/Lua/Marshal/Template.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- | -Module : Text.Pandoc.Lua.Marshal.Template -Copyright : © 2021-2022 Albert Krewinkel -License : GNU GPL, version 2 or above -Maintainer : Albert Krewinkel <[email protected]> - -Marshal 'Template' 'Text'. --} -module Text.Pandoc.Lua.Marshal.Template - ( pushTemplate - , peekTemplate - , typeTemplate - ) where - -import Data.Text (Text) -import HsLua as Lua -import Text.DocTemplates (Template) - --- | Pushes a 'Template' as a an opaque userdata value. -pushTemplate :: LuaError e => Pusher e (Template Text) -pushTemplate = pushUD typeTemplate - --- | Retrieves a 'Template' 'Text' value from the stack. -peekTemplate :: LuaError e => Peeker e (Template Text) -peekTemplate = peekUD typeTemplate - --- | Template object type. -typeTemplate :: LuaError e => DocumentedType e (Template Text) -typeTemplate = deftype "pandoc Template" [] [] diff --git a/src/Text/Pandoc/Lua/Marshal/WriterOptions.hs b/src/Text/Pandoc/Lua/Marshal/WriterOptions.hs deleted file mode 100644 index 86df682c5..000000000 --- a/src/Text/Pandoc/Lua/Marshal/WriterOptions.hs +++ /dev/null @@ -1,244 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.WriterOptions - Copyright : © 2021-2022 Albert Krewinkel, John MacFarlane - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel <[email protected]> - Stability : alpha - -Marshaling instance for WriterOptions and its components. --} -module Text.Pandoc.Lua.Marshal.WriterOptions - ( peekWriterOptions - , pushWriterOptions - ) where - -import Control.Applicative (optional) -import Data.Default (def) -import HsLua as Lua -#if !MIN_VERSION_hslua(2,2,0) -import HsLua.Aeson (peekViaJSON, pushViaJSON) -#endif -import Text.Pandoc.Lua.Marshal.List (pushPandocList) -import Text.Pandoc.Lua.Marshal.Template (peekTemplate, pushTemplate) -import Text.Pandoc.Options (WriterOptions (..)) - --- --- Writer Options --- - --- | Retrieve a WriterOptions value, either from a normal WriterOptions --- value, from a read-only object, or from a table with the same --- keys as a WriterOptions object. -peekWriterOptions :: LuaError e => Peeker e WriterOptions -peekWriterOptions = retrieving "WriterOptions" . \idx -> - liftLua (ltype idx) >>= \case - TypeUserdata -> peekUD typeWriterOptions idx - TypeTable -> peekWriterOptionsTable idx - _ -> failPeek =<< - typeMismatchMessage "WriterOptions userdata or table" idx - --- | Pushes a WriterOptions value as userdata object. -pushWriterOptions :: LuaError e => Pusher e WriterOptions -pushWriterOptions = pushUD typeWriterOptions - --- | 'WriterOptions' object type. -typeWriterOptions :: LuaError e => DocumentedType e WriterOptions -typeWriterOptions = deftype "WriterOptions" - [ operation Tostring $ lambda - ### liftPure show - <#> udparam typeWriterOptions "opts" "options to print in native format" - =#> functionResult pushString "string" "Haskell representation" - ] - [ property "cite_method" - "How to print cites" - (pushViaJSON, writerCiteMethod) - (peekViaJSON, \opts x -> opts{ writerCiteMethod = x }) - - , property "columns" - "Characters in a line (for text wrapping)" - (pushIntegral, writerColumns) - (peekIntegral, \opts x -> opts{ writerColumns = x }) - - , property "dpi" - "DPI for pixel to/from inch/cm conversions" - (pushIntegral, writerDpi) - (peekIntegral, \opts x -> opts{ writerDpi = x }) - - , property "email_obfuscation" - "How to obfuscate emails" - (pushViaJSON, writerEmailObfuscation) - (peekViaJSON, \opts x -> opts{ writerEmailObfuscation = x }) - - , property "epub_chapter_level" - "Header level for chapters (separate files)" - (pushIntegral, writerEpubChapterLevel) - (peekIntegral, \opts x -> opts{ writerEpubChapterLevel = x }) - - , property "epub_fonts" - "Paths to fonts to embed" - (pushPandocList pushString, writerEpubFonts) - (peekList peekString, \opts x -> opts{ writerEpubFonts = x }) - - , property "epub_metadata" - "Metadata to include in EPUB" - (maybe pushnil pushText, writerEpubMetadata) - (optional . peekText, \opts x -> opts{ writerEpubMetadata = x }) - - , property "epub_subdirectory" - "Subdir for epub in OCF" - (pushText, writerEpubSubdirectory) - (peekText, \opts x -> opts{ writerEpubSubdirectory = x }) - - , property "extensions" - "Markdown extensions that can be used" - (pushViaJSON, writerExtensions) - (peekViaJSON, \opts x -> opts{ writerExtensions = x }) - - , property "highlight_style" - "Style to use for highlighting (nil = no highlighting)" - (maybe pushnil pushViaJSON, writerHighlightStyle) - (optional . peekViaJSON, \opts x -> opts{ writerHighlightStyle = x }) - - , property "html_math_method" - "How to print math in HTML" - (pushViaJSON, writerHTMLMathMethod) - (peekViaJSON, \opts x -> opts{ writerHTMLMathMethod = x }) - - , property "html_q_tags" - "Use @<q>@ tags for quotes in HTML" - (pushBool, writerHtmlQTags) - (peekBool, \opts x -> opts{ writerHtmlQTags = x }) - - , property "identifier_prefix" - "Prefix for section & note ids in HTML and for footnote marks in markdown" - (pushText, writerIdentifierPrefix) - (peekText, \opts x -> opts{ writerIdentifierPrefix = x }) - - , property "incremental" - "True if lists should be incremental" - (pushBool, writerIncremental) - (peekBool, \opts x -> opts{ writerIncremental = x }) - - , property "listings" - "Use listings package for code" - (pushBool, writerListings) - (peekBool, \opts x -> opts{ writerListings = x }) - - , property "number_offset" - "Starting number for section, subsection, ..." - (pushPandocList pushIntegral, writerNumberOffset) - (peekList peekIntegral, \opts x -> opts{ writerNumberOffset = x }) - - , property "number_sections" - "Number sections in LaTeX" - (pushBool, writerNumberSections) - (peekBool, \opts x -> opts{ writerNumberSections = x }) - - , property "prefer_ascii" - "Prefer ASCII representations of characters when possible" - (pushBool, writerPreferAscii) - (peekBool, \opts x -> opts{ writerPreferAscii = x }) - - , property "reference_doc" - "Path to reference document if specified" - (maybe pushnil pushString, writerReferenceDoc) - (optional . peekString, \opts x -> opts{ writerReferenceDoc = x }) - - , property "reference_links" - "Use reference links in writing markdown, rst" - (pushBool, writerReferenceLinks) - (peekBool, \opts x -> opts{ writerReferenceLinks = x }) - - , property "reference_location" - "Location of footnotes and references for writing markdown" - (pushViaJSON, writerReferenceLocation) - (peekViaJSON, \opts x -> opts{ writerReferenceLocation = x }) - - , property "section_divs" - "Put sections in div tags in HTML" - (pushBool, writerSectionDivs) - (peekBool, \opts x -> opts{ writerSectionDivs = x }) - - , property "setext_headers" - "Use setext headers for levels 1-2 in markdown" - (pushBool, writerSetextHeaders) - (peekBool, \opts x -> opts{ writerSetextHeaders = x }) - - , property "slide_level" - "Force header level of slides" - (maybe pushnil pushIntegral, writerSlideLevel) - (optional . peekIntegral, \opts x -> opts{ writerSlideLevel = x }) - - -- , property "syntax_map" "Syntax highlighting definition" - -- (pushViaJSON, writerSyntaxMap) - -- (peekViaJSON, \opts x -> opts{ writerSyntaxMap = x }) - -- :: SyntaxMap - - , property "tab_stop" - "Tabstop for conversion btw spaces and tabs" - (pushIntegral, writerTabStop) - (peekIntegral, \opts x -> opts{ writerTabStop = x }) - - , property "table_of_contents" - "Include table of contents" - (pushBool, writerTableOfContents) - (peekBool, \opts x -> opts{ writerTableOfContents = x }) - - , property "template" - "Template to use" - (maybe pushnil pushTemplate, writerTemplate) - (optional . peekTemplate, \opts x -> opts{ writerTemplate = x }) - -- :: Maybe (Template Text) - - , property "toc_depth" - "Number of levels to include in TOC" - (pushIntegral, writerTOCDepth) - (peekIntegral, \opts x -> opts{ writerTOCDepth = x }) - - , property "top_level_division" - "Type of top-level divisions" - (pushViaJSON, writerTopLevelDivision) - (peekViaJSON, \opts x -> opts{ writerTopLevelDivision = x }) - - , property "variables" - "Variables to set in template" - (pushViaJSON, writerVariables) - (peekViaJSON, \opts x -> opts{ writerVariables = x }) - - , property "wrap_text" - "Option for wrapping text" - (pushViaJSON, writerWrapText) - (peekViaJSON, \opts x -> opts{ writerWrapText = x }) - ] - --- | Retrieves a 'WriterOptions' object from a table on the stack, using --- the default values for all missing fields. --- --- Internally, this pushes the default writer options, sets each --- key/value pair of the table in the userdata value, then retrieves the --- object again. This will update all fields and complain about unknown --- keys. -peekWriterOptionsTable :: LuaError e => Peeker e WriterOptions -peekWriterOptionsTable idx = retrieving "WriterOptions (table)" $ do - liftLua $ do - absidx <- absindex idx - pushUD typeWriterOptions def - let setFields = do - next absidx >>= \case - False -> return () -- all fields were copied - True -> do - pushvalue (nth 2) *> insert (nth 2) - settable (nth 4) -- set in userdata object - setFields - pushnil -- first key - setFields - peekUD typeWriterOptions top `lastly` pop 1 - -instance Pushable WriterOptions where - push = pushWriterOptions diff --git a/src/Text/Pandoc/Lua/Module/MediaBag.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs deleted file mode 100644 index ca028f444..000000000 --- a/src/Text/Pandoc/Lua/Module/MediaBag.hs +++ /dev/null @@ -1,142 +0,0 @@ -{-# 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 <[email protected]> - -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/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs deleted file mode 100644 index e708f4345..000000000 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ /dev/null @@ -1,320 +0,0 @@ -{-# 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 <[email protected]> - 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/src/Text/Pandoc/Lua/Module/System.hs b/src/Text/Pandoc/Lua/Module/System.hs deleted file mode 100644 index 70ef1b315..000000000 --- a/src/Text/Pandoc/Lua/Module/System.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# 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 <[email protected]> - 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/src/Text/Pandoc/Lua/Module/Template.hs b/src/Text/Pandoc/Lua/Module/Template.hs deleted file mode 100644 index 967fe31a8..000000000 --- a/src/Text/Pandoc/Lua/Module/Template.hs +++ /dev/null @@ -1,61 +0,0 @@ -{-# 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 <[email protected]> - -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/src/Text/Pandoc/Lua/Module/Types.hs b/src/Text/Pandoc/Lua/Module/Types.hs deleted file mode 100644 index b8d45d93e..000000000 --- a/src/Text/Pandoc/Lua/Module/Types.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{- | - Module : Text.Pandoc.Lua.Module.Types - Copyright : © 2019-2022 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel <[email protected]> - 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/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs deleted file mode 100644 index 33349870c..000000000 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ /dev/null @@ -1,239 +0,0 @@ -{-# 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 <[email protected]> - 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) - , "." ] diff --git a/src/Text/Pandoc/Lua/Orphans.hs b/src/Text/Pandoc/Lua/Orphans.hs deleted file mode 100644 index 62b54d051..000000000 --- a/src/Text/Pandoc/Lua/Orphans.hs +++ /dev/null @@ -1,116 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE FlexibleInstances #-} -{- | - Module : Text.Pandoc.Lua.Orphans - Copyright : © 2012-2022 John MacFarlane - © 2017-2022 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel <[email protected]> - Stability : alpha - -Orphan instances for Lua's Pushable and Peekable type classes. --} -module Text.Pandoc.Lua.Orphans () where - -import Data.Version (Version) -import HsLua -import HsLua.Module.Version (peekVersionFuzzy) -import Text.Pandoc.Definition -import Text.Pandoc.Lua.Marshal.AST -import Text.Pandoc.Lua.Marshal.CommonState () -import Text.Pandoc.Lua.Marshal.Context () -import Text.Pandoc.Lua.Marshal.PandocError() -import Text.Pandoc.Lua.Marshal.ReaderOptions () -import Text.Pandoc.Lua.Marshal.Sources (pushSources) -import Text.Pandoc.Lua.ErrorConversion () -import Text.Pandoc.Sources (Sources) - -instance Pushable Pandoc where - push = pushPandoc - -instance Pushable Meta where - push = pushMeta - -instance Pushable MetaValue where - push = pushMetaValue - -instance Pushable Block where - push = pushBlock - -instance {-# OVERLAPPING #-} Pushable [Block] where - push = pushBlocks - -instance Pushable Alignment where - push = pushString . show - -instance Pushable CitationMode where - push = pushCitationMode - -instance Pushable Format where - push = pushFormat - -instance Pushable ListNumberDelim where - push = pushString . show - -instance Pushable ListNumberStyle where - push = pushString . show - -instance Pushable MathType where - push = pushMathType - -instance Pushable QuoteType where - push = pushQuoteType - -instance Pushable Cell where - push = pushCell - -instance Pushable Inline where - push = pushInline - -instance {-# OVERLAPPING #-} Pushable [Inline] where - push = pushInlines - -instance Pushable Citation where - push = pushCitation - -instance Pushable Row where - push = pushRow - -instance Pushable TableBody where - push = pushTableBody - -instance Pushable TableFoot where - push = pushTableFoot - -instance Pushable TableHead where - push = pushTableHead - --- These instances exist only for testing. It's a hack to avoid making --- the marshalling modules public. -instance Peekable Inline where - safepeek = peekInline - -instance Peekable Block where - safepeek = peekBlock - -instance Peekable Cell where - safepeek = peekCell - -instance Peekable Meta where - safepeek = peekMeta - -instance Peekable Pandoc where - safepeek = peekPandoc - -instance Peekable Row where - safepeek = peekRow - -instance Peekable Version where - safepeek = peekVersionFuzzy - -instance {-# OVERLAPPING #-} Peekable Attr where - safepeek = peekAttr - -instance Pushable Sources where - push = pushSources diff --git a/src/Text/Pandoc/Lua/PandocLua.hs b/src/Text/Pandoc/Lua/PandocLua.hs deleted file mode 100644 index e07a91d61..000000000 --- a/src/Text/Pandoc/Lua/PandocLua.hs +++ /dev/null @@ -1,113 +0,0 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- | - Module : Text.Pandoc.Lua.PandocLua - Copyright : Copyright © 2020-2022 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel <[email protected]> - Stability : alpha - -PandocMonad instance which allows execution of Lua operations and which -uses Lua to handle state. --} -module Text.Pandoc.Lua.PandocLua - ( PandocLua (..) - , runPandocLua - , liftPandocLua - ) where - -import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow) -import Control.Monad.Except (MonadError (catchError, throwError)) -import Control.Monad.IO.Class (MonadIO) -import HsLua as Lua -import Text.Pandoc.Class (PandocMonad (..)) -import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.Global (Global (..), setGlobals) -import Text.Pandoc.Lua.Marshal.CommonState (peekCommonState) - -import qualified Control.Monad.Catch as Catch -import qualified Text.Pandoc.Class.IO as IO - --- | Type providing access to both, pandoc and Lua operations. -newtype PandocLua a = PandocLua { unPandocLua :: LuaE PandocError a } - deriving - ( Applicative - , Functor - , Monad - , MonadCatch - , MonadIO - , MonadMask - , MonadThrow - ) - --- | Lift a @'Lua'@ operation into the @'PandocLua'@ type. -liftPandocLua :: LuaE PandocError a -> PandocLua a -liftPandocLua = PandocLua - --- | Evaluate a @'PandocLua'@ computation, running all contained Lua --- operations.. -runPandocLua :: (PandocMonad m, MonadIO m) => PandocLua a -> m a -runPandocLua pLua = do - origState <- getCommonState - globals <- defaultGlobals - (result, newState) <- liftIO . Lua.run . unPandocLua $ do - putCommonState origState - liftPandocLua $ setGlobals globals - r <- pLua - c <- getCommonState - return (r, c) - putCommonState newState - return result - -instance {-# OVERLAPPING #-} Exposable PandocError (PandocLua NumResults) where - partialApply _narg = liftLua . unPandocLua - -instance Pushable a => Exposable PandocError (PandocLua a) where - partialApply _narg x = 1 <$ (liftLua (unPandocLua x >>= Lua.push)) - --- | Global variables which should always be set. -defaultGlobals :: PandocMonad m => m [Global] -defaultGlobals = do - commonState <- getCommonState - return - [ PANDOC_API_VERSION - , PANDOC_STATE commonState - , PANDOC_VERSION - ] - -instance MonadError PandocError PandocLua where - catchError = Catch.catch - throwError = Catch.throwM - -instance PandocMonad PandocLua where - lookupEnv = IO.lookupEnv - getCurrentTime = IO.getCurrentTime - getCurrentTimeZone = IO.getCurrentTimeZone - newStdGen = IO.newStdGen - newUniqueHash = IO.newUniqueHash - - openURL = IO.openURL - - readFileLazy = IO.readFileLazy - readFileStrict = IO.readFileStrict - readStdinStrict = IO.readStdinStrict - - glob = IO.glob - fileExists = IO.fileExists - getDataFileName = IO.getDataFileName - getModificationTime = IO.getModificationTime - - getCommonState = PandocLua $ do - Lua.getglobal "PANDOC_STATE" - forcePeek $ peekCommonState Lua.top - putCommonState = PandocLua . setGlobals . (:[]) . PANDOC_STATE - - logOutput = IO.logOutput diff --git a/src/Text/Pandoc/Lua/Reader.hs b/src/Text/Pandoc/Lua/Reader.hs deleted file mode 100644 index 6303dace3..000000000 --- a/src/Text/Pandoc/Lua/Reader.hs +++ /dev/null @@ -1,84 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{- | - Module : Text.Pandoc.Lua.Reader - Copyright : Copyright (C) 2021-2022 John MacFarlane - License : GNU GPL, version 2 or above - - Maintainer : John MacFarlane <[email protected]> - Stability : alpha - Portability : portable - -Supports custom parsers written in Lua which produce a Pandoc AST. --} -module Text.Pandoc.Lua.Reader ( readCustom ) where -import Control.Exception -import Control.Monad (when) -import Control.Monad.IO.Class (MonadIO) -import Data.Maybe (fromMaybe) -import HsLua as Lua hiding (Operation (Div)) -import Text.Pandoc.Definition -import Text.Pandoc.Class (PandocMonad, findFileWithDataFallback, report) -import Text.Pandoc.Logging -import Text.Pandoc.Lua.Global (Global (..), setGlobals) -import Text.Pandoc.Lua.Init (runLua) -import Text.Pandoc.Lua.PandocLua -import Text.Pandoc.Lua.Marshal.Pandoc (peekPandoc) -import Text.Pandoc.Options -import Text.Pandoc.Sources (ToSources(..), sourcesToText) -import qualified Data.Text as T - --- | Convert custom markup to Pandoc. -readCustom :: (PandocMonad m, MonadIO m, ToSources s) - => FilePath -> ReaderOptions -> s -> m Pandoc -readCustom luaFile opts srcs = do - let globals = [ PANDOC_SCRIPT_FILE luaFile ] - luaFile' <- fromMaybe luaFile <$> findFileWithDataFallback "readers" luaFile - res <- runLua $ do - setGlobals globals - stat <- dofileTrace luaFile' - -- check for error in lua script (later we'll change the return type - -- to handle this more gracefully): - when (stat /= Lua.OK) - Lua.throwErrorAsException - parseCustom - case res of - Left msg -> throw msg - Right doc -> return doc - where - parseCustom = do - let input = toSources srcs - getglobal "Reader" - push input - push opts - pcallTrace 2 1 >>= \case - OK -> forcePeek $ peekPandoc top - ErrRun -> do - -- Caught a runtime error. Check if parsing might work if we - -- pass a string instead of a Sources list, then retry. - runPeek (peekText top) >>= \case - Failure {} -> - -- not a string error object. Bail! - throwErrorAsException - Success errmsg -> do - if "string expected, got pandoc Sources" `T.isInfixOf` errmsg - then do - pop 1 - _ <- unPandocLua $ do - report $ Deprecated "old Reader function signature" $ - T.unlines - [ "Reader functions should accept a sources list; " - , "functions expecting `string` input are deprecated. " - , "Use `tostring` to convert the first argument to a " - , "string." - ] - getglobal "Reader" - push $ sourcesToText input -- push sources as string - push opts - callTrace 2 1 - forcePeek $ peekPandoc top - else - -- nothing we can do here - throwErrorAsException - _ -> -- not a runtime error, we won't be able to recover from that - throwErrorAsException diff --git a/src/Text/Pandoc/Lua/Writer.hs b/src/Text/Pandoc/Lua/Writer.hs deleted file mode 100644 index f216ea63b..000000000 --- a/src/Text/Pandoc/Lua/Writer.hs +++ /dev/null @@ -1,63 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{- | - Module : Text.Pandoc.Lua.Writer - Copyright : Copyright (C) 2012-2022 John MacFarlane - License : GNU GPL, version 2 or above - - Maintainer : John MacFarlane <[email protected]> - Stability : alpha - Portability : portable - -Conversion of Pandoc documents using a custom Lua writer. --} -module Text.Pandoc.Lua.Writer - ( writeCustom - ) where - -import Control.Exception -import Control.Monad ((<=<)) -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import HsLua -import Control.Monad.IO.Class (MonadIO) -import Text.Pandoc.Class (PandocMonad, findFileWithDataFallback) -import Text.Pandoc.Definition (Pandoc (..)) -import Text.Pandoc.Lua.Global (Global (..), setGlobals) -import Text.Pandoc.Lua.Init (runLua) -import Text.Pandoc.Options (WriterOptions) -import qualified Text.Pandoc.Lua.Writer.Classic as Classic - --- | Convert Pandoc to custom markup. -writeCustom :: (PandocMonad m, MonadIO m) - => FilePath -> WriterOptions -> Pandoc -> m Text -writeCustom luaFile opts doc = do - luaFile' <- fromMaybe luaFile <$> findFileWithDataFallback "writers" luaFile - either throw pure <=< runLua $ do - setGlobals [ PANDOC_DOCUMENT doc - , PANDOC_SCRIPT_FILE luaFile' - , PANDOC_WRITER_OPTIONS opts - ] - dofileTrace luaFile' >>= \case - OK -> pure () - _ -> throwErrorAsException - -- Most classic writers contain code that throws an error if a global - -- is not present. This would break our check for the existence of a - -- "Writer" function. We resort to raw access for that reason, but - -- could also catch the error instead. - let rawgetglobal x = do - pushglobaltable - pushName x - rawget (nth 2) <* remove (nth 2) -- remove global table - - rawgetglobal "Writer" >>= \case - TypeNil -> do - pop 1 -- remove nil - Classic.runCustom opts doc - _ -> do - -- Writer on top of the stack. Call it with document and writer - -- options as arguments. - push doc - push opts - callTrace 2 1 - forcePeek $ peekText top diff --git a/src/Text/Pandoc/Lua/Writer/Classic.hs b/src/Text/Pandoc/Lua/Writer/Classic.hs deleted file mode 100644 index 522bdb651..000000000 --- a/src/Text/Pandoc/Lua/Writer/Classic.hs +++ /dev/null @@ -1,250 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{- | - Module : Text.Pandoc.Lua.Writer.Classic - Copyright : Copyright (C) 2012-2022 John MacFarlane - License : GNU GPL, version 2 or above - - Maintainer : John MacFarlane <[email protected]> - Stability : alpha - Portability : portable - -Conversion of Pandoc documents using a \"classic\" custom Lua writer. --} -module Text.Pandoc.Lua.Writer.Classic - ( runCustom - ) where -import Control.Applicative (optional) -import Control.Arrow ((***)) -import Data.List (intersperse) -import Data.Maybe (fromMaybe) -import qualified Data.Text as T -import Data.Text (Text, pack) -import HsLua as Lua hiding (Operation (Div)) -#if !MIN_VERSION_hslua(2,2,0) -import HsLua.Aeson (peekViaJSON) -#endif -import Text.DocLayout (literal, render) -import Text.DocTemplates (Context) -import Text.Pandoc.Definition -import Text.Pandoc.Lua.Marshal.Attr (pushAttributeList) -import Text.Pandoc.Lua.Orphans () -import Text.Pandoc.Options -import Text.Pandoc.Templates (renderTemplate) -import Text.Pandoc.Writers.Shared - --- | List of key-value pairs that is pushed to Lua as AttributeList --- userdata. -newtype AttributeList = AttributeList [(Text, Text)] -instance Pushable AttributeList where - push (AttributeList kvs) = pushAttributeList kvs - -attrToMap :: Attr -> AttributeList -attrToMap (id',classes,keyvals) = AttributeList - $ ("id", id') - : ("class", T.unwords classes) - : keyvals - -newtype Stringify a = Stringify a - -instance Pushable (Stringify Format) where - push (Stringify (Format f)) = Lua.push (T.toLower f) - -instance Pushable (Stringify [Inline]) where - push (Stringify ils) = Lua.push =<< inlineListToCustom ils - -instance Pushable (Stringify [Block]) where - push (Stringify blks) = Lua.push =<< blockListToCustom blks - -instance Pushable (Stringify MetaValue) where - push (Stringify (MetaMap m)) = Lua.push (fmap Stringify m) - push (Stringify (MetaList xs)) = Lua.push (map Stringify xs) - push (Stringify (MetaBool x)) = Lua.push x - push (Stringify (MetaString s)) = Lua.push s - push (Stringify (MetaInlines ils)) = Lua.push (Stringify ils) - push (Stringify (MetaBlocks bs)) = Lua.push (Stringify bs) - -instance Pushable (Stringify Citation) where - push (Stringify cit) = flip pushAsTable cit - [ ("citationId", push . citationId) - , ("citationPrefix", push . Stringify . citationPrefix) - , ("citationSuffix", push . Stringify . citationSuffix) - , ("citationMode", push . citationMode) - , ("citationNoteNum", push . citationNoteNum) - , ("citationHash", push . citationHash) - ] - --- | Key-value pair, pushed as a table with @a@ as the only key and @v@ as the --- associated value. -newtype KeyValue a b = KeyValue (a, b) - -instance (Pushable a, Pushable b) => Pushable (KeyValue a b) where - push (KeyValue (k, v)) = do - Lua.newtable - Lua.push k - Lua.push v - Lua.rawset (Lua.nth 3) - --- | Convert Pandoc to custom markup using a classic Lua writer. -runCustom :: LuaError e - => WriterOptions - -> Pandoc - -> LuaE e Text -runCustom opts doc@(Pandoc meta _) = do - (body, context) <- docToCustom opts doc - -- convert metavalues to a template context (variables) - metaContext <- metaToContext opts - (fmap (literal . pack) . blockListToCustom) - (fmap (literal . pack) . inlineListToCustom) - meta - -- merge contexts from metadata and variables - let renderContext = context <> metaContext - return $ case writerTemplate opts of - Nothing -> body - Just tpl -> render Nothing $ - renderTemplate tpl $ setField "body" body renderContext - --- | Converts a Pandoc value to custom markup using a classic Lua writer. -docToCustom :: forall e. LuaError e - => WriterOptions -> Pandoc -> LuaE e (Text, Context Text) -docToCustom opts (Pandoc (Meta metamap) blocks) = do - body <- blockListToCustom blocks - -- invoke doesn't work with multiple return values, so we have to call - -- `Doc` manually. - Lua.getglobal "Doc" -- function - push body -- argument 1 - push (fmap Stringify metamap) -- argument 2 - push (writerVariables opts) -- argument 3 - call 3 2 - rendered <- peek (nth 2) -- first return value - context <- forcePeek . optional $ peekViaJSON top -- snd return value - return (rendered, fromMaybe mempty context) - - --- | Convert Pandoc block element to Custom. -blockToCustom :: forall e. LuaError e - => Block -- ^ Block element - -> LuaE e String - -blockToCustom Null = return "" - -blockToCustom (Plain inlines) = invoke "Plain" (Stringify inlines) - -blockToCustom (Para [Image attr txt (src,tit)]) = - invoke "CaptionedImage" src tit (Stringify txt) (attrToMap attr) - -blockToCustom (Para inlines) = invoke "Para" (Stringify inlines) - -blockToCustom (LineBlock linesList) = - invoke "LineBlock" (map (Stringify) linesList) - -blockToCustom (RawBlock format str) = - invoke "RawBlock" (Stringify format) str - -blockToCustom HorizontalRule = invoke "HorizontalRule" - -blockToCustom (Header level attr inlines) = - invoke "Header" level (Stringify inlines) (attrToMap attr) - -blockToCustom (CodeBlock attr str) = - invoke "CodeBlock" str (attrToMap attr) - -blockToCustom (BlockQuote blocks) = - invoke "BlockQuote" (Stringify blocks) - -blockToCustom (Table _ blkCapt specs thead tbody tfoot) = - let (capt, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot - aligns' = map show aligns - capt' = Stringify capt - headers' = map (Stringify) headers - rows' = map (map (Stringify)) rows - in invoke "Table" capt' aligns' widths headers' rows' - -blockToCustom (BulletList items) = - invoke "BulletList" (map (Stringify) items) - -blockToCustom (OrderedList (num,sty,delim) items) = - invoke "OrderedList" (map (Stringify) items) num (show sty) (show delim) - -blockToCustom (DefinitionList items) = - invoke "DefinitionList" - (map (KeyValue . (Stringify *** map (Stringify))) items) - -blockToCustom (Div attr items) = - invoke "Div" (Stringify items) (attrToMap attr) - --- | Convert list of Pandoc block elements to Custom. -blockListToCustom :: forall e. LuaError e - => [Block] -- ^ List of block elements - -> LuaE e String -blockListToCustom xs = do - blocksep <- invoke "Blocksep" - bs <- mapM blockToCustom xs - return $ mconcat $ intersperse blocksep bs - --- | Convert list of Pandoc inline elements to Custom. -inlineListToCustom :: forall e. LuaError e => [Inline] -> LuaE e String -inlineListToCustom lst = do - xs <- mapM (inlineToCustom @e) lst - return $ mconcat xs - --- | Convert Pandoc inline element to Custom. -inlineToCustom :: forall e. LuaError e => Inline -> LuaE e String - -inlineToCustom (Str str) = invoke "Str" str - -inlineToCustom Space = invoke "Space" - -inlineToCustom SoftBreak = invoke "SoftBreak" - -inlineToCustom (Emph lst) = invoke "Emph" (Stringify lst) - -inlineToCustom (Underline lst) = invoke "Underline" (Stringify lst) - -inlineToCustom (Strong lst) = invoke "Strong" (Stringify lst) - -inlineToCustom (Strikeout lst) = invoke "Strikeout" (Stringify lst) - -inlineToCustom (Superscript lst) = invoke "Superscript" (Stringify lst) - -inlineToCustom (Subscript lst) = invoke "Subscript" (Stringify lst) - -inlineToCustom (SmallCaps lst) = invoke "SmallCaps" (Stringify lst) - -inlineToCustom (Quoted SingleQuote lst) = - invoke "SingleQuoted" (Stringify lst) - -inlineToCustom (Quoted DoubleQuote lst) = - invoke "DoubleQuoted" (Stringify lst) - -inlineToCustom (Cite cs lst) = - invoke "Cite" (Stringify lst) (map (Stringify) cs) - -inlineToCustom (Code attr str) = - invoke "Code" str (attrToMap attr) - -inlineToCustom (Math DisplayMath str) = - invoke "DisplayMath" str - -inlineToCustom (Math InlineMath str) = - invoke "InlineMath" str - -inlineToCustom (RawInline format str) = - invoke "RawInline" (Stringify format) str - -inlineToCustom LineBreak = invoke "LineBreak" - -inlineToCustom (Link attr txt (src,tit)) = - invoke "Link" (Stringify txt) src tit (attrToMap attr) - -inlineToCustom (Image attr alt (src,tit)) = - invoke "Image" (Stringify alt) src tit (attrToMap attr) - -inlineToCustom (Note contents) = invoke "Note" (Stringify contents) - -inlineToCustom (Span attr items) = - invoke "Span" (Stringify items) (attrToMap attr) |