{-# LANGUAGE OverloadedStrings     #-}
{-# 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

Scripting
-}

module Text.Pandoc.Filter.Plot.Scripting
    ( ScriptResult(..)
    , runTempScript
    , runScriptIfNecessary
    , figurePath
    ) where

import           Control.Monad.Reader

import           Data.Hashable                     (hash)
import           Data.Text                         (Text, pack, unpack)
import qualified Data.Text.IO                      as T

import           Paths_pandoc_plot                 (version)

import           System.Directory                  (createDirectoryIfMissing,
                                                    doesFileExist, getTemporaryDirectory, 
                                                    getCurrentDirectory)
import           System.Exit                       (ExitCode (..))
import           System.FilePath                   (addExtension,
                                                    normalise, replaceExtension,
                                                    takeDirectory, (</>))

import           Text.Pandoc.Filter.Plot.Renderers
import           Text.Pandoc.Filter.Plot.Monad


-- Run script as described by the spec, only if necessary

runScriptIfNecessary :: FigureSpec -> PlotM ScriptResult
runScriptIfNecessary :: FigureSpec -> PlotM ScriptResult
runScriptIfNecessary FigureSpec
spec = do
    FilePath
target <- FigureSpec -> PlotM FilePath
figurePath FigureSpec
spec
    IO () -> StateT PlotState (ReaderT RuntimeEnv IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT PlotState (ReaderT RuntimeEnv IO) ())
-> IO () -> StateT PlotState (ReaderT RuntimeEnv IO) ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeDirectory (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
target

    Bool
fileAlreadyExists <- IO Bool -> StateT PlotState (ReaderT RuntimeEnv IO) Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> StateT PlotState (ReaderT RuntimeEnv IO) Bool)
-> (FilePath -> IO Bool)
-> FilePath
-> StateT PlotState (ReaderT RuntimeEnv IO) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
doesFileExist (FilePath -> StateT PlotState (ReaderT RuntimeEnv IO) Bool)
-> FilePath -> StateT PlotState (ReaderT RuntimeEnv IO) Bool
forall a b. (a -> b) -> a -> b
$ FilePath
target
    ScriptResult
result <- if Bool
fileAlreadyExists
                then ScriptResult -> PlotM ScriptResult
forall (m :: * -> *) a. Monad m => a -> m a
return ScriptResult
ScriptSuccess
                else FigureSpec -> PlotM ScriptResult
runTempScript FigureSpec
spec

    ScriptResult -> StateT PlotState (ReaderT RuntimeEnv IO) ()
logScriptResult ScriptResult
result

    case ScriptResult
result of
        ScriptResult
ScriptSuccess -> do
            FilePath
scp <- FigureSpec -> PlotM FilePath
sourceCodePath FigureSpec
spec
            IO ScriptResult -> PlotM ScriptResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ScriptResult -> PlotM ScriptResult)
-> IO ScriptResult -> PlotM ScriptResult
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
T.writeFile FilePath
scp (FigureSpec -> Text
script FigureSpec
spec) IO () -> IO ScriptResult -> IO ScriptResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ScriptResult -> IO ScriptResult
forall (m :: * -> *) a. Monad m => a -> m a
return ScriptResult
ScriptSuccess
        ScriptResult
other         -> ScriptResult -> PlotM ScriptResult
forall (m :: * -> *) a. Monad m => a -> m a
return ScriptResult
other

    where
        logScriptResult :: ScriptResult -> StateT PlotState (ReaderT RuntimeEnv IO) ()
logScriptResult ScriptResult
ScriptSuccess = () -> StateT PlotState (ReaderT RuntimeEnv IO) ()
forall (m :: * -> *) a. Monad m => a -> m a
return () 
        logScriptResult ScriptResult
