Separated tracing from logging.

Formerly tracing was just log messages with a DEBUG log
level.  We now make these things independent.  Tracing
can be turned on or off in PandocMonad using `setTrace`;
it is independent of logging.

* Removed `DEBUG` from `Verbosity`.
* Removed `ParserTrace` from `LogMessage`.
* Added `trace`, `setTrace` to `PandocMonad`.

9 files changed, 40 insertions, 39 deletions

diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs
index 033614752..2c5e1de6b 100644
--- a/src/Text/Pandoc/App.hs
+++ b/src/Text/Pandoc/App.hs
@@ -76,7 +76,7 @@ import System.IO.Error (isDoesNotExistError)
 import Text.Pandoc
 import Text.Pandoc.Builder (setMeta)
 import Text.Pandoc.Class (PandocIO, extractMedia, fillMediaBag, getLog,
-                          setResourcePath, withMediaBag)
+                          setResourcePath, withMediaBag, setTrace)
 import Text.Pandoc.Highlighting (highlightingStyles)
 import Text.Pandoc.Lua (runLuaFilter)
 import Text.Pandoc.Writers.Math (defaultMathJaxURL, defaultKaTeXURL)
@@ -391,6 +391,7 @@ convertWithOpts opts = do
   let runIO' :: PandocIO a -> IO a
       runIO' f = do
         (res, reports) <- runIOorExplode $ do
+                             setTrace (optTrace opts)
                              setVerbosity verbosity
                              x <- f
                              rs <- getLog
@@ -559,6 +560,7 @@ data Opt = Opt
     , optDumpArgs              :: Bool    -- ^ Output command-line arguments
     , optIgnoreArgs            :: Bool    -- ^ Ignore command-line arguments
     , optVerbosity             :: Verbosity  -- ^ Verbosity of diagnostic output
+    , optTrace                 :: Bool  -- ^ Enable tracing
     , optLogFile               :: Maybe FilePath -- ^ File to write JSON log output
     , optFailIfWarnings        :: Bool    -- ^ Fail on warnings
     , optReferenceLinks        :: Bool    -- ^ Use reference links in writing markdown, rst
@@ -633,6 +635,7 @@ defaultOpts = Opt
     , optDumpArgs              = False
     , optIgnoreArgs            = False
     , optVerbosity             = WARNING
+    , optTrace                 = False
     , optLogFile               = Nothing
     , optFailIfWarnings        = False
     , optReferenceLinks        = False
@@ -1390,7 +1393,7 @@ options =
 
     , Option "" ["trace"]
                  (NoArg
-                  (\opt -> return opt { optVerbosity = DEBUG }))
+                  (\opt -> return opt { optTrace = True }))
                  "" -- "Turn on diagnostic tracing in readers."
 
     , Option "" ["dump-args"]
diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index 8db2e214e..a7194f8d5 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -45,6 +45,7 @@ module Text.Pandoc.Class ( PandocMonad(..)
                          , getZonedTime
                          , readFileFromDirs
                          , report
+                         , setTrace
                          , getLog
                          , setVerbosity
                          , getMediaBag
@@ -78,7 +79,7 @@ import qualified Text.Pandoc.Shared as IO ( readDataFile
 import qualified Text.Pandoc.UTF8 as UTF8
 import Text.Pandoc.Compat.Time (UTCTime)
 import Text.Pandoc.Logging
-import Text.Parsec (ParsecT)
+import Text.Parsec (ParsecT, getPosition)
 import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime)
 import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType)
 import Text.Pandoc.Definition
@@ -117,6 +118,7 @@ import System.IO.Error
 import System.IO (stderr)
 import qualified Data.Map as M
 import Text.Pandoc.Error
+import qualified Debug.Trace
 
 class (Functor m, Applicative m, Monad m, MonadError PandocError m)
       => PandocMonad m where
@@ -140,6 +142,11 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m)
   modifyCommonState :: (CommonState -> CommonState) -> m ()
   modifyCommonState f = getCommonState >>= putCommonState . f
 
+  trace :: String -> m ()
+  trace msg = do
+    tracing <- getsCommonState stTrace
+    when tracing $ Debug.Trace.trace ("[trace] " ++ msg) (return ())
+
   logOutput :: LogMessage -> m ()
 
 -- Functions defined for all PandocMonad instances
