{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}

-- |
-- Module      : $header$
-- Copyright   : (c) Laurent P René de Cotret, 2019 - present
-- License     : GNU GPL, version 2 or above
-- Maintainer  : laurent.decotret@outlook.com
-- Stability   : internal
-- Portability : portable
--
-- This module defines the @PlotM@ monad and related capabilities.
module Text.Pandoc.Filter.Plot.Monad
  ( Configuration (..),
    PlotM,
    RuntimeEnv (..),
    PlotState (..),
    runPlotM,

    -- * Concurrent execution
    mapConcurrentlyN,

    -- * Running external commands
    runCommand,
    withPrependedPath,

    -- * Halting pandoc-plot
    throwStrictError,

    -- * Getting file hashes
    fileHash,

    -- * Getting executables
    executable,

    -- * Logging
    Verbosity (..),
    LogSink (..),
    debug,
    err,
    warning,
    info,

    -- * Lifting and other monadic operations
    liftIO,
    ask,
    asks,
    asksConfig,

    -- * Base types
    module Text.Pandoc.Filter.Plot.Monad.Types,
  )
where

import Control.Concurrent.Async.Lifted (mapConcurrently)
import Control.Concurrent.MVar (MVar, newMVar, putMVar, takeMVar)
import Control.Concurrent.QSemN
  ( QSemN,
    newQSemN,
    signalQSemN,
    waitQSemN,
  )
import Control.Exception.Lifted (bracket, bracket_)
import Control.Monad.Reader
  ( MonadIO (liftIO),
    MonadReader (ask),
    ReaderT (runReaderT),
    asks,
  )
import Control.Monad.State.Strict
  ( MonadState (get, put),
    StateT,
    evalStateT,
  )
import Data.ByteString.Lazy (toStrict)
import Data.Hashable (hash)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Text (Text, pack, unpack)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import System.Directory
  ( doesFileExist,
    getCurrentDirectory,
    getModificationTime,
  )
import System.Environment (getEnv, setEnv)
import System.Exit (ExitCode (..), exitFailure)
import System.Process.Typed
  ( byteStringInput,
    byteStringOutput,
    nullStream,
    readProcessStderr,
    setStderr,
    setStdin,
    setStdout,
    setWorkingDir,
    shell,
  )
import Text.Pandoc.Definition (Format (..))
import Text.Pandoc.Filter.Plot.Monad.Logging
  ( LogSink (..),
    Logger,
    MonadLogger (..),
    Verbosity (..),
    debug,
    err,
    info,
    strict,
    terminateLogging,
    warning,
    withLogger,
  )
import Text.Pandoc.Filter.Plot.Monad.Types
import Prelude hiding (fst, log, snd)

-- | pandoc-plot monad
type PlotM = StateT PlotState (ReaderT RuntimeEnv IO)

instance MonadLogger PlotM where
  askLogger :: PlotM Logger
askLogger = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RuntimeEnv -> Logger
envLogger

data RuntimeEnv = RuntimeEnv
  { RuntimeEnv -> Maybe Format
envFormat :: Maybe Format, -- pandoc output format
    RuntimeEnv -> Configuration
envConfig :: Configuration,
    RuntimeEnv -> Logger
envLogger :: Logger,
    RuntimeEnv -> String
envCWD :: FilePath,
    -- The following lock prevents from writing to the same file multiple times.
    -- This is a rather crude fix for issue #53.
    RuntimeEnv -> MVar ()
envIOLock :: MVar ()
  }

-- | Get access to configuration within the @PlotM@ monad.
asksConfig :: (Configuration -> a) -> PlotM a
asksConfig :: forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> a
f = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Configuration -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeEnv -> Configuration
envConfig)

-- | Evaluate a @PlotM@ action.
runPlotM :: Maybe Format -> Configuration -> PlotM a -> IO a
runPlotM :: forall a. Maybe Format -> Configuration -> PlotM a -> IO a
runPlotM Maybe Format
fmt Configuration
conf PlotM a
v = do
  String
cwd <- IO String
getCurrentDirectory
  MVar ()
sem <- forall a. a -> IO (MVar a)
newMVar ()
  PlotState
st <-
    MVar (Map String FileHash) -> PlotState
PlotState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (MVar a)
newMVar forall a. Monoid a => a
mempty
  let verbosity :: Verbosity
verbosity = Configuration -> Verbosity
logVerbosity Configuration
conf
      sink :: LogSink
