{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Text.Pandoc.Filter.Plot.Scripting
( ScriptResult(..)
, runTempScript
, runScriptIfNecessary
, figurePath
) where
import Control.Exception.Lifted (bracket)
import Control.Monad.Reader
import Data.Hashable (hash)
import Data.Text (Text, pack, unpack)
import qualified Data.Text.IO as T
import Paths_pandoc_plot (version)
import System.Directory (createDirectoryIfMissing,
doesFileExist, getTemporaryDirectory)
import System.Environment (getEnv, setEnv)
import System.Exit (ExitCode (..))
import System.FilePath (addExtension,
normalise, replaceExtension,
takeDirectory, (</>))
import Text.Pandoc.Filter.Plot.Renderers
import Text.Pandoc.Filter.Plot.Monad
runScriptIfNecessary :: FigureSpec -> PlotM ScriptResult
runScriptIfNecessary spec = do
target <- figurePath spec
liftIO $ createDirectoryIfMissing True . takeDirectory $ target
fileAlreadyExists <- liftIO . doesFileExist $ target
result <- if fileAlreadyExists
then return ScriptSuccess
else runTempScript spec
logScriptResult result
case result of
ScriptSuccess -> do
scp <- sourceCodePath spec
liftIO $ T.writeFile scp (script spec) >> return ScriptSuccess
other -> return other
where
logScriptResult ScriptSuccess = return ()
logScriptResult r = err . pack . show $ r
data ScriptResult
= ScriptSuccess
| ScriptChecksFailed Text
| ScriptFailure Text Int
| ToolkitNotInstalled Toolkit
instance Show ScriptResult where
show ScriptSuccess = "Script success."
show (ScriptChecksFailed msg) = unpack $ "Script checks failed: " <> msg
show (ScriptFailure msg ec) = mconcat ["Script failed with exit code ", show ec, " and the following message: ", unpack msg]
show (ToolkitNotInstalled tk) = (show tk) <> " toolkit not installed."
runTempScript :: FigureSpec -> PlotM ScriptResult
runTempScript spec@FigureSpec{..} = do
let checks = scriptChecks toolkit
checkResult = mconcat $ checks <*> [script]
case checkResult of
CheckFailed msg -> return $ ScriptChecksFailed msg
CheckPassed -> do
scriptPath <- tempScriptPath spec
target <- figurePath spec
exe <- executable toolkit
case exe of
Nothing -> error $ "Toolkit " <> show toolkit <> " is not installed."
Just (Executable exedir exename) ->
withPrependedPath exedir $ do
let scriptWithCapture = (capture toolkit) spec target
liftIO $ T.writeFile scriptPath scriptWithCapture
let outputSpec = OutputSpec { oFigureSpec = spec
, oScriptPath = scriptPath
, oFigurePath = target
}
let command_ = command toolkit outputSpec exename
cwd <- asks envCWD
(ec, _) <- runCommand cwd command_
case ec of
ExitSuccess -> return ScriptSuccess
ExitFailure code -> do
toolkitInstalled <- toolkitAvailable toolkit
if toolkitInstalled
then return $ ScriptFailure command_ code
else return $ ToolkitNotInstalled toolkit
tempScriptPath :: FigureSpec -> PlotM FilePath
tempScriptPath FigureSpec{..} = do
let ext = scriptExtension toolkit
let hashedPath = "pandocplot" <> (show . abs . hash $ script) <> ext
liftIO $ (</> hashedPath) <$> getTemporaryDirectory
sourceCodePath :: FigureSpec -> PlotM FilePath
sourceCodePath = fmap normalise . fmap (flip replaceExtension ".txt") . figurePath
figureContentHash :: FigureSpec -> PlotM Word
figureContentHash FigureSpec{..} = do
dependenciesHash <- sequence $ fileHash <$> dependencies
return $ fromIntegral
$ hash ( (fromEnum toolkit
, script
, fromEnum saveFormat
, directory)
, ( dpi
, dependenciesHash
, extraAttrs
, show version
)
)
figurePath :: FigureSpec -> PlotM FilePath
figurePath spec = do
fh <- figureContentHash spec
let ext = extension . saveFormat $ spec
stem = flip addExtension ext . show $ fh
return $ normalise $ directory spec </> stem
withPrependedPath :: FilePath -> PlotM a -> PlotM a
withPrependedPath dir f = do
pathVar <- liftIO $ getEnv "PATH"
let pathVarPrepended = mconcat [dir, ";", pathVar]
bracket
( liftIO $ setEnv "PATH" pathVarPrepended)
(\_ -> liftIO $ setEnv "PATH" pathVar)
(\_ -> f)