summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorstuebinm2021-12-29 04:49:46 +0100
committerstuebinm2021-12-29 04:56:19 +0100
commit0419aa9918723c8b74252bf6ff1a2162c2f3a89a (patch)
tree6c793ecd95e1653024f4cb73675ab2a400c7221c /lib
parent436a7dbb734f58a254bed6c9d28908033b537bf8 (diff)
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)
Diffstat (limited to 'lib')
-rw-r--r--lib/CheckDir.hs20
-rw-r--r--lib/CheckMap.hs18
-rw-r--r--lib/Properties.hs12
-rw-r--r--lib/TiledAbstract.hs8
-rw-r--r--lib/Uris.hs6
-rw-r--r--lib/Util.hs7
6 files changed, 50 insertions, 21 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
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index fead0b9..885ee70 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -21,20 +21,21 @@ import GHC.Generics (Generic)
import Badges (Badge)
-import LintConfig (LintConfig', LintConfig (configAssemblyTag))
+import LintConfig (LintConfig (configAssemblyTag), LintConfig')
import LintWriter (LintResult, invertLintResult,
resultToAdjusted, resultToBadges,
resultToDeps, resultToLints, resultToOffers,
runLintWriter)
import Properties (checkLayer, checkMap, checkTileset)
+import System.FilePath (takeFileName)
import Tiled (Layer (layerLayers, layerName),
LoadResult (..),
Tiledmap (tiledmapLayers, tiledmapTilesets),
loadTiledmap)
-import Types (Dep (MapLink), Hint (Hint, hintLevel, hintMsg),
- Level (..), lintsToHints)
+import Types (Dep (MapLink),
+ Hint (Hint, hintLevel, hintMsg), Level (..),
+ lintsToHints)
import Util (PrettyPrint (prettyprint), prettyprint)
-import System.FilePath (takeFileName)
@@ -56,6 +57,15 @@ data MapResult = MapResult
-- ^ general-purpose lints that didn't fit anywhere else
} deriving (Generic)
+
+instance Eq MapResult where
+ a == b =
+ mapresultLayer a == mapresultLayer b &&
+ mapresultTileset a == mapresultTileset b &&
+ -- mapresultBadges a == mapresultBadges b &&
+ mapresultGeneral a == mapresultGeneral b
+
+
instance ToJSON MapResult where
toJSON res = A.object
[ "layer" .= CollectedLints (mapresultLayer res)
diff --git a/lib/Properties.hs b/lib/Properties.hs
index 605f970..e594751 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -12,17 +12,17 @@ module Properties (checkMap, checkTileset, checkLayer) where
import Control.Monad (forM, forM_, unless, when)
-import Data.Text (Text, intercalate, isPrefixOf, isInfixOf)
+import Data.Text (Text, intercalate, isInfixOf, isPrefixOf)
import qualified Data.Text as T
import qualified Data.Vector as V
import Tiled (Layer (..), Object (..), Property (..),
PropertyValue (..), Tile (..),
Tiledmap (..), Tileset (..))
-import TiledAbstract (HasName (..), HasProperties (..),
- HasTypeName (..), IsProperty (..),
- HasData (..), layerIsEmpty)
-import Util (mkProxy, naiveEscapeHTML,
- prettyprint, showText)
+import TiledAbstract (HasData (..), HasName (..),
+ HasProperties (..), HasTypeName (..),
+ IsProperty (..), layerIsEmpty)
+import Util (mkProxy, naiveEscapeHTML, prettyprint,
+ showText)
import Badges (Badge (Badge),
BadgeArea (BadgePoint, BadgeRect),
diff --git a/lib/TiledAbstract.hs b/lib/TiledAbstract.hs
index 0ccf26b..5589207 100644
--- a/lib/TiledAbstract.hs
+++ b/lib/TiledAbstract.hs
@@ -5,12 +5,12 @@ module TiledAbstract where
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy)
import Data.Text (Text)
+import Data.Vector (Vector)
import qualified Data.Vector as V
-import Tiled (Layer (..), Object (..), Property (..),
+import Tiled (GlobalId, Layer (..), Object (..), Property (..),
PropertyValue (..), Tile (..), Tiledmap (..),
- Tileset (..), mkTiledId, GlobalId)
-import Data.Vector (Vector)
-import Util (showText)
+ Tileset (..), mkTiledId)
+import Util (showText)
class HasProperties a where
getProperties :: a -> [Property]
diff --git a/lib/Uris.hs b/lib/Uris.hs
index 5c2ad05..6436ac6 100644
--- a/lib/Uris.hs
+++ b/lib/Uris.hs
@@ -22,9 +22,9 @@ import Data.Text (Text, pack)
import qualified Data.Text as T
import GHC.Generics (Generic)
import GHC.TypeLits (KnownSymbol, symbolVal)
+import Network.URI.Encode as URI
import Text.Regex.TDFA ((=~))
-import Witherable (mapMaybe)
-import Network.URI.Encode as URI
+import Witherable (mapMaybe)
data Substitution =
Prefixed { prefix :: Text, blocked :: [Text], allowed :: [Text], scope :: [String] }
@@ -82,7 +82,7 @@ applySubsts s substs uri = do
[] -> Left (SchemaDoesNotExist schema)
results@(_:_) -> case mapMaybe rightToMaybe results of
suc:_ -> Right suc
- _ -> minimum results
+ _ -> minimum results
where
note = maybeToRight
diff --git a/lib/Util.hs b/lib/Util.hs
index d760fc2..3fe0a16 100644
--- a/lib/Util.hs
+++ b/lib/Util.hs
@@ -66,7 +66,12 @@ printPretty :: PrettyPrint a => a -> IO ()
printPretty = putStr . T.unpack . prettyprint
-
+-- | for long lists which shouldn't be printed out in their entirety
+ellipsis :: Int -> [Text] -> Text
+ellipsis i texts
+ | i < l = prettyprint (take i texts) <> " ... (and " <> showText (l-i) <> " more)"
+ | otherwise = prettyprint texts
+ where l = length texts