Use hslua >= 0.7, update Lua code
This commit is contained in:
Albert Krewinkel
parent
418bda8128
commit
2dc3dbd68b
12 changed files with 462 additions and 621 deletions
|
|
@ -317,7 +317,7 @@ Library
|
|||
yaml >= 0.8.8.2 && < 0.9,
|
||||
scientific >= 0.2 && < 0.4,
|
||||
vector >= 0.10 && < 0.13,
|
||||
hslua >= 0.4 && < 0.6,
|
||||
hslua >= 0.7 && < 0.8,
|
||||
binary >= 0.5 && < 0.9,
|
||||
SHA >= 1.6 && < 1.7,
|
||||
haddock-library >= 1.1 && < 1.5,
|
||||
|
|
@ -464,7 +464,6 @@ Library
|
|||
Text.Pandoc.Readers.Org.ParserState,
|
||||
Text.Pandoc.Readers.Org.Parsing,
|
||||
Text.Pandoc.Readers.Org.Shared,
|
||||
Text.Pandoc.Lua.Compat,
|
||||
Text.Pandoc.Lua.PandocModule,
|
||||
Text.Pandoc.Lua.SharedInstances,
|
||||
Text.Pandoc.Lua.StackInstances,
|
||||
|
|
@ -545,7 +544,7 @@ Test-Suite test-pandoc
|
|||
text >= 0.11 && < 1.3,
|
||||
directory >= 1 && < 1.4,
|
||||
filepath >= 1.1 && < 1.5,
|
||||
hslua >= 0.4 && < 0.6,
|
||||
hslua >= 0.7 && < 0.8,
|
||||
process >= 1.2.3 && < 1.7,
|
||||
skylighting >= 0.3.3 && < 0.4,
|
||||
temporary >= 1.1 && < 1.3,
|
||||
|
|
|
|||
|
|
@ -41,14 +41,16 @@ import Data.Data (toConstr, showConstr, dataTypeOf, dataTypeConstrs, Data)
|
|||
import Data.Map (Map)
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Typeable (Typeable)
|
||||
import Scripting.Lua (LuaState, StackValue (..))
|
||||
import Foreign.Lua (Lua, FromLuaStack (..), ToLuaStack (..), runLua,
|
||||
peekEither, getglobal', throwLuaError)
|
||||
import Foreign.Lua.Types.Lua (runLuaWith, liftLua1)
|
||||
import Foreign.Lua.Api
|
||||
import Text.Pandoc.Definition
|
||||
import Text.Pandoc.Lua.PandocModule (pushPandocModule)
|
||||
import Text.Pandoc.Lua.StackInstances ()
|
||||
import Text.Pandoc.Walk
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import qualified Scripting.Lua as Lua
|
||||
|
||||
newtype LuaException = LuaException String
|
||||
deriving (Show, Typeable)
|
||||
|
|
@ -57,123 +59,120 @@ instance Exception LuaException
|
|||
|
||||
runLuaFilter :: (MonadIO m)
|
||||
=> Maybe FilePath -> FilePath -> [String] -> Pandoc -> m Pandoc
|
||||
runLuaFilter datadir filterPath args pd = liftIO $ do
|
||||
lua <- Lua.newstate
|
||||
Lua.openlibs lua
|
||||
runLuaFilter datadir filterPath args pd = liftIO . runLua $ do
|
||||
openlibs
|
||||
-- store module in global "pandoc"
|
||||
pushPandocModule datadir lua
|
||||
Lua.setglobal lua "pandoc"
|
||||
top <- Lua.gettop lua
|
||||
status <- Lua.loadfile lua filterPath
|
||||
if status /= 0
|
||||
pushPandocModule datadir
|
||||
setglobal "pandoc"
|
||||
top <- gettop
|
||||
stat<- dofile filterPath
|
||||
if stat /= OK
|
||||
then do
|
||||
Just luaErrMsg <- Lua.peek lua 1
|
||||
throwIO (LuaException luaErrMsg)
|
||||
luaErrMsg <- peek (-1) <* pop 1
|
||||
throwLuaError luaErrMsg
|
||||
else do
|
||||
Lua.call lua 0 Lua.multret
|
||||
newtop <- Lua.gettop lua
|
||||
newtop <- gettop
|
||||
-- Use the implicitly defined global filter if nothing was returned
|
||||
when (newtop - top < 1) $ pushGlobalFilter lua
|
||||
Just luaFilters <- Lua.peek lua (-1)
|
||||
Lua.push lua args
|
||||
Lua.setglobal lua "PandocParameters"
|
||||
doc <- runAll luaFilters pd
|
||||
Lua.close lua
|
||||
return doc
|
||||
when (newtop - top < 1) $ pushGlobalFilter
|
||||
luaFilters <- peek (-1)
|
||||
push args
|
||||
setglobal "PandocParameters"
|
||||
runAll luaFilters pd
|
||||
|
||||
pushGlobalFilter :: LuaState -> IO ()
|
||||
pushGlobalFilter lua =
|
||||
Lua.newtable lua
|
||||
*> Lua.getglobal2 lua "pandoc.global_filter"
|
||||
*> Lua.call lua 0 1
|
||||
*> Lua.rawseti lua (-2) 1
|
||||
pushGlobalFilter :: Lua ()
|
||||
pushGlobalFilter = do
|
||||
newtable
|
||||
getglobal' "pandoc.global_filter"
|
||||
call 0 1
|
||||
rawseti (-2) 1
|
||||
|
||||
runAll :: [LuaFilter] -> Pandoc -> IO Pandoc
|
||||
runAll :: [LuaFilter] -> Pandoc -> Lua Pandoc
|
||||
runAll = foldr ((>=>) . walkMWithLuaFilter) return
|
||||
|
||||
walkMWithLuaFilter :: LuaFilter -> Pandoc -> IO Pandoc
|
||||
walkMWithLuaFilter (LuaFilter lua fnMap) =
|
||||
walkMWithLuaFilter :: LuaFilter -> Pandoc -> Lua Pandoc
|
||||
walkMWithLuaFilter (LuaFilter fnMap) = liftLua1 walkLua
|
||||
where
|
||||
walkLua :: LuaState -> Pandoc -> IO Pandoc
|
||||
walkLua l =
|
||||
(if hasOneOf (constructorsFor (dataTypeOf (Str [])))
|
||||
then walkM (tryFilter lua fnMap :: Inline -> IO Inline)
|
||||
then walkM (runLuaWith l . (tryFilter fnMap :: Inline -> Lua Inline))
|
||||
else return)
|
||||
>=>
|
||||
(if hasOneOf (constructorsFor (dataTypeOf (Para [])))
|
||||
then walkM (tryFilter lua fnMap :: Block -> IO Block)
|
||||
then walkM ((runLuaWith l . (tryFilter fnMap :: Block -> Lua Block)))
|
||||
else return)
|
||||
>=>
|
||||
(case Map.lookup "Meta" fnMap of
|
||||
Just fn -> walkM (\(Pandoc meta blocks) -> do
|
||||
meta' <- runFilterFunction lua fn meta
|
||||
return $ Pandoc meta' blocks)
|
||||
Just fn -> walkM ((\(Pandoc meta blocks) -> runLuaWith l $ do
|
||||
meta' <- runFilterFunction fn meta
|
||||
return $ Pandoc meta' blocks))
|
||||
Nothing -> return)
|
||||
>=>
|
||||
(case Map.lookup "Pandoc" fnMap `mplus` Map.lookup "Doc" fnMap of
|
||||
Just fn -> (runFilterFunction lua fn) :: Pandoc -> IO Pandoc
|
||||
Just fn -> runLuaWith l . (runFilterFunction fn :: Pandoc -> Lua Pandoc)
|
||||
Nothing -> return)
|
||||
where hasOneOf = any (\k -> isJust (Map.lookup k fnMap))
|
||||
hasOneOf = any (\k -> isJust (Map.lookup k fnMap))
|
||||
constructorsFor x = map show (dataTypeConstrs x)
|
||||
|
||||
type FunctionMap = Map String LuaFilterFunction
|
||||
data LuaFilter = LuaFilter LuaState FunctionMap
|
||||
data LuaFilter = LuaFilter FunctionMap
|
||||
|
||||
newtype LuaFilterFunction = LuaFilterFunction { functionIndex :: Int }
|
||||
|
||||
tryFilter :: (Data a, StackValue a) => LuaState -> FunctionMap -> a -> IO a
|
||||
tryFilter lua fnMap x =
|
||||
-- | Try running a filter for the given element
|
||||
tryFilter :: (Data a, FromLuaStack a, ToLuaStack a) => FunctionMap -> a -> Lua a
|
||||
tryFilter fnMap x =
|
||||
let filterFnName = showConstr (toConstr x) in
|
||||
case Map.lookup filterFnName fnMap of
|
||||
Nothing -> return x
|
||||
Just fn -> runFilterFunction lua fn x
|
||||
Just fn -> runFilterFunction fn x
|
||||
|
||||
instance StackValue LuaFilter where
|
||||
valuetype _ = Lua.TTABLE
|
||||
push = undefined
|
||||
peek lua idx = fmap (LuaFilter lua) <$> Lua.peek lua idx
|
||||
instance FromLuaStack LuaFilter where
|
||||
peek idx = LuaFilter <$> peek idx
|
||||
|
||||
-- | Push a value to the stack via a lua filter function. The filter function is
|
||||
-- called with given element as argument and is expected to return an element.
|
||||
-- Alternatively, the function can return nothing or nil, in which case the
|
||||
-- element is left unchanged.
|
||||
runFilterFunction :: StackValue a => LuaState -> LuaFilterFunction -> a -> IO a
|
||||
runFilterFunction lua lf x = do
|
||||
pushFilterFunction lua lf
|
||||
Lua.push lua x
|
||||
z <- Lua.pcall lua 1 1 0
|
||||
if (z /= 0)
|
||||
runFilterFunction :: (FromLuaStack a, ToLuaStack a)
|
||||
=> LuaFilterFunction -> a -> Lua a
|
||||
runFilterFunction lf x = do
|
||||
pushFilterFunction lf
|
||||
push x
|
||||
z <- pcall 1 1 Nothing
|
||||
if z /= OK
|
||||
then do
|
||||
msg <- Lua.peek lua (-1)
|
||||
msg <- peek (-1)
|
||||
let prefix = "Error while running filter function: "
|
||||
throwIO . LuaException $
|
||||
case msg of
|
||||
Nothing -> prefix ++ "could not read error message"
|
||||
Just msg' -> prefix ++ msg'
|
||||
throwLuaError $ prefix ++ msg
|
||||
else do
|
||||
resType <- Lua.ltype lua (-1)
|
||||
resType <- ltype (-1)
|
||||
case resType of
|
||||
Lua.TNIL -> Lua.pop lua 1 *> return x
|
||||
TypeNil -> pop 1 *> return x
|
||||
_ -> do
|
||||
mbres <- Lua.peek lua (-1)
|
||||
mbres <- peekEither (-1)
|
||||
case mbres of
|
||||
Nothing -> throwIO $ LuaException
|
||||
Left err -> throwLuaError
|
||||
("Error while trying to get a filter's return "
|
||||
++ "value from lua stack.")
|
||||
Just res -> res <$ Lua.pop lua 1
|
||||
++ "value from lua stack.\n" ++ err)
|
||||
Right res -> res <$ pop 1
|
||||
|
||||
-- | Push the filter function to the top of the stack.
|
||||
pushFilterFunction :: Lua.LuaState -> LuaFilterFunction -> IO ()
|
||||
pushFilterFunction lua lf =
|
||||
pushFilterFunction :: LuaFilterFunction -> Lua ()
|
||||
pushFilterFunction lf =
|
||||
-- The function is stored in a lua registry table, retrieve it from there.
|
||||
Lua.rawgeti lua Lua.registryindex (functionIndex lf)
|
||||
rawgeti registryindex (functionIndex lf)
|
||||
|
||||
registerFilterFunction :: LuaState -> Int -> IO LuaFilterFunction
|
||||
registerFilterFunction lua idx = do
|
||||
isFn <- Lua.isfunction lua idx
|
||||
unless isFn . throwIO . LuaException $ "Not a function at index " ++ show idx
|
||||
Lua.pushvalue lua idx
|
||||
refIdx <- Lua.ref lua Lua.registryindex
|
||||
registerFilterFunction :: StackIndex -> Lua LuaFilterFunction
|
||||
registerFilterFunction idx = do
|
||||
isFn <- isfunction idx
|
||||
unless isFn . throwLuaError $ "Not a function at index " ++ show idx
|
||||
pushvalue idx
|
||||
refIdx <- ref registryindex
|
||||
return $ LuaFilterFunction refIdx
|
||||
|
||||
instance StackValue LuaFilterFunction where
|
||||
valuetype _ = Lua.TFUNCTION
|
||||
instance ToLuaStack LuaFilterFunction where
|
||||
push = pushFilterFunction
|
||||
peek = fmap (fmap Just) . registerFilterFunction
|
||||
|
||||
instance FromLuaStack LuaFilterFunction where
|
||||
peek = registerFilterFunction
|
||||
|
|
|
|||
|
|
@ -1,40 +0,0 @@
|
|||
{-
|
||||
Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
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 #-}
|
||||
{- |
|
||||
Module : Text.Pandoc.Lua.Compat
|
||||
Copyright : Copyright © 2017 Albert Krewinkel
|
||||
License : GNU GPL, version 2 or above
|
||||
|
||||
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
|
||||
Stability : alpha
|
||||
|
||||
Compatibility helpers for hslua
|
||||
-}
|
||||
module Text.Pandoc.Lua.Compat ( loadstring ) where
|
||||
|
||||
import Scripting.Lua (LuaState)
|
||||
import qualified Scripting.Lua as Lua
|
||||
|
||||
-- | Interpret string as lua code and load into the lua environment.
|
||||
loadstring :: LuaState -> String -> String -> IO Int
|
||||
#if MIN_VERSION_hslua(0,5,0)
|
||||
loadstring lua script _ = Lua.loadstring lua script
|
||||
#else
|
||||
loadstring lua script cn = Lua.loadstring lua script cn
|
||||
#endif
|
||||
|
|
@ -31,31 +31,31 @@ import Control.Monad (unless)
|
|||
import Data.ByteString.Char8 (unpack)
|
||||
import Data.Default (Default (..))
|
||||
import Data.Text (pack)
|
||||
import Scripting.Lua (LuaState, call, push, pushhsfunction, rawset)
|
||||
import Foreign.Lua (Lua, Status (OK), liftIO, push, pushHaskellFunction)
|
||||
import Foreign.Lua.Api (call, loadstring, rawset)
|
||||
import Text.Pandoc.Class
|
||||
import Text.Pandoc.Definition (Pandoc)
|
||||
import Text.Pandoc.Options (ReaderOptions(readerExtensions))
|
||||
import Text.Pandoc.Lua.Compat (loadstring)
|
||||
import Text.Pandoc.Lua.StackInstances ()
|
||||
import Text.Pandoc.Readers (Reader (..), getReader)
|
||||
|
||||
-- | Push the "pandoc" on the lua stack.
|
||||
pushPandocModule :: Maybe FilePath -> LuaState -> IO ()
|
||||
pushPandocModule datadir lua = do
|
||||
script <- pandocModuleScript datadir
|
||||
status <- loadstring lua script "pandoc.lua"
|
||||
unless (status /= 0) $ call lua 0 1
|
||||
push lua "__read"
|
||||
pushhsfunction lua read_doc
|
||||
rawset lua (-3)
|
||||
pushPandocModule :: Maybe FilePath -> Lua ()
|
||||
pushPandocModule datadir = do
|
||||
script <- liftIO (pandocModuleScript datadir)
|
||||
status <- loadstring script
|
||||
unless (status /= OK) $ call 0 1
|
||||
push "__read"
|
||||
pushHaskellFunction readDoc
|
||||
rawset (-3)
|
||||
|
||||
-- | Get the string representation of the pandoc module
|
||||
pandocModuleScript :: Maybe FilePath -> IO String
|
||||
pandocModuleScript datadir = unpack <$>
|
||||
runIOorExplode (setUserDataDir datadir >> readDataFile "pandoc.lua")
|
||||
|
||||
read_doc :: String -> String -> IO (Either String Pandoc)
|
||||
read_doc formatSpec content = do
|
||||
readDoc :: String -> String -> Lua (Either String Pandoc)
|
||||
readDoc formatSpec content = liftIO $ do
|
||||
case getReader formatSpec of
|
||||
Left s -> return $ Left s
|
||||
Right (reader, es) ->
|
||||
|
|
|
|||
|
|
@ -36,81 +36,9 @@ Shared StackValue instances for pandoc and generic types.
|
|||
-}
|
||||
module Text.Pandoc.Lua.SharedInstances () where
|
||||
|
||||
import Scripting.Lua (LTYPE (..), StackValue (..), newtable)
|
||||
import Text.Pandoc.Lua.Util (addRawInt, addValue, getRawInt, keyValuePairs)
|
||||
import Foreign.Lua (ToLuaStack (push))
|
||||
|
||||
import qualified Data.Map as M
|
||||
import qualified Text.Pandoc.UTF8 as UTF8
|
||||
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
instance {-# OVERLAPS #-} StackValue [Char] where
|
||||
#else
|
||||
instance StackValue [Char] where
|
||||
#endif
|
||||
push lua cs = push lua (UTF8.fromString cs)
|
||||
peek lua i = fmap UTF8.toString <$> peek lua i
|
||||
valuetype _ = TSTRING
|
||||
|
||||
instance (StackValue a, StackValue b) => StackValue (a, b) where
|
||||
push lua (a, b) = do
|
||||
newtable lua
|
||||
addRawInt lua 1 a
|
||||
addRawInt lua 2 b
|
||||
peek lua idx = do
|
||||
a <- getRawInt lua idx 1
|
||||
b <- getRawInt lua idx 2
|
||||
return $ (,) <$> a <*> b
|
||||
valuetype _ = TTABLE
|
||||
|
||||
instance (StackValue a, StackValue b, StackValue c) =>
|
||||
StackValue (a, b, c)
|
||||
where
|
||||
push lua (a, b, c) = do
|
||||
newtable lua
|
||||
addRawInt lua 1 a
|
||||
addRawInt lua 2 b
|
||||
addRawInt lua 3 c
|
||||
peek lua idx = do
|
||||
a <- getRawInt lua idx 1
|
||||
b <- getRawInt lua idx 2
|
||||
c <- getRawInt lua idx 3
|
||||
return $ (,,) <$> a <*> b <*> c
|
||||
valuetype _ = TTABLE
|
||||
|
||||
instance (StackValue a, StackValue b, StackValue c,
|
||||
StackValue d, StackValue e) =>
|
||||
StackValue (a, b, c, d, e)
|
||||
where
|
||||
push lua (a, b, c, d, e) = do
|
||||
newtable lua
|
||||
addRawInt lua 1 a
|
||||
addRawInt lua 2 b
|
||||
addRawInt lua 3 c
|
||||
addRawInt lua 4 d
|
||||
addRawInt lua 5 e
|
||||
peek lua idx = do
|
||||
a <- getRawInt lua idx 1
|
||||
b <- getRawInt lua idx 2
|
||||
c <- getRawInt lua idx 3
|
||||
d <- getRawInt lua idx 4
|
||||
e <- getRawInt lua idx 5
|
||||
return $ (,,,,) <$> a <*> b <*> c <*> d <*> e
|
||||
valuetype _ = TTABLE
|
||||
|
||||
instance (Ord a, StackValue a, StackValue b) =>
|
||||
StackValue (M.Map a b) where
|
||||
push lua m = do
|
||||
newtable lua
|
||||
mapM_ (uncurry $ addValue lua) $ M.toList m
|
||||
peek lua idx = fmap M.fromList <$> keyValuePairs lua idx
|
||||
valuetype _ = TTABLE
|
||||
|
||||
instance (StackValue a, StackValue b) => StackValue (Either a b) where
|
||||
push lua = \case
|
||||
Left x -> push lua x
|
||||
Right x -> push lua x
|
||||
peek lua idx = peek lua idx >>= \case
|
||||
Just left -> return . Just $ Left left
|
||||
Nothing -> fmap Right <$> peek lua idx
|
||||
valuetype (Left x) = valuetype x
|
||||
valuetype (Right x) = valuetype x
|
||||
instance (ToLuaStack a, ToLuaStack b) => ToLuaStack (Either a b) where
|
||||
push = \case
|
||||
Left x -> push x
|
||||
Right x -> push x
|
||||
|
|
|
|||
|
|
@ -33,243 +33,244 @@ StackValue instances for pandoc types.
|
|||
module Text.Pandoc.Lua.StackInstances () where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Scripting.Lua (LTYPE (..), LuaState, StackValue (..), ltype, newtable,
|
||||
objlen)
|
||||
import Foreign.Lua (Lua, Type (..), FromLuaStack (peek), ToLuaStack (push),
|
||||
StackIndex, peekEither, throwLuaError)
|
||||
import Foreign.Lua.Api (getfield, ltype, newtable, pop, rawlen)
|
||||
import Text.Pandoc.Definition
|
||||
import Text.Pandoc.Lua.SharedInstances ()
|
||||
import Text.Pandoc.Lua.Util (addValue, getTable, pushViaConstructor)
|
||||
import Text.Pandoc.Shared (safeRead)
|
||||
|
||||
instance StackValue Pandoc where
|
||||
push lua (Pandoc meta blocks) = do
|
||||
newtable lua
|
||||
addValue lua "blocks" blocks
|
||||
addValue lua "meta" meta
|
||||
peek lua idx = do
|
||||
blocks <- getTable lua idx "blocks"
|
||||
meta <- getTable lua idx "meta"
|
||||
return $ Pandoc <$> meta <*> blocks
|
||||
valuetype _ = TTABLE
|
||||
instance ToLuaStack Pandoc where
|
||||
push (Pandoc meta blocks) = do
|
||||
newtable
|
||||
addValue "blocks" blocks
|
||||
addValue "meta" meta
|
||||
instance FromLuaStack Pandoc where
|
||||
peek idx = do
|
||||
blocks <- getTable idx "blocks"
|
||||
meta <- getTable idx "meta"
|
||||
return $ Pandoc meta blocks
|
||||
|
||||
instance StackValue Meta where
|
||||
push lua (Meta mmap) = push lua mmap
|
||||
peek lua idx = fmap Meta <$> peek lua idx
|
||||
valuetype _ = TTABLE
|
||||
instance ToLuaStack Meta where
|
||||
push (Meta mmap) = push mmap
|
||||
instance FromLuaStack Meta where
|
||||
peek idx = Meta <$> peek idx
|
||||
|
||||
instance StackValue MetaValue where
|
||||
instance ToLuaStack MetaValue where
|
||||
push = pushMetaValue
|
||||
instance FromLuaStack MetaValue where
|
||||
peek = peekMetaValue
|
||||
valuetype = \case
|
||||
MetaBlocks _ -> TTABLE
|
||||
MetaBool _ -> TBOOLEAN
|
||||
MetaInlines _ -> TTABLE
|
||||
MetaList _ -> TTABLE
|
||||
MetaMap _ -> TTABLE
|
||||
MetaString _ -> TSTRING
|
||||
|
||||
instance StackValue Block where
|
||||
instance ToLuaStack Block where
|
||||
push = pushBlock
|
||||
|
||||
instance FromLuaStack Block where
|
||||
peek = peekBlock
|
||||
valuetype _ = TTABLE
|
||||
|
||||
instance StackValue Inline where
|
||||
-- Inline
|
||||
instance ToLuaStack Inline where
|
||||
push = pushInline
|
||||
|
||||
instance FromLuaStack Inline where
|
||||
peek = peekInline
|
||||
valuetype _ = TTABLE
|
||||
|
||||
instance StackValue Citation where
|
||||
push lua (Citation cid prefix suffix mode noteNum hash) =
|
||||
pushViaConstructor lua "Citation" cid mode prefix suffix noteNum hash
|
||||
peek lua idx = do
|
||||
id' <- getTable lua idx "citationId"
|
||||
prefix <- getTable lua idx "citationPrefix"
|
||||
suffix <- getTable lua idx "citationSuffix"
|
||||
mode <- getTable lua idx "citationMode"
|
||||
num <- getTable lua idx "citationNoteNum"
|
||||
hash <- getTable lua idx "citationHash"
|
||||
return $ Citation <$> id' <*> prefix <*> suffix <*> mode <*> num <*> hash
|
||||
valuetype _ = TTABLE
|
||||
-- Citation
|
||||
instance ToLuaStack Citation where
|
||||
push (Citation cid prefix suffix mode noteNum hash) =
|
||||
pushViaConstructor "Citation" cid mode prefix suffix noteNum hash
|
||||
|
||||
instance StackValue Alignment where
|
||||
push lua = push lua . show
|
||||
peek lua idx = (>>= safeRead) <$> peek lua idx
|
||||
valuetype _ = TSTRING
|
||||
instance FromLuaStack Citation where
|
||||
peek idx = do
|
||||
id' <- getTable idx "citationId"
|
||||
prefix <- getTable idx "citationPrefix"
|
||||
suffix <- getTable idx "citationSuffix"
|
||||
mode <- getTable idx "citationMode"
|
||||
num <- getTable idx "citationNoteNum"
|
||||
hash <- getTable idx "citationHash"
|
||||
return $ Citation id' prefix suffix mode num hash
|
||||
|
||||
instance StackValue CitationMode where
|
||||
push lua = push lua . show
|
||||
peek lua idx = (>>= safeRead) <$> peek lua idx
|
||||
valuetype _ = TSTRING
|
||||
instance ToLuaStack Alignment where
|
||||
push = push . show
|
||||
instance FromLuaStack Alignment where
|
||||
peek idx = safeRead' =<< peek idx
|
||||
|
||||
instance StackValue Format where
|
||||
push lua (Format f) = push lua f
|
||||
peek lua idx = fmap Format <$> peek lua idx
|
||||
valuetype _ = TSTRING
|
||||
instance ToLuaStack CitationMode where
|
||||
push = push . show
|
||||
instance FromLuaStack CitationMode where
|
||||
peek idx = safeRead' =<< peek idx
|
||||
|
||||
instance StackValue ListNumberDelim where
|
||||
push lua = push lua . show
|
||||
peek lua idx = (>>= safeRead) <$> peek lua idx
|
||||
valuetype _ = TSTRING
|
||||
instance ToLuaStack Format where
|
||||
push (Format f) = push f
|
||||
instance FromLuaStack Format where
|
||||
peek idx = Format <$> peek idx
|
||||
|
||||
instance StackValue ListNumberStyle where
|
||||
push lua = push lua . show
|
||||
peek lua idx = (>>= safeRead) <$> peek lua idx
|
||||
valuetype _ = TSTRING
|
||||
instance ToLuaStack ListNumberDelim where
|
||||
push = push . show
|
||||
instance FromLuaStack ListNumberDelim where
|
||||
peek idx = safeRead' =<< peek idx
|
||||
|
||||
instance StackValue MathType where
|
||||
push lua = push lua . show
|
||||
peek lua idx = (>>= safeRead) <$> peek lua idx
|
||||
valuetype _ = TSTRING
|
||||
instance ToLuaStack ListNumberStyle where
|
||||
push = push . show
|
||||
instance FromLuaStack ListNumberStyle where
|
||||
peek idx = safeRead' =<< peek idx
|
||||
|
||||
instance StackValue QuoteType where
|
||||
push lua = push lua . show
|
||||
peek lua idx = (>>= safeRead) <$> peek lua idx
|
||||
valuetype _ = TSTRING
|
||||
instance ToLuaStack MathType where
|
||||
push = push . show
|
||||
instance FromLuaStack MathType where
|
||||
peek idx = safeRead' =<< peek idx
|
||||
|
||||
instance ToLuaStack QuoteType where
|
||||
push = push . show
|
||||
instance FromLuaStack QuoteType where
|
||||
peek idx = safeRead' =<< peek idx
|
||||
|
||||
safeRead' :: Read a => String -> Lua a
|
||||
safeRead' s = case safeRead s of
|
||||
Nothing -> throwLuaError ("Could not read: " ++ s)
|
||||
Just x -> return x
|
||||
|
||||
-- | Push an meta value element to the top of the lua stack.
|
||||
pushMetaValue :: LuaState -> MetaValue -> IO ()
|
||||
pushMetaValue lua = \case
|
||||
MetaBlocks blcks -> pushViaConstructor lua "MetaBlocks" blcks
|
||||
MetaBool bool -> push lua bool
|
||||
MetaInlines inlns -> pushViaConstructor lua "MetaInlines" inlns
|
||||
MetaList metalist -> pushViaConstructor lua "MetaList" metalist
|
||||
MetaMap metamap -> pushViaConstructor lua "MetaMap" metamap
|
||||
MetaString str -> push lua str
|
||||
pushMetaValue :: MetaValue -> Lua ()
|
||||
pushMetaValue = \case
|
||||
MetaBlocks blcks -> pushViaConstructor "MetaBlocks" blcks
|
||||
MetaBool bool -> push bool
|
||||
MetaInlines inlns -> pushViaConstructor "MetaInlines" inlns
|
||||
MetaList metalist -> pushViaConstructor "MetaList" metalist
|
||||
MetaMap metamap -> pushViaConstructor "MetaMap" metamap
|
||||
MetaString str -> push str
|
||||
|
||||
-- | Interpret the value at the given stack index as meta value.
|
||||
peekMetaValue :: LuaState -> Int -> IO (Maybe MetaValue)
|
||||
peekMetaValue lua idx = do
|
||||
peekMetaValue :: StackIndex -> Lua MetaValue
|
||||
peekMetaValue idx = do
|
||||
-- Get the contents of an AST element.
|
||||
let elementContent :: StackValue a => IO (Maybe a)
|
||||
elementContent = peek lua idx
|
||||
luatype <- ltype lua idx
|
||||
let elementContent :: FromLuaStack a => Lua a
|
||||
elementContent = peek idx
|
||||
luatype <- ltype idx
|
||||
case luatype of
|
||||
TBOOLEAN -> fmap MetaBool <$> peek lua idx
|
||||
TSTRING -> fmap MetaString <$> peek lua idx
|
||||
TTABLE -> do
|
||||
tag <- getTable lua idx "t"
|
||||
TypeBoolean -> MetaBool <$> peek idx
|
||||
TypeString -> MetaString <$> peek idx
|
||||
TypeTable -> do
|
||||
tag <- getfield idx "t" *> peekEither (-1) <* pop 1
|
||||
case tag of
|
||||
Just "MetaBlocks" -> fmap MetaBlocks <$> elementContent
|
||||
Just "MetaBool" -> fmap MetaBool <$> elementContent
|
||||
Just "MetaMap" -> fmap MetaMap <$> elementContent
|
||||
Just "MetaInlines" -> fmap MetaInlines <$> elementContent
|
||||
Just "MetaList" -> fmap MetaList <$> elementContent
|
||||
Just "MetaString" -> fmap MetaString <$> elementContent
|
||||
Nothing -> do
|
||||
Right "MetaBlocks" -> MetaBlocks <$> elementContent
|
||||
Right "MetaBool" -> MetaBool <$> elementContent
|
||||
Right "MetaMap" -> MetaMap <$> elementContent
|
||||
Right "MetaInlines" -> MetaInlines <$> elementContent
|
||||
Right "MetaList" -> MetaList <$> elementContent
|
||||
Right "MetaString" -> MetaString <$> elementContent
|
||||
Right t -> throwLuaError ("Unknown meta tag: " ++ t)
|
||||
Left _ -> do
|
||||
-- no meta value tag given, try to guess.
|
||||
len <- objlen lua idx
|
||||
len <- rawlen idx
|
||||
if len <= 0
|
||||
then fmap MetaMap <$> peek lua idx
|
||||
else (fmap MetaInlines <$> peek lua idx)
|
||||
<|> (fmap MetaBlocks <$> peek lua idx)
|
||||
<|> (fmap MetaList <$> peek lua idx)
|
||||
_ -> return Nothing
|
||||
_ -> return Nothing
|
||||
then MetaMap <$> peek idx
|
||||
else (MetaInlines <$> peek idx)
|
||||
<|> (MetaBlocks <$> peek idx)
|
||||
<|> (MetaList <$> peek idx)
|
||||
_ -> throwLuaError ("could not get meta value")
|
||||
|
||||
-- | Push an block element to the top of the lua stack.
|
||||
pushBlock :: LuaState -> Block -> IO ()
|
||||
pushBlock lua = \case
|
||||
BlockQuote blcks -> pushViaConstructor lua "BlockQuote" blcks
|
||||
BulletList items -> pushViaConstructor lua "BulletList" items
|
||||
CodeBlock attr code -> pushViaConstructor lua "CodeBlock" code (LuaAttr attr)
|
||||
DefinitionList items -> pushViaConstructor lua "DefinitionList" items
|
||||
Div attr blcks -> pushViaConstructor lua "Div" blcks (LuaAttr attr)
|
||||
Header lvl attr inlns -> pushViaConstructor lua "Header" lvl inlns (LuaAttr attr)
|
||||
HorizontalRule -> pushViaConstructor lua "HorizontalRule"
|
||||
LineBlock blcks -> pushViaConstructor lua "LineBlock" blcks
|
||||
OrderedList lstAttr list -> pushViaConstructor lua "OrderedList" list lstAttr
|
||||
Null -> pushViaConstructor lua "Null"
|
||||
Para blcks -> pushViaConstructor lua "Para" blcks
|
||||
Plain blcks -> pushViaConstructor lua "Plain" blcks
|
||||
RawBlock f cs -> pushViaConstructor lua "RawBlock" f cs
|
||||
pushBlock :: Block -> Lua ()
|
||||
pushBlock = \case
|
||||
BlockQuote blcks -> pushViaConstructor "BlockQuote" blcks
|
||||
BulletList items -> pushViaConstructor "BulletList" items
|
||||
CodeBlock attr code -> pushViaConstructor "CodeBlock" code (LuaAttr attr)
|
||||
DefinitionList items -> pushViaConstructor "DefinitionList" items
|
||||
Div attr blcks -> pushViaConstructor "Div" blcks (LuaAttr attr)
|
||||
Header lvl attr inlns -> pushViaConstructor "Header" lvl inlns (LuaAttr attr)
|
||||
HorizontalRule -> pushViaConstructor "HorizontalRule"
|
||||
LineBlock blcks -> pushViaConstructor "LineBlock" blcks
|
||||
OrderedList lstAttr list -> pushViaConstructor "OrderedList" list lstAttr
|
||||
Null -> pushViaConstructor "Null"
|
||||
Para blcks -> pushViaConstructor "Para" blcks
|
||||
Plain blcks -> pushViaConstructor "Plain" blcks
|
||||
RawBlock f cs -> pushViaConstructor "RawBlock" f cs
|
||||
Table capt aligns widths headers rows ->
|
||||
pushViaConstructor lua "Table" capt aligns widths headers rows
|
||||
pushViaConstructor "Table" capt aligns widths headers rows
|
||||
|
||||
-- | Return the value at the given index as block if possible.
|
||||
peekBlock :: LuaState -> Int -> IO (Maybe Block)
|
||||
peekBlock lua idx = do
|
||||
tag <- getTable lua idx "t"
|
||||
peekBlock :: StackIndex -> Lua Block
|
||||
peekBlock idx = do
|
||||
tag <- getTable idx "t"
|
||||
case tag of
|
||||
Nothing -> return Nothing
|
||||
Just t -> case t of
|
||||
"BlockQuote" -> fmap BlockQuote <$> elementContent
|
||||
"BulletList" -> fmap BulletList <$> elementContent
|
||||
"CodeBlock" -> fmap (withAttr CodeBlock) <$> elementContent
|
||||
"DefinitionList" -> fmap DefinitionList <$> elementContent
|
||||
"Div" -> fmap (withAttr Div) <$> elementContent
|
||||
"Header" -> fmap (\(lvl, LuaAttr attr, lst) -> Header lvl attr lst)
|
||||
"BlockQuote" -> BlockQuote <$> elementContent
|
||||
"BulletList" -> BulletList <$> elementContent
|
||||
"CodeBlock" -> (withAttr CodeBlock) <$> elementContent
|
||||
"DefinitionList" -> DefinitionList <$> elementContent
|
||||
"Div" -> (withAttr Div) <$> elementContent
|
||||
"Header" -> (\(lvl, LuaAttr attr, lst) -> Header lvl attr lst)
|
||||
<$> elementContent
|
||||
"HorizontalRule" -> return (Just HorizontalRule)
|
||||
"LineBlock" -> fmap LineBlock <$> elementContent
|
||||
"OrderedList" -> fmap (uncurry OrderedList) <$> elementContent
|
||||
"Null" -> return (Just Null)
|
||||
"Para" -> fmap Para <$> elementContent
|
||||
"Plain" -> fmap Plain <$> elementContent
|
||||
"RawBlock" -> fmap (uncurry RawBlock) <$> elementContent
|
||||
"Table" -> fmap (\(capt, aligns, widths, headers, body) ->
|
||||
"HorizontalRule" -> return HorizontalRule
|
||||
"LineBlock" -> LineBlock <$> elementContent
|
||||
"OrderedList" -> (uncurry OrderedList) <$> elementContent
|
||||
"Null" -> return Null
|
||||
"Para" -> Para <$> elementContent
|
||||
"Plain" -> Plain <$> elementContent
|
||||
"RawBlock" -> (uncurry RawBlock) <$> elementContent
|
||||
"Table" -> (\(capt, aligns, widths, headers, body) ->
|
||||
Table capt aligns widths headers body)
|
||||
<$> elementContent
|
||||
_ -> return Nothing
|
||||
_ -> throwLuaError ("Unknown block type: " ++ tag)
|
||||
where
|
||||
-- Get the contents of an AST element.
|
||||
elementContent :: StackValue a => IO (Maybe a)
|
||||
elementContent = getTable lua idx "c"
|
||||
elementContent :: FromLuaStack a => Lua a
|
||||
elementContent = getTable idx "c"
|
||||
|
||||
-- | Push an inline element to the top of the lua stack.
|
||||
pushInline :: LuaState -> Inline -> IO ()
|
||||
pushInline lua = \case
|
||||
Cite citations lst -> pushViaConstructor lua "Cite" lst citations
|
||||
Code attr lst -> pushViaConstructor lua "Code" lst (LuaAttr attr)
|
||||
Emph inlns -> pushViaConstructor lua "Emph" inlns
|
||||
Image attr alt (src,tit) -> pushViaConstructor lua "Image" alt src tit (LuaAttr attr)
|
||||
LineBreak -> pushViaConstructor lua "LineBreak"
|
||||
Link attr lst (src,tit) -> pushViaConstructor lua "Link" lst src tit (LuaAttr attr)
|
||||
Note blcks -> pushViaConstructor lua "Note" blcks
|
||||
Math mty str -> pushViaConstructor lua "Math" mty str
|
||||
Quoted qt inlns -> pushViaConstructor lua "Quoted" qt inlns
|
||||
RawInline f cs -> pushViaConstructor lua "RawInline" f cs
|
||||
SmallCaps inlns -> pushViaConstructor lua "SmallCaps" inlns
|
||||
SoftBreak -> pushViaConstructor lua "SoftBreak"
|
||||
Space -> pushViaConstructor lua "Space"
|
||||
Span attr inlns -> pushViaConstructor lua "Span" inlns (LuaAttr attr)
|
||||
Str str -> pushViaConstructor lua "Str" str
|
||||
Strikeout inlns -> pushViaConstructor lua "Strikeout" inlns
|
||||
Strong inlns -> pushViaConstructor lua "Strong" inlns
|
||||
Subscript inlns -> pushViaConstructor lua "Subscript" inlns
|
||||
Superscript inlns -> pushViaConstructor lua "Superscript" inlns
|
||||
pushInline :: Inline -> Lua ()
|
||||
pushInline = \case
|
||||
Cite citations lst -> pushViaConstructor "Cite" lst citations
|
||||
Code attr lst -> pushViaConstructor "Code" lst (LuaAttr attr)
|
||||
Emph inlns -> pushViaConstructor "Emph" inlns
|
||||
Image attr alt (src,tit) -> pushViaConstructor "Image" alt src tit (LuaAttr attr)
|
||||
LineBreak -> pushViaConstructor "LineBreak"
|
||||
Link attr lst (src,tit) -> pushViaConstructor "Link" lst src tit (LuaAttr attr)
|
||||
Note blcks -> pushViaConstructor "Note" blcks
|
||||
Math mty str -> pushViaConstructor "Math" mty str
|
||||
Quoted qt inlns -> pushViaConstructor "Quoted" qt inlns
|
||||
RawInline f cs -> pushViaConstructor "RawInline" f cs
|
||||
SmallCaps inlns -> pushViaConstructor "SmallCaps" inlns
|
||||
SoftBreak -> pushViaConstructor "SoftBreak"
|
||||
Space -> pushViaConstructor "Space"
|
||||
Span attr inlns -> pushViaConstructor "Span" inlns (LuaAttr attr)
|
||||
Str str -> pushViaConstructor "Str" str
|
||||
Strikeout inlns -> pushViaConstructor "Strikeout" inlns
|
||||
Strong inlns -> pushViaConstructor "Strong" inlns
|
||||
Subscript inlns -> pushViaConstructor "Subscript" inlns
|
||||
Superscript inlns -> pushViaConstructor "Superscript" inlns
|
||||
|
||||
-- | Return the value at the given index as inline if possible.
|
||||
peekInline :: LuaState -> Int -> IO (Maybe Inline)
|
||||
peekInline lua idx = do
|
||||
tag <- getTable lua idx "t"
|
||||
peekInline :: StackIndex -> Lua Inline
|
||||
peekInline idx = do
|
||||
tag <- getTable idx "t"
|
||||
case tag of
|
||||
Nothing -> return Nothing
|
||||
Just t -> case t of
|
||||
"Cite" -> fmap (uncurry Cite) <$> elementContent
|
||||
"Code" -> fmap (withAttr Code) <$> elementContent
|
||||
"Emph" -> fmap Emph <$> elementContent
|
||||
"Image" -> fmap (\(LuaAttr attr, lst, tgt) -> Image attr lst tgt)
|
||||
"Cite" -> (uncurry Cite) <$> elementContent
|
||||
"Code" -> (withAttr Code) <$> elementContent
|
||||
"Emph" -> Emph <$> elementContent
|
||||
"Image" -> (\(LuaAttr attr, lst, tgt) -> Image attr lst tgt)
|
||||
<$> elementContent
|
||||
"Link" -> fmap (\(LuaAttr attr, lst, tgt) -> Link attr lst tgt)
|
||||
"Link" -> (\(LuaAttr attr, lst, tgt) -> Link attr lst tgt)
|
||||
<$> elementContent
|
||||
"LineBreak" -> return (Just LineBreak)
|
||||
"Note" -> fmap Note <$> elementContent
|
||||
"Math" -> fmap (uncurry Math) <$> elementContent
|
||||
"Quoted" -> fmap (uncurry Quoted) <$> elementContent
|
||||
"RawInline" -> fmap (uncurry RawInline) <$> elementContent
|
||||
"SmallCaps" -> fmap SmallCaps <$> elementContent
|
||||
"SoftBreak" -> return (Just SoftBreak)
|
||||
"Space" -> return (Just Space)
|
||||
"Span" -> fmap (withAttr Span) <$> elementContent
|
||||
"Str" -> fmap Str <$> elementContent
|
||||
"Strikeout" -> fmap Strikeout <$> elementContent
|
||||
"Strong" -> fmap Strong <$> elementContent
|
||||
"Subscript" -> fmap Subscript <$> elementContent
|
||||
"Superscript"-> fmap Superscript <$> elementContent
|
||||
_ -> return Nothing
|
||||
"LineBreak" -> return LineBreak
|
||||
"Note" -> Note <$> elementContent
|
||||
"Math" -> (uncurry Math) <$> elementContent
|
||||
"Quoted" -> (uncurry Quoted) <$> elementContent
|
||||
"RawInline" -> (uncurry RawInline) <$> elementContent
|
||||
"SmallCaps" -> SmallCaps <$> elementContent
|
||||
"SoftBreak" -> return SoftBreak
|
||||
"Space" -> return Space
|
||||
"Span" -> (withAttr Span) <$> elementContent
|
||||
"Str" -> Str <$> elementContent
|
||||
"Strikeout" -> Strikeout <$> elementContent
|
||||
"Strong" -> Strong <$> elementContent
|
||||
"Subscript" -> Subscript <$> elementContent
|
||||
"Superscript"-> Superscript <$> elementContent
|
||||
_ -> throwLuaError ("Unknown inline type: " ++ tag)
|
||||
where
|
||||
-- Get the contents of an AST element.
|
||||
elementContent :: StackValue a => IO (Maybe a)
|
||||
elementContent = getTable lua idx "c"
|
||||
elementContent :: FromLuaStack a => Lua a
|
||||
elementContent = getTable idx "c"
|
||||
|
||||
withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b
|
||||
withAttr f (attributes, x) = f (fromLuaAttr attributes) x
|
||||
|
|
@ -277,8 +278,8 @@ withAttr f (attributes, x) = f (fromLuaAttr attributes) x
|
|||
-- | Wrapper for Attr
|
||||
newtype LuaAttr = LuaAttr { fromLuaAttr :: Attr }
|
||||
|
||||
instance StackValue LuaAttr where
|
||||
push lua (LuaAttr (id', classes, kv)) =
|
||||
pushViaConstructor lua "Attr" id' classes kv
|
||||
peek lua idx = fmap LuaAttr <$> peek lua idx
|
||||
valuetype _ = TTABLE
|
||||
instance ToLuaStack LuaAttr where
|
||||
push (LuaAttr (id', classes, kv)) =
|
||||
pushViaConstructor "Attr" id' classes kv
|
||||
instance FromLuaStack LuaAttr where
|
||||
peek idx = LuaAttr <$> peek idx
|
||||
|
|
|
|||
|
|
@ -36,103 +36,79 @@ module Text.Pandoc.Lua.Util
|
|||
, getRawInt
|
||||
, setRawInt
|
||||
, addRawInt
|
||||
, keyValuePairs
|
||||
, PushViaCall
|
||||
, pushViaCall
|
||||
, pushViaConstructor
|
||||
) where
|
||||
|
||||
import Scripting.Lua (LuaState, StackValue (..), call, getglobal2, gettable,
|
||||
next, pop, pushnil, rawgeti, rawseti, settable)
|
||||
import Foreign.Lua (Lua, FromLuaStack (..), ToLuaStack (..), NumArgs,
|
||||
StackIndex, getglobal')
|
||||
import Foreign.Lua.Api (call, gettable, pop, rawgeti, rawseti, settable)
|
||||
|
||||
-- | Adjust the stack index, assuming that @n@ new elements have been pushed on
|
||||
-- the stack.
|
||||
adjustIndexBy :: Int -> Int -> Int
|
||||
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 :: (StackValue a, StackValue b) => LuaState -> Int -> a -> IO (Maybe b)
|
||||
getTable lua idx key = do
|
||||
push lua key
|
||||
gettable lua (idx `adjustIndexBy` 1)
|
||||
peek lua (-1) <* pop lua 1
|
||||
getTable :: (ToLuaStack a, FromLuaStack b) => StackIndex -> a -> Lua b
|
||||
getTable idx key = do
|
||||
push key
|
||||
gettable (idx `adjustIndexBy` 1)
|
||||
peek (-1) <* pop 1
|
||||
|
||||
-- | Set value for key for table at the given index
|
||||
setTable :: (StackValue a, StackValue b) => LuaState -> Int -> a -> b -> IO ()
|
||||
setTable lua idx key value = do
|
||||
push lua key
|
||||
push lua value
|
||||
settable lua (idx `adjustIndexBy` 2)
|
||||
setTable :: (ToLuaStack a, ToLuaStack b) => StackIndex -> a -> b -> Lua ()
|
||||
setTable idx key value = do
|
||||
push key
|
||||
push value
|
||||
settable (idx `adjustIndexBy` 2)
|
||||
|
||||
-- | Add a key-value pair to the table at the top of the stack
|
||||
addValue :: (StackValue a, StackValue b) => LuaState -> a -> b -> IO ()
|
||||
addValue lua = setTable lua (-1)
|
||||
addValue :: (ToLuaStack a, ToLuaStack b) => a -> b -> Lua ()
|
||||
addValue = setTable (-1)
|
||||
|
||||
-- | Get value behind key from table at given index.
|
||||
getRawInt :: StackValue a => LuaState -> Int -> Int -> IO (Maybe a)
|
||||
getRawInt lua idx key =
|
||||
rawgeti lua idx key
|
||||
*> peek lua (-1)
|
||||
<* pop lua 1
|
||||
getRawInt :: FromLuaStack a => StackIndex -> Int -> Lua a
|
||||
getRawInt idx key =
|
||||
rawgeti idx key
|
||||
*> peek (-1)
|
||||
<* pop 1
|
||||
|
||||
-- | Set numeric key/value in table at the given index
|
||||
setRawInt :: StackValue a => LuaState -> Int -> Int -> a -> IO ()
|
||||
setRawInt lua idx key value = do
|
||||
push lua value
|
||||
rawseti lua (idx `adjustIndexBy` 1) key
|
||||
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 :: StackValue a => LuaState -> Int -> a -> IO ()
|
||||
addRawInt lua = setRawInt lua (-1)
|
||||
|
||||
-- | Try reading the table under the given index as a list of key-value pairs.
|
||||
keyValuePairs :: (StackValue a, StackValue b)
|
||||
=> LuaState -> Int -> IO (Maybe [(a, b)])
|
||||
keyValuePairs lua idx = do
|
||||
pushnil lua
|
||||
sequence <$> remainingPairs
|
||||
where
|
||||
remainingPairs = do
|
||||
res <- nextPair
|
||||
case res of
|
||||
Nothing -> return []
|
||||
Just a -> (a:) <$> remainingPairs
|
||||
nextPair :: (StackValue a, StackValue b) => IO (Maybe (Maybe (a,b)))
|
||||
nextPair = do
|
||||
hasNext <- next lua (idx `adjustIndexBy` 1)
|
||||
if hasNext
|
||||
then do
|
||||
val <- peek lua (-1)
|
||||
key <- peek lua (-2)
|
||||
pop lua 1 -- removes the value, keeps the key
|
||||
return $ Just <$> ((,) <$> key <*> val)
|
||||
else do
|
||||
return Nothing
|
||||
addRawInt :: ToLuaStack a => Int -> a -> Lua ()
|
||||
addRawInt = setRawInt (-1)
|
||||
|
||||
-- | Helper class for pushing a single value to the stack via a lua function.
|
||||
-- See @pushViaCall@.
|
||||
class PushViaCall a where
|
||||
pushViaCall' :: LuaState -> String -> IO () -> Int -> a
|
||||
pushViaCall' :: String -> Lua () -> NumArgs -> a
|
||||
|
||||
instance PushViaCall (IO ()) where
|
||||
pushViaCall' lua fn pushArgs num = do
|
||||
getglobal2 lua fn
|
||||
instance PushViaCall (Lua ()) where
|
||||
pushViaCall' fn pushArgs num = do
|
||||
getglobal' fn
|
||||
pushArgs
|
||||
call lua num 1
|
||||
call num 1
|
||||
|
||||
instance (StackValue a, PushViaCall b) => PushViaCall (a -> b) where
|
||||
pushViaCall' lua fn pushArgs num x =
|
||||
pushViaCall' lua fn (pushArgs *> push lua x) (num + 1)
|
||||
instance (ToLuaStack a, PushViaCall b) => PushViaCall (a -> b) where
|
||||
pushViaCall' fn pushArgs num x =
|
||||
pushViaCall' fn (pushArgs *> 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
|
||||
-- a single value.
|
||||
pushViaCall :: PushViaCall a => LuaState -> String -> a
|
||||
pushViaCall lua fn = pushViaCall' lua fn (return ()) 0
|
||||
pushViaCall :: PushViaCall a => String -> a
|
||||
pushViaCall fn = pushViaCall' fn (return ()) 0
|
||||
|
||||
-- | Call a pandoc element constructor within lua, passing all given arguments.
|
||||
pushViaConstructor :: PushViaCall a => LuaState -> String -> a
|
||||
pushViaConstructor lua pandocFn = pushViaCall lua ("pandoc." ++ pandocFn)
|
||||
pushViaConstructor :: PushViaCall a => String -> a
|
||||
pushViaConstructor pandocFn = pushViaCall ("pandoc." ++ pandocFn)
|
||||
|
|
|
|||
|
|
@ -44,10 +44,9 @@ import qualified Data.Map as M
|
|||
import Data.Text (Text, pack)
|
||||
import Data.Typeable
|
||||
import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)
|
||||
import Scripting.Lua (LuaState, StackValue, callfunc)
|
||||
import qualified Scripting.Lua as Lua
|
||||
import Foreign.Lua (Lua, ToLuaStack (..), callFunc, runLua)
|
||||
import Foreign.Lua.Api
|
||||
import Text.Pandoc.Error
|
||||
import Text.Pandoc.Lua.Compat ( loadstring )
|
||||
import Text.Pandoc.Lua.Util ( addValue )
|
||||
import Text.Pandoc.Lua.SharedInstances ()
|
||||
import Text.Pandoc.Definition
|
||||
|
|
@ -62,55 +61,40 @@ attrToMap (id',classes,keyvals) = M.fromList
|
|||
: ("class", unwords classes)
|
||||
: keyvals
|
||||
|
||||
instance StackValue Format where
|
||||
push lua (Format f) = Lua.push lua (map toLower f)
|
||||
peek l n = fmap Format `fmap` Lua.peek l n
|
||||
valuetype _ = Lua.TSTRING
|
||||
instance ToLuaStack Format where
|
||||
push (Format f) = push (map toLower f)
|
||||
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
instance {-# OVERLAPS #-} StackValue [Inline] where
|
||||
instance {-# OVERLAPS #-} ToLuaStack [Inline] where
|
||||
#else
|
||||
instance StackValue [Inline] where
|
||||
instance ToLuaStack [Inline] where
|
||||
#endif
|
||||
push l ils = Lua.push l =<< inlineListToCustom l ils
|
||||
peek _ _ = undefined
|
||||
valuetype _ = Lua.TSTRING
|
||||
push ils = push =<< inlineListToCustom ils
|
||||
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
instance {-# OVERLAPS #-} StackValue [Block] where
|
||||
instance {-# OVERLAPS #-} ToLuaStack [Block] where
|
||||
#else
|
||||
instance StackValue [Block] where
|
||||
instance ToLuaStack [Block] where
|
||||
#endif
|
||||
push l ils = Lua.push l =<< blockListToCustom l ils
|
||||
peek _ _ = undefined
|
||||
valuetype _ = Lua.TSTRING
|
||||
push ils = push =<< blockListToCustom ils
|
||||
|
||||
instance StackValue MetaValue where
|
||||
push l (MetaMap m) = Lua.push l m
|
||||
push l (MetaList xs) = Lua.push l xs
|
||||
push l (MetaBool x) = Lua.push l x
|
||||
push l (MetaString s) = Lua.push l s
|
||||
push l (MetaInlines ils) = Lua.push l ils
|
||||
push l (MetaBlocks bs) = Lua.push l bs
|
||||
peek _ _ = undefined
|
||||
valuetype (MetaMap _) = Lua.TTABLE
|
||||
valuetype (MetaList _) = Lua.TTABLE
|
||||
valuetype (MetaBool _) = Lua.TBOOLEAN
|
||||
valuetype (MetaString _) = Lua.TSTRING
|
||||
valuetype (MetaInlines _) = Lua.TSTRING
|
||||
valuetype (MetaBlocks _) = Lua.TSTRING
|
||||
instance ToLuaStack MetaValue where
|
||||
push (MetaMap m) = push m
|
||||
push (MetaList xs) = push xs
|
||||
push (MetaBool x) = push x
|
||||
push (MetaString s) = push s
|
||||
push (MetaInlines ils) = push ils
|
||||
push (MetaBlocks bs) = push bs
|
||||
|
||||
instance StackValue Citation where
|
||||
push lua cit = do
|
||||
Lua.createtable lua 6 0
|
||||
addValue lua "citationId" $ citationId cit
|
||||
addValue lua "citationPrefix" $ citationPrefix cit
|
||||
addValue lua "citationSuffix" $ citationSuffix cit
|
||||
addValue lua "citationMode" $ show (citationMode cit)
|
||||
addValue lua "citationNoteNum" $ citationNoteNum cit
|
||||
addValue lua "citationHash" $ citationHash cit
|
||||
peek = undefined
|
||||
valuetype _ = Lua.TTABLE
|
||||
instance ToLuaStack Citation where
|
||||
push cit = do
|
||||
createtable 6 0
|
||||
addValue "citationId" $ citationId cit
|
||||
addValue "citationPrefix" $ citationPrefix cit
|
||||
addValue "citationSuffix" $ citationSuffix cit
|
||||
addValue "citationMode" $ show (citationMode cit)
|
||||
addValue "citationNoteNum" $ citationNoteNum cit
|
||||
addValue "citationHash" $ citationHash cit
|
||||
|
||||
data PandocLuaException = PandocLuaException String
|
||||
deriving (Show, Typeable)
|
||||
|
|
@ -123,23 +107,22 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
|
|||
luaScript <- UTF8.readFile luaFile
|
||||
enc <- getForeignEncoding
|
||||
setForeignEncoding utf8
|
||||
lua <- Lua.newstate
|
||||
Lua.openlibs lua
|
||||
status <- loadstring lua luaScript luaFile
|
||||
(body, context) <- runLua $ do
|
||||
openlibs
|
||||
stat <- loadstring luaScript
|
||||
-- check for error in lua script (later we'll change the return type
|
||||
-- to handle this more gracefully):
|
||||
when (status /= 0) $
|
||||
Lua.tostring lua 1 >>= throw . PandocLuaException . UTF8.toString
|
||||
Lua.call lua 0 0
|
||||
when (stat /= OK) $
|
||||
tostring 1 >>= throw . PandocLuaException . UTF8.toString
|
||||
call 0 0
|
||||
-- TODO - call hierarchicalize, so we have that info
|
||||
rendered <- docToCustom lua opts doc
|
||||
rendered <- docToCustom opts doc
|
||||
context <- metaToJSON opts
|
||||
(blockListToCustom lua)
|
||||
(inlineListToCustom lua)
|
||||
blockListToCustom
|
||||
inlineListToCustom
|
||||
meta
|
||||
Lua.close lua
|
||||
return (rendered, context)
|
||||
setForeignEncoding enc
|
||||
let body = rendered
|
||||
case writerTemplate opts of
|
||||
Nothing -> return $ pack body
|
||||
Just tpl ->
|
||||
|
|
@ -147,117 +130,115 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
|
|||
Left e -> throw (PandocTemplateError e)
|
||||
Right r -> return (pack r)
|
||||
|
||||
docToCustom :: LuaState -> WriterOptions -> Pandoc -> IO String
|
||||
docToCustom lua opts (Pandoc (Meta metamap) blocks) = do
|
||||
body <- blockListToCustom lua blocks
|
||||
callfunc lua "Doc" body metamap (writerVariables opts)
|
||||
docToCustom :: WriterOptions -> Pandoc -> Lua String
|
||||
docToCustom opts (Pandoc (Meta metamap) blocks) = do
|
||||
body <- blockListToCustom blocks
|
||||
callFunc "Doc" body metamap (writerVariables opts)
|
||||
|
||||
-- | Convert Pandoc block element to Custom.
|
||||
blockToCustom :: LuaState -- ^ Lua state
|
||||
-> Block -- ^ Block element
|
||||
-> IO String
|
||||
blockToCustom :: Block -- ^ Block element
|
||||
-> Lua String
|
||||
|
||||
blockToCustom _ Null = return ""
|
||||
blockToCustom Null = return ""
|
||||
|
||||
blockToCustom lua (Plain inlines) = callfunc lua "Plain" inlines
|
||||
blockToCustom (Plain inlines) = callFunc "Plain" inlines
|
||||
|
||||
blockToCustom lua (Para [Image attr txt (src,tit)]) =
|
||||
callfunc lua "CaptionedImage" src tit txt (attrToMap attr)
|
||||
blockToCustom (Para [Image attr txt (src,tit)]) =
|
||||
callFunc "CaptionedImage" src tit txt (attrToMap attr)
|
||||
|
||||
blockToCustom lua (Para inlines) = callfunc lua "Para" inlines
|
||||
blockToCustom (Para inlines) = callFunc "Para" inlines
|
||||
|
||||
blockToCustom lua (LineBlock linesList) = callfunc lua "LineBlock" linesList
|
||||
blockToCustom (LineBlock linesList) = callFunc "LineBlock" linesList
|
||||
|
||||
blockToCustom lua (RawBlock format str) =
|
||||
callfunc lua "RawBlock" format str
|
||||
blockToCustom (RawBlock format str) =
|
||||
callFunc "RawBlock" format str
|
||||
|
||||
blockToCustom lua HorizontalRule = callfunc lua "HorizontalRule"
|
||||
blockToCustom HorizontalRule = callFunc "HorizontalRule"
|
||||
|
||||
blockToCustom lua (Header level attr inlines) =
|
||||
callfunc lua "Header" level inlines (attrToMap attr)
|
||||
blockToCustom (Header level attr inlines) =
|
||||
callFunc "Header" level inlines (attrToMap attr)
|
||||
|
||||
blockToCustom lua (CodeBlock attr str) =
|
||||
callfunc lua "CodeBlock" str (attrToMap attr)
|
||||
blockToCustom (CodeBlock attr str) =
|
||||
callFunc "CodeBlock" str (attrToMap attr)
|
||||
|
||||
blockToCustom lua (BlockQuote blocks) = callfunc lua "BlockQuote" blocks
|
||||
blockToCustom (BlockQuote blocks) = callFunc "BlockQuote" blocks
|
||||
|
||||
blockToCustom lua (Table capt aligns widths headers rows') =
|
||||
callfunc lua "Table" capt (map show aligns) widths headers rows'
|
||||
blockToCustom (Table capt aligns widths headers rows') =
|
||||
callFunc "Table" capt (map show aligns) widths headers rows'
|
||||
|
||||
blockToCustom lua (BulletList items) = callfunc lua "BulletList" items
|
||||
blockToCustom (BulletList items) = callFunc "BulletList" items
|
||||
|
||||
blockToCustom lua (OrderedList (num,sty,delim) items) =
|
||||
callfunc lua "OrderedList" items num (show sty) (show delim)
|
||||
blockToCustom (OrderedList (num,sty,delim) items) =
|
||||
callFunc "OrderedList" items num (show sty) (show delim)
|
||||
|
||||
blockToCustom lua (DefinitionList items) =
|
||||
callfunc lua "DefinitionList" items
|
||||
blockToCustom (DefinitionList items) =
|
||||
callFunc "DefinitionList" items
|
||||
|
||||
blockToCustom lua (Div attr items) =
|
||||
callfunc lua "Div" items (attrToMap attr)
|
||||
blockToCustom (Div attr items) =
|
||||
callFunc "Div" items (attrToMap attr)
|
||||
|
||||
-- | Convert list of Pandoc block elements to Custom.
|
||||
blockListToCustom :: LuaState -- ^ Options
|
||||
-> [Block] -- ^ List of block elements
|
||||
-> IO String
|
||||
blockListToCustom lua xs = do
|
||||
blocksep <- callfunc lua "Blocksep"
|
||||
bs <- mapM (blockToCustom lua) xs
|
||||
blockListToCustom :: [Block] -- ^ List of block elements
|
||||
-> Lua String
|
||||
blockListToCustom xs = do
|
||||
blocksep <- callFunc "Blocksep"
|
||||
bs <- mapM blockToCustom xs
|
||||
return $ mconcat $ intersperse blocksep bs
|
||||
|
||||
-- | Convert list of Pandoc inline elements to Custom.
|
||||
inlineListToCustom :: LuaState -> [Inline] -> IO String
|
||||
inlineListToCustom lua lst = do
|
||||
xs <- mapM (inlineToCustom lua) lst
|
||||
return $ concat xs
|
||||
inlineListToCustom :: [Inline] -> Lua String
|
||||
inlineListToCustom lst = do
|
||||
xs <- mapM inlineToCustom lst
|
||||
return $ mconcat xs
|
||||
|
||||
-- | Convert Pandoc inline element to Custom.
|
||||
inlineToCustom :: LuaState -> Inline -> IO String
|
||||
inlineToCustom :: Inline -> Lua String
|
||||
|
||||
inlineToCustom lua (Str str) = callfunc lua "Str" str
|
||||
inlineToCustom (Str str) = callFunc "Str" str
|
||||
|
||||
inlineToCustom lua Space = callfunc lua "Space"
|
||||
inlineToCustom Space = callFunc "Space"
|
||||
|
||||
inlineToCustom lua SoftBreak = callfunc lua "SoftBreak"
|
||||
inlineToCustom SoftBreak = callFunc "SoftBreak"
|
||||
|
||||
inlineToCustom lua (Emph lst) = callfunc lua "Emph" lst
|
||||
inlineToCustom (Emph lst) = callFunc "Emph" lst
|
||||
|
||||
inlineToCustom lua (Strong lst) = callfunc lua "Strong" lst
|
||||
inlineToCustom (Strong lst) = callFunc "Strong" lst
|
||||
|
||||
inlineToCustom lua (Strikeout lst) = callfunc lua "Strikeout" lst
|
||||
inlineToCustom (Strikeout lst) = callFunc "Strikeout" lst
|
||||
|
||||
inlineToCustom lua (Superscript lst) = callfunc lua "Superscript" lst
|
||||
inlineToCustom (Superscript lst) = callFunc "Superscript" lst
|
||||
|
||||
inlineToCustom lua (Subscript lst) = callfunc lua "Subscript" lst
|
||||
inlineToCustom (Subscript lst) = callFunc "Subscript" lst
|
||||
|
||||
inlineToCustom lua (SmallCaps lst) = callfunc lua "SmallCaps" lst
|
||||
inlineToCustom (SmallCaps lst) = callFunc "SmallCaps" lst
|
||||
|
||||
inlineToCustom lua (Quoted SingleQuote lst) = callfunc lua "SingleQuoted" lst
|
||||
inlineToCustom (Quoted SingleQuote lst) = callFunc "SingleQuoted" lst
|
||||
|
||||
inlineToCustom lua (Quoted DoubleQuote lst) = callfunc lua "DoubleQuoted" lst
|
||||
inlineToCustom (Quoted DoubleQuote lst) = callFunc "DoubleQuoted" lst
|
||||
|
||||
inlineToCustom lua (Cite cs lst) = callfunc lua "Cite" lst cs
|
||||
inlineToCustom (Cite cs lst) = callFunc "Cite" lst cs
|
||||
|
||||
inlineToCustom lua (Code attr str) =
|
||||
callfunc lua "Code" str (attrToMap attr)
|
||||
inlineToCustom (Code attr str) =
|
||||
callFunc "Code" str (attrToMap attr)
|
||||
|
||||
inlineToCustom lua (Math DisplayMath str) =
|
||||
callfunc lua "DisplayMath" str
|
||||
inlineToCustom (Math DisplayMath str) =
|
||||
callFunc "DisplayMath" str
|
||||
|
||||
inlineToCustom lua (Math InlineMath str) =
|
||||
callfunc lua "InlineMath" str
|
||||
inlineToCustom (Math InlineMath str) =
|
||||
callFunc "InlineMath" str
|
||||
|
||||
inlineToCustom lua (RawInline format str) =
|
||||
callfunc lua "RawInline" format str
|
||||
inlineToCustom (RawInline format str) =
|
||||
callFunc "RawInline" format str
|
||||
|
||||
inlineToCustom lua (LineBreak) = callfunc lua "LineBreak"
|
||||
inlineToCustom (LineBreak) = callFunc "LineBreak"
|
||||
|
||||
inlineToCustom lua (Link attr txt (src,tit)) =
|
||||
callfunc lua "Link" txt src tit (attrToMap attr)
|
||||
inlineToCustom (Link attr txt (src,tit)) =
|
||||
callFunc "Link" txt src tit (attrToMap attr)
|
||||
|
||||
inlineToCustom lua (Image attr alt (src,tit)) =
|
||||
callfunc lua "Image" alt src tit (attrToMap attr)
|
||||
inlineToCustom (Image attr alt (src,tit)) =
|
||||
callFunc "Image" alt src tit (attrToMap attr)
|
||||
|
||||
inlineToCustom lua (Note contents) = callfunc lua "Note" contents
|
||||
inlineToCustom (Note contents) = callFunc "Note" contents
|
||||
|
||||
inlineToCustom lua (Span attr items) =
|
||||
callfunc lua "Span" items (attrToMap attr)
|
||||
inlineToCustom (Span attr items) =
|
||||
callFunc "Span" items (attrToMap attr)
|
||||
|
|
|
|||
|
|
@ -20,6 +20,6 @@ packages:
|
|||
- '../pandoc-types'
|
||||
- '../texmath'
|
||||
extra-deps:
|
||||
- hslua-0.5.0
|
||||
- hslua-0.7.0
|
||||
- skylighting-0.3.3
|
||||
resolver: lts-8.12
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ packages:
|
|||
commit: 2e27f5cb40577c9b3ffe0fc112687084f3d9d877
|
||||
extra-dep: false
|
||||
extra-deps:
|
||||
- hslua-0.5.0
|
||||
- hslua-0.7.0
|
||||
- skylighting-0.3.3
|
||||
- cmark-gfm-0.1.1
|
||||
- QuickCheck-2.10.0.1
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ flags:
|
|||
packages:
|
||||
- '.'
|
||||
extra-deps:
|
||||
- hslua-0.5.0
|
||||
- hslua-0.7.0
|
||||
- skylighting-0.3.3
|
||||
- cmark-gfm-0.1.1
|
||||
- QuickCheck-2.10.0.1
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ import Text.Pandoc.Builder ( (<>), bulletList, doc, doubleQuoted, emph
|
|||
, space, str, strong)
|
||||
import Text.Pandoc.Lua
|
||||
|
||||
import qualified Scripting.Lua as Lua
|
||||
import Foreign.Lua
|
||||
|
||||
tests :: [TestTree]
|
||||
tests = map (localOption (QuickCheckTests 20))
|
||||
|
|
@ -71,23 +71,20 @@ assertFilterConversion msg filterPath docIn docExpected = do
|
|||
docRes <- runLuaFilter Nothing ("lua" </> filterPath) [] docIn
|
||||
assertEqual msg docExpected docRes
|
||||
|
||||
roundtripEqual :: (Eq a, Lua.StackValue a) => a -> IO Bool
|
||||
roundtripEqual :: (Eq a, FromLuaStack a, ToLuaStack a) => a -> IO Bool
|
||||
roundtripEqual x = (x ==) <$> roundtripped
|
||||
where
|
||||
roundtripped :: (Lua.StackValue a) => IO a
|
||||
roundtripped = do
|
||||
lua <- Lua.newstate
|
||||
Lua.openlibs lua
|
||||
pushPandocModule Nothing lua
|
||||
Lua.setglobal lua "pandoc"
|
||||
oldSize <- Lua.gettop lua
|
||||
Lua.push lua x
|
||||
size <- Lua.gettop lua
|
||||
roundtripped :: (FromLuaStack a, ToLuaStack a) => IO a
|
||||
roundtripped = runLua $ do
|
||||
openlibs
|
||||
pushPandocModule Nothing
|
||||
setglobal "pandoc"
|
||||
oldSize <- gettop
|
||||
push x
|
||||
size <- gettop
|
||||
when ((size - oldSize) /= 1) $
|
||||
error ("not exactly one additional element on the stack: " ++ show size)
|
||||
res <- Lua.peek lua (-1)
|
||||
retval <- case res of
|
||||
Nothing -> error "could not read from stack"
|
||||
Just y -> return y
|
||||
Lua.close lua
|
||||
return retval
|
||||
res <- peekEither (-1)
|
||||
case res of
|
||||
Left _ -> error "could not read from stack"
|
||||
Right y -> return y
|
||||
|
|
|
|||
Loading…
Reference in a new issue