[#226] Change output formatting

* cli: avoid spaces in metavar * errors: change formatting * tests: accept new output
serokell · Nov 21, 2024 · 4c2306b · 4c2306b
1 parent 671f527
commit 4c2306b
Show file tree

Hide file tree

Showing 34 changed files with 784 additions and 909 deletions.
diff --git a/src/Xrefcheck/CLI.hs b/src/Xrefcheck/CLI.hs
@@ -208,7 +208,7 @@ exclusionOptionsParser :: Parser ExclusionOptions
 exclusionOptionsParser = do
   eoIgnore <- many . globOption $
     long "ignore" <>
-    metavar "GLOB PATTERN" <>
+    metavar "GLOB_PATTERN" <>
     help "Ignore these files. References to them will fail verification,\
          \ and references from them will not be verified.\
          \ Glob patterns that contain wildcards MUST be enclosed\
@@ -237,7 +237,7 @@ dumpConfigOptions = hsubparser $
       option repoTypeReadM $
       short 't' <>
       long "type" <>
-      metavar "REPOSITORY TYPE" <>
+      metavar "REPOSITORY_TYPE" <>
       help [int||
       Git repository type. \
       Can be (#{intercalate " | " $ map show allFlavors}). \

diff --git a/src/Xrefcheck/Command.hs b/src/Xrefcheck/Command.hs
@@ -92,7 +92,8 @@ defaultAction Options{..} = do
       verifyRepo rw fullConfig oMode repoInfo
 
     case verifyErrors verifyRes of
-      Nothing | null scanErrs -> fmtLn "All repository links are valid."
+      Nothing | null scanErrs ->
+        fmtLn $ colorIfNeeded Green "All repository links are valid."
       Nothing -> exitFailure
       Just verifyErrs -> do
         unless (null scanErrs) $ fmt "\n"

diff --git a/src/Xrefcheck/Core.hs b/src/Xrefcheck/Core.hs
@@ -63,10 +63,8 @@ instance FromJSON Flavor where
 newtype Position = Position (Maybe Text)
   deriving stock (Show, Eq, Generic)
 
-instance Given ColorMode => Buildable Position where
-  build (Position pos) = case pos of
-    Nothing -> ""
-    Just p  -> styleIfNeeded Faint $ "at src:" <> build p
+instance Buildable Position where
+  build (Position pos) = maybe "" build pos
 
 -- | Full info about a reference.
 data Reference = Reference

diff --git a/src/Xrefcheck/Scan.hs b/src/Xrefcheck/Scan.hs
@@ -37,7 +37,7 @@ import Control.Lens (_1, makeLensesWith, (%~))
 import Data.Aeson (FromJSON (..), genericParseJSON, withText)
 import Data.Map qualified as M
 import Data.Reflection (Given)
-import Fmt (Buildable (..), fmt)
+import Fmt (Buildable (..), Builder, fmtLn)
 import System.Directory (doesDirectoryExist, pathIsSymbolicLink)
 import System.Process (cwd, readCreateProcess, shell)
 import Text.Interpolation.Nyan
@@ -120,23 +120,20 @@ mkGatherScanError seFile ScanError{sePosition, seDescription} = ScanError
   , seDescription
   }
 
-instance Given ColorMode => Buildable (ScanError 'Gather) where
-  build ScanError{..} = [int||
-    In file #{styleIfNeeded Faint (styleIfNeeded Bold seFile)}
-    scan error #{sePosition}:
-
-    #{seDescription}
-
-    |]
+pprScanErr :: Given ColorMode => ScanError 'Gather -> Builder
+pprScanErr ScanError{..} = hdr <> "\n" <> interpolateIndentF 2 msg <> "\n"
+  where
+    hdr, msg :: Builder
+    hdr =
+      styleIfNeeded Bold (build seFile <> ":" <> build sePosition <> ": ") <>
+      colorIfNeeded Red "scan error:"
+    msg = build seDescription
 
 reportScanErrs :: Given ColorMode => NonEmpty (ScanError 'Gather) -> IO ()
-reportScanErrs errs = fmt
-  [int||
-  === Scan errors found ===
-
-  #{interpolateIndentF 2 (interpolateBlockListF' "➥ " build errs)}
-  Scan errors dumped, #{length errs} in total.
-  |]
+reportScanErrs errs = do
+  traverse_ (fmtLn . pprScanErr) errs
+  fmtLn $ colorIfNeeded Red $
+    "Scan errors dumped, " <> build (length errs) <> " in total."
 
 data ScanErrorDescription
   = LinkErr
@@ -152,8 +149,8 @@ instance Buildable ScanErrorDescription where
                      markdown or right after comments at the top|]
     ParagraphErr txt -> [int||Expected a PARAGRAPH after \
                               "ignore paragraph" annotation, but found #{txt}|]
-    UnrecognisedErr txt -> [int||Unrecognised option "#{txt}" perhaps you meant \
-                                 <"ignore link"|"ignore paragraph"|"ignore all">|]
+    UnrecognisedErr txt -> [int||Unrecognised option "#{txt}"
+                                 Perhaps you meant <"ignore link"|"ignore paragraph"|"ignore all">|]
 
 firstFileSupport :: [FileSupport] -> FileSupport
 firstFileSupport fs isSymlink =

diff --git a/src/Xrefcheck/Verify.hs b/src/Xrefcheck/Verify.hs
@@ -46,7 +46,7 @@ import Data.Text.Metrics (damerauLevenshteinNorm)
 import Data.Time (UTCTime, defaultTimeLocale, formatTime, readPTime, rfc822DateFormat)
 import Data.Time.Clock.POSIX (getPOSIXTime)
 import Data.Traversable (for)
-import Fmt (Buildable (..), Builder, fmt, maybeF, nameF)
+import Fmt (Buildable (..), Builder, fmt, fmtLn, maybeF, nameF)
 import GHC.Exts qualified as Exts
 import GHC.Read (Read (readPrec))
 import Network.FTP.Client
@@ -107,13 +107,6 @@ data WithReferenceLoc a = WithReferenceLoc
   , wrlItem      :: a
   }
 
-instance (Given ColorMode, Buildable a) => Buildable (WithReferenceLoc a) where
-  build WithReferenceLoc{..} = [int||
-    In file #{styleIfNeeded Faint (styleIfNeeded Bold wrlFile)}
-    bad #{wrlReference}
-    #{wrlItem}
-    |]
-
 -- | Contains a name of a domain, examples:
 -- @DomainName "github.com"@,
 -- @DomainName "localhost"@,
@@ -147,8 +140,8 @@ data ResponseResult
   = RRDone
   | RRFollow Text
 
-instance Given ColorMode => Buildable VerifyError where
-  build = \case
+pprVerifyErr' :: Given ColorMode => VerifyError -> Builder
+pprVerifyErr' = \case
     LocalFileDoesNotExist file ->
       [int||
       File does not exist:
@@ -304,15 +297,55 @@ incTotalCounter rc = rc {rcTotalRetries = rcTotalRetries rc + 1}
 incTimeoutCounter :: RetryCounter -> RetryCounter
 incTimeoutCounter rc = rc {rcTimeoutRetries = rcTimeoutRetries rc + 1}
 
+pprReferenceInfo :: Given ColorMode => ReferenceInfo -> Builder
+pprReferenceInfo = \case
+  RIFile ReferenceInfoFile{..} ->
+    case rifLink of
+      FLLocal ->
+        [int||
+        - #{paren $ colorIfNeeded Green "file-local"}
+        - anchor: #{rifAnchor ?: styleIfNeeded Faint "-"}
+        |]
+      FLRelative link ->
+        [int||
+        - link #{paren $ colorIfNeeded Yellow "relative"}: #{link}
+        - anchor: #{rifAnchor ?: styleIfNeeded Faint "-"}
+        |]
+      FLAbsolute link ->
+        [int||
+        - link #{paren $ colorIfNeeded Yellow "absolute"}: /#{link}
+        - anchor: #{rifAnchor ?: styleIfNeeded Faint "-"}
+        |]
+  RIExternal (ELUrl url) ->
+    [int||
+    - link #{paren $ colorIfNeeded Red "external"}: #{url}
+    |]
+  RIExternal (ELOther url) ->
+    [int||
+    - link: #{url}
+    |]
+
+pprVerifyErr :: Given ColorMode => WithReferenceLoc VerifyError -> Builder
+pprVerifyErr wrl = hdr <> "\n" <> interpolateIndentF 2 msg
+  where
+    WithReferenceLoc{wrlFile, wrlReference, wrlItem} = wrl
+    Reference{rName, rInfo} = wrlReference
+
+    hdr, msg :: Builder
+    hdr =
+      styleIfNeeded Bold (build wrlFile <> ":" <> build (rPos wrlReference) <> ": ") <>
+      colorIfNeeded Red "bad reference:"
+    msg =
+      "- text: " <> (show rName) <> "\n" <>
+      pprReferenceInfo rInfo <> "\n" <>
+      pprVerifyErr' wrlItem
+
 reportVerifyErrs
   :: Given ColorMode => NonEmpty (WithReferenceLoc VerifyError) -> IO ()
-reportVerifyErrs errs = fmt
-  [int||
-  === Invalid references found ===
-
-  #{interpolateIndentF 2 (interpolateBlockListF' "➥ " build errs)}
-  Invalid references dumped, #{length errs} in total.
-  |]
+reportVerifyErrs errs = do
+  traverse_ (fmtLn . pprVerifyErr) errs
+  fmtLn $ colorIfNeeded Red $
+    "Invalid references dumped, " <> build (length errs) <> " in total."
 
 data RetryAfter = Date UTCTime | Seconds (Time Second)
   deriving stock (Show, Eq)

diff --git a/tests/golden/check-anchors/expected1.gold b/tests/golden/check-anchors/expected1.gold
@@ -1,32 +1,29 @@
-=== Invalid references found ===
+a.md:16:1-43: bad reference:
+  - text: "ambiguous anchor in this file"
+  - (file-local)
+  - anchor: some-text
 
-  ➥  In file a.md
-     bad reference (file-local) at src:16:1-43:
-       - text: "ambiguous anchor in this file"
-       - anchor: some-text
+  Ambiguous reference to anchor 'some-text'
+    In file a.md
+    It could refer to either:
+      - some-text (header I) 6:1-11
+      - some-text (header I) 8:1-15
+      - some-text (header II) 12:1-12
+    Use of ambiguous anchors is discouraged because the target
+    can change silently while the document containing it evolves.
 
-     Ambiguous reference to anchor 'some-text'
-       In file a.md
-       It could refer to either:
-         - some-text (header I) at src:6:1-11
-         - some-text (header I) at src:8:1-15
-         - some-text (header II) at src:12:1-12
-       Use of ambiguous anchors is discouraged because the target
-       can change silently while the document containing it evolves.
+b.md:7:1-48: bad reference:
+  - text: "ambiguous anchor in other file"
+  - link (relative): a.md
+  - anchor: some-text
 
-  ➥  In file b.md
-     bad reference (relative) at src:7:1-48:
-       - text: "ambiguous anchor in other file"
-       - link: a.md
-       - anchor: some-text
-
-     Ambiguous reference to anchor 'some-text'
-       In file a.md
-       It could refer to either:
-         - some-text (header I) at src:6:1-11
-         - some-text (header I) at src:8:1-15
-         - some-text (header II) at src:12:1-12
-       Use of ambiguous anchors is discouraged because the target
-       can change silently while the document containing it evolves.
+  Ambiguous reference to anchor 'some-text'
+    In file a.md
+    It could refer to either:
+      - some-text (header I) 6:1-11
+      - some-text (header I) 8:1-15
+      - some-text (header II) 12:1-12
+    Use of ambiguous anchors is discouraged because the target
+    can change silently while the document containing it evolves.
 
 Invalid references dumped, 2 in total.
diff --git a/tests/golden/check-anchors/expected2.gold b/tests/golden/check-anchors/expected2.gold
@@ -1,27 +1,25 @@
-=== Invalid references found ===
+a.md:12:1-13: bad reference:
+  - text: "broken"
+  - (file-local)
+  - anchor: h3
 
-  ➥  In file a.md
-     bad reference (file-local) at src:12:1-13:
-       - text: "broken"
-       - anchor: h3
+  Anchor 'h3' is not present, did you mean:
+      - h1 (header I) 6:1-4
+      - h2 (header II) 8:1-5
 
-     Anchor 'h3' is not present, did you mean:
-         - h1 (header I) at src:6:1-4
-         - h2 (header II) at src:8:1-5
+a.md:14:1-18: bad reference:
+  - text: "broken"
+  - (file-local)
+  - anchor: heading
 
-  ➥  In file a.md
-     bad reference (file-local) at src:14:1-18:
-       - text: "broken"
-       - anchor: heading
+  Anchor 'heading' is not present, did you mean:
+      - the-heading (header I) 10:1-13
 
-     Anchor 'heading' is not present, did you mean:
-         - the-heading (header I) at src:10:1-13
+a.md:16:1-31: bad reference:
+  - text: "broken"
+  - (file-local)
+  - anchor: really-unique-anchor
 
-  ➥  In file a.md
-     bad reference (file-local) at src:16:1-31:
-       - text: "broken"
-       - anchor: really-unique-anchor
-
-     Anchor 'really-unique-anchor' is not present
+  Anchor 'really-unique-anchor' is not present
 
 Invalid references dumped, 3 in total.
diff --git a/tests/golden/check-autolinks/expected.gold b/tests/golden/check-autolinks/expected.gold
@@ -5,22 +5,19 @@
         - reference (external):
             - text: "https://www.google.com/doodles"
             - link: https://www.google.com/doodles
-        - reference (external) at src:8:0-18:
+        - reference (external) 8:0-18:
             - text: "www.commonmark.org"
             - link: http://www.commonmark.org
     - anchors:
         none
 
-=== Invalid references found ===
+file-with-autolinks.md:8:0-18: bad reference:
+  - text: "www.commonmark.org"
+  - link (external): http://www.commonmark.org
 
-  ➥  In file file-with-autolinks.md
-     bad reference (external) at src:8:0-18:
-       - text: "www.commonmark.org"
-       - link: http://www.commonmark.org
-
-     Permanent redirect found:
-       -| http://www.commonmark.org
-       -> https://commonmark.org
-          ^-- stopped before this one
+  Permanent redirect found:
+    -| http://www.commonmark.org
+    -> https://commonmark.org
+       ^-- stopped before this one
 
 Invalid references dumped, 1 in total.
diff --git a/tests/golden/check-backslash/expected.gold b/tests/golden/check-backslash/expected.gold
@@ -2,40 +2,37 @@
 
   a.md:
     - references:
-        - reference (relative) at src:8:1-33:
+        - reference (relative) 8:1-33:
             - text: "Reference to a\\a"
             - link: a\a.md
             - anchor: header
-        - reference (relative) at src:10:1-30:
+        - reference (relative) 10:1-30:
             - text: "Bad reference to a\\b"
             - link: a\b.md
             - anchor: -
     - anchors:
-        - header (header I) at src:6:1-8
+        - header (header I) 6:1-8
 
   a\a.md:
     - references:
-        - reference (relative) at src:2:1-22:
+        - reference (relative) 2:1-22:
             - text: "Reference to a"
             - link: a.md
             - anchor: -
-        - reference (relative) at src:3:1-29:
+        - reference (relative) 3:1-29:
             - text: "Reference to myself"
             - link: a\a.md
             - anchor: -
     - anchors:
-        - header (header I) at src:1:1-8
+        - header (header I) 1:1-8
 
-=== Invalid references found ===
+a.md:10:1-30: bad reference:
+  - text: "Bad reference to a\\b"
+  - link (relative): a\b.md
+  - anchor: -
 
-  ➥  In file a.md
-     bad reference (relative) at src:10:1-30:
-       - text: "Bad reference to a\\b"
-       - link: a\b.md
-       - anchor: -
-
-     File does not exist:
-       a\b.md
-       Its reference contains a backslash. Maybe it uses the wrong path separator.
+  File does not exist:
+    a\b.md
+    Its reference contains a backslash. Maybe it uses the wrong path separator.
 
 Invalid references dumped, 1 in total.