{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- |

-- Module      : $header$

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

-- License     : GNU GPL, version 2 or above

-- Maintainer  : laurent.decotret@outlook.com

-- Stability   : internal

-- Portability : portable

--

-- Specification of renderers.

module Text.Pandoc.Filter.Plot.Renderers
  ( scriptExtension,
    comment,
    language,
    preambleSelector,
    supportedSaveFormats,
    scriptChecks,
    parseExtraAttrs,
    command,
    capture,
    executable,
    toolkitAvailable,
    availableToolkits,
    availableToolkitsM,
    unavailableToolkits,
    unavailableToolkitsM,
    OutputSpec (..),
    Executable (..),
  )
where

import Control.Concurrent.Async.Lifted (forConcurrently)
import Data.List ((\\))
import Data.Map.Strict (Map)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Text.Pandoc.Filter.Plot.Monad
import Text.Pandoc.Filter.Plot.Renderers.Bokeh
import Text.Pandoc.Filter.Plot.Renderers.GGPlot2
import Text.Pandoc.Filter.Plot.Renderers.GNUPlot
import Text.Pandoc.Filter.Plot.Renderers.Graphviz
import Text.Pandoc.Filter.Plot.Renderers.Mathematica
import Text.Pandoc.Filter.Plot.Renderers.Matlab
import Text.Pandoc.Filter.Plot.Renderers.Matplotlib
import Text.Pandoc.Filter.Plot.Renderers.Octave
import Text.Pandoc.Filter.Plot.Renderers.PlotlyPython
import Text.Pandoc.Filter.Plot.Renderers.PlotlyR
import Text.Pandoc.Filter.Plot.Renderers.Plotsjl
import Text.Pandoc.Filter.Plot.Renderers.Prelude (OutputSpec (..))

-- Extension for script files, e.g. ".py", or ".m".

scriptExtension :: Toolkit -> String
scriptExtension :: Toolkit -> String
scriptExtension Toolkit
Matplotlib = String
".py"
scriptExtension Toolkit
PlotlyPython = String
".py"
scriptExtension Toolkit
PlotlyR = String
".r"
scriptExtension Toolkit
Matlab = String
".m"
scriptExtension Toolkit
Mathematica = String
".m"
scriptExtension Toolkit
Octave = String
".m"
scriptExtension Toolkit
GGPlot2 = String
".r"
scriptExtension Toolkit
GNUPlot = String
".gp"
scriptExtension Toolkit
Graphviz = String
".dot"
scriptExtension Toolkit
Bokeh = String
".py"
scriptExtension Toolkit
Plotsjl = String
".jl"

-- | Language that is used by a toolkit. Specifically used

-- to highlight the appropriate language in the external source code.

language :: Toolkit -> Text
language :: Toolkit -> Text
language Toolkit
Matplotlib = Text
"python"
language Toolkit
PlotlyPython = Text
"python"
language Toolkit
PlotlyR = Text
"r"
language Toolkit
Matlab = Text
"matlab"
language Toolkit
Mathematica = Text
"mathematica"
language Toolkit
Octave = Text
"matlab"
language Toolkit
GGPlot2 = Text
"r"
language Toolkit
GNUPlot = Text
"gnuplot"
language Toolkit
Graphviz = Text
"dot"
language Toolkit
Bokeh = Text
"python"
language Toolkit
Plotsjl = Text
"julia"

-- Make a string into a comment

comment :: Toolkit -> (Text -> Text)
comment :: Toolkit -> Text -> Text
comment Toolkit
Matplotlib = Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"# "
comment Toolkit
PlotlyPython = Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"# "
comment Toolkit
PlotlyR = Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"# "
comment Toolkit
Matlab = Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"% "
comment Toolkit
Mathematica = \Text
t -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"(*", Text
t, Text
"*)"]
comment Toolkit
Octave = Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"% "
comment Toolkit
GGPlot2 = Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"# "
comment Toolkit
GNUPlot = Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"# "
comment Toolkit
Graphviz = Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"// "
comment Toolkit
Bokeh = Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"# "
comment Toolkit
Plotsjl = Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"# "

