{-# LANGUAGE MultiParamTypeClasses #-}
{-# 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
    , toImage
    ) where

import           Control.Monad.Reader

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

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

import           Text.Pandoc.Builder               (fromList, imageWith, link,
                                                    para, toList)
import           Text.Pandoc.Definition            (Block (..), Format)

import           Text.Pandoc.Filter.Plot.Parse     (captionReader)
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 spec :: FigureSpec
spec = do
    IO () -> ReaderT RuntimeEnv IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT RuntimeEnv IO ())
-> IO () -> 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
$ FigureSpec -> FilePath
figurePath FigureSpec
spec

    Bool
fileAlreadyExists <- IO Bool -> ReaderT RuntimeEnv IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT RuntimeEnv IO Bool)
-> (FilePath -> IO Bool) -> FilePath -> ReaderT RuntimeEnv IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
doesFileExist (FilePath -> ReaderT RuntimeEnv IO Bool)
-> FilePath -> ReaderT RuntimeEnv IO Bool
forall a b. (a -> b) -> a -> b
$ FigureSpec -> FilePath
figurePath FigureSpec
spec
    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 -> ReaderT RuntimeEnv IO ()
logScriptResult ScriptResult
result

    case ScriptResult
result of
        ScriptSuccess -> 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 (FigureSpec -> FilePath
sourceCodePath FigureSpec
spec) (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
        other :: ScriptResult
other         -> ScriptResult -> PlotM ScriptResult
forall (m :: * -> *) a. Monad m => a -> m a
return ScriptResult
other

    where
        logScriptResult :: ScriptResult -> ReaderT RuntimeEnv IO ()
logScriptResult ScriptSuccess = () -> ReaderT RuntimeEnv IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () 
        logScriptResult r :: ScriptResult
r             = Text -> ReaderT RuntimeEnv IO ()
err   (Text -> ReaderT RuntimeEnv IO ())
-> (ScriptResult -> Text)
-> ScriptResult
-> 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 -> ReaderT RuntimeEnv IO ())
-> ScriptResult -> 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 ScriptSuccess            = "Script success."
    show (ScriptChecksFailed msg :: Text
msg) = Text -> FilePath
unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ "Script checks failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
    show (ScriptFailure msg :: Text
msg ec :: Int
ec)   = [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat ["Script failed with exit code ", Int -> FilePath
forall a. Show a => a -> FilePath
show Int
ec, " and the following message: ", Text -> FilePath
unpack Text
msg]
    show (ToolkitNotInstalled tk :: Toolkit
tk) = (Toolkit -> FilePath
forall a. Show a => a -> FilePath
show Toolkit
tk) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> " 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{..} = 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 msg :: 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
        CheckPassed -> do
            FilePath
scriptPath <- FigureSpec -> PlotM FilePath
tempScriptPath FigureSpec
spec
            let captureFragment :: Text
captureFragment = (Toolkit -> FigureSpec -> FilePath -> Text
capture Toolkit
toolkit) FigureSpec
spec (FigureSpec -> FilePath
figurePath FigureSpec
spec)
                -- Note: for gnuplot, the capture string must be placed

                --       BEFORE plotting happens. Since this is only really an

                --       issue for gnuplot, we have a special case.

                scriptWithCapture :: Text
scriptWithCapture = if (Toolkit
toolkit Toolkit -> Toolkit -> Bool
forall a. Eq a => a -> a -> Bool
== Toolkit
GNUPlot)
                                        then [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
captureFragment, "\n", Text
script]
                                        else [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
script, "\n", Text
captureFragment]
            IO () -> ReaderT RuntimeEnv IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT RuntimeEnv IO ())
-> IO () -> 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 = FigureSpec -> FilePath
figurePath FigureSpec
spec
                                        }
            Text
command_ <- Toolkit -> OutputSpec -> PlotM Text
command Toolkit
toolkit OutputSpec
outputSpec
            (ec :: ExitCode
ec, _) <- Text -> PlotM (ExitCode, Text)
runCommand Text
command_
            case ExitCode