r             = Text -> StateT PlotState (ReaderT RuntimeEnv IO) ()
err   (Text -> StateT PlotState (ReaderT RuntimeEnv IO) ())
-> (ScriptResult -> Text)
-> ScriptResult
-> StateT PlotState (ReaderT RuntimeEnv IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack (FilePath -> Text)
-> (ScriptResult -> FilePath) -> ScriptResult -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptResult -> FilePath
forall a. Show a => a -> FilePath
show (ScriptResult -> StateT PlotState (ReaderT RuntimeEnv IO) ())
-> ScriptResult -> StateT PlotState (ReaderT RuntimeEnv IO) ()
forall a b. (a -> b) -> a -> b
$ ScriptResult
r


-- | Possible result of running a script

data ScriptResult
    = ScriptSuccess
    | ScriptChecksFailed Text   -- Message

    | ScriptFailure Text Int    -- Command and exit code

    | ToolkitNotInstalled Toolkit -- Script failed because toolkit is not installed


instance Show ScriptResult where
    show :: ScriptResult -> FilePath
show ScriptResult
ScriptSuccess            = FilePath
"Script success."
    show (ScriptChecksFailed Text
msg) = Text -> FilePath
unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text
"Script checks failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
    show (ScriptFailure Text
msg Int
ec)   = [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat [FilePath
"Script failed with exit code ", Int -> FilePath
forall a. Show a => a -> FilePath
show Int
ec, FilePath
" and the following message: ", Text -> FilePath
unpack Text
msg]
    show (ToolkitNotInstalled Toolkit
tk) = (Toolkit -> FilePath
forall a. Show a => a -> FilePath
show Toolkit
tk) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" toolkit not installed."


-- Run script as described by the spec

-- Checks are performed, according to the renderer

-- Note that stdout from the script is suppressed, but not

-- stderr.

runTempScript :: FigureSpec -> PlotM ScriptResult
runTempScript :: FigureSpec -> PlotM ScriptResult
runTempScript spec :: FigureSpec
spec@FigureSpec{Bool
Int
FilePath
[FilePath]
[(Text, Text)]
Attr
Text
SaveFormat
Toolkit
blockAttrs :: FigureSpec -> Attr
extraAttrs :: FigureSpec -> [(Text, Text)]
dependencies :: FigureSpec -> [FilePath]
dpi :: FigureSpec -> Int
directory :: FigureSpec -> FilePath
saveFormat :: FigureSpec -> SaveFormat
withSource :: FigureSpec -> Bool
caption :: FigureSpec -> Text
toolkit :: FigureSpec -> Toolkit
blockAttrs :: Attr
extraAttrs :: [(Text, Text)]
dependencies :: [FilePath]
dpi :: Int
directory :: FilePath
saveFormat :: SaveFormat
script :: Text
withSource :: Bool
caption :: Text
toolkit :: Toolkit
script :: FigureSpec -> Text
..} = do
    let checks :: [Text -> CheckResult]
checks = Toolkit -> [Text -> CheckResult]
scriptChecks Toolkit
toolkit
        checkResult :: CheckResult
checkResult = [CheckResult] -> CheckResult
forall a. Monoid a => [a] -> a
mconcat ([CheckResult] -> CheckResult) -> [CheckResult] -> CheckResult
forall a b. (a -> b) -> a -> b
$ [Text -> CheckResult]
checks [Text -> CheckResult] -> [Text] -> [CheckResult]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Text
script]
    case CheckResult
checkResult of
        CheckFailed Text
msg -> ScriptResult -> PlotM ScriptResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptResult -> PlotM ScriptResult)
-> ScriptResult -> PlotM ScriptResult
forall a b. (a -> b) -> a -> b
$ Text -> ScriptResult
ScriptChecksFailed Text
msg
        CheckResult
CheckPassed -> do
            FilePath
scriptPath <- FigureSpec -> PlotM FilePath
tempScriptPath FigureSpec
spec
            FilePath
target <- FigureSpec -> PlotM FilePath
figurePath FigureSpec
spec

            -- Check if executable is present

            -- Note that checking if the toolkit if fully configured is much more involved,

            -- and so we only check if the toolkit is appropriately installed if there is

            -- an error.

            Maybe Executable
exe <- Toolkit -> PlotM (Maybe Executable)
executable Toolkit
toolkit
            case Maybe Executable
exe of
                Maybe Executable
Nothing -> FilePath -> PlotM ScriptResult
forall a. HasCallStack => FilePath -> a
error (FilePath -> PlotM ScriptResult) -> FilePath -> PlotM ScriptResult
forall a b. (a -> b) -> a -> b
$ FilePath
"Toolkit " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Toolkit -> FilePath
forall a. Show a => a -> FilePath
show Toolkit
toolkit FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" is not installed."
                Just (Executable FilePath
exedir Text
exename) -> do
                    -- Commands are run from the executable directory,

                    -- so we need to tell the full absolute path where to save the

                    -- figure

                    FilePath
curdir <- IO FilePath -> PlotM FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> PlotM FilePath) -> IO FilePath -> PlotM FilePath
forall a b. (a -> b) -> a -> b
$ IO FilePath
getCurrentDirectory
                    let scriptWithCapture :: Text
