{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}
{- |
   Module      : Text.Pandoc.Lua
   Copyright   : Copyright © 2017-2024 Albert Krewinkel
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha

Running pandoc Lua filters.
-}
module Text.Pandoc.Lua
  ( -- * High-level functions
    applyFilter
  , loadCustom
  -- * Low-level functions
  , Global(..)
  , setGlobals
  , runLua
  , runLuaNoEnv
  -- * Engine
  , getEngine
  ) where

import Control.Monad.IO.Class (MonadIO (liftIO))
import HsLua.Core (getglobal, openlibs, run, top, tostring)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Filter (applyFilter)
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
import Text.Pandoc.Lua.Init (runLua, runLuaNoEnv)
import Text.Pandoc.Lua.Custom (loadCustom)
import Text.Pandoc.Lua.Orphans ()
import Text.Pandoc.Scripting (ScriptingEngine (..))
import qualified Text.Pandoc.UTF8 as UTF8

-- | Constructs the Lua scripting engine.
getEngine :: MonadIO m => m ScriptingEngine
getEngine :: forall (m :: * -> *). MonadIO m => m ScriptingEngine
getEngine = do
  Maybe ByteString
versionName <- IO (Maybe ByteString) -> m (Maybe ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> (LuaE PandocError (Maybe ByteString) -> IO (Maybe ByteString))
-> LuaE PandocError (Maybe ByteString)
-> m (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. LuaE e a -> IO a
run @PandocError (LuaE PandocError (Maybe ByteString) -> m (Maybe ByteString))
-> LuaE PandocError (Maybe ByteString) -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ do
    LuaE PandocError ()
forall e. LuaE e ()
openlibs
    Name -> LuaE PandocError Type
forall e. LuaError e => Name -> LuaE e Type
getglobal Name
"_VERSION"
    StackIndex -> LuaE PandocError (Maybe ByteString)
forall e. StackIndex -> LuaE e (Maybe ByteString)
tostring StackIndex
top
  ScriptingEngine -> m ScriptingEngine
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptingEngine -> m ScriptingEngine)
-> ScriptingEngine -> m ScriptingEngine
forall a b. (a -> b) -> a -> b
$ ScriptingEngine
    { engineName :: Text
engineName = Text -> (ByteString -> Text) -> Maybe ByteString -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"Lua (unknown version)" ByteString -> Text
UTF8.toText Maybe ByteString
versionName
    , engineApplyFilter :: forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
Environment -> [String] -> String -> Pandoc -> m Pandoc
engineApplyFilter = Environment -> [String] -> String -> Pandoc -> m Pandoc
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
Environment -> [String] -> String -> Pandoc -> m Pandoc
applyFilter
    , engineLoadCustom :: forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
String -> m (CustomComponents m)
engineLoadCustom = String -> m (CustomComponents m)
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
String -> m (CustomComponents m)
loadCustom
    }