{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
module Text.Pandoc.Lua.Util
( getTag
, rawField
, addField
, addFunction
, addValue
, typeCheck
, 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, Lua, NumArgs, StackIndex, Status,
ToLuaStack, ToHaskellFunction)
import Text.Pandoc.Class (readDataFile, runIOorExplode, setUserDataDir)
import qualified Foreign.Lua as Lua
rawField :: FromLuaStack a => StackIndex -> String -> Lua a
rawField idx key = do
absidx <- Lua.absindex idx
Lua.push key
Lua.rawget absidx
popValue
addField :: ToLuaStack a => String -> a -> Lua ()
addField = addValue
addValue :: (ToLuaStack a, ToLuaStack b) => a -> b -> Lua ()
addValue key value = do
Lua.push key
Lua.push value
Lua.rawset (Lua.nthFromTop 3)
addFunction :: ToHaskellFunction a => String -> a -> Lua ()
addFunction name fn = do
Lua.push name
Lua.pushHaskellFunction fn
Lua.wrapHaskellFunction
Lua.rawset (-3)
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 ++ "."
popValue :: FromLuaStack a => Lua a
popValue = do
resOrError <- Lua.peekEither (-1)
Lua.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
Lua.call num 1
instance (ToLuaStack a, PushViaCall b) => PushViaCall (a -> b) where
pushViaCall' fn pushArgs num x =
pushViaCall' fn (pushArgs *> Lua.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
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