{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Filter
   Copyright   : Copyright (C) 2006-2023 John MacFarlane
   License     : GNU GPL, version 2 or above

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

Programmatically modifications of pandoc documents via JSON filters.
-}
module Text.Pandoc.Filter.JSON (apply) where

import Control.Monad (unless, when)
import Control.Monad.Trans (MonadIO (liftIO))
import Data.Aeson (eitherDecode', encode)
import Data.Char (toLower)
import Data.Maybe (isNothing)
import qualified Data.Text as T
import System.Directory (executable, doesFileExist, findExecutable,
                         getPermissions)
import System.Environment (getEnvironment)
import System.Exit (ExitCode (..))
import System.FilePath ((</>), takeExtension)
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Error (PandocError (PandocFilterError))
import Text.Pandoc.Filter.Environment (Environment (..))
import Text.Pandoc.Process (pipeProcess)
import Text.Pandoc.Version (pandocVersionText)
import Text.Pandoc.Shared (tshow)
import qualified Control.Exception as E
import qualified Text.Pandoc.UTF8 as UTF8

apply :: MonadIO m
      => Environment
      -> [String]
      -> FilePath
      -> Pandoc
      -> m Pandoc
apply :: forall (m :: * -> *).
MonadIO m =>
Environment -> [String] -> String -> Pandoc -> m Pandoc
apply Environment
ropts [String]
args String
f = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadIO m =>
Environment -> String -> [String] -> Pandoc -> m Pandoc
externalFilter Environment
ropts String
f [String]
args

externalFilter :: MonadIO m
               => Environment -> FilePath -> [String] -> Pandoc -> m Pandoc
externalFilter :: forall (m :: * -> *).
MonadIO m =>
Environment -> String -> [String] -> Pandoc -> m Pandoc
externalFilter Environment
fenv String
f [String]
args' Pandoc
d = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  Bool
exists <- String -> IO Bool
doesFileExist String
f
  Bool
isExecutable <- if Bool
exists
                     then Permissions -> Bool
executable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Permissions
getPermissions String
f
                     else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  let (String
f', [String]
args'') = if Bool
exists
                        then case forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String
takeExtension String
f) of
                                  String
_      | Bool
isExecutable -> (String
"." String -> String -> String
</> String
f, [String]
args')
                                  String
".py"  -> (String
"python", String
fforall a. a -> [a] -> [a]
:[String]
args')
                                  String
".hs"  -> (String
"runhaskell", String
fforall a. a -> [a] -> [a]
:[String]
args')
                                  String
".pl"  -> (String
"perl", String
fforall a. a -> [a] -> [a]
:[String]
args')
                                  String
".rb"  -> (String
"ruby", String
fforall a. a -> [a] -> [a]
:[String]
args')
                                  String
".php" -> (String
"php", String
fforall a. a -> [a] -> [a]
:[String]
args')
                                  String
".js"  -> (String
"node", String
fforall a. a -> [a] -> [a]
:[String]
args')
                                  String
".r"   -> (String
"Rscript", String
fforall a. a -> [a] -> [a]
:[String]
args')
                                  String
_      -> (String
f, [String]
args')
                        else (String
f, [String]
args')
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
exists Bool -> Bool -> Bool
&& Bool
isExecutable) forall a b. (a -> b) -> a -> b
$ do
    Maybe String
mbExe <- String -> IO (Maybe String)
findExecutable String
f'
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe String
mbExe) forall a b. (a -> b) -> a -> b
$
      forall e a. Exception e => e -> IO a
E.throwIO forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocFilterError Text
fText (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"Could not find executable " forall a. Semigroup a => a -> a -> a
<> String
f')
  let ropts :: ReaderOptions
ropts = Environment -> ReaderOptions
envReaderOptions Environment
fenv
  [(String, String)]
env <- IO [(String, String)]
getEnvironment
  let env' :: Maybe [(String, String)]
env' = forall a. a -> Maybe a
Just
           ( (String
"PANDOC_VERSION", Text -> String
T.unpack Text
pandocVersionText)
           forall a. a -> [a] -> [a]
: (String
"PANDOC_READER_OPTIONS", ByteString -> String
UTF8.toStringLazy (forall a. ToJSON a => a -> ByteString
encode ReaderOptions
ropts))
           forall a. a -> [a] -> [a]
: [(String, String)]
env )
  (ExitCode
exitcode, ByteString
outbs) <- forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle forall a. SomeException -> IO a
filterException forall a b. (a -> b) -> a -> b
$
                              Maybe [(String, String)]
-> String -> [String] -> ByteString -> IO (ExitCode, ByteString)
pipeProcess Maybe [(String, String)]
env' String
f' [String]
args'' forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode Pandoc
d
  case ExitCode
exitcode of
       ExitCode
ExitSuccess    -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e a. Exception e => e -> IO a
E.throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> PandocError
PandocFilterError Text
fText forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
                                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either String a
eitherDecode' ByteString
outbs
       ExitFailure Int
ec -> forall e a. Exception e => e -> IO a
E.throwIO forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocFilterError Text
fText
                           (Text
"Filter returned error status " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
ec)
 where fText :: Text
fText = String -> Text
T.pack String
f

       filterException :: E.SomeException -> IO a
       filterException :: forall a. SomeException -> IO a
filterException SomeException
e = forall e a. Exception e => e -> IO a
E.throwIO forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocFilterError Text
fText forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
tshow SomeException
e