{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Lua.Module
   Copyright   : © 2017-2024 Albert Krewinkel
   License     : GPL-2.0-or-later
   Maintainer  : Albert Krewinkel <albert+pandoc@tarleb.com>

Setting up and initializing Lua modules.
-}

module Text.Pandoc.Lua.Module
  ( initModules
  ) where

import Control.Monad (forM_, when)
import Data.Version (makeVersion)
import HsLua as Lua
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshal.List (pushPandocList, pushListModule)
import Text.Pandoc.Lua.PandocLua (PandocLua (..), liftPandocLua)
import qualified Data.ByteString.Char8 as Char8
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.Image as Pandoc.Image
import qualified Text.Pandoc.Lua.Module.JSON as Pandoc.JSON
import qualified Text.Pandoc.Lua.Module.Log as Pandoc.Log
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

initModules :: PandocLua ()
initModules :: PandocLua ()
initModules = do
  PandocLua ()
initPandocModule
  PandocLua ()
initJsonMetatable
  PandocLua ()
installLpegSearcher
  PandocLua ()
setGlobalModules

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

-- | 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.
submodules :: [Module PandocError]
submodules :: [Module PandocError]
submodules =
  [ Module PandocError
Pandoc.CLI.documentedModule
  , Module PandocError
Pandoc.Format.documentedModule
  , Module PandocError
Pandoc.Image.documentedModule
  , Module PandocError
Pandoc.JSON.documentedModule
  , Module PandocError
Pandoc.Log.documentedModule
  , Module PandocError
Pandoc.MediaBag.documentedModule
  , Module PandocError
Pandoc.Scaffolding.documentedModule
  , Module PandocError
Pandoc.Structure.documentedModule
  , Module PandocError
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
  , Module PandocError
forall e. LuaError e => Module e
Module.Layout.documentedModule { moduleName = "pandoc.layout" }
    Module PandocError -> [Int] -> Module PandocError
forall {e}. Module e -> [Int] -> Module e
`allSince` [Int
2,Int
18]
  , Module PandocError
forall e. LuaError e => Module e
Module.Path.documentedModule { moduleName = "pandoc.path" }
    Module PandocError -> [Int] -> Module PandocError
forall {e}. Module e -> [Int] -> Module e
`allSince` [Int
2,Int
12]
  , Module PandocError
forall e. LuaError e => Module e
Module.Zip.documentedModule { moduleName = "pandoc.zip" }
    Module PandocError -> [Int] -> Module PandocError
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 = map (`since` makeVersion version) $ moduleFunctions mdl
    }

-- | Load all global modules and set them to their global variables.
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, CFunction)]
-> ((Name, CFunction) -> LuaE PandocError ())
-> LuaE PandocError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Name, CFunction)]
globalModules (((Name, CFunction) -> LuaE PandocError ()) -> LuaE PandocError ())
-> ((Name, CFunction) -> LuaE PandocError ())
-> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$
    \(Name
pkgname, CFunction
luaopen) -> do
      CFunction -> LuaE PandocError ()
forall e. CFunction -> LuaE e ()
Lua.pushcfunction CFunction
luaopen
      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 ()) -> LuaE PandocError ()
forall a b.
LuaE PandocError a
-> (a -> LuaE PandocError b) -> LuaE PandocError b
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
        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!

      -- Module on top of stack. Register as global
      Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
pkgname

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 a b.
LuaE PandocError a
-> (a -> LuaE PandocError b) -> LuaE PandocError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO NumResults -> HaskellFunction PandocError
forall a. IO a -> LuaE PandocError a
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

-- | Setup the metatable that's assigned to Lua tables that were created
-- from/via JSON arrays.
initJsonMetatable :: PandocLua ()
initJsonMetatable :: PandocLua ()
initJsonMetatable = 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
  Pusher PandocError Any -> Pusher PandocError [Any]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList (LuaE PandocError () -> Pusher PandocError Any
forall a b. a -> b -> a
const LuaE PandocError ()
forall e. LuaE e ()
pushnil) []
  StackIndex -> LuaE PandocError Bool
forall e. StackIndex -> LuaE e Bool
getmetatable StackIndex
top
  StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield StackIndex
registryindex Name
HsLua.Aeson.jsonarray
  Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
Lua.pop Int
1