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

-- |

-- Module      : $header$

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

-- 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 (..),
    Script,
    CheckResult (..),
    InclusionKey (..),
    FigureSpec (..),
    OutputSpec (..),
    SaveFormat (..),
    cls,
    extension,
    toolkits,
    inclusionKeys,
    Executable (..),
    exeFromPath,
    -- Utilities

    isWindows,
  )
where

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

-- | List of supported toolkits.

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

-- | Enumeration of supported toolkits

data Toolkit
  = Matplotlib
  | Matlab
  | PlotlyPython
  | PlotlyR
  | Mathematica
  | Octave
  | GGPlot2
  | GNUPlot
  | Graphviz
  | Bokeh
  | Plotsjl
  deriving (Toolkit
Toolkit -> Toolkit -> Bounded Toolkit
forall a. a -> a -> Bounded a
maxBound :: Toolkit
$cmaxBound :: Toolkit
minBound :: Toolkit
$cminBound :: Toolkit
Bounded, Toolkit -> Toolkit -> Bool
(Toolkit -> Toolkit -> Bool)
-> (Toolkit -> Toolkit -> Bool) -> Eq Toolkit
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]
(Toolkit -> Toolkit)
-> (Toolkit -> Toolkit)
-> (Int -> Toolkit)
-> (Toolkit -> Int)
-> (Toolkit -> [Toolkit])
-> (Toolkit -> Toolkit -> [Toolkit])
-> (Toolkit -> Toolkit -> [Toolkit])
-> (Toolkit -> Toolkit -> Toolkit -> [Toolkit])
-> Enum 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. Toolkit -> Rep Toolkit x)
-> (forall x. Rep Toolkit x -> Toolkit) -> Generic Toolkit
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
Eq Toolkit
-> (Toolkit -> Toolkit -> Ordering)
-> (Toolkit -> Toolkit -> Bool)
-> (Toolkit -> Toolkit -> Bool)
-> (Toolkit -> Toolkit -> Bool)
-> (Toolkit -> Toolkit -> Bool)
-> (Toolkit -> Toolkit -> Toolkit)
-> (Toolkit -> Toolkit -> Toolkit)
-> Ord 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
$cp1Ord :: Eq Toolkit
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"

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

-- | Executable program and directory where it can be found.

data Executable = Executable FilePath Text

exeFromPath :: FilePath -> Executable
exeFromPath :: String -> Executable
exeFromPath String
fp =
  let (String
dir, String
name) = String -> (String, String)
splitFileName String
fp
   in String -> Text -> Executable
Executable String
dir (String -> Text
pack String
name)

-- | Source context for plotting scripts

type Script = Text

-- | Result of checking scripts for problems

data CheckResult
  = CheckPassed
  | CheckFailed Text
  deriving (CheckResult -> CheckResult -> Bool
(CheckResult -> CheckResult -> Bool)
-> (CheckResult -> CheckResult -> Bool) -> Eq CheckResult
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 Text -> Text -> Text
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
InclusionKey -> InclusionKey -> Bounded InclusionKey
forall a. a -> a -> Bounded a
maxBound :: InclusionKey
$cmaxBound :: InclusionKey
minBound :: InclusionKey
$cminBound :: InclusionKey
Bounded, InclusionKey -> InclusionKey -> Bool
(InclusionKey -> InclusionKey -> Bool)
-> (InclusionKey -> InclusionKey -> Bool) -> Eq InclusionKey
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]
(InclusionKey -> InclusionKey)
-> (InclusionKey -> InclusionKey)
-> (Int -> InclusionKey)
-> (InclusionKey -> Int)
-> (InclusionKey -> [InclusionKey])
-> (InclusionKey -> InclusionKey -> [InclusionKey])
-> (InclusionKey -> InclusionKey -> [InclusionKey])
-> (InclusionKey -> InclusionKey -> InclusionKey -> [InclusionKey])
-> Enum 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 = InclusionKey -> InclusionKey -> [InclusionKey]
forall a. Enum a => a -> a -> [a]
enumFromTo (InclusionKey
forall a. Bounded a => a
minBound :: InclusionKey) InclusionKey
forall a. Bounded a => a
maxBound

-- | Datatype containing all parameters required to run pandoc-plot.

--

-- 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,
    -- | 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
  deriving (SaveFormat
SaveFormat -> SaveFormat -> Bounded 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]
(SaveFormat -> SaveFormat)
-> (SaveFormat -> SaveFormat)
-> (Int -> SaveFormat)
-> (SaveFormat -> Int)
-> (SaveFormat -> [SaveFormat])
-> (SaveFormat -> SaveFormat -> [SaveFormat])
-> (SaveFormat -> SaveFormat -> [SaveFormat])
-> (SaveFormat -> SaveFormat -> SaveFormat -> [SaveFormat])
-> Enum 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, SaveFormat -> SaveFormat -> Bool
(SaveFormat -> SaveFormat -> Bool)
-> (SaveFormat -> SaveFormat -> Bool) -> Eq SaveFormat
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
(Int -> SaveFormat -> ShowS)
-> (SaveFormat -> String)
-> ([SaveFormat] -> ShowS)
-> Show SaveFormat
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. SaveFormat -> Rep SaveFormat x)
-> (forall x. Rep SaveFormat x -> SaveFormat) -> Generic SaveFormat
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 String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"png", String
"PNG", String
".png"] = SaveFormat
PNG
    | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"pdf", String
"PDF", String
".pdf"] = SaveFormat
PDF
    | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"svg", String
"SVG", String
".svg"] = SaveFormat
SVG
    | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"eps", String
"EPS", String
".eps"] = SaveFormat
EPS
    | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"gif", String
"GIF", String
".gif"] = SaveFormat
GIF
    | String
s String -> [String] -> Bool
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 String -> [String] -> Bool
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 String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"webp", String
"WEBP", String
".webp"] = SaveFormat
WEBP
    | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"html", String
"HTML", String
".html"] = SaveFormat
HTML
    | Bool
otherwise =
      String -> SaveFormat
forall a. String -> a
errorWithoutStackTrace (String -> SaveFormat) -> String -> SaveFormat
forall a b. (a -> b) -> a -> b
$
        [String] -> String
forall a. Monoid a => [a] -> a
mconcat
          [ String
s,
            String
" is not one of valid save format : ",
            [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
", " ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ SaveFormat -> String
forall a. Show a => a -> String
show (SaveFormat -> String) -> [SaveFormat] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SaveFormat]
saveFormats
          ]
    where
      saveFormats :: [SaveFormat]
saveFormats = SaveFormat -> SaveFormat -> [SaveFormat]
forall a. Enum a => a -> a -> [a]
enumFromTo SaveFormat
forall a. Bounded a => a
minBound SaveFormat
forall a. Bounded a => a
maxBound :: [SaveFormat]

instance FromJSON SaveFormat -- TODO: test this parsing


instance ToJSON SaveFormat where
  toJSON :: SaveFormat -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (SaveFormat -> String) -> SaveFormat -> Value
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
fmt = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
".", (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower ShowS -> (SaveFormat -> String) -> SaveFormat -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SaveFormat -> String
forall a. Show a => a -> String
show (SaveFormat -> String) -> SaveFormat -> String
forall a b. (a -> b) -> a -> b
$ SaveFormat
fmt]

isWindows :: Bool
isWindows :: Bool
isWindows = String
os String -> [String] -> Bool
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
  }

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