{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Lua
   Copyright   : Copyright © 2017-2022 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
  ) where

import Control.Monad (forM, forM_, when)
import Control.Monad.Catch (throwM, try)
import Control.Monad.Trans (MonadIO (..))
import Data.Maybe (catMaybes)
import HsLua as Lua hiding (status, try)
import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)
import Text.Pandoc.Class.PandocMonad (PandocMonad, readDataFile)
import Text.Pandoc.Error (PandocError (PandocLuaError))
import Text.Pandoc.Lua.Packages (installPandocPackageSearcher)
import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, runPandocLua)
import qualified Data.Text as T
import qualified Lua.LPeg as LPeg
import qualified Text.Pandoc.Lua.Module.Pandoc as ModulePandoc

-- | 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 :: LuaE PandocError a -> m (Either PandocError a)
runLua LuaE PandocError a
luaOp = do
  TextEncoding
enc <- IO TextEncoding -> m TextEncoding
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextEncoding -> m TextEncoding)
-> IO TextEncoding -> m TextEncoding
forall a b. (a -> b) -> a -> b
$ IO TextEncoding
getForeignEncoding IO TextEncoding -> IO () -> IO TextEncoding
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* TextEncoding -> IO ()
setForeignEncoding TextEncoding
utf8
  Either PandocError a
res <- PandocLua (Either PandocError a) -> m (Either PandocError a)
forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
PandocLua a -> m a
runPandocLua (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.
(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
luaOp
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TextEncoding -> IO ()
setForeignEncoding TextEncoding
enc
  Either PandocError a -> m (Either PandocError a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either PandocError a
res

-- | Modules that are loaded at startup and assigned to fields in the
-- pandoc module.
loadedModules :: [(Name, Name)]
loadedModules :: [(Name, Name)]
loadedModules =
  [ (Name
"pandoc.List", Name
"List")
  , (Name
"pandoc.mediabag", Name
"mediabag")
  , (Name
"pandoc.path", Name
"path")
  , (Name
"pandoc.system", Name
"system")
  , (Name
"pandoc.template", Name
"template")
  , (Name
"pandoc.types", Name
"types")
  , (Name
"pandoc.utils", Name
"utils")
  , (Name
"text", Name
"text")
  ]

-- | 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 ()
installPandocPackageSearcher
  PandocLua ()
initPandocModule
  PandocLua ()
installLpegSearcher
  PandocLua ()
setGlobalModules
  FilePath -> PandocLua ()
loadInitScript FilePath
"init.lua"
 where
  initPandocModule :: PandocLua ()
  initPandocModule :: PandocLua ()
initPandocModule = do
    -- Push module table
    PandocLua NumResults
ModulePandoc.pushModule
    -- register as loaded module
    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
      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
"pandoc"
      Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
Lua.pop Int
1  -- remove LOADED table
    -- load modules and add them to the `pandoc` module table.
    LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ [(Name, Name)]
-> ((Name, Name) -> LuaE PandocError ()) -> LuaE PandocError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Name, Name)]
loadedModules (((Name, Name) -> LuaE PandocError ()) -> LuaE PandocError ())
-> ((Name, Name) -> LuaE PandocError ()) -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ \(Name
pkgname, Name
fieldname) -> do
      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
      StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield (CInt -> StackIndex
nth CInt
2) Name
fieldname
    -- assign module to global variable
    LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ 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 (m :: * -> *) e a. (MonadThrow m, 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 (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 (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 (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 (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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO NumResults -> HaskellFunction PandocError
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