From 08865726c8e9e290b2ae6ebe124a98300b122ac4 Mon Sep 17 00:00:00 2001
From: Don Stewart <don.stewart@tngtech.com>
Date: Tue, 1 Mar 2022 05:31:44 +0000
Subject: [PATCH] Flatten duplicate warnings about experimental features

For some projects (e.g. glean) that make wide use of colon specifiers or
visibility, we get hundreds (thousands) of duplicating warnings about
these language features, spamming our builds.

Flatten this warning into a single instance per parse, and a count of
others.

Example:
```
Warning: glean.cabal:1674:15: colon specifier is experimental feature (issue
Warning: glean.cabal:1625:24: visibility is experimental feature (issue #5660)
(and 32 more occurrences)
```

Test plan:
- try on glean.cabal from https://github.com/facebookincubator/Glean and
  see it working as above
- cabal test all
---
 .../Distribution/Simple/PackageDescription.hs | 38 ++++++++++++++++---
 1 file changed, 32 insertions(+), 6 deletions(-)

diff --git a/Cabal/src/Distribution/Simple/PackageDescription.hs b/Cabal/src/Distribution/Simple/PackageDescription.hs
index 4c64aedf767..faa86fb7ba5 100644
--- a/Cabal/src/Distribution/Simple/PackageDescription.hs
+++ b/Cabal/src/Distribution/Simple/PackageDescription.hs
@@ -24,12 +24,15 @@ import Distribution.Compat.Prelude
 import Distribution.Fields.ParseResult
 import Distribution.PackageDescription
 import Distribution.PackageDescription.Parsec
-import Distribution.Parsec.Error    (showPError)
-import Distribution.Parsec.Warning  (showPWarning)
-import Distribution.Simple.Utils
-import Distribution.Verbosity
+import Distribution.Parsec.Error ( showPError )
+import Distribution.Parsec.Warning
+    ( PWarning(..), PWarnType(PWTExperimental), showPWarning )
+import Distribution.Simple.Utils ( equating, die', warn )
+import Distribution.Verbosity ( Verbosity )
 
-import qualified Data.ByteString    as BS
+import Data.List ( groupBy )
+import Text.Printf ( printf )
+import qualified Data.ByteString as BS
 import System.Directory (doesFileExist)
 
 readGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription
@@ -65,10 +68,33 @@ parseString
     -> IO a
 parseString parser verbosity name bs = do
     let (warnings, result) = runParseResult (parser bs)
-    traverse_ (warn verbosity . showPWarning name) warnings
+    traverse_ (warn verbosity . showPWarning name) (flattenDups warnings)
     case result of
         Right x -> return x
         Left (_, errors) -> do
             traverse_ (warn verbosity . showPError name) errors
             die' verbosity $ "Failed parsing \"" ++ name ++ "\"."
 
+-- Collapse duplicate experimental feature warnings into single warning, with
+-- a count of further sites
+flattenDups :: [PWarning] -> [PWarning]
+flattenDups ws = rest ++ experimentals
+    where
+        (exps, rest) = partition (\(PWarning w _ _) -> w == PWTExperimental) ws
+        experimentals =
+             concatMap flatCount
+           . groupBy (equating warningStr)
+           . sortBy (comparing warningStr)
+           $ exps
+
+        warningStr (PWarning _ _ w) = w
+
+        -- flatten if we have 3 or more examples
+        flatCount :: [PWarning] -> [PWarning]
+        flatCount w@[] = w
+        flatCount w@[_] = w
+        flatCount w@[_,_] = w
+        flatCount (PWarning t pos w:xs) =
+            [PWarning t pos
+                (w <> printf " (and %d more occurrences)" (length xs))
+            ]
\ No newline at end of file