@@ -155,10 +162,11 @@ report :: PandocMonad m => LogMessage -> m ()
 report msg = do
   verbosity <- getsCommonState stVerbosity
   let level = messageVerbosity msg
-  when (level <= verbosity) $
-    logOutput msg
-  unless (level == DEBUG) $
-    modifyCommonState $ \st -> st{ stLog = msg : stLog st }
+  when (level <= verbosity) $ logOutput msg
+  modifyCommonState $ \st -> st{ stLog = msg : stLog st }
+
+setTrace :: PandocMonad m => Bool -> m ()
+setTrace useTracing = modifyCommonState $ \st -> st{stTrace = useTracing}
 
 setMediaBag :: PandocMonad m => MediaBag -> m ()
 setMediaBag mb = modifyCommonState $ \st -> st{stMediaBag = mb}
@@ -208,6 +216,7 @@ data CommonState = CommonState { stLog          :: [LogMessage]
                                , stOutputFile   :: Maybe FilePath
                                , stResourcePath :: [FilePath]
                                , stVerbosity    :: Verbosity
+                               , stTrace        :: Bool
                                }
 
 instance Default CommonState where
@@ -217,6 +226,7 @@ instance Default CommonState where
                     , stOutputFile = Nothing
                     , stResourcePath = ["."]
                     , stVerbosity = WARNING
+                    , stTrace = False
                     }
 
 runIO :: PandocIO a -> IO (Either PandocError a)
@@ -561,8 +571,15 @@ instance PandocMonad m => PandocMonad (ParsecT s st m) where
   getModificationTime = lift . getModificationTime
   getCommonState = lift getCommonState
   putCommonState = lift . putCommonState
+  trace msg = do
+    tracing <- getsCommonState stTrace
+    when tracing $ do
+      pos <- getPosition
+      Debug.Trace.trace
+        ("[trace] Parsed " ++ msg ++ " at " ++ show pos) (return ())
   logOutput = lift . logOutput
 
+
 instance PandocMonad m => PandocMonad (ReaderT r m) where
   lookupEnv = lift . lookupEnv
   getCurrentTime = lift getCurrentTime
diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs
index b31c33d4e..4090243ea 100644
--- a/src/Text/Pandoc/Logging.hs
+++ b/src/Text/Pandoc/Logging.hs
@@ -52,7 +52,7 @@ import Text.Pandoc.Definition
 import Text.Parsec.Pos
 
 -- | Verbosity level.
-data Verbosity = ERROR | WARNING | INFO | DEBUG
+data Verbosity = ERROR | WARNING | INFO
      deriving (Show, Read, Eq, Data, Enum, Ord, Bounded, Typeable, Generic)
 
 instance ToJSON Verbosity where
@@ -63,7 +63,6 @@ instance FromJSON Verbosity where
          "ERROR"   -> return ERROR
          "WARNING" -> return WARNING
          "INFO"    -> return INFO
-         "DEBUG"   -> return DEBUG
          _         -> mzero
   parseJSON _      =  mzero
 
@@ -78,7 +77,6 @@ data LogMessage =
   | CircularReference String SourcePos
   | ParsingUnescaped String SourcePos
   | CouldNotLoadIncludeFile String SourcePos
-  | ParsingTrace String SourcePos
   | InlineNotRendered Inline
   | BlockNotRendered Block
   | DocxParserWarning String
@@ -151,11 +149,6 @@ instance ToJSON LogMessage where
             "source" .= Text.pack (sourceName pos),
             "line" .= toJSON (sourceLine pos),
             "column" .= toJSON (sourceColumn pos)]
-      ParsingTrace s pos ->
-           ["contents" .= Text.pack s,
-            "source" .= Text.pack (sourceName pos),
-            "line" .= sourceLine pos,
-            "column" .= sourceColumn pos]
       InlineNotRendered il ->
            ["contents" .= toJSON il]
       BlockNotRendered bl ->
