diff options
| -rw-r--r-- | lib/Properties.hs | 126 |
1 files changed, 69 insertions, 57 deletions
diff --git a/lib/Properties.hs b/lib/Properties.hs index 395bc87..c2f5c81 100644 --- a/lib/Properties.hs +++ b/lib/Properties.hs @@ -18,17 +18,71 @@ import Types (Dep (Link, Local, LocalMap, MapLink)) --- | the point of this module +-- | Checks an entire map for "general" lints. -- --- given a property, check if it is valid. It gets a reference --- to its own layer since sometimes the presense of one property --- implies the presence or absense of another. +-- Note that it does /not/ call checkMapProperty; this is handled +-- seperately in CheckMap.hs, since these lints go into a different +-- field of the resulting json. +checkMap :: Tiledmap -> LintWriter () +checkMap tiledmap = do + -- check properties + mapM_ (checkMapProperty tiledmap) (tiledmapProperties tiledmap) + -- check tilesets + mapM_ checkTileset (tiledmapTilesets tiledmap) + + -- some layers should exist + hasLayerNamed "start" (const True) + "The map must have one layer named \"start\"" + hasLayerNamed "floorLayer" ((==) "objectgroup" . layerType) + "The map must have one layer named \"floorLayer\" of type \"objectgroup\"" + hasLayer (flip containsProperty "exitUrl" . layerProperties) + "The map must contain at least one layer with the property \"exitUrl\" set" + + -- reject maps not suitable for workadventure + unless (tiledmapOrientation tiledmap == "orthogonal") + $ complain "The map's orientation must be set to \"orthogonal\"" + unless (tiledmapTileheight tiledmap == 32 && tiledmapTilewidth tiledmap == 32) + $ complain "The map's tile size must be 32 by 32 pixels" + where + layers = tiledmapLayers tiledmap + hasLayerNamed name pred = hasLayer (\l -> layerName l == name && pred l) + hasLayer pred err = + unless (any pred layers) + $ complain err + + +-- | Checks a single property of a map. -- --- The tests in here are meant to comply with the informal spec --- at https://workadventu.re/map-building +-- Doesn't really do all that much, but could in theory be expanded into a +-- longer function same as checkLayerProperty. +checkMapProperty :: Tiledmap -> Property -> LintWriter () +checkMapProperty map (Property name value) = case name of + "script" -> isForbidden + _ -> complain $ "unknown map property " <> name + where + -- | this property is forbidden and should not be used + isForbidden = forbid $ "property " <> prettyprint name <> " should not be used" + + +-- | check an embedded tile set. -- --- I've attempted to build the LintWriter monad in a way --- that should make this readable even to non-Haskellers +-- Important to collect dependency files +checkTileset :: Tileset -> LintWriter () +checkTileset tileset = do + -- TODO: can tilesets be non-local dependencies? + dependsOn $ Local (tilesetImage tileset) + + -- reject tilesets unsuitable for workadventure + unless (tilesetTilewidth tileset == 32 && tilesetTileheight tileset == 32) + $ complain $ "Tileset " <> tilesetName tileset <> " must have tile size 32 by 32" + + + + +-- | Checks a single (custom) property of a layer +-- +-- It gets a reference to its own layer since sometimes the presence +-- of one property implies the presence or absense of another. checkLayerProperty :: Layer -> Property -> LintWriter () checkLayerProperty layer p@(Property name value) = case name of "jitsiRoom" -> do @@ -110,59 +164,17 @@ checkLayerProperty layer p@(Property name value) = case name of uselessEmptyLayer = when (layerIsEmpty layer) $ warn ("property" <> name <> " was set on an empty layer and is thereby useless") --- | Checks a single property of a map. --- --- Doesn't really do all that much, but could in theory be expanded into a --- longer function same as checkLayerProperty. -checkMapProperty :: Tiledmap -> Property -> LintWriter () -checkMapProperty map (Property name value) = case name of - "script" -> isForbidden - _ -> complain $ "unknown map property " <> name - where - -- | this property is forbidden and should not be used - isForbidden = forbid $ "property " <> prettyprint name <> " should not be used" --- | Checks an entire map for "general" lints. --- --- Note that it does /not/ call checkMapProperty; this is handled --- seperately in CheckMap.hs, since these lints go into a different --- field of the resulting json. -checkMap :: Tiledmap -> LintWriter () -checkMap tiledmap = do - -- check properties - mapM_ (checkMapProperty tiledmap) (tiledmapProperties tiledmap) - mapM_ checkTileset (tiledmapTilesets tiledmap) - -- some layers should exist - hasLayerNamed "start" (const True) - "The map must have one layer named \"start\"" - hasLayerNamed "floorLayer" ((==) "objectgroup" . layerType) - "The map must have one layer named \"floorLayer\" of type \"objectgroup\"" - hasLayer (flip containsProperty "exitUrl" . layerProperties) - "The map must contain at least one layer with the property \"exitUrl\" set" - -- reject maps not suitable for workadventure - unless (tiledmapOrientation tiledmap == "orthogonal") - $ complain "The map's orientation must be set to \"orthogonal\"" - unless (tiledmapTileheight tiledmap == 32 && tiledmapTilewidth tiledmap == 32) - $ complain "The map's tile size must be 32 by 32 pixels" - where - layers = tiledmapLayers tiledmap - hasLayerNamed name pred = hasLayer (\l -> layerName l == name && pred l) - hasLayer pred err = - unless (any pred layers) - $ complain err --- | check an embedded tile set. --- --- Important to collect dependency files -checkTileset :: Tileset -> LintWriter () -checkTileset tileset = do - -- TODO: can tilesets be non-local dependencies? - dependsOn $ Local (tilesetImage tileset) - -- reject tilesets unsuitable for workadventure - unless (tilesetTilewidth tileset == 32 && tilesetTileheight tileset == 32) - $ complain $ "Tileset " <> tilesetName tileset <> " must have tile size 32 by 32" + + + + + +--------- Helper functions & stuff --------- + -- | does this layer have the given property? containsProperty :: [Property] -> Text -> Bool |