summaryrefslogtreecommitdiff
path: root/lib/CheckDir.hs
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/CheckDir.hs20
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