Logging.hs

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE OverloadedStrings  #-}
{- |
   Module      : Text.Pandoc.Logging
   Copyright   : Copyright (C) 2006-2023 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

This module provides data types and functions for warnings
and info messages.

-}
module Text.Pandoc.Logging (
    Verbosity(..)
  , LogMessage(..)
  , encodeLogMessages
  , showLogMessage
  , messageVerbosity
  ) where

import Control.Monad (mzero)
import Data.Aeson
import Data.Aeson.Encode.Pretty (Config (..), defConfig, encodePretty',
                                 keyOrder)
import qualified Data.ByteString.Lazy as BL
import Data.Data (Data, toConstr)
import qualified Data.Text as Text
import Data.Text (Text)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Text.Pandoc.Definition
import Text.Parsec.Pos
import Text.Pandoc.Shared (tshow)

-- | Verbosity level.
data Verbosity = ERROR | WARNING | INFO
     deriving (Show, Read, Eq, Data, Enum, Ord, Bounded, Typeable, Generic)

instance ToJSON Verbosity where
  toJSON x = toJSON (show x)
instance FromJSON Verbosity where
  parseJSON (String t) =
    case t of
         "ERROR"   -> return ERROR
         "WARNING" -> return WARNING
         "INFO"    -> return INFO
         _         -> mzero
  parseJSON _      =  mzero

data LogMessage =
    SkippedContent Text SourcePos
  | IgnoredElement Text
  | DuplicateLinkReference Text SourcePos
  | DuplicateNoteReference Text SourcePos
  | NoteDefinedButNotUsed Text SourcePos
  | DuplicateIdentifier Text SourcePos
  | ReferenceNotFound Text SourcePos
  | CircularReference Text SourcePos
  | UndefinedToggle Text SourcePos
  | ParsingUnescaped Text SourcePos
  | CouldNotLoadIncludeFile Text SourcePos
  | CouldNotParseIncludeFile Text SourcePos
  | MacroAlreadyDefined Text SourcePos
  | InlineNotRendered Inline
  | BlockNotRendered Block
  | DocxParserWarning Text
  | PowerpointTemplateWarning Text
  | IgnoredIOError Text
  | CouldNotFetchResource Text Text
  | CouldNotDetermineImageSize Text Text
  | CouldNotConvertImage Text Text
  | CouldNotDetermineMimeType Text
  | CouldNotConvertTeXMath Text Text
  | CouldNotParseCSS Text
  | Fetching Text
  | Extracting Text
  | LoadedResource FilePath FilePath
  | ScriptingWarning Text (Maybe SourcePos)
  | NoTitleElement Text
  | NoLangSpecified
  | InvalidLang Text
  | CouldNotHighlight Text
  | MissingCharacter Text
  | Deprecated Text Text
  | NoTranslation Text
  | CouldNotLoadTranslations Text Text
  | UnusualConversion Text
  | UnexpectedXmlElement Text Text
  | UnknownOrgExportOption Text
  | CouldNotDeduceFormat [Text] Text
  | RunningFilter FilePath
  | FilterCompleted FilePath Integer
  | CiteprocWarning Text
  | ATXHeadingInLHS Int Text
  | EnvironmentVariableUndefined Text
  | DuplicateAttribute Text Text
  | NotUTF8Encoded FilePath
  | MakePDFInfo Text Text
  | MakePDFWarning Text
  deriving (Show, Eq, Data, Ord, Typeable, Generic)

