{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Text.Pandoc.Filter.Plot.Scripting
( ScriptResult(..)
, runTempScript
, runScriptIfNecessary
, figurePath
) where
import Control.Monad.Reader
import Data.Hashable (hash)
import Data.Text (Text, pack, unpack)
import qualified Data.Text.IO as T
import System.Directory (createDirectoryIfMissing,
doesFileExist, getTemporaryDirectory)
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
liftIO $ createDirectoryIfMissing True . takeDirectory $ figurePath spec
fileAlreadyExists <- liftIO . doesFileExist $ figurePath spec
result <- if fileAlreadyExists
then return ScriptSuccess
else runTempScript spec
logScriptResult result
case result of
ScriptSuccess -> liftIO $ T.writeFile (sourceCodePath spec) (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
let captureFragment = (capture toolkit) spec (figurePath spec)
scriptWithCapture = if (toolkit == GNUPlot)
then mconcat [captureFragment, "\n", script]
else mconcat [script, "\n", captureFragment]
liftIO $ T.writeFile scriptPath scriptWithCapture
let outputSpec = OutputSpec { oFigureSpec = spec
, oScriptPath = scriptPath
, oFigurePath = figurePath spec
}
command_ <- command toolkit outputSpec
(ec, _) <- runCommand 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 -> FilePath
sourceCodePath = normalise . flip replaceExtension ".txt" . figurePath
figurePath :: FigureSpec -> FilePath
figurePath spec = normalise $ directory spec </> stem spec
where
stem = flip addExtension ext . show . figureContentHash
ext = extension . saveFormat $ spec