diff options
Diffstat (limited to 'src/Text')
-rw-r--r-- | src/Text/Pandoc/Lua.hs | 16 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Module/Pandoc.hs | 9 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/StackInstances.hs | 56 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Util.hs | 84 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Custom.hs | 14 |
5 files changed, 75 insertions, 104 deletions
diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs index cd7117074..be448cf48 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -34,14 +34,14 @@ module Text.Pandoc.Lua import Prelude import Control.Monad ((>=>)) -import Foreign.Lua (FromLuaStack (peek), Lua, LuaException (..), - Status (OK), ToLuaStack (push)) +import Foreign.Lua (Lua, LuaException (..)) import Text.Pandoc.Class (PandocIO) import Text.Pandoc.Definition (Pandoc) import Text.Pandoc.Lua.Filter (LuaFilter, walkMWithLuaFilter) import Text.Pandoc.Lua.Init (runPandocLua, registerScriptPath) import Text.Pandoc.Lua.Util (popValue) import Text.Pandoc.Options (ReaderOptions) + import qualified Foreign.Lua as Lua -- | Run the Lua filter in @filterPath@ for a transformation to target @@ -60,25 +60,23 @@ runLuaFilter' ropts filterPath format pd = do registerScriptPath filterPath top <- Lua.gettop stat <- Lua.dofile filterPath - if stat /= OK - then do - luaErrMsg <- popValue - Lua.throwLuaError luaErrMsg + if stat /= Lua.OK + then Lua.throwTopMessageAsError else do newtop <- Lua.gettop -- Use the returned filters, or the implicitly defined global filter if -- nothing was returned. luaFilters <- if newtop - top >= 1 - then peek (-1) + then Lua.peek Lua.stackTop else Lua.getglobal "_G" *> fmap (:[]) popValue runAll luaFilters pd where registerFormat = do - push format + Lua.push format Lua.setglobal "FORMAT" registerReaderOptions = do - push ropts + Lua.push ropts Lua.setglobal "PANDOC_READER_OPTIONS" runAll :: [LuaFilter] -> Pandoc -> Lua Pandoc diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index 8cb630d7b..ca337941f 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -42,7 +42,7 @@ import Text.Pandoc.Class (runIO) import Text.Pandoc.Definition (Block, Inline) import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter) import Text.Pandoc.Lua.StackInstances () -import Text.Pandoc.Lua.Util (addFunction, addValue, loadScriptFromDataDir) +import Text.Pandoc.Lua.Util (addFunction, loadScriptFromDataDir) import Text.Pandoc.Walk (Walkable) import Text.Pandoc.Options (ReaderOptions (readerExtensions)) import Text.Pandoc.Process (pipeProcess) @@ -51,6 +51,7 @@ 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.Lua.Util as LuaUtil -- | Push the "pandoc" on the lua stack. Requires the `list` module to be -- loaded. @@ -114,9 +115,9 @@ instance FromLuaStack PipeError where instance ToLuaStack PipeError where push pipeErr = do Lua.newtable - addValue "command" (pipeErrorCommand pipeErr) - addValue "error_code" (pipeErrorCode pipeErr) - addValue "output" (pipeErrorOutput pipeErr) + LuaUtil.addField "command" (pipeErrorCommand pipeErr) + LuaUtil.addField "error_code" (pipeErrorCode pipeErr) + LuaUtil.addField "output" (pipeErrorOutput pipeErr) pushPipeErrorMetaTable Lua.setmetatable (-2) where diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs index 3298079c5..9c3b40f12 100644 --- a/src/Text/Pandoc/Lua/StackInstances.hs +++ b/src/Text/Pandoc/Lua/StackInstances.hs @@ -44,7 +44,7 @@ import Foreign.Lua (FromLuaStack (peek), Lua, LuaInteger, LuaNumber, StackIndex, ToLuaStack (push), Type (..), throwLuaError, tryLua) import Text.Pandoc.Definition import Text.Pandoc.Extensions (Extensions) -import Text.Pandoc.Lua.Util (getTable, getTag, pushViaConstructor, typeCheck) +import Text.Pandoc.Lua.Util (pushViaConstructor, typeCheck) import Text.Pandoc.Options (ReaderOptions (..), TrackChanges) import Text.Pandoc.Shared (Element (Blk, Sec), safeRead) @@ -62,7 +62,7 @@ instance ToLuaStack Pandoc where instance FromLuaStack Pandoc where peek idx = defineHowTo "get Pandoc value" $ do typeCheck idx Lua.TypeTable - blocks <- getTable idx "blocks" + blocks <- LuaUtil.rawField idx "blocks" meta <- Lua.getfield idx "meta" *> (Lua.peek Lua.stackTop `finally` Lua.pop 1) return $ Pandoc meta blocks @@ -99,12 +99,12 @@ instance ToLuaStack Citation where instance FromLuaStack Citation where peek idx = do - id' <- getTable idx "id" - prefix <- getTable idx "prefix" - suffix <- getTable idx "suffix" - mode <- getTable idx "mode" - num <- getTable idx "note_num" - hash <- getTable idx "hash" + id' <- LuaUtil.rawField idx "id" + prefix <- LuaUtil.rawField idx "prefix" + suffix <- LuaUtil.rawField idx "suffix" + mode <- LuaUtil.rawField idx "mode" + num <- LuaUtil.rawField idx "note_num" + hash <- LuaUtil.rawField idx "hash" return $ Citation id' prefix suffix mode num hash instance ToLuaStack Alignment where @@ -178,7 +178,7 @@ peekMetaValue idx = defineHowTo "get MetaValue" $ do TypeBoolean -> MetaBool <$> peek idx TypeString -> MetaString <$> peek idx TypeTable -> do - tag <- tryLua $ getTag idx + tag <- tryLua $ LuaUtil.getTag idx case tag of Right "MetaBlocks" -> MetaBlocks <$> elementContent Right "MetaBool" -> MetaBool <$> elementContent @@ -220,7 +220,7 @@ pushBlock = \case peekBlock :: StackIndex -> Lua Block peekBlock idx = defineHowTo "get Block value" $ do typeCheck idx Lua.TypeTable - tag <- getTag idx + tag <- LuaUtil.getTag idx case tag of "BlockQuote" -> BlockQuote <$> elementContent "BulletList" -> BulletList <$> elementContent @@ -243,7 +243,7 @@ peekBlock idx = defineHowTo "get Block value" $ do where -- Get the contents of an AST element. elementContent :: FromLuaStack a => Lua a - elementContent = getTable idx "c" + elementContent = LuaUtil.rawField idx "c" -- | Push an inline element to the top of the lua stack. pushInline :: Inline -> Lua () @@ -272,7 +272,7 @@ pushInline = \case peekInline :: StackIndex -> Lua Inline peekInline idx = defineHowTo "get Inline value" $ do typeCheck idx Lua.TypeTable - tag <- getTag idx + tag <- LuaUtil.getTag idx case tag of "Cite" -> uncurry Cite <$> elementContent "Code" -> withAttr Code <$> elementContent @@ -299,7 +299,7 @@ peekInline idx = defineHowTo "get Inline value" $ do where -- Get the contents of an AST element. elementContent :: FromLuaStack a => Lua a - elementContent = getTable idx "c" + elementContent = LuaUtil.rawField idx "c" withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b withAttr f (attributes, x) = f (fromLuaAttr attributes) x @@ -321,11 +321,11 @@ instance ToLuaStack Element where push (Blk blk) = push blk push (Sec lvl num attr label contents) = do Lua.newtable - LuaUtil.addValue "level" lvl - LuaUtil.addValue "numbering" num - LuaUtil.addValue "attr" (LuaAttr attr) - LuaUtil.addValue "label" label - LuaUtil.addValue "contents" contents + LuaUtil.addField "level" lvl + LuaUtil.addField "numbering" num + LuaUtil.addField "attr" (LuaAttr attr) + LuaUtil.addField "label" label + LuaUtil.addField "contents" contents pushSecMetaTable Lua.setmetatable (-2) where @@ -333,7 +333,7 @@ instance ToLuaStack Element where pushSecMetaTable = do inexistant <- Lua.newmetatable "PandocElementSec" when inexistant $ do - LuaUtil.addValue "t" "Sec" + LuaUtil.addField "t" "Sec" Lua.push "__index" Lua.pushvalue (-2) Lua.rawset (-3) @@ -367,12 +367,12 @@ instance ToLuaStack ReaderOptions where (stripComments :: Bool) = ro Lua.newtable - LuaUtil.addValue "extensions" extensions - LuaUtil.addValue "standalone" standalone - LuaUtil.addValue "columns" columns - LuaUtil.addValue "tabStop" tabStop - LuaUtil.addValue "indentedCodeClasses" indentedCodeClasses - LuaUtil.addValue "abbreviations" abbreviations - LuaUtil.addValue "defaultImageExtension" defaultImageExtension - LuaUtil.addValue "trackChanges" trackChanges - LuaUtil.addValue "stripComments" stripComments + LuaUtil.addField "extensions" extensions + LuaUtil.addField "standalone" standalone + LuaUtil.addField "columns" columns + LuaUtil.addField "tabStop" tabStop + LuaUtil.addField "indentedCodeClasses" indentedCodeClasses + LuaUtil.addField "abbreviations" abbreviations + LuaUtil.addField "defaultImageExtension" defaultImageExtension + LuaUtil.addField "trackChanges" trackChanges + LuaUtil.addField "stripComments" stripComments diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs index ea9ec2554..c12884a10 100644 --- a/src/Text/Pandoc/Lua/Util.hs +++ b/src/Text/Pandoc/Lua/Util.hs @@ -31,14 +31,11 @@ Lua utility functions. -} module Text.Pandoc.Lua.Util ( getTag - , getTable - , addValue + , rawField + , addField , addFunction - , getRawInt - , setRawInt - , addRawInt + , addValue , typeCheck - , raiseError , popValue , PushViaCall , pushViaCall @@ -51,34 +48,30 @@ import Prelude import Control.Monad (when) import Control.Monad.Catch (finally) import Data.ByteString.Char8 (unpack) -import Foreign.Lua (FromLuaStack (..), NumResults, Lua, NumArgs, StackIndex, - ToLuaStack (..), ToHaskellFunction) -import Foreign.Lua.Api (Status, call, pop, rawget, rawgeti, rawset, rawseti) +import Foreign.Lua (FromLuaStack, Lua, NumArgs, StackIndex, Status, + ToLuaStack, ToHaskellFunction) import Text.Pandoc.Class (readDataFile, runIOorExplode, setUserDataDir) import qualified Foreign.Lua as Lua --- | Adjust the stack index, assuming that @n@ new elements have been pushed on --- the stack. -adjustIndexBy :: StackIndex -> StackIndex -> StackIndex -adjustIndexBy idx n = - if idx < 0 - then idx - n - else idx - -- | Get value behind key from table at given index. -getTable :: (ToLuaStack a, FromLuaStack b) => StackIndex -> a -> Lua b -getTable idx key = do - push key - rawget (idx `adjustIndexBy` 1) +rawField :: FromLuaStack a => StackIndex -> String -> Lua a +rawField idx key = do + absidx <- Lua.absindex idx + Lua.push key + Lua.rawget absidx popValue +-- | Add a value to the table at the top of the stack at a string-index. +addField :: ToLuaStack a => String -> a -> Lua () +addField = addValue + -- | 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) + Lua.push key + Lua.push value + Lua.rawset (Lua.nthFromTop 3) -- | Add a function to the table at the top of the stack, using the given name. addFunction :: ToHaskellFunction a => String -> a -> Lua () @@ -88,22 +81,6 @@ addFunction name fn = do Lua.wrapHaskellFunction Lua.rawset (-3) --- | Get value behind key from table at given index. -getRawInt :: FromLuaStack a => StackIndex -> Int -> Lua a -getRawInt idx key = do - rawgeti idx key - popValue - --- | Set numeric key/value in table at the given index -setRawInt :: ToLuaStack a => StackIndex -> Int -> a -> Lua () -setRawInt idx key value = do - push value - rawseti (idx `adjustIndexBy` 1) key - --- | Set numeric key/value in table at the top of the stack. -addRawInt :: ToLuaStack a => Int -> a -> Lua () -addRawInt = setRawInt (-1) - typeCheck :: StackIndex -> Lua.Type -> Lua () typeCheck idx expected = do actual <- Lua.ltype idx @@ -112,16 +89,11 @@ typeCheck idx expected = do actName <- Lua.typename actual Lua.throwLuaError $ "expected " ++ expName ++ " but got " ++ actName ++ "." -raiseError :: ToLuaStack a => a -> Lua NumResults -raiseError e = do - Lua.push e - fromIntegral <$> Lua.lerror - -- | Get, then pop the value at the top of the stack. popValue :: FromLuaStack a => Lua a popValue = do resOrError <- Lua.peekEither (-1) - pop 1 + Lua.pop 1 case resOrError of Left err -> Lua.throwLuaError err Right x -> return x @@ -136,11 +108,11 @@ instance PushViaCall (Lua ()) where Lua.push fn Lua.rawget Lua.registryindex pushArgs - call num 1 + Lua.call num 1 instance (ToLuaStack a, PushViaCall b) => PushViaCall (a -> b) where pushViaCall' fn pushArgs num x = - pushViaCall' fn (pushArgs *> push x) (num + 1) + pushViaCall' fn (pushArgs *> Lua.push x) (num + 1) -- | Push an value to the stack via a lua function. The lua function is called -- with all arguments that are passed to this function and is expected to return @@ -163,9 +135,9 @@ loadScriptFromDataDir datadir scriptFile = do "Couldn't load '" ++ scriptFile ++ "'.\n" ++ msg -- | Load a string and immediately perform a full garbage collection. This is --- important to keep the program from hanging: If the program contained a call --- to @require@, the a new loader function was created which then become --- garbage. If that function is collected at an inopportune times, i.e. when the +-- important to keep the program from hanging: If the program containes a call +-- to @require@, then a new loader function is created which then becomes +-- garbage. If that function is collected at an inopportune time, i.e. when the -- Lua API is called via a function that doesn't allow calling back into Haskell -- (getraw, setraw, …), then the function's finalizer, and the full program, -- will hang. @@ -182,8 +154,8 @@ dostring' script = do -- metatable. getTag :: StackIndex -> Lua String getTag idx = do - top <- Lua.gettop - hasMT <- Lua.getmetatable idx - push "tag" - if hasMT then Lua.rawget (-2) else Lua.rawget (idx `adjustIndexBy` 1) - peek Lua.stackTop `finally` Lua.settop top + -- push metatable or just the table + Lua.getmetatable idx >>= \hasMT -> when (not hasMT) (Lua.pushvalue idx) + Lua.push "tag" + Lua.rawget (Lua.nthFromTop 2) + Lua.peek Lua.stackTop `finally` Lua.pop 2 diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index c0940ad78..866df85be 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -48,7 +48,7 @@ import Text.Pandoc.Definition import Text.Pandoc.Error import Text.Pandoc.Lua.Init (runPandocLua, registerScriptPath) import Text.Pandoc.Lua.StackInstances () -import Text.Pandoc.Lua.Util (addValue, dostring') +import Text.Pandoc.Lua.Util (addField, addValue, dostring') import Text.Pandoc.Options import Text.Pandoc.Templates import qualified Text.Pandoc.UTF8 as UTF8 @@ -82,12 +82,12 @@ instance ToLuaStack (Stringify MetaValue) where instance ToLuaStack (Stringify Citation) where push (Stringify cit) = do createtable 6 0 - addValue "citationId" $ citationId cit - addValue "citationPrefix" . Stringify $ citationPrefix cit - addValue "citationSuffix" . Stringify $ citationSuffix cit - addValue "citationMode" $ show (citationMode cit) - addValue "citationNoteNum" $ citationNoteNum cit - addValue "citationHash" $ citationHash cit + addField "citationId" $ citationId cit + addField "citationPrefix" . Stringify $ citationPrefix cit + addField "citationSuffix" . Stringify $ citationSuffix cit + addField "citationMode" $ show (citationMode cit) + addField "citationNoteNum" $ citationNoteNum cit + addField "citationHash" $ citationHash cit -- | Key-value pair, pushed as a table with @a@ as the only key and @v@ as the -- associated value. |