Add timing info for filters in `--verbose` mode.

+ Add RunningFilter, FilterCompleted constructors to LogMessage
+ When verbose mode is specified (verbosity == INFO), print a
  notice when running a filter and when a filter completes (including
  timing).

Closes #6112.

2 files changed, 30 insertions, 5 deletions

diff --git a/src/Text/Pandoc/Filter.hs b/src/Text/Pandoc/Filter.hs
index adea0d5e2..924e4cb66 100644
--- a/src/Text/Pandoc/Filter.hs
+++ b/src/Text/Pandoc/Filter.hs
@@ -20,11 +20,13 @@ module Text.Pandoc.Filter
   ) where
 
 import Prelude
+import System.CPUTime (getCPUTime)
 import Data.Aeson.TH (deriveJSON, defaultOptions)
 import GHC.Generics (Generic)
-import Text.Pandoc.Class (PandocIO)
+import Text.Pandoc.Class (PandocIO, report, getVerbosity)
 import Text.Pandoc.Definition (Pandoc)
 import Text.Pandoc.Options (ReaderOptions)
+import Text.Pandoc.Logging
 import qualified Text.Pandoc.Filter.JSON as JSONFilter
 import qualified Text.Pandoc.Filter.Lua as LuaFilter
 import qualified Text.Pandoc.Filter.Path as Path
@@ -32,7 +34,8 @@ import Data.YAML
 import qualified Data.Text as T
 import System.FilePath (takeExtension)
 import Control.Applicative ((<|>))
-import Control.Monad (foldM)
+import Control.Monad.Trans (MonadIO (liftIO))
+import Control.Monad (foldM, when)
 
 -- | Type of filter and path to filter file.
 data Filter = LuaFilter FilePath
@@ -65,8 +68,19 @@ applyFilters ropts filters args d = do
   expandedFilters <- mapM expandFilterPath filters
   foldM applyFilter d expandedFilters
  where
-  applyFilter doc (JSONFilter f) = JSONFilter.apply ropts args f doc
-  applyFilter doc (LuaFilter f)  = LuaFilter.apply ropts args f doc
+  applyFilter doc (JSONFilter f) =
+    withMessages f $ JSONFilter.apply ropts args f doc
+  applyFilter doc (LuaFilter f)  =
+    withMessages f $ LuaFilter.apply ropts args f doc
+  withMessages f action = do
+    verbosity <- getVerbosity
+    when (verbosity == INFO) $ report $ RunningFilter f
+    starttime <- toMilliseconds <$> liftIO getCPUTime
+    res <- action
+    endtime <- toMilliseconds <$> liftIO getCPUTime
+    when (verbosity == INFO) $ report $ FilterCompleted f (endtime - starttime)
+    return res
+  toMilliseconds picoseconds = picoseconds `div` 1000000000
 
 -- | Expand paths of filters, searching the data directory.
 expandFilterPath :: Filter -> PandocIO Filter
diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs
index f13139fa2..761060f8e 100644
--- a/src/Text/Pandoc/Logging.hs
+++ b/src/Text/Pandoc/Logging.hs
@@ -98,6 +98,8 @@ data LogMessage =
   | UnexpectedXmlElement Text.Text Text.Text
   | UnknownOrgExportOption Text.Text
   | CouldNotDeduceFormat [Text.Text] Text.Text
+  | RunningFilter FilePath
+  | FilterCompleted FilePath Integer
   deriving (Show, Eq, Data, Ord, Typeable, Generic)
 
 instance ToJSON LogMessage where
@@ -222,7 +224,11 @@ instance ToJSON LogMessage where
       CouldNotDeduceFormat exts format ->
            ["extensions" .= exts
            ,"format" .= format]
-
+      RunningFilter fp ->
+           ["path" .= Text.pack fp ]
+      FilterCompleted fp ms ->
+           ["path" .= Text.pack fp
+           ,"milliseconds" .= Text.pack (show ms) ]
 
 showPos :: SourcePos -> Text.Text
 showPos pos = Text.pack $ sn ++ "line " ++
@@ -331,6 +337,9 @@ showLogMessage msg =
          "Could not deduce format from file extension " <>
          Text.intercalate " or " exts <> "\n" <>
          "Defaulting to " <> format
+       RunningFilter fp -> "Running filter " <> Text.pack fp
+       FilterCompleted fp ms -> "Completed filter " <> Text.pack fp <>
+          " in " <> Text.pack (show ms) <> " ms"
 
 messageVerbosity :: LogMessage -> Verbosity
 messageVerbosity msg =
@@ -374,3 +383,5 @@ messageVerbosity msg =
        UnexpectedXmlElement {}       -> WARNING
        UnknownOrgExportOption {}     -> WARNING
        CouldNotDeduceFormat{}        -> WARNING
+       RunningFilter{}               -> INFO
+       FilterCompleted{}             -> INFO