From a74cc87b085fa15213f8901f091db2631fee10db Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sun, 17 Oct 2021 21:27:50 +0200
Subject: add tileset property linting

this reorganised the whole linting for tilesets somewhat; it's now very
similar to that linting layers, and it may be possible to abstract some
of the code away ...
---
 lib/Properties.hs | 29 +++++++++++++++++++++++------
 1 file changed, 23 insertions(+), 6 deletions(-)

(limited to 'lib/Properties.hs')

diff --git a/lib/Properties.hs b/lib/Properties.hs
index 241a076..ee774c8 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 -- | Contains checks for custom properties of the map json
-module Properties (checkLayerProperty, checkMap) where
+module Properties (checkLayerProperty, checkMap, checkTileset) where
 
 
 import           Control.Monad (unless, when)
@@ -30,7 +30,6 @@ checkMap = do
 
   -- test other things
   mapM_ checkMapProperty (tiledmapProperties tiledmap)
-  mapM_ checkTileset (tiledmapTilesets tiledmap)
 
   -- some layers should exist
   hasLayerNamed "start" (const True)
@@ -69,7 +68,7 @@ checkMapProperty (Property name _value) = case name of
 -- | check an embedded tile set.
 --
 -- Important to collect dependency files
-checkTileset :: Tileset -> LintWriter Tiledmap
+checkTileset :: Tileset -> LintWriter Tileset
 checkTileset tileset = do
   -- TODO: can tilesets be non-local dependencies?
   unwrapPath (tilesetImage tileset) (dependsOn . Local)
@@ -81,6 +80,14 @@ checkTileset tileset = do
   unless (tilesetImageheight tileset < 4096 && tilesetImagewidth tileset < 4096)
     $ warn $ "Tileset " <> tilesetName tileset <> " should not be larger than 4096×4096 pixels in total"
 
+  -- TODO: check copyright!
+  requireProperty "copyright"
+  mapM_ checkTilesetProperty (tilesetProperties tileset)
+
+checkTilesetProperty :: Property -> LintWriter Tileset
+checkTilesetProperty p@(Property name value) = case name of
+  "copyright" -> pure () -- only allow some licenses?
+  _           -> pure () -- are there any other properties?
 
 -- | Checks a single (custom) property of a layer
 --
@@ -174,10 +181,19 @@ checkLayerProperty p@(Property name _value) = case name of
 
 --------- Helper functions & stuff ---------
 
-unlessHasProperty :: Text -> LintWriter Layer -> LintWriter Layer
+class HasProperties a where
+  getProperties :: a -> [Property]
+
+instance HasProperties Layer where
+  getProperties = layerProperties
+
+instance HasProperties Tileset where
+  getProperties = tilesetProperties
+
+unlessHasProperty :: HasProperties a => Text -> LintWriter a -> LintWriter a
 unlessHasProperty name andthen = do
   layer <- askContext
-  let hasprop = any (\(Property name' _) -> name == name') (layerProperties layer)
+  let hasprop = any (\(Property name' _) -> name == name') (getProperties layer)
   unless hasprop andthen
 
 
@@ -187,8 +203,9 @@ forbidProperty name = do
   forbid $ "property " <> prettyprint name <> " should not be used"
 
 
+
 -- | require some property
-requireProperty :: Text -> LintWriter Layer
+requireProperty :: HasProperties a => Text -> LintWriter a
 requireProperty name =
   unlessHasProperty name
   $ complain $ "property "<>prettyprint name<>" requires property "<>prettyprint name
-- 
cgit v1.2.3