From 34c1949525e711beaeb6465a54338ec3bd811712 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 28 Oct 2021 23:15:55 +0200
Subject: flipping the output map structure

for now, just with layers. Instead of listing by layer (and giving
lints multiple times), list by lint type (and list all layers in which
this lint was applicable).

This is a bit wonky for now, but readability of output is much better.
---
 lib/CheckMap.hs | 41 ++++++++++++++++++++++++++++-------------
 1 file changed, 28 insertions(+), 13 deletions(-)

(limited to 'lib/CheckMap.hs')

diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index d7d45c0..93c8696 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -8,9 +8,10 @@
 -- | Module that contains the high-level checking functions
 module CheckMap (loadAndLintMap, MapResult(..)) where
 
-import           Data.Aeson       (ToJSON)
+import           Data.Aeson       (ToJSON (toJSON))
 import qualified Data.Aeson       as A
 import           Data.Map         (Map, fromList, toList)
+import qualified Data.Map         as M
 import           Data.Maybe       (mapMaybe)
 import           Data.Text        (Text)
 import qualified Data.Text        as T
@@ -19,23 +20,27 @@ import           GHC.Generics     (Generic)
 
 
 import           Data.Aeson.Types ((.=))
+import           Data.Map.Lazy    (foldlWithKey)
 import           LintWriter       (LintResult (..), LintWriter, askContext,
-                                   filterLintLevel, lintToDep, resultToDeps,
-                                   resultToLints, resultToOffers, runLintWriter)
+                                   filterLintLevel, invertLintResult, lintToDep,
+                                   resultToDeps, resultToLints, resultToOffers,
+                                   runLintWriter)
 import           Properties       (checkLayerProperty, checkMap, checkTileset)
-import           Tiled2           (HasProperties (getProperties),
+import           Tiled2           (HasName (getName),
+                                   HasProperties (getProperties),
                                    Layer (layerName, layerProperties),
                                    LoadResult (..),
                                    Tiledmap (tiledmapLayers, tiledmapTilesets),
                                    Tileset (tilesetName), loadTiledmap)
-import           Types            (Dep, Level (..), Lint (..), hint)
+import           Types            (Dep, Hint (hintLevel, hintMsg), Level (..),
+                                   Lint (..), hint)
 import           Util             (PrettyPrint (prettyprint), prettyprint)
 
 
 
 -- | What this linter produces: lints for a single map
 data MapResult = MapResult
-  { mapresultLayer    :: Map Text (LintResult Layer)
+  { mapresultLayer    :: Map Hint [Layer] --Map Text (LintResult Layer)
   , mapresultTileset  :: Map Text (LintResult Tileset)
   , mapresultGeneral  :: [Lint]
   , mapresultDepends  :: [Dep]
@@ -44,7 +49,7 @@ data MapResult = MapResult
 
 instance ToJSON MapResult where
   toJSON res = A.object
-    [ "layer" .= mapresultLayer res
+    [ "layer" .= CollectedLints (fmap getName <$> mapresultLayer res) --mapresultLayer res
     , "tileset" .= mapresultTileset res
     , "general" .= mapresultGeneral res
     -- TODO: not sure if these are necessary of even useful
@@ -52,6 +57,14 @@ instance ToJSON MapResult where
     , "provides" .= mapresultProvides res
     ]
 
+newtype CollectedLints = CollectedLints (Map Hint [Text])
+
+instance ToJSON CollectedLints where
+  toJSON (CollectedLints col) = toJSON
+    . M.mapKeys hintMsg
+    $ M.mapWithKey (\h cs -> A.object [ "level" .= hintLevel h, "in" .= cs ]) col
+
+
 -- | this module's raison d'être
 -- Lints the map at `path`, and limits local links to at most `depth`
 -- layers upwards in the file hierarchy
@@ -74,17 +87,19 @@ loadAndLintMap path depth = loadTiledmap path >>= pure . \case
 -- | lint a loaded map
 runLinter :: Tiledmap -> Int -> MapResult
 runLinter tiledmap depth = MapResult
-  { mapresultLayer = fromList layer
+  { mapresultLayer = layer'
   , mapresultTileset = fromList tileset
   , mapresultGeneral = generalLints
-  , mapresultDepends = concatMap (resultToDeps . snd) layer
-    <> mapMaybe lintToDep generalLints
+  , mapresultDepends = --concatMap (resultToDeps . snd) layer
+    {-<>-} mapMaybe lintToDep generalLints
     <> concatMap (resultToDeps . snd) tileset
-  , mapresultProvides = concatMap (resultToOffers . snd) layer
+  , mapresultProvides = mempty --concatMap (resultToOffers . snd) layer
   }
   where
+    layer' =  M.unionsWith (<>) $ fmap invertLintResult layer
+
     layer = V.toList . V.map runCheck $ tiledmapLayers tiledmap
-      where runCheck l = (layerName l, runLintWriter l depth checkLayer)
+      where runCheck l = runLintWriter l depth checkLayer
     tileset =  V.toList . V.map runCheck $ tiledmapTilesets tiledmap
       where runCheck l = (tilesetName l, runLintWriter l depth (checkTileset l))
 
@@ -109,7 +124,7 @@ instance PrettyPrint (Level, MapResult) where
       -- TODO: this can be simplified further
       prettyLayer :: [Text]
       prettyLayer = mapMaybe
-        (\(_,l) -> Just $ prettyprint (level, l))
+        (\(_,l) -> Just $ {-prettyprint level <> -}(T.concat $ fmap prettyprint $ fmap getName l))
         (toList . mapresultLayer $ mapResult)
       prettyTileset :: [Text]
       prettyTileset = mapMaybe
-- 
cgit v1.2.3