{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}
{- |
   Module      : Text.Pandoc.Lua.Packages
   Copyright   : Copyright © 2017-2022 Albert Krewinkel
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha

Pandoc module for Lua.
-}
module Text.Pandoc.Lua.Packages
  ( installPandocPackageSearcher
  ) where

import Control.Monad (forM_)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshal.List (pushListModule)
import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua)

import qualified HsLua as Lua
import qualified HsLua.Module.Path as Path
import qualified HsLua.Module.Text as Text
import qualified Text.Pandoc.Lua.Module.Pandoc as Pandoc
import qualified Text.Pandoc.Lua.Module.MediaBag as MediaBag
import qualified Text.Pandoc.Lua.Module.System as System
import qualified Text.Pandoc.Lua.Module.Template as Template
import qualified Text.Pandoc.Lua.Module.Types as Types
import qualified Text.Pandoc.Lua.Module.Utils as Utils

-- | Insert pandoc's package loader as the first loader, making it the default.
installPandocPackageSearcher :: PandocLua ()
installPandocPackageSearcher :: PandocLua ()
installPandocPackageSearcher = 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"
  LuaE PandocError ()
shiftArray
  LuaE PandocError NumResults -> LuaE PandocError ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
Lua.pushHaskellFunction (LuaE PandocError NumResults -> LuaE PandocError ())
-> LuaE PandocError NumResults -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ (String -> PandocLua NumResults) -> LuaE PandocError NumResults
forall e a. Exposable e a => a -> HaskellFunction e
Lua.toHaskellFunction String -> PandocLua NumResults
pandocPackageSearcher
  StackIndex -> Integer -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
Lua.rawseti (CInt -> StackIndex
Lua.nth CInt
2) Integer
1
  Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
Lua.pop Int
1           -- remove 'package.searchers' from stack
 where
  shiftArray :: LuaE PandocError ()
shiftArray = [Integer]
-> (Integer -> LuaE PandocError ()) -> LuaE PandocError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Integer
4, Integer
3, Integer
2, Integer
1] ((Integer -> LuaE PandocError ()) -> LuaE PandocError ())
-> (Integer -> LuaE PandocError ()) -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ \Integer
i -> do
    StackIndex -> Integer -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
Lua.rawgeti (-StackIndex
1) Integer
i
    StackIndex -> Integer -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
Lua.rawseti (-StackIndex
2) (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)

-- | Load a pandoc module.
pandocPackageSearcher :: String -> PandocLua Lua.NumResults
pandocPackageSearcher :: String -> PandocLua NumResults
pandocPackageSearcher String
pkgName =
  case String
pkgName of
    String
"pandoc"          -> Module PandocError -> PandocLua NumResults
pushModuleLoader Module PandocError
Pandoc.documentedModule
    String
"pandoc.mediabag" -> Module PandocError -> PandocLua NumResults
pushModuleLoader Module PandocError
MediaBag.documentedModule
    String
"pandoc.path"     -> Module PandocError -> PandocLua NumResults
pushModuleLoader Module PandocError
forall e. LuaError e => Module e
Path.documentedModule
    String
"pandoc.system"   -> Module PandocError -> PandocLua NumResults
pushModuleLoader Module PandocError
forall e. LuaError e => Module e
System.documentedModule
    String
"pandoc.template" -> Module PandocError -> PandocLua NumResults
pushModuleLoader Module PandocError
Template.documentedModule
    String
"pandoc.types"    -> Module PandocError -> PandocLua NumResults
pushModuleLoader Module PandocError
Types.documentedModule
    String
"pandoc.utils"    -> Module PandocError -> PandocLua NumResults
pushModuleLoader Module PandocError
Utils.documentedModule
    String
"text"            -> Module PandocError -> PandocLua NumResults
pushModuleLoader Module PandocError
forall e. Module e
Text.documentedModule
    String
"pandoc.List"     -> LuaE PandocError NumResults -> PandocLua NumResults
forall {a}. Num a => LuaE PandocError NumResults -> PandocLua a
pushWrappedHsFun (LuaE PandocError NumResults -> PandocLua NumResults)
-> (LuaE PandocError NumResults -> LuaE PandocError NumResults)
-> LuaE PandocError NumResults
-> PandocLua NumResults
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exposable e a => a -> HaskellFunction e
Lua.toHaskellFunction @PandocError (LuaE PandocError NumResults -> PandocLua NumResults)
-> LuaE PandocError NumResults -> PandocLua NumResults
forall a b. (a -> b) -> a -> b
$
                         (CInt -> NumResults
Lua.NumResults CInt
1 NumResults -> LuaE PandocError () -> LuaE PandocError NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e. LuaError e => LuaE e ()
pushListModule @PandocError)
    String
_                 -> PandocLua NumResults
reportPandocSearcherFailure
 where
  pushModuleLoader :: Module PandocError -> PandocLua NumResults
pushModuleLoader Module PandocError
mdl = LuaE PandocError NumResults -> PandocLua NumResults
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError NumResults -> PandocLua NumResults)
-> LuaE PandocError NumResults -> PandocLua NumResults
forall a b. (a -> b) -> a -> b
$ do
    LuaE PandocError NumResults -> LuaE PandocError ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
Lua.pushHaskellFunction (LuaE PandocError NumResults -> LuaE PandocError ())
-> LuaE PandocError NumResults -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$
      CInt -> NumResults
Lua.NumResults CInt
1 NumResults -> LuaE PandocError () -> LuaE PandocError NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e. LuaError e => Module e -> LuaE e ()
Lua.pushModule @PandocError Module PandocError
mdl
    NumResults -> LuaE PandocError NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
Lua.NumResults CInt
1)
  pushWrappedHsFun :: LuaE PandocError NumResults -> PandocLua a
pushWrappedHsFun LuaE PandocError NumResults
f = LuaE PandocError a -> PandocLua a
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError a -> PandocLua a)
-> LuaE PandocError a -> PandocLua a
forall a b. (a -> b) -> a -> b
$ do
    LuaE PandocError NumResults -> LuaE PandocError ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
Lua.pushHaskellFunction LuaE PandocError NumResults
f
    a -> LuaE PandocError a
forall (m :: * -> *) a. Monad m => a -> m a
return a
1
  reportPandocSearcherFailure :: PandocLua NumResults
reportPandocSearcherFailure = LuaE PandocError NumResults -> PandocLua NumResults
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError NumResults -> PandocLua NumResults)
-> LuaE PandocError NumResults -> PandocLua NumResults
forall a b. (a -> b) -> a -> b
$ do
    String -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push (String
"\n\t" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pkgName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is not one of pandoc's default packages")
    NumResults -> LuaE PandocError NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
Lua.NumResults CInt
1)