{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : $header$
Copyright   : (c) Laurent P René de Cotret, 2020
License     : GNU GPL, version 2 or above
Maintainer  : laurent.decotret@outlook.com
Stability   : internal
Portability : portable

This module defines the @PlotM@ monad and related capabilities.
-}

module Text.Pandoc.Filter.Plot.Monad (
      Configuration(..)
    , PlotM
    , runPlotM
    -- * Running external commands

    , runCommand
    -- * Logging

    , Verbosity(..)
    , LogSink(..)
    , debug
    , err
    , warning
    , info
    -- * Lifting and other monadic operations

    , liftIO
    , ask
    , asks
    -- * Base types

    , module Text.Pandoc.Filter.Plot.Monad.Types
) where

import           Control.Monad.Reader

import           Data.ByteString.Lazy        (toStrict)
import           Data.Text                   (Text, pack, unpack)
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
import Text.Pandoc.Filter.Plot.Monad.Types

-- | pandoc-plot monad

type PlotM a = ReaderT Configuration LoggingM a


-- | Evaluate a @PlotM@ action 

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 -> LoggingM a -> IO a
forall a. Verbosity -> LogSink -> LoggingM a -> IO a
runLoggingM Verbosity
verbosity LogSink
sink (PlotM a -> Configuration -> LoggingM a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT PlotM a
v Configuration
conf)


debug :: Text -> PlotM ()
debug :: Text -> PlotM ()
debug t :: Text
t = WriterT [LogMessage] IO () -> PlotM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [LogMessage] IO () -> PlotM ())
-> WriterT [LogMessage] IO () -> PlotM ()
forall a b. (a -> b) -> a -> b
$ Text -> Verbosity -> Text -> WriterT [LogMessage] IO ()
log "DEBUG| " Verbosity
Debug Text
t


err :: Text -> PlotM ()
err :: Text -> PlotM ()
err t :: Text
t = WriterT [LogMessage] IO () -> PlotM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [LogMessage] IO () -> PlotM ())
-> WriterT [LogMessage] IO () -> PlotM ()
forall a b. (a -> b) -> a -> b
$ Text -> Verbosity -> Text -> WriterT [LogMessage] IO ()
log "ERROR| " Verbosity
Error Text
t


warning :: Text -> PlotM ()
warning :: Text -> PlotM ()
warning t :: Text
t = WriterT [LogMessage] IO () -> PlotM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [LogMessage] IO () -> PlotM ())
-> WriterT [LogMessage] IO () -> PlotM ()
forall a b. (a -> b) -> a -> b
$ Text -> Verbosity -> Text -> WriterT [LogMessage] IO ()
log "WARN | " Verbosity
Warning Text
t


info :: Text -> PlotM ()
info :: Text -> PlotM ()
info t :: Text
t = WriterT [LogMessage] IO () -> PlotM ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [LogMessage] IO () -> PlotM ())
-> WriterT [LogMessage] IO () -> PlotM ()
forall a b. (a -> b) -> a -> b
$ Text -> Verbosity -> Text -> WriterT [LogMessage] IO ()
log "INFO | " Verbosity
Info Text
t


-- | Run a command within the @PlotM@ monad. Stdout and Stderr

