{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Unsafe #-}
module Text.Pandoc.Filter.Pyplot
( makePlot
, plotTransform
, PandocPyplotError(..)
, makePlot'
, directoryKey
, captionKey
, dpiKey
, includePathKey
, saveFormatKey
) where
import Control.Monad ((>=>))
import Data.List (intersperse)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Version (showVersion)
import Paths_pandoc_pyplot (version)
import System.Directory (createDirectoryIfMissing,
doesFileExist)
import System.FilePath (isValid, makeValid,
replaceExtension, takeDirectory)
import Text.Pandoc.Definition
import Text.Pandoc.Walk (walkM)
import Text.Pandoc.Filter.FigureSpec (FigureSpec (..),
SaveFormat (..), addPlotCapture,
figurePath, hiresFigurePath,
saveFormatFromString)
import Text.Pandoc.Filter.Scripting
data PandocPyplotError
= ScriptError Int
| InvalidTargetError FilePath
| BlockingCallError
deriving (Eq)
instance Show PandocPyplotError where
show (ScriptError exitcode) =
"Script error: plot could not be generated. Exit code " <> (show exitcode)
show (InvalidTargetError fname) = "Target filename " <> fname <> " is not valid."
show BlockingCallError = "Script contains a blocking call to show, like 'plt.show()'"
directoryKey, captionKey, dpiKey, includePathKey, saveFormatKey :: String
directoryKey = "directory"
captionKey = "caption"
dpiKey = "dpi"
includePathKey = "include"
saveFormatKey = "format"
inclusionKeys :: [String]
inclusionKeys = [directoryKey, captionKey, dpiKey, includePathKey, saveFormatKey]
parseFigureSpec :: Block -> IO (Maybe FigureSpec)
parseFigureSpec (CodeBlock (id', cls, attrs) content)
| "pyplot" `elem` cls = Just <$> figureSpec
| otherwise = return Nothing
where
attrs' = Map.fromList attrs
filteredAttrs = filter (\(k, _) -> k `notElem` inclusionKeys) attrs
dir = makeValid $ Map.findWithDefault "generated" directoryKey attrs'
format = fromMaybe (PNG) $ saveFormatFromString $ Map.findWithDefault "png" saveFormatKey attrs'
includePath = Map.lookup includePathKey attrs'
figureSpec :: IO FigureSpec
figureSpec = do
includeScript <- fromMaybe (return "") $ T.readFile <$> includePath
let header = "# Generated by pandoc-pyplot " <> ((T.pack . showVersion) version)
fullScript = mconcat $ intersperse "\n" [header, includeScript, T.pack content]
caption' = Map.findWithDefault mempty captionKey attrs'
dpi' = read $ Map.findWithDefault "80" dpiKey attrs'
blockAttrs' = (id', filter (/= "pyplot") cls, filteredAttrs)
return $ FigureSpec caption' fullScript format dir dpi' blockAttrs'
parseFigureSpec _ = return Nothing
validateSpec :: FigureSpec -> Maybe PandocPyplotError
validateSpec spec
| not (isValid path) = Just $ InvalidTargetError path
| hasBlockingShowCall rendered = Just $ BlockingCallError
| otherwise = Nothing
where
path = figurePath spec
rendered = script spec
runScriptIfNecessary :: FigureSpec -> IO ScriptResult
runScriptIfNecessary spec = do
createDirectoryIfMissing True . takeDirectory $ figurePath spec
fileAlreadyExists <- doesFileExist $ figurePath spec
if fileAlreadyExists
then return ScriptSuccess
else do
result <- runTempPythonScript $ addPlotCapture spec
case result of
ScriptFailure code -> return $ ScriptFailure code
ScriptSuccess
-> do
let sourcePath = replaceExtension (figurePath spec) ".txt"
T.writeFile sourcePath $ script spec
return ScriptSuccess
makePlot' :: Block -> IO (Either PandocPyplotError Block)
makePlot' block = do
parsed <- parseFigureSpec block
case parsed of
Nothing -> return $ Right block
Just spec ->
case validateSpec spec of
Just err -> return $ Left err
Nothing -> do
result <- runScriptIfNecessary spec
case result of
ScriptFailure code -> return $ Left $ ScriptError code
ScriptSuccess -> do
let relevantAttrs = blockAttrs spec
sourcePath = replaceExtension (figurePath spec) ".txt"
hiresPath = hiresFigurePath spec
srcTarget = Link nullAttr [Str "Source code"] (sourcePath, "")
hiresTarget = Link nullAttr [Str "high res."] (hiresPath, "")
caption' =
[ Str $ caption spec
, Space
, Str "("
, srcTarget
, Str ","
, Space
, hiresTarget
, Str ")"
]
image = Image relevantAttrs caption' (figurePath spec, "fig:")
return $ Right $ Para $ [image]
makePlot :: Block -> IO Block
makePlot = makePlot' >=> either (fail . show) return
plotTransform :: Pandoc -> IO Pandoc
plotTransform = walkM makePlot