{-# 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 (..))
import Text.Pandoc.Data (readDataFile)
import Text.Pandoc.Error (PandocError (PandocLuaError))
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
import Text.Pandoc.Lua.Marshal.List (newListMetatable, pushListModule)
import Text.Pandoc.Lua.PandocLua (PandocLua (..), liftPandocLua)
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

-- | 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 (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
(forall b. LuaE PandocError b -> IO b) -> PandocLua a -> m a
runPandocLuaWith forall e a. LuaE e a -> IO a
Lua.run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ do
    PandocLua ()
initLuaState
    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 (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
(forall b. LuaE PandocError b -> IO b) -> PandocLua a -> m a
runPandocLuaWith (forall e a. GCManagedState -> LuaE e a -> IO a
withGCManagedState GCManagedState
luaState) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ do
    PandocLua ()
initLuaState
    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 (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
(forall b. LuaE PandocError b -> IO b) -> PandocLua a -> m a
runPandocLuaWith forall e a. LuaE e a -> IO a
Lua.run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ do
    forall a. LuaE PandocError a -> PandocLua a
liftPandocLua 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.
      forall e. Bool -> LuaE e ()
Lua.pushboolean Bool
True
      forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield StackIndex
Lua.registryindex Name
"LUA_NOENV"
    PandocLua ()
initLuaState
    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
  , 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
  , forall e. LuaError e => Module e
Module.Layout.documentedModule { moduleName :: Name
moduleName = Name
"pandoc.layout" }
    forall {e}. Module e -> [Int] -> Module e
`allSince` [Int
2,Int
18]
  , forall e. LuaError e => Module e
Module.Path.documentedModule { moduleName :: Name
moduleName = Name
"pandoc.path" }
    forall {e}. Module e -> [Int] -> Module e
`allSince` [Int
2,Int
12]
  , forall e. LuaError e => Module e
Module.Zip.documentedModule { moduleName :: Name
moduleName = Name
"pandoc.zip" }
    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 :: [DocumentedFunction e]
moduleFunctions = forall a b. (a -> b) -> [a] -> [b]
map (forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int]
version) forall a b. (a -> b) -> a -> b
$ forall e. Module e -> [DocumentedFunction e]
moduleFunctions Module e
mdl
    }

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

  loadInitScript :: FilePath -> PandocLua ()
  loadInitScript :: FilePath -> PandocLua ()
loadInitScript FilePath
scriptFile = do
    ByteString
script <- forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile FilePath
scriptFile
    Status
status <- forall a. LuaE PandocError a -> PandocLua a
liftPandocLua forall a b. (a -> b) -> a -> b
$ forall e. ByteString -> LuaE e Status
Lua.dostring ByteString
script
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status
status forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LuaE PandocError a -> PandocLua a
liftPandocLua forall a b. (a -> b) -> a -> b
$ do
      PandocError
err <- forall e. LuaError e => LuaE e e
popException
      let prefix :: Text
prefix = Text
"Couldn't load '" forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
scriptFile forall a. Semigroup a => a -> a -> a
<> Text
"':\n"
      forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PandocError
PandocLuaError forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
prefix forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$ case PandocError
err of
        PandocLuaError Text
msg -> Text
msg
        PandocError
_                  -> FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show PandocError
err

  setGlobalModules :: PandocLua ()
  setGlobalModules :: PandocLua ()
setGlobalModules = forall a. LuaE PandocError a -> PandocLua a
liftPandocLua 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 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Name, CFunction)]
globalModules forall a b. (a -> b) -> a -> b
$
      \(Name
pkgname, CFunction
luaopen) -> do
        forall e. CFunction -> LuaE e ()
Lua.pushcfunction CFunction
luaopen
        Bool
usedBuiltIn <- forall e.
NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status
Lua.pcall NumArgs
0 NumResults
1 forall a. Maybe a
Nothing 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
            forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
Lua.registryindex Name
Lua.loaded
            forall e. StackIndex -> LuaE e ()
Lua.pushvalue (CInt -> StackIndex
Lua.nth CInt
2)
            forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield (CInt -> StackIndex
Lua.nth CInt
2) Name
pkgname
            forall e. Int -> LuaE e ()
Lua.pop Int
1  -- pop _LOADED
            forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          Status
_  -> do               -- built-in library failed, load system lib
            forall e. Int -> LuaE e ()
Lua.pop Int
1  -- ignore error message
            -- Try loading via the normal package loading mechanism.
            forall e. LuaError e => Name -> LuaE e Type
Lua.getglobal Name
"require"
            forall e. Name -> LuaE e ()
Lua.pushName Name
pkgname
            forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
Lua.call NumArgs
1 NumResults
1  -- Throws an exception if loading failed again!
            forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

        -- Module on top of stack. Register as global
        forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
pkgname
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
usedBuiltIn then forall a. a -> Maybe a
Just Name
pkgname else 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.
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Name]
loadedBuiltInModules forall a b. (a -> b) -> a -> b
$ \Name
pkgname -> do
      forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
Lua.registryindex Name
Lua.loaded
      forall e. LuaE e ()
Lua.pushnil
      forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield (CInt -> StackIndex
Lua.nth CInt
2) Name
pkgname
      forall e. Int -> LuaE e ()
Lua.pop Int
1  -- registry

  installLpegSearcher :: PandocLua ()
  installLpegSearcher :: PandocLua ()
installLpegSearcher = forall a. LuaE PandocError a -> PandocLua a
liftPandocLua forall a b. (a -> b) -> a -> b
$ do
    forall e. LuaError e => Name -> LuaE e ()
Lua.getglobal' Name
"package.searchers"
    forall e. LuaError e => HaskellFunction e -> LuaE e ()
Lua.pushHaskellFunction forall a b. (a -> b) -> a -> b
$ forall e. LuaE e State
Lua.state forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreCFunction
LPeg.lpeg_searcher
    forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
Lua.rawseti (CInt -> StackIndex
Lua.nth CInt
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+Integer
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e. StackIndex -> LuaE e Int
Lua.rawlen (CInt -> StackIndex
Lua.nth CInt
2)
    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 = forall a. LuaE PandocError a -> PandocLua a
liftPandocLua forall a b. (a -> b) -> a -> b
$ do
  forall e. Name -> LuaE e () -> LuaE e ()
newListMetatable Name
HsLua.Aeson.jsonarray (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  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 <- forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
  [Global]
globals <- forall (m :: * -> *). PandocMonad m => m [Global]
defaultGlobals
  (a
result, CommonState
newState) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. LuaE PandocError b -> IO b
runner forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PandocLua a -> LuaE PandocError a
unPandocLua forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState CommonState
origState
    forall a. LuaE PandocError a -> PandocLua a
liftPandocLua forall a b. (a -> b) -> a -> b
$ [Global] -> LuaE PandocError ()
setGlobals [Global]
globals
    a
r <- PandocLua a
pLua
    CommonState
c <- forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
    forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, CommonState
c)
  forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState CommonState
newState
  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 <- forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
  forall (m :: * -> *) a. Monad m => a -> m a
return
    [ Global
PANDOC_API_VERSION
    , CommonState -> Global
PANDOC_STATE CommonState
commonState
    , Global
PANDOC_VERSION
    ]