blob: f35201db0a77ad892698c8ef1279dfc86a28fee6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{- |
Module : Text.Pandoc.Lua.Util
Copyright : © 2012-2021 John MacFarlane,
© 2017-2021 Albert Krewinkel
License : GNU GPL, version 2 or above
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
Stability : alpha
Lua utility functions.
-}
module Text.Pandoc.Lua.Util
( getTag
, addField
, callWithTraceback
, dofileWithTraceback
, pushViaConstr'
) where
import Control.Monad (unless, when)
import HsLua
import qualified HsLua as Lua
-- | Add a value to the table at the top of the stack at a string-index.
addField :: (LuaError e, Pushable a) => String -> a -> LuaE e ()
addField key value = do
Lua.push key
Lua.push value
Lua.rawset (Lua.nth 3)
-- | Get the tag of a value. This is an optimized and specialized version of
-- @Lua.getfield idx "tag"@. It only checks for the field on the table at index
-- @idx@ and on its metatable, also ignoring any @__index@ value on the
-- metatable.
getTag :: LuaError e => Peeker e Name
getTag idx = do
-- push metatable or just the table
liftLua $ do
Lua.getmetatable idx >>= \hasMT -> unless hasMT (Lua.pushvalue idx)
Lua.pushName "tag"
Lua.rawget (Lua.nth 2)
Lua.peekName Lua.top `lastly` Lua.pop 2 -- table/metatable and `tag` field
pushViaConstr' :: forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e ()
pushViaConstr' fnname pushArgs = do
pushName @e ("pandoc." <> fnname)
rawget @e registryindex
sequence_ pushArgs
call @e (fromIntegral (length pushArgs)) 1
-- | Like @'Lua.pcall'@, but uses a predefined error handler which adds a
-- traceback on error.
pcallWithTraceback :: LuaError e => NumArgs -> NumResults -> LuaE e Status
pcallWithTraceback nargs nresults = do
let traceback' :: LuaError e => LuaE e NumResults
traceback' = do
l <- Lua.state
msg <- Lua.tostring' (Lua.nthBottom 1)
Lua.traceback l (Just msg) 2
return 1
tracebackIdx <- Lua.absindex (Lua.nth (Lua.fromNumArgs nargs + 1))
Lua.pushHaskellFunction traceback'
Lua.insert tracebackIdx
result <- Lua.pcall nargs nresults (Just tracebackIdx)
Lua.remove tracebackIdx
return result
-- | Like @'Lua.call'@, but adds a traceback to the error message (if any).
callWithTraceback :: LuaError e => NumArgs -> NumResults -> LuaE e ()
callWithTraceback nargs nresults = do
result <- pcallWithTraceback nargs nresults
when (result /= Lua.OK)
Lua.throwErrorAsException
-- | Run the given string as a Lua program, while also adding a traceback to the
-- error message if an error occurs.
dofileWithTraceback :: LuaError e => FilePath -> LuaE e Status
dofileWithTraceback fp = do
loadRes <- Lua.loadfile fp
case loadRes of
Lua.OK -> pcallWithTraceback 0 Lua.multret
_ -> return loadRes
|
