{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
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
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
data ScriptResult
= ScriptSuccess
| ScriptChecksFailed Text
| ScriptFailure Text Int
| ToolkitNotInstalled Toolkit
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."
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
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
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
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
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
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
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
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
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
)
)
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