module Text.Pandoc.R where
import Control.Applicative
import Control.Monad
import Data.List (delete)
import Data.List.Split
import Data.Maybe
import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile, renameFile)
import System.Exit (ExitCode (..))
import System.FilePath ((<.>), (</>), pathSeparator)
import System.IO (hPutStrLn, stderr)
import System.Process
import Text.Pandoc.Generic
import Text.Pandoc.JSON
rClass, fileAttr, defFile, defRplot, tmpRFile :: String
rClass = "Rplot"
fileAttr = "files"
defFile = "Rplot.png"
defRplot = "Rplots.pdf"
tmpRFile = "plot.R"
renderRPandoc :: FilePath -> Pandoc -> IO Pandoc
renderRPandoc f p = bottomUpM (insertRplots f) p
insertRplots :: FilePath -> Block -> IO Block
insertRplots outDir block@(CodeBlock (ident, classes, attrs) code) = do
if rClass `elem` classes then do
let imgFiles = case lookup fileAttr attrs of
Just is -> splitOn "," is
Nothing -> [defFile]
d <- renderRPlot code
when (imgFiles == [defFile]) $ void $ convertDefault
imgFiles' <- moveFiles imgFiles outDir
return $ if d then Plain (map insertImage imgFiles') else block
else return block
insertRplots _ block = return block
insertImage :: FilePath -> Inline
insertImage file = Image [] (file,"")
--png(filename="fig1.png")
renderRPlot :: String -> IO Bool
renderRPlot rcode = do
writeFile tmpRFile rcode
(code,stdout,stderr) <- readProcessWithExitCode "R" ["CMD", "BATCH", "--no-save", "--quiet", tmpRFile] ""
when (code /= ExitSuccess) $ do
putStrLnErr $ "R exited with: " ++ (show code)
putStrLnErr stdout
putStrLnErr stderr
whenM (doesFileExist tmpRFile) $ removeFile tmpRFile
whenM (doesFileExist "plot.Rout") $ removeFile "plot.Rout"
return $ (code==ExitSuccess)
moveFiles :: [FilePath] -> FilePath -> IO [FilePath]
moveFiles files outDir = do
createDirectoryIfMissing False outDir
mapM_ (\a -> whenM (doesFileExist a) $ renameFile a (outDir </> a)) files
return $ map ((pathSeparator : outDir) </>) files
convertDefault :: IO Bool
convertDefault = do
(code,_,_) <- readProcessWithExitCode "convert" [defRplot, defFile] ""
whenM (doesFileExist defRplot) $ void $ removeFile defRplot
return $ (code==ExitSuccess)
putStrLnErr = hPutStrLn stderr
whenM :: Monad m => m Bool -> m () -> m ()
whenM cond a = do
c <- cond
if c then a else (return ())