-- are read and decoded. Logging happens at the debug level.

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 Configuration LoggingM (ExitCode, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 
                        (IO (ExitCode, ByteString)
 -> ReaderT Configuration LoggingM (ExitCode, ByteString))
-> IO (ExitCode, ByteString)
-> ReaderT Configuration LoggingM (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)


-- | The @Configuration@ type holds the default values to use

-- when running pandoc-plot. These values can be overridden in code blocks.

--

-- You can create an instance of the @Configuration@ type from file using the @configuration@ function.

--

-- You can store the path to a configuration file in metadata under the key @plot-configuration@. For example, in Markdown:

--

-- @

--     ---

--     title: My document

--     author: John Doe

--     plot-configuration: /path/to/file.yml

--     ---     

-- @

--

-- The same can be specified via the command line using Pandoc's @-M@ flag:

--

-- > pandoc --filter pandoc-plot -M plot-configuration="path/to/file.yml" ...

--

-- In this case, use @configurationPathMeta@ to extact the path from @Pandoc@ documents.

data Configuration = Configuration
    { Configuration -> String
defaultDirectory      :: !FilePath   -- ^ The default directory where figures will be saved.

    , Configuration -> Bool
defaultWithSource     :: !Bool       -- ^ The default behavior of whether or not to include links to source code and high-res

    , Configuration -> Int
defaultDPI            :: !Int        -- ^ The default dots-per-inch value for generated figures. Renderers might ignore this.

    , Configuration -> SaveFormat
defaultSaveFormat     :: !SaveFormat -- ^ The default save format of generated figures.

    , Configuration -> Format
captionFormat         :: !Format     -- ^ Caption format, in the same notation as Pandoc format, e.g. "markdown+tex_math_dollars"


    , Configuration -> Verbosity
logVerbosity          :: !Verbosity  -- ^ Level of logging verbosity.

    , Configuration -> LogSink
logSink               :: !LogSink    -- ^ Method of logging, i.e. printing to stderr or file.


    , Configuration -> Text
matplotlibPreamble    :: !Script     -- ^ The default preamble script for the matplotlib toolkit.

    , Configuration -> Text
plotlyPythonPreamble  :: !Script     -- ^ The default preamble script for the Plotly/Python toolkit.

    , Configuration -> Text
plotlyRPreamble       :: !Script     -- ^ The default preamble script for the Plotly/R toolkit.

    , Configuration -> Text
matlabPreamble        :: !Script     -- ^ The default preamble script for the MATLAB toolkit.

    , Configuration -> Text
mathematicaPreamble   :: !Script     -- ^ The default preamble script for the Mathematica toolkit.

    , Configuration -> Text
octavePreamble        :: !Script     -- ^ The default preamble script for the GNU Octave toolkit.

    , Configuration -> Text
ggplot2Preamble       :: !Script     -- ^ The default preamble script for the GGPlot2 toolkit.

    , Configuration -> Text
gnuplotPreamble       :: !Script     -- ^ The default preamble script for the gnuplot toolkit.

    , Configuration -> Text
graphvizPreamble      :: !Script     -- ^ The default preamble script for the Graphviz toolkit.

    
    , Configuration -> String
matplotlibExe         :: !FilePath   -- ^ The executable to use to generate figures using the matplotlib toolkit.

    , Configuration -> String
matlabExe             :: !FilePath   -- ^ The executable to use to generate figures using the MATLAB toolkit.

    , Configuration -> String
plotlyPythonExe       :: !FilePath   -- ^ The executable to use to generate figures using the Plotly/Python toolkit.

    , Configuration -> String
plotlyRExe            :: !FilePath   -- ^ The executable to use to generate figures using the Plotly/R toolkit.

    , Configuration -> String
mathematicaExe        :: !FilePath   -- ^ The executable to use to generate figures using the Mathematica toolkit.

    , Configuration -> String
octaveExe             :: !FilePath   -- ^ The executable to use to generate figures using the GNU Octave toolkit.

    , Configuration -> String
ggplot2Exe            :: !FilePath   -- ^ The executable to use to generate figures using the GGPlot2 toolkit.

    , Configuration -> String
gnuplotExe            :: !FilePath   -- ^ The executable to use to generate figures using the gnuplot toolkit.

    , Configuration -> String
graphvizExe           :: !FilePath   -- ^ The executable to use to generate figures using the Graphviz toolkit.

    
    , Configuration -> Bool
matplotlibTightBBox   :: !Bool       -- ^ Whether or not to make Matplotlib figures tight by default.

    , Configuration -> Bool
matplotlibTransparent :: !Bool       -- ^ Whether or not to make Matplotlib figures transparent by default.

    } 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)