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

-- |
-- 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 base types in use in pandoc-plot
module Text.Pandoc.Filter.Plot.Monad.Types
  ( Toolkit (..),
    Renderer (..),
    AvailabilityCheck(..),
    Script,
    CheckResult (..),
    InclusionKey (..),
    FigureSpec (..),
    OutputSpec (..),
    SaveFormat (..),
    cls,
    extension,
    toolkits,
    inclusionKeys,
    Executable (..),
    exeFromPath,
    pathToExe,
    -- Utilities
    isWindows,
  )
where

import Data.Char (toLower)
import Data.List (intersperse)
import Data.String (IsString (..))
import Data.Text (Text, pack, unpack)
import Data.Yaml (FromJSON(..), ToJSON (toJSON), withText)
import GHC.Generics (Generic)
import System.FilePath (splitFileName, (</>), isAbsolute)
import System.Info (os)
import Text.Pandoc.Definition (Attr)

-- | List of supported toolkits.
toolkits :: [Toolkit]
toolkits :: [Toolkit]
toolkits = forall a. Enum a => a -> a -> [a]
enumFromTo forall a. Bounded a => a
minBound forall a. Bounded a => a
maxBound

-- | Enumeration of supported toolkits
data Toolkit
  = Matplotlib
  | Matlab
  | PlotlyPython
  | PlotlyR
  | Mathematica
  | Octave
  | GGPlot2
  | GNUPlot
  | Graphviz
  | Bokeh
  | Plotsjl
  | PlantUML
  | SageMath
  deriving (Toolkit
forall a. a -> a -> Bounded a
maxBound :: Toolkit
$cmaxBound :: Toolkit
minBound :: Toolkit
$cminBound :: Toolkit
Bounded, Toolkit -> Toolkit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Toolkit -> Toolkit -> Bool
$c/= :: Toolkit -> Toolkit -> Bool
== :: Toolkit -> Toolkit -> Bool
$c== :: Toolkit -> Toolkit -> Bool
Eq, Int -> Toolkit
Toolkit -> Int
Toolkit -> [Toolkit]
Toolkit -> Toolkit
Toolkit -> Toolkit -> [Toolkit]
Toolkit -> Toolkit -> Toolkit -> [Toolkit]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Toolkit -> Toolkit -> Toolkit -> [Toolkit]
$cenumFromThenTo :: Toolkit -> Toolkit -> Toolkit -> [Toolkit]
enumFromTo :: Toolkit -> Toolkit -> [Toolkit]
$cenumFromTo :: Toolkit -> Toolkit -> [Toolkit]
enumFromThen :: Toolkit -> Toolkit -> [Toolkit]
$cenumFromThen :: Toolkit -> Toolkit -> [Toolkit]
enumFrom :: Toolkit -> [Toolkit]
$cenumFrom :: Toolkit -> [Toolkit]
fromEnum :: Toolkit -> Int
$cfromEnum :: Toolkit -> Int
toEnum :: Int -> Toolkit
$ctoEnum :: Int -> Toolkit
pred :: Toolkit -> Toolkit
$cpred :: Toolkit -> Toolkit
succ :: Toolkit -> Toolkit
$csucc :: Toolkit -> Toolkit
Enum, forall x. Rep Toolkit x -> Toolkit
forall x. Toolkit -> Rep Toolkit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Toolkit x -> Toolkit
$cfrom :: forall x. Toolkit -> Rep Toolkit x
Generic, Eq Toolkit
Toolkit -> Toolkit -> Bool
Toolkit -> Toolkit -> Ordering
Toolkit -> Toolkit -> Toolkit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Toolkit -> Toolkit -> Toolkit
$cmin :: Toolkit -> Toolkit -> Toolkit
max :: Toolkit -> Toolkit -> Toolkit
$cmax :: Toolkit -> Toolkit -> Toolkit
>= :: Toolkit -> Toolkit -> Bool
$c>= :: Toolkit -> Toolkit -> Bool
> :: Toolkit -> Toolkit -> Bool
$c> :: Toolkit -> Toolkit -> Bool
<= :: Toolkit -> Toolkit -> Bool
$c<= :: Toolkit -> Toolkit -> Bool
< :: Toolkit -> Toolkit -> Bool
$c< :: Toolkit -> Toolkit -> Bool
compare :: Toolkit -> Toolkit -> Ordering
$ccompare :: Toolkit -> Toolkit -> Ordering
Ord)