sink = Configuration -> LogSink
logSink Configuration
conf
  forall a. Verbosity -> LogSink -> (Logger -> IO a) -> IO a
withLogger Verbosity
verbosity LogSink
sink forall a b. (a -> b) -> a -> b
$
    \Logger
logger -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT PlotM a
v PlotState
st) (Maybe Format
-> Configuration -> Logger -> String -> MVar () -> RuntimeEnv
RuntimeEnv Maybe Format
fmt Configuration
conf Logger
logger String
cwd MVar ()
sem)

-- | maps a function, performing at most @N@ actions concurrently.
mapConcurrentlyN :: Traversable t => Int -> (a -> PlotM b) -> t a -> PlotM (t b)
mapConcurrentlyN :: forall (t :: * -> *) a b.
Traversable t =>
Int -> (a -> PlotM b) -> t a -> PlotM (t b)
mapConcurrentlyN Int
n a -> PlotM b
f t a
xs = do
  -- Emulating a pool of processes with locked access
  QSemN
sem <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Int -> IO QSemN
newQSemN Int
n
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, MonadBaseControl IO m) =>
(a -> m b) -> t a -> m (t b)
mapConcurrently (forall a. QSemN -> PlotM a -> PlotM a
with QSemN
sem forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PlotM b
f) t a
xs
  where
    with :: QSemN -> PlotM a -> PlotM a
    with :: forall a. QSemN -> PlotM a -> PlotM a
with QSemN
s = forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> m b -> m c -> m c
bracket_ (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ QSemN -> Int -> IO ()
waitQSemN QSemN
s Int
1) (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ QSemN -> Int -> IO ()
signalQSemN QSemN
s Int
1)

-- | Run a command within the @PlotM@ monad. Stderr stream
-- is read and decoded, while Stdout is ignored.
-- Logging happens at the debug level if the command succeeds, or at
-- the error level if it does not succeed.
runCommand ::
  FilePath -> -- Directory from which to run the command
  Text -> -- Command to run, including executable
  PlotM (ExitCode, Text)
runCommand :: String -> Text -> PlotM (ExitCode, Text)
runCommand String
wordir Text
command = do
  (ExitCode
ec, ByteString
processOutput') <-
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) stdin stdout stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdout stderrIgnored
-> m (ExitCode, ByteString)
readProcessStderr forall a b. (a -> b) -> a -> b
$
        -- For Julia specifically, if the line below is not there (`setStdin (byteStringInput "")`),
        -- the following error is thrown on Windows:
        --    ERROR: error initializing stdin in uv_dup:
        --           Unknown system error 50 (Unknown system error 50 50)
        forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin (ByteString -> StreamSpec 'STInput ()
byteStringInput ByteString
"") forall a b. (a -> b) -> a -> b
$
          forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
nullStream forall a b. (a -> b) -> a -> b
$
            forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput (STM ByteString)
byteStringOutput forall a b. (a -> b) -> a -> b
$
              forall stdin stdout stderr.
String
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setWorkingDir String
wordir forall a b. (a -> b) -> a -> b
$
                String -> ProcessConfig () () ()
shell (Text -> String
unpack Text
command)
  let processOutput :: Text
processOutput = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict ByteString
processOutput'
      logFunc :: Text -> StateT PlotState (ReaderT RuntimeEnv IO) ()
logFunc =
        if ExitCode
ec forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
          then forall (m :: * -> *). (MonadLogger m, MonadIO m) => Text -> m ()
debug
          else forall (m :: * -> *). (MonadLogger m, MonadIO m) => Text -> m ()
err
      message :: Text
message =
        [Text] -> Text
T.unlines
          [ Text
"Running command",
            Text
"    " forall a. Semigroup a => a -> a -> a
<> Text
command,
            Text
"ended with exit code " forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ ExitCode
ec)
          ]
      errorMessage :: Text
errorMessage =
        if Text
processOutput forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty
          then forall a. Monoid a => a
mempty
          else
            [Text] -> Text
T.unlines
              [ Text
"*******",
                Text
processOutput,
                Text
"*******"
              ]

  Text -> StateT PlotState (ReaderT RuntimeEnv IO) ()
logFunc forall a b. (a -> b) -> a -> b
$ Text
message forall a. Semigroup a => a -> a -> a
<> Text
errorMessage
  forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ec, Text
processOutput)

