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