{- |
   Module      : Text.Pandoc.Lua
   Copyright   : Copyright © 2017-2020 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.Catch (try)
import Control.Monad.Trans (MonadIO (..))
import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr)
import Foreign.Lua (Lua)
import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)
import Text.Pandoc.Class.PandocIO (PandocIO)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Packages (installPandocPackageSearcher)
import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua,
                                  loadScriptFromDataDir, runPandocLua)

import qualified Foreign.Lua as Lua
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 :: Lua a -> PandocIO (Either PandocError a)
runLua :: Lua a -> PandocIO (Either PandocError a)
runLua Lua a
luaOp = do
  TextEncoding
enc <- IO TextEncoding -> PandocIO TextEncoding
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextEncoding -> PandocIO TextEncoding)
-> IO TextEncoding -> PandocIO 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) -> PandocIO (Either PandocError a)
forall a. PandocLua a -> PandocIO a
runPandocLua (PandocLua (Either PandocError a)
 -> PandocIO (Either PandocError a))
-> (PandocLua a -> PandocLua (Either PandocError a))
-> PandocLua a
-> PandocIO (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 -> PandocIO (Either PandocError a))
-> PandocLua a -> PandocIO (Either PandocError a)
forall a b. (a -> b) -> a -> b
$ do
    PandocLua ()
initLuaState
    Lua a -> PandocLua a
forall a. Lua a -> PandocLua a
liftPandocLua Lua a
luaOp
  IO () -> PandocIO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PandocIO ()) -> IO () -> PandocIO ()
forall a b. (a -> b) -> a -> b
$ TextEncoding -> IO ()
setForeignEncoding TextEncoding
enc
  Either PandocError a -> PandocIO (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
  Lua () -> PandocLua ()
forall a. Lua a -> PandocLua a
liftPandocLua Lua ()
Lua.openlibs
  PandocLua ()
installPandocPackageSearcher
  PandocLua ()
initPandocModule
  FilePath -> PandocLua ()
loadScriptFromDataDir FilePath
"init.lua"
 where
  initPandocModule :: PandocLua ()
  initPandocModule :: PandocLua ()
initPandocModule = do
    -- Push module table
    PandocLua NumResults
ModulePandoc.pushModule
    -- register as loaded module
    Lua () -> PandocLua ()
forall a. Lua a -> PandocLua a
liftPandocLua (Lua () -> PandocLua ()) -> Lua () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ do
      StackIndex -> Lua ()
Lua.pushvalue StackIndex
Lua.stackTop
      StackIndex -> FilePath -> Lua ()
Lua.getfield StackIndex
Lua.registryindex FilePath
Lua.loadedTableRegistryField
      StackIndex -> FilePath -> Lua ()
Lua.setfield (CInt -> StackIndex
Lua.nthFromTop CInt
2) FilePath
"pandoc"
      StackIndex -> Lua ()
Lua.pop StackIndex
1
    -- copy constructors into registry
    PandocLua ()
putConstructorsInRegistry
    -- assign module to global variable
    Lua () -> PandocLua ()
forall a. Lua a -> PandocLua a
liftPandocLua (Lua () -> PandocLua ()) -> Lua () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Lua ()
Lua.setglobal FilePath
"pandoc"

-- | 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 = Lua () -> PandocLua ()
forall a. Lua a -> PandocLua a
liftPandocLua (Lua () -> PandocLua ()) -> Lua () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ do
  Pandoc -> Lua ()
forall a. Data a => a -> Lua ()
constrsToReg (Pandoc -> Lua ()) -> Pandoc -> Lua ()
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc.Pandoc Meta
forall a. Monoid a => a
mempty [Block]
forall a. Monoid a => a
mempty
  Inline -> Lua ()
forall a. Data a => a -> Lua ()
constrsToReg (Inline -> Lua ()) -> Inline -> Lua ()
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Pandoc.Str Text
forall a. Monoid a => a
mempty
  Block -> Lua ()
forall a. Data a => a -> Lua ()
constrsToReg (Block -> Lua ()) -> Block -> Lua ()
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Pandoc.Para [Inline]
forall a. Monoid a => a
mempty
  Meta -> Lua ()
forall a. Data a => a -> Lua ()
constrsToReg (Meta -> Lua ()) -> Meta -> Lua ()
forall a b. (a -> b) -> a -> b
$ Map Text MetaValue -> Meta
Pandoc.Meta Map Text MetaValue
forall a. Monoid a => a
mempty
  MetaValue -> Lua ()
forall a. Data a => a -> Lua ()
constrsToReg (MetaValue -> Lua ()) -> MetaValue -> Lua ()
forall a b. (a -> b) -> a -> b
$ [MetaValue] -> MetaValue
Pandoc.MetaList [MetaValue]
forall a. Monoid a => a
mempty
  Citation -> Lua ()
forall a. Data a => a -> Lua ()
constrsToReg (Citation -> Lua ()) -> Citation -> Lua ()
forall a b. (a -> b) -> a -> b
$ Text
-> [Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation
Pandoc.Citation Text
forall a. Monoid a => a
mempty [Inline]
forall a. Monoid a => a
mempty [Inline]
forall a. Monoid a => a
mempty CitationMode
Pandoc.AuthorInText Int
0 Int
0
  FilePath -> Lua ()
putInReg FilePath
"Attr"  -- used for Attr type alias
  FilePath -> Lua ()
putInReg FilePath
"ListAttributes"  -- used for ListAttributes type alias
  FilePath -> Lua ()
putInReg FilePath
"List"  -- pandoc.List
  FilePath -> Lua ()
putInReg FilePath
"SimpleTable"  -- helper for backward-compatible table handling
 where
  constrsToReg :: Data a => a -> Lua ()
  constrsToReg :: a -> Lua ()
constrsToReg = (Constr -> Lua ()) -> [Constr] -> Lua ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> Lua ()
putInReg (FilePath -> Lua ()) -> (Constr -> FilePath) -> Constr -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> FilePath
showConstr) ([Constr] -> Lua ()) -> (a -> [Constr]) -> a -> Lua ()
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 -> Lua ()
  putInReg :: FilePath -> Lua ()
putInReg FilePath
name = do
    FilePath -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (FilePath
"pandoc." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name) -- name in registry
    FilePath -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push FilePath
name -- in pandoc module
    StackIndex -> Lua ()
Lua.rawget (CInt -> StackIndex
Lua.nthFromTop CInt
3)
    StackIndex -> Lua ()
Lua.rawset StackIndex
Lua.registryindex