{-# 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
Maybe Format -> Configuration -> PlotM Pandoc -> IO Pandoc
forall a. Maybe Format -> Configuration -> PlotM a -> IO a
runPlotM Maybe Format
mfmt 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
newMeta
where
newMeta :: Meta
newMeta = Meta
meta Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Map Text MetaValue -> Meta
Meta (Text -> MetaValue -> Map Text MetaValue
forall k a. k -> a -> Map k a
singleton Text
"graphics" (MetaValue -> Map Text MetaValue)
-> MetaValue -> Map Text MetaValue
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 Maybe Format
forall a. Maybe a
Nothing
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
whenStrict :: StateT PlotState (ReaderT RuntimeEnv IO) ()
-> StateT PlotState (ReaderT RuntimeEnv IO) ()
whenStrict StateT PlotState (ReaderT RuntimeEnv IO) ()
f = (Configuration -> Bool) -> PlotM Bool
forall a. (Configuration -> a) -> PlotM a
asksConfig Configuration -> Bool
strictMode PlotM Bool
-> (Bool -> StateT PlotState (ReaderT RuntimeEnv IO) ())
-> StateT PlotState (ReaderT RuntimeEnv IO) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
s -> Bool
-> StateT PlotState (ReaderT RuntimeEnv IO) ()
-> StateT PlotState (ReaderT RuntimeEnv IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
s StateT PlotState (ReaderT RuntimeEnv IO) ()
f
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
UnsupportedSaveFormat Toolkit
tk SaveFormat
sv -> 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
$ SaveFormat -> Toolkit -> PandocPlotError
IncompatibleSaveFormatError SaveFormat
sv 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
| 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 " 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."
show (IncompatibleSaveFormatError SaveFormat
tk Toolkit
sv) = String
"ERROR (pandoc-plot) Save format " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Toolkit -> String
forall a. Show a => a -> String
show Toolkit
sv String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" not supported by the " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SaveFormat -> String
forall a. Show a => a -> String
show SaveFormat
tk String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" toolkit."