{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
module Text.Pandoc.Filter.Plot (
makePlot
, plotTransform
, cleanOutputDirs
, configuration
, defaultConfiguration
, Configuration(..)
, Verbosity(..)
, LogSink(..)
, SaveFormat(..)
, Script
, availableToolkits
, unavailableToolkits
, make
, makeEither
, PandocPlotError(..)
, readDoc
) where
import Control.Concurrent.Async.Lifted (mapConcurrently)
import Data.Text (Text, unpack)
import Text.Pandoc.Definition (Pandoc(..), Block)
import Text.Pandoc.Walk (walkM, Walkable)
import Text.Pandoc.Filter.Plot.Internal
plotTransform :: Configuration
-> Pandoc
-> IO Pandoc
plotTransform :: Configuration -> Pandoc -> IO Pandoc
plotTransform conf :: Configuration
conf (Pandoc meta :: Meta
meta blocks :: [Block]
blocks) =
Configuration -> PlotM Pandoc -> IO Pandoc
forall a. Configuration -> PlotM a -> IO a
runPlotM Configuration
conf (PlotM Pandoc -> IO Pandoc) -> PlotM Pandoc -> IO Pandoc
forall a b. (a -> b) -> a -> b
$ (Block -> ReaderT RuntimeEnv IO Block)
-> [Block] -> ReaderT RuntimeEnv IO [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, MonadBaseControl IO m) =>
(a -> m b) -> t a -> m (t b)
mapConcurrently Block -> ReaderT RuntimeEnv IO Block
make [Block]
blocks ReaderT RuntimeEnv IO [Block]
-> ([Block] -> PlotM Pandoc) -> PlotM Pandoc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pandoc -> PlotM Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> PlotM Pandoc)
-> ([Block] -> Pandoc) -> [Block] -> PlotM Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> [Block] -> Pandoc
Pandoc Meta
meta
makePlot :: Walkable Block a
=> Configuration
-> a
-> IO a
makePlot :: Configuration -> a -> IO a
makePlot conf :: Configuration
conf = Configuration -> PlotM a -> IO a
forall a. Configuration -> PlotM a -> IO a
runPlotM Configuration
conf (PlotM a -> IO a) -> (a -> PlotM a) -> a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> ReaderT RuntimeEnv IO Block) -> a -> PlotM a
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Block -> ReaderT RuntimeEnv IO Block
make
make :: Block -> PlotM Block
make :: Block -> ReaderT RuntimeEnv IO Block
make blk :: Block
blk = (PandocPlotError -> ReaderT RuntimeEnv IO Block)
-> (Block -> ReaderT RuntimeEnv IO Block)
-> Either PandocPlotError Block
-> ReaderT RuntimeEnv IO Block
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ReaderT RuntimeEnv IO Block
-> PandocPlotError -> ReaderT RuntimeEnv IO Block
forall a b. a -> b -> a
const (Block -> ReaderT RuntimeEnv IO Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
blk) ) Block -> ReaderT RuntimeEnv IO Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocPlotError Block -> ReaderT RuntimeEnv IO Block)
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block)
-> ReaderT RuntimeEnv IO Block
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Block -> ReaderT RuntimeEnv IO (Either PandocPlotError Block)
makeEither Block
blk
makeEither :: Block -> PlotM (Either PandocPlotError Block)
makeEither :: Block -> ReaderT RuntimeEnv IO (Either PandocPlotError Block)
makeEither block :: Block
block =
Block -> PlotM (Maybe FigureSpec)
parseFigureSpec Block
block
PlotM (Maybe FigureSpec)
-> (Maybe FigureSpec
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block))
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderT RuntimeEnv IO (Either PandocPlotError Block)
-> (FigureSpec
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block))
-> Maybe FigureSpec
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(Either PandocPlotError Block
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocPlotError Block
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block))
-> Either PandocPlotError Block
-> 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)
(\s :: FigureSpec
s -> FigureSpec -> PlotM ScriptResult
runScriptIfNecessary FigureSpec
s PlotM ScriptResult
-> (ScriptResult
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block))
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FigureSpec
-> ScriptResult
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block)
handleResult FigureSpec
s)
where
handleResult :: FigureSpec -> ScriptResult -> PlotM (Either PandocPlotError Block)
handleResult :: FigureSpec
-> ScriptResult
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block)
handleResult _ (ScriptFailure msg :: Text
msg code :: Int
code) = Either PandocPlotError Block
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocPlotError Block
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block))
-> Either PandocPlotError Block
-> 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
msg Int
code)
handleResult _ (ScriptChecksFailed msg :: Text
msg) = Either PandocPlotError Block
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocPlotError Block
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block))
-> Either PandocPlotError Block
-> 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 _ (ToolkitNotInstalled tk' :: Toolkit
tk') = Either PandocPlotError Block
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocPlotError Block
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block))
-> Either PandocPlotError Block
-> 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 (Toolkit -> PandocPlotError
ToolkitNotInstalledError Toolkit
tk')
handleResult spec :: FigureSpec
spec ScriptSuccess = (RuntimeEnv -> Configuration)
-> ReaderT RuntimeEnv IO Configuration
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RuntimeEnv -> Configuration
envConfig ReaderT RuntimeEnv IO Configuration
-> (Configuration
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block))
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \c :: Configuration
c -> Either PandocPlotError Block
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocPlotError Block
-> ReaderT RuntimeEnv IO (Either PandocPlotError Block))
-> Either PandocPlotError Block
-> 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 -> Either PandocPlotError Block)
-> Block -> Either PandocPlotError Block
forall a b. (a -> b) -> a -> b
$ Format -> FigureSpec -> Block
toImage (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 _ exitcode :: Int
exitcode) = "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
<> "."
show (ScriptChecksFailedError msg :: Text
msg) = "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
<> "."
show (ToolkitNotInstalledError tk :: Toolkit
tk) = "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
<> " toolkit is required but not installed."