{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Filter.Plot.Monad (
Configuration(..)
, PlotM
, RuntimeEnv(..)
, runPlotM
, runCommand
, Verbosity(..)
, LogSink(..)
, debug
, err
, warning
, info
, liftIO
, ask
, asks
, asksConfig
, module Text.Pandoc.Filter.Plot.Monad.Types
) where
import Control.Concurrent.Chan (writeChan)
import Control.Monad.Reader
import Data.ByteString.Lazy (toStrict)
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.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 = ReaderT RuntimeEnv IO a
data RuntimeEnv =
RuntimeEnv { RuntimeEnv -> Configuration
envConfig :: Configuration
, RuntimeEnv -> Logger
envLogger :: Logger
}
asksConfig :: (Configuration -> a) -> PlotM a
asksConfig :: (Configuration -> a) -> PlotM a
asksConfig f :: Configuration -> a
f = (RuntimeEnv -> a) -> PlotM a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Configuration -> a
f (Configuration -> a)
-> (RuntimeEnv -> Configuration) -> RuntimeEnv -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeEnv -> Configuration
envConfig)
runPlotM :: Configuration -> PlotM a -> IO a
runPlotM :: Configuration -> PlotM a -> IO a
runPlotM conf :: Configuration
conf v :: PlotM a
v =
let verbosity :: Verbosity
verbosity = Configuration -> Verbosity
logVerbosity Configuration
conf
sink :: LogSink
sink = Configuration -> LogSink
logSink Configuration
conf
in Verbosity -> LogSink -> (Logger -> IO a) -> IO a
forall a. Verbosity -> LogSink -> (Logger -> IO a) -> IO a
withLogger Verbosity
verbosity LogSink
sink ((Logger -> IO a) -> IO a) -> (Logger -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
\logger :: Logger
logger -> PlotM a -> RuntimeEnv -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT PlotM a
v (Configuration -> Logger -> RuntimeEnv
RuntimeEnv Configuration
conf Logger
logger)
debug, err, warning, info :: Text -> PlotM ()
debug :: Text -> PlotM ()
debug = Text -> Verbosity -> Text -> PlotM ()
log "DEBUG| " Verbosity
Debug
err :: Text -> PlotM ()
err = Text -> Verbosity -> Text -> PlotM ()
log "ERROR| " Verbosity
Error
warning :: Text -> PlotM ()
warning = Text -> Verbosity -> Text -> PlotM ()
log "WARN | " Verbosity
Warning
info :: Text -> PlotM ()
info = Text -> Verbosity -> Text -> PlotM ()
log "INFO | " Verbosity
Info
log :: Text
-> Verbosity
-> Text
-> PlotM ()
log :: Text -> Verbosity -> Text -> PlotM ()
log h :: Text
h v :: Verbosity
v t :: Text
t = do
Logger
logger <- (RuntimeEnv -> Logger) -> ReaderT RuntimeEnv IO Logger
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RuntimeEnv -> Logger
envLogger
Bool -> PlotM () -> PlotM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
v Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Logger -> Verbosity
lVerbosity Logger
logger) (PlotM () -> PlotM ()) -> PlotM () -> PlotM ()
forall a b. (a -> b) -> a -> b
$
IO () -> PlotM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PlotM ()) -> IO () -> PlotM ()
forall a b. (a -> b) -> a -> b
$ do
let lines' :: [Text]
lines' = [Text
l' | Text
l' <- Text -> [Text]
T.lines Text
t]
[Text] -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
lines' ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \l :: Text
l -> Chan (Maybe Text) -> Maybe Text -> IO ()
forall a. Chan a -> a -> IO ()
writeChan (Logger -> Chan (Maybe Text)
lChannel Logger
logger) (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"))
runCommand :: Text -> PlotM (ExitCode, Text)
runCommand :: Text -> PlotM (ExitCode, Text)
runCommand command :: Text
command = do
(ec :: ExitCode
ec, processOutput' :: ByteString
processOutput') <- IO (ExitCode, ByteString)
-> ReaderT RuntimeEnv IO (ExitCode, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO (ExitCode, ByteString)
-> ReaderT RuntimeEnv IO (ExitCode, ByteString))
-> IO (ExitCode, ByteString)
-> ReaderT RuntimeEnv IO (ExitCode, ByteString)
forall a b. (a -> b) -> a -> b
$ ProcessConfig () () (STM ByteString) -> IO (ExitCode, ByteString)
forall (m :: * -> *) stdin stdout stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdout stderrIgnored
-> m (ExitCode, ByteString)
readProcessStderr
(ProcessConfig () () (STM ByteString) -> IO (ExitCode, ByteString))
-> ProcessConfig () () (STM ByteString)
-> IO (ExitCode, ByteString)
forall a b. (a -> b) -> a -> b
$ StreamSpec 'STOutput ()
-> ProcessConfig () () (STM ByteString)
-> ProcessConfig () () (STM ByteString)
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
nullStream
(ProcessConfig () () (STM ByteString)
-> ProcessConfig () () (STM ByteString))
-> ProcessConfig () () (STM ByteString)
-> ProcessConfig () () (STM ByteString)
forall a b. (a -> b) -> a -> b
$ StreamSpec 'STOutput (STM ByteString)
-> ProcessConfig () () () -> ProcessConfig () () (STM ByteString)
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr StreamSpec 'STOutput (STM ByteString)
byteStringOutput
(ProcessConfig () () () -> ProcessConfig () () (STM ByteString))
-> ProcessConfig () () () -> ProcessConfig () () (STM ByteString)
forall a b. (a -> b) -> a -> b
$ String -> ProcessConfig () () ()
shell (Text -> String
unpack Text
command)
let processOutput :: Text
processOutput = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict ByteString
processOutput'
Text -> PlotM ()
debug (Text -> PlotM ()) -> Text -> PlotM ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [ "Running command\n"
, " ", Text
command, "\n"
, "ended with exit code ", String -> Text
pack (String -> Text) -> (ExitCode -> String) -> ExitCode -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExitCode -> String
forall a. Show a => a -> String
show (ExitCode -> Text) -> ExitCode -> Text
forall a b. (a -> b) -> a -> b
$ ExitCode
ec
, if Text
processOutput Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
forall a. Monoid a => a
mempty then " and output\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
processOutput else Text
forall a. Monoid a => a
mempty
, "\n"
]
(ExitCode, Text) -> PlotM (ExitCode, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ec, Text
processOutput)
data Configuration = Configuration
{ Configuration -> String
defaultDirectory :: !FilePath
, Configuration -> Bool
defaultWithSource :: !Bool
, Configuration -> Int
defaultDPI :: !Int
, Configuration -> SaveFormat
defaultSaveFormat :: !SaveFormat
, Configuration -> Format
captionFormat :: !Format
, Configuration -> Verbosity
logVerbosity :: !Verbosity
, Configuration -> LogSink
logSink :: !LogSink
, Configuration -> Text
matplotlibPreamble :: !Script
, Configuration -> Text
plotlyPythonPreamble :: !Script
, Configuration -> Text
plotlyRPreamble :: !Script
, Configuration -> Text
matlabPreamble :: !Script
, Configuration -> Text
mathematicaPreamble :: !Script
, Configuration -> Text
octavePreamble :: !Script
, Configuration -> Text
ggplot2Preamble :: !Script
, Configuration -> Text
gnuplotPreamble :: !Script
, Configuration -> Text
graphvizPreamble :: !Script
, Configuration -> String
matplotlibExe :: !FilePath
, Configuration -> String
matlabExe :: !FilePath
, Configuration -> String
plotlyPythonExe :: !FilePath
, Configuration -> String
plotlyRExe :: !FilePath
, Configuration -> String
mathematicaExe :: !FilePath
, Configuration -> String
octaveExe :: !FilePath
, Configuration -> String
ggplot2Exe :: !FilePath
, Configuration -> String
gnuplotExe :: !FilePath
, Configuration -> String
graphvizExe :: !FilePath
, Configuration -> Bool
matplotlibTightBBox :: !Bool
, Configuration -> Bool
matplotlibTransparent :: !Bool
} deriving (Configuration -> Configuration -> Bool
(Configuration -> Configuration -> Bool)
-> (Configuration -> Configuration -> Bool) -> Eq Configuration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Configuration -> Configuration -> Bool
$c/= :: Configuration -> Configuration -> Bool
== :: Configuration -> Configuration -> Bool
$c== :: Configuration -> Configuration -> Bool
Eq, Int -> Configuration -> ShowS
[Configuration] -> ShowS
Configuration -> String
(Int -> Configuration -> ShowS)
-> (Configuration -> String)
-> ([Configuration] -> ShowS)
-> Show Configuration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Configuration] -> ShowS
$cshowList :: [Configuration] -> ShowS
show :: Configuration -> String
$cshow :: Configuration -> String
showsPrec :: Int -> Configuration -> ShowS
$cshowsPrec :: Int -> Configuration -> ShowS
Show)