-- | This instance should only be used to display toolkit names
instance Show Toolkit where
  show :: Toolkit -> String
show Toolkit
Matplotlib = String
"Python/Matplotlib"
  show Toolkit
Matlab = String
"MATLAB"
  show Toolkit
PlotlyPython = String
"Python/Plotly"
  show Toolkit
PlotlyR = String
"R/Plotly"
  show Toolkit
Mathematica = String
"Mathematica"
  show Toolkit
Octave = String
"GNU Octave"
  show Toolkit
GGPlot2 = String
"ggplot2"
  show Toolkit
GNUPlot = String
"gnuplot"
  show Toolkit
Graphviz = String
"graphviz"
  show Toolkit
Bokeh = String
"Python/Bokeh"
  show Toolkit
Plotsjl = String
"Julia/Plots.jl"
  show Toolkit
PlantUML = String
"PlantUML"
  show Toolkit
SageMath = String
"SageMath"

-- | Class name which will trigger the filter
cls :: Toolkit -> Text
cls :: Toolkit -> Text
cls Toolkit
Matplotlib = Text
"matplotlib"
cls Toolkit
Matlab = Text
"matlabplot"
cls Toolkit
PlotlyPython = Text
"plotly_python"
cls Toolkit
PlotlyR = Text
"plotly_r"
cls Toolkit
Mathematica = Text
"mathplot"
cls Toolkit
Octave = Text
"octaveplot"
cls Toolkit
GGPlot2 = Text
"ggplot2"
cls Toolkit
GNUPlot = Text
"gnuplot"
cls Toolkit
Graphviz = Text
"graphviz"
cls Toolkit
Bokeh = Text
"bokeh"
cls Toolkit
Plotsjl = Text
"plotsjl"
cls Toolkit
PlantUML = Text
"plantuml"
cls Toolkit
SageMath = Text
"sageplot"

-- | Executable program, and sometimes the directory where it can be found.
data Executable 
  = AbsExe FilePath Text
  | RelExe Text

exeFromPath :: FilePath -> Executable
exeFromPath :: String -> Executable
exeFromPath String
fp
  | String -> Bool
isAbsolute String
fp = let (String
dir, String
name) = String -> (String, String)
splitFileName String
fp
                     in String -> Text -> Executable
AbsExe String
dir (String -> Text
pack String
name)
  | Bool
otherwise     = Text -> Executable
RelExe (String -> Text
pack String
fp) 

pathToExe :: Executable -> FilePath
pathToExe :: Executable -> String
pathToExe (AbsExe String
dir Text
name) = String
dir String -> ShowS
</> Text -> String
unpack Text
name 
pathToExe (RelExe Text
name)            = Text -> String
unpack Text
name

-- | Source context for plotting scripts
type Script = Text

-- | Result of checking scripts for problems
data CheckResult
  = CheckPassed
  | CheckFailed Text
  deriving (CheckResult -> CheckResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckResult -> CheckResult -> Bool
$c/= :: CheckResult -> CheckResult -> Bool
== :: CheckResult -> CheckResult -> Bool
$c== :: CheckResult -> CheckResult -> Bool
Eq)

instance Semigroup CheckResult where
  <> :: CheckResult -> CheckResult -> CheckResult
(<>) CheckResult
CheckPassed CheckResult
a = CheckResult
a
  (<>) CheckResult
a CheckResult
CheckPassed = CheckResult
a
  (<>) (CheckFailed Text
msg1) (CheckFailed Text
msg2) = Text -> CheckResult
CheckFailed (Text
msg1 forall a. Semigroup a => a -> a -> a
<> Text
msg2)

instance Monoid CheckResult where
  mempty :: CheckResult
mempty = CheckResult
CheckPassed

