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

Functions to initialize the Lua interpreter.
-}
module Text.Pandoc.Lua.Init
  ( initLua
  , userInit
  ) where

import Control.Monad (when)
import Control.Monad.Catch (throwM)
import HsLua as Lua hiding (status)
import Text.Pandoc.Class (report)
import Text.Pandoc.Data (readDataFile)
import Text.Pandoc.Error (PandocError (PandocLuaError))
import Text.Pandoc.Logging (LogMessage (ScriptingWarning))
import Text.Pandoc.Lua.Module (initModules)
import Text.Pandoc.Lua.PandocLua (PandocLua (..), liftPandocLua)
import Text.Pandoc.Lua.SourcePos (luaSourcePos)
import qualified Data.Text as T
import qualified Text.Pandoc.UTF8 as UTF8

-- | Initialize Lua with all default and pandoc-specific libraries and default
-- globals.
initLua :: PandocLua ()
initLua :: PandocLua ()
initLua = do
  LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua LuaE PandocError ()
forall e. LuaE e ()
Lua.openlibs
  PandocLua ()
setWarnFunction
  PandocLua ()
initModules
  LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua LuaE PandocError ()
userInit

-- | User-controlled initialization, e.g., running the user's init script.
userInit :: LuaE PandocError ()
userInit :: LuaE PandocError ()
userInit = LuaE PandocError ()
runInitScript

-- | Run the @init.lua@ data file as a Lua script.
runInitScript :: LuaE PandocError ()
runInitScript :: LuaE PandocError ()
runInitScript = FilePath -> LuaE PandocError ()
runDataFileScript FilePath
"init.lua"

-- | Get a data file and run it as a Lua script.
runDataFileScript :: FilePath -> LuaE PandocError ()
runDataFileScript :: FilePath -> LuaE PandocError ()
runDataFileScript FilePath
scriptFile = do
  script <- PandocLua ByteString -> LuaE PandocError ByteString
forall a. PandocLua a -> LuaE PandocError a
unPandocLua (PandocLua ByteString -> LuaE PandocError ByteString)
-> PandocLua ByteString -> LuaE PandocError ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> PandocLua ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile FilePath
scriptFile
  status <- Lua.dostring script
  when (status /= Lua.OK) $ do
    err <- popException
    let prefix = Text
"Couldn't load '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
scriptFile Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"':\n"
    throwM . PandocLuaError . (prefix <>) $ case err of
      PandocLuaError Text
msg -> Text
msg
      PandocError
_                  -> FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ PandocError -> FilePath
forall a. Show a => a -> FilePath
show PandocError
err

setWarnFunction :: PandocLua ()
setWarnFunction :: PandocLua ()
setWarnFunction = LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError () -> PandocLua ())
-> ((ByteString -> LuaE PandocError ()) -> LuaE PandocError ())
-> (ByteString -> LuaE PandocError ())
-> PandocLua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> LuaE PandocError ()) -> LuaE PandocError ()
forall e. LuaError e => (ByteString -> LuaE e ()) -> LuaE e ()
setwarnf' ((ByteString -> LuaE PandocError ()) -> PandocLua ())
-> (ByteString -> LuaE PandocError ()) -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ \ByteString
msg -> do
  -- reporting levels:
  -- 0: this hook,
  -- 1: userdata wrapper function for the hook,
  -- 2: warn,
  -- 3: function calling warn.
  pos <- Int -> LuaE PandocError (Maybe SourcePos)
forall e. LuaError e => Int -> LuaE e (Maybe SourcePos)
luaSourcePos Int
3
  unPandocLua . report $ ScriptingWarning (UTF8.toText msg) pos