{-# 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
    , preambleSelector
    , supportedSaveFormats
    , scriptChecks
    , parseExtraAttrs
    , command
    , capture
    , executable
    , toolkitAvailable
    , availableToolkits
    , availableToolkitsM
    , unavailableToolkits
    , unavailableToolkitsM
    , OutputSpec(..)
) 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.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.GGPlot2
import           Text.Pandoc.Filter.Plot.Renderers.GNUPlot
import           Text.Pandoc.Filter.Plot.Renderers.Graphviz
import           Text.Pandoc.Filter.Plot.Renderers.Prelude     (executable, OutputSpec(..))

import           Text.Pandoc.Filter.Plot.Monad


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

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


-- Make a string into a comment

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


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

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


-- | Save formats supported by this renderer.

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


-- 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 Matplotlib = [Text -> CheckResult
matplotlibCheckIfShow]
scriptChecks _ = [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 Matplotlib = Map Text Text -> Map Text Text
matplotlibExtraAttrs
parseExtraAttrs _          = 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
        -> PlotM Text
command :: Toolkit -> OutputSpec -> PlotM Text
command Matplotlib   = OutputSpec -> PlotM Text
matplotlibCommand
command PlotlyPython = OutputSpec -> PlotM Text
plotlyPythonCommand
command PlotlyR      = OutputSpec -> PlotM Text
plotlyRCommand
command Matlab       = OutputSpec -> PlotM Text
matlabCommand
command Mathematica  = OutputSpec -> PlotM Text
mathematicaCommand
command Octave       = OutputSpec -> PlotM Text
octaveCommand
command GGPlot2      = OutputSpec -> PlotM Text
ggplot2Command
command GNUPlot      = OutputSpec -> PlotM Text
gnuplotCommand
command Graphviz     = OutputSpec -> PlotM Text
graphvizCommand


-- | Script fragment required to capture a figure.

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


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

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


-- | 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 conf :: 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 conf :: Configuration
conf = Configuration -> PlotM [Toolkit] -> IO [Toolkit]
forall a. Configuration -> PlotM a -> IO a
runPlotM Configuration
conf PlotM [Toolkit]
unavailableToolkitsM


-- | Monadic version of @availableToolkits@.

availableToolkitsM :: PlotM [Toolkit]
availableToolkitsM :: PlotM [Toolkit]
availableToolkitsM = do
    [Maybe Toolkit]
mtks <- [Toolkit]
-> (Toolkit -> ReaderT RuntimeEnv IO (Maybe Toolkit))
-> 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 -> ReaderT RuntimeEnv IO (Maybe Toolkit))
 -> ReaderT RuntimeEnv IO [Maybe Toolkit])
-> (Toolkit -> ReaderT RuntimeEnv IO (Maybe Toolkit))
-> ReaderT RuntimeEnv IO [Maybe Toolkit]
forall a b. (a -> b) -> a -> b
$  \tk :: Toolkit
tk -> do
        Bool
available <- Toolkit -> PlotM Bool
toolkitAvailable Toolkit
tk
        if Bool
available
            then Maybe Toolkit -> ReaderT RuntimeEnv IO (Maybe Toolkit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Toolkit -> ReaderT RuntimeEnv IO (Maybe Toolkit))
-> Maybe Toolkit -> 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 -> 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