-- | Description of any possible inclusion key, both in documents
-- and in configuration files.
data InclusionKey
  = DirectoryK
  | CaptionK
  | SaveFormatK
  | WithSourceK
  | CaptionFormatK
  | PreambleK
  | DpiK
  | SourceCodeLabelK
  | StrictModeK
  | ExecutableK
  | CommandLineArgsK
  | DependenciesK
  | FileK
  | MatplotlibTightBBoxK
  | MatplotlibTransparentK
  deriving (InclusionKey
forall a. a -> a -> Bounded a
maxBound :: InclusionKey
$cmaxBound :: InclusionKey
minBound :: InclusionKey
$cminBound :: InclusionKey
Bounded, InclusionKey -> InclusionKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InclusionKey -> InclusionKey -> Bool
$c/= :: InclusionKey -> InclusionKey -> Bool
== :: InclusionKey -> InclusionKey -> Bool
$c== :: InclusionKey -> InclusionKey -> Bool
Eq, Int -> InclusionKey
InclusionKey -> Int
InclusionKey -> [InclusionKey]
InclusionKey -> InclusionKey
InclusionKey -> InclusionKey -> [InclusionKey]
InclusionKey -> InclusionKey -> InclusionKey -> [InclusionKey]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: InclusionKey -> InclusionKey -> InclusionKey -> [InclusionKey]
$cenumFromThenTo :: InclusionKey -> InclusionKey -> InclusionKey -> [InclusionKey]
enumFromTo :: InclusionKey -> InclusionKey -> [InclusionKey]
$cenumFromTo :: InclusionKey -> InclusionKey -> [InclusionKey]
enumFromThen :: InclusionKey -> InclusionKey -> [InclusionKey]
$cenumFromThen :: InclusionKey -> InclusionKey -> [InclusionKey]
enumFrom :: InclusionKey -> [InclusionKey]
$cenumFrom :: InclusionKey -> [InclusionKey]
fromEnum :: InclusionKey -> Int
$cfromEnum :: InclusionKey -> Int
toEnum :: Int -> InclusionKey
$ctoEnum :: Int -> InclusionKey
pred :: InclusionKey -> InclusionKey
$cpred :: InclusionKey -> InclusionKey
succ :: InclusionKey -> InclusionKey
$csucc :: InclusionKey -> InclusionKey
Enum)

-- | Keys that pandoc-plot will look for in code blocks.
-- These are only exported for testing purposes.
instance Show InclusionKey where
  show :: InclusionKey -> String
show InclusionKey
DirectoryK = String
"directory"
  show InclusionKey
CaptionK = String
"caption"
  show InclusionKey
SaveFormatK = String
"format"
  show InclusionKey
WithSourceK = String
"source"
  show InclusionKey
CaptionFormatK = String
"caption_format"
  show InclusionKey
PreambleK = String
"preamble"
  show InclusionKey
DpiK = String
"dpi"
  show InclusionKey
SourceCodeLabelK = String
"source_label"
  show InclusionKey
StrictModeK = String
"strict"
  show InclusionKey
ExecutableK = String
"executable"
  show InclusionKey
CommandLineArgsK = String
"command_line_arguments"
  show InclusionKey
DependenciesK = String
"dependencies"
  show InclusionKey
FileK = String
"file"
  show InclusionKey
MatplotlibTightBBoxK = String
"tight_bbox"
  show InclusionKey
MatplotlibTransparentK = String
"transparent"

-- | List of all keys related to pandoc-plot that
-- can be specified in source material.
inclusionKeys :: [InclusionKey]
inclusionKeys :: [InclusionKey]
inclusionKeys = forall a. Enum a => a -> a -> [a]
enumFromTo (forall a. Bounded a => a
minBound :: InclusionKey) forall a. Bounded a => a
maxBound

-- | Datatype containing all parameters required to specify a figure.
--
-- It is assumed that once a @FigureSpec@ has been created, no configuration
-- can overload it; hence, a @FigureSpec@ completely encodes a particular figure.
data FigureSpec = FigureSpec
  { -- | Renderer to use for this figure.
    FigureSpec -> Renderer
renderer_ :: !Renderer,
    -- | Executable to use in rendering this figure.
    FigureSpec -> Executable
fsExecutable :: Executable,
    -- | Figure caption.
    FigureSpec -> Text
caption :: !Text,
    -- | Append link to source code in caption.
    FigureSpec -> Bool
withSource :: !Bool,
    -- | Source code for the figure.
    FigureSpec -> Text
script :: !Script,
    -- | Save format of the figure.
    FigureSpec -> SaveFormat
saveFormat :: !SaveFormat,
    -- | Directory where to save the file.
    FigureSpec -> String
directory :: !FilePath,
    -- | Dots-per-inch of figure.
    FigureSpec -> Int
dpi :: !Int,
    -- | Files/directories on which this figure depends, e.g. data files.
    FigureSpec -> [String]
dependencies :: ![FilePath],
    -- | Renderer-specific extra attributes.
    FigureSpec -> [(Text, Text)]
extraAttrs :: ![(Text, Text)],
    -- | Attributes not related to @pandoc-plot@ will be propagated.
    FigureSpec -> Attr
blockAttrs :: !Attr
  }