ec of
                ExitSuccess      -> ScriptResult -> PlotM ScriptResult
forall (m :: * -> *) a. Monad m => a -> m a
return   ScriptResult
ScriptSuccess
                ExitFailure code :: 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 -> 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


-- | Convert a @FigureSpec@ to a Pandoc block component.

-- Note that the script to generate figure files must still

-- be run in another function.

toImage :: Format       -- ^ text format of the caption

        -> FigureSpec 
        -> Block
toImage :: Format -> FigureSpec -> Block
toImage fmt :: Format
fmt spec :: FigureSpec
spec = [Block] -> Block
forall a. [a] -> a
head ([Block] -> Block)
-> (Many Block -> [Block]) -> Many Block -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Block -> [Block]
forall a. Many a -> [a]
toList (Many Block -> Block) -> Many Block -> Block
forall a b. (a -> b) -> a -> b
$ Inlines -> Many Block
para (Inlines -> Many Block) -> Inlines -> Many Block
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
imageWith Attr
attrs' (FilePath -> Text
pack FilePath
target') "fig:" Inlines
caption'
    -- To render images as figures with captions, the target title

    -- must be "fig:"

    -- Janky? yes

    where
        attrs' :: Attr
attrs'       = FigureSpec -> Attr
blockAttrs FigureSpec
spec
        target' :: FilePath
target'      = FigureSpec -> FilePath
figurePath FigureSpec
spec
        withSource' :: Bool
withSource'  = FigureSpec -> Bool
withSource FigureSpec
spec
        srcLink :: Inlines
srcLink      = Text -> Text -> Inlines -> Inlines
link (FilePath -> Text
pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
replaceExtension FilePath
target' ".txt") Text
forall a. Monoid a => a
mempty "Source code"
        captionText :: Inlines
captionText  = [Inline] -> Inlines
forall a. [a] -> Many a
fromList ([Inline] -> Inlines) -> [Inline] -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Maybe [Inline] -> [Inline]
forall a. a -> Maybe a -> a
fromMaybe [Inline]
forall a. Monoid a => a
mempty (Format -> Text -> Maybe [Inline]
captionReader Format
fmt (Text -> Maybe [Inline]) -> Text -> Maybe [Inline]
forall a b. (a -> b) -> a -> b
$ FigureSpec -> Text
caption FigureSpec
spec)
        captionLinks :: Inlines
captionLinks = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat [" (", Inlines
srcLink, ")"]
        caption' :: Inlines
caption'     = if Bool
withSource' then Inlines
captionText Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
captionLinks else Inlines
captionText


-- | 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{..} = do
    let ext :: FilePath
ext = Toolkit -> FilePath
scriptExtension Toolkit
toolkit
    -- Note that matlab will refuse to process files that don't start with

    -- a letter... so we append the renderer name

    -- 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 = "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 -> FilePath
sourceCodePath :: FigureSpec -> FilePath
sourceCodePath = FilePath -> FilePath
normalise (FilePath -> FilePath)
-> (FigureSpec -> FilePath) -> FigureSpec -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath)
-> FilePath -> FilePath -> FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> FilePath
replaceExtension ".txt" (FilePath -> FilePath)
-> (FigureSpec -> FilePath) -> FigureSpec -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FigureSpec -> FilePath
figurePath


-- | 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 -> FilePath
figurePath :: FigureSpec -> FilePath
figurePath spec :: FigureSpec
spec = FilePath -> FilePath
normalise (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FigureSpec -> FilePath
directory FigureSpec
spec FilePath -> FilePath -> FilePath
</> FigureSpec -> FilePath
stem FigureSpec
spec
  where
    stem :: FigureSpec -> 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)
-> (FigureSpec -> FilePath) -> FigureSpec -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> (FigureSpec -> Int) -> FigureSpec -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FigureSpec -> Int
figureContentHash
    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