diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/CheckMap.hs | 41 | ||||
| -rw-r--r-- | lib/Properties.hs | 5 |
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 -- |