{-# 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.Monoid ((<>))
import qualified Data.Text as T
import qualified Data.Text.IO as T
import System.Directory (createDirectoryIfMissing,
doesFileExist)
import System.Exit (ExitCode (..))
import System.FilePath (FilePath, addExtension,
normalise, replaceExtension,
takeDirectory, (</>))
import System.IO.Temp (getCanonicalTemporaryDirectory)
import System.Process.Typed (runProcess, shell, setStdout, nullStream)
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.Types
data ScriptResult
= ScriptSuccess
| ScriptChecksFailed String
| ScriptFailure String Int
| ToolkitNotInstalled Toolkit
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
case result of
ScriptSuccess -> liftIO $ T.writeFile (sourceCodePath spec) (script spec) >> return ScriptSuccess
other -> return other
runTempScript :: FigureSpec -> PlotM ScriptResult
runTempScript spec@FigureSpec{..} = do
tk <- asks toolkit
conf <- asks config
let checks = scriptChecks tk
checkResult = mconcat $ checks <*> [script]
case checkResult of
CheckFailed msg -> return $ ScriptChecksFailed msg
CheckPassed -> do
scriptPath <- tempScriptPath spec
let captureFragment = (capture tk) spec (figurePath spec)
scriptWithCapture = if (tk == GNUPlot)
then mconcat [captureFragment, "\n", script]
else mconcat [script, "\n", captureFragment]
liftIO $ T.writeFile scriptPath scriptWithCapture
let command_ = T.unpack $ command tk conf spec scriptPath
ec <- liftIO
$ runProcess
$ setStdout nullStream
$ shell command_
case ec of
ExitSuccess -> return ScriptSuccess
ExitFailure code -> do
toolkitInstalled <- liftIO $ toolkitAvailable tk conf
if toolkitInstalled
then return $ ScriptFailure command_ code
else return $ ToolkitNotInstalled tk
toImage :: Format
-> FigureSpec
-> Block
toImage fmt spec = head . toList $ para $ imageWith attrs' (T.pack target') "fig:" caption'
where
attrs' = blockAttrs spec
target' = figurePath spec
withSource' = withSource spec
srcLink = link (T.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
tk <- asks toolkit
let ext = scriptExtension tk
hashedPath = "pandocplot" <> (show . abs . hash $ script) <> ext
liftIO $ (</> hashedPath) <$> getCanonicalTemporaryDirectory
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 . hash
ext = extension . saveFormat $ spec