From 7d8c66b4c3ffd610ef0da98c3f2ff8626f1c8af6 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 2 Dec 2021 02:28:23 +0100
Subject: collect badges from object layers

this includes a halfway-reasonable parsing of object layers, as well as
some monad plumbing to get them all in the right place.
---
 lib/CheckMap.hs | 17 +++++++++++------
 1 file changed, 11 insertions(+), 6 deletions(-)

(limited to 'lib/CheckMap.hs')

diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 8a2ad7e..359452c 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -21,11 +21,12 @@ import qualified Data.Vector      as V
 import           GHC.Generics     (Generic)
 
 
+import           Badges           (Badge)
 import           LintConfig       (LintConfig')
-import           LintWriter       (LintResult (..), filterLintLevel,
-                                   invertLintResult, lintToDep,
-                                   resultToAdjusted, resultToDeps,
-                                   resultToLints, resultToOffers, runLintWriter)
+import           LintWriter       (LintResult (..), invertLintResult, lintToDep,
+                                   resultToAdjusted, resultToBadges,
+                                   resultToDeps, resultToLints, resultToOffers,
+                                   runLintWriter)
 import           Properties       (checkLayer, checkMap, checkTileset)
 import           Tiled2           (HasName (getName),
                                    Layer (layerLayers, layerName),
@@ -33,7 +34,7 @@ import           Tiled2           (HasName (getName),
                                    Tiledmap (tiledmapLayers, tiledmapTilesets),
                                    Tileset, loadTiledmap)
 import           Types            (Dep, Hint (Hint, hintLevel, hintMsg),
-                                   Level (..), Lint (..), hint, lintsToHints)
+                                   Level (..), lintsToHints)
 import           Util             (PrettyPrint (prettyprint), prettyprint)
 
 
@@ -50,6 +51,8 @@ data MapResult = MapResult
   -- ^ entrypoints provided by this map (needed for dependency checking)
   , mapresultAdjusted :: Maybe Tiledmap
   -- ^ the loaded map, with adjustments by the linter
+  , mapresultBadges   :: [Badge]
+  -- ^ badges that can be found on this map
   , mapresultGeneral  :: [Hint]
   -- ^ general-purpose lints that didn't fit anywhere else
   } deriving (Generic)
@@ -77,7 +80,7 @@ instance ToJSON CollectedLints where
 -- layers upwards in the file hierarchy
 loadAndLintMap :: LintConfig' -> FilePath -> Int -> IO (Maybe MapResult)
 loadAndLintMap config path depth = loadTiledmap path <&> (\case
-    DecodeErr err -> Just (MapResult mempty mempty mempty mempty Nothing
+    DecodeErr err -> Just (MapResult mempty mempty mempty mempty Nothing mempty
         [ Hint Fatal . T.pack $
           path <> ": Fatal: " <> err
         ])
@@ -96,6 +99,8 @@ runLinter config tiledmap depth = MapResult
     <> concatMap resultToDeps tileset
   , mapresultProvides = concatMap resultToOffers layer
   , mapresultAdjusted = Just adjustedMap
+  , mapresultBadges = concatMap resultToBadges layer
+    <> resultToBadges generalResult
   }
   where
     layer = checkLayerRec config depth (V.toList $ tiledmapLayers tiledmap)
-- 
cgit v1.2.3