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

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

Functions to initialize the Lua interpreter.
-}
module Text.Pandoc.Lua.Init
  ( runLua
  , runLuaNoEnv
  , runLuaWith
  ) where

import Control.Monad (forM, forM_, when)
import Control.Monad.Catch (throwM, try)
import Control.Monad.Trans (MonadIO (..))
import Data.Maybe (catMaybes)
import Data.Version (makeVersion)
import HsLua as Lua hiding (status, try)
import Text.Pandoc.Class (PandocMonad (..), report)
import Text.Pandoc.Data (readDataFile)
import Text.Pandoc.Error (PandocError (PandocLuaError))
import Text.Pandoc.Logging (LogMessage (ScriptingWarning))
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
import Text.Pandoc.Lua.Marshal.List (newListMetatable, pushListModule)
import Text.Pandoc.Lua.PandocLua (PandocLua (..), liftPandocLua)
import Text.Parsec.Pos (newPos)
import Text.Read (readMaybe)
import qualified Data.ByteString.Char8 as Char8
import qualified Data.Text as T
import qualified Lua.LPeg as LPeg
import qualified HsLua.Aeson
import qualified HsLua.Module.DocLayout as Module.Layout
import qualified HsLua.Module.Path as Module.Path
import qualified HsLua.Module.Zip as Module.Zip
import qualified Text.Pandoc.Lua.Module.CLI as Pandoc.CLI
import qualified Text.Pandoc.Lua.Module.Format as Pandoc.Format
import qualified Text.Pandoc.Lua.Module.JSON as Pandoc.JSON
import qualified Text.Pandoc.Lua.Module.MediaBag as Pandoc.MediaBag
import qualified Text.Pandoc.Lua.Module.Pandoc as Module.Pandoc
import qualified Text.Pandoc.Lua.Module.Scaffolding as Pandoc.Scaffolding
import qualified Text.Pandoc.Lua.Module.Structure as Pandoc.Structure
import qualified Text.Pandoc.Lua.Module.System as Pandoc.System
import qualified Text.Pandoc.Lua.Module.Template as Pandoc.Template
import qualified Text.Pandoc.Lua.Module.Text as Pandoc.Text
import qualified Text.Pandoc.Lua.Module.Types as Pandoc.Types
import qualified Text.Pandoc.Lua.Module.Utils as Pandoc.Utils
import qualified Text.Pandoc.UTF8 as UTF8

-- | 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 ()
initLuaState
    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 ()
initLuaState
    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 ()
initLuaState
    LuaE PandocError a -> PandocLua a
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua LuaE PandocError a
action

-- | Modules that are loaded at startup and assigned to fields in the
-- pandoc module.
--
-- Note that @pandoc.List@ is not included here for technical reasons;
-- it must be handled separately.
loadedModules :: [Module PandocError]
loadedModules :: [Module PandocError]
loadedModules =
  [ Module PandocError
Pandoc.CLI.documentedModule
  , Module PandocError
Pandoc.Format.documentedModule
  , Module PandocError
Pandoc.JSON.documentedModule
  , Module PandocError
Pandoc.MediaBag.documentedModule
  , Module PandocError
Pandoc.Scaffolding.documentedModule
  , Module PandocError
Pandoc.Structure.documentedModule
  , Module PandocError
forall e. LuaError e => Module e
Pandoc.System.documentedModule
  , Module PandocError
Pandoc.Template.documentedModule
  , Module PandocError
Pandoc.Text.documentedModule
  , Module PandocError
Pandoc.Types.documentedModule
  , Module PandocError
Pandoc.Utils.documentedModule
  , Module PandocError
forall e. LuaError e => Module e
Module.Layout.documentedModule { moduleName = "pandoc.layout" }
    Module PandocError -> [Int] -> Module PandocError
forall {e}. Module e -> [Int] -> Module e
`allSince` [Int
2,Int
18]
  , Module PandocError
forall e. LuaError e => Module e
Module.Path.documentedModule { moduleName = "pandoc.path" }
    Module PandocError -> [Int] -> Module PandocError
forall {e}. Module e -> [Int] -> Module e
`allSince` [Int
2,Int
12]
  , Module PandocError
forall e. LuaError e => Module e
Module.Zip.documentedModule { moduleName = "pandoc.zip" }
    Module PandocError -> [Int] -> Module PandocError
forall {e}. Module e -> [Int] -> Module e
`allSince` [Int
3,Int
0]
  ]
 where
  allSince :: Module e -> [Int] -> Module e
