{-# 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
--
-- Reading configuration from file
module Text.Pandoc.Filter.Plot.Configuration
  ( configuration,
    configurationPathMeta,
    defaultConfiguration,
  )
where

import Data.Aeson ( (.:?), (.!=), Key, Value(Object, Null), FromJSON(parseJSON) )
import Data.String (IsString(..))
import Data.Text (Text, unpack)
import qualified Data.Text.IO as TIO
import Data.Yaml.Config (ignoreEnv, loadYamlSettings)
import System.FilePath (normalise)
import Text.Pandoc.Definition (Format (..), Inline (..), MetaValue (..), Pandoc (..), lookupMeta)
import Text.Pandoc.Filter.Plot.Monad

-- | Read configuration from a YAML file. The
-- keys are exactly the same as for code blocks.
--
-- If a key is not present, its value will be set
-- to the default value. Parsing errors result in thrown exceptions.
configuration :: FilePath -> IO Configuration
configuration :: FilePath -> IO Configuration
configuration FilePath
fp = forall settings.
FromJSON settings =>
[FilePath] -> [Value] -> EnvUsage -> IO settings
loadYamlSettings [FilePath -> FilePath
normalise FilePath
fp] [] EnvUsage
ignoreEnv forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConfigPrecursor -> IO Configuration
renderConfig

-- | Default configuration values.
--
-- @since 0.5.0.0
defaultConfiguration :: Configuration
defaultConfiguration :: Configuration
defaultConfiguration =
  Configuration
    { defaultDirectory :: FilePath
defaultDirectory = FilePath
"plots/",
      defaultWithSource :: Bool
defaultWithSource = Bool
False,
      defaultDPI :: Int
defaultDPI = Int
80,
      defaultSaveFormat :: SaveFormat
defaultSaveFormat = SaveFormat
PNG,
      defaultDependencies :: [FilePath]
defaultDependencies = forall a. Monoid a => a
mempty,
      captionFormat :: Format
captionFormat = Text -> Format
Format Text
"markdown+tex_math_dollars",
      sourceCodeLabel :: Text
sourceCodeLabel = Text
"Source code",
      strictMode :: Bool
strictMode = Bool
False,
      logVerbosity :: Verbosity
logVerbosity = Verbosity
Warning,
      logSink :: LogSink
logSink = LogSink
StdErr,
      -- Preambles
      matplotlibPreamble :: Text
matplotlibPreamble = forall a. Monoid a => a
mempty,
      plotlyPythonPreamble :: Text
plotlyPythonPreamble = forall a. Monoid a => a
mempty,
      plotlyRPreamble :: Text
plotlyRPreamble = forall a. Monoid a => a
mempty,
      matlabPreamble :: Text
matlabPreamble = forall a. Monoid a => a
mempty,
      mathematicaPreamble :: Text
mathematicaPreamble = forall a. Monoid a => a
mempty,
      octavePreamble :: Text
octavePreamble = forall a. Monoid a => a
mempty,
      ggplot2Preamble :: Text
ggplot2Preamble = forall a. Monoid a => a
mempty,
      gnuplotPreamble :: Text
gnuplotPreamble = forall a. Monoid a => a
mempty,
      graphvizPreamble :: Text
graphvizPreamble = forall a. Monoid a => a
mempty,
      bokehPreamble :: Text
bokehPreamble = forall a. Monoid a => a
mempty,
      plotsjlPreamble :: Text
plotsjlPreamble = forall a. Monoid a => a
mempty,
      plantumlPreamble :: Text
plantumlPreamble = forall a. Monoid a => a
mempty,
      sagemathPreamble :: Text
sagemathPreamble = forall a. Monoid a => a
mempty,
      -- Executables
      matplotlibExe :: FilePath
matplotlibExe = FilePath
python,
      matlabExe :: FilePath
matlabExe = FilePath
"matlab",
      plotlyPythonExe :: FilePath
plotlyPythonExe = FilePath
python,
      plotlyRExe :: FilePath
plotlyRExe = FilePath
"Rscript",
      mathematicaExe :: FilePath
mathematicaExe = FilePath
"math",
      octaveExe :: FilePath
octaveExe = FilePath
"octave",
      ggplot2Exe :: FilePath
ggplot2Exe = FilePath
"Rscript",
      gnuplotExe :: FilePath
gnuplotExe = FilePath
"gnuplot",
      graphvizExe :: FilePath
graphvizExe = FilePath
"dot",
      bokehExe :: FilePath
bokehExe = FilePath
python,
      plotsjlExe :: FilePath
plotsjlExe = FilePath
"julia",
      plantumlExe :: FilePath
plantumlExe = FilePath
"java",
      sagemathExe :: FilePath
sagemathExe = FilePath
"sage",
      -- Command line arguments
      matplotlibCmdArgs :: Text
matplotlibCmdArgs = forall a. Monoid a => a
mempty,
      matlabCmdArgs :: Text
matlabCmdArgs = forall a. Monoid a => a
mempty,
      plotlyPythonCmdArgs :: Text
plotlyPythonCmdArgs = forall a. Monoid a => a
mempty,
      plotlyRCmdArgs :: Text
plotlyRCmdArgs = forall a. Monoid a => a
mempty,
      mathematicaCmdArgs :: Text
mathematicaCmdArgs = forall a. Monoid a => a
mempty,
      octaveCmdArgs :: Text
octaveCmdArgs = forall a. Monoid a => a
mempty,
      ggplot2CmdArgs :: Text
ggplot2CmdArgs = forall a. Monoid a => a
mempty,
      gnuplotCmdArgs :: Text
gnuplotCmdArgs = forall a. Monoid a => a
mempty,
      graphvizCmdArgs :: Text
graphvizCmdArgs = forall a. Monoid a => a
mempty,
      bokehCmdArgs :: Text
bokehCmdArgs = forall a. Monoid a => a
mempty,
      plotsjlCmdArgs :: Text
plotsjlCmdArgs = forall a. Monoid a => a
mempty,
      plantumlCmdArgs :: Text
plantumlCmdArgs = Text
"-jar plantuml.jar",
      sagemathCmdArgs :: Text
sagemathCmdArgs = forall a. Monoid a => a
mempty,
      -- Extras
      matplotlibTightBBox :: Bool
matplotlibTightBBox = Bool
False,
      matplotlibTransparent :: Bool
matplotlibTransparent = Bool
False
    }
  where
    python :: FilePath
python = if Bool
isWindows then FilePath
"python" else FilePath
"python3"

-- | Extact path to configuration from the metadata in a Pandoc document.
-- The path to the configuration file should be under the @plot-configuration@ key.
-- In case there is no such metadata, return the default configuration.
--
-- For example, at the top of a markdown file:
--
-- @
-- ---
-- title: My document
-- author: John Doe
-- plot-configuration: /path/to/file.yml
-- ---
-- @
--
-- The same can be specified via the command line using Pandoc's @-M@ flag:
--
-- > pandoc --filter pandoc-plot -M plot-configuration="path/to/file.yml" ...
--
-- @since 0.6.0.0
configurationPathMeta :: Pandoc -> Maybe FilePath
configurationPathMeta :: Pandoc -> Maybe FilePath
configurationPathMeta (Pandoc Meta
meta [Block]
_) =
  Text -> Meta -> Maybe MetaValue
lookupMeta Text
"plot-configuration" Meta
meta forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetaValue -> Maybe FilePath
getPath
  where
    getPath :: MetaValue -> Maybe FilePath
getPath (MetaString Text
t) = forall a. a -> Maybe a
Just (Text -> FilePath
unpack Text
t)
    getPath (MetaInlines [Str Text
s]) = forall a. a -> Maybe a
Just (Text -> FilePath
unpack Text
s)
    getPath MetaValue
_ = forall a. Maybe a
Nothing

-- We define a precursor type because preambles are best specified as file paths,
-- but we want to read those files before building a full
-- @Configuration@ value.
data ConfigPrecursor = ConfigPrecursor
  { ConfigPrecursor -> FilePath
_defaultDirectory :: !FilePath,
    ConfigPrecursor -> Bool
_defaultWithSource :: !Bool,
    ConfigPrecursor -> Int
_defaultDPI :: !Int,
    ConfigPrecursor -> SaveFormat
_defaultSaveFormat :: !SaveFormat,
    ConfigPrecursor -> [FilePath]
_defaultDependencies :: ![FilePath],
    ConfigPrecursor -> Format
_captionFormat :: !Format,
    ConfigPrecursor -> Text
_sourceCodeLabel :: !Text,
    ConfigPrecursor -> Bool
_strictMode :: !Bool,
    ConfigPrecursor -> LoggingPrecursor
_logPrec :: !LoggingPrecursor,
    ConfigPrecursor -> MatplotlibPrecursor
_matplotlibPrec :: !MatplotlibPrecursor,
    ConfigPrecursor -> MatlabPrecursor
_matlabPrec :: !MatlabPrecursor,
    ConfigPrecursor -> PlotlyPythonPrecursor
_plotlyPythonPrec :: !PlotlyPythonPrecursor,
    ConfigPrecursor -> PlotlyRPrecursor
_plotlyRPrec :: !PlotlyRPrecursor,
    ConfigPrecursor -> MathematicaPrecursor
_mathematicaPrec :: !MathematicaPrecursor,
    ConfigPrecursor -> OctavePrecursor
_octavePrec :: !OctavePrecursor,
    ConfigPrecursor -> GGPlot2Precursor
_ggplot2Prec :: !GGPlot2Precursor,
    ConfigPrecursor -> GNUPlotPrecursor
_gnuplotPrec :: !GNUPlotPrecursor,
    ConfigPrecursor -> GraphvizPrecursor
_graphvizPrec :: !GraphvizPrecursor,
    ConfigPrecursor -> BokehPrecursor
_bokehPrec :: !BokehPrecursor,
    ConfigPrecursor -> PlotsjlPrecursor
_plotsjlPrec :: !PlotsjlPrecursor,
    ConfigPrecursor -> PlantUMLPrecursor
_plantumlPrec :: !PlantUMLPrecursor,
    ConfigPrecursor -> SageMathPrecursor
_sagemathPrec :: !SageMathPrecursor
  }

defaultConfigPrecursor :: ConfigPrecursor
defaultConfigPrecursor :: ConfigPrecursor
defaultConfigPrecursor =
  ConfigPrecursor
    { _defaultDirectory :: FilePath
_defaultDirectory = Configuration -> FilePath
defaultDirectory Configuration
defaultConfiguration,
      _defaultWithSource :: Bool
_defaultWithSource = Configuration -> Bool
defaultWithSource Configuration
defaultConfiguration,
      _defaultDPI :: Int
_defaultDPI = Configuration -> Int
defaultDPI Configuration
defaultConfiguration,
      _defaultSaveFormat :: SaveFormat
_defaultSaveFormat = Configuration -> SaveFormat
defaultSaveFormat Configuration
defaultConfiguration,
      _defaultDependencies :: [FilePath]
_defaultDependencies = Configuration -> [FilePath]
defaultDependencies Configuration
defaultConfiguration,
      _captionFormat :: Format
_captionFormat = Configuration -> Format
captionFormat Configuration
defaultConfiguration,
      _sourceCodeLabel :: Text
_sourceCodeLabel = Configuration -> Text
sourceCodeLabel Configuration
defaultConfiguration,
      _strictMode :: Bool
_strictMode = Configuration -> Bool
strictMode Configuration
defaultConfiguration,
      _logPrec :: LoggingPrecursor
_logPrec = Verbosity -> Maybe FilePath -> LoggingPrecursor
LoggingPrecursor (Configuration -> Verbosity
logVerbosity Configuration
defaultConfiguration) forall a. Maybe a
Nothing, -- _logFilePath=Nothing implies log to stderr
      _matplotlibPrec :: MatplotlibPrecursor
_matplotlibPrec = Maybe FilePath
-> Bool -> Bool -> FilePath -> Text -> MatplotlibPrecursor
MatplotlibPrecursor forall a. Maybe a
Nothing (Configuration -> Bool
matplotlibTightBBox Configuration
defaultConfiguration) (Configuration -> Bool
matplotlibTransparent Configuration
defaultConfiguration) (Configuration -> FilePath
matplotlibExe Configuration
defaultConfiguration) (Configuration -> Text
matplotlibCmdArgs Configuration
defaultConfiguration),
      _matlabPrec :: MatlabPrecursor
_matlabPrec = Maybe FilePath -> FilePath -> Text -> MatlabPrecursor
MatlabPrecursor forall a. Maybe a
Nothing (Configuration -> FilePath
matlabExe Configuration
defaultConfiguration) (Configuration -> Text
matlabCmdArgs Configuration
defaultConfiguration),
      _plotlyPythonPrec :: PlotlyPythonPrecursor
_plotlyPythonPrec = Maybe FilePath -> FilePath -> Text -> PlotlyPythonPrecursor
PlotlyPythonPrecursor forall a. Maybe a
Nothing (Configuration -> FilePath
plotlyPythonExe Configuration
defaultConfiguration) (Configuration -> Text
plotlyPythonCmdArgs Configuration
defaultConfiguration),
      _plotlyRPrec :: PlotlyRPrecursor
_plotlyRPrec = Maybe FilePath -> FilePath -> Text -> PlotlyRPrecursor
PlotlyRPrecursor forall a. Maybe a
Nothing (Configuration -> FilePath
plotlyRExe Configuration
defaultConfiguration) (Configuration -> Text
plotlyRCmdArgs Configuration
defaultConfiguration),
      _mathematicaPrec :: MathematicaPrecursor
_mathematicaPrec = Maybe FilePath -> FilePath -> Text -> MathematicaPrecursor
MathematicaPrecursor forall a. Maybe a
Nothing (Configuration -> FilePath
mathematicaExe Configuration
defaultConfiguration) (Configuration -> Text
mathematicaCmdArgs Configuration
defaultConfiguration),
      _octavePrec :: OctavePrecursor
_octavePrec = Maybe FilePath -> FilePath -> Text -> OctavePrecursor
OctavePrecursor forall a. Maybe a
Nothing (Configuration -> FilePath
octaveExe Configuration
defaultConfiguration) (Configuration -> Text
octaveCmdArgs Configuration
defaultConfiguration),
      _ggplot2Prec :: GGPlot2Precursor
_ggplot2Prec = Maybe FilePath -> FilePath -> Text -> GGPlot2Precursor
GGPlot2Precursor forall a. Maybe a
Nothing (Configuration -> FilePath
ggplot2Exe Configuration
defaultConfiguration) (Configuration -> Text
ggplot2CmdArgs Configuration
defaultConfiguration),
      _gnuplotPrec :: GNUPlotPrecursor
_gnuplotPrec = Maybe FilePath -> FilePath -> Text -> GNUPlotPrecursor
GNUPlotPrecursor forall a. Maybe a
Nothing (Configuration -> FilePath
gnuplotExe Configuration
defaultConfiguration) (Configuration -> Text
gnuplotCmdArgs Configuration
defaultConfiguration),
      _graphvizPrec :: GraphvizPrecursor
_graphvizPrec = Maybe FilePath -> FilePath -> Text -> GraphvizPrecursor
GraphvizPrecursor forall a. Maybe a
Nothing (Configuration -> FilePath
graphvizExe Configuration
defaultConfiguration) (Configuration -> Text
graphvizCmdArgs Configuration
defaultConfiguration),
      _bokehPrec :: BokehPrecursor
_bokehPrec = Maybe FilePath -> FilePath -> Text -> BokehPrecursor
BokehPrecursor forall a. Maybe a
Nothing (Configuration -> FilePath
bokehExe Configuration
defaultConfiguration) (Configuration -> Text
bokehCmdArgs Configuration
defaultConfiguration),
      _plotsjlPrec :: PlotsjlPrecursor
_plotsjlPrec = Maybe FilePath -> FilePath -> Text -> PlotsjlPrecursor
PlotsjlPrecursor forall a. Maybe a
Nothing (Configuration -> FilePath
plotsjlExe Configuration
defaultConfiguration) (Configuration -> Text
plotsjlCmdArgs Configuration
defaultConfiguration),
      _plantumlPrec :: PlantUMLPrecursor
_plantumlPrec = Maybe FilePath -> FilePath -> Text -> PlantUMLPrecursor
PlantUMLPrecursor forall a. Maybe a
Nothing (Configuration -> FilePath
plantumlExe Configuration
defaultConfiguration) (Configuration -> Text
plantumlCmdArgs Configuration
defaultConfiguration),
      _sagemathPrec :: SageMathPrecursor
_sagemathPrec = Maybe FilePath -> FilePath -> Text -> SageMathPrecursor
SageMathPrecursor forall a. Maybe a
Nothing (Configuration -> FilePath
sagemathExe Configuration
defaultConfiguration) (Configuration -> Text
sagemathCmdArgs Configuration
defaultConfiguration)
    }

data LoggingPrecursor = LoggingPrecursor
  { LoggingPrecursor -> Verbosity
_logVerbosity :: !Verbosity,
    LoggingPrecursor -> Maybe FilePath
_logFilePath :: !(Maybe FilePath)
  }

-- Separate YAML clauses have their own types.
data MatplotlibPrecursor = MatplotlibPrecursor
  { MatplotlibPrecursor -> Maybe FilePath
_matplotlibPreamble :: !(Maybe FilePath),
    MatplotlibPrecursor -> Bool
_matplotlibTightBBox :: !Bool,
    MatplotlibPrecursor -> Bool
_matplotlibTransparent :: !Bool,
    MatplotlibPrecursor -> FilePath
_matplotlibExe :: !FilePath,
    MatplotlibPrecursor -> Text
_matplotlibCmdArgs :: !Text
  }

data MatlabPrecursor = MatlabPrecursor {MatlabPrecursor -> Maybe FilePath
_matlabPreamble :: !(Maybe FilePath), MatlabPrecursor -> FilePath
_matlabExe :: !FilePath, MatlabPrecursor -> Text
_matlabCmdArgs :: !Text}

data PlotlyPythonPrecursor = PlotlyPythonPrecursor {PlotlyPythonPrecursor -> Maybe FilePath
_plotlyPythonPreamble :: !(Maybe FilePath), PlotlyPythonPrecursor -> FilePath
_plotlyPythonExe :: !FilePath, PlotlyPythonPrecursor -> Text
_plotlyPythonCmdArgs :: !Text}

data PlotlyRPrecursor = PlotlyRPrecursor {PlotlyRPrecursor -> Maybe FilePath
_plotlyRPreamble :: !(Maybe FilePath), PlotlyRPrecursor -> FilePath
_plotlyRExe :: !FilePath, PlotlyRPrecursor -> Text
_plotlyRCmdArgs :: !Text}

data MathematicaPrecursor = MathematicaPrecursor {MathematicaPrecursor -> Maybe FilePath
_mathematicaPreamble :: !(Maybe FilePath), MathematicaPrecursor -> FilePath
_mathematicaExe :: !FilePath, MathematicaPrecursor -> Text
_mathematicaCmdArgs :: !Text}

data OctavePrecursor = OctavePrecursor {OctavePrecursor -> Maybe FilePath
_octavePreamble :: !(Maybe FilePath), OctavePrecursor -> FilePath
_octaveExe :: !FilePath, OctavePrecursor -> Text
_octaveCmdArgs :: !Text}

data GGPlot2Precursor = GGPlot2Precursor {GGPlot2Precursor -> Maybe FilePath
_ggplot2Preamble :: !(Maybe FilePath), GGPlot2Precursor -> FilePath
_ggplot2Exe :: !FilePath, GGPlot2Precursor -> Text
_ggplot2CmdArgs :: !Text}

data GNUPlotPrecursor = GNUPlotPrecursor {GNUPlotPrecursor -> Maybe FilePath
_gnuplotPreamble :: !(Maybe FilePath), GNUPlotPrecursor -> FilePath
_gnuplotExe :: !FilePath, GNUPlotPrecursor -> Text
_gnuplotCmdArgs :: !Text}

data GraphvizPrecursor = GraphvizPrecursor {GraphvizPrecursor -> Maybe FilePath
_graphvizPreamble :: !(Maybe FilePath), GraphvizPrecursor -> FilePath
_graphvizExe :: !FilePath, GraphvizPrecursor -> Text
_graphvizCmdArgs :: !Text}

data BokehPrecursor = BokehPrecursor {BokehPrecursor -> Maybe FilePath
_bokehPreamble :: !(Maybe FilePath), BokehPrecursor -> FilePath
_bokehExe :: !FilePath, BokehPrecursor -> Text
_bokehCmdArgs :: !Text}

data PlotsjlPrecursor = PlotsjlPrecursor {PlotsjlPrecursor -> Maybe FilePath
_plotsjlPreamble :: !(Maybe FilePath), PlotsjlPrecursor -> FilePath
_plotsjlExe :: !FilePath, PlotsjlPrecursor -> Text
_plotsjlCmdArgs :: !Text}

data PlantUMLPrecursor = PlantUMLPrecursor {PlantUMLPrecursor -> Maybe FilePath
_plantumlPreamble :: !(Maybe FilePath), PlantUMLPrecursor -> FilePath
_plantumlExe :: !FilePath, PlantUMLPrecursor -> Text
_plantumlCmdArgs :: !Text}

data SageMathPrecursor = SageMathPrecursor {SageMathPrecursor -> Maybe FilePath
_sagemathPreamble :: !(Maybe FilePath), SageMathPrecursor -> FilePath
_sagemathExe :: !FilePath, SageMathPrecursor -> Text
_sagemathCmdArgs :: !Text}

instance FromJSON LoggingPrecursor where
  parseJSON :: Value -> Parser LoggingPrecursor
parseJSON (Object Object
v) =
    Verbosity -> Maybe FilePath -> LoggingPrecursor
LoggingPrecursor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"verbosity" forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> Verbosity
logVerbosity Configuration
defaultConfiguration
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filepath"
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [FilePath
"Could not parse logging configuration. "]

asKey :: InclusionKey -> Key 
asKey :: InclusionKey -> Key
asKey = forall a. IsString a => FilePath -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show

instance FromJSON MatplotlibPrecursor where
  parseJSON :: Value -> Parser MatplotlibPrecursor
parseJSON (Object Object
v) =
    Maybe FilePath
-> Bool -> Bool -> FilePath -> Text -> MatplotlibPrecursor
MatplotlibPrecursor
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
PreambleK
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
MatplotlibTightBBoxK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> Bool
matplotlibTightBBox Configuration
defaultConfiguration
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
MatplotlibTransparentK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> Bool
matplotlibTransparent Configuration
defaultConfiguration
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
ExecutableK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> FilePath
matplotlibExe Configuration
defaultConfiguration
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
CommandLineArgsK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> Text
matplotlibCmdArgs Configuration
defaultConfiguration
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [FilePath
"Could not parse ", forall a. Show a => a -> FilePath
show Toolkit
Matplotlib, FilePath
" configuration."]

instance FromJSON MatlabPrecursor where
  parseJSON :: Value -> Parser MatlabPrecursor
parseJSON (Object Object
v) = Maybe FilePath -> FilePath -> Text -> MatlabPrecursor
MatlabPrecursor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
PreambleK forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
ExecutableK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> FilePath
matlabExe Configuration
defaultConfiguration forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
CommandLineArgsK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> Text
matlabCmdArgs Configuration
defaultConfiguration
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [FilePath
"Could not parse ", forall a. Show a => a -> FilePath
show Toolkit
Matlab, FilePath
" configuration."]

instance FromJSON PlotlyPythonPrecursor where
  parseJSON :: Value -> Parser PlotlyPythonPrecursor
parseJSON (Object Object
v) = Maybe FilePath -> FilePath -> Text -> PlotlyPythonPrecursor
PlotlyPythonPrecursor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
PreambleK forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
ExecutableK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> FilePath
plotlyPythonExe Configuration
defaultConfiguration forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
CommandLineArgsK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> Text
plotlyPythonCmdArgs Configuration
defaultConfiguration
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [FilePath
"Could not parse ", forall a. Show a => a -> FilePath
show Toolkit
PlotlyPython, FilePath
" configuration."]

instance FromJSON PlotlyRPrecursor where
  parseJSON :: Value -> Parser PlotlyRPrecursor
parseJSON (Object Object
v) = Maybe FilePath -> FilePath -> Text -> PlotlyRPrecursor
PlotlyRPrecursor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
PreambleK forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
ExecutableK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> FilePath
plotlyRExe Configuration
defaultConfiguration forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
CommandLineArgsK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> Text
plotlyRCmdArgs Configuration
defaultConfiguration
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [FilePath
"Could not parse ", forall a. Show a => a -> FilePath
show Toolkit
PlotlyR, FilePath
" configuration."]

instance FromJSON MathematicaPrecursor where
  parseJSON :: Value -> Parser MathematicaPrecursor
parseJSON (Object Object
v) = Maybe FilePath -> FilePath -> Text -> MathematicaPrecursor
MathematicaPrecursor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
PreambleK forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
ExecutableK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> FilePath
mathematicaExe Configuration
defaultConfiguration forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
CommandLineArgsK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> Text
mathematicaCmdArgs Configuration
defaultConfiguration
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [FilePath
"Could not parse ", forall a. Show a => a -> FilePath
show Toolkit
Mathematica, FilePath
" configuration."]

instance FromJSON OctavePrecursor where
  parseJSON :: Value -> Parser OctavePrecursor
parseJSON (Object Object
v) = Maybe FilePath -> FilePath -> Text -> OctavePrecursor
OctavePrecursor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
PreambleK forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
ExecutableK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> FilePath
octaveExe Configuration
defaultConfiguration forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
CommandLineArgsK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> Text
octaveCmdArgs Configuration
defaultConfiguration
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [FilePath
"Could not parse ", forall a. Show a => a -> FilePath
show Toolkit
Octave, FilePath
" configuration."]

instance FromJSON GGPlot2Precursor where
  parseJSON :: Value -> Parser GGPlot2Precursor
parseJSON (Object Object
v) = Maybe FilePath -> FilePath -> Text -> GGPlot2Precursor
GGPlot2Precursor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
PreambleK forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
ExecutableK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> FilePath
ggplot2Exe Configuration
defaultConfiguration forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
CommandLineArgsK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> Text
ggplot2CmdArgs Configuration
defaultConfiguration
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [FilePath
"Could not parse ", forall a. Show a => a -> FilePath
show Toolkit
GGPlot2, FilePath
" configuration."]

instance FromJSON GNUPlotPrecursor where
  parseJSON :: Value -> Parser GNUPlotPrecursor
parseJSON (Object Object
v) = Maybe FilePath -> FilePath -> Text -> GNUPlotPrecursor
GNUPlotPrecursor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
PreambleK forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
ExecutableK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> FilePath
gnuplotExe Configuration
defaultConfiguration forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
CommandLineArgsK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> Text
gnuplotCmdArgs Configuration
defaultConfiguration
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [FilePath
"Could not parse ", forall a. Show a => a -> FilePath
show Toolkit
GNUPlot, FilePath
" configuration."]

instance FromJSON GraphvizPrecursor where
  parseJSON :: Value -> Parser GraphvizPrecursor
parseJSON (Object Object
v) = Maybe FilePath -> FilePath -> Text -> GraphvizPrecursor
GraphvizPrecursor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
PreambleK forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
ExecutableK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> FilePath
graphvizExe Configuration
defaultConfiguration forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
CommandLineArgsK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> Text
graphvizCmdArgs Configuration
defaultConfiguration
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [FilePath
"Could not parse ", forall a. Show a => a -> FilePath
show Toolkit
Graphviz, FilePath
" configuration."]

instance FromJSON BokehPrecursor where
  parseJSON :: Value -> Parser BokehPrecursor
parseJSON (Object Object
v) = Maybe FilePath -> FilePath -> Text -> BokehPrecursor
BokehPrecursor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
PreambleK forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
ExecutableK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> FilePath
bokehExe Configuration
defaultConfiguration forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
CommandLineArgsK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> Text
bokehCmdArgs Configuration
defaultConfiguration
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [FilePath
"Could not parse ", forall a. Show a => a -> FilePath
show Toolkit
Bokeh, FilePath
" configuration."]

instance FromJSON PlotsjlPrecursor where
  parseJSON :: Value -> Parser PlotsjlPrecursor
parseJSON (Object Object
v) = Maybe FilePath -> FilePath -> Text -> PlotsjlPrecursor
PlotsjlPrecursor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
PreambleK forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
ExecutableK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> FilePath
plotsjlExe Configuration
defaultConfiguration forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
CommandLineArgsK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> Text
plotsjlCmdArgs Configuration
defaultConfiguration
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [FilePath
"Could not parse ", forall a. Show a => a -> FilePath
show Toolkit
Plotsjl, FilePath
" configuration."]

instance FromJSON PlantUMLPrecursor where
  parseJSON :: Value -> Parser PlantUMLPrecursor
parseJSON (Object Object
v) = Maybe FilePath -> FilePath -> Text -> PlantUMLPrecursor
PlantUMLPrecursor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
PreambleK forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
ExecutableK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> FilePath
plantumlExe Configuration
defaultConfiguration forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
CommandLineArgsK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> Text
plantumlCmdArgs Configuration
defaultConfiguration
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [FilePath
"Could not parse ", forall a. Show a => a -> FilePath
show Toolkit
PlantUML, FilePath
" configuration."]

instance FromJSON SageMathPrecursor where
  parseJSON :: Value -> Parser SageMathPrecursor
parseJSON (Object Object
v) = Maybe FilePath -> FilePath -> Text -> SageMathPrecursor
SageMathPrecursor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
PreambleK forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
ExecutableK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> FilePath
sagemathExe Configuration
defaultConfiguration forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
CommandLineArgsK forall a. Parser (Maybe a) -> a -> Parser a
.!= Configuration -> Text
sagemathCmdArgs Configuration
defaultConfiguration
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [FilePath
"Could not parse ", forall a. Show a => a -> FilePath
show Toolkit
SageMath, FilePath
" configuration."]

toolkitAsKey :: Toolkit -> Key 
toolkitAsKey :: Toolkit -> Key
toolkitAsKey = forall a. IsString a => FilePath -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Toolkit -> Text
cls

instance FromJSON ConfigPrecursor where
  parseJSON :: Value -> Parser ConfigPrecursor
parseJSON Value
Null = forall (m :: * -> *) a. Monad m => a -> m a
return ConfigPrecursor
defaultConfigPrecursor -- In case of empty file
  parseJSON (Object Object
v) = do
    FilePath
_defaultDirectory <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
DirectoryK forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> FilePath
_defaultDirectory ConfigPrecursor
defaultConfigPrecursor
    Bool
_defaultWithSource <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
WithSourceK forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> Bool
_defaultWithSource ConfigPrecursor
defaultConfigPrecursor
    Int
_defaultDPI <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
DpiK forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> Int
_defaultDPI ConfigPrecursor
defaultConfigPrecursor
    SaveFormat
_defaultSaveFormat <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
SaveFormatK forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> SaveFormat
_defaultSaveFormat ConfigPrecursor
defaultConfigPrecursor
    [FilePath]
_defaultDependencies <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
DependenciesK forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> [FilePath]
_defaultDependencies ConfigPrecursor
defaultConfigPrecursor
    Format
_captionFormat <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
CaptionFormatK forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> Format
_captionFormat ConfigPrecursor
defaultConfigPrecursor
    Text
_sourceCodeLabel <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
SourceCodeLabelK forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> Text
_sourceCodeLabel ConfigPrecursor
defaultConfigPrecursor
    Bool
_strictMode <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? InclusionKey -> Key
asKey InclusionKey
StrictModeK forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> Bool
_strictMode ConfigPrecursor
defaultConfigPrecursor
    LoggingPrecursor
_logPrec <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"logging" forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> LoggingPrecursor
_logPrec ConfigPrecursor
defaultConfigPrecursor

    MatplotlibPrecursor
_matplotlibPrec <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Toolkit -> Key
toolkitAsKey Toolkit
Matplotlib forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> MatplotlibPrecursor
_matplotlibPrec ConfigPrecursor
defaultConfigPrecursor
    MatlabPrecursor
_matlabPrec <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Toolkit -> Key
toolkitAsKey Toolkit
Matlab forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> MatlabPrecursor
_matlabPrec ConfigPrecursor
defaultConfigPrecursor
    PlotlyPythonPrecursor
_plotlyPythonPrec <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Toolkit -> Key
toolkitAsKey Toolkit
PlotlyPython forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> PlotlyPythonPrecursor
_plotlyPythonPrec ConfigPrecursor
defaultConfigPrecursor
    PlotlyRPrecursor
_plotlyRPrec <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Toolkit -> Key
toolkitAsKey Toolkit
PlotlyR forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> PlotlyRPrecursor
_plotlyRPrec ConfigPrecursor
defaultConfigPrecursor
    MathematicaPrecursor
_mathematicaPrec <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Toolkit -> Key
toolkitAsKey Toolkit
Mathematica forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> MathematicaPrecursor
_mathematicaPrec ConfigPrecursor
defaultConfigPrecursor
    OctavePrecursor
_octavePrec <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Toolkit -> Key
toolkitAsKey Toolkit
Octave forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> OctavePrecursor
_octavePrec ConfigPrecursor
defaultConfigPrecursor
    GGPlot2Precursor
_ggplot2Prec <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Toolkit -> Key
toolkitAsKey Toolkit
GGPlot2 forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> GGPlot2Precursor
_ggplot2Prec ConfigPrecursor
defaultConfigPrecursor
    GNUPlotPrecursor
_gnuplotPrec <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Toolkit -> Key
toolkitAsKey Toolkit
GNUPlot forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> GNUPlotPrecursor
_gnuplotPrec ConfigPrecursor
defaultConfigPrecursor
    GraphvizPrecursor
_graphvizPrec <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Toolkit -> Key
toolkitAsKey Toolkit
Graphviz forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> GraphvizPrecursor
_graphvizPrec ConfigPrecursor
defaultConfigPrecursor
    BokehPrecursor
_bokehPrec <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Toolkit -> Key
toolkitAsKey Toolkit
Bokeh forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> BokehPrecursor
_bokehPrec ConfigPrecursor
defaultConfigPrecursor
    PlotsjlPrecursor
_plotsjlPrec <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Toolkit -> Key
toolkitAsKey Toolkit
Plotsjl forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> PlotsjlPrecursor
_plotsjlPrec ConfigPrecursor
defaultConfigPrecursor
    PlantUMLPrecursor
_plantumlPrec <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Toolkit -> Key
toolkitAsKey Toolkit
PlantUML forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> PlantUMLPrecursor
_plantumlPrec ConfigPrecursor
defaultConfigPrecursor
    SageMathPrecursor
_sagemathPrec <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Toolkit -> Key
toolkitAsKey Toolkit
SageMath forall a. Parser (Maybe a) -> a -> Parser a
.!= ConfigPrecursor -> SageMathPrecursor
_sagemathPrec ConfigPrecursor
defaultConfigPrecursor

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConfigPrecursor {Bool
Int
FilePath
[FilePath]
Text
Format
SaveFormat
SageMathPrecursor
PlantUMLPrecursor
PlotsjlPrecursor
BokehPrecursor
GraphvizPrecursor
GNUPlotPrecursor
GGPlot2Precursor
OctavePrecursor
MathematicaPrecursor
PlotlyRPrecursor
PlotlyPythonPrecursor
MatlabPrecursor
MatplotlibPrecursor
LoggingPrecursor
_sagemathPrec :: SageMathPrecursor
_plantumlPrec :: PlantUMLPrecursor
_plotsjlPrec :: PlotsjlPrecursor
_bokehPrec :: BokehPrecursor
_graphvizPrec :: GraphvizPrecursor
_gnuplotPrec :: GNUPlotPrecursor
_ggplot2Prec :: GGPlot2Precursor
_octavePrec :: OctavePrecursor
_mathematicaPrec :: MathematicaPrecursor
_plotlyRPrec :: PlotlyRPrecursor
_plotlyPythonPrec :: PlotlyPythonPrecursor
_matlabPrec :: MatlabPrecursor
_matplotlibPrec :: MatplotlibPrecursor
_logPrec :: LoggingPrecursor
_strictMode :: Bool
_sourceCodeLabel :: Text
_captionFormat :: Format
_defaultDependencies :: [FilePath]
_defaultSaveFormat :: SaveFormat
_defaultDPI :: Int
_defaultWithSource :: Bool
_defaultDirectory :: FilePath
_sagemathPrec :: SageMathPrecursor
_plantumlPrec :: PlantUMLPrecursor
_plotsjlPrec :: PlotsjlPrecursor
_bokehPrec :: BokehPrecursor
_graphvizPrec :: GraphvizPrecursor
_gnuplotPrec :: GNUPlotPrecursor
_ggplot2Prec :: GGPlot2Precursor
_octavePrec :: OctavePrecursor
_mathematicaPrec :: MathematicaPrecursor
_plotlyRPrec :: PlotlyRPrecursor
_plotlyPythonPrec :: PlotlyPythonPrecursor
_matlabPrec :: MatlabPrecursor
_matplotlibPrec :: MatplotlibPrecursor
_logPrec :: LoggingPrecursor
_strictMode :: Bool
_sourceCodeLabel :: Text
_captionFormat :: Format
_defaultDependencies :: [FilePath]
_defaultSaveFormat :: SaveFormat
_defaultDPI :: Int
_defaultWithSource :: Bool
_defaultDirectory :: FilePath
..}
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Could not parse configuration."

renderConfig :: ConfigPrecursor -> IO Configuration
renderConfig :: ConfigPrecursor -> IO Configuration
renderConfig ConfigPrecursor {Bool
Int
FilePath
[FilePath]
Text
Format
SaveFormat
SageMathPrecursor
PlantUMLPrecursor
PlotsjlPrecursor
BokehPrecursor
GraphvizPrecursor
GNUPlotPrecursor
GGPlot2Precursor
OctavePrecursor
MathematicaPrecursor
PlotlyRPrecursor
PlotlyPythonPrecursor
MatlabPrecursor
MatplotlibPrecursor
LoggingPrecursor
_sagemathPrec :: SageMathPrecursor
_plantumlPrec :: PlantUMLPrecursor
_plotsjlPrec :: PlotsjlPrecursor
_bokehPrec :: BokehPrecursor
_graphvizPrec :: GraphvizPrecursor
_gnuplotPrec :: GNUPlotPrecursor
_ggplot2Prec :: GGPlot2Precursor
_octavePrec :: OctavePrecursor
_mathematicaPrec :: MathematicaPrecursor
_plotlyRPrec :: PlotlyRPrecursor
_plotlyPythonPrec :: PlotlyPythonPrecursor
_matlabPrec :: MatlabPrecursor
_matplotlibPrec :: MatplotlibPrecursor
_logPrec :: LoggingPrecursor
_strictMode :: Bool
_sourceCodeLabel :: Text
_captionFormat :: Format
_defaultDependencies :: [FilePath]
_defaultSaveFormat :: SaveFormat
_defaultDPI :: Int
_defaultWithSource :: Bool
_defaultDirectory :: FilePath
_sagemathPrec :: ConfigPrecursor -> SageMathPrecursor
_plantumlPrec :: ConfigPrecursor -> PlantUMLPrecursor
_plotsjlPrec :: ConfigPrecursor -> PlotsjlPrecursor
_bokehPrec :: ConfigPrecursor -> BokehPrecursor
_graphvizPrec :: ConfigPrecursor -> GraphvizPrecursor
_gnuplotPrec :: ConfigPrecursor -> GNUPlotPrecursor
_ggplot2Prec :: ConfigPrecursor -> GGPlot2Precursor
_octavePrec :: ConfigPrecursor -> OctavePrecursor
_mathematicaPrec :: ConfigPrecursor -> MathematicaPrecursor
_plotlyRPrec :: ConfigPrecursor -> PlotlyRPrecursor
_plotlyPythonPrec :: ConfigPrecursor -> PlotlyPythonPrecursor
_matlabPrec :: ConfigPrecursor -> MatlabPrecursor
_matplotlibPrec :: ConfigPrecursor -> MatplotlibPrecursor
_logPrec :: ConfigPrecursor -> LoggingPrecursor
_strictMode :: ConfigPrecursor -> Bool
_sourceCodeLabel :: ConfigPrecursor -> Text
_captionFormat :: ConfigPrecursor -> Format
_defaultDependencies :: ConfigPrecursor -> [FilePath]
_defaultSaveFormat :: ConfigPrecursor -> SaveFormat
_defaultDPI :: ConfigPrecursor -> Int
_defaultWithSource :: ConfigPrecursor -> Bool
_defaultDirectory :: ConfigPrecursor -> FilePath
..} = do
  let defaultDirectory :: FilePath
defaultDirectory = FilePath
_defaultDirectory
      defaultWithSource :: Bool
defaultWithSource = Bool
_defaultWithSource
      defaultDPI :: Int
defaultDPI = Int
_defaultDPI
      defaultSaveFormat :: SaveFormat
defaultSaveFormat = SaveFormat
_defaultSaveFormat
      defaultDependencies :: [FilePath]
defaultDependencies = [FilePath]
_defaultDependencies
      captionFormat :: Format
captionFormat = Format
_captionFormat
      sourceCodeLabel :: Text
sourceCodeLabel = Text
_sourceCodeLabel
      strictMode :: Bool
strictMode = Bool
_strictMode

      logVerbosity :: Verbosity
logVerbosity = LoggingPrecursor -> Verbosity
_logVerbosity LoggingPrecursor
_logPrec
      logSink :: LogSink
logSink = forall b a. b -> (a -> b) -> Maybe a -> b
maybe LogSink
StdErr FilePath -> LogSink
LogFile (LoggingPrecursor -> Maybe FilePath
_logFilePath LoggingPrecursor
_logPrec)

      matplotlibTightBBox :: Bool
matplotlibTightBBox = MatplotlibPrecursor -> Bool
_matplotlibTightBBox MatplotlibPrecursor
_matplotlibPrec
      matplotlibTransparent :: Bool
matplotlibTransparent = MatplotlibPrecursor -> Bool
_matplotlibTransparent MatplotlibPrecursor
_matplotlibPrec

      matplotlibExe :: FilePath
matplotlibExe = MatplotlibPrecursor -> FilePath
_matplotlibExe MatplotlibPrecursor
_matplotlibPrec
      matlabExe :: FilePath
matlabExe = MatlabPrecursor -> FilePath
_matlabExe MatlabPrecursor
_matlabPrec
      plotlyPythonExe :: FilePath
plotlyPythonExe = PlotlyPythonPrecursor -> FilePath
_plotlyPythonExe PlotlyPythonPrecursor
_plotlyPythonPrec
      plotlyRExe :: FilePath
plotlyRExe = PlotlyRPrecursor -> FilePath
_plotlyRExe PlotlyRPrecursor
_plotlyRPrec
      mathematicaExe :: FilePath
mathematicaExe = MathematicaPrecursor -> FilePath
_mathematicaExe MathematicaPrecursor
_mathematicaPrec
      octaveExe :: FilePath
octaveExe = OctavePrecursor -> FilePath
_octaveExe OctavePrecursor
_octavePrec
      ggplot2Exe :: FilePath
ggplot2Exe = GGPlot2Precursor -> FilePath
_ggplot2Exe GGPlot2Precursor
_ggplot2Prec
      gnuplotExe :: FilePath
gnuplotExe = GNUPlotPrecursor -> FilePath
_gnuplotExe GNUPlotPrecursor
_gnuplotPrec
      graphvizExe :: FilePath
graphvizExe = GraphvizPrecursor -> FilePath
_graphvizExe GraphvizPrecursor
_graphvizPrec
      bokehExe :: FilePath
bokehExe = BokehPrecursor -> FilePath
_bokehExe BokehPrecursor
_bokehPrec
      plotsjlExe :: FilePath
plotsjlExe = PlotsjlPrecursor -> FilePath
_plotsjlExe PlotsjlPrecursor
_plotsjlPrec
      plantumlExe :: FilePath
plantumlExe = PlantUMLPrecursor -> FilePath
_plantumlExe PlantUMLPrecursor
_plantumlPrec
      sagemathExe :: FilePath
sagemathExe = SageMathPrecursor -> FilePath
_sagemathExe SageMathPrecursor
_sagemathPrec

      matplotlibCmdArgs :: Text
matplotlibCmdArgs = MatplotlibPrecursor -> Text
_matplotlibCmdArgs MatplotlibPrecursor
_matplotlibPrec
      matlabCmdArgs :: Text
matlabCmdArgs = MatlabPrecursor -> Text
_matlabCmdArgs MatlabPrecursor
_matlabPrec
      plotlyPythonCmdArgs :: Text
plotlyPythonCmdArgs = PlotlyPythonPrecursor -> Text
_plotlyPythonCmdArgs PlotlyPythonPrecursor
_plotlyPythonPrec
      plotlyRCmdArgs :: Text
plotlyRCmdArgs = PlotlyRPrecursor -> Text
_plotlyRCmdArgs PlotlyRPrecursor
_plotlyRPrec
      mathematicaCmdArgs :: Text
mathematicaCmdArgs = MathematicaPrecursor -> Text
_mathematicaCmdArgs MathematicaPrecursor
_mathematicaPrec
      octaveCmdArgs :: Text
octaveCmdArgs = OctavePrecursor -> Text
_octaveCmdArgs OctavePrecursor
_octavePrec
      ggplot2CmdArgs :: Text
ggplot2CmdArgs = GGPlot2Precursor -> Text
_ggplot2CmdArgs GGPlot2Precursor
_ggplot2Prec
      gnuplotCmdArgs :: Text
gnuplotCmdArgs = GNUPlotPrecursor -> Text
_gnuplotCmdArgs GNUPlotPrecursor
_gnuplotPrec
      graphvizCmdArgs :: Text
graphvizCmdArgs = GraphvizPrecursor -> Text
_graphvizCmdArgs GraphvizPrecursor
_graphvizPrec
      bokehCmdArgs :: Text
bokehCmdArgs = BokehPrecursor -> Text
_bokehCmdArgs BokehPrecursor
_bokehPrec
      plotsjlCmdArgs :: Text
plotsjlCmdArgs = PlotsjlPrecursor -> Text
_plotsjlCmdArgs PlotsjlPrecursor
_plotsjlPrec
      plantumlCmdArgs :: Text
plantumlCmdArgs = PlantUMLPrecursor -> Text
_plantumlCmdArgs PlantUMLPrecursor
_plantumlPrec
      sagemathCmdArgs :: Text
sagemathCmdArgs = SageMathPrecursor -> Text
_sagemathCmdArgs SageMathPrecursor
_sagemathPrec

  Text
matplotlibPreamble <- Maybe FilePath -> IO Text
readPreamble (MatplotlibPrecursor -> Maybe FilePath
_matplotlibPreamble MatplotlibPrecursor
_matplotlibPrec)
  Text
matlabPreamble <- Maybe FilePath -> IO Text
readPreamble (MatlabPrecursor -> Maybe FilePath
_matlabPreamble MatlabPrecursor
_matlabPrec)
  Text
plotlyPythonPreamble <- Maybe FilePath -> IO Text
readPreamble (PlotlyPythonPrecursor -> Maybe FilePath
_plotlyPythonPreamble PlotlyPythonPrecursor
_plotlyPythonPrec)
  Text
plotlyRPreamble <- Maybe FilePath -> IO Text
readPreamble (PlotlyRPrecursor -> Maybe FilePath
_plotlyRPreamble PlotlyRPrecursor
_plotlyRPrec)
  Text
mathematicaPreamble <- Maybe FilePath -> IO Text
readPreamble (MathematicaPrecursor -> Maybe FilePath
_mathematicaPreamble MathematicaPrecursor
_mathematicaPrec)
  Text
octavePreamble <- Maybe FilePath -> IO Text
readPreamble (OctavePrecursor -> Maybe FilePath
_octavePreamble OctavePrecursor
_octavePrec)
  Text
ggplot2Preamble <- Maybe FilePath -> IO Text
readPreamble (GGPlot2Precursor -> Maybe FilePath
_ggplot2Preamble GGPlot2Precursor
_ggplot2Prec)
  Text
gnuplotPreamble <- Maybe FilePath -> IO Text
readPreamble (GNUPlotPrecursor -> Maybe FilePath
_gnuplotPreamble GNUPlotPrecursor
_gnuplotPrec)
  Text
graphvizPreamble <- Maybe FilePath -> IO Text
readPreamble (GraphvizPrecursor -> Maybe FilePath
_graphvizPreamble GraphvizPrecursor
_graphvizPrec)
  Text
bokehPreamble <- Maybe FilePath -> IO Text
readPreamble (BokehPrecursor -> Maybe FilePath
_bokehPreamble BokehPrecursor
_bokehPrec)
  Text
plotsjlPreamble <- Maybe FilePath -> IO Text
readPreamble (PlotsjlPrecursor -> Maybe FilePath
_plotsjlPreamble PlotsjlPrecursor
_plotsjlPrec)
  Text
plantumlPreamble <- Maybe FilePath -> IO Text
readPreamble (PlantUMLPrecursor -> Maybe FilePath
_plantumlPreamble PlantUMLPrecursor
_plantumlPrec)
  Text
sagemathPreamble <- Maybe FilePath -> IO Text
readPreamble (SageMathPrecursor -> Maybe FilePath
_sagemathPreamble SageMathPrecursor
_sagemathPrec)

  forall (m :: * -> *) a. Monad m => a -> m a
return Configuration {Bool
Int
FilePath
[FilePath]
Text
Format
LogSink
Verbosity
SaveFormat
sagemathPreamble :: Text
plantumlPreamble :: Text
plotsjlPreamble :: Text
bokehPreamble :: Text
graphvizPreamble :: Text
gnuplotPreamble :: Text
ggplot2Preamble :: Text
octavePreamble :: Text
mathematicaPreamble :: Text
plotlyRPreamble :: Text
plotlyPythonPreamble :: Text
matlabPreamble :: Text
matplotlibPreamble :: Text
sagemathCmdArgs :: Text
plantumlCmdArgs :: Text
plotsjlCmdArgs :: Text
bokehCmdArgs :: Text
graphvizCmdArgs :: Text
gnuplotCmdArgs :: Text
ggplot2CmdArgs :: Text
octaveCmdArgs :: Text
mathematicaCmdArgs :: Text
plotlyRCmdArgs :: Text
plotlyPythonCmdArgs :: Text
matlabCmdArgs :: Text
matplotlibCmdArgs :: Text
sagemathExe :: FilePath
plantumlExe :: FilePath
plotsjlExe :: FilePath
bokehExe :: FilePath
graphvizExe :: FilePath
gnuplotExe :: FilePath
ggplot2Exe :: FilePath
octaveExe :: FilePath
mathematicaExe :: FilePath
plotlyRExe :: FilePath
plotlyPythonExe :: FilePath
matlabExe :: FilePath
matplotlibExe :: FilePath
matplotlibTransparent :: Bool
matplotlibTightBBox :: Bool
logSink :: LogSink
logVerbosity :: Verbosity
strictMode :: Bool
sourceCodeLabel :: Text
captionFormat :: Format
defaultDependencies :: [FilePath]
defaultSaveFormat :: SaveFormat
defaultDPI :: Int
defaultWithSource :: Bool
defaultDirectory :: FilePath
matplotlibTransparent :: Bool
matplotlibTightBBox :: Bool
sagemathCmdArgs :: Text
plantumlCmdArgs :: Text
plotsjlCmdArgs :: Text
bokehCmdArgs :: Text
graphvizCmdArgs :: Text
gnuplotCmdArgs :: Text
ggplot2CmdArgs :: Text
octaveCmdArgs :: Text
mathematicaCmdArgs :: Text
plotlyRCmdArgs :: Text
plotlyPythonCmdArgs :: Text
matlabCmdArgs :: Text
matplotlibCmdArgs :: Text
sagemathExe :: FilePath
plantumlExe :: FilePath
plotsjlExe :: FilePath
bokehExe :: FilePath
graphvizExe :: FilePath
gnuplotExe :: FilePath
ggplot2Exe :: FilePath
octaveExe :: FilePath
mathematicaExe :: FilePath
plotlyRExe :: FilePath
plotlyPythonExe :: FilePath
matlabExe :: FilePath
matplotlibExe :: FilePath
sagemathPreamble :: Text
plantumlPreamble :: Text
plotsjlPreamble :: Text
bokehPreamble :: Text
graphvizPreamble :: Text
gnuplotPreamble :: Text
ggplot2Preamble :: Text
octavePreamble :: Text
mathematicaPreamble :: Text
matlabPreamble :: Text
plotlyRPreamble :: Text
plotlyPythonPreamble :: Text
matplotlibPreamble :: Text
logSink :: LogSink
logVerbosity :: Verbosity
strictMode :: Bool
sourceCodeLabel :: Text
captionFormat :: Format
defaultDependencies :: [FilePath]
defaultSaveFormat :: SaveFormat
defaultDPI :: Int
defaultWithSource :: Bool
defaultDirectory :: FilePath
..}
  where
    readPreamble :: Maybe FilePath -> IO Text
readPreamble = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty FilePath -> IO Text
TIO.readFile