deal with group layers

I have no idea why these even exist, but apparently they do, so here's
some code to deal with them in a hopefully useful manner …

2 files changed, 37 insertions, 9 deletions

diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 962da22..5b486aa 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -22,11 +22,14 @@ import           GHC.Generics     (Generic)
 
 
 import           LintConfig       (LintConfig')
-import           LintWriter       (filterLintLevel, invertLintResult, lintToDep,
+import           LintWriter       (LintResult (..), filterLintLevel,
+                                   invertLintResult, lintToDep,
                                    resultToAdjusted, resultToDeps,
                                    resultToLints, resultToOffers, runLintWriter)
 import           Properties       (checkLayer, checkMap, checkTileset)
-import           Tiled2           (HasName (getName), Layer, LoadResult (..),
+import           Tiled2           (HasName (getName),
+                                   Layer (layerLayers, layerName),
+                                   LoadResult (..),
                                    Tiledmap (tiledmapLayers, tiledmapTilesets),
                                    Tileset, loadTiledmap)
 import           Types            (Dep, Hint (hintLevel, hintMsg), Level (..),
@@ -95,23 +98,53 @@ runLinter config tiledmap depth = MapResult
   , mapresultAdjusted = Just adjustedMap
   }
   where
-    layer = checkThing tiledmapLayers checkLayer
+    layer = checkLayerRec config depth (V.toList $ tiledmapLayers tiledmap)
     tileset = checkThing tiledmapTilesets checkTileset
     generalResult = runLintWriter config tiledmap depth checkMap
 
     checkThing getter checker = V.toList . V.map runCheck $ getter tiledmap
       where runCheck thing = runLintWriter config thing depth checker
 
+
     -- | "inverts" a LintResult, i.e. groups it by lints instead of
     --    layers / maps
     invertThing thing = M.unionsWith (<>) $ fmap invertLintResult thing
 
 
     adjustedMap = (resultToAdjusted generalResult)
-      { tiledmapLayers = V.fromList . fmap resultToAdjusted $ layer
+      { tiledmapLayers = V.fromList $ fmap resultToAdjusted layer
       , tiledmapTilesets = V.fromList . fmap resultToAdjusted $ tileset
       }
 
+-- | Recursively checks a layer.
+--
+-- This is apparently necessary because someone thought it would be a good
+-- idea to have group layers, even if their entire semantics appear to be
+-- "they're group layers"; they don't seem to /do/ anything …
+checkLayerRec :: LintConfig' -> Int -> [Layer] -> [LintResult Layer]
+checkLayerRec config depth = concatMap $ \parent ->
+  case layerLayers parent of
+    Nothing ->
+      [runLintWriter config parent depth checkLayer]
+    Just sublayers ->
+      let
+        -- before linting, append the group's top-level name to that of sublayers
+        results = checkLayerRec config depth $ sublayers
+                    <&> \l -> l { layerName = layerName parent <> "/" <> layerName l }
+        -- get the original sublayer names
+        names = fmap layerName sublayers
+        -- pass the adjusted sublayers on to linting the parent layer,
+        -- but restore the actual names of sublayers
+        result = runLintWriter config
+            (parent { layerLayers = Just
+                     $ zipWith (\n l -> (resultToAdjusted l) { layerName = n })
+                     names results
+                   }
+            ) depth checkLayer
+      in result:results
+
+
+
 -- human-readable lint output, e.g. for consoles
 instance PrettyPrint (Level, MapResult) where
   prettyprint (level, mapResult) = if complete == ""
diff --git a/lib/Properties.hs b/lib/Properties.hs
index 2928152..9f995b0 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -121,11 +121,6 @@ checkLayer = do
     ty -> unless (layerName layer == "floorLayer" && ty == "objectgroup")
           $ complain "only tilelayer are supported."
 
-  case layerLayers layer of
-    Nothing -> pure ()
-    Just _  -> complain "walint doesn't support grouplayers for now"
-
-
 
 -- | Checks a single (custom) property of a layer
 --