{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{- |
   Module      : Text.Pandoc.Lua.Run
   Copyright   : Copyright © 2017-2024 Albert Krewinkel
   License     : GPL-2.0-or-later
   Maintainer  : Albert Krewinkel <albert+pandoc@tarleb.com>

Run code in the Lua interpreter.
-}
module Text.Pandoc.Lua.Run
  ( runLua
  , runLuaNoEnv
  , runLuaWith
  ) where

import Control.Monad.Catch (try)
import Control.Monad.Trans (MonadIO (..))
import HsLua as Lua hiding (try)
import Text.Pandoc.Class (PandocMonad (..))
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
import Text.Pandoc.Lua.Init (initLua)
import Text.Pandoc.Lua.PandocLua (PandocLua (..), liftPandocLua)

-- | Run the Lua interpreter, using pandoc's default way of environment
-- initialization.
runLua :: (PandocMonad m, MonadIO m)
       => LuaE PandocError a -> m (Either PandocError a)
runLua :: forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
LuaE PandocError a -> m (Either PandocError a)
runLua LuaE PandocError a
action = do
  (forall b. LuaE PandocError b -> IO b)
-> PandocLua (Either PandocError a) -> m (Either PandocError a)
forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
(forall b. LuaE PandocError b -> IO b) -> PandocLua a -> m a
runPandocLuaWith LuaE PandocError b -> IO b
forall b. LuaE PandocError b -> IO b
forall e a. LuaE e a -> IO a
Lua.run (PandocLua (Either PandocError a) -> m (Either PandocError a))
-> (PandocLua a -> PandocLua (Either PandocError a))
-> PandocLua a
-> m (Either PandocError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocLua a -> PandocLua (Either PandocError a)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (PandocLua a -> m (Either PandocError a))
-> PandocLua a -> m (Either PandocError a)
forall a b. (a -> b) -> a -> b
$ do
    PandocLua ()
initLua
    LuaE PandocError a -> PandocLua a
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua LuaE PandocError a
action

runLuaWith :: (PandocMonad m, MonadIO m)
           => GCManagedState -> LuaE PandocError a -> m (Either PandocError a)
runLuaWith :: forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
GCManagedState -> LuaE PandocError a -> m (Either PandocError a)
runLuaWith GCManagedState
luaState LuaE PandocError a
action = do
  (forall b. LuaE PandocError b -> IO b)
-> PandocLua (Either PandocError a) -> m (Either PandocError a)
forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
(forall b. LuaE PandocError b -> IO b) -> PandocLua a -> m a
runPandocLuaWith (GCManagedState -> LuaE PandocError b -> IO b
forall e a. GCManagedState -> LuaE e a -> IO a
withGCManagedState GCManagedState
luaState) (PandocLua (Either PandocError a) -> m (Either PandocError a))
-> (PandocLua a -> PandocLua (Either PandocError a))
-> PandocLua a
-> m (Either PandocError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocLua a -> PandocLua (Either PandocError a)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (PandocLua a -> m (Either PandocError a))
-> PandocLua a -> m (Either PandocError a)
forall a b. (a -> b) -> a -> b
$ do
    PandocLua ()
initLua
    LuaE PandocError a -> PandocLua a
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua LuaE PandocError a
action

-- | Like 'runLua', but ignores all environment variables like @LUA_PATH@.
runLuaNoEnv :: (PandocMonad m, MonadIO m)
            => LuaE PandocError a -> m (Either PandocError a)
runLuaNoEnv :: forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
LuaE PandocError a -> m (Either PandocError a)
runLuaNoEnv LuaE PandocError a
action = do
  (forall b. LuaE PandocError b -> IO b)
-> PandocLua (Either PandocError a) -> m (Either PandocError a)
forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
(forall b. LuaE PandocError b -> IO b) -> PandocLua a -> m a
runPandocLuaWith LuaE PandocError b -> IO b
forall b. LuaE PandocError b -> IO b
forall e a. LuaE e a -> IO a
Lua.run (PandocLua (Either PandocError a) -> m (Either PandocError a))
-> (PandocLua a -> PandocLua (Either PandocError a))
-> PandocLua a
-> m (Either PandocError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocLua a -> PandocLua (Either PandocError a)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (PandocLua a -> m (Either PandocError a))
-> PandocLua a -> m (Either PandocError a)
forall a b. (a -> b) -> a -> b
$ do
    LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ do
      -- This is undocumented, but works -- the code is adapted from the
      -- `lua.c` sources for the default interpreter.
      Bool -> LuaE PandocError ()
forall e. Bool -> LuaE e ()
Lua.pushboolean Bool
True
      StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield StackIndex
Lua.registryindex Name
"LUA_NOENV"
    PandocLua ()
initLua
    LuaE PandocError a -> PandocLua a
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua LuaE PandocError a
action

-- | Evaluate a @'PandocLua'@ computation, running all contained Lua
-- operations.
runPandocLuaWith :: (PandocMonad m, MonadIO m)
                 => (forall b. LuaE PandocError b -> IO b)
                 -> PandocLua a
                 -> m a
runPandocLuaWith :: forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
(forall b. LuaE PandocError b -> IO b) -> PandocLua a -> m a
runPandocLuaWith forall b. LuaE PandocError b -> IO b
runner PandocLua a
pLua = do
  origState <- m CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
  globals <- defaultGlobals
  (result, newState) <- liftIO . runner . unPandocLua $ do
    putCommonState origState
    liftPandocLua $ setGlobals globals
    r <- pLua
    c <- getCommonState
    return (r, c)
  putCommonState newState
  return result

-- | Global variables which should always be set.
defaultGlobals :: PandocMonad m => m [Global]
defaultGlobals :: forall (m :: * -> *). PandocMonad m => m [Global]
defaultGlobals = do
  commonState <- m CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
  return
    [ PANDOC_API_VERSION
    , PANDOC_STATE commonState
    , PANDOC_VERSION
    ]