{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

-- |

-- Module      : $header$

-- Description : Pandoc filter to create figures from code blocks using your plotting toolkit of choice

-- Copyright   : (c) Laurent P René de Cotret, 2020

-- License     : GNU GPL, version 2 or above

-- Maintainer  : laurent.decotret@outlook.com

-- Stability   : unstable

-- Portability : portable

--

-- This module defines a Pandoc filter @plotTransform@ and related functions

-- that can be used to walk over a Pandoc document and generate figures from

-- code blocks, using a multitude of plotting toolkits.

--

-- The syntax for code blocks is simple. Code blocks with the appropriate class

-- attribute will trigger the filter:

--

-- *   @matplotlib@ for matplotlib-based Python plots;

-- *   @plotly_python@ for Plotly-based Python plots;

-- *   @plotly_r@ for Plotly-based R plots;

-- *   @matlabplot@ for MATLAB plots;

-- *   @mathplot@ for Mathematica plots;

-- *   @octaveplot@ for GNU Octave plots;

-- *   @ggplot2@ for ggplot2-based R plots;

-- *   @gnuplot@ for gnuplot plots;

-- *   @graphviz@ for Graphviz graphs;

-- *   @bokeh@ for Bokeh-based Python plots;

-- *   @plotsjl@ for Plots.jl-based Julia plots;

--

-- For example, in Markdown:

--

-- @

--     This is a paragraph.

--

--     ```{.matlabplot}

--     figure()

--     plot([1,2,3,4,5], [1,2,3,4,5], '-k')

--     ```

-- @

--

-- The code block will be reworked into a script and the output figure will be captured. Optionally, the source code

--  used to generate the figure will be linked in the caption.

--

-- Here are the possible attributes what pandoc-plot understands for ALL toolkits:

--

--     * @directory=...@ : Directory where to save the figure. This path should be specified with

--       respect to the current working directory, and not with respect to the document.

--     * @source=true|false@ : Whether or not to link the source code of this figure in the caption.

--       Ideal for web pages, for example. Default is false.

--     * @format=...@: Format of the generated figure. This can be an extension or an acronym,

--       e.g. @format=PNG@.

--     * @caption="..."@: Specify a plot caption (or alternate text). Format

--       for captions is specified in the documentation for the @Configuration@ type.

--     * @dpi=...@: Specify a value for figure resolution, or dots-per-inch. Certain toolkits ignore this.

--     * @dependencies=[...]@: Specify files/directories on which a figure depends, e.g. data file.

--       Figures will be re-rendered if one of those file/directory changes. These paths should

--       be specified with respect to the current working directory, and not with respect to the document.

--     * @preamble=...@: Path to a file to include before the code block. Ideal to avoid repetition over

--       many figures.

--     * @file=...@: Path to a file from which to read the content of the figure. The content of the

--       code block will be ignored. This path should be specified with respect to the current working

--       directory, and not with respect to the document.

--

-- Default values for the above attributes are stored in the @Configuration@ datatype. These can be specified in a

-- YAML file.

--

-- Here is an example code block which will render a figure using gnuplot, in Markdown:

--

-- @

--     ```{.gnuplot format=png caption="Sinusoidal function" source=true}

--     sin(x)

--

--     set xlabel "x"

--     set ylabel "y"

--     ```

-- @

module Text.Pandoc.Filter.Plot
  ( -- * Operating on whole Pandoc documents

    plotTransform,

    -- * Cleaning output directories

    cleanOutputDirs,

    -- * Runtime configuration

    configuration,
    defaultConfiguration,
    Configuration (..),
    Verbosity (..),
    LogSink (..),
    SaveFormat (..),
    Script,

    -- * Determining available plotting toolkits

    Toolkit (..),
    availableToolkits,
    unavailableToolkits,
    toolkits,
    supportedSaveFormats,

    -- * Version information

    pandocPlotVersion,

    -- * For embedding, testing and internal purposes ONLY. Might change without notice.

    make,
    makeEither,
    PandocPlotError (..),
  )
where

import Control.Concurrent.Async.Lifted (mapConcurrently)
import Data.Text (Text, unpack)
import Data.Version (Version)
import Paths_pandoc_plot (version)
import Text.Pandoc.Definition (Block, Pandoc (..))
import Text.Pandoc.Filter.Plot.Internal
  ( Configuration (..),
    FigureSpec,
    LogSink (..),
    PlotM,
    RuntimeEnv (envConfig),
    SaveFormat (..),
    Script,
    ScriptResult (..),
    Toolkit (..),
    Verbosity (..),
    asks,
    availableToolkits,
    cleanOutputDirs,
    configuration,
    defaultConfiguration,
    parseFigureSpec,
    runPlotM,
    runScriptIfNecessary,
    supportedSaveFormats,
    toFigure,
    toolkits,
    unavailableToolkits,
  )

-- | Walk over an entire Pandoc document, transforming appropriate code blocks

-- into figures. This function will operate on blocks in parallel if possible.

--

-- Failing to render a figure does not stop the filter, so that you may run the filter

-- on documents without having all necessary toolkits installed. In this case, error

-- messages are printed to stderr, and blocks are left unchanged.

plotTransform ::
  -- | Configuration for default values

  Configuration ->
  -- | Input document

  Pandoc ->
  IO Pandoc
plotTransform :: Configuration -> Pandoc -> IO Pandoc
plotTransform Configuration
conf (Pandoc Meta
meta [Block]
blocks) =
  Configuration -> PlotM Pandoc -> IO Pandoc
forall a. Configuration -> PlotM a -> IO a
runPlotM Configuration
conf (PlotM Pandoc -> IO Pandoc) -> PlotM Pandoc -> IO Pandoc
forall a b. (a -> b) -> a -> b
$ (Block -> StateT PlotState (ReaderT RuntimeEnv IO) Block)
-> [Block] -> StateT PlotState (ReaderT RuntimeEnv IO) [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, MonadBaseControl IO m) =>
(a -> m b) -> t a -> m (t b)
mapConcurrently Block -> StateT PlotState (ReaderT RuntimeEnv IO) Block
make [Block]
blocks StateT PlotState (ReaderT RuntimeEnv IO) [Block]
-> ([Block] -> PlotM Pandoc) -> PlotM Pandoc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pandoc -> PlotM Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> PlotM Pandoc)
-> ([Block] -> Pandoc) -> [Block] -> PlotM Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> [Block] -> Pandoc
Pandoc Meta
meta

