diff --git a/lib/Properties.hs b/lib/Properties.hs
index f645392f926d80c5a478fd7104b2733e7025a322..035b76a085f5fbf9e9e9bbb72fd746cfd70708ab 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