instance ToJSON LogMessage where
  toJSON x = object $
    "verbosity" .= toJSON (messageVerbosity x) :
    "type" .= toJSON (show $ toConstr x) :
    case x of
      SkippedContent s pos ->
           ["contents" .= s,
            "source" .= sourceName pos,
            "line" .= sourceLine pos,
            "column" .= sourceColumn pos]
      IgnoredElement s ->
           ["contents" .= s]
      DuplicateLinkReference s pos ->
           ["contents" .= s,
            "source" .= sourceName pos,
            "line" .= toJSON (sourceLine pos),
            "column" .= toJSON (sourceColumn pos)]
      NoteDefinedButNotUsed s pos ->
           ["key" .= s,
            "source" .= sourceName pos,
            "line" .= toJSON (sourceLine pos),
            "column" .= toJSON (sourceColumn pos)]
      DuplicateNoteReference s pos ->
           ["contents" .= s,
            "source" .= sourceName pos,
            "line" .= toJSON (sourceLine pos),
            "column" .= toJSON (sourceColumn pos)]
      DuplicateIdentifier s pos ->
           ["contents" .= s,
            "source" .= sourceName pos,
            "line" .= toJSON (sourceLine pos),
            "column" .= toJSON (sourceColumn pos)]
      ReferenceNotFound s pos ->
           ["contents" .= s,
            "source" .= sourceName pos,
            "line" .= toJSON (sourceLine pos),
            "column" .= toJSON (sourceColumn pos)]
      CircularReference s pos ->
           ["contents" .= s,
            "source" .= sourceName pos,
            "line" .= toJSON (sourceLine pos),
            "column" .= toJSON (sourceColumn pos)]
      UndefinedToggle s pos ->
           ["contents" .= s,
            "source" .= sourceName pos,
            "line" .= toJSON (sourceLine pos),
            "column" .= toJSON (sourceColumn pos)]
      ParsingUnescaped s pos ->
           ["contents" .= s,
            "source" .= sourceName pos,
            "line" .= toJSON (sourceLine pos),
            "column" .= toJSON (sourceColumn pos)]
      CouldNotLoadIncludeFile fp pos ->
           ["path" .= fp,
            "source" .= sourceName pos,
            "line" .= toJSON (sourceLine pos),
            "column" .= toJSON (sourceColumn pos)]
      CouldNotParseIncludeFile fp pos ->
           ["path" .= fp,
            "source" .= sourceName pos,
            "line" .= toJSON (sourceLine pos),
            "column" .= toJSON (sourceColumn pos)]
      MacroAlreadyDefined name pos ->
           ["name" .= name,
            "source" .= sourceName pos,
            "line" .= toJSON (sourceLine pos),
            "column" .= toJSON (sourceColumn pos)]
      InlineNotRendered il ->
           ["contents" .= toJSON il]
      BlockNotRendered bl ->
           ["contents" .= toJSON bl]
      DocxParserWarning s ->
           ["contents" .= s]
      PowerpointTemplateWarning s ->
           ["contents" .= s]
      IgnoredIOError s ->
           ["contents" .= s]
      CouldNotFetchResource fp s ->
           ["path" .= fp,
            "message" .= s]
      CouldNotDetermineImageSize fp s ->
           ["path" .= fp,
            "message" .= s]
      CouldNotConvertImage fp s ->
           ["path" .= fp,
            "message" .= s]
      CouldNotDetermineMimeType fp ->
           ["path" .= fp]
      CouldNotConvertTeXMath s msg ->
           ["contents" .= s,
            "message" .= msg]
      CouldNotParseCSS msg ->
           ["message" .= msg]
      Fetching fp ->
           ["path" .= fp]
      Extracting fp ->
           ["path" .= fp]
      LoadedResource orig found ->
           ["for"  .= orig
           ,"from" .= found]
      ScriptingWarning msg mbpos ->
           ["message" .= msg] <>
           case mbpos of
             Nothing  -> []
             Just pos -> ["source" .= sourceName pos
                         ,"line" .= toJSON (sourceLine pos)
                         ,"column" .= toJSON (sourceColumn pos)
                         ]
      NoTitleElement fallback ->
           ["fallback" .= fallback]
      NoLangSpecified -> []
      InvalidLang s ->
           ["lang" .= s]
      CouldNotHighlight msg ->
           ["message" .= msg]
      MissingCharacter msg ->
           ["message" .= msg]
      Deprecated thing msg ->
           ["thing" .= thing,
            "message" .= msg]
      NoTranslation term ->
           ["term" .= term]
      CouldNotLoadTranslations lang msg ->
           ["lang" .= lang,
            "message" .= msg]
      UnusualConversion msg ->
           ["message" .= msg]
      UnexpectedXmlElement element parent ->
           ["element" .= element,
            "parent" .= parent]
      UnknownOrgExportOption option ->
           ["option" .= option]
      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) ]
      CiteprocWarning msg ->
           ["message" .= msg]
      ATXHeadingInLHS lvl contents ->
           ["level" .= lvl
           ,"contents" .= contents]
      EnvironmentVariableUndefined var ->
           ["variable" .= var ]
      DuplicateAttribute attr val ->
           ["attribute" .= attr
           ,"value" .= val]
      NotUTF8Encoded src ->
           ["source" .= src]
      MakePDFInfo description contents ->
           ["description" .= description
           ,"contents" .= contents]
      MakePDFWarning message ->
           ["message" .= message]

