maps, maps, and yet more maps

don't add maps to the result if their lint result looks the same as that
of another list, just say it happened several times instead (this leads
to a rather confusing Eq instance for MapResult which implements a very
simple surface-level equality — perhaps change that later)

1 files changed, 17 insertions, 3 deletions

diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs
index 59c6f2f..cb4f886 100644
--- a/lib/CheckDir.hs
+++ b/lib/CheckDir.hs
@@ -14,8 +14,10 @@ import           Control.Monad          (void)
 import           Control.Monad.Extra    (mapMaybeM)
 import           Data.Aeson             (ToJSON, (.=))
 import qualified Data.Aeson             as A
+import           Data.Bifunctor         (first)
 import           Data.Foldable          (fold)
 import           Data.Functor           ((<&>))
+import           Data.List              (partition)
 import           Data.Map               (Map, elems, keys)
 import qualified Data.Map               as M
 import           Data.Map.Strict        (mapKeys, mapWithKey, (\\))
@@ -34,7 +36,7 @@ import           System.FilePath.Posix  (takeDirectory)
 import           Text.Dot               (Dot, showDot)
 import           Types                  (Dep (Local, LocalMap), Hint (Hint),
                                          Level (..), hintLevel)
-import           Util                   (PrettyPrint (prettyprint))
+import           Util                   (PrettyPrint (prettyprint), ellipsis)
 
 
 -- based on the startling observation that Data.Map has lower complexity
@@ -97,13 +99,25 @@ instance ToJSON DirResult where
     "result" .=  A.object
       [ "missingDeps" .= dirresultDeps res
       , "missingAssets" .= dirresultMissingAssets res
-      , "mapLints" .= dirresultMaps res
-      , "exitGraph" .= showDot (dirresultGraph res)
+      -- some repos have auto-generated maps which are basically all the
+      -- same; aggregate those to reduce output size
+      , "mapLints" .= (M.fromList
+                       . fmap (first (ellipsis 6))
+                       . foldr aggregateSameResults []
+                       . M.toList
+                       $ dirresultMaps res)
+      -- unused in the hub, temporarily removed to make the output smaller
+      -- , "exitGraph" .= showDot (dirresultGraph res)
       ]
     , "severity" .= maximumLintLevel res
     , "mapInfo" .= fmap (\tm -> A.object [ "badges" .= mapresultBadges tm ])
                         (dirresultMaps res)
     ]
+    where
+      aggregateSameResults (path,res) acc =
+        case partition (\(_,res') -> res == res') acc of
+          ([],_)             -> ([T.pack path], res):acc
+          ((paths,_):_,acc') -> (T.pack path:paths, res) : acc'
 
 instance ToJSON MissingAsset where
   toJSON (MissingAsset md) = A.object