change formatting

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"

src/Xrefcheck/Core.hs

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

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 =

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)