showPos :: SourcePos -> Text
showPos pos = Text.pack $ sn ++ "line " ++
     show (sourceLine pos) ++ " column " ++ show (sourceColumn pos)
  where
    sn' = sourceName pos
    sn = if sn' == "source" || sn' == "" || sn' == "-"
            then ""
            else sn' ++ " "

encodeLogMessages :: [LogMessage] -> BL.ByteString
encodeLogMessages ms =
  encodePretty' defConfig{ confCompare =
      keyOrder [ "type", "verbosity", "contents", "message", "path",
                 "source", "line", "column" ] } ms

showLogMessage :: LogMessage -> Text
showLogMessage msg =
  case msg of
       SkippedContent s pos ->
         "Skipped '" <> s <> "' at " <> showPos pos
       IgnoredElement s ->
         "Ignored element " <> s
       DuplicateLinkReference s pos ->
         "Duplicate link reference '" <> s <> "' at " <> showPos pos
       DuplicateNoteReference s pos ->
         "Duplicate note reference '" <> s <> "' at " <> showPos pos
       NoteDefinedButNotUsed s pos ->
         "Note with key '" <> s <> "' defined at " <> showPos pos <>
           " but not used."
       DuplicateIdentifier s pos ->
         "Duplicate identifier '" <> s <> "' at " <> showPos pos
       ReferenceNotFound s pos ->
         "Reference not found for '" <> s <> "' at " <> showPos pos
       CircularReference s pos ->
         "Circular reference '" <> s <> "' at " <> showPos pos
       UndefinedToggle s pos ->
         "Undefined toggle '" <> s <> "' at " <> showPos pos
       ParsingUnescaped s pos ->
         "Parsing unescaped '" <> s <> "' at " <> showPos pos
       CouldNotLoadIncludeFile fp pos ->
         "Could not load include file " <> fp <> " at " <> showPos pos
       CouldNotParseIncludeFile fp pos ->
         "Parsing include file " <> fp <> " failed at " <> showPos pos
       MacroAlreadyDefined name pos ->
         "Macro '" <> name <> "' already defined, ignoring at " <> showPos pos
       InlineNotRendered il ->
         "Not rendering " <> Text.pack (show il)
       BlockNotRendered bl ->
         "Not rendering " <> Text.pack (show bl)
       DocxParserWarning s ->
         "Docx parser warning: " <> s
       PowerpointTemplateWarning s ->
         "Powerpoint template warning: " <> s
       IgnoredIOError s ->
         "IO Error (ignored): " <> s
       CouldNotFetchResource fp s ->
         "Could not fetch resource " <> fp <>
           if Text.null s then "" else ": " <> s
       CouldNotDetermineImageSize fp s ->
         "Could not determine image size for " <> fp <>
           if Text.null s then "" else ": " <> s
       CouldNotConvertImage fp s ->
         "Could not convert image " <> fp <>
           if Text.null s then "" else ": " <> s
       CouldNotDetermineMimeType fp ->
         "Could not determine mime type for " <> fp
       CouldNotConvertTeXMath s m ->
         "Could not convert TeX math " <> s <> ", rendering as TeX" <>
           if Text.null m then "" else ":\n" <> m
       CouldNotParseCSS m ->
         "Could not parse CSS" <> if Text.null m then "" else ":\n" <> m
       Fetching fp ->
         "Fetching " <> fp <> "..."
       Extracting fp ->
         "Extracting " <> fp <> "..."
       LoadedResource orig found ->
         "Loaded " <> Text.pack orig <> " from " <> Text.pack found
       ScriptingWarning s mbpos ->
         "Scripting warning" <>
         maybe "" (\pos -> " at " <> showPos pos) mbpos  <> ": " <> s
       NoTitleElement fallback ->
         "This document format requires a nonempty <title> element.\n" <>
         "Defaulting to '" <> fallback <> "' as the title.\n" <>
         "To specify a title, use 'title' in metadata or " <>
         "--metadata title=\"...\"."
       NoLangSpecified ->
         "No value for 'lang' was specified in the metadata.\n" <>
         "It is recommended that lang be specified for this format."
       InvalidLang s ->
         "Invalid 'lang' value '" <> s <> "'.\n" <>
         "Use an IETF language tag like 'en-US'."
       CouldNotHighlight m ->
         "Could not highlight code block:\n" <> m
       MissingCharacter m ->
         "Missing character: " <> m
       Deprecated t m ->
         "Deprecated: " <> t <>
         if Text.null m
            then ""
            else ". " <> m
       NoTranslation t ->
         "The term " <> t <> " has no translation defined."
       CouldNotLoadTranslations lang m ->
         "Could not load translations for " <> lang <>
           if Text.null m then "" else "\n" <> m
       UnusualConversion m ->
         "Unusual conversion: " <> m
       UnexpectedXmlElement element parent ->
         "Unexpected XML element " <> element <> " in " <> parent
       UnknownOrgExportOption option ->
         "Ignoring unknown Org export option: " <> option
       CouldNotDeduceFormat exts format ->
         "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"
       CiteprocWarning ms -> "Citeproc: " <> ms
       ATXHeadingInLHS lvl contents ->
         "Rendering heading '" <> contents <> "' as a paragraph.\n" <>
         "ATX headings cannot be used in literate Haskell, because " <>
         "'#' is not\nallowed in column 1." <>
         if lvl < 3
            then " Consider using --markdown-headings=setext."
            else ""
       EnvironmentVariableUndefined var ->
         "Undefined environment variable " <> var <> " in defaults file."
       DuplicateAttribute attr val ->
         "Ignoring duplicate attribute " <> attr <> "=" <> tshow val <> "."
       NotUTF8Encoded src ->
         Text.pack src <>
           " is not UTF-8 encoded: falling back to latin1."
       MakePDFInfo description contents ->
         "[makePDF] " <> description <>
          if Text.null contents
             then mempty
             else "\n" <> contents
       MakePDFWarning message -> "[makePDF] " <> message

