{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Text.Pandoc.Filter.Plot.Scripting
( ScriptResult(..)
, runTempScript
, runScriptIfNecessary
, toImage
) where
import Control.Monad.Reader
import Data.Hashable (hash)
import Data.Maybe (fromMaybe)
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.Builder (fromList, imageWith, link,
para, toList)
import Text.Pandoc.Definition (Block (..), Format)
import Text.Pandoc.Filter.Plot.Parse (captionReader)
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
toImage :: Format
-> FigureSpec
-> Block
toImage fmt spec = head . toList $ para $ imageWith attrs' (pack target') "fig:" caption'
where
attrs' = blockAttrs spec
target' = figurePath spec
withSource' = withSource spec
srcLink = link (pack $ replaceExtension target' ".txt") mempty "Source code"
captionText = fromList $ fromMaybe mempty (captionReader fmt $ caption spec)
captionLinks = mconcat [" (", srcLink, ")"]
caption' = if withSource' then captionText <> captionLinks else captionText
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