allSince Module e
mdl [Int]
version = Module e
mdl
    { moduleFunctions = map (`since` makeVersion version) $ moduleFunctions mdl
    }

-- | Initialize the lua state with all required values
initLuaState :: PandocLua ()
initLuaState :: PandocLua ()
initLuaState = do
  LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua LuaE PandocError ()
forall e. LuaE e ()
Lua.openlibs
  PandocLua ()
setWarnFunction
  PandocLua ()
initJsonMetatable
  PandocLua ()
initPandocModule
  PandocLua ()
installLpegSearcher
  PandocLua ()
setGlobalModules
  FilePath -> PandocLua ()
loadInitScript FilePath
"init.lua"
 where
  initPandocModule :: PandocLua ()
  initPandocModule :: PandocLua ()
initPandocModule = 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
    -- Push module table
    Module PandocError -> LuaE PandocError ()
forall e. LuaError e => Module e -> LuaE e ()
registerModule Module PandocError
Module.Pandoc.documentedModule
    -- load modules and add them to the `pandoc` module table.
    [Module PandocError]
-> (Module PandocError -> LuaE PandocError ())
-> LuaE PandocError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Module PandocError]
loadedModules ((Module PandocError -> LuaE PandocError ())
 -> LuaE PandocError ())
-> (Module PandocError -> LuaE PandocError ())
-> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ \Module PandocError
mdl -> do
      Module PandocError -> LuaE PandocError ()
forall e. LuaError e => Module e -> LuaE e ()
registerModule Module PandocError
mdl
      -- pandoc.text must be require-able as 'text' for backwards compat.
      Bool -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Module PandocError -> Name
forall e. Module e -> Name
moduleName Module PandocError
mdl Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"pandoc.text") (LuaE PandocError () -> LuaE PandocError ())
-> LuaE PandocError () -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ do
        StackIndex -> Name -> LuaE PandocError Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
registryindex Name
loaded
        StackIndex -> LuaE PandocError ()
forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth  CInt
2)
        StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield (CInt -> StackIndex
nth CInt
2) Name
"text"
        Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
pop Int
1 -- _LOADED
      -- Shorten name, drop everything before the first dot (if any).
      let fieldname :: Name -> Name
fieldname (Name ByteString
mdlname) = ByteString -> Name
Name (ByteString -> Name)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            ByteString
-> ((Char, ByteString) -> ByteString)
-> Maybe (Char, ByteString)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
mdlname (Char, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (Maybe (Char, ByteString) -> ByteString)
-> ((ByteString, ByteString) -> Maybe (Char, ByteString))
-> (ByteString, ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Char, ByteString)
Char8.uncons (ByteString -> Maybe (Char, ByteString))
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> Maybe (Char, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> Name)
-> (ByteString, ByteString) -> Name
forall a b. (a -> b) -> a -> b
$
            (Char -> Bool) -> ByteString -> (ByteString, ByteString)
Char8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') ByteString
mdlname
      StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield (CInt -> StackIndex
nth CInt
2) (Name -> Name
fieldname (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Module PandocError -> Name
forall e. Module e -> Name
moduleName Module PandocError
mdl)
    -- pandoc.List is low-level and must be opened differently.
    Name -> (Name -> LuaE PandocError ()) -> LuaE PandocError ()
forall e. LuaError e => Name -> (Name -> LuaE e ()) -> LuaE e ()
requirehs Name
"pandoc.List" (LuaE PandocError () -> Name -> LuaE PandocError ()
forall a b. a -> b -> a
const LuaE PandocError ()
forall e. LuaError e => LuaE e ()
pushListModule)
    StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield (CInt -> StackIndex
nth CInt
2) Name
"List"
    -- assign module to global variable
    Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"pandoc"

  loadInitScript :: FilePath -> PandocLua ()
  loadInitScript :: FilePath -> PandocLua ()
loadInitScript FilePath
scriptFile = do
    ByteString
script <- FilePath -> PandocLua ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile FilePath
scriptFile
    Status
status <- LuaE PandocError Status -> PandocLua Status
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError Status -> PandocLua Status)
-> LuaE PandocError Status -> PandocLua Status
forall a b. (a -> b) -> a -> b
$ ByteString -> LuaE PandocError Status
forall e. ByteString -> LuaE e Status
Lua.dostring ByteString
script
    Bool -> PandocLua () -> PandocLua ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK) (PandocLua () -> PandocLua ())
