From b33957ed5644042da0270c9732942414373b3d57 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Fri, 14 Mar 2025 16:58:43 +0000 Subject: [PATCH 1/2] Print 10 violations in normal mode Using --verbose on a large project prints out too much output (see https://github.com/haskell/cabal/issues/10744) Printing out all the violations if there are a lot of them is quite slow, printing out a lot to stdout is not that fast. Therefore we reach a compromise where we print up to 10 reasons for failure and omit the rest. If you want all the failures you can use --verbose. Fixes #48 --- FixWhitespace.hs | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/FixWhitespace.hs b/FixWhitespace.hs index eebf449..6a284a3 100644 --- a/FixWhitespace.hs +++ b/FixWhitespace.hs @@ -204,7 +204,7 @@ main = do fix :: Mode -> Verbose -> TabSize -> FilePath -> IO Bool fix mode verbose tabSize f = - checkFile tabSize verbose f >>= \case + checkFile tabSize True f >>= \case CheckOK -> do when verbose $ @@ -212,7 +212,7 @@ fix mode verbose tabSize f = return False CheckViolation s vs -> do - hPutStrLn stderr (msg vs) + Text.hPutStrLn stderr (msg vs) when (mode == Fix) $ withFile f WriteMode $ \h -> do hSetEncoding h utf8 @@ -227,9 +227,20 @@ fix mode verbose tabSize f = where msg vs | mode == Fix = - "[ Violation fixed ] " ++ f + "[ Violation fixed ] " <> Text.pack f | otherwise = - "[ Violation detected ] " ++ f ++ - (if not verbose then "" else - ":\n" ++ unlines (map (Text.unpack . displayLineError f) vs)) + "[ Violation detected ]:\n" <> Text.pack f <> + (if not verbose then (displayViolations (Just 10) vs) + else (displayViolations Nothing vs)) + + + displayViolations mlimit violations = + let (display_violations, more_violations) = + case mlimit of + Just limit -> splitAt limit violations + Nothing -> (violations, []) + in Text.unlines (map (displayLineError f) display_violations) + <> case more_violations of + [] -> mempty + (_:_) -> "\n... and " <> Text.pack (show (length more_violations)) <> " more violations." From d97ec7102ad534aa8df38c0fb3a64f4b25ff9bf3 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 17 May 2025 19:53:54 +0200 Subject: [PATCH 2/2] `--verbose` option takes argument (default 10) This limits the number of errors displayed per file. --- CHANGELOG.md | 7 ++++ FixWhitespace.hs | 66 ++++++++++++++++++++-------------- fix-whitespace.cabal | 2 +- src/Data/Text/FixWhitespace.hs | 5 +-- test/Golden.hs | 4 ++- 5 files changed, 53 insertions(+), 31 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0b0c2fd..bbbc35e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,13 @@ Version history. +# 0.2 + +- [BREAKING:] Flag `--verbose` now takes an optional argument + that determines the maximum number of whitespace violations printed per file. + This argument is an integer, defaulting to 10, but can be `all` + to not limit the number of violations. + # 0.1 Rainy Summer edition released 2023-08-07 - Flag `--verbose` now also displays locations of whitespace violations diff --git a/FixWhitespace.hs b/FixWhitespace.hs index 6a284a3..a38c549 100644 --- a/FixWhitespace.hs +++ b/FixWhitespace.hs @@ -4,14 +4,16 @@ module Main where -import Control.Monad ( unless, when ) +import Control.Monad ( unless, when, forM ) import Data.List.Extra ( nubOrd ) +import Data.Maybe ( fromMaybe, isJust ) +import Data.Text ( Text ) import qualified Data.Text as Text import qualified Data.Text.IO as Text {- Strict IO -} import Data.Version ( showVersion ) -import System.Console.GetOpt ( OptDescr(Option), ArgDescr(NoArg, ReqArg), ArgOrder(Permute), getOpt, usageInfo ) +import System.Console.GetOpt ( OptDescr(Option), ArgDescr(NoArg, ReqArg, OptArg), ArgOrder(Permute), getOpt, usageInfo ) import System.Directory ( getCurrentDirectory, doesFileExist ) import System.Environment ( getArgs, getProgName ) import System.Exit ( die, exitFailure, exitSuccess ) @@ -21,7 +23,7 @@ import System.IO ( IOMode(WriteMode), hPutStr, hPut import Text.Read ( readMaybe ) import Data.Text.FixWhitespace ( CheckResult(CheckOK, CheckViolation, CheckIOError), checkFile, displayLineError - , TabSize, Verbose, defaultTabSize ) + , TabSize, Verbose, defaultTabSize, LineError ) import ParseConfig ( Config(Config), parseConfig ) import qualified Paths_fix_whitespace as PFW ( version ) @@ -31,6 +33,10 @@ import qualified Paths_fix_whitespace as PFW ( version ) defaultConfigFile :: String defaultConfigFile = "fix-whitespace.yaml" +-- | Default number of errors printed per file with @--verbose@. +defaultNumberOfErrors :: Int +defaultNumberOfErrors = 10 + -- Modes. data Mode = Fix -- ^ Fix whitespace issues. @@ -38,7 +44,7 @@ data Mode deriving (Show, Eq) data Options = Options - { optVerbose :: Verbose + { optVerbose :: Maybe String -- ^ Display the location of a file being checked or not. , optHelp :: Bool -- ^ Display the help information. @@ -53,7 +59,7 @@ data Options = Options defaultOptions :: Options defaultOptions = Options - { optVerbose = False + { optVerbose = Nothing , optHelp = False , optVersion = False , optMode = Fix @@ -70,10 +76,12 @@ options = (NoArg (\opts -> opts { optVersion = True })) "Show the program's version." , Option ['v'] ["verbose"] - (NoArg (\opts -> opts { optVerbose = True })) + (OptArg (\ms opts -> opts { optVerbose = Just $ fromMaybe (show defaultNumberOfErrors) ms }) "N") (unlines [ "Show files as they are being checked." - , "Display location of detected whitespace violations." + , "Display location of detected whitespace violations," + , "up to N per file, or all if N is `all'." + , "N defaults to 10." ]) , Option ['t'] ["tab"] (ReqArg (\ts opts -> opts { optTabSize = ts }) "TABSIZE") @@ -153,12 +161,17 @@ main = do exitFailure let mode = optMode opts - verbose = optVerbose opts config = optConfig opts tabSize <- maybe (die "Error: Illegal TABSIZE, must be an integer.") return $ readMaybe $ optTabSize opts + + verbose :: Verbose <- forM (optVerbose opts) $ \case + "all" -> pure (maxBound :: Int) + s -> maybe (die "Error: Illegal VERBOSITY, must be an integer or 'all'.") pure $ + readMaybe s + base <- getCurrentDirectory files <- if not $ null nonOpts @@ -178,10 +191,10 @@ main = do -- and when not matching an excluded file pattern let incPatterns = map ("**/" ++) incFiles -- Directory and file patterns to exclude - let excPatterns = (map (++ "*") excDirs) - ++ (map ("**/" ++) excFiles) + let excPatterns = map (++ "*") excDirs + ++ map ("**/" ++) excFiles - when verbose $ do + when (isJust verbose) $ do putStrLn "Include whitelist:" putStrLn (unlines incWhitelistPatterns) @@ -204,10 +217,10 @@ main = do fix :: Mode -> Verbose -> TabSize -> FilePath -> IO Bool fix mode verbose tabSize f = - checkFile tabSize True f >>= \case + checkFile tabSize verbose f >>= \case CheckOK -> do - when verbose $ + when (isJust verbose) $ putStrLn $ "[ Checked ] " ++ f return False @@ -230,17 +243,16 @@ fix mode verbose tabSize f = "[ Violation fixed ] " <> Text.pack f | otherwise = - "[ Violation detected ]:\n" <> Text.pack f <> - (if not verbose then (displayViolations (Just 10) vs) - else (displayViolations Nothing vs)) - - - displayViolations mlimit violations = - let (display_violations, more_violations) = - case mlimit of - Just limit -> splitAt limit violations - Nothing -> (violations, []) - in Text.unlines (map (displayLineError f) display_violations) - <> case more_violations of - [] -> mempty - (_:_) -> "\n... and " <> Text.pack (show (length more_violations)) <> " more violations." + "[ Violation detected ] " <> Text.pack f <> + (displayViolations verbose vs) + + -- In verbose mode, take initial errors up to maximum verbosity. + displayViolations :: Verbose -> [LineError] -> Text + displayViolations Nothing _ = Text.empty + displayViolations (Just limit) _ | limit <= 0 = Text.empty + displayViolations (Just limit) violations = do + let (display_violations, more_violations) = splitAt limit violations + -- txt should start and end with a newline character. + let txt = Text.unlines $ Text.empty : map (displayLineError f) display_violations + if null more_violations then txt + else txt <> "... and " <> Text.pack (show (length more_violations)) <> " more violations." diff --git a/fix-whitespace.cabal b/fix-whitespace.cabal index 07dc7eb..df9d371 100644 --- a/fix-whitespace.cabal +++ b/fix-whitespace.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: fix-whitespace -version: 0.1 +version: 0.2 build-type: Simple category: Text diff --git a/src/Data/Text/FixWhitespace.hs b/src/Data/Text/FixWhitespace.hs index e29e629..c3777ab 100644 --- a/src/Data/Text/FixWhitespace.hs +++ b/src/Data/Text/FixWhitespace.hs @@ -19,6 +19,7 @@ import Control.Monad.Trans.Writer.Strict ( Writer, runWriter, tell ) import Control.Exception ( IOException, handle ) import Data.Char ( GeneralCategory(Space, Format), generalCategory ) +import Data.Maybe ( isJust ) import Data.Text ( Text ) import qualified Data.Text as Text import qualified Data.Text.IO as Text {- Strict IO -} @@ -27,7 +28,7 @@ import System.IO ( IOMode(ReadMode), hSetEncod import Data.List.Extra.Drop ( dropWhileEnd1, dropWhile1 ) -type Verbose = Bool +type Verbose = Maybe Int type TabSize = Int -- | Default tab size. @@ -61,7 +62,7 @@ checkFile tabSize verbose f = hSetEncoding h utf8 s <- Text.hGetContents h let (s', lvs) - | verbose = transformWithLog tabSize s + | isJust verbose = transformWithLog tabSize s | otherwise = (transform tabSize s, []) return $ if s' == s then CheckOK else CheckViolation s' lvs diff --git a/test/Golden.hs b/test/Golden.hs index 61858b7..e0c0f80 100644 --- a/test/Golden.hs +++ b/test/Golden.hs @@ -34,7 +34,7 @@ goldenTests = do goldenValue :: FilePath -> IO ByteString goldenValue file = do - checkFile defaultTabSize {-verbose: -}True file >>= \case + checkFile defaultTabSize {-verbose: -} maxVerbosity file >>= \case CheckIOError e -> ioError e @@ -45,3 +45,5 @@ goldenValue file = do CheckViolation _ errs -> return $ LazyText.encodeUtf8 $ LazyText.fromStrict $ Text.unlines $ "Violations:" : map (displayLineError file) errs + where + maxVerbosity = Just (maxBound :: Int) \ No newline at end of file