Add --consecutive option

Resolves #68

Add an option to check for maximum count of consecutive empty lines.
If zero, unlimited cmount is allowed. If 1, there cannot be empty lines,
if 2 there can be one empty line, and so on.

I fail with naming, having value 1 to disallow any empty lines makes
sense, but it's not "maximum amount of empty lines",
it's more of "fail if there is that much empty lines".

Author: phadej

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, Verbose, defaultTabSize )
+                                              , TabSize, ConsecutiveEmptyLines, Verbose, defaultTabSize, defaultConsecutiveEmptyLines )
 
 import           ParseConfig                  ( Config(Config), parseConfig )
 import qualified Paths_fix_whitespace         as PFW ( version )
@@ -49,6 +49,7 @@ data Options = Options
   -- ^ The location to the configuration file.
   , optTabSize :: String
   -- ^ The number of spaces to expand a tab character to.  @"0"@ for keeping tabs.
+  , optConsEL  :: String
   }
 
 defaultOptions :: Options
@@ -59,6 +60,7 @@ defaultOptions = Options
   , optMode    = Fix
   , optConfig  = defaultConfigFile
   , optTabSize = show defaultTabSize
+  , optConsEL  = show defaultConsecutiveEmptyLines
   }
 
 options :: [OptDescr (Options -> Options)]
@@ -81,6 +83,12 @@ options =
         [ "Expand tab characters to TABSIZE (default: " ++ show defaultTabSize ++ ") many spaces."
         , "Keep tabs if 0 is given as TABSIZE."
         ])
+  , Option ['n']     ["consecutive"]
+      (ReqArg (\ns opts -> opts { optConsEL = ns }) "LINES")
+      (unlines
+        [ "Maximum consecutive empty lines (default: " ++ show defaultConsecutiveEmptyLines ++ ")."
+        , "Unlimited if 0 is given as LINES."
+        ])
   , Option []        ["config"]
       (ReqArg (\loc opts -> opts { optConfig = loc }) "CONFIG")
       (concat ["Override the project configuration ", defaultConfigFile, "."])
@@ -105,7 +113,7 @@ shortUsageHeader :: String -> String
 shortUsageHeader progName = unwords
   [ "Usage:"
   , progName
-  , "[-h|--help] [-v|--verbose] [--check] [--config CONFIG] [-t|--tab TABSIZE] [FILES]"
+  , "[-h|--help] [-v|--verbose] [--check] [--config CONFIG] [-t|--tab TABSIZE] [-n|--consecutive LINES] [FILES]"
   ]
 
 usageHeader :: String -> String
@@ -159,6 +167,9 @@ main = do
   tabSize <- maybe (die "Error: Illegal TABSIZE, must be an integer.") return $
     readMaybe $ optTabSize opts
 
+  consecutiveLines <- maybe (die "Error: Illegal LINES, must be an integer.") return $
+    readMaybe $ optConsEL opts
+
   base <- getCurrentDirectory
 
   files <- if not $ null nonOpts
@@ -198,13 +209,13 @@ main = do
       files1 <- getDirectoryFilesIgnore base incPatterns excPatterns
       return (nubOrd (files0 ++ files1))
 
-  changes <- mapM (fix mode verbose tabSize) files
+  changes <- mapM (fix mode verbose tabSize consecutiveLines) files
 
   when (or changes && mode == Check) exitFailure
 
-fix :: Mode -> Verbose -> TabSize -> FilePath -> IO Bool
-fix mode verbose tabSize f =
-  checkFile tabSize verbose f >>= \case
+fix :: Mode -> Verbose -> TabSize -> ConsecutiveEmptyLines -> FilePath -> IO Bool
+fix mode verbose tabSize consecutiveLines f =
+  checkFile tabSize consecutiveLines verbose f >>= \case
 
     CheckOK -> do
       when verbose $

src/Data/Text/FixWhitespace.hs

@@ -9,8 +9,10 @@ module Data.Text.FixWhitespace
   , transform
   , transformWithLog
   , TabSize
+  , ConsecutiveEmptyLines
   , Verbose
   , defaultTabSize
+  , defaultConsecutiveEmptyLines
   )
   where
 
@@ -29,12 +31,17 @@ import           Data.List.Extra.Drop              ( dropWhileEnd1, dropWhile1 )
 
 type Verbose = Bool
 type TabSize = Int
+type ConsecutiveEmptyLines = Int
 
 -- | Default tab size.
 --
 defaultTabSize :: TabSize
 defaultTabSize = 8
 
+-- | Maximum consecutive empty lines
+defaultConsecutiveEmptyLines :: ConsecutiveEmptyLines
+defaultConsecutiveEmptyLines = 0
+
 -- | Result of checking a file against the whitespace policy.
 --
 data CheckResult
@@ -54,30 +61,44 @@ data LineError = LineError Int Text
 -- | Check a file against the whitespace policy,
 --   returning a fix if violations occurred.
 --
