aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Text/Pandoc/App.hs7
-rw-r--r--src/Text/Pandoc/Class.hs27
-rw-r--r--src/Text/Pandoc/Logging.hs12
-rw-r--r--src/Text/Pandoc/Readers/HTML.hs5
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs6
-rw-r--r--src/Text/Pandoc/Readers/MediaWiki.hs5
-rw-r--r--src/Text/Pandoc/Readers/Muse.hs5
-rw-r--r--src/Text/Pandoc/Readers/TWiki.hs6
-rw-r--r--src/Text/Pandoc/Readers/Textile.hs6
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-24 02:03:24 +0000