-- | The version of the pandoc-plot package.

--

-- @since 0.8.0.0

pandocPlotVersion :: Version
pandocPlotVersion :: Version
pandocPlotVersion = Version
version

-- | Try to process the block with `pandoc-plot`. If a failure happens (or the block)

-- was not meant to become a figure, return the block as-is.

make :: Block -> PlotM Block
make :: Block -> StateT PlotState (ReaderT RuntimeEnv IO) Block
make Block
blk = (PandocPlotError -> StateT PlotState (ReaderT RuntimeEnv IO) Block)
-> (Block -> StateT PlotState (ReaderT RuntimeEnv IO) Block)
-> Either PandocPlotError Block
-> StateT PlotState (ReaderT RuntimeEnv IO) Block
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (StateT PlotState (ReaderT RuntimeEnv IO) Block
-> PandocPlotError
-> StateT PlotState (ReaderT RuntimeEnv IO) Block
forall a b. a -> b -> a
const (Block -> StateT PlotState (ReaderT RuntimeEnv IO) Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
blk)) Block -> StateT PlotState (ReaderT RuntimeEnv IO) Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocPlotError Block
 -> StateT PlotState (ReaderT RuntimeEnv IO) Block)
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
-> StateT PlotState (ReaderT RuntimeEnv IO) Block
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Block
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
makeEither Block
blk

-- | Try to process the block with `pandoc-plot`, documenting the error.

makeEither :: Block -> PlotM (Either PandocPlotError Block)
makeEither :: Block
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
makeEither Block
block =
  Block -> PlotM (Maybe FigureSpec)
