{-# 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.Maybe (fromMaybe)
import Data.Text (Text)
import HsLua
import Control.Monad.IO.Class (MonadIO)
import Text.Pandoc.Class (PandocMonad, findFileWithDataFallback)
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 = do
  FilePath
luaFile' <- forall a. a -> Maybe a -> a
fromMaybe FilePath
luaFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
FilePath -> FilePath -> m (Maybe FilePath)
findFileWithDataFallback FilePath
"writers" FilePath
luaFile
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
throw forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
LuaE PandocError a -> m (Either PandocError a)
runLua 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
               ]
    forall e. FilePath -> LuaE e Status
dofileTrace FilePath
luaFile' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Status
OK -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Status
_  -> 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
          forall e. LuaE e ()
pushglobaltable
          forall e. Name -> LuaE e ()
pushName Name
x
          forall e. LuaError e => StackIndex -> LuaE e Type
rawget (CInt -> StackIndex
nth CInt
2) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e. StackIndex -> LuaE e ()
remove (CInt -> StackIndex
nth CInt
2) -- remove global table

    forall {e}. LuaError e => Name -> LuaE e Type
rawgetglobal Name
"Writer" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Type
TypeNil -> do
        forall e. Int -> LuaE e ()
pop Int
1  -- remove nil
        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.
        forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push Pandoc
doc
        forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push WriterOptions
opts
        forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
callTrace NumArgs
2 NumResults
1
        forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall a b. (a -> b) -> a -> b
$ forall e. Peeker e Text
peekText StackIndex
top