-- | The function that maps from configuration to the preamble.

preambleSelector :: Toolkit -> (Configuration -> Script)
preambleSelector :: Toolkit -> Configuration -> Text
preambleSelector Toolkit
Matplotlib = Configuration -> Text
matplotlibPreamble
preambleSelector Toolkit
PlotlyPython = Configuration -> Text
plotlyPythonPreamble
preambleSelector Toolkit
PlotlyR = Configuration -> Text
plotlyRPreamble
preambleSelector Toolkit
Matlab = Configuration -> Text
matlabPreamble
preambleSelector Toolkit
Mathematica = Configuration -> Text
mathematicaPreamble
preambleSelector Toolkit
Octave = Configuration -> Text
octavePreamble
preambleSelector Toolkit
GGPlot2 = Configuration -> Text
ggplot2Preamble
preambleSelector Toolkit
GNUPlot = Configuration -> Text
gnuplotPreamble
preambleSelector Toolkit
Graphviz = Configuration -> Text
graphvizPreamble
preambleSelector Toolkit
Bokeh = Configuration -> Text
bokehPreamble
preambleSelector Toolkit
Plotsjl = Configuration -> Text
plotsjlPreamble

-- | Save formats supported by this renderer.

supportedSaveFormats :: Toolkit -> [SaveFormat]
supportedSaveFormats :: Toolkit -> [SaveFormat]
supportedSaveFormats Toolkit
Matplotlib = [SaveFormat]
matplotlibSupportedSaveFormats
supportedSaveFormats Toolkit
PlotlyPython = [SaveFormat]
plotlyPythonSupportedSaveFormats
supportedSaveFormats Toolkit
PlotlyR = [SaveFormat]
plotlyRSupportedSaveFormats
supportedSaveFormats Toolkit
Matlab = [SaveFormat]
matlabSupportedSaveFormats
supportedSaveFormats Toolkit
Mathematica = [SaveFormat]
mathematicaSupportedSaveFormats
supportedSaveFormats Toolkit
Octave = [SaveFormat]
octaveSupportedSaveFormats
supportedSaveFormats Toolkit
GGPlot2 = [SaveFormat]
ggplot2SupportedSaveFormats
supportedSaveFormats Toolkit
GNUPlot = [SaveFormat]
gnuplotSupportedSaveFormats
supportedSaveFormats Toolkit
Graphviz = [SaveFormat]
graphvizSupportedSaveFormats
supportedSaveFormats Toolkit
Bokeh = [SaveFormat]
bokehSupportedSaveFormats
supportedSaveFormats Toolkit
Plotsjl = [SaveFormat]
plotsjlSupportedSaveFormats

-- Checks to perform before running a script. If ANY check fails,

-- the figure is not rendered. This is to prevent, for example,

-- blocking operations to occur.

scriptChecks :: Toolkit -> [Script -> CheckResult]
scriptChecks :: Toolkit -> [Text -> CheckResult]
scriptChecks Toolkit
Matplotlib = [Text -> CheckResult
matplotlibCheckIfShow]
scriptChecks Toolkit
Bokeh = [Text -> CheckResult
bokehCheckIfShow]
scriptChecks Toolkit
_ = [Text -> CheckResult]
forall a. Monoid a => a
mempty

-- | Parse code block headers for extra attributes that are specific

-- to this renderer. By default, no extra attributes are parsed.

parseExtraAttrs :: Toolkit -> Map Text Text -> Map Text Text
parseExtraAttrs :: Toolkit -> Map Text Text -> Map Text Text
parseExtraAttrs Toolkit
Matplotlib = Map Text Text -> Map Text Text
matplotlibExtraAttrs
parseExtraAttrs Toolkit
_ = Map Text Text -> Map Text Text -> Map Text Text
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text Text
forall a. Monoid a => a
mempty

