summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorstuebinm2021-12-04 13:06:27 +0100
committerstuebinm2021-12-12 17:42:22 +0100
commit6a67d3e41fc49e09ed6c1c02fec2946c6db9bc1f (patch)
treef16d369c22a13c0e9a8ec733a00271c76a1234ab /lib
parentbbde46e7db5fa23015ba09128efb27f6b7342675 (diff)
lints for names that are used more than twice
(previously it would just lint "can't use name twice" multiple times, which looks kind of silly)
Diffstat (limited to 'lib')
-rw-r--r--lib/Properties.hs20
1 files changed, 13 insertions, 7 deletions
diff --git a/lib/Properties.hs b/lib/Properties.hs
index ba78fca..07b4397 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -14,7 +14,8 @@ import Control.Monad (forM_, unless, when)
import Data.Text (Text, isPrefixOf)
import qualified Data.Vector as V
import Tiled (Layer (..), Object (..), Property (..),
- PropertyValue (..), Tiledmap (..), Tileset (..))
+ PropertyValue (..), Tile (..), Tiledmap (..),
+ Tileset (..))
import TiledAbstract (HasName (..), HasProperties (..),
HasTypeName (..), IsProperty (..))
import Util (layerIsEmpty, mkProxy, naiveEscapeHTML,
@@ -368,13 +369,18 @@ refuseDoubledNames
=> (Foldable t, Functor t)
=> t a
-> LintWriter b
-refuseDoubledNames things = foldr folding base things mempty
+refuseDoubledNames things = foldr folding base things (mempty,mempty)
where
- -- this accumulates a function that complains about things it's already seen
- folding thing cont seen = do
- when (name `elem` seen)
- $ complain $ "cannot use " <> typeName (mkProxy thing) <> " name \"" <> name <> "\" twice"
- cont (S.insert name seen)
+ -- 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)
+ | otherwise =
+ cont (S.insert name seen, twice)
where name = getName thing
base _ = pure ()