-- | Generated figure file format supported by pandoc-plot.
-- Note that not all formats are supported by all toolkits.
data SaveFormat
  = -- | Portable network graphics
    PNG
  | -- | Portable document format
    PDF
  | -- | Scalable vector graphics
    SVG
  | -- | JPEG/JPG compressed image
    JPG
  | -- | Encapsulated postscript
    EPS
  | -- | GIF format
    GIF
  | -- | Tagged image format
    TIF
  | -- | WebP image format
    WEBP
  | -- | HTML for interactive plots.
    HTML
  | -- | LaTeX text and pdf graphics
    LaTeX
  deriving (SaveFormat
forall a. a -> a -> Bounded a
maxBound :: SaveFormat
$cmaxBound :: SaveFormat
minBound :: SaveFormat
$cminBound :: SaveFormat
Bounded, Int -> SaveFormat
SaveFormat -> Int
SaveFormat -> [SaveFormat]
SaveFormat -> SaveFormat
SaveFormat -> SaveFormat -> [SaveFormat]
SaveFormat -> SaveFormat -> SaveFormat -> [SaveFormat]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SaveFormat -> SaveFormat -> SaveFormat -> [SaveFormat]
$cenumFromThenTo :: SaveFormat -> SaveFormat -> SaveFormat -> [SaveFormat]
enumFromTo :: SaveFormat -> SaveFormat -> [SaveFormat]
$cenumFromTo :: SaveFormat -> SaveFormat -> [SaveFormat]
enumFromThen :: SaveFormat -> SaveFormat -> [SaveFormat]
$cenumFromThen :: SaveFormat -> SaveFormat -> [SaveFormat]
enumFrom :: SaveFormat -> [SaveFormat]
$cenumFrom :: SaveFormat -> [SaveFormat]
fromEnum :: SaveFormat -> Int
$cfromEnum :: SaveFormat -> Int
toEnum :: Int -> SaveFormat
$ctoEnum :: Int -> SaveFormat
pred :: SaveFormat -> SaveFormat
$cpred :: SaveFormat -> SaveFormat
succ :: SaveFormat -> SaveFormat
$csucc :: SaveFormat -> SaveFormat
Enum, Eq SaveFormat
SaveFormat -> SaveFormat -> Bool
SaveFormat -> SaveFormat -> Ordering
SaveFormat -> SaveFormat -> SaveFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SaveFormat -> SaveFormat -> SaveFormat
$cmin :: SaveFormat -> SaveFormat -> SaveFormat
max :: SaveFormat -> SaveFormat -> SaveFormat
$cmax :: SaveFormat -> SaveFormat -> SaveFormat
>= :: SaveFormat -> SaveFormat -> Bool
$c>= :: SaveFormat -> SaveFormat -> Bool
> :: SaveFormat -> SaveFormat -> Bool
$c> :: SaveFormat -> SaveFormat -> Bool
<= :: SaveFormat -> SaveFormat -> Bool
$c<= :: SaveFormat -> SaveFormat -> Bool
< :: SaveFormat -> SaveFormat -> Bool
$c< :: SaveFormat -> SaveFormat -> Bool
compare :: SaveFormat -> SaveFormat -> Ordering
$ccompare :: SaveFormat -> SaveFormat -> Ordering
Ord, SaveFormat -> SaveFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SaveFormat -> SaveFormat -> Bool
$c/= :: SaveFormat -> SaveFormat -> Bool
== :: SaveFormat -> SaveFormat -> Bool
$c== :: SaveFormat -> SaveFormat -> Bool
Eq, Int -> SaveFormat -> ShowS
[SaveFormat] -> ShowS
SaveFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SaveFormat] -> ShowS
$cshowList :: [SaveFormat] -> ShowS
show :: SaveFormat -> String
$cshow :: SaveFormat -> String
showsPrec :: Int -> SaveFormat -> ShowS
$cshowsPrec :: Int -> SaveFormat -> ShowS
Show, forall x. Rep SaveFormat x -> SaveFormat
forall x. SaveFormat -> Rep SaveFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SaveFormat x -> SaveFormat
$cfrom :: forall x. SaveFormat -> Rep SaveFormat x
Generic)

