{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Filter.Plot
(
plotFilter,
plotTransform,
cleanOutputDirs,
configuration,
defaultConfiguration,
Configuration (..),
Verbosity (..),
LogSink (..),
SaveFormat (..),
Script,
Toolkit (..),
availableToolkits,
unavailableToolkits,
toolkits,
supportedSaveFormats,
pandocPlotVersion,
make,
makeEither,
PandocPlotError (..),
)
where
import Control.Concurrent (getNumCapabilities)
import Control.Monad.Reader (when)
import Data.Functor ((<&>))
import Data.Map (singleton)
import Data.Text (Text, pack, unpack)
import Data.Version (Version)
import Paths_pandoc_plot (version)
import Text.Pandoc.Definition (Block, Meta (..), Format, MetaValue (..), Pandoc (..))
import Text.Pandoc.Filter.Plot.Internal
( Configuration (..),
FigureSpec,
LogSink (..),
ParseFigureResult (..),
PlotM,
RuntimeEnv (envConfig),
SaveFormat (..),
Script,
ScriptResult (..),
Toolkit (..),
Verbosity (..),
asks,
asksConfig,
availableToolkits,
cleanOutputDirs,
configuration,
debug,
defaultConfiguration,
mapConcurrentlyN,
parseFigureSpec,
runPlotM,
runScriptIfNecessary,
supportedSaveFormats,
throwStrictError,
toFigure,
toolkits,
unavailableToolkits,
)
import Text.Pandoc.Walk (walkM)
plotFilter ::
Configuration ->
Maybe Format ->
Pandoc ->
IO Pandoc
plotFilter :: Configuration -> Maybe Format -> Pandoc -> IO Pandoc
plotFilter Configuration
conf Maybe Format
mfmt (Pandoc Meta
meta [Block]
blocks) = do
Int
maxproc <- IO Int
getNumCapabilities
forall a. Maybe Format -> Configuration -> PlotM a -> IO a
runPlotM Maybe Format
mfmt Configuration
conf forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). (MonadLogger m, MonadIO m) => Text -> m ()
debug forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Text
"Starting a new run, utilizing at most ", String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
maxproc, Text
" processes."]
forall (t :: * -> *) a b.
Traversable t =>
Int -> (a -> PlotM b) -> t a -> PlotM (t b)
mapConcurrentlyN Int
maxproc Block -> PlotM Block
make [Block]
blocks forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Meta -> [Block] -> Pandoc
Pandoc Meta
newMeta
where
newMeta :: Meta
newMeta = Meta
meta forall a. Semigroup a => a -> a -> a
<> Map Text MetaValue -> Meta
Meta (forall k a. k -> a -> Map k a
singleton Text
"graphics" forall a b. (a -> b) -> a -> b
$ Bool -> MetaValue
MetaBool Bool
True)
plotTransform ::
Configuration ->
Pandoc ->
IO Pandoc
{-# DEPRECATED plotTransform
[ "plotTransform has been deprecated in favour of plotFilter, which is aware of conversion format."
, "plotTransform will be removed in an upcoming major update."
]
#-}
plotTransform :: Configuration -> Pandoc -> IO Pandoc
plotTransform Configuration
conf = Configuration -> Maybe Format -> Pandoc -> IO Pandoc
plotFilter Configuration
conf forall a. Maybe a
Nothing
pandocPlotVersion :: Version
pandocPlotVersion :: Version
pandocPlotVersion = Version
version
make :: Block -> PlotM Block
make :: Block -> PlotM Block
make = forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM forall a b. (a -> b) -> a -> b
$ \Block
blk -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Block -> PandocPlotError -> PlotM Block
onError Block
blk) forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Block -> PlotM (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 forall a b. (a -> b) -> a -> b
$ Text -> StateT PlotState (ReaderT RuntimeEnv IO) ()
throwStrictError (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ PandocPlotError
e)
forall (m :: * -> *) a. Monad m => a -> m a
return Block
b
whenStrict :: StateT PlotState (ReaderT RuntimeEnv IO) ()
-> StateT PlotState (ReaderT RuntimeEnv IO) ()
whenStrict StateT PlotState (ReaderT RuntimeEnv IO) ()
f = forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> Bool
strictMode forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
s -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
s StateT PlotState (ReaderT RuntimeEnv IO) ()
f
makeEither :: Block -> PlotM (Either PandocPlotError Block)
makeEither :: Block -> PlotM (Either PandocPlotError Block)
makeEither Block
block =
Block -> PlotM ParseFigureResult
parseFigureSpec Block
block
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ParseFigureResult
NotAFigure -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Block
block
PFigure FigureSpec
fs -> FigureSpec -> PlotM ScriptResult
runScriptIfNecessary FigureSpec
fs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FigureSpec -> ScriptResult -> PlotM (Either PandocPlotError Block)
handleResult FigureSpec
fs
MissingToolkit Toolkit
tk -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Toolkit -> PandocPlotError
ToolkitNotInstalledError Toolkit
tk
UnsupportedSaveFormat Toolkit
tk SaveFormat
sv -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ SaveFormat -> Toolkit -> PandocPlotError
IncompatibleSaveFormatError SaveFormat
sv Toolkit
tk
where
handleResult :: FigureSpec -> ScriptResult -> PlotM (Either PandocPlotError Block)
handleResult :: FigureSpec -> ScriptResult -> PlotM (Either PandocPlotError Block)
handleResult FigureSpec
_ (ScriptFailure Text
cmd Int
code Text
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (Text -> Int -> PandocPlotError
ScriptRuntimeError Text
cmd Int
code)
handleResult FigureSpec
_ (ScriptChecksFailed Text
msg) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (Text -> PandocPlotError
ScriptChecksFailedError Text
msg)
handleResult FigureSpec
spec ScriptResult
ScriptSuccess = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RuntimeEnv -> Configuration
envConfig forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Configuration
c -> forall a b. b -> Either a b
Right 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
| IncompatibleSaveFormatError SaveFormat Toolkit
instance Show PandocPlotError where
show :: PandocPlotError -> String
show (ScriptRuntimeError Text
_ Int
exitcode) = String
"ERROR (pandoc-plot) The script failed with exit code " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
exitcode forall a. Semigroup a => a -> a -> a
<> String
"."
show (ScriptChecksFailedError Text
msg) = String
"ERROR (pandoc-plot) A script check failed with message: " forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
msg forall a. Semigroup a => a -> a -> a
<> String
"."
show (ToolkitNotInstalledError Toolkit
tk) = String
"ERROR (pandoc-plot) The " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Toolkit
tk forall a. Semigroup a => a -> a -> a
<> String
" toolkit is required but not installed."
show (IncompatibleSaveFormatError SaveFormat
tk Toolkit
sv) = String
"ERROR (pandoc-plot) Save format " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Toolkit
sv forall a. Semigroup a => a -> a -> a
<> String
" not supported by the " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show SaveFormat
tk forall a. Semigroup a => a -> a -> a
<> String
" toolkit."