{-# LANGUAGE OverloadedStrings #-}

-- |

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

--

-- Prelude for renderers, containing some helpful utilities.

module Text.Pandoc.Filter.Plot.Renderers.Prelude
  ( module Prelude,
    module Text.Pandoc.Filter.Plot.Monad,
    Text,
    st,
    unpack,
    commandSuccess,
    existsOnPath,
    OutputSpec (..),
    appendCapture,
    toRPath,
  )
where

import Data.Maybe (isJust)
import Data.Text (Text, unpack)
import System.Directory (findExecutable)
import System.Exit (ExitCode (..))
import System.FilePath (isPathSeparator)
import Text.Pandoc.Filter.Plot.Monad
import Text.Shakespeare.Text (st)

-- | Check that the supplied command results in

-- an exit code of 0 (i.e. no errors)

commandSuccess ::
  FilePath -> -- Directory from which to run the command

  Text -> -- Command to run, including the executable

  PlotM Bool
commandSuccess :: FilePath -> Text -> PlotM Bool
commandSuccess FilePath
fp Text
s = do
  (ExitCode
ec, Text
_) <- FilePath -> Text -> PlotM (ExitCode, Text)
runCommand FilePath
fp Text
s
  Bool -> PlotM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> PlotM Bool) -> Bool -> PlotM Bool
forall a b. (a -> b) -> a -> b
$ ExitCode
ec ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess

-- | Checks that an executable is available on path, at all.

existsOnPath :: FilePath -> IO Bool
existsOnPath :: FilePath -> IO Bool
existsOnPath FilePath
fp = FilePath -> IO (Maybe FilePath)
findExecutable FilePath
fp IO (Maybe FilePath) -> (Maybe FilePath -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe FilePath -> Bool) -> IO (Maybe FilePath) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (IO (Maybe FilePath) -> IO Bool)
-> (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | A shortcut to append capture script fragments to scripts

appendCapture ::
  (FigureSpec -> FilePath -> Script) ->
  FigureSpec ->
  FilePath ->
  Script
appendCapture :: (FigureSpec -> FilePath -> Text) -> FigureSpec -> FilePath -> Text
appendCapture FigureSpec -> FilePath -> Text
f FigureSpec
s FilePath
fp = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [FigureSpec -> Text
script FigureSpec
s, Text
"\n", FigureSpec -> FilePath -> Text
f FigureSpec
s FilePath
fp]

-- | 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 -> FilePath
oScriptPath :: FilePath,
    -- | Figure output path

    OutputSpec -> FilePath
oFigurePath :: FilePath
  }

-- | R paths use the '/' path separator

toRPath :: FilePath -> FilePath
toRPath :: FilePath -> FilePath
toRPath = (Char -> Char) -> FilePath -> FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
c -> if Char -> Bool
isPathSeparator Char
c then Char
'/' else Char
c)