summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorstuebinm2021-09-20 02:21:04 +0200
committerstuebinm2021-09-20 02:21:04 +0200
commitd3548568e33e830bc2bdb8dc51e48ad880747a12 (patch)
treeb313f8cbc9d6787aaea62d8800f8209bedf976f7 /lib
parenta4476a3e6d44e8e2ae054a8aec68836b2e813c60 (diff)
moving code around
Diffstat (limited to 'lib')
-rw-r--r--lib/Properties.hs126
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