{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
   Module      : Text.Pandoc.Lua.Packages
   Copyright   : Copyright © 2017-2020 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.Catch (try)
import Control.Monad (forM_)
import Data.ByteString (ByteString)
import Foreign.Lua (Lua, NumResults)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Class.PandocMonad (readDataFile)
import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua)

import qualified Foreign.Lua as Lua
import qualified Foreign.Lua.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.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 = Lua () -> PandocLua ()
forall a. Lua a -> PandocLua a
liftPandocLua (Lua () -> PandocLua ()) -> Lua () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ do
  String -> Lua ()
Lua.getglobal' String
"package.searchers"
  Lua ()
shiftArray
  (String -> PandocLua NumResults) -> Lua ()
forall a. ToHaskellFunction a => a -> Lua ()
Lua.pushHaskellFunction String -> PandocLua NumResults
pandocPackageSearcher
  StackIndex -> Integer -> Lua ()
Lua.rawseti (CInt -> StackIndex
Lua.nthFromTop CInt
2) Integer
1
  StackIndex -> Lua ()
Lua.pop StackIndex
1           -- remove 'package.searchers' from stack
 where
  shiftArray :: Lua ()
shiftArray = [Integer] -> (Integer -> Lua ()) -> Lua ()
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 -> Lua ()) -> Lua ()) -> (Integer -> Lua ()) -> Lua ()
forall a b. (a -> b) -> a -> b
$ \Integer
i -> do
    StackIndex -> Integer -> Lua ()
Lua.rawgeti (-StackIndex
1) Integer
i
    StackIndex -> Integer -> Lua ()
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 NumResults
pandocPackageSearcher :: String -> PandocLua NumResults
pandocPackageSearcher String
pkgName =
  case String
pkgName of
    String
"pandoc"          -> PandocLua NumResults -> PandocLua NumResults
forall a a. (ToHaskellFunction a, Num a) => a -> PandocLua a
pushWrappedHsFun PandocLua NumResults
Pandoc.pushModule
    String
"pandoc.mediabag" -> PandocLua NumResults -> PandocLua NumResults
forall a a. (ToHaskellFunction a, Num a) => a -> PandocLua a
pushWrappedHsFun PandocLua NumResults
MediaBag.pushModule
    String
"pandoc.system"   -> Lua NumResults -> PandocLua NumResults
forall a a. (ToHaskellFunction a, Num a) => a -> PandocLua a
pushWrappedHsFun Lua NumResults
System.pushModule
    String
"pandoc.types"    -> Lua NumResults -> PandocLua NumResults
forall a a. (ToHaskellFunction a, Num a) => a -> PandocLua a
pushWrappedHsFun Lua NumResults
Types.pushModule
    String
"pandoc.utils"    -> PandocLua NumResults -> PandocLua NumResults
forall a a. (ToHaskellFunction a, Num a) => a -> PandocLua a
pushWrappedHsFun PandocLua NumResults
Utils.pushModule
    String
"text"            -> Lua NumResults -> PandocLua NumResults
forall a a. (ToHaskellFunction a, Num a) => a -> PandocLua a
pushWrappedHsFun Lua NumResults
Text.pushModule
    String
_                 -> PandocLua NumResults
searchPureLuaLoader
 where
  pushWrappedHsFun :: a -> PandocLua a
pushWrappedHsFun a
f = Lua a -> PandocLua a
forall a. Lua a -> PandocLua a
liftPandocLua (Lua a -> PandocLua a) -> Lua a -> PandocLua a
forall a b. (a -> b) -> a -> b
$ do
    a -> Lua ()
forall a. ToHaskellFunction a => a -> Lua ()
Lua.pushHaskellFunction a
f
    a -> Lua a
forall (m :: * -> *) a. Monad m => a -> m a
return a
1
  searchPureLuaLoader :: PandocLua NumResults
searchPureLuaLoader = do
    let filename :: String
filename = String
pkgName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".lua"
    PandocLua ByteString -> PandocLua (Either PandocError ByteString)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (String -> PandocLua ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDataFile String
filename) PandocLua (Either PandocError ByteString)
-> (Either PandocError ByteString -> PandocLua NumResults)
-> PandocLua NumResults
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right ByteString
script -> Lua NumResults -> PandocLua NumResults
forall a a. (ToHaskellFunction a, Num a) => a -> PandocLua a
pushWrappedHsFun (String -> ByteString -> Lua NumResults
loadStringAsPackage String
pkgName ByteString
script)
      Left (PandocError
_ :: PandocError) -> Lua NumResults -> PandocLua NumResults
forall a. Lua a -> PandocLua a
liftPandocLua (Lua NumResults -> PandocLua NumResults)
-> Lua NumResults -> PandocLua NumResults
forall a b. (a -> b) -> a -> b
$ do
        String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (String
"\n\tno file '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
filename String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' in pandoc's datadir")
        NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (NumResults
1 :: NumResults)

loadStringAsPackage :: String -> ByteString -> Lua NumResults
loadStringAsPackage :: String -> ByteString -> Lua NumResults
loadStringAsPackage String
pkgName ByteString
script = do
  Status
status <- ByteString -> Lua Status
Lua.dostring ByteString
script
  if Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
Lua.OK
    then NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (NumResults
1 :: NumResults)
    else do
      String
msg <- Lua String
forall a. Peekable a => Lua a
Lua.popValue
      String -> Lua NumResults
forall a. Pushable a => a -> Lua NumResults
Lua.raiseError (String
"Error while loading `" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pkgName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`.\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg)