pandoc-plot 1.0.2.0 → 1.0.2.1

raw patch · 7 files changed

+69/−39 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• pandoc-plot.cabal +2/−2
• src/Text/Pandoc/Filter/Plot.hs +10/−5
• src/Text/Pandoc/Filter/Plot/Monad.hs +30/−10
• src/Text/Pandoc/Filter/Plot/Monad/Logging.hs +19/−12
• src/Text/Pandoc/Filter/Plot/Parse.hs +1/−1
• stack.yaml +1/−9

@@ -2,6 +2,12 @@ 
 pandoc-plot uses [Semantic Versioning](http://semver.org/spec/v2.0.0.html)
 
+Release 1.0.2.1
+---------------
+
+* `pandoc-plot` will now only render at most `N` figures in parallel, where `N` is the number of available CPU cores.
+* Fixed an issue where error message would get mangled in strict-mode.
+
 Release 1.0.2.0
 ---------------
 

@@ -1,6 +1,6 @@ cabal-version:  2.2
 name:           pandoc-plot
-version:        1.0.2.0
+version:        1.0.2.1
 synopsis:       A Pandoc filter to include figures generated from code blocks using your plotting toolkit of choice.
 description:    A Pandoc filter to include figures generated from code blocks. 
                 Keep the document and code in the same location. Output is 
@@ -14,7 +14,7 @@ license:        GPL-2.0-or-later
 license-file:   LICENSE
 build-type:     Simple
-tested-with:    GHC == 8.10.1
+tested-with:    GHC == 8.10.3
 extra-source-files:
     CHANGELOG.md
     LICENSE

@@ -109,7 +109,7 @@   )
 where
 
-import Control.Concurrent.Async.Lifted (mapConcurrently)
+import Control.Concurrent (getNumCapabilities)
 import Data.Functor ((<&>))
 import Data.Text (Text, pack, unpack)
 import Data.Version (Version)
@@ -130,12 +130,14 @@     availableToolkits,
     cleanOutputDirs,
     configuration,
+    debug,
     defaultConfiguration,
+    mapConcurrentlyN,
     parseFigureSpec,
     runPlotM,
     runScriptIfNecessary,
     supportedSaveFormats,
-    throwError,
+    throwStrictError,
     toFigure,
     toolkits,
     unavailableToolkits,
@@ -154,8 +156,11 @@   -- | Input document
   Pandoc ->
   IO Pandoc
-plotTransform conf (Pandoc meta blocks) =
-  runPlotM conf $ mapConcurrently make blocks <&> Pandoc meta
+plotTransform conf (Pandoc meta blocks) = do
+  maxproc <- getNumCapabilities
+  runPlotM conf $ do
+    debug $ mconcat ["Starting a new run, utilizing at most ", pack . show $ maxproc, " processes."]
+    mapConcurrentlyN maxproc make blocks <&> Pandoc meta
 
 -- | The version of the pandoc-plot package.
 --
@@ -170,7 +175,7 @@   where
     onError :: Block -> PandocPlotError -> PlotM Block
     onError b e = do
-      whenStrict $ throwError $ "[strict mode] " <> (pack . show $ e)
+      whenStrict $ throwStrictError (pack . show $ e)
       return b
 
 -- | Try to process the block with `pandoc-plot`, documenting the error.

@@ -16,13 +16,16 @@     PlotState (..),
     runPlotM,
 
+    -- * Concurrent execution
+    mapConcurrentlyN,
+
     -- * Running external commands
     runCommand,
     withPrependedPath,
 
     -- * Halting pandoc-plot
     whenStrict,
-    throwError,
+    throwStrictError,
 
     -- * Getting file hashes
     fileHash,
@@ -50,9 +53,11 @@   )
 where
 
+import Control.Concurrent.Async.Lifted (mapConcurrently)
 import Control.Concurrent.Chan (writeChan)
 import Control.Concurrent.MVar
-import Control.Exception.Lifted (bracket)
+import Control.Concurrent.QSemN
+import Control.Exception.Lifted (bracket, bracket_)
 import Control.Monad.Reader
 import Control.Monad.State.Strict
 import Data.ByteString.Lazy (toStrict)
@@ -71,7 +76,7 @@     getModificationTime,
   )
 import System.Environment (getEnv, setEnv)
-import System.Exit (ExitCode (..))
+import System.Exit (ExitCode (..), exitFailure)
 import System.Process.Typed
   ( byteStringInput,
     byteStringOutput,
@@ -117,11 +122,21 @@   withLogger verbosity sink $
     \logger -> runReaderT (evalStateT v st) (RuntimeEnv conf logger cwd)
 
+-- | maps a function, performing at most @N@ actions concurrently.
+mapConcurrentlyN :: Traversable t => Int -> (a -> PlotM b) -> t a -> PlotM (t b)
+mapConcurrentlyN n f xs = do
+  -- Emulating a pool of processes with locked access
+  sem <- liftIO $ newQSemN n
+  mapConcurrently (with sem . f) xs
+  where
+    with :: QSemN -> PlotM a -> PlotM a
+    with s = bracket_ (liftIO $ waitQSemN s 1) (liftIO $ signalQSemN s 1)
+
 debug, err, warning, info :: Text -> PlotM ()
-debug = log "DEBUG | " Debug
-err = log "ERROR | " Error
-warning = log "WARN  | " Warning
-info = log "INFO  | " Info
+debug = log "[pandoc-plot] DEBUG | " Debug
+err = log "[pandoc-plot] ERROR | " Error
+warning = log "[pandoc-plot] WARN  | " Warning
+info = log "[pandoc-plot] INFO  | " Info
 
 -- | General purpose logging.
 log ::
@@ -198,9 +213,14 @@     (\_ -> liftIO $ setEnv "PATH" pathVar)
     (const f)
 
--- | Throw an error that halts the execution of pandoc-plot
-throwError :: Text -> PlotM ()
-throwError = liftIO . errorWithoutStackTrace . unpack
+-- | Throw an error that halts the execution of pandoc-plot due to a strict-mode.
+throwStrictError :: Text -> PlotM ()
+throwStrictError msg = do
+  logger <- asks envLogger
+  log "[pandoc-plot] STRICT MODE | " Error msg
+  liftIO $ do
+    terminateLogging logger
+    exitFailure
 
 -- | Conditional execution of a PlotM action if pandoc-plot is
 -- run in strict mode.

@@ -15,20 +15,21 @@     LogSink (..),
     Logger (..),
     withLogger,
+    terminateLogging,
   )
 where
 
 import Control.Concurrent (forkIO)
 import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
 import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)
-import Control.Monad (forever)
+import Control.Monad (forever, void)
 import Data.Char (toLower)
 import Data.List (intercalate)
 import Data.String (IsString (..))
 import Data.Text (Text, unpack)
-import Data.Text.IO (hPutStr)
+import Data.Text.IO as TIO
 import Data.Yaml (FromJSON (parseJSON), Value (String))
-import System.IO (IOMode (AppendMode), stderr, withFile)
+import System.IO (stderr)
 
 -- | Verbosity of the logger.
 data Verbosity
@@ -60,6 +61,16 @@     lSync :: MVar ()
   }
 
+-- | Ensure that all log messages are flushed, and stop logging
+terminateLogging :: Logger -> IO ()
+terminateLogging logger = do
+  -- Flushing the logger
+  -- To signal to the logger that logging duties are over,
+  -- we append Nothing to the channel, and wait for it to finish
+  -- dealing with all items in the channel.
+  writeChan (lChannel logger) Nothing
+  void $ takeMVar (lSync logger)
+
 -- | Perform an IO action with a logger. Using this function
 -- ensures that logging will be gracefully shut down.
 withLogger :: Verbosity -> LogSink -> (Logger -> IO a) -> IO a
@@ -80,17 +91,13 @@ 
   result <- f logger
 
-  -- Flushing the logger
-  -- To signal to the logger that logging duties are over,
-  -- we append Nothing to the channel, and wait for it to finish
-  -- dealing with all items in the channel.
-  writeChan (lChannel logger) Nothing
-  () <- takeMVar (lSync logger)
+  terminateLogging logger
 
   return result
   where
-    sink StdErr = hPutStr stderr
-    sink (LogFile fp) = \t -> withFile fp AppendMode $ \h -> hPutStr h t
+    sink :: LogSink -> Text -> IO ()
+    sink StdErr = TIO.hPutStr stderr
+    sink (LogFile fp) = TIO.appendFile fp
 
 instance IsString Verbosity where
   fromString s
@@ -109,4 +116,4 @@ 
 instance FromJSON Verbosity where
   parseJSON (String t) = pure $ fromString . unpack $ t
-  parseJSON _ = fail $ "Could not parse the logging verbosity."
+  parseJSON _ = fail "Could not parse the logging verbosity."

@@ -61,7 +61,7 @@       case r of
         Nothing -> do
           let msg = mconcat ["Renderer for ", tshow tk, " needed but is not installed"]
-          whenStrict $ throwError $ "[strict mode] " <> msg
+          whenStrict $ throwStrictError msg
           warning msg
           return Nothing
         Just r' -> do

@@ -1,22 +1,14 @@-resolver: nightly-2020-12-14 # GHC 8.10.2
+resolver: nightly-2021-01-05 # GHC 8.10.3
 
 packages:
 - .
 
-# GHC 8.10.2 is broken on Windows:
-#   https://gitlab.haskell.org/ghc/ghc/-/issues/18550
-compiler: ghc-8.10.3
-
 extra-deps:
 - pandoc-2.11.3.2
 - citeproc-0.3.0.3@sha256:273b4935b18079fb666e53419dbf31e1edb7c7bdf7ea4295ff7ba6da22dc61b3,5590
-- texmath-0.12.1@sha256:57d2ff00f89da2a56f10eda28c6c502e1314a35090c7f63600f6d7b0adedbc29,6563
 - commonmark-0.1.1.2@sha256:c06ab05f0f224ab7982502a96e17952823a9b6dae8505fb35194b0baa9e2a975,3278
 - commonmark-extensions-0.2.0.4@sha256:6a437bcfa3c757af4262b71336513619990eafb5cfdc33e57a499c93ad225608,3184
 - commonmark-pandoc-0.2.0.1@sha256:529c6e2c6cabf61558b66a28123eafc1d90d3324be29819f59f024e430312c1f,1105
-- doctemplates-0.9@sha256:eb0bf957ba8571746f36f07ceca43d311a0e390a9fdcfde6909f9f9be85b3b28,3125
-- skylighting-0.10.2@sha256:9c395703ca61752f4491044443e87d5b87ed94bca78c0a00b5ebf4e4b8e59904,10031
-- skylighting-core-0.10.2@sha256:5070d9f08135cdb7c935c5936a4a76a9e1922ec846cd40d6e2837f42e7a9f29f,8159
 
 # For development
 - git: https://github.com/owickstrom/pandoc-include-code.git