-> (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError ()
-> PandocLua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
      PandocError
err <- LuaE PandocError PandocError
forall e. LuaError e => LuaE e e
popException
      let prefix :: Text
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"
      PandocError -> LuaE PandocError ()
forall e a. (HasCallStack, Exception e) => e -> LuaE PandocError a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (PandocError -> LuaE PandocError ())
-> (Text -> PandocError) -> Text -> LuaE PandocError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PandocError
PandocLuaError (Text -> PandocError) -> (Text -> Text) -> Text -> PandocError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> LuaE PandocError ()) -> Text -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ case PandocError
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

  setGlobalModules :: PandocLua ()
  setGlobalModules :: PandocLua ()
setGlobalModules = 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
    let globalModules :: [(Name, CFunction)]
globalModules =
          [ (Name
"lpeg", CFunction
LPeg.luaopen_lpeg_ptr)  -- must be loaded first
          , (Name
"re", CFunction
LPeg.luaopen_re_ptr)      -- re depends on lpeg
          ]
    [Name]
loadedBuiltInModules <- ([Maybe Name] -> [Name])
-> LuaE PandocError [Maybe Name] -> LuaE PandocError [Name]
forall a b. (a -> b) -> LuaE PandocError a -> LuaE PandocError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe Name] -> [Name]
forall a. [Maybe a] -> [a]
catMaybes (LuaE PandocError [Maybe Name] -> LuaE PandocError [Name])
-> (((Name, CFunction) -> LuaE PandocError (Maybe Name))
    -> LuaE PandocError [Maybe Name])
-> ((Name, CFunction) -> LuaE PandocError (Maybe Name))
-> LuaE PandocError [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, CFunction)]
-> ((Name, CFunction) -> LuaE PandocError (Maybe Name))
-> LuaE PandocError [Maybe Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Name, CFunction)]
globalModules (((Name, CFunction) -> LuaE PandocError (Maybe Name))
 -> LuaE PandocError [Name])
-> ((Name, CFunction) -> LuaE PandocError (Maybe Name))
-> LuaE PandocError [Name]
forall a b. (a -> b) -> a -> b
$
      \(Name
pkgname, CFunction
luaopen) -> do
        CFunction -> LuaE PandocError ()
forall e. CFunction -> LuaE e ()
Lua.pushcfunction CFunction
luaopen
        Bool
usedBuiltIn <- NumArgs
-> NumResults -> Maybe StackIndex -> LuaE PandocError Status
forall e.
NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
Lua.pcall NumArgs
0 NumResults
1 Maybe StackIndex
forall a. Maybe a
Nothing LuaE PandocError Status
-> (Status -> LuaE PandocError Bool) -> LuaE PandocError Bool
forall a b.
LuaE PandocError a
-> (a -> LuaE PandocError b) -> LuaE PandocError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Status
OK -> do               -- all good, loading succeeded
            -- register as loaded module so later modules can rely on this
            StackIndex -> Name -> LuaE PandocError Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
Lua.registryindex Name
Lua.loaded
            StackIndex -> LuaE PandocError ()
forall e. StackIndex -> LuaE e ()
Lua.pushvalue (CInt -> StackIndex
Lua.nth CInt
2)
            StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield (CInt -> StackIndex
Lua.nth CInt
2) Name
pkgname
            Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