-checkFile :: TabSize -> Verbose -> FilePath -> IO CheckResult
-checkFile tabSize verbose f =
+checkFile :: TabSize -> ConsecutiveEmptyLines -> Verbose -> FilePath -> IO CheckResult
+checkFile tabSize consecutiveLines verbose f =
   handle (\ (e :: IOException) -> return $ CheckIOError e) $
     withFile f ReadMode $ \ h -> do
       hSetEncoding h utf8
       s <- Text.hGetContents h
       let (s', lvs)
-            | verbose   = transformWithLog tabSize s
-            | otherwise = (transform tabSize s, [])
+            | verbose   = transformWithLog tabSize consecutiveLines s
+            | otherwise = (transform tabSize consecutiveLines s, [])
       return $ if s' == s then CheckOK else CheckViolation s' lvs
 
 transform
   :: TabSize   -- ^ Expand tab characters to so many spaces.  Keep tabs if @<= 0@.
+  -> ConsecutiveEmptyLines -- ^ Maximum count of consecutive empty lines. Unlimited if @<= 0@.
   -> Text      -- ^ Text before transformation.
   -> Text      -- ^ Text after transformation.
-transform tabSize =
+transform tabSize consecutiveLines =
   Text.unlines .
+  squashConsecutiveEmptyLines 0 .
   removeFinalEmptyLinesExceptOne .
   map (removeTrailingWhitespace .  convertTabs tabSize) .
   Text.lines
   where
   removeFinalEmptyLinesExceptOne =
     reverse . dropWhile1 Text.null . reverse
 
+  squashConsecutiveEmptyLines :: Int -> [Text] -> [Text]
+  squashConsecutiveEmptyLines _ [] = []
+  squashConsecutiveEmptyLines n (l:ls)
+    | Text.null l
+    = if n >= consecutiveLines
+      then squashConsecutiveEmptyLines n ls
+      else
+        l : squashConsecutiveEmptyLines (n + 1) ls
+
+    | otherwise
+    = l : squashConsecutiveEmptyLines 0 ls
+
 -- | The transformation monad: maintains info about lines that
 --   violate the rules. Used in the verbose mode to build a log.
 --
@@ -87,9 +108,10 @@ type TransformM = Writer [LineError]
 --
 transformWithLog
   :: TabSize             -- ^ Expand tab characters to so many spaces.  Keep tabs if @<= 0@.
+  -> ConsecutiveEmptyLines -- ^ Maximum count of consecutive empty lines. Unlimited if @<= 0@.
   -> Text                -- ^ Text before transformation.
   -> (Text, [LineError]) -- ^ Text after transformation and violating lines if any.
-transformWithLog tabSize =
+transformWithLog tabSize consecutiveLines =
   runWriter .
   fmap Text.unlines .
   fixAllViolations .
@@ -98,6 +120,8 @@ transformWithLog tabSize =
   where
   fixAllViolations :: [(Int,Text)] -> TransformM [Text]
   fixAllViolations =
+    (if consecutiveLines > 0 then squashConsecutiveEmptyLines 1 0 else return)
+    <=<
     removeFinalEmptyLinesExceptOne
     <=<
     mapM (fixLineWith $ removeTrailingWhitespace . convertTabs tabSize)
@@ -114,6 +138,25 @@ transformWithLog tabSize =
     lenLs' = length ls'
     els    = replicate (lenLs - lenLs') ""
 
+  squashConsecutiveEmptyLines :: Int -> Int -> [Text] -> TransformM [Text]
+  squashConsecutiveEmptyLines _ _ [] = return []
+  squashConsecutiveEmptyLines i n (l:ls)
+    | Text.null l
+    = if n >= consecutiveLines
+      then do
+        tell [LineError i l]
+        squashConsecutiveEmptyLinesAfterError (i + 1) ls
+      else
+        (l:) <$> squashConsecutiveEmptyLines (i + 1) (n + 1) ls
+
+    | otherwise
+    = (l:) <$> squashConsecutiveEmptyLines (i + 1) 0 ls
+
+  squashConsecutiveEmptyLinesAfterError _ [] = return []
+  squashConsecutiveEmptyLinesAfterError i (l:ls)
+    | Text.null l = squashConsecutiveEmptyLinesAfterError (i + 1) ls
+    | otherwise   = squashConsecutiveEmptyLines i 0 (l:ls)
+
   fixLineWith :: (Text -> Text) -> (Int, Text) -> TransformM Text
   fixLineWith fixer (i, l)
     | l == l'   = pure l

test/Golden.hs

@@ -34,7 +34,7 @@ goldenTests = do
 
 goldenValue :: FilePath -> IO ByteString
 goldenValue file = do
-  checkFile defaultTabSize {-verbose: -}True file >>= \case
+  checkFile defaultTabSize 1 {-verbose: -} True file >>= \case
 
     CheckIOError e ->
       ioError e

test/violations.golden

@@ -1,3 +1,4 @@
 Violations:
 test/violations.txt:1: Trailing·space·
 test/violations.txt:3: Trailing·tab····
+test/violations.txt:5: <NEWLINE>

test/violations.txt

@@ -2,4 +2,6 @@ Trailing space
 
 Trailing tab    
 
+
+
 Missing newline at end of file