rudimentary linting for overlapping layers

1 files changed, 17 insertions, 0 deletions

diff --git a/lib/Properties.hs b/lib/Properties.hs
index 2747998..5845a1b 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -25,8 +25,10 @@ import           Badges        (Badge (Badge),
                                 parseToken)
 import           Data.Data     (Proxy (Proxy))
 import           Data.Maybe    (fromMaybe, isJust)
+import           Data.Set      (Set)
 import qualified Data.Set      as S
 import           GHC.TypeLits  (KnownSymbol)
+import           LayerData     (Collision, layerOverlaps)
 import           LintConfig    (LintConfig (..))
 import           LintWriter    (LintWriter, adjust, askContext, askFileDepth,
                                 complain, dependsOn, forbid, lintConfig,
@@ -71,6 +73,11 @@ checkMap = do
   unlessHasProperty "mapCopyright"
     $ complain "must give the map's copyright via the \"mapCopyright\" property."
 
+  -- TODO: this doesn't catch collisions with the default start layer!
+  whenLayerCollisions (\(Property name _) -> name == "exitUrl" || name == "startLayer")
+    $ \cols -> warn $ "collisions between entry and / or exit layers: " <> prettyprint cols
+
+
 -- | Checks a single property of a map.
 --
 -- Doesn't really do all that much, but could in theory be expanded into a
@@ -378,6 +385,16 @@ containsProperty :: Foldable t => t Property -> Text -> Bool
 containsProperty props name = any
   (\(Property name' _) -> name' == name) props
 
+-- | should the layers fulfilling the given predicate collide, then perform andthen.
+whenLayerCollisions
+  :: (Property -> Bool)
+  -> (Set Collision -> LintWriter Tiledmap)
+  -> LintWriter Tiledmap
+whenLayerCollisions f andthen = do
+  tiledmap <- askContext
+  let collisions = layerOverlaps . V.filter (any f . getProperties) $ tiledmapLayers tiledmap
+  unless (null collisions)
+    $ andthen collisions
 
 ----- Functions with concrete lint messages -----