@@ -228,8 +221,6 @@ showLogMessage msg =
          "Parsing unescaped '" ++ s ++ "' at " ++ showPos pos
        CouldNotLoadIncludeFile fp pos ->
          "Could not load include file '" ++ fp ++ "' at " ++ showPos pos
-       ParsingTrace s pos ->
-         "Parsing trace at " ++ showPos pos ++ ": " ++ s
        InlineNotRendered il ->
          "Not rendering " ++ show il
        BlockNotRendered bl ->
@@ -281,7 +272,6 @@ messageVerbosity msg =
        CircularReference{}          -> WARNING
        CouldNotLoadIncludeFile{}    -> WARNING
        ParsingUnescaped{}           -> INFO
-       ParsingTrace{}               -> DEBUG
        InlineNotRendered{}          -> INFO
        BlockNotRendered{}           -> INFO
        DocxParserWarning{}          -> WARNING
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index 94f933c4d..e203298b8 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -71,7 +71,7 @@ import Data.Monoid ((<>))
 import Text.Parsec.Error
 import qualified Data.Set as Set
 import Text.Pandoc.Error
-import Text.Pandoc.Class (PandocMonad, report)
+import Text.Pandoc.Class (PandocMonad(..))
 import Control.Monad.Except (throwError)
 
 -- | Convert HTML-formatted string to 'Pandoc' document.
