{-# LANGUAGE OverloadedStrings #-}
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
"python", 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