{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE IncoherentInstances  #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{- |
Module      : Text.Pandoc.Lua.Filter
Copyright   : © 2012-2022 John MacFarlane,
              © 2017-2022 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
  ( runFilterFile
  ) where
import Control.Monad ((>=>), (<$!>))
import HsLua as Lua
import Text.Pandoc.Definition
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.ErrorConversion ()
import Text.Pandoc.Lua.Marshal.AST
import Text.Pandoc.Lua.Marshal.Filter


-- | 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 <- LuaE PandocError StackIndex
forall e. LuaE e StackIndex
gettop
  Status
stat <- FilePath -> LuaE PandocError Status
forall e. FilePath -> LuaE e Status
dofileTrace FilePath
filterPath
  if Status
stat Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK
    then LuaE PandocError Pandoc
forall e a. LuaError e => LuaE e a
throwErrorAsException
    else do
      StackIndex
newtop <- LuaE PandocError StackIndex
forall e. LuaE e StackIndex
gettop
      -- Use the returned filters, or the implicitly defined global
      -- filter if nothing was returned.
      [Filter]
luaFilters <- Peek PandocError [Filter] -> LuaE PandocError [Filter]
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek PandocError [Filter] -> LuaE PandocError [Filter])
-> Peek PandocError [Filter] -> LuaE PandocError [Filter]
forall a b. (a -> b) -> a -> b
$
        if StackIndex
newtop StackIndex -> StackIndex -> StackIndex
forall a. Num a => a -> a -> a
- StackIndex
oldtop StackIndex -> StackIndex -> Bool
forall a. Ord a => a -> a -> Bool
>= StackIndex
1
        then Peeker PandocError Filter -> Peeker PandocError [Filter]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker PandocError Filter
forall e. LuaError e => Peeker e Filter
peekFilter StackIndex
top
        else (Filter -> [Filter] -> [Filter]
forall a. a -> [a] -> [a]
:[]) (Filter -> [Filter])
-> Peek PandocError Filter -> Peek PandocError [Filter]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (LuaE PandocError () -> Peek PandocError ()
forall e a. LuaE e a -> Peek e a
liftLua LuaE PandocError ()
forall e. LuaE e ()
pushglobaltable Peek PandocError ()
-> Peek PandocError Filter -> Peek PandocError Filter
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker PandocError Filter
forall e. LuaError e => Peeker e Filter
peekFilter StackIndex
top)
      StackIndex -> LuaE PandocError ()
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 = (Filter
 -> (Pandoc -> LuaE PandocError Pandoc)
 -> Pandoc
 -> LuaE PandocError Pandoc)
-> (Pandoc -> LuaE PandocError Pandoc)
-> [Filter]
-> Pandoc
-> LuaE PandocError Pandoc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Pandoc -> LuaE PandocError Pandoc)
-> (Pandoc -> LuaE PandocError Pandoc)
-> Pandoc
-> LuaE PandocError Pandoc
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
(>=>) ((Pandoc -> LuaE PandocError Pandoc)
 -> (Pandoc -> LuaE PandocError Pandoc)
 -> Pandoc
 -> LuaE PandocError Pandoc)
-> (Filter -> Pandoc -> LuaE PandocError Pandoc)
-> Filter
-> (Pandoc -> LuaE PandocError Pandoc)
-> Pandoc
-> LuaE PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Filter -> Pandoc -> LuaE PandocError Pandoc
forall e. LuaError e => Filter -> Pandoc -> LuaE e Pandoc
applyFully) Pandoc -> LuaE PandocError Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return