{- |
   Module      : Text.Pandoc.Filter.Lua
   Copyright   : Copyright (C) 2006-2020 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley@edu>
   Stability   : alpha
   Portability : portable

Apply Lua filters to modify a pandoc documents programmatically.
-}
module Text.Pandoc.Filter.Lua (apply) where

import Control.Exception (throw)
import Control.Monad ((>=>))
import qualified Data.Text as T
import Text.Pandoc.Class.PandocIO (PandocIO)
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Error (PandocError (PandocFilterError, PandocLuaError))
import Text.Pandoc.Lua (Global (..), runLua, runFilterFile, setGlobals)
import Text.Pandoc.Options (ReaderOptions)

-- | 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.
apply :: ReaderOptions
      -> [String]
      -> FilePath
      -> Pandoc
      -> PandocIO Pandoc
apply :: ReaderOptions -> [String] -> String -> Pandoc -> PandocIO Pandoc
apply ReaderOptions
ropts [String]
args String
fp Pandoc
doc = do
  let format :: String
format = case [String]
args of
                 (String
x:[String]
_) -> String
x
                 [String]
_     -> String -> String
forall a. HasCallStack => String -> a
error String
"Format not supplied for Lua filter"
  Lua Pandoc -> PandocIO (Either PandocError Pandoc)
forall a. Lua a -> PandocIO (Either PandocError a)
runLua (Lua Pandoc -> PandocIO (Either PandocError Pandoc))
-> (Either PandocError Pandoc -> PandocIO Pandoc)
-> Lua Pandoc
-> PandocIO Pandoc
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> Either PandocError Pandoc -> PandocIO Pandoc
forceResult String
fp (Lua Pandoc -> PandocIO Pandoc) -> Lua Pandoc -> PandocIO Pandoc
forall a b. (a -> b) -> a -> b
$ do
    [Global] -> Lua ()
setGlobals [ Text -> Global
FORMAT (Text -> Global) -> Text -> Global
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
format
               , ReaderOptions -> Global
PANDOC_READER_OPTIONS ReaderOptions
ropts
               , String -> Global
PANDOC_SCRIPT_FILE String
fp
               ]
    String -> Pandoc -> Lua Pandoc
runFilterFile String
fp Pandoc
doc

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