-- | Generate the appropriate command-line command to generate a figure.

-- The executable will need to be found first, hence the IO monad.

command ::
  Toolkit ->
  OutputSpec ->
  Text -> -- Executable name (e.g. "python3")

  Text
command :: Toolkit -> OutputSpec -> Text -> Text
command Toolkit
Matplotlib = OutputSpec -> Text -> Text
matplotlibCommand
command Toolkit
PlotlyPython = OutputSpec -> Text -> Text
plotlyPythonCommand
command Toolkit
PlotlyR = OutputSpec -> Text -> Text
plotlyRCommand
command Toolkit
Matlab = OutputSpec -> Text -> Text
matlabCommand
command Toolkit
Mathematica = OutputSpec -> Text -> Text
mathematicaCommand
command Toolkit
Octave = OutputSpec -> Text -> Text
octaveCommand
command Toolkit
GGPlot2 = OutputSpec -> Text -> Text
ggplot2Command
command Toolkit
GNUPlot = OutputSpec -> Text -> Text
gnuplotCommand
command Toolkit
Graphviz = OutputSpec -> Text -> Text
graphvizCommand
command Toolkit
Bokeh = OutputSpec -> Text -> Text
bokehCommand
command Toolkit
Plotsjl = OutputSpec -> Text -> Text
plotsjlCommand

-- | Script fragment required to capture a figure.

capture :: Toolkit -> (FigureSpec -> FilePath -> Script)
capture :: Toolkit -> FigureSpec -> String -> Text
capture Toolkit
Matplotlib = FigureSpec -> String -> Text
matplotlibCapture
capture Toolkit
PlotlyPython = FigureSpec -> String -> Text
plotlyPythonCapture
capture Toolkit
PlotlyR = FigureSpec -> String -> Text
plotlyRCapture
capture Toolkit
Matlab = FigureSpec -> String -> Text
matlabCapture
capture Toolkit
Mathematica = FigureSpec -> String -> Text
mathematicaCapture
capture Toolkit
Octave = FigureSpec -> String -> Text
octaveCapture
capture Toolkit
GGPlot2 = FigureSpec -> String -> Text
ggplot2Capture
capture Toolkit
GNUPlot = FigureSpec -> String -> Text
gnuplotCapture
capture Toolkit
Graphviz = FigureSpec -> String -> Text
graphvizCapture
capture Toolkit
Bokeh = FigureSpec -> String -> Text
bokehCapture
capture Toolkit
Plotsjl = FigureSpec -> String -> Text
plotsjlCapture

-- | Check if a toolkit is available, based on the current configuration

toolkitAvailable :: Toolkit -> PlotM Bool
toolkitAvailable :: Toolkit -> PlotM Bool
toolkitAvailable Toolkit
Matplotlib = PlotM Bool
matplotlibAvailable
toolkitAvailable Toolkit
PlotlyPython = PlotM Bool
plotlyPythonAvailable
toolkitAvailable Toolkit
PlotlyR = PlotM Bool
plotlyRAvailable
toolkitAvailable Toolkit
Matlab = PlotM Bool
matlabAvailable
toolkitAvailable Toolkit
Mathematica = PlotM Bool
mathematicaAvailable
toolkitAvailable Toolkit
Octave = PlotM Bool
octaveAvailable
toolkitAvailable Toolkit
GGPlot2 = PlotM Bool
ggplot2Available
toolkitAvailable Toolkit
GNUPlot = PlotM Bool
gnuplotAvailable
toolkitAvailable Toolkit
Graphviz = PlotM Bool
graphvizAvailable
toolkitAvailable Toolkit
Bokeh = PlotM Bool
bokehAvailable
toolkitAvailable Toolkit
Plotsjl = PlotM Bool
plotsjlAvailable

-- | List of toolkits available on this machine.

-- The executables to look for are taken from the configuration.

