{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Filter.Plot.Monad (
Configuration(..)
, PlotM
, RuntimeEnv(..)
, runPlotM
, runCommand
, fileHash
, 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)
import System.Exit (ExitCode (..))
import System.Process.Typed ( readProcessStderr, shell, nullStream
, setStdout, setStderr, byteStringOutput
)
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
}
silence :: PlotM a -> PlotM a
silence = local (\(RuntimeEnv c l) -> RuntimeEnv c l{lVerbosity = Silent})
asksConfig :: (Configuration -> a) -> PlotM a
asksConfig f = asks (f . envConfig)
runPlotM :: Configuration -> PlotM a -> IO a
runPlotM conf v = do
st <- newMVar mempty
let verbosity = logVerbosity conf
sink = logSink conf
withLogger verbosity sink $
\logger -> runReaderT (evalStateT v st) (RuntimeEnv conf logger)
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
let lines' = [l' | l' <- T.lines t]
forM_ lines' $ \l -> writeChan (lChannel logger) (Just (h <> l <> "\n"))
runCommand :: Text -> PlotM (ExitCode, Text)
runCommand command = do
(ec, processOutput') <- liftIO
$ readProcessStderr
$ setStdout nullStream
$ setStderr byteStringOutput
$ 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
type PlotState = MVar (Map FilePath FileHash)
fileHash :: FilePath -> PlotM FileHash
fileHash path = do
var <- get
hashes <- liftIO $ takeMVar var
(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 var hashes'
put var
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
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)