From 8ddb5086557a1ded81bbdfb89e8a3925e41c61c3 Mon Sep 17 00:00:00 2001 From: Artem Pelenitsyn Date: Sat, 18 Mar 2023 13:29:48 -0400 Subject: [PATCH] Print line violations only under --verbose flag Alleviates #48 but a proper performance fix would be better. --- FixWhitespace.hs | 27 ++++++++------- src/Data/Text/FixWhitespace.hs | 61 +++++++++++++++++++++++----------- test/Golden.hs | 2 +- 3 files changed, 57 insertions(+), 33 deletions(-) diff --git a/FixWhitespace.hs b/FixWhitespace.hs index c5097c5..42e87c0 100644 --- a/FixWhitespace.hs +++ b/FixWhitespace.hs @@ -21,7 +21,7 @@ import System.IO ( IOMode(WriteMode), hPutStr, hPut import Text.Read ( readMaybe ) import Data.Text.FixWhitespace ( CheckResult(CheckOK, CheckViolation, CheckIOError), checkFile, displayLineError - , TabSize, defaultTabSize ) + , TabSize, Verbose, defaultTabSize ) import ParseConfig ( Config(Config), parseConfig ) import qualified Paths_fix_whitespace as PFW ( version ) @@ -37,8 +37,6 @@ data Mode | Check -- ^ Check if there are any whitespace issues. deriving (Show, Eq) -type Verbose = Bool - data Options = Options { optVerbose :: Verbose -- ^ Display the location of a file being checked or not. @@ -203,28 +201,33 @@ main = do fix :: Mode -> Verbose -> TabSize -> FilePath -> IO Bool fix mode verbose tabSize f = - checkFile tabSize f >>= \case + checkFile tabSize verbose f >>= \case CheckOK -> do when verbose $ putStrLn $ "[ Checked ] " ++ f return False - CheckViolation s vs -> do - hPutStrLn stderr $ - "[ Violation " ++ - (if mode == Fix then "fixed" else "detected") ++ - " ] " ++ f ++ - (if mode == Fix then "" else - ":\n" ++ (unlines $ map (Text.unpack . displayLineError f) vs)) - + CheckViolation s vs -> do + hPutStrLn stderr (msg vs) when (mode == Fix) $ withFile f WriteMode $ \h -> do hSetEncoding h utf8 Text.hPutStr h s return True + CheckIOError _e -> do hPutStrLn stderr $ "[ Read error ] " ++ f return False + + where + msg vs + | mode == Fix = + "[ Violation fixed ] " ++ f + + | otherwise = + "[ Violation detected ] " ++ f ++ + (if not verbose then "" else + ":\n" ++ unlines (map (Text.unpack . displayLineError f) vs)) diff --git a/src/Data/Text/FixWhitespace.hs b/src/Data/Text/FixWhitespace.hs index b1004b6..e29e629 100644 --- a/src/Data/Text/FixWhitespace.hs +++ b/src/Data/Text/FixWhitespace.hs @@ -7,7 +7,9 @@ module Data.Text.FixWhitespace , LineError(..) , displayLineError , transform + , transformWithLog , TabSize + , Verbose , defaultTabSize ) where @@ -23,12 +25,13 @@ import qualified Data.Text.IO as Text {- Strict IO -} import System.IO ( IOMode(ReadMode), hSetEncoding, utf8, withFile ) -import Data.List.Extra.Drop ( dropWhileEnd1 ) +import Data.List.Extra.Drop ( dropWhileEnd1, dropWhile1 ) +type Verbose = Bool type TabSize = Int -- | Default tab size. - +-- defaultTabSize :: TabSize defaultTabSize = 8 @@ -51,27 +54,42 @@ data LineError = LineError Int Text -- | Check a file against the whitespace policy, -- returning a fix if violations occurred. -- -checkFile :: TabSize -> FilePath -> IO CheckResult -checkFile tabSize f = +checkFile :: TabSize -> Verbose -> FilePath -> IO CheckResult +checkFile tabSize verbose f = handle (\ (e :: IOException) -> return $ CheckIOError e) $ withFile f ReadMode $ \ h -> do hSetEncoding h utf8 s <- Text.hGetContents h - let (s', lvs) = transform tabSize s + let (s', lvs) + | verbose = transformWithLog tabSize s + | otherwise = (transform tabSize s, []) return $ if s' == s then CheckOK else CheckViolation s' lvs +transform + :: TabSize -- ^ Expand tab characters to so many spaces. Keep tabs if @<= 0@. + -> Text -- ^ Text before transformation. + -> Text -- ^ Text after transformation. +transform tabSize = + Text.unlines . + removeFinalEmptyLinesExceptOne . + map (removeTrailingWhitespace . convertTabs tabSize) . + Text.lines + where + removeFinalEmptyLinesExceptOne = + reverse . dropWhile1 Text.null . reverse + -- | The transformation monad: maintains info about lines that --- violate the rules. +-- violate the rules. Used in the verbose mode to build a log. -- type TransformM = Writer [LineError] -- | Transforms the contents of a file. -- -transform +transformWithLog :: TabSize -- ^ Expand tab characters to so many spaces. Keep tabs if @<= 0@. -> Text -- ^ Text before transformation. -> (Text, [LineError]) -- ^ Text after transformation and violating lines if any. -transform tabSize = +transformWithLog tabSize = runWriter . fmap Text.unlines . fixAllViolations . @@ -82,7 +100,7 @@ transform tabSize = fixAllViolations = removeFinalEmptyLinesExceptOne <=< - mapM (fixLineWith $ removeTrailingWhitespace . convertTabs) + mapM (fixLineWith $ removeTrailingWhitespace . convertTabs tabSize) removeFinalEmptyLinesExceptOne :: [Text] -> TransformM [Text] removeFinalEmptyLinesExceptOne ls @@ -96,9 +114,6 @@ transform tabSize = lenLs' = length ls' els = replicate (lenLs - lenLs') "" - removeTrailingWhitespace = - Text.dropWhileEnd $ \ c -> generalCategory c `elem` [Space,Format] || c == '\t' - fixLineWith :: (Text -> Text) -> (Int, Text) -> TransformM Text fixLineWith fixer (i, l) | l == l' = pure l @@ -108,16 +123,22 @@ transform tabSize = where l' = fixer l - convertTabs = if tabSize <= 0 then id else - Text.pack . reverse . fst . foldl convertOne ([], 0) . Text.unpack +removeTrailingWhitespace :: Text -> Text +removeTrailingWhitespace = + Text.dropWhileEnd $ \ c -> generalCategory c `elem` [Space,Format] || c == '\t' - convertOne (a, p) '\t' = (addSpaces n a, p + n) - where - n = tabSize - p `mod` tabSize -- Here, tabSize > 0 is guaranteed - convertOne (a, p) c = (c:a, p+1) +convertTabs :: TabSize -> Text -> Text +convertTabs tabSize = if tabSize <= 0 then id else + Text.pack . reverse . fst . foldl (convertOne tabSize) ([], 0) . Text.unpack + +convertOne :: TabSize -> (String, Int) -> Char -> (String, Int) +convertOne tabSize (a, p) '\t' = (addSpaces n a, p + n) + where + n = tabSize - p `mod` tabSize -- Here, tabSize > 0 is guaranteed +convertOne _tabSize (a, p) c = (c:a, p+1) - addSpaces :: Int -> String -> String - addSpaces n = (replicate n ' ' ++) +addSpaces :: Int -> String -> String +addSpaces n = (replicate n ' ' ++) -- | Print a erroneous line with 'visibleSpaces'. -- diff --git a/test/Golden.hs b/test/Golden.hs index e295e8b..61858b7 100644 --- a/test/Golden.hs +++ b/test/Golden.hs @@ -34,7 +34,7 @@ goldenTests = do goldenValue :: FilePath -> IO ByteString goldenValue file = do - checkFile defaultTabSize file >>= \case + checkFile defaultTabSize {-verbose: -}True file >>= \case CheckIOError e -> ioError e