diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 96211dd3..cdf3f977 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -176,6 +176,17 @@ jobs: exit 1 fi pandoc-plot clean tests/issue30.md + + # The idea here is to install some random package (npstreams) to + # check whether the plots will be rendered in the appropriate + # environment + python -m venv ./issue46 + ./issue46/bin/python -m pip install npstreams matplotlib + pandoc --filter pandoc-plot -i tests/issue46.md -t native + if [ $(ls "plots" | wc -l) != 2 ]; then + exit 1 + fi + pandoc-plot clean tests/issue46.md - name: Build documentation run: source tools/mkmanual.sh diff --git a/CHANGELOG.md b/CHANGELOG.md index b46af06a..987f6080 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ pandoc-plot uses [Semantic Versioning](http://semver.org/spec/v2.0.0.html) +## Release 1.5.2 + +* Overhauled the way executables are handled. This fixes an issue where executables specified in documents (rather than configuration) were ignored (#46). + ## Release 1.5.1 * Figures with no captions (and no link to the source script), will now be shown as an image, without figure numbering (#37). diff --git a/cabal.project b/cabal.project index c9099b3b..74d3c9ca 100644 --- a/cabal.project +++ b/cabal.project @@ -1,2 +1 @@ -packages: pandoc-plot.cabal -allow-newer: all \ No newline at end of file +packages: pandoc-plot.cabal \ No newline at end of file diff --git a/executable/Main.hs b/executable/Main.hs index db6f5cbc..14358d7b 100644 --- a/executable/Main.hs +++ b/executable/Main.hs @@ -9,7 +9,6 @@ module Main where import Control.Monad (join, msum, void, when) import Data.List (intersperse, (\\)) -import Data.Maybe (fromJust) import Data.Text (unpack) import qualified Data.Text.IO as TIO import Data.Version (parseVersion, showVersion) @@ -58,15 +57,15 @@ import Text.Pandoc.Filter.Plot plotFilter, ) import Text.Pandoc.Filter.Plot.Internal - ( Executable (..), - cleanOutputDirs, + ( cleanOutputDirs, cls, configurationPathMeta, executable, readDoc, runPlotM, supportedSaveFormats, - toolkits, + toolkits, + pathToExe ) import Text.Pandoc.JSON (toJSONFilter) import Text.ParserCombinators.ReadP (readP_to_S) @@ -286,8 +285,8 @@ showAvailableToolkits mfp = do toolkitInfo avail conf tk = do putStrLn $ "Toolkit: " <> show tk when avail $ do - Executable dir exe <- fmap fromJust $ runPlotM Nothing conf $ executable tk - putStrLn $ " Executable: " <> (dir unpack exe) + exe <- runPlotM Nothing conf $ executable tk + putStrLn $ " Executable: " <> (pathToExe exe) putStrLn $ " Code block trigger: " <> (unpack . cls $ tk) putStrLn $ " Supported save formats: " <> (mconcat . intersperse ", " . fmap show $ supportedSaveFormats tk) putStrLn mempty diff --git a/pandoc-plot.cabal b/pandoc-plot.cabal index 28b7959d..a9ce0054 100644 --- a/pandoc-plot.cabal +++ b/pandoc-plot.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: pandoc-plot -version: 1.5.1 +version: 1.5.2 synopsis: A Pandoc filter to include figures generated from code blocks using your plotting toolkit of choice. description: A Pandoc filter to include figures generated from code blocks. Keep the document and code in the same location. Output is @@ -14,7 +14,11 @@ maintainer: Laurent P. René de Cotret license: GPL-2.0-or-later license-file: LICENSE build-type: Simple -tested-with: GHC == 8.10.4, GHC == 9.0.1 +tested-with: GHC == 8.10.4, + GHC == 9.0.1, + GHC == 9.0.1, + GHC == 9.2.1, + GHC == 9.2.2 extra-source-files: CHANGELOG.md LICENSE @@ -94,7 +98,7 @@ library , directory >= 1.2.7 && < 2 , filepath >= 1.4 && < 2 , hashable >= 1 && < 2 - , pandoc >= 2.10 && < 3 + , pandoc >= 2.11 && < 3 , pandoc-types >= 1.22 && < 1.23 , lifted-async >= 0.10 && < 1 , lifted-base >= 0.2 && < 1 @@ -144,7 +148,6 @@ test-suite tests , containers , directory , filepath - , hspec , hspec-expectations , pandoc-types >= 1.20 && <= 2 , pandoc-plot diff --git a/src/Text/Pandoc/Filter/Plot/Monad.hs b/src/Text/Pandoc/Filter/Plot/Monad.hs index 03360898..1c56debe 100644 --- a/src/Text/Pandoc/Filter/Plot/Monad.hs +++ b/src/Text/Pandoc/Filter/Plot/Monad.hs @@ -74,7 +74,6 @@ import Control.Monad.State.Strict evalStateT, ) import Data.ByteString.Lazy (toStrict) -import Data.Functor ((<&>)) import Data.Hashable (hash) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M @@ -84,7 +83,6 @@ import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import System.Directory ( doesFileExist, - findExecutable, getCurrentDirectory, getModificationTime, ) @@ -141,7 +139,6 @@ runPlotM fmt conf v = do cwd <- getCurrentDirectory st <- PlotState <$> newMVar mempty - <*> newMVar mempty let verbosity = logVerbosity conf sink = logSink conf withLogger verbosity sink $ @@ -224,27 +221,23 @@ throwStrictError msg = do logger <- askLogger liftIO $ terminateLogging logger >> exitFailure --- Plot state is used for caching. --- One part consists of a map of filepaths to hashes +-- Plot state is used for caching a map of filepaths to hashes -- This allows multiple plots to depend on the same file/directory, and the file hashes -- will only be calculated once. This is OK because pandoc-plot will not run for long. -- We note that because figures are rendered possibly in parallel, access to -- the state must be synchronized; otherwise, each thread might compute its own -- hashes. --- The other part is comprised of a map of toolkits to renderers (possibly missing) --- This means that checking if renderers are available will only be done once. type FileHash = Word data PlotState = PlotState (MVar (Map FilePath FileHash)) - (MVar (Map Toolkit (Maybe Renderer))) -- | Get a filehash. If the file hash has been computed before, -- it is reused. Otherwise, the filehash is calculated and stored. fileHash :: FilePath -> PlotM FileHash fileHash path = do - PlotState varHashes varExes <- get + PlotState varHashes <- get hashes <- liftIO $ takeMVar varHashes (fh, hashes') <- case M.lookup path hashes of Nothing -> do @@ -256,7 +249,7 @@ fileHash path = do debug $ mconcat ["Hash of dependency ", pack path, " already calculated."] return (h, hashes) liftIO $ putMVar varHashes hashes' - put $ PlotState varHashes varExes + put $ PlotState varHashes return fh where -- As a proxy for the state of a file dependency, we use the modification time @@ -269,12 +262,8 @@ fileHash path = do else err (mconcat ["Dependency ", pack fp, " does not exist."]) >> return 0 -- | Find an executable. -executable :: Toolkit -> PlotM (Maybe Executable) -executable tk = - exeSelector tk - >>= \name -> - liftIO $ - findExecutable name <&> fmap exeFromPath +executable :: Toolkit -> PlotM Executable +executable tk = exeSelector tk >>= return . exeFromPath where exeSelector Matplotlib = asksConfig matplotlibExe exeSelector PlotlyPython = asksConfig plotlyPythonExe diff --git a/src/Text/Pandoc/Filter/Plot/Monad/Types.hs b/src/Text/Pandoc/Filter/Plot/Monad/Types.hs index 86ea7474..ad01c80c 100644 --- a/src/Text/Pandoc/Filter/Plot/Monad/Types.hs +++ b/src/Text/Pandoc/Filter/Plot/Monad/Types.hs @@ -14,6 +14,7 @@ module Text.Pandoc.Filter.Plot.Monad.Types ( Toolkit (..), Renderer (..), + AvailabilityCheck(..), Script, CheckResult (..), InclusionKey (..), @@ -26,6 +27,7 @@ module Text.Pandoc.Filter.Plot.Monad.Types inclusionKeys, Executable (..), exeFromPath, + pathToExe, -- Utilities isWindows, ) @@ -37,7 +39,7 @@ import Data.String (IsString (..)) import Data.Text (Text, pack, unpack) import Data.Yaml (FromJSON(..), ToJSON (toJSON), withText) import GHC.Generics (Generic) -import System.FilePath (splitFileName) +import System.FilePath (splitFileName, (), isAbsolute) import System.Info (os) import Text.Pandoc.Definition (Attr) @@ -94,13 +96,20 @@ cls Plotsjl = "plotsjl" cls PlantUML = "plantuml" cls SageMath = "sageplot" --- | Executable program and directory where it can be found. -data Executable = Executable FilePath Text +-- | Executable program, and sometimes the directory where it can be found. +data Executable + = AbsExe FilePath Text + | RelExe Text exeFromPath :: FilePath -> Executable -exeFromPath fp = - let (dir, name) = splitFileName fp - in Executable dir (pack name) +exeFromPath fp + | isAbsolute fp = let (dir, name) = splitFileName fp + in AbsExe dir (pack name) + | otherwise = RelExe (pack fp) + +pathToExe :: Executable -> FilePath +pathToExe (AbsExe dir name) = dir unpack name +pathToExe (RelExe name) = unpack name -- | Source context for plotting scripts type Script = Text @@ -170,6 +179,8 @@ inclusionKeys = enumFromTo (minBound :: InclusionKey) maxBound data FigureSpec = FigureSpec { -- | Renderer to use for this figure. renderer_ :: !Renderer, + -- | Executable to use in rendering this figure. + fsExecutable :: Executable, -- | Figure caption. caption :: !Text, -- | Append link to source code in caption. @@ -263,15 +274,21 @@ data OutputSpec = OutputSpec oScriptPath :: FilePath, -- | Figure output path oFigurePath :: FilePath, + -- | Executable to use during rendering + oExecutable :: Executable, -- | Current working directory oCWD :: FilePath } +data AvailabilityCheck + = CommandSuccess (Executable -> Text) + | ExecutableExists + data Renderer = Renderer { rendererToolkit :: Toolkit, - rendererExe :: Executable, rendererCapture :: FigureSpec -> FilePath -> Script, rendererCommand :: OutputSpec -> Text, + rendererAvailability :: AvailabilityCheck, rendererSupportedSaveFormats :: [SaveFormat], rendererChecks :: [Script -> CheckResult], rendererLanguage :: Text, diff --git a/src/Text/Pandoc/Filter/Plot/Parse.hs b/src/Text/Pandoc/Filter/Plot/Parse.hs index d211d136..f08d49ee 100644 --- a/src/Text/Pandoc/Filter/Plot/Parse.hs +++ b/src/Text/Pandoc/Filter/Plot/Parse.hs @@ -70,11 +70,7 @@ parseFigureSpec block@(CodeBlock (id', classes, attrs) _) = do Nothing -> return NotAFigure Just tk -> do r <- renderer tk - case r of - Nothing -> do - err $ mconcat ["Renderer for ", tshow tk, " needed but is not installed"] - return $ MissingToolkit tk - Just r' -> figureSpec r' + figureSpec r where attrs' = Map.fromList attrs preamblePath = unpack <$> Map.lookup (tshow PreambleK) attrs' @@ -108,8 +104,11 @@ parseFigureSpec block@(CodeBlock (id', classes, attrs) _) = do -- Decide between reading from file or using document content content <- parseContent block + + defaultExe <- executable rendererToolkit let caption = Map.findWithDefault mempty (tshow CaptionK) attrs' + fsExecutable = maybe defaultExe (exeFromPath . unpack) $ Map.lookup (tshow ExecutableK) attrs' withSource = maybe defWithSource readBool (Map.lookup (tshow WithSourceK) attrs') script = mconcat $ intersperse "\n" [header, includeScript, content] directory = makeValid $ unpack $ Map.findWithDefault (pack $ defaultDirectory conf) (tshow DirectoryK) attrs' diff --git a/src/Text/Pandoc/Filter/Plot/Renderers.hs b/src/Text/Pandoc/Filter/Plot/Renderers.hs index e1ae2ef6..8824afe3 100644 --- a/src/Text/Pandoc/Filter/Plot/Renderers.hs +++ b/src/Text/Pandoc/Filter/Plot/Renderers.hs @@ -27,16 +27,14 @@ module Text.Pandoc.Filter.Plot.Renderers where import Control.Concurrent.Async.Lifted (forConcurrently) -import Control.Concurrent.MVar (putMVar, takeMVar) import Control.Monad.Reader (local) -import Control.Monad.State.Strict - ( MonadState (get, put), - ) +import Data.Functor ((<&>)) import Data.List ((\\)) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe (catMaybes, isJust) import Data.Text (Text, pack) +import System.Exit (ExitCode (..)) import Text.Pandoc.Filter.Plot.Monad import Text.Pandoc.Filter.Plot.Monad.Logging ( Logger (lVerbosity), @@ -67,41 +65,25 @@ import Text.Pandoc.Filter.Plot.Renderers.Plotsjl ( plotsjl, plotsjlSupportedSaveFormats ) import Text.Pandoc.Filter.Plot.Renderers.SageMath ( sagemath, sagemathSupportedSaveFormats ) +import System.Directory (findExecutable) -- | Get the renderer associated with a toolkit. -- If the renderer has not been used before, -- initialize it and store where it is. It will be re-used. -renderer :: Toolkit -> PlotM (Maybe Renderer) -renderer tk = do - PlotState varHashes varRenderers <- get - renderers <- liftIO $ takeMVar varRenderers - (r', rs') <- case M.lookup tk renderers of - Nothing -> do - debug $ mconcat ["Looking for renderer for ", pack $ show tk] - r' <- sel tk - let rs' = M.insert tk r' renderers - return (r', rs') - Just e -> do - debug $ mconcat ["Renderer for \"", pack $ show tk, "\" already initialized."] - return (e, renderers) - liftIO $ putMVar varRenderers rs' - put $ PlotState varHashes varRenderers - return r' - where - sel :: Toolkit -> PlotM (Maybe Renderer) - sel Matplotlib = matplotlib - sel PlotlyPython = plotlyPython - sel PlotlyR = plotlyR - sel Matlab = matlab - sel Mathematica = mathematica - sel Octave = octave - sel GGPlot2 = ggplot2 - sel GNUPlot = gnuplot - sel Graphviz = graphviz - sel Bokeh = bokeh - sel Plotsjl = plotsjl - sel PlantUML = plantuml - sel SageMath = sagemath +renderer :: Toolkit -> PlotM Renderer +renderer Matplotlib = matplotlib +renderer PlotlyPython = plotlyPython +renderer PlotlyR = plotlyR +renderer Matlab = matlab +renderer Mathematica = mathematica +renderer Octave = octave +renderer GGPlot2 = ggplot2 +renderer GNUPlot = gnuplot +renderer Graphviz = graphviz +renderer Bokeh = bokeh +renderer Plotsjl = plotsjl +renderer PlantUML = plantuml +renderer SageMath = sagemath -- | Save formats supported by this renderer. supportedSaveFormats :: Toolkit -> [SaveFormat] @@ -157,14 +139,29 @@ unavailableToolkits conf = runPlotM Nothing conf unavailableToolkitsM availableToolkitsM :: PlotM [Toolkit] availableToolkitsM = asNonStrictAndSilent $ do mtks <- forConcurrently toolkits $ \tk -> do - available <- isJust <$> renderer tk - if available + r <- renderer tk + exe <- executable tk + a <- isAvailable exe (rendererAvailability r) + if a then return $ Just tk else return Nothing return $ catMaybes mtks where asNonStrictAndSilent = local (\(RuntimeEnv f c l d) -> RuntimeEnv f (c{strictMode = False}) (l{lVerbosity = Silent}) d) + -- | Check that the supplied command results in + -- an exit code of 0 (i.e. no errors) + commandSuccess :: Text -> PlotM Bool + commandSuccess s = do + cwd <- asks envCWD + (ec, _) <- runCommand cwd s + debug $ mconcat ["Command ", s, " resulted in ", pack $ show ec] + return $ ec == ExitSuccess + + isAvailable :: Executable -> AvailabilityCheck -> PlotM Bool + isAvailable exe (CommandSuccess f) = commandSuccess (f exe) + isAvailable exe (ExecutableExists) = liftIO $ findExecutable (pathToExe exe) <&> isJust + -- | Monadic version of @unavailableToolkits@ unavailableToolkitsM :: PlotM [Toolkit] unavailableToolkitsM = (\\) toolkits <$> availableToolkitsM diff --git a/src/Text/Pandoc/Filter/Plot/Renderers/Bokeh.hs b/src/Text/Pandoc/Filter/Plot/Renderers/Bokeh.hs index 48a7b871..7b17d057 100644 --- a/src/Text/Pandoc/Filter/Plot/Renderers/Bokeh.hs +++ b/src/Text/Pandoc/Filter/Plot/Renderers/Bokeh.hs @@ -22,41 +22,27 @@ import Data.Monoid (Any (..)) import qualified Data.Text as T import Text.Pandoc.Filter.Plot.Renderers.Prelude -bokeh :: PlotM (Maybe Renderer) +bokeh :: PlotM Renderer bokeh = do - avail <- bokehAvailable - if not avail - then return Nothing - else do cmdargs <- asksConfig bokehCmdArgs - mexe <- executable Bokeh return $ - mexe >>= \exe@(Executable _ exename) -> - return - Renderer - { rendererToolkit = Bokeh, - rendererExe = exe, - rendererCapture = appendCapture bokehCaptureFragment, - rendererCommand = bokehCommand cmdargs exename, - rendererSupportedSaveFormats = bokehSupportedSaveFormats, - rendererChecks = [bokehCheckIfShow], - rendererLanguage = "python", - rendererComment = mappend "# ", - rendererScriptExtension = ".py" - } + Renderer + { rendererToolkit = Bokeh, + rendererCapture = appendCapture bokehCaptureFragment, + rendererCommand = bokehCommand cmdargs, + rendererAvailability = CommandSuccess $ \exe -> [st|#{pathToExe exe} -c "import bokeh; import selenium"|], + rendererSupportedSaveFormats = bokehSupportedSaveFormats, + rendererChecks = [bokehCheckIfShow], + rendererLanguage = "python", + rendererComment = mappend "# ", + rendererScriptExtension = ".py" + } bokehSupportedSaveFormats :: [SaveFormat] bokehSupportedSaveFormats = [PNG, SVG, HTML] -bokehCommand :: Text -> Text -> OutputSpec -> Text -bokehCommand cmdargs exe OutputSpec {..} = [st|#{exe} #{cmdargs} "#{oScriptPath}"|] - -bokehAvailable :: PlotM Bool -bokehAvailable = do - mexe <- executable Bokeh - case mexe of - Nothing -> return False - Just (Executable dir exe) -> withPrependedPath dir $ asks envCWD >>= flip commandSuccess [st|#{exe} -c "import bokeh; import selenium"|] +bokehCommand :: Text -> OutputSpec -> Text +bokehCommand cmdargs OutputSpec {..} = [st|#{pathToExe oExecutable} #{cmdargs} "#{oScriptPath}"|] -- | Check if `bokeh.io.show()` calls are present in the script, -- which would halt pandoc-plot diff --git a/src/Text/Pandoc/Filter/Plot/Renderers/GGPlot2.hs b/src/Text/Pandoc/Filter/Plot/Renderers/GGPlot2.hs index 1ed076b7..0b5159e0 100644 --- a/src/Text/Pandoc/Filter/Plot/Renderers/GGPlot2.hs +++ b/src/Text/Pandoc/Filter/Plot/Renderers/GGPlot2.hs @@ -21,42 +21,27 @@ where import qualified Data.Text as T import Text.Pandoc.Filter.Plot.Renderers.Prelude -ggplot2 :: PlotM (Maybe Renderer) +ggplot2 :: PlotM Renderer ggplot2 = do - avail <- ggplot2Available - if not avail - then return Nothing - else do cmdargs <- asksConfig ggplot2CmdArgs - mexe <- executable GGPlot2 return $ - mexe >>= \exe@(Executable _ exename) -> - return - Renderer - { rendererToolkit = GGPlot2, - rendererExe = exe, - rendererCapture = ggplot2Capture, - rendererCommand = ggplot2Command cmdargs exename, - rendererSupportedSaveFormats = ggplot2SupportedSaveFormats, - rendererChecks = mempty, - rendererLanguage = "r", - rendererComment = mappend "# ", - rendererScriptExtension = ".r" - } + Renderer + { rendererToolkit = GGPlot2, + rendererCapture = ggplot2Capture, + rendererCommand = ggplot2Command cmdargs, + rendererAvailability = CommandSuccess $ \exe -> [st|#{pathToExe exe} -e "if(!require('ggplot2')) {quit(status=1)}"|], + rendererSupportedSaveFormats = ggplot2SupportedSaveFormats, + rendererChecks = mempty, + rendererLanguage = "r", + rendererComment = mappend "# ", + rendererScriptExtension = ".r" + } ggplot2SupportedSaveFormats :: [SaveFormat] ggplot2SupportedSaveFormats = [PNG, PDF, SVG, JPG, EPS, TIF] -ggplot2Command :: Text -> Text -> OutputSpec -> Text -ggplot2Command cmdargs exe OutputSpec {..} = [st|#{exe} #{cmdargs} "#{oScriptPath}"|] - -ggplot2Available :: PlotM Bool -ggplot2Available = do - mexe <- executable GGPlot2 - case mexe of - Nothing -> return False - Just (Executable dir exe) -> - withPrependedPath dir $ asks envCWD >>= flip commandSuccess [st|#{exe} -e "if(!require('ggplot2')) {quit(status=1)}"|] +ggplot2Command :: Text -> OutputSpec -> Text +ggplot2Command cmdargs OutputSpec {..} = [st|#{pathToExe oExecutable} #{cmdargs} "#{oScriptPath}"|] ggplot2Capture :: FigureSpec -> FilePath -> Script ggplot2Capture fs fp = diff --git a/src/Text/Pandoc/Filter/Plot/Renderers/GNUPlot.hs b/src/Text/Pandoc/Filter/Plot/Renderers/GNUPlot.hs index 4e914368..1386d7bb 100644 --- a/src/Text/Pandoc/Filter/Plot/Renderers/GNUPlot.hs +++ b/src/Text/Pandoc/Filter/Plot/Renderers/GNUPlot.hs @@ -20,42 +20,27 @@ where import Text.Pandoc.Filter.Plot.Renderers.Prelude -gnuplot :: PlotM (Maybe Renderer) +gnuplot :: PlotM Renderer gnuplot = do - avail <- gnuplotAvailable - if not avail - then return Nothing - else do cmdargs <- asksConfig gnuplotCmdArgs - mexe <- executable GNUPlot return $ - mexe >>= \exe@(Executable _ exename) -> - return - Renderer - { rendererToolkit = GNUPlot, - rendererExe = exe, - rendererCapture = gnuplotCapture, - rendererCommand = gnuplotCommand cmdargs exename, - rendererSupportedSaveFormats = gnuplotSupportedSaveFormats, - rendererChecks = mempty, - rendererLanguage = "gnuplot", - rendererComment = mappend "# ", - rendererScriptExtension = ".gp" - } + Renderer + { rendererToolkit = GNUPlot, + rendererCapture = gnuplotCapture, + rendererCommand = gnuplotCommand cmdargs, + rendererAvailability = CommandSuccess $ \exe -> [st|#{pathToExe exe} -h|], + rendererSupportedSaveFormats = gnuplotSupportedSaveFormats, + rendererChecks = mempty, + rendererLanguage = "gnuplot", + rendererComment = mappend "# ", + rendererScriptExtension = ".gp" + } gnuplotSupportedSaveFormats :: [SaveFormat] gnuplotSupportedSaveFormats = [LaTeX, PNG, SVG, EPS, GIF, JPG, PDF] -gnuplotCommand :: Text -> Text -> OutputSpec -> Text -gnuplotCommand cmdargs exe OutputSpec {..} = [st|#{exe} #{cmdargs} -c "#{oScriptPath}"|] - -gnuplotAvailable :: PlotM Bool -gnuplotAvailable = do - mexe <- executable GNUPlot - case mexe of - Nothing -> return False - Just (Executable dir exe) -> - withPrependedPath dir $ asks envCWD >>= flip commandSuccess [st|"#{exe}" -h|] +gnuplotCommand :: Text -> OutputSpec -> Text +gnuplotCommand cmdargs OutputSpec {..} = [st|#{pathToExe oExecutable} #{cmdargs} -c "#{oScriptPath}"|] gnuplotCapture :: FigureSpec -> FilePath -> Script gnuplotCapture = prependCapture gnuplotCaptureFragment diff --git a/src/Text/Pandoc/Filter/Plot/Renderers/Graphviz.hs b/src/Text/Pandoc/Filter/Plot/Renderers/Graphviz.hs index 17b4e3bf..fc69e989 100644 --- a/src/Text/Pandoc/Filter/Plot/Renderers/Graphviz.hs +++ b/src/Text/Pandoc/Filter/Plot/Renderers/Graphviz.hs @@ -21,45 +21,30 @@ where import Data.Char import Text.Pandoc.Filter.Plot.Renderers.Prelude -graphviz :: PlotM (Maybe Renderer) +graphviz :: PlotM Renderer graphviz = do - avail <- graphvizAvailable - if not avail - then return Nothing - else do cmdargs <- asksConfig graphvizCmdArgs - mexe <- executable Graphviz return $ - mexe >>= \exe@(Executable _ exename) -> - return - Renderer - { rendererToolkit = Graphviz, - rendererExe = exe, - rendererCapture = graphvizCapture, - rendererCommand = graphvizCommand cmdargs exename, - rendererSupportedSaveFormats = graphvizSupportedSaveFormats, - rendererChecks = mempty, - rendererLanguage = "dot", - rendererComment = mappend "// ", - rendererScriptExtension = ".dot" - } + Renderer + { rendererToolkit = Graphviz, + rendererCapture = graphvizCapture, + rendererCommand = graphvizCommand cmdargs, + rendererAvailability = CommandSuccess $ \exe -> [st|#{pathToExe exe} -?|], + rendererSupportedSaveFormats = graphvizSupportedSaveFormats, + rendererChecks = mempty, + rendererLanguage = "dot", + rendererComment = mappend "// ", + rendererScriptExtension = ".dot" + } graphvizSupportedSaveFormats :: [SaveFormat] graphvizSupportedSaveFormats = [PNG, PDF, SVG, JPG, EPS, WEBP, GIF] -graphvizCommand :: Text -> Text -> OutputSpec -> Text -graphvizCommand cmdargs exe OutputSpec {..} = +graphvizCommand :: Text -> OutputSpec -> Text +graphvizCommand cmdargs OutputSpec {..} = let fmt = fmap toLower . show . saveFormat $ oFigureSpec dpi' = dpi oFigureSpec - in [st|#{exe} #{cmdargs} -T#{fmt} -Gdpi=#{dpi'} -o "#{oFigurePath}" "#{oScriptPath}"|] - -graphvizAvailable :: PlotM Bool -graphvizAvailable = do - mexe <- executable Graphviz - case mexe of - Nothing -> return False - Just (Executable dir exe) -> - withPrependedPath dir $ asks envCWD >>= flip commandSuccess [st|#{exe} -?|] + in [st|#{pathToExe oExecutable} #{cmdargs} -T#{fmt} -Gdpi=#{dpi'} -o "#{oFigurePath}" "#{oScriptPath}"|] -- Graphviz export is entirely based on command-line arguments -- so there is no need to modify the script itself. diff --git a/src/Text/Pandoc/Filter/Plot/Renderers/Mathematica.hs b/src/Text/Pandoc/Filter/Plot/Renderers/Mathematica.hs index 55549bff..0a6e3442 100644 --- a/src/Text/Pandoc/Filter/Plot/Renderers/Mathematica.hs +++ b/src/Text/Pandoc/Filter/Plot/Renderers/Mathematica.hs @@ -20,42 +20,27 @@ where import Text.Pandoc.Filter.Plot.Renderers.Prelude -mathematica :: PlotM (Maybe Renderer) +mathematica :: PlotM Renderer mathematica = do - avail <- mathematicaAvailable - if not avail - then return Nothing - else do cmdargs <- asksConfig mathematicaCmdArgs - mexe <- executable Mathematica return $ - mexe >>= \exe@(Executable _ exename) -> - return - Renderer - { rendererToolkit = Mathematica, - rendererExe = exe, - rendererCapture = mathematicaCapture, - rendererCommand = mathematicaCommand cmdargs exename, - rendererSupportedSaveFormats = mathematicaSupportedSaveFormats, - rendererChecks = mempty, - rendererLanguage = "mathematica", - rendererComment = \t -> mconcat ["(*", t, "*)"], - rendererScriptExtension = ".m" - } + Renderer + { rendererToolkit = Mathematica, + rendererCapture = mathematicaCapture, + rendererCommand = mathematicaCommand cmdargs, + rendererAvailability = CommandSuccess $ \exe -> [st|#{pathToExe exe} -h|], -- TODO: test this + rendererSupportedSaveFormats = mathematicaSupportedSaveFormats, + rendererChecks = mempty, + rendererLanguage = "mathematica", + rendererComment = \t -> mconcat ["(*", t, "*)"], + rendererScriptExtension = ".m" + } mathematicaSupportedSaveFormats :: [SaveFormat] mathematicaSupportedSaveFormats = [PNG, PDF, SVG, JPG, EPS, GIF, TIF] -mathematicaCommand :: Text -> Text -> OutputSpec -> Text -mathematicaCommand cmdargs exe OutputSpec {..} = [st|#{exe} #{cmdargs} -script "#{oScriptPath}"|] - -mathematicaAvailable :: PlotM Bool -mathematicaAvailable = do - mexe <- executable Mathematica - case mexe of - Nothing -> return False - Just (Executable dir exe) -> - withPrependedPath dir $ asks envCWD >>= flip commandSuccess [st|#{exe} -h|] -- TODO: test this +mathematicaCommand :: Text -> OutputSpec -> Text +mathematicaCommand cmdargs OutputSpec {..} = [st|#{pathToExe oExecutable} #{cmdargs} -script "#{oScriptPath}"|] mathematicaCapture :: FigureSpec -> FilePath -> Script mathematicaCapture = appendCapture mathematicaCaptureFragment diff --git a/src/Text/Pandoc/Filter/Plot/Renderers/Matlab.hs b/src/Text/Pandoc/Filter/Plot/Renderers/Matlab.hs index 18691723..d3704848 100644 --- a/src/Text/Pandoc/Filter/Plot/Renderers/Matlab.hs +++ b/src/Text/Pandoc/Filter/Plot/Renderers/Matlab.hs @@ -18,50 +18,38 @@ module Text.Pandoc.Filter.Plot.Renderers.Matlab ) where -import System.Directory (exeExtension) import Text.Pandoc.Filter.Plot.Renderers.Prelude -matlab :: PlotM (Maybe Renderer) +matlab :: PlotM Renderer matlab = do - avail <- matlabAvailable - if not avail - then return Nothing - else do cmdargs <- asksConfig matlabCmdArgs - mexe <- executable Matlab return $ - mexe >>= \exe@(Executable _ exename) -> - return - Renderer - { rendererToolkit = Matlab, - rendererExe = exe, - rendererCapture = matlabCapture, - rendererCommand = matlabCommand cmdargs exename, - rendererSupportedSaveFormats = matlabSupportedSaveFormats, - rendererChecks = mempty, - rendererLanguage = "matlab", - rendererComment = mappend "% ", - rendererScriptExtension = ".m" - } + Renderer + { rendererToolkit = Matlab, + rendererCapture = matlabCapture, + rendererCommand = matlabCommand cmdargs, + -- On Windows at least, "matlab -help" actually returns -1, even though the + -- help text is shown successfully! + -- Therefore, we cannot rely on this behavior to know if matlab is present, + -- like other toolkits. + rendererAvailability = ExecutableExists, + rendererSupportedSaveFormats = matlabSupportedSaveFormats, + rendererChecks = mempty, + rendererLanguage = "matlab", + rendererComment = mappend "% ", + rendererScriptExtension = ".m" + } matlabSupportedSaveFormats :: [SaveFormat] matlabSupportedSaveFormats = [PNG, PDF, SVG, JPG, EPS, GIF, TIF] -matlabCommand :: Text -> Text -> OutputSpec -> Text -matlabCommand cmdargs exe OutputSpec {..} = +matlabCommand :: Text -> OutputSpec -> Text +matlabCommand cmdargs OutputSpec {..} = -- The MATLAB 'run' function will switch to the directory where the script -- is located before executing the script. Therefore, we first save the current -- working directory in the variable 'pandoc_plot_cwd' so that we can use it -- when exporting the figure - [st|#{exe} #{cmdargs} -sd '#{oCWD}' -noFigureWindows -batch "pandoc_plot_cwd=pwd; run('#{oScriptPath}')"|] - --- On Windows at least, "matlab -help" actually returns -1, even though the --- help text is shown successfully! --- Therefore, we cannot rely on this behavior to know if matlab is present, --- like other toolkits. -matlabAvailable :: PlotM Bool -matlabAvailable = - asksConfig matlabExe >>= (\exe -> liftIO $ existsOnPath (exe <> exeExtension)) + [st|#{pathToExe oExecutable} #{cmdargs} -sd '#{oCWD}' -noFigureWindows -batch "pandoc_plot_cwd=pwd; run('#{oScriptPath}')"|] matlabCapture :: FigureSpec -> FilePath -> Script matlabCapture = appendCapture matlabCaptureFragment diff --git a/src/Text/Pandoc/Filter/Plot/Renderers/Matplotlib.hs b/src/Text/Pandoc/Filter/Plot/Renderers/Matplotlib.hs index 5a148856..3588c9d4 100644 --- a/src/Text/Pandoc/Filter/Plot/Renderers/Matplotlib.hs +++ b/src/Text/Pandoc/Filter/Plot/Renderers/Matplotlib.hs @@ -27,34 +27,27 @@ import Data.Monoid (Any (..)) import qualified Data.Text as T import Text.Pandoc.Filter.Plot.Renderers.Prelude -matplotlib :: PlotM (Maybe Renderer) +matplotlib :: PlotM Renderer matplotlib = do - avail <- matplotlibAvailable - if not avail - then return Nothing - else do cmdargs <- asksConfig matplotlibCmdArgs - mexe <- executable Matplotlib return $ - mexe >>= \exe@(Executable _ exename) -> - return - Renderer - { rendererToolkit = Matplotlib, - rendererExe = exe, - rendererCapture = matplotlibCapture, - rendererCommand = matplotlibCommand cmdargs exename, - rendererSupportedSaveFormats = matplotlibSupportedSaveFormats, - rendererChecks = [matplotlibCheckIfShow], - rendererLanguage = "python", - rendererComment = mappend "# ", - rendererScriptExtension = ".py" - } + Renderer + { rendererToolkit = Matplotlib, + rendererCapture = matplotlibCapture, + rendererCommand = matplotlibCommand cmdargs, + rendererAvailability = CommandSuccess $ \exe -> [st|#{pathToExe exe} -c "import matplotlib"|], + rendererSupportedSaveFormats = matplotlibSupportedSaveFormats, + rendererChecks = [matplotlibCheckIfShow], + rendererLanguage = "python", + rendererComment = mappend "# ", + rendererScriptExtension = ".py" + } matplotlibSupportedSaveFormats :: [SaveFormat] matplotlibSupportedSaveFormats = [PNG, PDF, SVG, JPG, EPS, GIF, TIF] -matplotlibCommand :: Text -> Text -> OutputSpec -> Text -matplotlibCommand cmdargs exe OutputSpec {..} = [st|#{exe} #{cmdargs} "#{oScriptPath}"|] +matplotlibCommand :: Text -> OutputSpec -> Text +matplotlibCommand cmdargs OutputSpec {..} = [st|#{pathToExe oExecutable} #{cmdargs} "#{oScriptPath}"|] matplotlibCapture :: FigureSpec -> FilePath -> Script matplotlibCapture = appendCapture matplotlibCaptureFragment @@ -72,14 +65,6 @@ plt.savefig(r"#{fname}", dpi=#{dpi}, transparent=#{transparent}, bbox_inches=#{t tightBox = if tight_ then ("'tight'" :: Text) else ("None" :: Text) transparent = if transparent_ then ("True" :: Text) else ("False" :: Text) -matplotlibAvailable :: PlotM Bool -matplotlibAvailable = do - mexe <- executable Matplotlib - case mexe of - Nothing -> return False - Just (Executable dir exe) -> - withPrependedPath dir $ asks envCWD >>= flip commandSuccess [st|#{exe} -c "import matplotlib"|] - -- | Check if `matplotlib.pyplot.show()` calls are present in the script, -- which would halt pandoc-plot matplotlibCheckIfShow :: Script -> CheckResult diff --git a/src/Text/Pandoc/Filter/Plot/Renderers/Octave.hs b/src/Text/Pandoc/Filter/Plot/Renderers/Octave.hs index 3810cd82..302d9de8 100644 --- a/src/Text/Pandoc/Filter/Plot/Renderers/Octave.hs +++ b/src/Text/Pandoc/Filter/Plot/Renderers/Octave.hs @@ -20,42 +20,27 @@ where import Text.Pandoc.Filter.Plot.Renderers.Prelude -octave :: PlotM (Maybe Renderer) +octave :: PlotM Renderer octave = do - avail <- octaveAvailable - if not avail - then return Nothing - else do cmdargs <- asksConfig octaveCmdArgs - mexe <- executable Octave return $ - mexe >>= \exe@(Executable _ exename) -> - return - Renderer - { rendererToolkit = Octave, - rendererExe = exe, - rendererCapture = octaveCapture, - rendererCommand = octaveCommand cmdargs exename, - rendererSupportedSaveFormats = octaveSupportedSaveFormats, - rendererChecks = mempty, - rendererLanguage = "matlab", - rendererComment = mappend "% ", - rendererScriptExtension = ".m" - } + Renderer + { rendererToolkit = Octave, + rendererCapture = octaveCapture, + rendererCommand = octaveCommand cmdargs, + rendererAvailability = CommandSuccess $ \exe -> [st|#{pathToExe exe} -h|], + rendererSupportedSaveFormats = octaveSupportedSaveFormats, + rendererChecks = mempty, + rendererLanguage = "matlab", + rendererComment = mappend "% ", + rendererScriptExtension = ".m" + } octaveSupportedSaveFormats :: [SaveFormat] octaveSupportedSaveFormats = [PNG, PDF, SVG, JPG, EPS, GIF, TIF] -octaveCommand :: Text -> Text -> OutputSpec -> Text -octaveCommand cmdargs exe OutputSpec {..} = [st|#{exe} #{cmdargs} --no-gui --no-window-system "#{oScriptPath}"|] - -octaveAvailable :: PlotM Bool -octaveAvailable = do - mexe <- executable Octave - case mexe of - Nothing -> return False - Just (Executable dir exe) -> - withPrependedPath dir $ asks envCWD >>= flip commandSuccess [st|#{exe} -h|] +octaveCommand :: Text -> OutputSpec -> Text +octaveCommand cmdargs OutputSpec {..} = [st|#{pathToExe oExecutable} #{cmdargs} --no-gui --no-window-system "#{oScriptPath}"|] octaveCapture :: FigureSpec -> FilePath -> Script octaveCapture = appendCapture octaveCaptureFragment diff --git a/src/Text/Pandoc/Filter/Plot/Renderers/PlantUML.hs b/src/Text/Pandoc/Filter/Plot/Renderers/PlantUML.hs index 4695f46b..b3ed02d5 100644 --- a/src/Text/Pandoc/Filter/Plot/Renderers/PlantUML.hs +++ b/src/Text/Pandoc/Filter/Plot/Renderers/PlantUML.hs @@ -22,40 +22,33 @@ import Data.Char import System.FilePath (takeDirectory, ()) import Text.Pandoc.Filter.Plot.Renderers.Prelude -plantuml :: PlotM (Maybe Renderer) +plantuml :: PlotM Renderer plantuml = do - avail <- plantumlAvailable - if not avail - then return Nothing - else do cmdargs <- asksConfig plantumlCmdArgs - mexe <- executable PlantUML return $ - mexe >>= \exe@(Executable _ exename) -> - return - Renderer - { rendererToolkit = PlantUML, - rendererExe = exe, - rendererCapture = plantumlCapture, - rendererCommand = plantumlCommand cmdargs exename, - rendererSupportedSaveFormats = plantumlSupportedSaveFormats, - rendererChecks = mempty, - rendererLanguage = "plantuml", - rendererComment = mappend "' ", - rendererScriptExtension = ".txt" - } + Renderer + { rendererToolkit = PlantUML, + rendererCapture = plantumlCapture, + rendererCommand = plantumlCommand cmdargs, + rendererAvailability = CommandSuccess $ \exe -> [st|#{pathToExe exe} #{cmdargs} -h|], + rendererSupportedSaveFormats = plantumlSupportedSaveFormats, + rendererChecks = mempty, + rendererLanguage = "plantuml", + rendererComment = mappend "' ", + rendererScriptExtension = ".txt" + } plantumlSupportedSaveFormats :: [SaveFormat] plantumlSupportedSaveFormats = [PNG, PDF, SVG] -plantumlCommand :: Text -> Text -> OutputSpec -> Text -plantumlCommand cmdargs exe OutputSpec {..} = +plantumlCommand :: Text -> OutputSpec -> Text +plantumlCommand cmdargs OutputSpec {..} = let fmt = fmap toLower . show . saveFormat $ oFigureSpec dir = takeDirectory oFigurePath -- the command below works as long as the script name is the same basename -- as the target figure path. E.g.: script basename of pandocplot123456789.txt -- will result in pandocplot123456789.(extension) - in [st|#{exe} #{cmdargs} -t#{fmt} -output "#{oCWD dir}" "#{normalizePath oScriptPath}"|] + in [st|#{pathToExe oExecutable} #{cmdargs} -t#{fmt} -output "#{oCWD dir}" "#{normalizePath oScriptPath}"|] normalizePath :: String -> String normalizePath = map f @@ -63,15 +56,6 @@ normalizePath = map f f '\\' = '/' f x = x -plantumlAvailable :: PlotM Bool -plantumlAvailable = do - mexe <- executable PlantUML - case mexe of - Nothing -> return False - Just (Executable dir exe) -> do - cmdargs <- asksConfig plantumlCmdArgs - withPrependedPath dir $ asks envCWD >>= flip commandSuccess [st|#{exe} #{cmdargs} -h|] - -- PlantUML export is entirely based on command-line arguments -- so there is no need to modify the script itself. plantumlCapture :: FigureSpec -> FilePath -> Script diff --git a/src/Text/Pandoc/Filter/Plot/Renderers/PlotlyPython.hs b/src/Text/Pandoc/Filter/Plot/Renderers/PlotlyPython.hs index 5d1138c1..d124f9d7 100644 --- a/src/Text/Pandoc/Filter/Plot/Renderers/PlotlyPython.hs +++ b/src/Text/Pandoc/Filter/Plot/Renderers/PlotlyPython.hs @@ -20,22 +20,15 @@ where import Text.Pandoc.Filter.Plot.Renderers.Prelude -plotlyPython :: PlotM (Maybe Renderer) +plotlyPython :: PlotM Renderer plotlyPython = do - avail <- plotlyPythonAvailable - if not avail - then return Nothing - else do cmdargs <- asksConfig plotlyPythonCmdArgs - mexe <- executable PlotlyPython return $ - mexe >>= \exe@(Executable _ exename) -> - return Renderer { rendererToolkit = PlotlyPython, - rendererExe = exe, rendererCapture = plotlyPythonCapture, - rendererCommand = plotlyPythonCommand cmdargs exename, + rendererCommand = plotlyPythonCommand cmdargs, + rendererAvailability = CommandSuccess $ \exe -> [st|#{pathToExe exe} -c "import plotly.graph_objects"|], rendererSupportedSaveFormats = plotlyPythonSupportedSaveFormats, rendererChecks = mempty, rendererLanguage = "python", @@ -46,17 +39,8 @@ plotlyPython = do plotlyPythonSupportedSaveFormats :: [SaveFormat] plotlyPythonSupportedSaveFormats = [PNG, JPG, WEBP, PDF, SVG, EPS, HTML] -plotlyPythonCommand :: Text -> Text -> OutputSpec -> Text -plotlyPythonCommand cmdargs exe OutputSpec {..} = [st|#{exe} #{cmdargs} "#{oScriptPath}"|] - -plotlyPythonAvailable :: PlotM Bool -plotlyPythonAvailable = do - mexe <- executable PlotlyPython - case mexe of - Nothing -> return False - Just (Executable dir exe) -> - withPrependedPath dir $ - asks envCWD >>= flip commandSuccess [st|#{exe} -c "import plotly.graph_objects"|] +plotlyPythonCommand :: Text -> OutputSpec -> Text +plotlyPythonCommand cmdargs OutputSpec {..} = [st|#{pathToExe oExecutable} #{cmdargs} "#{oScriptPath}"|] plotlyPythonCapture :: FigureSpec -> FilePath -> Script plotlyPythonCapture = appendCapture plotlyPythonCaptureFragment diff --git a/src/Text/Pandoc/Filter/Plot/Renderers/PlotlyR.hs b/src/Text/Pandoc/Filter/Plot/Renderers/PlotlyR.hs index 7c80730b..7530ec44 100644 --- a/src/Text/Pandoc/Filter/Plot/Renderers/PlotlyR.hs +++ b/src/Text/Pandoc/Filter/Plot/Renderers/PlotlyR.hs @@ -21,43 +21,27 @@ where import qualified Data.Text as T import Text.Pandoc.Filter.Plot.Renderers.Prelude -plotlyR :: PlotM (Maybe Renderer) +plotlyR :: PlotM Renderer plotlyR = do - avail <- plotlyRAvailable - if not avail - then return Nothing - else do cmdargs <- asksConfig plotlyRCmdArgs - mexe <- executable PlotlyR return $ - mexe >>= \exe@(Executable _ exename) -> - return - Renderer - { rendererToolkit = PlotlyR, - rendererExe = exe, - rendererCapture = plotlyRCapture, - rendererCommand = plotlyRCommand cmdargs exename, - rendererSupportedSaveFormats = plotlyRSupportedSaveFormats, - rendererChecks = mempty, - rendererLanguage = "r", - rendererComment = mappend "# ", - rendererScriptExtension = ".r" - } + Renderer + { rendererToolkit = PlotlyR, + rendererCapture = plotlyRCapture, + rendererCommand = plotlyRCommand cmdargs, + rendererAvailability = CommandSuccess $ \exe -> [st|#{pathToExe exe} -e "if(!require('plotly')) {quit(status=1)}"|], + rendererSupportedSaveFormats = plotlyRSupportedSaveFormats, + rendererChecks = mempty, + rendererLanguage = "r", + rendererComment = mappend "# ", + rendererScriptExtension = ".r" + } plotlyRSupportedSaveFormats :: [SaveFormat] plotlyRSupportedSaveFormats = [PNG, PDF, SVG, JPG, EPS, HTML] -plotlyRCommand :: Text -> Text -> OutputSpec -> Text -plotlyRCommand cmdargs exe OutputSpec {..} = [st|#{exe} #{cmdargs} "#{oScriptPath}"|] - -plotlyRAvailable :: PlotM Bool -plotlyRAvailable = do - mexe <- executable PlotlyR - case mexe of - Nothing -> return False - Just (Executable dir exe) -> - withPrependedPath dir $ - asks envCWD >>= flip commandSuccess [st|#{exe} -e "if(!require('plotly')) {quit(status=1)}"|] +plotlyRCommand :: Text -> OutputSpec -> Text +plotlyRCommand cmdargs OutputSpec {..} = [st|#{pathToExe oExecutable} #{cmdargs} "#{oScriptPath}"|] plotlyRCapture :: FigureSpec -> FilePath -> Script plotlyRCapture fs fp = diff --git a/src/Text/Pandoc/Filter/Plot/Renderers/Plotsjl.hs b/src/Text/Pandoc/Filter/Plot/Renderers/Plotsjl.hs index ab54c866..745e3d1d 100644 --- a/src/Text/Pandoc/Filter/Plot/Renderers/Plotsjl.hs +++ b/src/Text/Pandoc/Filter/Plot/Renderers/Plotsjl.hs @@ -20,45 +20,29 @@ where import Text.Pandoc.Filter.Plot.Renderers.Prelude -plotsjl :: PlotM (Maybe Renderer) +plotsjl :: PlotM Renderer plotsjl = do - avail <- plotsjlAvailable - if not avail - then return Nothing - else do cmdargs <- asksConfig plotsjlCmdArgs - mexe <- executable Plotsjl return $ - mexe >>= \exe@(Executable _ exename) -> - return - Renderer - { rendererToolkit = Plotsjl, - rendererExe = exe, - rendererCapture = plotsjlCapture, - rendererCommand = plotsjlCommand cmdargs exename, - rendererSupportedSaveFormats = plotsjlSupportedSaveFormats, - rendererChecks = mempty, - rendererLanguage = "julia", - rendererComment = mappend "# ", - rendererScriptExtension = ".jl" - } + Renderer + { rendererToolkit = Plotsjl, + rendererCapture = plotsjlCapture, + rendererCommand = plotsjlCommand cmdargs, + rendererAvailability = CommandSuccess $ \exe -> [st|#{pathToExe exe} -e "using Plots"|], + rendererSupportedSaveFormats = plotsjlSupportedSaveFormats, + rendererChecks = mempty, + rendererLanguage = "julia", + rendererComment = mappend "# ", + rendererScriptExtension = ".jl" + } -- Save formats support by most backends -- https://docs.plotsjl.org/latest/output/#Supported-output-file-formats-1 plotsjlSupportedSaveFormats :: [SaveFormat] plotsjlSupportedSaveFormats = [PNG, SVG, PDF] -plotsjlCommand :: Text -> Text -> OutputSpec -> Text -plotsjlCommand cmdargs exe OutputSpec {..} = [st|#{exe} #{cmdargs} -- "#{oScriptPath}"|] - -plotsjlAvailable :: PlotM Bool -plotsjlAvailable = do - mexe <- executable Plotsjl - case mexe of - Nothing -> return False - Just (Executable dir exe) -> - withPrependedPath dir $ - asks envCWD >>= flip commandSuccess [st|#{exe} -e "using Plots"|] +plotsjlCommand :: Text -> OutputSpec -> Text +plotsjlCommand cmdargs OutputSpec {..} = [st|#{pathToExe oExecutable} #{cmdargs} -- "#{oScriptPath}"|] plotsjlCapture :: FigureSpec -> FilePath -> Script plotsjlCapture = appendCapture plotsjlCaptureFragment diff --git a/src/Text/Pandoc/Filter/Plot/Renderers/Prelude.hs b/src/Text/Pandoc/Filter/Plot/Renderers/Prelude.hs index ae825c47..ecc85e06 100644 --- a/src/Text/Pandoc/Filter/Plot/Renderers/Prelude.hs +++ b/src/Text/Pandoc/Filter/Plot/Renderers/Prelude.hs @@ -15,36 +15,18 @@ module Text.Pandoc.Filter.Plot.Renderers.Prelude Text, st, unpack, - commandSuccess, - existsOnPath, + findExecutable, appendCapture, toRPath, ) where -import Data.Functor ((<&>)) -import Data.Maybe (isJust) import Data.Text (Text, unpack) import System.Directory (findExecutable) -import System.Exit (ExitCode (..)) import System.FilePath (isPathSeparator) import Text.Pandoc.Filter.Plot.Monad import Text.Shakespeare.Text (st) --- | Check that the supplied command results in --- an exit code of 0 (i.e. no errors) -commandSuccess :: - FilePath -> -- Directory from which to run the command - Text -> -- Command to run, including the executable - PlotM Bool -commandSuccess fp s = do - (ec, _) <- runCommand fp s - return $ ec == ExitSuccess - --- | Checks that an executable is available on path, at all. -existsOnPath :: FilePath -> IO Bool -existsOnPath fp = findExecutable fp <&> isJust - -- | A shortcut to append capture script fragments to scripts appendCapture :: (FigureSpec -> FilePath -> Script) -> diff --git a/src/Text/Pandoc/Filter/Plot/Renderers/SageMath.hs b/src/Text/Pandoc/Filter/Plot/Renderers/SageMath.hs index fb49f55c..2905c162 100644 --- a/src/Text/Pandoc/Filter/Plot/Renderers/SageMath.hs +++ b/src/Text/Pandoc/Filter/Plot/Renderers/SageMath.hs @@ -20,50 +20,33 @@ where import Text.Pandoc.Filter.Plot.Renderers.Prelude -sagemath :: PlotM (Maybe Renderer) +sagemath :: PlotM Renderer sagemath = do - avail <- sagemathAvailable - if not avail - then return Nothing - else do cmdargs <- asksConfig sagemathCmdArgs - mexe <- executable SageMath return $ - mexe >>= \exe@(Executable _ exename) -> - return - Renderer - { rendererToolkit = SageMath, - rendererExe = exe, - rendererCapture = sagemathCapture, - rendererCommand = sagemathCommand cmdargs exename, - rendererSupportedSaveFormats = sagemathSupportedSaveFormats, - rendererChecks = mempty, - rendererLanguage = "sagemath", - rendererComment = mappend "# ", - rendererScriptExtension = ".sage" - } + Renderer + { rendererToolkit = SageMath, + rendererCapture = sagemathCapture, + rendererCommand = sagemathCommand cmdargs, + rendererAvailability = CommandSuccess $ \exe -> [st|#{pathToExe exe} -v|], + rendererSupportedSaveFormats = sagemathSupportedSaveFormats, + rendererChecks = mempty, + rendererLanguage = "sagemath", + rendererComment = mappend "# ", + rendererScriptExtension = ".sage" + } -- See here: -- https://doc.sagemath.org/html/en/reference/plotting/sage/plot/graphics.html#sage.plot.graphics.Graphics.save sagemathSupportedSaveFormats :: [SaveFormat] sagemathSupportedSaveFormats = [EPS, PDF, PNG, SVG] -sagemathCommand :: Text -> Text -> OutputSpec -> Text -sagemathCommand cmdargs exe OutputSpec {..} = [st|#{exe} #{cmdargs} "#{oScriptPath}"|] - -sagemathAvailable :: PlotM Bool -sagemathAvailable = do - mexe <- executable SageMath - case mexe of - Nothing -> return False - Just (Executable dir exe) -> do - withPrependedPath dir $ asks envCWD >>= flip commandSuccess [st|#{exe} -v|] - +sagemathCommand :: Text -> OutputSpec -> Text +sagemathCommand cmdargs OutputSpec {..} = [st|#{pathToExe oExecutable} #{cmdargs} "#{oScriptPath}"|] sagemathCapture :: FigureSpec -> FilePath -> Script sagemathCapture = appendCapture sagemathCaptureFragment - -- This capture fragment is a bit ugly because sage does not have the -- equivalent of matplotlib's `plt.gca()` to get a pointer to the most -- recent graphical object. We must search for it diff --git a/src/Text/Pandoc/Filter/Plot/Scripting.hs b/src/Text/Pandoc/Filter/Plot/Scripting.hs index c79987cc..8edd0e72 100644 --- a/src/Text/Pandoc/Filter/Plot/Scripting.hs +++ b/src/Text/Pandoc/Filter/Plot/Scripting.hs @@ -120,20 +120,17 @@ runTempScript spec@FigureSpec {..} = do { oFigureSpec = spec, oScriptPath = scriptPath, oFigurePath = target, + oExecutable = fsExecutable, oCWD = cwd } let command_ = rendererCommand renderer_ outputSpec - -- Change the PATH environment variable so the appropriate executable is - -- found first - let (Executable exedir _) = rendererExe renderer_ - withPrependedPath exedir $ do - -- It is important that the CWD be inherited from the - -- parent process. See #2. - (ec, _) <- runCommand cwd command_ - case ec of - ExitSuccess -> return ScriptSuccess - ExitFailure code -> return $ ScriptFailure command_ code script + -- It is important that the CWD be inherited from the + -- parent process. See #2. + (ec, _) <- runCommand cwd command_ + case ec of + ExitSuccess -> return ScriptSuccess + ExitFailure code -> return $ ScriptFailure command_ code script -- | Determine the temp script path from Figure specifications -- Note that for certain renderers, the appropriate file extension diff --git a/tests/issue46.md b/tests/issue46.md new file mode 100644 index 00000000..58de9088 --- /dev/null +++ b/tests/issue46.md @@ -0,0 +1,9 @@ +--- +plot-configuration: tests/fixtures/.verbose-config.yml +--- + +```{.matplotlib executable="./issue46/bin/python"} +import sys +print(f"sys.executable={sys.executable}", file=sys.stderr) +import npstreams +``` \ No newline at end of file