{- |
   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
  ( LuaException (..)
  , LuaPackageParams (..)
  , runLua
  , luaPackageParams
  ) where

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.Class.PandocMonad (getCommonState, getUserDataDir,
                                      putCommonState)
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
import Text.Pandoc.Lua.Packages (LuaPackageParams (..),
                                 installPandocPackageSearcher)
import Text.Pandoc.Lua.Util (loadScriptFromDataDir)

import qualified Data.Text as Text
import qualified Foreign.Lua as Lua
import qualified Foreign.Lua.Module.Text as Lua
import qualified Text.Pandoc.Definition as Pandoc
import qualified Text.Pandoc.Lua.Module.Pandoc as ModulePandoc

-- | Lua error message
newtype LuaException = LuaException Text.Text deriving (Int -> LuaException -> ShowS
[LuaException] -> ShowS
LuaException -> String
(Int -> LuaException -> ShowS)
-> (LuaException -> String)
-> ([LuaException] -> ShowS)
-> Show LuaException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LuaException] -> ShowS
$cshowList :: [LuaException] -> ShowS
show :: LuaException -> String
$cshow :: LuaException -> String
showsPrec :: Int -> LuaException -> ShowS
$cshowsPrec :: Int -> LuaException -> ShowS
Show)

-- | Run the lua interpreter, using pandoc's default way of environment
-- initialization.
runLua :: Lua a -> PandocIO (Either LuaException a)
runLua :: Lua a -> PandocIO (Either LuaException a)
runLua Lua a
luaOp = do
  LuaPackageParams
luaPkgParams <- PandocIO LuaPackageParams
luaPackageParams
  [Global]
globals <- PandocIO [Global]
defaultGlobals
  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 Exception (a, CommonState)
res <- IO (Either Exception (a, CommonState))
-> PandocIO (Either Exception (a, CommonState))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Exception (a, CommonState))
 -> PandocIO (Either Exception (a, CommonState)))
-> (Lua (a, CommonState) -> IO (Either Exception (a, CommonState)))
-> Lua (a, CommonState)
-> PandocIO (Either Exception (a, CommonState))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lua (a, CommonState) -> IO (Either Exception (a, CommonState))
forall a. Lua a -> IO (Either Exception a)
Lua.runEither (Lua (a, CommonState)
 -> PandocIO (Either Exception (a, CommonState)))
-> Lua (a, CommonState)
-> PandocIO (Either Exception (a, CommonState))
forall a b. (a -> b) -> a -> b
$ do
    [Global] -> Lua ()
setGlobals [Global]
globals
    LuaPackageParams -> Lua ()
initLuaState LuaPackageParams
luaPkgParams
    -- run the given Lua operation
    a
opResult <- Lua a
luaOp
    -- get the (possibly modified) state back
    String -> Lua ()
Lua.getglobal String
"PANDOC_STATE"
    CommonState
st <- StackIndex -> Lua CommonState
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
Lua.stackTop
    StackIndex -> Lua ()
Lua.pop StackIndex
1
    -- done
    (a, CommonState) -> Lua (a, CommonState)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
opResult, CommonState
st)
  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
  case Either Exception (a, CommonState)
res of
    Left (Lua.Exception String
msg) -> Either LuaException a -> PandocIO (Either LuaException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either LuaException a -> PandocIO (Either LuaException a))
-> Either LuaException a -> PandocIO (Either LuaException a)
forall a b. (a -> b) -> a -> b
$ LuaException -> Either LuaException a
forall a b. a -> Either a b
Left (Text -> LuaException
LuaException (Text -> LuaException) -> Text -> LuaException
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
msg)
    Right (a
x, CommonState
newState) -> do
      CommonState -> PandocIO ()
forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState CommonState
newState
      Either LuaException a -> PandocIO (Either LuaException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either LuaException a -> PandocIO (Either LuaException a))
-> Either LuaException a -> PandocIO (Either LuaException a)
forall a b. (a -> b) -> a -> b
$ a -> Either LuaException a
forall a b. b -> Either a b
Right a
x

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

-- | Generate parameters required to setup pandoc's lua environment.
luaPackageParams :: PandocIO LuaPackageParams
luaPackageParams :: PandocIO LuaPackageParams
luaPackageParams = do
  Maybe String
datadir <- PandocIO (Maybe String)
forall (m :: * -> *). PandocMonad m => m (Maybe String)
getUserDataDir
  LuaPackageParams -> PandocIO LuaPackageParams
forall (m :: * -> *) a. Monad m => a -> m a
return LuaPackageParams :: Maybe String -> LuaPackageParams
LuaPackageParams { luaPkgDataDir :: Maybe String
luaPkgDataDir = Maybe String
datadir }

-- | Initialize the lua state with all required values
initLuaState :: LuaPackageParams -> Lua ()
initLuaState :: LuaPackageParams -> Lua ()
initLuaState LuaPackageParams
pkgParams = do
  Lua ()
Lua.openlibs
  String -> Lua ()
Lua.preloadTextModule String
"text"
  LuaPackageParams -> Lua ()
installPandocPackageSearcher LuaPackageParams
pkgParams
  Lua ()
initPandocModule
  Maybe String -> String -> Lua ()
loadScriptFromDataDir (LuaPackageParams -> Maybe String
luaPkgDataDir LuaPackageParams
pkgParams) String
"init.lua"
 where
  initPandocModule :: Lua ()
  initPandocModule :: Lua ()
initPandocModule = do
    -- Push module table
    Maybe String -> Lua NumResults
ModulePandoc.pushModule (LuaPackageParams -> Maybe String
luaPkgDataDir LuaPackageParams
pkgParams)
    -- register as loaded module
    StackIndex -> Lua ()
Lua.pushvalue StackIndex
Lua.stackTop
    StackIndex -> String -> Lua ()
Lua.getfield StackIndex
Lua.registryindex String
Lua.loadedTableRegistryField
    StackIndex -> String -> Lua ()
Lua.setfield (CInt -> StackIndex
Lua.nthFromTop CInt
2) String
"pandoc"
    StackIndex -> Lua ()
Lua.pop StackIndex
1
    -- copy constructors into registry
    Lua ()
putConstructorsInRegistry
    -- assign module to global variable
    String -> Lua ()
Lua.setglobal String
"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 :: Lua ()
putConstructorsInRegistry :: Lua ()
putConstructorsInRegistry = 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
  String -> Lua ()
putInReg String
"Attr"  -- used for Attr type alias
  String -> Lua ()
putInReg String
"ListAttributes"  -- used for ListAttributes type alias
  String -> Lua ()
putInReg String
"List"  -- pandoc.List
 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_ (String -> Lua ()
putInReg (String -> Lua ()) -> (Constr -> String) -> Constr -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> String
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 :: String -> Lua ()
putInReg String
name = do
    String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (String
"pandoc." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name) -- name in registry
    String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push String
name -- in pandoc module
    StackIndex -> Lua ()
Lua.rawget (CInt -> StackIndex
Lua.nthFromTop CInt
3)
    StackIndex -> Lua ()
Lua.rawset StackIndex
Lua.registryindex