From 12025514261f524d7a4ded461709a7d151cc1b36 Mon Sep 17 00:00:00 2001
From: stuebinm <stuebinm@disroot.org>
Date: Fri, 19 Nov 2021 00:52:17 +0100
Subject: [PATCH] fix group layer handling
we don't want to accidentally copy maps, whoopsie
---
lib/CheckMap.hs | 31 ++++++++++++++++++++++---------
1 file changed, 22 insertions(+), 9 deletions(-)
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 5b486aa..5d50f3f 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -105,15 +105,17 @@ runLinter config tiledmap depth = MapResult
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
- , tiledmapTilesets = V.fromList . fmap resultToAdjusted $ tileset
+ { tiledmapLayers = V.fromList
+ . fmap resultToAdjusted
+ $ take (length (tiledmapLayers tiledmap)) layer
+ , tiledmapTilesets = V.fromList
+ . fmap resultToAdjusted
+ $ tileset
}
-- | Recursively checks a layer.
@@ -121,16 +123,27 @@ runLinter config tiledmap depth = MapResult
-- 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 …
+--
+-- Note that this will flatten the layer structure and give them all back
+-- in a single list, but the ones that were passed in will always be at
+-- the head of the list.
checkLayerRec :: LintConfig' -> Int -> [Layer] -> [LintResult Layer]
-checkLayerRec config depth = concatMap $ \parent ->
+checkLayerRec config depth layers =
+ -- reordering to get the correct ones back up front
+ (\rs -> fmap fst rs <> concatMap snd rs)
+ -- map over all input layers
+ $ flip fmap layers $ \parent ->
case layerLayers parent of
+ -- not a group layer; just lint this one
Nothing ->
- [runLintWriter config parent depth checkLayer]
+ (runLintWriter config parent depth checkLayer,[])
+ -- this is a group layer. Fun!
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 }
+ results = take (length sublayers)
+ $ 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,
@@ -141,7 +154,7 @@ checkLayerRec config depth = concatMap $ \parent ->
names results
}
) depth checkLayer
- in result:results
+ in (result,results)
--
GitLab