linter: some work on lints

1 files changed, 41 insertions, 34 deletions

diff --git a/lib/Properties.hs b/lib/Properties.hs
index f645392..035b76a 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -45,7 +45,6 @@ import           Types               (Dep (Link, Local, LocalMap, MapLink))
 import           Uris                (SubstError (..), applySubsts)
 
 
-
 knownMapProperties :: Vector Text
 knownMapProperties = V.fromList
   [ "mapName", "mapDescription", "mapCopyright", "mapLink", "script" ]
@@ -113,7 +112,7 @@ checkMap = do
 
   let missingMetaInfo =
         ["mapName","mapDescription","mapLink"]
-        \\ fmap getName (getProperties tiledmap)
+        \\ map getName (getProperties tiledmap)
 
   unless (null missingMetaInfo)
    $ suggest $ "consider adding meta information to your map using the "
@@ -144,13 +143,13 @@ checkMapProperty p@(Property name _) = case name of
        (const $ forbid "scripts loaded from local files are disallowed")
     | name `elem` ["jitsiRoom", "playAudio", "openWebsite"
                   , "url", "exitUrl", "silent", "getBadge"]
-          -> complain $ "property " <> name
+      -> complain $ "property " <> name
                       <> " should be set on layers, not the map directly"
     | otherwise
-          -> warnUnknown p knownMapProperties
+      -> warnUnknown p knownMapProperties
 
 
--- | check an embedded tile set.
+-- | check an embedded tileset.
 --
 -- Important to collect dependency files
 checkTileset ::  LintWriter Tileset
@@ -178,9 +177,10 @@ checkTileset = do
   when (isJust (tilesetFileName tileset))
     $ complain "The \"filename\" property on tilesets was removed; use \"image\" instead (and perhaps a newer version of the Tiled Editor)."
 
+  -- check properties of individual tiles
   tiles' <- forM (tilesetTiles tileset) $ mapM $ \tile -> do
     mapM_ (checkTileProperty tile) (getProperties tile)
-    zoom (const tileset) (const tile) $ mapM_ checkTileThing' (getProperties tile)
+    zoom (const tileset) (const tile) $ mapM_ (checkTileThing True) (getProperties tile)
 
   adjust (\t -> t { tilesetTiles = tiles' })
 
@@ -189,7 +189,7 @@ checkTileset = do
 
   case tilesetTiles tileset of
     Nothing -> pure ()
-    Just tiles -> refuseDoubledThings tileId
+    Just tiles -> ifDoubledThings tileId
       -- can't set properties on the same tile twice
         (\tile -> complain $ "cannot set properties on the \
                   \tile with the id" <> show (tileId tile) <> "twice.")
@@ -202,9 +202,6 @@ checkTileset = do
       "collides"         -> warn "property \"collides\" should be set on individual tiles, not the tileset"
       _                  -> warn $ "unknown tileset property " <> prettyprint name
 
-    checkTileThing' :: Property -> LintWriter Tile
-    checkTileThing' = checkTileThing True
-
     checkTileProperty :: Tile -> Property -> LintWriter Tileset
     checkTileProperty tile p@(Property name _) =
       case name of
@@ -213,10 +210,9 @@ checkTileset = do
         "name" -> isString p
         "tilesetCopyright" -> warn "the \"tilesetCopyright\" property should be set on the entire tileset, \
                                    \not an individual tile."
-        -- _ -> warnUnknown' ("unknown tile property "
-        --         <> prettyprint name <> " in tile with global id "
-        --         <> showText (tileId tile)) p knownTilesetProperties
-        _ -> pure ()
+        _ -> warnUnknown' ("unknown tile property "
+                <> prettyprint name <> " in tile with global id "
+                <> show (tileId tile)) p knownTilesetProperties
 
 
 -- | collect lints on a single map layer
@@ -241,7 +237,7 @@ checkLayer = do
       adjust (\l -> l { layerObjects = objs })
 
       -- all objects which don't define badges
