{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{- |
   Module      : Text.Pandoc.Writers.Custom
   Copyright   : 2012-2022 John MacFarlane,
   License     : GNU GPL, version 2 or above
   Maintainer  : John MacFarlane <jgm@berkeley.edu>

Conversion of 'Pandoc' documents to custom markup using
a Lua writer.
-}
module Text.Pandoc.Writers.Custom ( writeCustom ) where
import Control.Exception
import Control.Monad ((<=<))
import Data.Text (Text)
import HsLua
import Control.Monad.IO.Class (MonadIO)
import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Definition (Pandoc (..))
import Text.Pandoc.Lua (Global (..), runLua, setGlobals)
import Text.Pandoc.Options (WriterOptions)

import qualified Text.Pandoc.Lua.Writer.Classic as Classic

-- | Convert Pandoc to custom markup.
writeCustom :: (PandocMonad m, MonadIO m)
            => FilePath -> WriterOptions -> Pandoc -> m Text
writeCustom :: forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> WriterOptions -> Pandoc -> m Text
writeCustom FilePath
luaFile WriterOptions
opts Pandoc
doc = (PandocError -> m Text)
-> (Text -> m Text) -> Either PandocError Text -> m Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PandocError -> m Text
forall a e. Exception e => e -> a
throw Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PandocError Text -> m Text)
-> (LuaE PandocError Text -> m (Either PandocError Text))
-> LuaE PandocError Text
-> m Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< LuaE PandocError Text -> m (Either PandocError Text)
forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
LuaE PandocError a -> m (Either PandocError a)
runLua (LuaE PandocError Text -> m Text)
-> LuaE PandocError Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
  [Global] -> LuaE PandocError ()
setGlobals [ Pandoc -> Global
PANDOC_DOCUMENT Pandoc
doc
             , FilePath -> Global
PANDOC_SCRIPT_FILE FilePath
luaFile
             , WriterOptions -> Global
PANDOC_WRITER_OPTIONS WriterOptions
opts
             ]
  FilePath -> LuaE PandocError Status
forall e. FilePath -> LuaE e Status
dofileTrace FilePath
luaFile LuaE PandocError Status
-> (Status -> LuaE PandocError ()) -> LuaE PandocError ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Status
OK -> () -> LuaE PandocError ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Status
_  -> LuaE PandocError ()
forall e a. LuaError e => LuaE e a
throwErrorAsException
  -- Most classic writers contain code that throws an error if a global
  -- is not present. This would break our check for the existence of a
  -- "Writer" function. We resort to raw access for that reason, but
  -- could also catch the error instead.
  let rawgetglobal :: Name -> LuaE e Type
rawgetglobal Name
x = do
        LuaE e ()
forall e. LuaE e ()
pushglobaltable
        Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
x
        StackIndex -> LuaE e Type
forall e. LuaError e => StackIndex -> LuaE e Type
rawget (CInt -> StackIndex
nth CInt
2) LuaE e Type -> LuaE e () -> LuaE e Type
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
remove (CInt -> StackIndex
nth CInt
2) -- remove global table

  Name -> LuaE PandocError Type
forall {e}. LuaError e => Name -> LuaE e Type
rawgetglobal Name
"Writer" LuaE PandocError Type
-> (Type -> LuaE PandocError Text) -> LuaE PandocError Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeNil -> do
      Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
pop Int
1  -- remove nil
      WriterOptions -> Pandoc -> LuaE PandocError Text
forall e. LuaError e => WriterOptions -> Pandoc -> LuaE e Text
Classic.runCustom WriterOptions
opts Pandoc
doc
    Type
_       -> do
      -- Writer on top of the stack. Call it with document and writer
      -- options as arguments.
      Pandoc -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push Pandoc
doc
      WriterOptions -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push WriterOptions
opts
      NumArgs -> NumResults -> LuaE PandocError ()
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
callTrace NumArgs
2 NumResults
1
      Peek PandocError Text -> LuaE PandocError Text
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek PandocError Text -> LuaE PandocError Text)
-> Peek PandocError Text -> LuaE PandocError Text
forall a b. (a -> b) -> a -> b
$ Peeker PandocError Text
forall e. Peeker e Text
peekText StackIndex
top