diff options
Diffstat (limited to 'lib/Properties.hs')
-rw-r--r-- | lib/Properties.hs | 21 |
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 |