summaryrefslogtreecommitdiff
path: root/lib/Properties.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Properties.hs')
-rw-r--r--lib/Properties.hs45
1 files changed, 30 insertions, 15 deletions
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