From d3548568e33e830bc2bdb8dc51e48ad880747a12 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Mon, 20 Sep 2021 02:21:04 +0200
Subject: moving code around

---
 lib/Properties.hs | 126 ++++++++++++++++++++++++++++++------------------------
 1 file changed, 69 insertions(+), 57 deletions(-)

(limited to 'lib/Properties.hs')

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
-- 
cgit v1.2.3