instance IsString SaveFormat where
  fromString :: String -> SaveFormat
fromString String
s
    | String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"png", String
"PNG", String
".png"] = SaveFormat
PNG
    | String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"pdf", String
"PDF", String
".pdf"] = SaveFormat
PDF
    | String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"svg", String
"SVG", String
".svg"] = SaveFormat
SVG
    | String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"eps", String
"EPS", String
".eps"] = SaveFormat
EPS
    | String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"gif", String
"GIF", String
".gif"] = SaveFormat
GIF
    | String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"jpg", String
"jpeg", String
"JPG", String
"JPEG", String
".jpg", String
".jpeg"] = SaveFormat
JPG
    | String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"tif", String
"tiff", String
"TIF", String
"TIFF", String
".tif", String
".tiff"] = SaveFormat
TIF
    | String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"webp", String
"WEBP", String
".webp"] = SaveFormat
WEBP
    | String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"html", String
"HTML", String
".html"] = SaveFormat
HTML
    | String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"latex", String
"LaTeX", String
".tex"] = SaveFormat
LaTeX
    | Bool
otherwise =
      forall a. String -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$
        forall a. Monoid a => [a] -> a
mconcat
          [ String
s,
            String
" is not one of the valid save formats : ",
            forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse String
", " forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SaveFormat]
saveFormats,
            String
" (and lowercase variations). "
          ]
    where
      saveFormats :: [SaveFormat]
saveFormats = forall a. Enum a => a -> a -> [a]
enumFromTo forall a. Bounded a => a
minBound forall a. Bounded a => a
maxBound :: [SaveFormat]

-- | Use the IsString instance to parse JSON so that the parsing is flexible
-- with respect to uppercase/lowercase (#42)
instance FromJSON SaveFormat where
  parseJSON :: Value -> Parser SaveFormat
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"SaveFormat" (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack)

instance ToJSON SaveFormat where
  toJSON :: SaveFormat -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. SaveFormat -> String
extension

-- | Save format file extension
extension :: SaveFormat -> String
extension :: SaveFormat -> String
extension SaveFormat
LaTeX = String
".tex"
extension SaveFormat
fmt = forall a. Monoid a => [a] -> a
mconcat [String
".", forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ SaveFormat
fmt]

isWindows :: Bool
isWindows :: Bool
isWindows = String
os forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"mingw32", String
"win32", String
"cygwin32"] -- Aliases taken from cabal's Distribution.System module

-- | Internal description of all information
-- needed to output a figure.
data OutputSpec = OutputSpec
  { -- | Figure spec
    OutputSpec -> FigureSpec
oFigureSpec :: FigureSpec,
    -- | Path to the script to render
    OutputSpec -> String
oScriptPath :: FilePath,
    -- | Figure output path
    OutputSpec -> String
oFigurePath :: FilePath,
    -- | Executable to use during rendering
    OutputSpec -> Executable
oExecutable :: Executable,
    -- | Current working directory
    OutputSpec -> String
oCWD :: FilePath
  }

data AvailabilityCheck
  = CommandSuccess (Executable -> Text)
  | ExecutableExists

data Renderer = Renderer
  { Renderer -> Toolkit
rendererToolkit :: Toolkit,
    Renderer -> FigureSpec -> String -> Text
rendererCapture :: FigureSpec -> FilePath -> Script,
    Renderer -> OutputSpec -> Text
rendererCommand :: OutputSpec -> Text,
    Renderer -> AvailabilityCheck
rendererAvailability :: AvailabilityCheck,
    Renderer -> [SaveFormat]
rendererSupportedSaveFormats :: [SaveFormat],
    Renderer -> [Text -> CheckResult]
rendererChecks :: [Script -> CheckResult],
    Renderer -> Text
rendererLanguage :: Text,
    Renderer -> Text -> Text
rendererComment :: Text -> Text,
    Renderer -> String
rendererScriptExtension :: String
  }