{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Text.Pandoc.Lua.Util
( getTag
, rawField
, addField
, addFunction
, addValue
, pushViaConstructor
, loadScriptFromDataDir
, defineHowTo
, throwTopMessageAsError'
, callWithTraceback
, dofileWithTraceback
) where
import Prelude
import Control.Monad (unless, when)
import Foreign.Lua ( Lua, NumArgs, NumResults, Peekable, Pushable, StackIndex
, Status, ToHaskellFunction )
import Text.Pandoc.Class (readDataFile, runIOorExplode, setUserDataDir)
import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.UTF8 as UTF8
rawField :: Peekable a => StackIndex -> String -> Lua a
rawField :: StackIndex -> String -> Lua a
rawField idx :: StackIndex
idx key :: String
key = do
StackIndex
absidx <- StackIndex -> Lua StackIndex
Lua.absindex StackIndex
idx
String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push String
key
StackIndex -> Lua ()
Lua.rawget StackIndex
absidx
Lua a
forall a. Peekable a => Lua a
Lua.popValue
addField :: Pushable a => String -> a -> Lua ()
addField :: String -> a -> Lua ()
addField = String -> a -> Lua ()
forall a b. (Pushable a, Pushable b) => a -> b -> Lua ()
addValue
addValue :: (Pushable a, Pushable b) => a -> b -> Lua ()
addValue :: a -> b -> Lua ()
addValue key :: a
key value :: b
value = do
a -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push a
key
b -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push b
value
StackIndex -> Lua ()
Lua.rawset (CInt -> StackIndex
Lua.nthFromTop 3)
addFunction :: ToHaskellFunction a => String -> a -> Lua ()
addFunction :: String -> a -> Lua ()
addFunction name :: String
name fn :: a
fn = do
String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push String
name
a -> Lua ()
forall a. ToHaskellFunction a => a -> Lua ()
Lua.pushHaskellFunction a
fn
StackIndex -> Lua ()
Lua.rawset (-3)
class PushViaCall a where
pushViaCall' :: String -> Lua () -> NumArgs -> a
instance PushViaCall (Lua ()) where
pushViaCall' :: String -> Lua () -> NumArgs -> Lua ()
pushViaCall' fn :: String
fn pushArgs :: Lua ()
pushArgs num :: NumArgs
num = do
String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push String
fn
StackIndex -> Lua ()
Lua.rawget StackIndex
Lua.registryindex
Lua ()
pushArgs
NumArgs -> NumResults -> Lua ()
Lua.call NumArgs
num 1
instance (Pushable a, PushViaCall b) => PushViaCall (a -> b) where
pushViaCall' :: String -> Lua () -> NumArgs -> a -> b
pushViaCall' fn :: String
fn pushArgs :: Lua ()
pushArgs num :: NumArgs
num x :: a
x =
String -> Lua () -> NumArgs -> b
forall a. PushViaCall a => String -> Lua () -> NumArgs -> a
pushViaCall' String
fn (Lua ()
pushArgs Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push a
x) (NumArgs
num NumArgs -> NumArgs -> NumArgs
forall a. Num a => a -> a -> a
+ 1)
pushViaCall :: PushViaCall a => String -> a
pushViaCall :: String -> a
pushViaCall fn :: String
fn = String -> Lua () -> NumArgs -> a
forall a. PushViaCall a => String -> Lua () -> NumArgs -> a
pushViaCall' String
fn (() -> Lua ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) 0
pushViaConstructor :: PushViaCall a => String -> a
pushViaConstructor :: String -> a
pushViaConstructor pandocFn :: String
pandocFn = String -> a
forall a. PushViaCall a => String -> a
pushViaCall ("pandoc." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pandocFn)
loadScriptFromDataDir :: Maybe FilePath -> FilePath -> Lua ()
loadScriptFromDataDir :: Maybe String -> String -> Lua ()
loadScriptFromDataDir datadir :: Maybe String
datadir scriptFile :: String
scriptFile = do
ByteString
script <- IO ByteString -> Lua ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (IO ByteString -> Lua ByteString)
-> (PandocIO ByteString -> IO ByteString)
-> PandocIO ByteString
-> Lua ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocIO ByteString -> IO ByteString
forall a. PandocIO a -> IO a
runIOorExplode (PandocIO ByteString -> Lua ByteString)
-> PandocIO ByteString -> Lua ByteString
forall a b. (a -> b) -> a -> b
$
Maybe String -> PandocIO ()
forall (m :: * -> *). PandocMonad m => Maybe String -> m ()
setUserDataDir Maybe String
datadir PandocIO () -> PandocIO ByteString -> PandocIO ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> PandocIO ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDataFile String
scriptFile
Status
status <- ByteString -> Lua Status
Lua.dostring ByteString
script
Bool -> Lua () -> Lua ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK) (Lua () -> Lua ()) -> Lua () -> Lua ()
forall a b. (a -> b) -> a -> b
$
(String -> String) -> Lua ()
forall a. (String -> String) -> Lua a
throwTopMessageAsError' (("Couldn't load '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scriptFile String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'.\n") String -> String -> String
forall a. [a] -> [a] -> [a]
++)
getTag :: StackIndex -> Lua String
getTag :: StackIndex -> Lua String
getTag idx :: StackIndex
idx = do
StackIndex -> Lua Bool
Lua.getmetatable StackIndex
idx Lua Bool -> (Bool -> Lua ()) -> Lua ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \hasMT :: Bool
hasMT -> Bool -> Lua () -> Lua ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasMT (StackIndex -> Lua ()
Lua.pushvalue StackIndex
idx)
String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push "tag"
StackIndex -> Lua ()
Lua.rawget (CInt -> StackIndex
Lua.nthFromTop 2)
StackIndex -> Lua (Maybe ByteString)
Lua.tostring StackIndex
Lua.stackTop Lua (Maybe ByteString) -> Lua () -> Lua (Maybe ByteString)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> Lua ()
Lua.pop 2 Lua (Maybe ByteString)
-> (Maybe ByteString -> Lua String) -> Lua String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Nothing -> String -> Lua String
forall a. String -> Lua a
Lua.throwException "untagged value"
Just x :: ByteString
x -> String -> Lua String
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> String
UTF8.toString ByteString
x)
throwTopMessageAsError' :: (String -> String) -> Lua a
throwTopMessageAsError' :: (String -> String) -> Lua a
throwTopMessageAsError' modifier :: String -> String
modifier = do
ByteString
msg <- StackIndex -> Lua ByteString
Lua.tostring' StackIndex
Lua.stackTop
StackIndex -> Lua ()
Lua.pop 2
String -> Lua a
forall a. String -> Lua a
Lua.throwException (String -> String
modifier (ByteString -> String
UTF8.toString ByteString
msg))
defineHowTo :: String -> Lua a -> Lua a
defineHowTo :: String -> Lua a -> Lua a
defineHowTo ctx :: String
ctx = (String -> String) -> Lua a -> Lua a
forall a. (String -> String) -> Lua a -> Lua a
Lua.withExceptionMessage (("Could not " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
ctx String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ": ") String -> String -> String
forall a. Semigroup a => a -> a -> a
<>)
pcallWithTraceback :: NumArgs -> NumResults -> Lua Status
pcallWithTraceback :: NumArgs -> NumResults -> Lua Status
pcallWithTraceback nargs :: NumArgs
nargs nresults :: NumResults
nresults = do
let traceback' :: Lua NumResults
traceback' :: Lua NumResults
traceback' = do
State
l <- Lua State
Lua.state
ByteString
msg <- StackIndex -> Lua ByteString
Lua.tostring' (CInt -> StackIndex
Lua.nthFromBottom 1)
State -> Maybe String -> Int -> Lua ()
Lua.traceback State
l (String -> Maybe String
forall a. a -> Maybe a
Just (ByteString -> String
UTF8.toString ByteString
msg)) 2
NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return 1
StackIndex
tracebackIdx <- StackIndex -> Lua StackIndex
Lua.absindex (CInt -> StackIndex
Lua.nthFromTop (NumArgs -> CInt
Lua.fromNumArgs NumArgs
nargs CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ 1))
Lua NumResults -> Lua ()
forall a. ToHaskellFunction a => a -> Lua ()
Lua.pushHaskellFunction Lua NumResults
traceback'
StackIndex -> Lua ()
Lua.insert StackIndex
tracebackIdx
Status
result <- NumArgs -> NumResults -> Maybe StackIndex -> Lua Status
Lua.pcall NumArgs
nargs NumResults
nresults (StackIndex -> Maybe StackIndex
forall a. a -> Maybe a
Just StackIndex
tracebackIdx)
StackIndex -> Lua ()
Lua.remove StackIndex
tracebackIdx
Status -> Lua Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
result
callWithTraceback :: NumArgs -> NumResults -> Lua ()
callWithTraceback :: NumArgs -> NumResults -> Lua ()
callWithTraceback nargs :: NumArgs
nargs nresults :: NumResults
nresults = do
Status
result <- NumArgs -> NumResults -> Lua Status
pcallWithTraceback NumArgs
nargs NumResults
nresults
Bool -> Lua () -> Lua ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status
result Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK) Lua ()
forall a. Lua a
Lua.throwTopMessage
dofileWithTraceback :: FilePath -> Lua Status
dofileWithTraceback :: String -> Lua Status
dofileWithTraceback fp :: String
fp = do
Status
loadRes <- String -> Lua Status
Lua.loadfile String
fp
case Status
loadRes of
Lua.OK -> NumArgs -> NumResults -> Lua Status
pcallWithTraceback 0 NumResults
Lua.multret
_ -> Status -> Lua Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
loadRes