{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
module Text.Pandoc.Lua.Util
( getTag
, getTable
, addValue
, addFunction
, getRawInt
, setRawInt
, addRawInt
, typeCheck
, raiseError
, popValue
, PushViaCall
, pushViaCall
, pushViaConstructor
, loadScriptFromDataDir
, dostring'
) where
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 Text.Pandoc.Class (readDataFile, runIOorExplode, setUserDataDir)
import qualified Foreign.Lua as Lua
adjustIndexBy :: StackIndex -> StackIndex -> StackIndex
adjustIndexBy idx n =
if idx < 0
then idx - n
else idx
getTable :: (ToLuaStack a, FromLuaStack b) => StackIndex -> a -> Lua b
getTable idx key = do
push key
rawget (idx `adjustIndexBy` 1)
popValue
addValue :: (ToLuaStack a, ToLuaStack b) => a -> b -> Lua ()
addValue key value = do
push key
push value
rawset (-3)
addFunction :: ToHaskellFunction a => String -> a -> Lua ()
addFunction name fn = do
Lua.push name
Lua.pushHaskellFunction fn
Lua.wrapHaskellFunction
Lua.rawset (-3)
getRawInt :: FromLuaStack a => StackIndex -> Int -> Lua a
getRawInt idx key = do
rawgeti idx key
popValue
setRawInt :: ToLuaStack a => StackIndex -> Int -> a -> Lua ()
setRawInt idx key value = do
push value
rawseti (idx `adjustIndexBy` 1) key
addRawInt :: ToLuaStack a => Int -> a -> Lua ()
addRawInt = setRawInt (-1)
typeCheck :: StackIndex -> Lua.Type -> Lua ()
typeCheck idx expected = do
actual <- Lua.ltype idx
when (actual /= expected) $ do
expName <- Lua.typename expected
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
popValue :: FromLuaStack a => Lua a
popValue = do
resOrError <- Lua.peekEither (-1)
pop 1
case resOrError of
Left err -> Lua.throwLuaError err
Right x -> return x
class PushViaCall a where
pushViaCall' :: String -> Lua () -> NumArgs -> a
instance PushViaCall (Lua ()) where
pushViaCall' fn pushArgs num = do
Lua.push fn
Lua.rawget Lua.registryindex
pushArgs
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 :: PushViaCall a => String -> a
pushViaCall fn = pushViaCall' fn (return ()) 0
pushViaConstructor :: PushViaCall a => String -> a
pushViaConstructor pandocFn = pushViaCall ("pandoc." ++ pandocFn)
loadScriptFromDataDir :: Maybe FilePath -> FilePath -> Lua ()
loadScriptFromDataDir datadir scriptFile = do
script <- fmap unpack . Lua.liftIO . runIOorExplode $
setUserDataDir datadir >> readDataFile scriptFile
status <- dostring' script
when (status /= Lua.OK) .
Lua.throwTopMessageAsError' $ \msg ->
"Couldn't load '" ++ scriptFile ++ "'.\n" ++ msg
dostring' :: String -> Lua Status
dostring' script = do
loadRes <- Lua.loadstring script
if loadRes == Lua.OK
then Lua.pcall 0 1 Nothing <* Lua.gc Lua.GCCOLLECT 0
else return loadRes
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