{-# LANGUAGE OverloadedStrings     #-}
{- |
   Module      : Text.Pandoc.Lua.Util
   Copyright   : © 2012-2022 John MacFarlane,
                 © 2017-2022 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
  ( addField
  , callWithTraceback
  , pcallWithTraceback
  , dofileWithTraceback
  , peekViaJSON
  , pushViaJSON
  ) where

import Control.Monad (when)
import HsLua
import HsLua.Aeson (peekValue, pushValue)
import qualified Data.Aeson as Aeson
import qualified HsLua as Lua
import qualified Text.Pandoc.UTF8 as UTF8

-- | 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 :: forall e a. (LuaError e, Pushable a) => String -> a -> LuaE e ()
addField String
key a
value = do
  String -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push String
key
  a -> LuaE e ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push a
value
  StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset (CInt -> StackIndex
Lua.nth CInt
3)

-- | Like @'Lua.pcall'@, but uses a predefined error handler which adds a
-- traceback on error.
pcallWithTraceback :: LuaError e => NumArgs -> NumResults -> LuaE e Status
pcallWithTraceback :: forall e. LuaError e => NumArgs -> NumResults -> LuaE e Status
pcallWithTraceback NumArgs
nargs NumResults
nresults = do
  let traceback' :: LuaError e => LuaE e NumResults
      traceback' :: forall e. LuaError e => LuaE e NumResults
traceback' = do
        State
l <- LuaE e State
forall e. LuaE e State
Lua.state
        ByteString
msg <- StackIndex -> LuaE e ByteString
forall e. LuaError e => StackIndex -> LuaE e ByteString
Lua.tostring' (CInt -> StackIndex
Lua.nthBottom CInt
1)
        State -> Maybe ByteString -> Int -> LuaE e ()
forall e. State -> Maybe ByteString -> Int -> LuaE e ()
Lua.traceback State
l (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
msg) Int
2
        NumResults -> LuaE e NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1
  StackIndex
tracebackIdx <- StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
Lua.absindex (CInt -> StackIndex
Lua.nth (NumArgs -> CInt
Lua.fromNumArgs NumArgs
nargs CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
1))
  HaskellFunction e -> LuaE e ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
Lua.pushHaskellFunction HaskellFunction e
forall e. LuaError e => LuaE e NumResults
traceback'
  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
Lua.insert StackIndex
tracebackIdx
  Status
result <- NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
forall e.
NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
Lua.pcall NumArgs
nargs NumResults
nresults (StackIndex -> Maybe StackIndex
forall a. a -> Maybe a
Just StackIndex
tracebackIdx)
  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
Lua.remove StackIndex
tracebackIdx
  Status -> LuaE e Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
result

-- | Like @'Lua.call'@, but adds a traceback to the error message (if any).
callWithTraceback :: LuaError e => NumArgs -> NumResults -> LuaE e ()
callWithTraceback :: forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
callWithTraceback NumArgs
nargs NumResults
nresults = do
  Status
result <- NumArgs -> NumResults -> LuaE e Status
forall e. LuaError e => NumArgs -> NumResults -> LuaE e Status
pcallWithTraceback NumArgs
nargs NumResults
nresults
  Bool -> LuaE e () -> LuaE e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status
result Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK)
    LuaE e ()
forall e a. LuaError e => LuaE e a
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 :: forall e. LuaError e => String -> LuaE e Status
dofileWithTraceback String
fp = do
  Status
loadRes <- String -> LuaE e Status
forall e. String -> LuaE e Status
Lua.loadfile String
fp
  case Status
loadRes of
    Status
Lua.OK -> NumArgs -> NumResults -> LuaE e Status
forall e. LuaError e => NumArgs -> NumResults -> LuaE e Status
pcallWithTraceback NumArgs
0 NumResults
Lua.multret
    Status
_ -> Status -> LuaE e Status
forall (m :: * -> *) a. Monad m => a -> m a
return Status
loadRes


-- These will become part of hslua-aeson in future versions.

-- | Retrieves a value from the Lua stack via JSON.
peekViaJSON :: (Aeson.FromJSON a, LuaError e) => Peeker e a
peekViaJSON :: forall a e. (FromJSON a, LuaError e) => Peeker e a
peekViaJSON StackIndex
idx = do
  Value
value <- Peeker e Value
forall e. LuaError e => Peeker e Value
peekValue StackIndex
idx
  case Value -> Result a
forall a. FromJSON a => Value -> Result a
Aeson.fromJSON Value
value of
    Aeson.Success a
x -> a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    Aeson.Error String
msg -> ByteString -> Peek e a
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek e a) -> ByteString -> Peek e a
forall a b. (a -> b) -> a -> b
$ ByteString
"failed to decode: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
                       String -> ByteString
UTF8.fromString String
msg

-- | Pushes a value to the Lua stack as a JSON-like value.
pushViaJSON :: (Aeson.ToJSON a, LuaError e) => Pusher e a
pushViaJSON :: forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON = Pusher e Value
forall e. LuaError e => Pusher e Value
pushValue Pusher e Value -> (a -> Value) -> a -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON