summaryrefslogtreecommitdiff
path: root/lib/Properties.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Properties.hs')
-rw-r--r--lib/Properties.hs29
1 files changed, 23 insertions, 6 deletions
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