From 4e72dde40c7c7c80dce859257bf7095c859681cf 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)
```

With -v1 (or below), flattening occurs. At -v2 or above, all instances are shown.

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 | 41 ++++++++++++++++---
 1 file changed, 35 insertions(+), 6 deletions(-)

diff --git a/Cabal/src/Distribution/Simple/PackageDescription.hs b/Cabal/src/Distribution/Simple/PackageDescription.hs
index 4c64aedf767..bb7e54550c3 100644
--- a/Cabal/src/Distribution/Simple/PackageDescription.hs
+++ b/Cabal/src/Distribution/Simple/PackageDescription.hs
@@ -24,12 +24,16 @@ 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
+    ( parseGenericPackageDescription, parseHookedBuildInfo )
+import Distribution.Parsec.Error ( showPError )
+import Distribution.Parsec.Warning
+    ( PWarning(..), PWarnType(PWTExperimental), showPWarning )
+import Distribution.Simple.Utils ( equating, die', warn )
+import Distribution.Verbosity ( normal, 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 +69,35 @@ 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 verbosity 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 :: Verbosity -> [PWarning] -> [PWarning]
+flattenDups verbosity ws
+    | verbosity <= normal = rest ++ experimentals
+    | otherwise = ws -- show all instances
+    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