scriptWithCapture = (Toolkit -> FigureSpec -> FilePath -> Text
capture Toolkit
toolkit) FigureSpec
spec (FilePath
curdir FilePath -> FilePath -> FilePath
</> FilePath
target)

                    IO () -> StateT PlotState (ReaderT RuntimeEnv IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT PlotState (ReaderT RuntimeEnv IO) ())
-> IO () -> StateT PlotState (ReaderT RuntimeEnv IO) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
T.writeFile FilePath
scriptPath Text
scriptWithCapture
                    let outputSpec :: OutputSpec
outputSpec = OutputSpec :: FigureSpec -> FilePath -> FilePath -> OutputSpec
OutputSpec { oFigureSpec :: FigureSpec
oFigureSpec = FigureSpec
spec
                                                , oScriptPath :: FilePath
oScriptPath = FilePath
scriptPath
                                                , oFigurePath :: FilePath
oFigurePath = FilePath
target
                                                }

                    let command_ :: Text
command_ = Toolkit -> OutputSpec -> Text -> Text
command Toolkit
toolkit OutputSpec
outputSpec Text
exename
                    (ExitCode
ec, Text
_) <- FilePath -> Text -> PlotM (ExitCode, Text)
runCommand FilePath
exedir Text
command_
                    case ExitCode
ec of
                        ExitCode
ExitSuccess      -> ScriptResult -> PlotM ScriptResult
forall (m :: * -> *) a. Monad m => a -> m a
return   ScriptResult
ScriptSuccess
                        ExitFailure Int
code -> do
                            -- Two possible types of failures: either the script

                            -- failed because the toolkit was not available, or

                            -- because of a genuine error

                            Bool
toolkitInstalled <- Toolkit -> StateT PlotState (ReaderT RuntimeEnv IO) Bool
toolkitAvailable Toolkit
toolkit 
                            if Bool
toolkitInstalled
                                then ScriptResult -> PlotM ScriptResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptResult -> PlotM ScriptResult)
-> ScriptResult -> PlotM ScriptResult
forall a b. (a -> b) -> a -> b
$ Text -> Int -> ScriptResult
ScriptFailure Text
command_ Int
code
                                else ScriptResult -> PlotM ScriptResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptResult -> PlotM ScriptResult)
-> ScriptResult -> PlotM ScriptResult
forall a b. (a -> b) -> a -> b
$ Toolkit -> ScriptResult
ToolkitNotInstalled Toolkit
toolkit


-- | Determine the temp script path from Figure specifications

-- Note that for certain renderers, the appropriate file extension

-- is important.

tempScriptPath :: FigureSpec -> PlotM FilePath
tempScriptPath :: FigureSpec -> PlotM FilePath
tempScriptPath FigureSpec{Bool
Int
FilePath
[FilePath]
[(Text, Text)]
Attr
Text
SaveFormat
Toolkit
blockAttrs :: Attr
extraAttrs :: [(Text, Text)]
dependencies :: [FilePath]
dpi :: Int
directory :: FilePath
saveFormat :: SaveFormat
script :: Text
withSource :: Bool
caption :: Text
toolkit :: Toolkit
blockAttrs :: FigureSpec -> Attr
extraAttrs :: FigureSpec -> [(Text, Text)]
dependencies :: FigureSpec -> [FilePath]
dpi :: FigureSpec -> Int
directory :: FigureSpec -> FilePath
saveFormat :: FigureSpec -> SaveFormat
withSource :: FigureSpec -> Bool
caption :: FigureSpec -> Text
toolkit :: FigureSpec -> Toolkit
script :: FigureSpec -> Text
..} = do
    let ext :: FilePath
ext = Toolkit -> FilePath
scriptExtension Toolkit
toolkit
    -- MATLAB will refuse to process files that don't start with

    -- a letter

    -- Note that this hash is only so that we are running scripts from unique

    -- file names; it does NOT determine whether this figure should

    -- be rendered or not.

    let hashedPath :: FilePath
hashedPath = FilePath
"pandocplot" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> (Text -> Int) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> (Text -> Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
forall a. Hashable a => a -> Int
hash (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text
script) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
ext
    IO FilePath -> PlotM FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> PlotM FilePath) -> IO FilePath -> PlotM FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath -> FilePath
</> FilePath
hashedPath) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getTemporaryDirectory


-- | Determine the path to the source code that generated the figure.

