From a74cc87b085fa15213f8901f091db2631fee10db Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sun, 17 Oct 2021 21:27:50 +0200
Subject: add tileset property linting

this reorganised the whole linting for tilesets somewhat; it's now very
similar to that linting layers, and it may be possible to abstract some
of the code away ...
---
 lib/CheckMap.hs | 25 ++++++++++++++++++-------
 1 file changed, 18 insertions(+), 7 deletions(-)

(limited to 'lib/CheckMap.hs')

diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 8b4dca8..036f4e8 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -22,10 +22,11 @@ import           Data.Aeson.Types ((.=))
 import           LintWriter       (LintResult (..), LintWriter, askContext,
                                    filterLintLevel, lintToDep, resultToDeps,
                                    resultToLints, resultToOffers, runLintWriter)
-import           Properties       (checkLayerProperty, checkMap)
+import           Properties       (checkLayerProperty, checkMap, checkTileset)
 import           Tiled2           (Layer (layerName, layerProperties),
-                                   LoadResult (..), Tiledmap (tiledmapLayers),
-                                   loadTiledmap)
+                                   LoadResult (..),
+                                   Tiledmap (tiledmapLayers, tiledmapTilesets),
+                                   Tileset (tilesetName), loadTiledmap)
 import           Types            (Dep, Level (..), Lint (..), hint)
 import           Util             (PrettyPrint (prettyprint), prettyprint)
 
@@ -34,6 +35,7 @@ import           Util             (PrettyPrint (prettyprint), prettyprint)
 -- | What this linter produces: lints for a single map
 data MapResult = MapResult
   { mapresultLayer    :: Map Text (LintResult Layer)
+  , mapresultTileset  :: Map Text (LintResult Tileset)
   , mapresultGeneral  :: [Lint]
   , mapresultDepends  :: [Dep]
   , mapresultProvides :: [Text]
@@ -42,6 +44,7 @@ data MapResult = MapResult
 instance ToJSON MapResult where
   toJSON res = A.object
     [ "layer" .= mapresultLayer res
+    , "tileset" .= mapresultTileset res
     , "general" .= mapresultGeneral res
     -- TODO: not sure if these are necessary of even useful
     , "depends" .= mapresultDepends res
@@ -55,6 +58,7 @@ loadAndLintMap :: FilePath -> Int -> IO (Maybe MapResult)
 loadAndLintMap path depth = loadTiledmap path >>= pure . \case
     DecodeErr err -> Just $ MapResult
       { mapresultLayer = mempty
+      , mapresultTileset = mempty
       , mapresultDepends = []
       , mapresultProvides = []
       , mapresultGeneral =
@@ -69,17 +73,19 @@ loadAndLintMap path depth = loadTiledmap path >>= pure . \case
 -- | lint a loaded map
 runLinter :: Tiledmap -> Int -> MapResult
 runLinter tiledmap depth = MapResult
-  { mapresultLayer = layerMap
-  , mapresultGeneral = generalLints  -- no general lints for now
+  { mapresultLayer = fromList layer
+  , mapresultTileset = fromList tileset
+  , mapresultGeneral = generalLints
   , mapresultDepends = concatMap (resultToDeps . snd) layer
     <> mapMaybe lintToDep generalLints
+    <> concatMap (resultToDeps . snd) tileset
   , mapresultProvides = concatMap (resultToOffers . snd) layer
   }
   where
-    layerMap :: Map Text (LintResult Layer)
-    layerMap = fromList layer
     layer = V.toList . V.map runCheck $ tiledmapLayers tiledmap
       where runCheck l = (layerName l, runLintWriter l depth checkLayer)
+    tileset =  V.toList . V.map runCheck $ tiledmapTilesets tiledmap
+      where runCheck l = (tilesetName l, runLintWriter l depth (checkTileset l))
 
     -- lints collected from properties
     generalLints =
@@ -98,11 +104,16 @@ instance PrettyPrint (Level, MapResult) where
     then "  all good!\n" else prettyLints
     where
       prettyLints = T.concat $ prettyGeneral <> prettyLayer
+        <> prettyTileset
       -- TODO: this can be simplified further
       prettyLayer :: [Text]
       prettyLayer = mapMaybe
         (\(_,l) -> Just $ prettyprint (level, l))
         (toList . mapresultLayer $ mapResult)
+      prettyTileset :: [Text]
+      prettyTileset = mapMaybe
+        (\(_,t) -> Just $ prettyprint (level, t))
+        (toList . mapresultTileset $ mapResult)
       prettyGeneral :: [Text]
       prettyGeneral = map
         ((<> "\n") . prettyprint)
-- 
cgit v1.2.3