summaryrefslogtreecommitdiff
path: root/lib/Properties.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Properties.hs')
-rw-r--r--lib/Properties.hs21
1 files changed, 7 insertions, 14 deletions
diff --git a/lib/Properties.hs b/lib/Properties.hs
index ed97355..1b0569d 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -8,10 +8,12 @@ module Properties (checkLayerProperty, checkMap, checkTileset) where
import Control.Monad (unless, when)
import Data.Text (Text, isPrefixOf)
-import Tiled2 (Layer (..), Property (..), PropertyValue (..),
+import Tiled2 (HasProperties (getProperties), Layer (..),
+ Property (..), PropertyValue (..),
Tiledmap (..), Tileset (..))
import Util (layerIsEmpty, prettyprint)
+import Data.Maybe (fromMaybe)
import LintWriter (LintWriter, askContext, askFileDepth, complain,
dependsOn, forbid, offersEntrypoint, suggest,
warn)
@@ -29,14 +31,14 @@ checkMap = do
tiledmap <- askContext
-- test other things
- mapM_ checkMapProperty (tiledmapProperties tiledmap)
+ mapM_ checkMapProperty (fromMaybe [] $ tiledmapProperties 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)
+ hasLayer (flip containsProperty "exitUrl" . getProperties)
"The map must contain at least one layer with the property \"exitUrl\" set"
-- reject maps not suitable for workadventure
@@ -82,7 +84,7 @@ checkTileset tileset = do
-- TODO: check copyright!
requireProperty "copyright"
- mapM_ checkTilesetProperty (tilesetProperties tileset)
+ mapM_ checkTilesetProperty (fromMaybe [] $ tilesetProperties tileset)
checkTilesetProperty :: Property -> LintWriter Tileset
checkTilesetProperty p@(Property name value) = case name of
@@ -182,15 +184,6 @@ checkLayerProperty p@(Property name _value) = case name of
--------- Helper functions & stuff ---------
-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
@@ -229,7 +222,7 @@ suggestProperty (Property name value) =
-- | does this layer have the given property?
-containsProperty :: [Property] -> Text -> Bool
+containsProperty :: Foldable t => t Property -> Text -> Bool
containsProperty props name = any
(\(Property name' _) -> name' == name) props