sourceCodePath :: FigureSpec -> PlotM FilePath
sourceCodePath :: FigureSpec -> PlotM FilePath
sourceCodePath = (FilePath -> FilePath) -> PlotM FilePath -> PlotM FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
normalise (PlotM FilePath -> PlotM FilePath)
-> (FigureSpec -> PlotM FilePath) -> FigureSpec -> PlotM FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> PlotM FilePath -> PlotM FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> FilePath -> FilePath)
-> FilePath -> FilePath -> FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> FilePath
replaceExtension FilePath
".txt") (PlotM FilePath -> PlotM FilePath)
-> (FigureSpec -> PlotM FilePath) -> FigureSpec -> PlotM FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FigureSpec -> PlotM FilePath
figurePath


-- | Hash of the content of a @FigureSpec@. Note that unlike usual hashes,

-- two @FigureSpec@ with the same @figureContentHash@ does not mean that they are equal!

--

-- Not all parts of a FigureSpec are related to running code.

-- For example, changing the caption should not require running the figure again.

figureContentHash :: FigureSpec -> PlotM Word
figureContentHash :: FigureSpec -> PlotM Word
figureContentHash FigureSpec{Bool
Int
FilePath
[FilePath]
[(Text, Text)]
Attr
Text
SaveFormat
Toolkit
blockAttrs :: Attr
extraAttrs :: [(Text, Text)]
dependencies :: [FilePath]
dpi :: Int
directory :: FilePath
saveFormat :: SaveFormat
script :: Text
withSource :: Bool
caption :: Text
toolkit :: Toolkit
blockAttrs :: FigureSpec -> Attr
extraAttrs :: FigureSpec -> [(Text, Text)]
dependencies :: FigureSpec -> [FilePath]
dpi :: FigureSpec -> Int
directory :: FigureSpec -> FilePath
saveFormat :: FigureSpec -> SaveFormat
withSource :: FigureSpec -> Bool
caption :: FigureSpec -> Text
toolkit :: FigureSpec -> Toolkit
script :: FigureSpec -> Text
..} = do
    [Word]
dependenciesHash <- [PlotM Word] -> StateT PlotState (ReaderT RuntimeEnv IO) [Word]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([PlotM Word] -> StateT PlotState (ReaderT RuntimeEnv IO) [Word])
-> [PlotM Word] -> StateT PlotState (ReaderT RuntimeEnv IO) [Word]
forall a b. (a -> b) -> a -> b
$ FilePath -> PlotM Word
fileHash (FilePath -> PlotM Word) -> [FilePath] -> [PlotM Word]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
dependencies
    -- hash looks strange because instances only exist for 7-tuples or less

    Word -> PlotM Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> PlotM Word) -> Word -> PlotM Word
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral 
           (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ ((Int, Text, Int, FilePath),
 (Int, [Word], [(Text, Text)], FilePath))
-> Int
forall a. Hashable a => a -> Int
hash ( (Toolkit -> Int
forall a. Enum a => a -> Int
fromEnum Toolkit
toolkit
                    , Text
script
                    , SaveFormat -> Int
forall a. Enum a => a -> Int
fromEnum SaveFormat
saveFormat
                    , FilePath
directory)
                  , ( Int
dpi
                    , [Word]
dependenciesHash
                    , [(Text, Text)]
extraAttrs
                    , Version -> FilePath
forall a. Show a => a -> FilePath
show Version
version -- Included version because capture

                    )              -- scripts may change between releases

                  )


-- | Determine the path a figure should have.

-- The path for this file is unique to the content of the figure,

-- so that @figurePath@ can be used to determine whether a figure should

-- be rendered again or not.

figurePath :: FigureSpec -> PlotM FilePath
figurePath :: FigureSpec -> PlotM FilePath
figurePath FigureSpec
spec = do
    Word
fh <- FigureSpec -> PlotM Word
figureContentHash FigureSpec
spec
    let    ext :: FilePath
ext  = SaveFormat -> FilePath
extension (SaveFormat -> FilePath)
-> (FigureSpec -> SaveFormat) -> FigureSpec -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FigureSpec -> SaveFormat
saveFormat (FigureSpec -> FilePath) -> FigureSpec -> FilePath
forall a b. (a -> b) -> a -> b
$ FigureSpec
spec
           stem :: FilePath
stem = (FilePath -> FilePath -> FilePath)
-> FilePath -> FilePath -> FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> FilePath
addExtension FilePath
ext (FilePath -> FilePath) -> (Word -> FilePath) -> Word -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> FilePath
forall a. Show a => a -> FilePath
show (Word -> FilePath) -> Word -> FilePath
forall a b. (a -> b) -> a -> b
$ Word
fh
    FilePath -> PlotM FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> PlotM FilePath) -> FilePath -> PlotM FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
normalise (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FigureSpec -> FilePath
directory FigureSpec
spec FilePath -> FilePath -> FilePath
</> FilePath
stem