availableToolkits :: Configuration -> IO [Toolkit]
availableToolkits :: Configuration -> IO [Toolkit]
availableToolkits Configuration
conf = Configuration -> PlotM [Toolkit] -> IO [Toolkit]
forall a. Configuration -> PlotM a -> IO a
runPlotM Configuration
conf PlotM [Toolkit]
availableToolkitsM

-- | List of toolkits not available on this machine.

-- The executables to look for are taken from the configur

unavailableToolkits :: Configuration -> IO [Toolkit]
unavailableToolkits :: Configuration -> IO [Toolkit]
unavailableToolkits Configuration
conf = Configuration -> PlotM [Toolkit] -> IO [Toolkit]
forall a. Configuration -> PlotM a -> IO a
runPlotM Configuration
conf PlotM [Toolkit]
unavailableToolkitsM

-- | Monadic version of @availableToolkits@.

--

-- Note that logging is disabled

availableToolkitsM :: PlotM [Toolkit]
availableToolkitsM :: PlotM [Toolkit]
availableToolkitsM = PlotM [Toolkit] -> PlotM [Toolkit]
forall a. PlotM a -> PlotM a
silence (PlotM [Toolkit] -> PlotM [Toolkit])
-> PlotM [Toolkit] -> PlotM [Toolkit]
forall a b. (a -> b) -> a -> b
$ do
  [Maybe Toolkit]
mtks <- [Toolkit]
-> (Toolkit
    -> StateT PlotState (ReaderT RuntimeEnv IO) (Maybe Toolkit))
-> StateT PlotState (ReaderT RuntimeEnv IO) [Maybe Toolkit]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, MonadBaseControl IO m) =>
t a -> (a -> m b) -> m (t b)
forConcurrently [Toolkit]
toolkits ((Toolkit
  -> StateT PlotState (ReaderT RuntimeEnv IO) (Maybe Toolkit))
 -> StateT PlotState (ReaderT RuntimeEnv IO) [Maybe Toolkit])
-> (Toolkit
    -> StateT PlotState (ReaderT RuntimeEnv IO) (Maybe Toolkit))
-> StateT PlotState (ReaderT RuntimeEnv IO) [Maybe Toolkit]
forall a b. (a -> b) -> a -> b
$ \Toolkit
tk -> do
    Bool
available <- Toolkit -> PlotM Bool
toolkitAvailable Toolkit
tk
    if Bool
available
      then Maybe Toolkit
-> StateT PlotState (ReaderT RuntimeEnv IO) (Maybe Toolkit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Toolkit
 -> StateT PlotState (ReaderT RuntimeEnv IO) (Maybe Toolkit))
-> Maybe Toolkit
-> StateT PlotState (ReaderT RuntimeEnv IO) (Maybe Toolkit)
forall a b. (a -> b) -> a -> b
$ Toolkit -> Maybe Toolkit
forall a. a -> Maybe a
Just Toolkit
tk
      else Maybe Toolkit
-> StateT PlotState (ReaderT RuntimeEnv IO) (Maybe Toolkit)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Toolkit
forall a. Maybe a
Nothing
  [Toolkit] -> PlotM [Toolkit]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Toolkit] -> PlotM [Toolkit]) -> [Toolkit] -> PlotM [Toolkit]
forall a b. (a -> b) -> a -> b
$ [Maybe Toolkit] -> [Toolkit]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Toolkit]
mtks

-- | Monadic version of @unavailableToolkits@

unavailableToolkitsM :: PlotM [Toolkit]
unavailableToolkitsM :: PlotM [Toolkit]
unavailableToolkitsM = [Toolkit] -> [Toolkit] -> [Toolkit]
forall a. Eq a => [a] -> [a] -> [a]
(\\) [Toolkit]
toolkits ([Toolkit] -> [Toolkit]) -> PlotM [Toolkit] -> PlotM [Toolkit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlotM [Toolkit]
availableToolkitsM