diff options
| -rw-r--r-- | data/pandoc.lua | 47 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/PandocModule.hs | 93 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Util.hs | 15 |
3 files changed, 77 insertions, 78 deletions
diff --git a/data/pandoc.lua b/data/pandoc.lua index 3be3b507a..df8aa06c4 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -874,53 +874,6 @@ M.UpperAlpha = "UpperAlpha" -- Helper Functions -- @section helpers ---- Parse the given string into a Pandoc document. --- The method used to interpret input is specified by *format*. Acceptable --- values for this parameter are equal to those that can be given to the --- `--from` command line option. --- @tparam string markup the markup to be parsed --- @tparam[opt] string format format specification, defaults to "markdown". --- @treturn Pandoc pandoc document --- @usage --- local org_markup = "/emphasis/" -- Input to be read --- local document = pandoc.read(org_markup, "org") --- -- Get the first block of the document --- local block = document.blocks[1] --- -- The inline element in that block is an `Emph` --- assert(block.content[1].t == "Emph") -function M.read(markup, format) - format = format or "markdown" - local pd = pandoc._read(format, markup) - if type(pd) == "string" then - error(pd) - else - return pd - end -end - ---- Runs command with arguments, passing it some input, and returns the output. --- @treturn string Output of command. --- @raise A table containing the keys `command`, `error_code`, and `output` is --- thrown if the command exits with a non-zero error code. --- @usage --- local ec, output = pandoc.pipe("sed", {"-e","s/a/b/"}, "abc") -function M.pipe (command, args, input) - local ec, output = pandoc._pipe(command, args, input) - if ec ~= 0 then - err = setmetatable( - { command = command, error_code = ec, output = output}, - { __tostring = function(e) - return "Error running " .. e.command - .. " (error code " .. e.error_code .. "): " - .. e.output - end - } - ) - error(err) - end - return output -end - --- Use functions defined in the global namespace to create a pandoc filter. -- All globally defined functions which have names of pandoc elements are -- collected into a new table. diff --git a/src/Text/Pandoc/Lua/PandocModule.hs b/src/Text/Pandoc/Lua/PandocModule.hs index 6bc2618fd..4a3e4d354 100644 --- a/src/Text/Pandoc/Lua/PandocModule.hs +++ b/src/Text/Pandoc/Lua/PandocModule.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE FlexibleContexts #-} {- Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> @@ -17,7 +15,7 @@ You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} -{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} {- | Module : Text.Pandoc.Lua.PandocModule Copyright : Copyright © 2017 Albert Krewinkel @@ -33,21 +31,20 @@ module Text.Pandoc.Lua.PandocModule , pushMediaBagModule ) where -import Control.Monad (zipWithM_) +import Control.Monad (when, zipWithM_) import Data.Default (Default (..)) import Data.Digest.Pure.SHA (sha1, showDigest) import Data.IORef (IORef, modifyIORef', readIORef) import Data.Maybe (fromMaybe) import Data.Text (pack) import Foreign.Lua (ToLuaStack, FromLuaStack, Lua, NumResults, liftIO) -import Foreign.Lua.FunctionCalling (ToHaskellFunction) import System.Exit (ExitCode (..)) import Text.Pandoc.Class (CommonState (..), fetchItem, putCommonState, runIO, runIOorExplode, setMediaBag) import Text.Pandoc.Definition (Block, Inline) import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter) import Text.Pandoc.Lua.StackInstances () -import Text.Pandoc.Lua.Util (loadScriptFromDataDir) +import Text.Pandoc.Lua.Util (addFunction, addValue, loadScriptFromDataDir) import Text.Pandoc.Walk (Walkable) import Text.Pandoc.MIME (MimeType) import Text.Pandoc.Options (ReaderOptions (readerExtensions)) @@ -55,6 +52,7 @@ import Text.Pandoc.Process (pipeProcess) import Text.Pandoc.Readers (Reader (..), getReader) import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Foreign.Lua as Lua import qualified Text.Pandoc.MediaBag as MB @@ -63,8 +61,8 @@ import qualified Text.Pandoc.MediaBag as MB pushPandocModule :: Maybe FilePath -> Lua NumResults pushPandocModule datadir = do loadScriptFromDataDir datadir "pandoc.lua" - addFunction "_pipe" pipeFn - addFunction "_read" readDoc + addFunction "read" readDoc + addFunction "pipe" pipeFn addFunction "sha1" sha1HashFn addFunction "walk_block" walkBlock addFunction "walk_inline" walkInline @@ -80,19 +78,23 @@ walkInline = walkElement walkBlock :: Block -> LuaFilter -> Lua Block walkBlock = walkElement -readDoc :: String -> String -> Lua NumResults -readDoc formatSpec content = do +readDoc :: String -> OrNil String -> Lua NumResults +readDoc content formatSpecOrNil = do + let formatSpec = fromMaybe "markdown" (toMaybe formatSpecOrNil) case getReader formatSpec of - Left s -> Lua.push s -- Unknown reader + Left s -> raiseError s -- Unknown reader Right (reader, es) -> case reader of TextReader r -> do res <- liftIO $ runIO $ r def{ readerExtensions = es } (pack content) case res of - Left s -> Lua.push $ show s -- error while reading - Right pd -> Lua.push pd -- success, push Pandoc - _ -> Lua.push "Only string formats are supported at the moment." - return 1 + Right pd -> (1 :: NumResults) <$ Lua.push pd -- success, push Pandoc + Left s -> raiseError (show s) -- error while reading + _ -> raiseError "Only string formats are supported at the moment." + where + raiseError s = do + Lua.push s + fromIntegral <$> Lua.lerror -- -- MediaBag submodule @@ -106,29 +108,64 @@ pushMediaBagModule commonState mediaBagRef = do addFunction "fetch" (fetch commonState mediaBagRef) return 1 -addFunction :: ToHaskellFunction a => String -> a -> Lua () -addFunction name fn = do - Lua.push name - Lua.pushHaskellFunction fn - Lua.rawset (-3) - sha1HashFn :: BL.ByteString -> Lua NumResults sha1HashFn contents = do Lua.push $ showDigest (sha1 contents) return 1 +-- | Pipes input through a command. pipeFn :: String -> [String] -> BL.ByteString -> Lua NumResults pipeFn command args input = do (ec, output) <- liftIO $ pipeProcess Nothing command args input - Lua.push $ case ec of - ExitSuccess -> 0 - ExitFailure n -> n - Lua.push output - return 2 + case ec of + ExitSuccess -> do + Lua.push output + return 1 + ExitFailure n -> do + Lua.push (PipeError command n output) + fromIntegral <$> Lua.lerror + +data PipeError = PipeError + { pipeErrorCommand :: String + , pipeErrorCode :: Int + , pipeErrorOutput :: BL.ByteString + } + +instance FromLuaStack PipeError where + peek idx = + PipeError + <$> (Lua.getfield idx "command" *> Lua.peek (-1) <* Lua.pop 1) + <*> (Lua.getfield idx "error_code" *> Lua.peek (-1) <* Lua.pop 1) + <*> (Lua.getfield idx "output" *> Lua.peek (-1) <* Lua.pop 1) + +instance ToLuaStack PipeError where + push pipeErr = do + Lua.newtable + addValue "command" (pipeErrorCommand pipeErr) + addValue "error_code" (pipeErrorCode pipeErr) + addValue "output" (pipeErrorOutput pipeErr) + pushPipeErrorMetaTable + Lua.setmetatable (-2) + where + pushPipeErrorMetaTable :: Lua () + pushPipeErrorMetaTable = do + v <- Lua.newmetatable "pandoc pipe error" + when v $ addFunction "__tostring" pipeErrorMessage + + pipeErrorMessage :: PipeError -> Lua BL.ByteString + pipeErrorMessage (PipeError cmd errorCode output) = return $ mconcat + [ BSL.pack "Error running " + , BSL.pack cmd + , BSL.pack " (error code " + , BSL.pack $ show errorCode + , BSL.pack "): " + , if output == mempty then BSL.pack "<no output>" else output + ] +-- end: pipe insertMediaFn :: IORef MB.MediaBag -> FilePath @@ -183,14 +220,14 @@ fetch commonState mbRef src = do return 2 -- returns 2 values: contents, mimetype -- --- Helper types and orphan instances +-- Helper types -- newtype OrNil a = OrNil { toMaybe :: Maybe a } instance FromLuaStack a => FromLuaStack (OrNil a) where peek idx = do - noValue <- Lua.isnil idx + noValue <- Lua.isnoneornil idx if noValue then return (OrNil Nothing) else OrNil . Just <$> Lua.peek idx diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs index 5803e62dc..f72ccd7f9 100644 --- a/src/Text/Pandoc/Lua/Util.hs +++ b/src/Text/Pandoc/Lua/Util.hs @@ -32,6 +32,7 @@ module Text.Pandoc.Lua.Util ( adjustIndexBy , getTable , addValue + , addFunction , getRawInt , setRawInt , addRawInt @@ -44,8 +45,8 @@ module Text.Pandoc.Lua.Util import Control.Monad (when) import Data.ByteString.Char8 (unpack) -import Foreign.Lua (FromLuaStack (..), Lua, NumArgs, StackIndex, - ToLuaStack (..), getglobal') +import Foreign.Lua (FromLuaStack (..), ToHaskellFunction, Lua, NumArgs, + StackIndex, ToLuaStack (..), getglobal') import Foreign.Lua.Api (Status, call, pop, rawget, rawgeti, rawset, rawseti) import Text.Pandoc.Class (readDataFile, runIOorExplode, setUserDataDir) @@ -66,13 +67,21 @@ getTable idx key = do rawget (idx `adjustIndexBy` 1) peek (-1) <* pop 1 --- | Add a key-value pair to the table at the top of the stack +-- | Add a key-value pair to the table at the top of the stack. addValue :: (ToLuaStack a, ToLuaStack b) => a -> b -> Lua () addValue key value = do push key push value rawset (-3) +-- | Add a function to the table at the top of the stack, using the given name. +addFunction :: ToHaskellFunction a => String -> a -> Lua () +addFunction name fn = do + Lua.push name + Lua.pushHaskellFunction fn + Lua.wrapHaskellFunction + Lua.rawset (-3) + -- | Get value behind key from table at given index. getRawInt :: FromLuaStack a => StackIndex -> Int -> Lua a getRawInt idx key = |