{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE IncoherentInstances  #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{- |
Module      : Text.Pandoc.Lua.Filter
Copyright   : © 2012-2023 John MacFarlane,
              © 2017-2023 Albert Krewinkel
License     : GNU GPL, version 2 or above
Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
Stability   : alpha

Types and functions for running Lua filters.
-}
module Text.Pandoc.Lua.Filter
  ( applyFilter
  ) where
import Control.Monad ((>=>), (<$!>))
import HsLua as Lua
import Text.Pandoc.Definition
import Text.Pandoc.Filter (Environment (..))
import Text.Pandoc.Lua.Marshal.AST
import Text.Pandoc.Lua.Marshal.Filter
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
import Text.Pandoc.Lua.Init (runLua)
import Text.Pandoc.Lua.PandocLua ()
import Control.Exception (throw)
import qualified Data.Text as T
import Text.Pandoc.Class (PandocMonad)
import Control.Monad.Trans (MonadIO)
import Text.Pandoc.Error (PandocError (PandocFilterError, PandocLuaError))

-- | Transform document using the filter defined in the given file.
runFilterFile :: FilePath -> Pandoc -> LuaE PandocError Pandoc
runFilterFile :: FilePath -> Pandoc -> LuaE PandocError Pandoc
runFilterFile FilePath
filterPath Pandoc
doc = do
  StackIndex
oldtop <- forall e. LuaE e StackIndex
gettop
  Status
stat <- forall e. Maybe FilePath -> LuaE e Status
dofileTrace (forall a. a -> Maybe a
Just FilePath
filterPath)
  if Status
stat forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK
    then forall e a. LuaError e => LuaE e a
throwErrorAsException
    else do
      StackIndex
newtop <- forall e. LuaE e StackIndex
gettop
      -- Use the returned filters, or the implicitly defined global
      -- filter if nothing was returned.
      [Filter]
luaFilters <- forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall a b. (a -> b) -> a -> b
$
        if StackIndex
newtop forall a. Num a => a -> a -> a
- StackIndex
oldtop forall a. Ord a => a -> a -> Bool
>= StackIndex
1
        then forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e Filter
peekFilter StackIndex
top
        else (forall a. a -> [a] -> [a]
:[]) forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (forall e a. LuaE e a -> Peek e a
liftLua forall e. LuaE e ()
pushglobaltable forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. LuaError e => Peeker e Filter
peekFilter StackIndex
top)
      forall e. StackIndex -> LuaE e ()
settop StackIndex
oldtop
      [Filter] -> Pandoc -> LuaE PandocError Pandoc
runAll [Filter]
luaFilters Pandoc
doc

runAll :: [Filter] -> Pandoc -> LuaE PandocError Pandoc
runAll :: [Filter] -> Pandoc -> LuaE PandocError Pandoc
runAll = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
(>=>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Filter -> Pandoc -> LuaE e Pandoc
applyFully) forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Run the Lua filter in @filterPath@ for a transformation to the
-- target format (first element in args). Pandoc uses Lua init files to
-- setup the Lua interpreter.
applyFilter :: (PandocMonad m, MonadIO m)
            => Environment
            -> [String]
            -> FilePath
            -> Pandoc
            -> m Pandoc
applyFilter :: forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
Environment -> [FilePath] -> FilePath -> Pandoc -> m Pandoc
applyFilter Environment
fenv [FilePath]
args FilePath
fp Pandoc
doc = do
  let globals :: [Global]
globals = [ Text -> Global
FORMAT forall a b. (a -> b) -> a -> b
$ case [FilePath]
args of
                    FilePath
x:[FilePath]
_ -> FilePath -> Text
T.pack FilePath
x
                    [FilePath]
_   -> Text
""
                , ReaderOptions -> Global
PANDOC_READER_OPTIONS (Environment -> ReaderOptions
envReaderOptions Environment
fenv)
                , WriterOptions -> Global
PANDOC_WRITER_OPTIONS (Environment -> WriterOptions
envWriterOptions Environment
fenv)
                , FilePath -> Global
PANDOC_SCRIPT_FILE FilePath
fp
                ]
  forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
LuaE PandocError a -> m (Either PandocError a)
runLua forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> Either PandocError Pandoc -> m Pandoc
forceResult FilePath
fp forall a b. (a -> b) -> a -> b
$ do
    [Global] -> LuaE PandocError ()
setGlobals [Global]
globals
    FilePath -> Pandoc -> LuaE PandocError Pandoc
runFilterFile FilePath
fp Pandoc
doc

forceResult :: (PandocMonad m, MonadIO m)
            => FilePath -> Either PandocError Pandoc -> m Pandoc
forceResult :: forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> Either PandocError Pandoc -> m Pandoc
forceResult FilePath
fp Either PandocError Pandoc
eitherResult = case Either PandocError Pandoc
eitherResult of
  Right Pandoc
x  -> forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
x
  Left PandocError
err -> forall a e. Exception e => e -> a
throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> PandocError
PandocFilterError (FilePath -> Text
T.pack FilePath
fp) forall a b. (a -> b) -> a -> b
$ case PandocError
err of
    PandocLuaError Text
msg -> Text
msg
    PandocError
_                  -> FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show PandocError
err