@@ -162,7 +162,6 @@ pHead = pInTags "head" $ pTitle <|> pMetaTag <|> pBaseTag <|> (mempty <$ pAnyTag
 
 block :: PandocMonad m => TagParser m Blocks
 block = do
-  pos <- getPosition
   res <- choice
             [ eSection
             , eSwitch B.para block
@@ -182,7 +181,7 @@ block = do
             , pPlain
             , pRawHtmlBlock
             ]
-  report $ ParsingTrace (take 60 $ show $ B.toList res) pos
+  trace (take 60 $ show $ B.toList res)
   return res
 
 namespaces :: PandocMonad m => [(String, TagParser m Inlines)]
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index e1c481311..edb356b39 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -52,7 +52,7 @@ import System.FilePath (addExtension, takeExtension)
 import Text.HTML.TagSoup
 import Text.Pandoc.Builder (Blocks, Inlines)
 import qualified Text.Pandoc.Builder as B
-import Text.Pandoc.Class (PandocMonad, report)
+import Text.Pandoc.Class (PandocMonad(..), report)
 import Text.Pandoc.Definition
 import Text.Pandoc.Emoji (emojis)
 import Text.Pandoc.Logging
@@ -488,7 +488,6 @@ parseBlocks = mconcat <$> manyTill block eof
 
 block :: PandocMonad m => MarkdownParser m (F Blocks)
 block = do
-  pos <- getPosition
   res <- choice [ mempty <$ blanklines
                , codeBlockFenced
                , yamlMetaBlock
@@ -514,8 +513,7 @@ block = do
                , para
                , plain
                ] <?> "block"
-  report $ ParsingTrace
-    (take 60 $ show $ B.toList $ runF res defaultParserState) pos
+  trace (take 60 $ show $ B.toList $ runF res defaultParserState)
   return res
 
 --
diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs
index a3ff60c14..e371ff152 100644
--- a/src/Text/Pandoc/Readers/MediaWiki.hs
+++ b/src/Text/Pandoc/Readers/MediaWiki.hs
@@ -52,7 +52,7 @@ import qualified Data.Set as Set
 import Text.HTML.TagSoup
 import Text.Pandoc.Builder (Blocks, Inlines, trimInlines)
 import qualified Text.Pandoc.Builder as B
-import Text.Pandoc.Class (PandocMonad, report)
+import Text.Pandoc.Class (PandocMonad(..))
 import Text.Pandoc.Definition
 import Text.Pandoc.Logging
 import Text.Pandoc.Options
@@ -205,7 +205,6 @@ parseMediaWiki = do
 
 block :: PandocMonad m => MWParser m Blocks
 block = do
-  pos <- getPosition
   res <- mempty <$ skipMany1 blankline
      <|> table
      <|> header
@@ -218,7 +217,7 @@ block = do
      <|> blockTag
      <|> (B.rawBlock "mediawiki" <$> template)
      <|> para
-  report $ ParsingTrace (take 60 $ show $ B.toList res) pos
+  trace (take 60 $ show $ B.toList res)
   return res
 
 para :: PandocMonad m => MWParser m Blocks
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs
index c1ea1354b..ac19a2382 100644
--- a/src/Text/Pandoc/Readers/Muse.hs
+++ b/src/Text/Pandoc/Readers/Muse.hs
@@ -53,7 +53,7 @@ import Data.Maybe (fromMaybe)
 import Text.HTML.TagSoup
 import Text.Pandoc.Builder (Blocks, Inlines)
 import qualified Text.Pandoc.Builder as B
-import Text.Pandoc.Class (PandocMonad, report)
+import Text.Pandoc.Class (PandocMonad(..))
 import Text.Pandoc.Definition
 import Text.Pandoc.Logging
 import Text.Pandoc.Options
@@ -166,12 +166,11 @@ directive = do
 
 block :: PandocMonad m => MuseParser m (F Blocks)
 block = do
-  pos <- getPosition
   res <- mempty <$ skipMany1 blankline
          <|> blockElements
          <|> para
   skipMany blankline
-  report $ ParsingTrace (take 60 $ show $ B.toList $ runF res defaultParserState) pos
+  trace (take 60 $ show $ B.toList $ runF res defaultParserState)
   return res
 
 blockElements :: PandocMonad m => MuseParser m (F Blocks)
diff --git a/src/Text/Pandoc/Readers/TWiki.hs b/src/Text/Pandoc/Readers/TWiki.hs
index 9e544c4ac..91ee8d1f1 100644
--- a/src/Text/Pandoc/Readers/TWiki.hs
+++ b/src/Text/Pandoc/Readers/TWiki.hs
@@ -42,9 +42,8 @@ import qualified Data.Foldable as F
 import Data.Maybe (fromMaybe)
 import Text.HTML.TagSoup
 import qualified Text.Pandoc.Builder as B
-import Text.Pandoc.Class (PandocMonad, report)
+import Text.Pandoc.Class (PandocMonad(..))
 import Text.Pandoc.Definition
-import Text.Pandoc.Logging
 import Text.Pandoc.Options
 import Text.Pandoc.Parsing hiding (enclosed, macro, nested)
 import Text.Pandoc.Readers.HTML (htmlTag, isCommentTag)
@@ -133,12 +132,11 @@ parseTWiki = do
 
 block :: PandocMonad m => TWParser m B.Blocks
 block = do
-  pos <- getPosition
   res <- mempty <$ skipMany1 blankline
          <|> blockElements
          <|> para
   skipMany blankline
-  report $ ParsingTrace (take 60 $ show $ B.toList res) pos
+  trace (take 60 $ show $ B.toList res)
   return res
 
 blockElements :: PandocMonad m => TWParser m B.Blocks
diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs
index 1669e3e51..96b51feef 100644
--- a/src/Text/Pandoc/Readers/Textile.hs
+++ b/src/Text/Pandoc/Readers/Textile.hs
@@ -61,10 +61,9 @@ import Text.HTML.TagSoup (Tag (..), fromAttrib)
 import Text.HTML.TagSoup.Match
 import Text.Pandoc.Builder (Blocks, Inlines, trimInlines)
 import qualified Text.Pandoc.Builder as B
-import Text.Pandoc.Class (PandocMonad, report)
+import Text.Pandoc.Class (PandocMonad(..))
 import Text.Pandoc.CSS
 import Text.Pandoc.Definition
-import Text.Pandoc.Logging
 import Text.Pandoc.Options
 import Text.Pandoc.Parsing
 import Text.Pandoc.Readers.HTML (htmlTag, isBlockTag, isInlineTag)
@@ -143,8 +142,7 @@ blockParsers = [ codeBlock
 block :: PandocMonad m => ParserT [Char] ParserState m Blocks
 block = do
   res <- choice blockParsers <?> "block"
-  pos <- getPosition
-  report $ ParsingTrace (take 60 $ show $ B.toList res) pos
+  trace (take 60 $ show $ B.toList res)
   return res
 
 commentBlock :: PandocMonad m => ParserT [Char] ParserState m Blocks