Lua.pop Int
1  -- pop _LOADED
            Bool -> LuaE PandocError Bool
forall a. a -> LuaE PandocError a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          Status
_  -> do               -- built-in library failed, load system lib
            Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
Lua.pop Int
1  -- ignore error message
            -- Try loading via the normal package loading mechanism.
            Name -> LuaE PandocError Type
forall e. LuaError e => Name -> LuaE e Type
Lua.getglobal Name
"require"
            Name -> LuaE PandocError ()
forall e. Name -> LuaE e ()
Lua.pushName Name
pkgname
            NumArgs -> NumResults -> LuaE PandocError ()
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
Lua.call NumArgs
1 NumResults
1  -- Throws an exception if loading failed again!
            Bool -> LuaE PandocError Bool
forall a. a -> LuaE PandocError a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

        -- Module on top of stack. Register as global
        Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
pkgname
        Maybe Name -> LuaE PandocError (Maybe Name)
forall a. a -> LuaE PandocError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Name -> LuaE PandocError (Maybe Name))
-> Maybe Name -> LuaE PandocError (Maybe Name)
forall a b. (a -> b) -> a -> b
$ if Bool
usedBuiltIn then Name -> Maybe Name
forall a. a -> Maybe a
Just Name
pkgname else Maybe Name
forall a. Maybe a
Nothing

    -- Remove module entry from _LOADED table in registry if we used a
    -- built-in library. This ensures that later calls to @require@ will
    -- prefer the shared library, if any.
    [Name] -> (Name -> LuaE PandocError ()) -> LuaE PandocError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Name]
loadedBuiltInModules ((Name -> LuaE PandocError ()) -> LuaE PandocError ())
-> (Name -> LuaE PandocError ()) -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ \Name
pkgname -> do
      StackIndex -> Name -> LuaE PandocError Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
Lua.registryindex Name
Lua.loaded
      LuaE PandocError ()
forall e. LuaE e ()
Lua.pushnil
      StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield (CInt -> StackIndex
Lua.nth CInt
2) Name
pkgname
      Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
Lua.pop Int
1  -- registry

  installLpegSearcher :: PandocLua ()
  installLpegSearcher :: PandocLua ()
installLpegSearcher = 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
    Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.getglobal' Name
"package.searchers"
    HaskellFunction PandocError -> LuaE PandocError ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
Lua.pushHaskellFunction (HaskellFunction PandocError -> LuaE PandocError ())
-> HaskellFunction PandocError -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ LuaE PandocError State
forall e. LuaE e State
Lua.state LuaE PandocError State
-> (State -> HaskellFunction PandocError)
-> HaskellFunction PandocError
forall a b.
LuaE PandocError a
-> (a -> LuaE PandocError b) -> LuaE PandocError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO NumResults -> HaskellFunction PandocError
forall a. IO a -> LuaE PandocError a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NumResults -> HaskellFunction PandocError)
-> (State -> IO NumResults) -> State -> HaskellFunction PandocError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> IO NumResults
LPeg.lpeg_searcher
    StackIndex -> Integer -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
Lua.rawseti (CInt -> StackIndex
Lua.nth CInt
2) (Integer -> LuaE PandocError ())
-> (Int -> Integer) -> Int -> LuaE PandocError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) (Integer -> Integer) -> (Int -> Integer) -> Int -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> LuaE PandocError ())
-> LuaE PandocError Int -> LuaE PandocError ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StackIndex -> LuaE PandocError Int
forall e. StackIndex -> LuaE e Int
Lua.rawlen (CInt -> StackIndex
Lua.nth CInt
2)
    Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
Lua.pop Int
1  -- remove 'package.searchers' from stack

-- | Setup the metatable that's assigned to Lua tables that were created
-- from/via JSON arrays.
initJsonMetatable :: PandocLua ()
initJsonMetatable :: PandocLua ()
initJsonMetatable = 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
  Name -> LuaE PandocError () -> LuaE PandocError ()
