From 5b8ed8ad906e92bce5b8576b29ae6f2cc46d8696 Mon Sep 17 00:00:00 2001 From: stuebinm Date: Mon, 20 Sep 2021 01:56:15 +0200 Subject: lint map things that aren't custom properties --- lib/CheckMap.hs | 13 +++++-------- lib/Properties.hs | 35 +++++++++++++++++++++++++++++++---- 2 files changed, 36 insertions(+), 12 deletions(-) diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs index 08932b4..ffd94ec 100644 --- a/lib/CheckMap.hs +++ b/lib/CheckMap.hs @@ -17,12 +17,10 @@ import qualified Data.Vector as V import GHC.Generics (Generic) import LintWriter (LintResult (..), LintWriter, - lintsToDeps, resultToLints, - runLintWriter) -import Properties (checkLayerProperty, - checkMapProperty) + lintsToDeps, runLintWriter) +import Properties (checkLayerProperty, checkMap) import Tiled2 (Layer (layerName, layerProperties), - Tiledmap (tiledmapLayers, tiledmapProperties), + Tiledmap (tiledmapLayers), loadTiledmap) import Types (Dep, Level (..), Lint (..), hint, lintLevel) @@ -57,7 +55,7 @@ loadAndLintMap path = loadTiledmap path >>= pure . \case runLinter :: Tiledmap -> MapResult () runLinter tiledmap = MapResult { mapresultLayer = Just layerMap - , mapresultGeneral = propertyLints -- no general lints for now + , mapresultGeneral = generalLints -- no general lints for now , mapresultDepends = concatMap (lintsToDeps . snd) layer } where @@ -67,8 +65,7 @@ runLinter tiledmap = MapResult where runCheck l = (layerName l, LintResult $ runWriterT (checkLayer l)) -- lints collected from properties - propertyLints = runLintWriter - $ mapM_ (checkMapProperty tiledmap) (tiledmapProperties tiledmap) + generalLints = runLintWriter (checkMap tiledmap) -- | collect lints on a single map layer diff --git a/lib/Properties.hs b/lib/Properties.hs index 0805a4d..4dada7d 100644 --- a/lib/Properties.hs +++ b/lib/Properties.hs @@ -3,13 +3,13 @@ {-# LANGUAGE OverloadedStrings #-} -- | Contains checks for custom properties of the map json -module Properties (checkLayerProperty, checkMapProperty) where +module Properties (checkLayerProperty, checkMap) where import Control.Monad (unless, when) import Data.Text (Text, isPrefixOf) -import Tiled2 (Layer (layerProperties), Property (..), - PropertyValue (..), Tiledmap) +import Tiled2 (Layer (..), Property (..), PropertyValue (..), + Tiledmap (..)) import Util (layerIsEmpty, prettyprint) import LintWriter (LintWriter, complain, dependsOn, forbid, info, @@ -122,7 +122,34 @@ checkMapProperty map (Property name value) = case name of -- | 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) + -- 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 -- cgit v1.2.3