{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : $header$
-- Copyright   : (c) Laurent P René de Cotret, 2019 - present
-- License     : GNU GPL, version 2 or above
-- Maintainer  : [email protected]
-- Stability   : internal
-- Portability : portable
--
-- Specification of renderers.
module Text.Pandoc.Filter.Plot.Renderers
  ( renderer,
    preambleSelector,
    parseExtraAttrs,
    executable,
    availableToolkits,
    availableToolkitsM,
    unavailableToolkits,
    unavailableToolkitsM,
    supportedSaveFormats,
    OutputSpec (..),
    Executable (..),
    Renderer (..),
  )
where

import Control.Concurrent.Async.Lifted (forConcurrently)
import Control.Monad.Reader (local)
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.Directory (findExecutable)
import System.Exit (ExitCode (..))
import Text.Pandoc.Filter.Plot.Monad
import Text.Pandoc.Filter.Plot.Monad.Logging
  ( Logger (lVerbosity),
  )
import Text.Pandoc.Filter.Plot.Renderers.Bokeh
  ( bokeh,
    bokehSupportedSaveFormats,
  )
import Text.Pandoc.Filter.Plot.Renderers.D2
  ( d2,
    d2SupportedSaveFormats,
  )
import Text.Pandoc.Filter.Plot.Renderers.GGPlot2
  ( ggplot2,
    ggplot2SupportedSaveFormats,
  )
import Text.Pandoc.Filter.Plot.Renderers.GNUPlot
  ( gnuplot,
    gnuplotSupportedSaveFormats,
  )
import Text.Pandoc.Filter.Plot.Renderers.Graphviz
  ( graphviz,
    graphvizSupportedSaveFormats,
  )
import Text.Pandoc.Filter.Plot.Renderers.Mathematica
  ( mathematica,
    mathematicaSupportedSaveFormats,
  )
import Text.Pandoc.Filter.Plot.Renderers.Matlab
  ( matlab,
    matlabSupportedSaveFormats,
  )
import Text.Pandoc.Filter.Plot.Renderers.Matplotlib
  ( matplotlib,
    matplotlibSupportedSaveFormats,
  )
import Text.Pandoc.Filter.Plot.Renderers.Octave
  ( octave,
    octaveSupportedSaveFormats,
  )
import Text.Pandoc.Filter.Plot.Renderers.PlantUML
  ( plantuml,
    plantumlSupportedSaveFormats,
  )
import Text.Pandoc.Filter.Plot.Renderers.PlotlyPython
  ( plotlyPython,
    plotlyPythonSupportedSaveFormats,
  )
import Text.Pandoc.Filter.Plot.Renderers.PlotlyR
  ( plotlyR,
    plotlyRSupportedSaveFormats,
  )
import Text.Pandoc.Filter.Plot.Renderers.Plotsjl
  ( plotsjl,
    plotsjlSupportedSaveFormats,
  )
import Text.Pandoc.Filter.Plot.Renderers.SageMath
  ( sagemath,
    sagemathSupportedSaveFormats,
  )
import Text.Pandoc.Filter.Plot.Renderers.Asymptote
  ( asymptote,
    asymptoteSupportedSaveFormats,
  )
import Text.Pandoc.Filter.Plot.Renderers.Mermaid
  ( mermaid,
    mermaidSupportedSaveFormats,
  )
-- | 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 Renderer
renderer :: Toolkit -> PlotM Renderer
renderer Toolkit
Matplotlib = PlotM Renderer
matplotlib
renderer Toolkit
PlotlyPython = PlotM Renderer
plotlyPython
renderer Toolkit
PlotlyR = PlotM Renderer
plotlyR
renderer Toolkit
Matlab = PlotM Renderer
matlab
renderer Toolkit
Mathematica = PlotM Renderer
mathematica
renderer Toolkit
Octave = PlotM Renderer
octave
renderer Toolkit
GGPlot2 = PlotM Renderer
ggplot2
renderer Toolkit
GNUPlot = PlotM Renderer
gnuplot
renderer Toolkit
Graphviz = PlotM Renderer
graphviz
renderer Toolkit
Bokeh = PlotM Renderer
bokeh
renderer Toolkit
Plotsjl = PlotM Renderer
plotsjl
renderer Toolkit
PlantUML = PlotM Renderer
plantuml
renderer Toolkit
SageMath = PlotM Renderer
sagemath
renderer Toolkit
D2 = PlotM Renderer
d2
renderer Toolkit
Asymptote = PlotM Renderer
asymptote
renderer Toolkit
Mermaid = PlotM Renderer
mermaid

-- | 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
supportedSaveFormats Toolkit
PlantUML = [SaveFormat]
plantumlSupportedSaveFormats
supportedSaveFormats Toolkit
SageMath = [SaveFormat]
sagemathSupportedSaveFormats
supportedSaveFormats Toolkit
D2 = [SaveFormat]
d2SupportedSaveFormats
supportedSaveFormats Toolkit
Asymptote = [SaveFormat]
asymptoteSupportedSaveFormats
supportedSaveFormats Toolkit
Mermaid = [SaveFormat]
mermaidSupportedSaveFormats

-- | 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
preambleSelector Toolkit
PlantUML = Configuration -> Text
plantumlPreamble
preambleSelector Toolkit
SageMath = Configuration -> Text
sagemathPreamble
preambleSelector Toolkit
D2 = Configuration -> Text
d2Preamble
preambleSelector Toolkit
Asymptote = Configuration -> Text
asyPreamble
preambleSelector Toolkit
Mermaid = Configuration -> Text
mermaidPreamble

-- | 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 =
  (Text -> Text -> Bool) -> Map Text Text -> Map Text Text
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey
    ( \Text
k Text
_ ->
        Text
k
          Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ InclusionKey -> String
forall a. Show a => a -> String
show InclusionKey
MatplotlibTightBBoxK,
                   String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ InclusionKey -> String
forall a. Show a => a -> String
show InclusionKey
MatplotlibTransparentK
                 ]
    )