forall e. Name -> LuaE e () -> LuaE e ()
newListMetatable Name
HsLua.Aeson.jsonarray (() -> LuaE PandocError ()
forall a. a -> LuaE PandocError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
Lua.pop Int
1

-- | 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
  CommonState
origState <- m CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
  [Global]
globals <- m [Global]
forall (m :: * -> *). PandocMonad m => m [Global]
defaultGlobals
  (a
result, CommonState
newState) <- IO (a, CommonState) -> m (a, CommonState)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, CommonState) -> m (a, CommonState))
-> (PandocLua (a, CommonState) -> IO (a, CommonState))
-> PandocLua (a, CommonState)
-> m (a, CommonState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LuaE PandocError (a, CommonState) -> IO (a, CommonState)
forall b. LuaE PandocError b -> IO b
runner (LuaE PandocError (a, CommonState) -> IO (a, CommonState))
-> (PandocLua (a, CommonState)
    -> LuaE PandocError (a, CommonState))
-> PandocLua (a, CommonState)
-> IO (a, CommonState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocLua (a, CommonState) -> LuaE PandocError (a, CommonState)
forall a. PandocLua a -> LuaE PandocError a
unPandocLua (PandocLua (a, CommonState) -> m (a, CommonState))
-> PandocLua (a, CommonState) -> m (a, CommonState)
forall a b. (a -> b) -> a -> b
$ do
    CommonState -> PandocLua ()
forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState CommonState
origState
    LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ [Global] -> LuaE PandocError ()
setGlobals [Global]
globals
    a
r <- PandocLua a
pLua
    CommonState
c <- PandocLua CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
    (a, CommonState) -> PandocLua (a, CommonState)
forall a. a -> PandocLua a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, CommonState
c)
  CommonState -> m ()
forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState CommonState
newState
  a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

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

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.
  Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
where' Int
3
  Text
loc <- ByteString -> Text
UTF8.toText (ByteString -> Text)
-> LuaE PandocError ByteString -> LuaE PandocError Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> LuaE PandocError ByteString
forall e. LuaError e => StackIndex -> LuaE e ByteString
tostring' StackIndex
top
  PandocLua () -> LuaE PandocError ()
forall a. PandocLua a -> LuaE PandocError a
unPandocLua (PandocLua () -> LuaE PandocError ())
-> (LogMessage -> PandocLua ())
-> LogMessage
-> LuaE PandocError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogMessage -> PandocLua ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> LuaE PandocError ())
-> LogMessage -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ Text -> Maybe SourcePos -> LogMessage
ScriptingWarning (ByteString -> Text
UTF8.toText ByteString
msg) (Text -> Maybe SourcePos
toSourcePos Text
loc)
 where
   toSourcePos :: Text -> Maybe SourcePos
toSourcePos Text
loc = (HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOnEnd Text
":" (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe Text
T.stripSuffix Text
": " Text
loc)
     Maybe (Text, Text)
-> ((Text, Text) -> Maybe ((Text, Char), Int))
-> Maybe ((Text, Char), Int)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(Text
prfx, Text
sfx) -> (,) ((Text, Char) -> Int -> ((Text, Char), Int))
-> Maybe (Text, Char) -> Maybe (Int -> ((Text, Char), Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Text, Char)
T.unsnoc Text
prfx Maybe (Int -> ((Text, Char), Int))
-> Maybe Int -> Maybe ((Text, Char), Int)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
readMaybe (Text -> FilePath
T.unpack Text
sfx))
     Maybe ((Text, Char), Int)
-> (((Text, Char), Int) -> Maybe SourcePos) -> Maybe SourcePos
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \((Text
source, Char
_), Int
line) -> SourcePos -> Maybe SourcePos
forall a. a -> Maybe a
Just (SourcePos -> Maybe SourcePos) -> SourcePos -> Maybe SourcePos
forall a b. (a -> b) -> a -> b
$ FilePath -> Int -> Int -> SourcePos
newPos (Text -> FilePath
T.unpack Text
source) Int
line Int
1