{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Lua
   Copyright   : Copyright © 2017-2021 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 (when)
import Control.Monad.Catch (throwM, try)
import Control.Monad.Trans (MonadIO (..))
import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr)
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 Text.Pandoc.Definition as Pandoc
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

-- | 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
  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 -> LuaE PandocError ()
forall e. StackIndex -> LuaE e ()
Lua.pushvalue StackIndex
Lua.top
      StackIndex -> Name -> LuaE PandocError Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
Lua.registryindex Name
Lua.loaded
      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
    -- copy constructors into registry
    PandocLua ()
putConstructorsInRegistry
    -- 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

-- | AST elements are marshaled via normal constructor functions in the
-- @pandoc@ module. However, accessing Lua globals from Haskell is
-- expensive (due to error handling). Accessing the Lua registry is much
-- cheaper, which is why the constructor functions are copied into the
-- Lua registry and called from there.
--
-- This function expects the @pandoc@ module to be at the top of the
-- stack.
putConstructorsInRegistry :: PandocLua ()
putConstructorsInRegistry :: PandocLua ()
putConstructorsInRegistry = 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
  Meta -> LuaE PandocError ()
forall a. Data a => a -> LuaE PandocError ()
constrsToReg (Meta -> LuaE PandocError ()) -> Meta -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ Map Text MetaValue -> Meta
Pandoc.Meta Map Text MetaValue
forall a. Monoid a => a
mempty
  MetaValue -> LuaE PandocError ()
forall a. Data a => a -> LuaE PandocError ()
constrsToReg (MetaValue -> LuaE PandocError ())
-> MetaValue -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ [MetaValue] -> MetaValue
Pandoc.MetaList [MetaValue]
forall a. Monoid a => a
mempty
  FilePath -> LuaE PandocError ()
putInReg FilePath
"List"  -- pandoc.List
  FilePath -> LuaE PandocError ()
putInReg FilePath
"SimpleTable"  -- helper for backward-compatible table handling
 where
  constrsToReg :: Data a => a -> LuaE PandocError ()
  constrsToReg :: a -> LuaE PandocError ()
constrsToReg = (Constr -> LuaE PandocError ()) -> [Constr] -> LuaE PandocError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> LuaE PandocError ()
putInReg (FilePath -> LuaE PandocError ())
-> (Constr -> FilePath) -> Constr -> LuaE PandocError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> FilePath
showConstr) ([Constr] -> LuaE PandocError ())
-> (a -> [Constr]) -> a -> LuaE PandocError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> [Constr]
dataTypeConstrs (DataType -> [Constr]) -> (a -> DataType) -> a -> [Constr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DataType
forall a. Data a => a -> DataType
dataTypeOf

  putInReg :: String -> LuaE PandocError ()
  putInReg :: FilePath -> LuaE PandocError ()
putInReg FilePath
name = do
    FilePath -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (FilePath
"pandoc." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name) -- name in registry
    FilePath -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push FilePath
name -- in pandoc module
    StackIndex -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawget (CInt -> StackIndex
Lua.nth CInt
3)
    StackIndex -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> LuaE e ()
Lua.rawset StackIndex
Lua.registryindex