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 eebf449..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) @@ -207,12 +220,12 @@ fix mode verbose tabSize f = checkFile tabSize verbose f >>= \case CheckOK -> do - when verbose $ + when (isJust verbose) $ putStrLn $ "[ Checked ] " ++ 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 +240,19 @@ 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 ] " <> 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