-- | Prepend a directory to the PATH environment variable for the duration
-- of a computation.
--
-- This function is exception-safe; even if an exception happens during the
-- computation, the PATH environment variable will be reverted back to
-- its initial value.
withPrependedPath :: FilePath -> PlotM a -> PlotM a
withPrependedPath :: forall a. String -> PlotM a -> PlotM a
withPrependedPath String
dir PlotM a
f = do
  String
pathVar <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO String
getEnv String
"PATH"
  let pathVarPrepended :: String
pathVarPrepended = forall a. Monoid a => [a] -> a
mconcat [String
dir, String
";", String
pathVar]
  forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
setEnv String
"PATH" String
pathVarPrepended)
    (\()
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
setEnv String
"PATH" String
pathVar)
    (forall a b. a -> b -> a
const PlotM a
f)

-- | Throw an error that halts the execution of pandoc-plot due to a strict-mode.
throwStrictError :: Text -> PlotM ()
throwStrictError :: Text -> StateT PlotState (ReaderT RuntimeEnv IO) ()
throwStrictError Text
msg = do
  forall (m :: * -> *). (MonadLogger m, MonadIO m) => Text -> m ()
strict Text
msg
  Logger
logger <- forall (m :: * -> *). MonadLogger m => m Logger
askLogger
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Logger -> IO ()
terminateLogging Logger
logger forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. IO a
exitFailure

-- 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.
type FileHash = Word

data PlotState
  = PlotState
      (MVar (Map FilePath FileHash))

-- | 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 :: String -> PlotM FileHash
fileHash String
path = do
  PlotState MVar (Map String FileHash)
varHashes <- forall s (m :: * -> *). MonadState s m => m s
get
  Map String FileHash
hashes <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
takeMVar MVar (Map String FileHash)
varHashes
  (FileHash
fh, Map String FileHash
hashes') <- case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
path Map String FileHash
hashes of
    Maybe FileHash
Nothing -> do
      forall (m :: * -> *). (MonadLogger m, MonadIO m) => Text -> m ()
debug forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Text
"Calculating hash of dependency ", String -> Text
pack String
path]
      FileHash
fh <- String -> PlotM FileHash
fileHash' String
path
      let hashes' :: Map String FileHash
hashes' = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
path FileHash
fh Map String FileHash
hashes
      forall (m :: * -> *) a. Monad m => a -> m a
return (FileHash
fh, Map String FileHash
hashes')
    Just FileHash
h -> do
      forall (m :: * -> *). (MonadLogger m, MonadIO m) => Text -> m ()
debug forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Text
"Hash of dependency ", String -> Text
pack String
path, Text
" already calculated."]
      forall (m :: * -> *) a. Monad m => a -> m a
return (FileHash
h, Map String FileHash
hashes)
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar (Map String FileHash)
varHashes Map String FileHash
hashes'
  forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ MVar (Map String FileHash) -> PlotState
PlotState MVar (Map String FileHash)
varHashes
  forall (m :: * -> *) a. Monad m => a -> m a
return FileHash
fh
  where
    -- As a proxy for the state of a file dependency, we use the modification time
    -- This is much faster than actual file hashing
    fileHash' :: FilePath -> PlotM FileHash
    fileHash' :: String -> PlotM FileHash
fileHash' String
fp = do
      Bool
fileExists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
fp
      if Bool
fileExists
        then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Hashable a => a -> Int
hash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO UTCTime
getModificationTime forall a b. (a -> b) -> a -> b
$ String
fp
        else forall (m :: * -> *). (MonadLogger m, MonadIO m) => Text -> m ()
err (forall a. Monoid a => [a] -> a
mconcat [Text
"Dependency ", String -> Text
pack String
fp, Text
" does not exist."]) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return FileHash
0

-- | Find an executable.
executable :: Toolkit -> PlotM Executable
executable :: Toolkit -> PlotM Executable
executable Toolkit
tk = Toolkit -> StateT PlotState (ReaderT RuntimeEnv IO) String
exeSelector Toolkit
tk forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Executable
exeFromPath
  where
    exeSelector :: Toolkit -> StateT PlotState (ReaderT RuntimeEnv IO) String
exeSelector Toolkit
Matplotlib = forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> String
matplotlibExe
    exeSelector Toolkit
PlotlyPython = forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> String
plotlyPythonExe
    exeSelector Toolkit
PlotlyR = forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> String
plotlyRExe
    exeSelector Toolkit
Matlab = forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> String
matlabExe
    exeSelector Toolkit
