summaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Filter/Plot/Scripting.hs
blob: 676fb3a5d468fcd019c57ec1892348994d3cfd73 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
{-# 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.Monoid                       ((<>))
import qualified Data.Text                         as T
import qualified Data.Text.IO                      as T

import           System.Directory                  (createDirectoryIfMissing,
                                                    doesFileExist)
import           System.Exit                       (ExitCode (..))
import           System.FilePath                   (FilePath, addExtension,
                                                    normalise, replaceExtension,
                                                    takeDirectory, (</>))
import           System.IO.Temp                    (getCanonicalTemporaryDirectory)
import           System.Process.Typed              (runProcess, shell, setStdout, nullStream)

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


-- | Possible result of running a script
data ScriptResult
    = ScriptSuccess
    | ScriptChecksFailed String   -- Message
    | ScriptFailure String Int    -- Command and exit code
    | ToolkitNotInstalled Toolkit -- Script failed because toolkit is not installed

-- Run script as described by the spec, only if necessary
runScriptIfNecessary :: FigureSpec -> PlotM ScriptResult
runScriptIfNecessary spec = do
    liftIO $ createDirectoryIfMissing True . takeDirectory $ figurePath spec

    fileAlreadyExists <- liftIO . doesFileExist $ figurePath spec
    result <- if fileAlreadyExists
                then return ScriptSuccess
                else runTempScript spec

    case result of
        ScriptSuccess      -> liftIO $ T.writeFile (sourceCodePath spec) (script spec) >> return ScriptSuccess
        other -> return other


-- 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 spec@FigureSpec{..} = do
    tk <- asks toolkit
    conf <- asks config
    let checks = scriptChecks tk
        checkResult = mconcat $ checks <*> [script]
    case checkResult of
        CheckFailed msg -> return $ ScriptChecksFailed msg
        CheckPassed -> do
            -- We involve the script hash as a temporary filename
            -- so that there is never any collision
            scriptPath <- tempScriptPath spec
            let captureFragment = (capture tk) spec (figurePath 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 = if (tk == GNUPlot)
                                        then mconcat [captureFragment, "\n", script]
                                        else mconcat [script, "\n", captureFragment]
            liftIO $ T.writeFile scriptPath scriptWithCapture
            let command_ = T.unpack $ command tk conf spec scriptPath

            ec <- liftIO 
                    $ runProcess 
                    $ setStdout nullStream
                    $ shell command_
            case ec of
                ExitSuccess      -> return   ScriptSuccess
                ExitFailure code -> do
                    -- Two possible types of failures: either the script
                    -- failed because the toolkit was not available, or
                    -- because of a genuine error
                    toolkitInstalled <- liftIO $ toolkitAvailable tk conf 
                    if toolkitInstalled
                        then return $ ScriptFailure command_ code
                        else return $ ToolkitNotInstalled tk


-- | 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 fmt spec = head . toList $ para $ imageWith attrs' (T.pack target') "fig:" caption'
    -- To render images as figures with captions, the target title
    -- must be "fig:"
    -- Janky? yes
    where
        attrs'       = blockAttrs spec
        target'      = figurePath spec
        withSource'  = withSource spec
        srcLink      = link (T.pack $ replaceExtension target' ".txt") mempty "Source code"
        captionText  = fromList $ fromMaybe mempty (captionReader fmt $ caption spec)
        captionLinks = mconcat [" (", srcLink, ")"]
        caption'     = if withSource' then captionText <> captionLinks else 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{..} = do
    tk <- asks toolkit
    -- Note that matlab will refuse to process files that don't start with
    -- a letter... so we append the renderer name
    let ext = scriptExtension tk
        hashedPath = "pandocplot" <> (show . abs . hash $ script) <> ext
    liftIO $ (</> hashedPath) <$> getCanonicalTemporaryDirectory


-- | Determine the path to the source code that generated the figure.
sourceCodePath :: FigureSpec -> FilePath
sourceCodePath = normalise . flip replaceExtension ".txt" . figurePath


-- | Determine the path a figure should have.
figurePath :: FigureSpec -> FilePath
figurePath spec = normalise $ directory spec </> stem spec
  where
    stem = flip addExtension ext . show . hash
    ext  = extension . saveFormat $ spec