-      let publicObjects = fmap (V.filter (not . (`containsProperty` "getBadge"))) objs
+      let publicObjects = map (V.filter (not . (`containsProperty` "getBadge"))) objs
 
       -- remove badges from output
       adjust $ \l -> l { layerObjects = publicObjects
@@ -326,7 +322,7 @@ checkObjectProperty p@(Property name _) = do
             suggestPropertyName' "door"
             suggestPropertyName "soundRadius"
               "set \"soundRadius\" to limit the door sound to a certain area."
-    | T.toLower name `elem` [ "allowapi" ]
+    | T.toLower name == "allowapi"
       -> forbidProperty name
     | otherwise ->
         warnUnknown p knownObjectProperties
@@ -340,18 +336,26 @@ checkObjectGroupProperty (Property name _) = case name of
 
 
 
--- | Checks a single (custom) property of a "normal" tile layer
-checkTileThing :: (HasProperties a, HasName a, HasData a) => Bool -> Property -> LintWriter a
+-- | Checks a single (custom) property. Since almost all properties
+-- can be set on tile layer AND on tilesets, this function aims to
+-- be generic over both — the only difference is that tilesets can't
+-- have exits, which is specified by the sole boolean argument
+checkTileThing
+  :: (HasProperties a, HasName a, HasData a)
+  => Bool -> Property -> LintWriter a
 checkTileThing removeExits p@(Property name _value) = case name of
     "jitsiRoom" -> do
+      uselessEmptyLayer
+      -- members of an assembly should automatically get
+      -- admin rights in jitsi (prepending "assembly-" here
+      -- to avoid namespace clashes with other admins)
       lintConfig configAssemblyTag
         >>= setProperty "jitsiRoomAdminTag"
-        . ("assembly-" <>) -- prepend "assembly-" to avoid namespace clashes
-      uselessEmptyLayer
+        . ("assembly-" <>)
       unwrapString p $ \jitsiRoom -> do
         suggestProperty $ Property "jitsiTrigger" "onaction"
 
-        -- prepend jitsi room names to avoid name clashes
+        -- prevents namespace clashes for jitsi room names
         unless ("shared" `isPrefixOf` jitsiRoom) $ do
           assemblyname <- lintConfig configAssemblyTag
           setProperty "jitsiRoom" (assemblyname <> "-" <> jitsiRoom)
@@ -412,20 +416,23 @@ checkTileThing removeExits p@(Property name _value) = case name of
                   _ -> complain "There's a path I don't understand here. Perhaps try \
                                 \asking a human?"
           )
-          $ \path ->
+          ( \path ->
             let ext = getExtension path in
-            if | isOldStyle path ->
-                 complain "Old-Style inter-repository links (using {<placeholder>}) \
-                          \cannot be used at divoc bb3; please use world:// instead \
-                          \(see https://di.c3voc.de/howto:world)."
+            if | isOldStyle path -> do
+                   eventslug <- lintConfig configEventSlug
+                   complain $
+                     "Old-Style inter-repository links (using {<placeholder>}) \
+                     \cannot be used at "<>eventslug<>"; please use world:// \
+                     \instead (see https://di.c3voc.de/howto:world)."
                | ext == "tmx" ->
                    complain "Cannot use .tmx map format; use Tiled's json export instead."
                | ext /= "json" ->
                    complain "All exit links must link to .json files."
                | otherwise -> dependsOn . LocalMap $ path
+          )
       else do
-        warn "exitUrls in Tilesets are not properly supported; if you want to add an \
-             \exit, please use a tile layer instead."
+        warn "exitUrls in Tilesets are not unsupported; if you want to \
+             \add an exit, please use a tile layer instead."
     "exitSceneUrl" ->
       deprecatedUseInstead "exitUrl"
     "exitInstance" ->
@@ -511,19 +518,19 @@ refuseDoubledNames
   :: (Container t, HasName (Element t), HasTypeName (Element t))
   => t
   -> LintWriter b
-refuseDoubledNames = refuseDoubledThings
-  getName
+refuseDoubledNames = ifDoubledThings getName
   (\thing -> complain $ "cannot use " <> typeName (mkProxy thing) <> " name "
                      <> getName thing <> " multiple times.")
 
--- | refuse doubled things via equality on after applying some function
-refuseDoubledThings
+-- | do `ifDouble` if any element of `things` occurs more than once under
+-- the function `f`
+ifDoubledThings
   :: (Eq a, Ord a, Container t)
   => (Element t -> a)
   -> (Element t -> LintWriter b)
   -> t
   -> LintWriter b
-refuseDoubledThings f ifDouble things = foldr folding base things (mempty, mempty)
+ifDoubledThings f ifDouble things = foldr folding base things (mempty, mempty)
   where
     folding thing cont (seen, twice)
       | f thing `elem` seen && f thing `notElem` twice = do
@@ -533,7 +540,7 @@ refuseDoubledThings f ifDouble things = foldr folding base things (mempty, mempt
         cont (S.insert (f thing) seen, twice)
     base _ = pure ()
 
-
+-- | we don't know this property; give suggestions for ones with similar names
 warnUnknown' :: Text -> Property -> Vector Text -> LintWriter a
 warnUnknown' msg (Property name _) knowns =
   if snd minDist < 4