[#226] Change error message formatting

CHANGES.md

@@ -56,6 +56,10 @@ Unreleased
   + Now Xrefcheck is able to follow relative redirects.
 * [#262](https://github.com/serokell/xrefcheck/pull/262)
   + Now Xrefcheck includes a scanner that verifies the repository symlinks.
+* [#307](https://github.com/serokell/xrefcheck/pull/307)
+  + The output of Xrefcheck is now more legible.
+  + Add the `--print-unix-paths` (`-u`) flag to print paths in Unix style (with
+    forward slashes) on all platforms.
 
 0.2.2
 ==========

package.yaml

@@ -93,6 +93,7 @@ library:
     - filepath
     - fmt
     - ftp-client
+    - crypton-connection
     - Glob
     - http-client
     - http-types
@@ -149,6 +150,7 @@ tests:
       - cmark-gfm
       - containers
       - directory
+      - filepath
       - wai
       - warp
       - scotty

src/Xrefcheck/CLI.hs

@@ -39,7 +39,7 @@ import Paths_xrefcheck (version)
 import Xrefcheck.Config (NetworkingConfig, NetworkingConfig' (..))
 import Xrefcheck.Core
 import Xrefcheck.Scan
-import Xrefcheck.System (CanonicalRelGlobPattern, mkCanonicalRelGlobPattern)
+import Xrefcheck.System (CanonicalRelGlobPattern, PrintUnixPaths (..), mkCanonicalRelGlobPattern)
 import Xrefcheck.Util (ColorMode (WithColors, WithoutColors))
 
 modeReadM :: ReadM VerifyMode
@@ -84,6 +84,7 @@ data Options = Options
   , oVerbose           :: Bool
   , oShowProgressBar   :: Maybe Bool
   , oColorMode         :: Maybe ColorMode
+  , oPrintUnixPaths    :: PrintUnixPaths
   , oExclusionOptions  :: ExclusionOptions
   , oNetworkingOptions :: NetworkingOptions
   , oScanPolicy        :: ScanPolicy
@@ -196,6 +197,10 @@ optionsParser = do
         help "Disable ANSI coloring of output."
     , pure Nothing
     ]
+  oPrintUnixPaths <- fmap PrintUnixPaths $ switch $
+    short 'u' <>
+    long "--print-unix-paths" <>
+    help "Print paths in Unix style (with forward slashes) on all platforms."
   oExclusionOptions <- exclusionOptionsParser
   oNetworkingOptions <- networkingOptionsParser
   oScanPolicy <- flag OnlyTracked IncludeUntracked $
@@ -208,7 +213,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 +242,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}). \

src/Xrefcheck/Command.hs

@@ -9,7 +9,7 @@ module Xrefcheck.Command
 
 import Universum
 
-import Data.Reflection (give)
+import Data.Reflection (Given, give)
 import Data.Yaml (decodeFileEither, prettyPrintParseException)
 import Fmt (build, fmt, fmtLn)
 import System.Console.Pretty (supportsPretty)
@@ -24,7 +24,7 @@ import Xrefcheck.Progress (allowRewrite)
 import Xrefcheck.Scan
 import Xrefcheck.Scanners.Markdown (markdownSupport)
 import Xrefcheck.Scanners.Symlink (symlinkSupport)
-import Xrefcheck.System (askWithinCI)
+import Xrefcheck.System (PrintUnixPaths (..), askWithinCI)
 import Xrefcheck.Util
 import Xrefcheck.Verify (reportVerifyErrs, verifyErrors, verifyRepo)
 
@@ -33,7 +33,7 @@ readConfig path = fmap overrideConfig do
   decodeFileEither path
     >>= either (error . toText . prettyPrintParseException) pure
 
-configuredFileSupport :: ScannersConfig -> FileSupport
+configuredFileSupport :: Given PrintUnixPaths => ScannersConfig -> FileSupport
 configuredFileSupport ScannersConfig{..} = firstFileSupport
     [ markdownSupport scMarkdown
     , symlinkSupport
@@ -55,7 +55,7 @@ defaultAction Options{..} = do
         then WithColors
         else WithoutColors
 
-  give colorMode $ do
+  give oPrintUnixPaths $ give colorMode $ do
     config <- case oConfigPath of
       Just configPath -> readConfig configPath
       Nothing -> do
@@ -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

@@ -60,13 +60,11 @@ instance FromJSON Flavor where
 -- | Description of element position in source file.
 -- We keep this in text because scanners for different formats use different
 -- representation of this thing, and it actually appears in reports only.
-newtype Position = Position (Maybe Text)
+newtype Position = Position 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) = build pos
 
 -- | Full info about a reference.
 data Reference = Reference
@@ -235,46 +233,41 @@ instance Given ColorMode => Buildable Reference where
         case rifLink of
           FLLocal ->
             [int||
-            reference #{paren $ colorIfNeeded Green "file-local"}#{posSep}#{rPos}:
+            reference #{paren $ colorIfNeeded Green "file-local"} at #{rPos}:
               - text: #s{rName}
               - anchor: #{rifAnchor ?: styleIfNeeded Faint "-"}
             |]
           FLRelative link ->
             [int||
-            reference #{paren $ colorIfNeeded Yellow "relative"}#{posSep}#{rPos}:
+            reference #{paren $ colorIfNeeded Yellow "relative"} at #{rPos}:
               - text: #s{rName}
               - link: #{link}
               - anchor: #{rifAnchor ?: styleIfNeeded Faint "-"}
             |]
           FLAbsolute link ->
             [int||
-            reference #{paren $ colorIfNeeded Yellow "absolute"}#{posSep}#{rPos}:
+            reference #{paren $ colorIfNeeded Yellow "absolute"} at #{rPos}:
               - text: #s{rName}
               - link: /#{link}
               - anchor: #{rifAnchor ?: styleIfNeeded Faint "-"}
             |]
       RIExternal (ELUrl url) ->
         [int||
-        reference #{paren $ colorIfNeeded Red "external"}#{posSep}#{rPos}:
+        reference #{paren $ colorIfNeeded Red "external"} at #{rPos}:
           - text: #s{rName}
           - link: #{url}
         |]
       RIExternal (ELOther url) ->
         [int||
-        reference (other)#{posSep}#{rPos}:
+        reference (other) at #{rPos}:
           - text: #s{rName}
           - link: #{url}
         |]
-    where
-      posSep :: Text
-      posSep = case rPos of
-        Position Nothing -> ""
-        _ -> " "
 
 instance Given ColorMode => Buildable AnchorType where
   build = styleIfNeeded Faint . \case
     HeaderAnchor l -> colorIfNeeded Green ("header " <> headerLevelToRoman l)
-    HandAnchor -> colorIfNeeded Yellow "hand made"
+    HandAnchor -> colorIfNeeded Yellow "handmade"
     BiblioAnchor -> colorIfNeeded Cyan "biblio"
     where
       headerLevelToRoman = \case
@@ -289,7 +282,7 @@ instance Given ColorMode => Buildable AnchorType where
 instance Given ColorMode => Buildable Anchor where
   build Anchor{..} =
     [int||
-    #{aName} (#{aType}) #{aPos}
+    #{aName} (#{aType}) at #{aPos}
     |]
 
 instance Given ColorMode => Buildable FileInfo where

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 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 =