diff options
| -rw-r--r-- | lib/CheckMap.hs | 13 | ||||
| -rw-r--r-- | 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 |