Mathematica = forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> String
mathematicaExe
    exeSelector Toolkit
Octave = forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> String
octaveExe
    exeSelector Toolkit
GGPlot2 = forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> String
ggplot2Exe
    exeSelector Toolkit
GNUPlot = forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> String
gnuplotExe
    exeSelector Toolkit
Graphviz = forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> String
graphvizExe
    exeSelector Toolkit
Bokeh = forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> String
bokehExe
    exeSelector Toolkit
Plotsjl = forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> String
plotsjlExe
    exeSelector Toolkit
PlantUML = forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> String
plantumlExe
    exeSelector Toolkit
SageMath = forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> String
sagemathExe

-- | The @Configuration@ type holds the default values to use
-- when running pandoc-plot. These values can be overridden in code blocks.
--
-- You can create an instance of the @Configuration@ type from file using the @configuration@ function.
--
-- You can store the path to a configuration file in metadata under the key @plot-configuration@. For example, in Markdown:
--
-- @
--     ---
--     title: My document
--     author: John Doe
--     plot-configuration: path\to\file.yml
--     ---
-- @
--
-- The same can be specified via the command line using Pandoc's @-M@ flag:
--
-- > pandoc --filter pandoc-plot -M plot-configuration="path/to/file.yml" ...
--
-- In this case, use @configurationPathMeta@ to extact the path from @Pandoc@ documents.
data Configuration = Configuration
  { -- | The default directory where figures will be saved.
    Configuration -> String
defaultDirectory :: !FilePath,
    -- | The default behavior of whether or not to include links to source code and high-res
    Configuration -> Bool
defaultWithSource :: !Bool,
    -- | The default dots-per-inch value for generated figures. Renderers might ignore this.
    Configuration -> Int
defaultDPI :: !Int,
    -- | The default save format of generated figures.
    Configuration -> SaveFormat
defaultSaveFormat :: !SaveFormat,
    -- | List of files/directories on which all figures depend.
    Configuration -> [String]
defaultDependencies :: ![FilePath],
    -- | Caption format, in the same notation as Pandoc format, e.g. "markdown+tex_math_dollars"
    Configuration -> Format
captionFormat :: !Format,
    -- | The text label to which the source code is linked. Change this if you are writing non-english documents.
    Configuration -> Text
sourceCodeLabel :: !Text,
    -- | Whether to halt pandoc-plot when an error is encountered or not.
    Configuration -> Bool
strictMode :: !Bool,
    -- | Level of logging verbosity.
    Configuration -> Verbosity
logVerbosity :: !Verbosity,
    -- | Method of logging, i.e. printing to stderr or file.
    Configuration -> LogSink
logSink :: !LogSink,
    -- | The default preamble script for the matplotlib toolkit.
    Configuration -> Text
matplotlibPreamble :: !Script,
    -- | The default preamble script for the Plotly/Python toolkit.
    Configuration -> Text
plotlyPythonPreamble :: !Script,
    -- | The default preamble script for the Plotly/R toolkit.
    Configuration -> Text
plotlyRPreamble :: !Script,
    -- | The default preamble script for the MATLAB toolkit.
    Configuration -> Text
matlabPreamble :: !Script,
    -- | The default preamble script for the Mathematica toolkit.
    Configuration -> Text
mathematicaPreamble :: !Script,
    -- | The default preamble script for the GNU Octave toolkit.
    Configuration -> Text
octavePreamble :: !Script,
    -- | The default preamble script for the GGPlot2 toolkit.
    Configuration -> Text
ggplot2Preamble :: !Script,
    -- | The default preamble script for the gnuplot toolkit.
    Configuration -> Text
gnuplotPreamble :: !Script,
    -- | The default preamble script for the Graphviz toolkit.
    Configuration -> Text
graphvizPreamble :: !Script,
    -- | The default preamble script for the Python/Bokeh toolkit.
    Configuration -> Text
bokehPreamble :: !Script,
    -- | The default preamble script for the Julia/Plots.jl toolkit.
    Configuration -> Text
plotsjlPreamble :: !Script,
    -- | The default preamble script for the PlantUML toolkit.
    Configuration -> Text
plantumlPreamble :: !Script,
    -- | The default preamble script for the SageMath toolkit.
    Configuration -> Text
sagemathPreamble :: !Script,
    -- | The executable to use to generate figures using the matplotlib toolkit.
    Configuration -> String
matplotlibExe :: !FilePath,
    -- | The executable to use to generate figures using the MATLAB toolkit.
    Configuration -> String
matlabExe :: !FilePath,
    -- | The executable to use to generate figures using the Plotly/Python toolkit.
    Configuration -> String
plotlyPythonExe :: !FilePath,
    -- | The executable to use to generate figures using the Plotly/R toolkit.
    Configuration -> String
plotlyRExe :: !FilePath,
    -- | The executable to use to generate figures using the Mathematica toolkit.
    Configuration -> String
mathematicaExe :: !FilePath,
    -- | The executable to use to generate figures using the GNU Octave toolkit.
    Configuration -> String
octaveExe :: !FilePath,
    -- | The executable to use to generate figures using the GGPlot2 toolkit.
    Configuration -> String
ggplot2Exe :: !FilePath,
    -- | The executable to use to generate figures using the gnuplot toolkit.
    Configuration -> String
gnuplotExe :: !FilePath,
    -- | The executable to use to generate figures using the Graphviz toolkit.
    Configuration -> String
graphvizExe :: !FilePath,
    -- | The executable to use to generate figures using the Python/Bokeh toolkit.
    Configuration -> String
bokehExe :: !FilePath,
    -- | The executable to use to generate figures using the Julia/Plots.jl toolkit.
    Configuration -> String
plotsjlExe :: !FilePath,
    -- | The executable to use to generate figures using the PlantUML toolkit.
    Configuration -> String
plantumlExe :: !FilePath,
    -- | The executable to use to generate figures using SageMath.
    Configuration -> String
sagemathExe :: !FilePath,
    -- | Command-line arguments to pass to the Python interpreter for the Matplotlib toolkit
    Configuration -> Text
matplotlibCmdArgs :: !Text,
    -- | Command-line arguments to pass to the interpreter for the MATLAB toolkit.
    Configuration -> Text
matlabCmdArgs :: !Text,
    -- | Command-line arguments to pass to the interpreter for the Plotly/Python toolkit.
    Configuration -> Text
plotlyPythonCmdArgs :: !Text,
    -- | Command-line arguments to pass to the interpreter for the Plotly/R toolkit.
    Configuration -> Text
plotlyRCmdArgs :: !Text,
    -- | Command-line arguments to pass to the interpreter for the Mathematica toolkit.
    Configuration -> Text
mathematicaCmdArgs :: !Text,
    -- | Command-line arguments to pass to the interpreter for the GNU Octave toolkit.
    Configuration -> Text
octaveCmdArgs :: !Text,
    -- | Command-line arguments to pass to the interpreter for the GGPlot2 toolkit.
    Configuration -> Text
ggplot2CmdArgs :: !Text,
    -- | Command-line arguments to pass to the interpreter for the gnuplot toolkit.
    Configuration -> Text
gnuplotCmdArgs :: !Text,
    -- | Command-line arguments to pass to the interpreter for the Graphviz toolkit.
    Configuration -> Text
graphvizCmdArgs :: !Text,
    -- | Command-line arguments to pass to the interpreter for the Python/Bokeh toolkit.
    Configuration -> Text
bokehCmdArgs :: !Text,
    -- | Command-line arguments to pass to the interpreter for the Julia/Plots.jl toolkit.
    Configuration -> Text
plotsjlCmdArgs :: !Text,
    -- | Command-line arguments to pass to the interpreter for the plantUML toolkit.
    Configuration -> Text
plantumlCmdArgs :: !Text,
    -- | Command-line arguments to pass to the interpreter for the SageMath toolkit.
    Configuration -> Text
sagemathCmdArgs :: !Text,
    -- | Whether or not to make Matplotlib figures tight by default.
    Configuration -> Bool
matplotlibTightBBox :: !Bool,
    -- | Whether or not to make Matplotlib figures transparent by default.
    Configuration -> Bool
matplotlibTransparent :: !Bool
  }
  deriving (Configuration -> Configuration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Configuration -> Configuration -> Bool
$c/= :: Configuration -> Configuration -> Bool
== :: Configuration -> Configuration -> Bool
$c== :: Configuration -> Configuration -> Bool
Eq, Int -> Configuration -> ShowS
[Configuration] -> ShowS
Configuration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Configuration] -> ShowS
$cshowList :: [Configuration] -> ShowS
show :: Configuration -> String
$cshow :: Configuration -> String
showsPrec :: Int -> Configuration -> ShowS
$cshowsPrec :: Int -> Configuration -> ShowS
Show)