    {-# LANGUAGE OverloadedStrings #-}
    {- |
       Module      : Text.Pandoc.Filter
       Copyright   : Copyright (C) 2006-2020 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.Class.PandocIO (PandocIO)
    import Text.Pandoc.Error (PandocError (PandocFilterError))
    import Text.Pandoc.Definition (Pandoc)
    import Text.Pandoc.Options (ReaderOptions)
    import Text.Pandoc.Process (pipeProcess)
    import Text.Pandoc.Shared (pandocVersion, tshow)
    import qualified Control.Exception as E
    import qualified Text.Pandoc.UTF8 as UTF8

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

    externalFilter :: MonadIO m
                   => ReaderOptions -> FilePath -> [String] -> Pandoc -> m Pandoc
    externalFilter :: ReaderOptions -> String -> [String] -> Pandoc -> m Pandoc
    externalFilter ropts :: ReaderOptions
    ropts f :: String
    f args' :: [String]
    args' d :: Pandoc
    d = IO Pandoc -> m Pandoc
    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
      Bool
    exists <- String -> IO Bool
    doesFileExist String
    f
      Bool
    isExecutable <- if Bool
    exists
                         then Permissions -> Bool
    executable (Permissions -> Bool) -> IO Permissions -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO Permissions
    getPermissions String
    f
                         else Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      let (f' :: String
    f', args'' :: [String]
    args'') = if Bool
    exists
                            then case (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (String -> String
    takeExtension String
    f) of
                                      _      | Bool
    isExecutable -> ("." String -> String -> String
    </> String
    f, [String]
    args')
                                      ".py"  -> ("python", String
    fString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    args')
                                      ".hs"  -> ("runhaskell", String
    fString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    args')
                                      ".pl"  -> ("perl", String
    fString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    args')
                                      ".rb"  -> ("ruby", String
    fString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    args')
                                      ".php" -> ("php", String
    fString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    args')
                                      ".js"  -> ("node", String
    fString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    args')
                                      ".r"   -> ("Rscript", String
    fString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    args')
                                      _      -> (String
    f, [String]
    args')
                            else (String
    f, [String]
    args')
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Bool
    exists Bool -> Bool -> Bool
    && Bool
    isExecutable) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        Maybe String
    mbExe <- String -> IO (Maybe String)
    findExecutable String
    f'
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe String -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe String
    mbExe) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          PandocError -> IO ()
    forall e a. Exception e => e -> IO a
    E.throwIO (PandocError -> IO ()) -> PandocError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> PandocError
    PandocFilterError Text
    fText (String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ "Could not find executable " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    f')
      [(String, String)]
    env <- IO [(String, String)]
    getEnvironment
      let env' :: Maybe [(String, String)]
    env' = [(String, String)] -> Maybe [(String, String)]
    forall a. a -> Maybe a
    Just
               ( ("PANDOC_VERSION", Text -> String
    T.unpack Text
    pandocVersion)
               (String, String) -> [(String, String)] -> [(String, String)]
    forall a. a -> [a] -> [a]
    : ("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 :: ExitCode
    exitcode, outbs :: ByteString
    outbs) <- (SomeException -> IO (ExitCode, ByteString))
    -> IO (ExitCode, ByteString) -> IO (ExitCode, ByteString)
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    E.handle SomeException -> IO (ExitCode, ByteString)
    forall a. SomeException -> IO a
    filterException (IO (ExitCode, ByteString) -> IO (ExitCode, ByteString))
    -> IO (ExitCode, ByteString) -> IO (ExitCode, ByteString)
    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'' (ByteString -> IO (ExitCode, ByteString))
    -> ByteString -> IO (ExitCode, ByteString)
    forall a b. (a -> b) -> a -> b
    $ Pandoc -> ByteString
    forall a. ToJSON a => a -> ByteString
    encode Pandoc
    d
      case ExitCode
    exitcode of
           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. 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 (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 ec :: Int
    ec -> PandocError -> IO Pandoc
    forall e a. 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
                               ("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 :: SomeException -> IO a
    filterException e :: SomeException
    e = PandocError -> IO a
    forall e a. 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