parseFigureSpec Block
block
    PlotM (Maybe FigureSpec)
-> (Maybe FigureSpec
    -> StateT
         PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block))
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StateT
  PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
-> (FigureSpec
    -> StateT
         PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block))
-> Maybe FigureSpec
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (Either PandocPlotError Block
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocPlotError Block
 -> StateT
      PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block))
-> Either PandocPlotError Block
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall a b. (a -> b) -> a -> b
$ Block -> Either PandocPlotError Block
forall a b. b -> Either a b
Right Block
block)
      (\FigureSpec
s -> FigureSpec -> PlotM ScriptResult
runScriptIfNecessary FigureSpec
s PlotM ScriptResult
-> (ScriptResult
    -> StateT
         PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block))
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FigureSpec
-> ScriptResult
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
handleResult FigureSpec
s)
  where
    -- Logging of errors has been taken care of in @runScriptIfNecessary@

    handleResult :: FigureSpec -> ScriptResult -> PlotM (Either PandocPlotError Block)
    handleResult :: FigureSpec
-> ScriptResult
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
handleResult FigureSpec
_ (ScriptFailure Text
msg Int
code) = Either PandocPlotError Block
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocPlotError Block
 -> StateT
      PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block))
-> Either PandocPlotError Block
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall a b. (a -> b) -> a -> b
$ PandocPlotError -> Either PandocPlotError Block
forall a b. a -> Either a b
Left (Text -> Int -> PandocPlotError
ScriptRuntimeError Text
msg Int
code)
    handleResult FigureSpec
_ (ScriptChecksFailed Text
msg) = Either PandocPlotError Block
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocPlotError Block
 -> StateT
      PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block))
-> Either PandocPlotError Block
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall a b. (a -> b) -> a -> b
$ PandocPlotError -> Either PandocPlotError Block
forall a b. a -> Either a b
Left (Text -> PandocPlotError
ScriptChecksFailedError Text
msg)
    handleResult FigureSpec
_ (ToolkitNotInstalled Toolkit
tk') = Either PandocPlotError Block
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocPlotError Block
 -> StateT
      PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block))
-> Either PandocPlotError Block
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall a b. (a -> b) -> a -> b
$ PandocPlotError -> Either PandocPlotError Block
forall a b. a -> Either a b
Left (Toolkit -> PandocPlotError
ToolkitNotInstalledError Toolkit
tk')
    handleResult FigureSpec
spec ScriptResult
ScriptSuccess = (RuntimeEnv -> Configuration)
-> StateT PlotState (ReaderT RuntimeEnv IO) Configuration
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RuntimeEnv -> Configuration
envConfig StateT PlotState (ReaderT RuntimeEnv IO) Configuration
-> (Configuration
    -> StateT
         PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block))
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Configuration
c -> Block -> Either PandocPlotError Block
forall a b. b -> Either a b
Right (Block -> Either PandocPlotError Block)
-> StateT PlotState (ReaderT RuntimeEnv IO) Block
-> StateT
     PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Format
-> FigureSpec -> StateT PlotState (ReaderT RuntimeEnv IO) Block
toFigure (Configuration -> Format
captionFormat Configuration
c) FigureSpec
spec

data PandocPlotError
  = ScriptRuntimeError Text Int
  | ScriptChecksFailedError Text
  | ToolkitNotInstalledError Toolkit

instance Show PandocPlotError where
  show :: PandocPlotError -> String
show (ScriptRuntimeError Text
_ Int
exitcode) = String
"ERROR (pandoc-plot) The script failed with exit code " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
exitcode String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
  show (ScriptChecksFailedError Text
msg) = String
"ERROR (pandoc-plot) A script check failed with message: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
msg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
  show (ToolkitNotInstalledError Toolkit
tk) = String
"ERROR (pandoc-plot) The " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Toolkit -> String
forall a. Show a => a -> String
show Toolkit
tk String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" toolkit is required but not installed."