{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Filter.Plot
(
plotTransform,
cleanOutputDirs,
configuration,
defaultConfiguration,
Configuration (..),
Verbosity (..),
LogSink (..),
SaveFormat (..),
Script,
Toolkit (..),
availableToolkits,
unavailableToolkits,
toolkits,
supportedSaveFormats,
pandocPlotVersion,
make,
makeEither,
PandocPlotError (..),
)
where
import Control.Concurrent (getNumCapabilities)
import Data.Functor ((<&>))
import Data.Text (Text, pack, unpack)
import Data.Version (Version)
import Paths_pandoc_plot (version)
import Text.Pandoc.Definition (Block, Pandoc (..))
import Text.Pandoc.Filter.Plot.Internal
( Configuration (..),
FigureSpec,
LogSink (..),
ParseFigureResult (..),
PlotM,
RuntimeEnv (envConfig),
SaveFormat (..),
Script,
ScriptResult (..),
Toolkit (..),
Verbosity (..),
asks,
availableToolkits,
cleanOutputDirs,
configuration,
debug,
defaultConfiguration,
mapConcurrentlyN,
parseFigureSpec,
runPlotM,
runScriptIfNecessary,
supportedSaveFormats,
throwStrictError,
toFigure,
toolkits,
unavailableToolkits,
whenStrict,
)
import Text.Pandoc.Walk (walkM)
plotTransform ::
Configuration ->
Pandoc ->
IO Pandoc
plotTransform :: Configuration -> Pandoc -> IO Pandoc
plotTransform Configuration
conf (Pandoc Meta
meta [Block]
blocks) = do
Int
maxproc <- IO Int
getNumCapabilities
Maybe Format -> Configuration -> PlotM Pandoc -> IO Pandoc
forall a. Maybe Format -> Configuration -> PlotM a -> IO a
runPlotM Maybe Format
forall a. Maybe a
Nothing Configuration
conf (PlotM Pandoc -> IO Pandoc) -> PlotM Pandoc -> IO Pandoc
forall a b. (a -> b) -> a -> b
$ do
Text -> StateT PlotState (ReaderT RuntimeEnv IO) ()
forall (m :: * -> *). (MonadLogger m, MonadIO m) => Text -> m ()
debug (Text -> StateT PlotState (ReaderT RuntimeEnv IO) ())
-> Text -> StateT PlotState (ReaderT RuntimeEnv IO) ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"Starting a new run, utilizing at most ", String -> Text
pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
maxproc, Text
" processes."]
Int -> (Block -> PlotM Block) -> [Block] -> PlotM [Block]
forall (t :: * -> *) a b.
Traversable t =>
Int -> (a -> PlotM b) -> t a -> PlotM (t b)
mapConcurrentlyN Int
maxproc Block -> PlotM Block
make [Block]
blocks PlotM [Block] -> ([Block] -> Pandoc) -> PlotM Pandoc
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Meta -> [Block] -> Pandoc
Pandoc Meta
meta
pandocPlotVersion :: Version
pandocPlotVersion :: Version
pandocPlotVersion = Version
version
make :: Block -> PlotM Block
make :: Block -> PlotM Block
make = (Block -> PlotM Block) -> Block -> PlotM Block
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM ((Block -> PlotM Block) -> Block -> PlotM Block)
-> (Block -> PlotM Block) -> Block -> PlotM Block
forall a b. (a -> b) -> a -> b
$ \Block
blk -> (PandocPlotError -> PlotM Block)
-> (Block -> PlotM Block)
-> Either PandocPlotError Block
-> PlotM Block
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Block -> PandocPlotError -> PlotM Block
onError Block
blk) Block -> PlotM Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocPlotError Block -> PlotM Block)
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
-> PlotM Block
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Block
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
makeEither Block
blk
where
onError :: Block -> PandocPlotError -> PlotM Block
onError :: Block -> PandocPlotError -> PlotM Block
onError Block
b PandocPlotError
e = do
StateT PlotState (ReaderT RuntimeEnv IO) ()
-> StateT PlotState (ReaderT RuntimeEnv IO) ()
whenStrict (StateT PlotState (ReaderT RuntimeEnv IO) ()
-> StateT PlotState (ReaderT RuntimeEnv IO) ())
-> StateT PlotState (ReaderT RuntimeEnv IO) ()
-> StateT PlotState (ReaderT RuntimeEnv IO) ()
forall a b. (a -> b) -> a -> b
$ Text -> StateT PlotState (ReaderT RuntimeEnv IO) ()
throwStrictError (String -> Text
pack (String -> Text)
-> (PandocPlotError -> String) -> PandocPlotError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocPlotError -> String
forall a. Show a => a -> String
show (PandocPlotError -> Text) -> PandocPlotError -> Text
forall a b. (a -> b) -> a -> b
$ PandocPlotError
e)
Block -> PlotM Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
b
makeEither :: Block -> PlotM (Either PandocPlotError Block)
makeEither :: Block
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
makeEither Block
block =
Block -> PlotM ParseFigureResult
parseFigureSpec Block
block
PlotM ParseFigureResult
-> (ParseFigureResult
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block))
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ParseFigureResult
NotAFigure -> Either PandocPlotError Block
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocPlotError Block
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block))
-> Either PandocPlotError Block
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall a b. (a -> b) -> a -> b
$ Block -> Either PandocPlotError Block
forall a b. b -> Either a b
Right Block
block
Figure FigureSpec
fs -> FigureSpec -> PlotM ScriptResult
runScriptIfNecessary FigureSpec
fs PlotM ScriptResult
-> (ScriptResult
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block))
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FigureSpec
-> ScriptResult
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
handleResult FigureSpec
fs
MissingToolkit Toolkit
tk -> Either PandocPlotError Block
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocPlotError Block
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block))
-> Either PandocPlotError Block
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall a b. (a -> b) -> a -> b
$ PandocPlotError -> Either PandocPlotError Block
forall a b. a -> Either a b
Left (PandocPlotError -> Either PandocPlotError Block)
-> PandocPlotError -> Either PandocPlotError Block
forall a b. (a -> b) -> a -> b
$ Toolkit -> PandocPlotError
ToolkitNotInstalledError Toolkit
tk
where
handleResult :: FigureSpec -> ScriptResult -> PlotM (Either PandocPlotError Block)
handleResult :: FigureSpec
-> ScriptResult
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
handleResult FigureSpec
_ (ScriptFailure Text
cmd Int
code Text
_) = Either PandocPlotError Block
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocPlotError Block
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block))
-> Either PandocPlotError Block
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall a b. (a -> b) -> a -> b
$ PandocPlotError -> Either PandocPlotError Block
forall a b. a -> Either a b
Left (Text -> Int -> PandocPlotError
ScriptRuntimeError Text
cmd Int
code)
handleResult FigureSpec
_ (ScriptChecksFailed Text
msg) = Either PandocPlotError Block
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocPlotError Block
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block))
-> Either PandocPlotError Block
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall a b. (a -> b) -> a -> b
$ PandocPlotError -> Either PandocPlotError Block
forall a b. a -> Either a b
Left (Text -> PandocPlotError
ScriptChecksFailedError Text
msg)
handleResult FigureSpec
spec ScriptResult
ScriptSuccess = (RuntimeEnv -> Configuration)
-> StateT PlotState (ReaderT RuntimeEnv IO) Configuration
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RuntimeEnv -> Configuration
envConfig StateT PlotState (ReaderT RuntimeEnv IO) Configuration
-> (Configuration
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block))
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Configuration
c -> Block -> Either PandocPlotError Block
forall a b. b -> Either a b
Right (Block -> Either PandocPlotError Block)
-> PlotM Block
-> StateT
PlotState (ReaderT RuntimeEnv IO) (Either PandocPlotError Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Format -> FigureSpec -> PlotM Block
toFigure (Configuration -> Format
captionFormat Configuration
c) FigureSpec
spec
data PandocPlotError
= ScriptRuntimeError Text Int
| ScriptChecksFailedError Text
| ToolkitNotInstalledError Toolkit
instance Show PandocPlotError where
show :: PandocPlotError -> String
show (ScriptRuntimeError Text
_ Int
exitcode) = String
"ERROR (pandoc-plot) The script failed with exit code " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
exitcode String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
show (ScriptChecksFailedError Text
msg) = String
"ERROR (pandoc-plot) A script check failed with message: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
msg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
show (ToolkitNotInstalledError Toolkit
tk) = String
"ERROR (pandoc-plot) The " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Toolkit -> String
forall a. Show a => a -> String
show Toolkit
tk String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" toolkit is required but not installed."