{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE RecordWildCards   #-}
{-|
Module      : $header$
Copyright   : (c) Laurent P René de Cotret, 2020
License     : GNU GPL, version 2 or above
Maintainer  : laurent.decotret@outlook.com
Stability   : internal
Portability : portable

Rendering Matlab code blocks
-}

module Text.Pandoc.Filter.Plot.Renderers.Matlab (
      matlabSupportedSaveFormats
    , matlabCommand
    , matlabCapture
    , matlabAvailable
) where

import           System.Directory                            (exeExtension)

import           Text.Pandoc.Filter.Plot.Renderers.Prelude


matlabSupportedSaveFormats :: [SaveFormat]
matlabSupportedSaveFormats :: [SaveFormat]
matlabSupportedSaveFormats = [SaveFormat
PNG, SaveFormat
PDF, SaveFormat
SVG, SaveFormat
JPG, SaveFormat
EPS, SaveFormat
GIF, SaveFormat
TIF]


matlabCommand :: OutputSpec -> PlotM Text
matlabCommand :: OutputSpec -> PlotM Text
matlabCommand OutputSpec{..} = do
    FilePath
exe <- Toolkit -> PlotM FilePath
executable Toolkit
Matlab
    Text -> PlotM Text
forall (m :: * -> *) a. Monad m => a -> m a
return [st|#{exe} -batch "run('#{oScriptPath}')"|]


-- On Windows at least, "matlab -help"  actually returns -1, even though the

-- help text is shown successfully!

-- Therefore, we cannot rely on this behavior to know if matlab is present, 

-- like other toolkits.

matlabAvailable :: PlotM Bool
matlabAvailable :: PlotM Bool
matlabAvailable = (Configuration -> FilePath) -> PlotM FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Configuration -> FilePath
matlabExe PlotM FilePath -> (FilePath -> PlotM Bool) -> PlotM Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\exe :: FilePath
exe -> IO Bool -> PlotM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> PlotM Bool) -> IO Bool -> PlotM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
existsOnPath (FilePath
exe FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExtension))


matlabCapture :: FigureSpec -> FilePath -> Script
matlabCapture :: FigureSpec -> FilePath -> Text
matlabCapture FigureSpec{..} fname :: FilePath
fname = [st|
saveas(gcf, '#{fname}')
|]