From 9e5ecf2bd3be27be6e8d1dd9f0bf8d80cf1eaa30 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 16 Dec 2021 15:10:30 +0100
Subject: fixed & removed a bunch of old TODOs

---
 lib/Properties.hs | 45 ++++++++++++++++++++++++++++++---------------
 1 file changed, 30 insertions(+), 15 deletions(-)

(limited to 'lib/Properties.hs')

diff --git a/lib/Properties.hs b/lib/Properties.hs
index 9c61aed..6a8c166 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -130,7 +130,6 @@ checkMapProperty p@(Property name _) = case name of
 checkTileset ::  LintWriter Tileset
 checkTileset = do
   tileset <- askContext
-  -- TODO: can tilesets be non-local dependencies?
   unwrapPath (tilesetImage tileset) (dependsOn . Local)
 
   refuseDoubledNames (getProperties tileset)
@@ -154,8 +153,16 @@ checkTileset = do
   -- check individual tileset properties
   mapM_ checkTilesetProperty (fromMaybe mempty $ tilesetProperties tileset)
 
-  -- check individual tile definitions
-  mapM_ checkTile (fromMaybe mempty $ tilesetTiles tileset)
+  case tilesetTiles tileset of
+    Nothing -> pure ()
+    Just tiles -> do
+      -- can't set properties on the same tile twice
+      refuseDoubledThings tileId
+        (\tile -> complain $ "cannot set properties on the \
+                  \tile with the id" <> showText (tileId tile) <> "twice.")
+        tiles
+
+      mapM_ checkTile tiles
   where
     checkTilesetProperty :: Property -> LintWriter Tileset
     checkTilesetProperty p@(Property name _value) = case name of
@@ -164,8 +171,8 @@ checkTileset = do
 
     checkTile :: Tile -> LintWriter Tileset
     checkTile tile = do
-      -- TODO:  refused doubled IDs?
-      mapM_ checkTileProperty (fromMaybe mempty $ tileProperties tile)
+      refuseDoubledNames (getProperties tile)
+      mapM_ checkTileProperty (getProperties tile)
       where checkTileProperty :: Property -> LintWriter Tileset
             checkTileProperty p@(Property name _) = case name of
               "collides" -> isBool p
@@ -401,22 +408,30 @@ refuseDoubledNames
   => (Foldable t, Functor t)
   => t a
   -> LintWriter b
-refuseDoubledNames things = foldr folding base things (mempty,mempty)
+refuseDoubledNames = refuseDoubledThings
+  getName
+  (\thing -> complain $ "cannot use " <> typeName (mkProxy thing) <> " name "
+                     <> getName thing <> " multiple times.")
+
+-- | refuse doubled things via equality on after applying some function
+refuseDoubledThings
+  :: (Eq a, Ord a, Foldable t, Functor t)
+  => (a' -> a)
+  -> (a' -> LintWriter b)
+  -> t a'
+  -> LintWriter b
+refuseDoubledThings f ifDouble things = foldr folding base things (mempty, mempty)
   where
-    -- this accumulates a function that complains about things it's
-    -- already seen, except if they've already occured twice and then
-    -- occur again …
     folding thing cont (seen, twice)
-      | name `elem` seen && name `notElem` twice = do
-        complain $ "cannot use " <> typeName (mkProxy thing)
-                  <> " name \"" <> name <> "\" multiple times."
-        cont (seen, S.insert name twice)
+      | f thing `elem` seen && f thing `notElem` twice = do
+        ifDouble thing
+        cont (seen, S.insert (f thing) twice)
       | otherwise =
-        cont (S.insert name seen, twice)
-      where name = getName thing
+        cont (S.insert (f thing) seen, twice)
     base _ = pure ()
 
 
+
 ---- General functions ----
 
 unlessElement
-- 
cgit v1.2.3