messageVerbosity :: LogMessage -> Verbosity
messageVerbosity msg =
  case msg of
       SkippedContent{}              -> INFO
       IgnoredElement{}              -> INFO
       DuplicateLinkReference{}      -> WARNING
       DuplicateNoteReference{}      -> WARNING
       NoteDefinedButNotUsed{}       -> WARNING
       DuplicateIdentifier{}         -> WARNING
       ReferenceNotFound{}           -> WARNING
       CircularReference{}           -> WARNING
       UndefinedToggle{}             -> WARNING
       CouldNotLoadIncludeFile f _
        | ".sty" `Text.isSuffixOf` f -> INFO
        | otherwise                  -> WARNING
       CouldNotParseIncludeFile{}    -> WARNING
       MacroAlreadyDefined{}         -> WARNING
       ParsingUnescaped{}            -> INFO
       InlineNotRendered{}           -> INFO
       BlockNotRendered{}            -> INFO
       DocxParserWarning{}           -> INFO
       PowerpointTemplateWarning{}   -> WARNING
       IgnoredIOError{}              -> WARNING
       CouldNotFetchResource{}       -> WARNING
       CouldNotDetermineImageSize{}  -> WARNING
       CouldNotConvertImage{}        -> WARNING
       CouldNotDetermineMimeType{}   -> WARNING
       CouldNotConvertTeXMath{}      -> WARNING
       CouldNotParseCSS{}            -> WARNING
       Fetching{}                    -> INFO
       Extracting{}                  -> INFO
       LoadedResource{}              -> INFO
       ScriptingWarning{}            -> WARNING
       NoTitleElement{}              -> WARNING
       NoLangSpecified               -> INFO
       InvalidLang{}                 -> WARNING
       CouldNotHighlight{}           -> WARNING
       MissingCharacter{}            -> WARNING
       Deprecated{}                  -> WARNING
       NoTranslation{}               -> WARNING
       CouldNotLoadTranslations{}    -> WARNING
       UnusualConversion {}          -> WARNING
       UnexpectedXmlElement {}       -> WARNING
       UnknownOrgExportOption {}     -> WARNING
       CouldNotDeduceFormat{}        -> WARNING
       RunningFilter{}               -> INFO
       FilterCompleted{}             -> INFO
       CiteprocWarning{}             -> WARNING
       ATXHeadingInLHS{}             -> WARNING
       EnvironmentVariableUndefined{}-> WARNING
       DuplicateAttribute{}          -> WARNING
       NotUTF8Encoded{}              -> WARNING
       MakePDFInfo{}                 -> INFO
       MakePDFWarning{}              -> WARNING