parseExtraAttrs Toolkit
_ = Map Text Text -> Map Text Text -> Map Text Text
forall a. a -> Map Text Text -> a
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text Text
forall a. Monoid a => a
mempty

-- | 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 = Maybe Format -> Configuration -> PlotM [Toolkit] -> IO [Toolkit]
forall a. Maybe Format -> Configuration -> PlotM a -> IO a
runPlotM Maybe Format
forall a. Maybe a
Nothing 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 = Maybe Format -> Configuration -> PlotM [Toolkit] -> IO [Toolkit]
forall a. Maybe Format -> Configuration -> PlotM a -> IO a
runPlotM Maybe Format
forall a. Maybe a
Nothing 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}.
StateT PlotState (ReaderT RuntimeEnv IO) a
-> StateT PlotState (ReaderT RuntimeEnv IO) a
asNonStrictAndSilent (PlotM [Toolkit] -> PlotM [Toolkit])
-> PlotM [Toolkit] -> PlotM [Toolkit]
forall a b. (a -> b) -> a -> b
$ do
  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
    r <- Toolkit -> PlotM Renderer
renderer Toolkit
tk
    exe <- executable tk
    a <- isAvailable exe (rendererAvailability r)
    if a
      then return $ Just tk
      else return Nothing
  return $ catMaybes mtks
  where
    asNonStrictAndSilent :: StateT PlotState (ReaderT RuntimeEnv IO) a
-> StateT PlotState (ReaderT RuntimeEnv IO) a
asNonStrictAndSilent = (RuntimeEnv -> RuntimeEnv)
-> StateT PlotState (ReaderT RuntimeEnv IO) a
-> StateT PlotState (ReaderT RuntimeEnv IO) a
forall a.
(RuntimeEnv -> RuntimeEnv)
-> StateT PlotState (ReaderT RuntimeEnv IO) a
-> StateT PlotState (ReaderT RuntimeEnv IO) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\(RuntimeEnv Maybe Format
f Configuration
c Logger
l String
d MVar ()
s) -> Maybe Format
-> Configuration -> Logger -> String -> MVar () -> RuntimeEnv
RuntimeEnv Maybe Format
f (Configuration
c {strictMode = False}) (Logger
l {lVerbosity = Silent}) String
d MVar ()
s)

    -- \| Check that the supplied command results in
    -- an exit code of 0 (i.e. no errors)
    commandSuccess :: Text -> PlotM Bool
    commandSuccess :: Text -> PlotM Bool
commandSuccess Text
s = do
      cwd <- (RuntimeEnv -> String)
-> StateT PlotState (ReaderT RuntimeEnv IO) String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RuntimeEnv -> String
envCWD
      (ec, _) <- runCommand cwd s
      debug $ mconcat ["Command ", s, " resulted in ", pack $ show ec]
      return $ ec == ExitSuccess

    isAvailable :: Executable -> AvailabilityCheck -> PlotM Bool
    isAvailable :: Executable -> AvailabilityCheck -> PlotM Bool
isAvailable Executable
exe (CommandSuccess Executable -> Text
f) = Text -> PlotM Bool
commandSuccess (Executable -> Text
f Executable
exe)
    isAvailable Executable
exe AvailabilityCheck
ExecutableExists = IO Bool -> PlotM Bool
forall a. IO a -> StateT PlotState (ReaderT RuntimeEnv IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> PlotM Bool) -> IO Bool -> PlotM Bool
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
findExecutable (Executable -> String
pathToExe Executable
exe) IO (Maybe String) -> (Maybe String -> Bool) -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Maybe String -> Bool
forall a. Maybe a -> Bool
isJust

-- | 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