{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Filter.Plot.Monad (
Configuration(..)
, PlotM
, RuntimeEnv(..)
, runPlotM
, runCommand
, fileHash
, executable
, Verbosity(..)
, LogSink(..)
, debug
, err
, warning
, info
, liftIO
, ask
, asks
, asksConfig
, silence
, module Text.Pandoc.Filter.Plot.Monad.Types
) where
import Control.Concurrent.Chan (writeChan)
import Control.Concurrent.MVar
import Control.Monad.Reader
import Control.Monad.State.Strict
import Data.ByteString.Lazy (toStrict)
import Data.Hashable (hash)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Text (Text, pack, unpack)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import System.Directory ( doesFileExist, getModificationTime
, findExecutable, getCurrentDirectory
)
import System.Exit (ExitCode (..))
import System.Process.Typed ( readProcessStderr, shell, nullStream
, setStdout, setStderr, byteStringOutput
, setWorkingDir
)
import Text.Pandoc.Definition (Format(..))
import Prelude hiding (log, fst, snd)
import Text.Pandoc.Filter.Plot.Monad.Logging as Log
import Text.Pandoc.Filter.Plot.Monad.Types
type PlotM a = StateT PlotState (ReaderT RuntimeEnv IO) a
data RuntimeEnv =
RuntimeEnv { envConfig :: Configuration
, envLogger :: Logger
, envCWD :: FilePath
}
silence :: PlotM a -> PlotM a
silence = local (\(RuntimeEnv c l d) -> RuntimeEnv c l{lVerbosity = Silent} d)
asksConfig :: (Configuration -> a) -> PlotM a
asksConfig f = asks (f . envConfig)
runPlotM :: Configuration -> PlotM a -> IO a
runPlotM conf v = do
cwd <- getCurrentDirectory
st <- PlotState <$> newMVar mempty
<*> newMVar mempty
let verbosity = logVerbosity conf
sink = logSink conf
withLogger verbosity sink $
\logger -> runReaderT (evalStateT v st) (RuntimeEnv conf logger cwd)
debug, err, warning, info :: Text -> PlotM ()
debug = log "DEBUG | " Debug
err = log "ERROR | " Error
warning = log "WARN | " Warning
info = log "INFO | " Info
log :: Text
-> Verbosity
-> Text
-> PlotM ()
log h v t = do
logger <- asks envLogger
when (v >= lVerbosity logger) $
liftIO $ do
forM_ ( T.lines t) $ \l -> writeChan (lChannel logger) (Just (h <> l <> "\n"))
runCommand :: FilePath
-> Text
-> PlotM (ExitCode, Text)
runCommand wordir command = do
(ec, processOutput') <- liftIO
$ readProcessStderr
$ setStdout nullStream
$ setStderr byteStringOutput
$ setWorkingDir wordir
$ shell (unpack command)
let processOutput = decodeUtf8With lenientDecode $ toStrict processOutput'
logFunc = if ec == ExitSuccess
then debug
else err
message = T.unlines [ "Running command"
, " " <> command
, "ended with exit code " <> (pack . show $ ec)
]
errorMessage = if processOutput == mempty
then mempty
else T.unlines [ "*******"
, processOutput
, "*******"
]
logFunc $ message <> errorMessage
return (ec, processOutput)
type FileHash = Word
data PlotState =
PlotState (MVar (Map FilePath FileHash))
(MVar (Map Toolkit (Maybe Executable)))
fileHash :: FilePath -> PlotM FileHash
fileHash path = do
PlotState varHashes varExes <- get
hashes <- liftIO $ takeMVar varHashes
(fh, hashes') <- case M.lookup path hashes of
Nothing -> do
debug $ mconcat ["Calculating hash of dependency ", pack path]
fh <- fileHash' path
let hashes' = M.insert path fh hashes
return (fh, hashes')
Just h -> do
debug $ mconcat ["Hash of dependency ", pack path, " already calculated."]
return (h, hashes)
liftIO $ putMVar varHashes hashes'
put $ PlotState varHashes varExes
return fh
where
fileHash' :: FilePath -> PlotM FileHash
fileHash' fp = do
fileExists <- liftIO $ doesFileExist fp
if fileExists
then liftIO . fmap (fromIntegral . hash . show) . getModificationTime $ fp
else err (mconcat ["Dependency ", pack fp, " does not exist."]) >> return 0
executable :: Toolkit -> PlotM (Maybe Executable)
executable tk = do
name <- exeSelector tk
PlotState varHashes varExes <- get
exes <- liftIO $ takeMVar varExes
(exe', exes') <- case M.lookup tk exes of
Nothing -> do
debug $ mconcat ["Looking for executable \"", pack name, "\" for ", pack $ show tk]
exe' <- liftIO $ findExecutable name >>= return . fmap exeFromPath
let exes' = M.insert tk exe' exes
return (exe', exes')
Just e -> do
debug $ mconcat ["Executable \"", pack name, "\" already found."]
return (e, exes)
liftIO $ putMVar varExes exes'
put $ PlotState varHashes varExes
return exe'
where
exeSelector Matplotlib = asksConfig matplotlibExe
exeSelector PlotlyPython = asksConfig plotlyPythonExe
exeSelector PlotlyR = asksConfig plotlyRExe
exeSelector Matlab = asksConfig matlabExe
exeSelector Mathematica = asksConfig mathematicaExe
exeSelector Octave = asksConfig octaveExe
exeSelector GGPlot2 = asksConfig ggplot2Exe
exeSelector GNUPlot = asksConfig gnuplotExe
exeSelector Graphviz = asksConfig graphvizExe
exeSelector Bokeh = asksConfig bokehExe
exeSelector Plotsjl = asksConfig plotsjlExe
data Configuration = Configuration
{ defaultDirectory :: !FilePath
, defaultWithSource :: !Bool
, defaultDPI :: !Int
, defaultSaveFormat :: !SaveFormat
, defaultDependencies :: ![FilePath]
, captionFormat :: !Format
, logVerbosity :: !Verbosity
, logSink :: !LogSink
, matplotlibPreamble :: !Script
, plotlyPythonPreamble :: !Script
, plotlyRPreamble :: !Script
, matlabPreamble :: !Script
, mathematicaPreamble :: !Script
, octavePreamble :: !Script
, ggplot2Preamble :: !Script
, gnuplotPreamble :: !Script
, graphvizPreamble :: !Script
, bokehPreamble :: !Script
, plotsjlPreamble :: !Script
, matplotlibExe :: !FilePath
, matlabExe :: !FilePath
, plotlyPythonExe :: !FilePath
, plotlyRExe :: !FilePath
, mathematicaExe :: !FilePath
, octaveExe :: !FilePath
, ggplot2Exe :: !FilePath
, gnuplotExe :: !FilePath
, graphvizExe :: !FilePath
, bokehExe :: !FilePath
, plotsjlExe :: !FilePath
, matplotlibTightBBox :: !Bool
, matplotlibTransparent :: !Bool
} deriving (Eq, Show)