summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/CheckMap.hs25
-rw-r--r--lib/Properties.hs29
-rw-r--r--lib/Tiled2.hs2
-rw-r--r--lib/Util.hs7
4 files changed, 47 insertions, 16 deletions
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 8b4dca8..036f4e8 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -22,10 +22,11 @@ import Data.Aeson.Types ((.=))
import LintWriter (LintResult (..), LintWriter, askContext,
filterLintLevel, lintToDep, resultToDeps,
resultToLints, resultToOffers, runLintWriter)
-import Properties (checkLayerProperty, checkMap)
+import Properties (checkLayerProperty, checkMap, checkTileset)
import Tiled2 (Layer (layerName, layerProperties),
- LoadResult (..), Tiledmap (tiledmapLayers),
- loadTiledmap)
+ LoadResult (..),
+ Tiledmap (tiledmapLayers, tiledmapTilesets),
+ Tileset (tilesetName), loadTiledmap)
import Types (Dep, Level (..), Lint (..), hint)
import Util (PrettyPrint (prettyprint), prettyprint)
@@ -34,6 +35,7 @@ import Util (PrettyPrint (prettyprint), prettyprint)
-- | What this linter produces: lints for a single map
data MapResult = MapResult
{ mapresultLayer :: Map Text (LintResult Layer)
+ , mapresultTileset :: Map Text (LintResult Tileset)
, mapresultGeneral :: [Lint]
, mapresultDepends :: [Dep]
, mapresultProvides :: [Text]
@@ -42,6 +44,7 @@ data MapResult = MapResult
instance ToJSON MapResult where
toJSON res = A.object
[ "layer" .= mapresultLayer res
+ , "tileset" .= mapresultTileset res
, "general" .= mapresultGeneral res
-- TODO: not sure if these are necessary of even useful
, "depends" .= mapresultDepends res
@@ -55,6 +58,7 @@ loadAndLintMap :: FilePath -> Int -> IO (Maybe MapResult)
loadAndLintMap path depth = loadTiledmap path >>= pure . \case
DecodeErr err -> Just $ MapResult
{ mapresultLayer = mempty
+ , mapresultTileset = mempty
, mapresultDepends = []
, mapresultProvides = []
, mapresultGeneral =
@@ -69,17 +73,19 @@ loadAndLintMap path depth = loadTiledmap path >>= pure . \case
-- | lint a loaded map
runLinter :: Tiledmap -> Int -> MapResult
runLinter tiledmap depth = MapResult
- { mapresultLayer = layerMap
- , mapresultGeneral = generalLints -- no general lints for now
+ { mapresultLayer = fromList layer
+ , mapresultTileset = fromList tileset
+ , mapresultGeneral = generalLints
, mapresultDepends = concatMap (resultToDeps . snd) layer
<> mapMaybe lintToDep generalLints
+ <> concatMap (resultToDeps . snd) tileset
, mapresultProvides = concatMap (resultToOffers . snd) layer
}
where
- layerMap :: Map Text (LintResult Layer)
- layerMap = fromList layer
layer = V.toList . V.map runCheck $ tiledmapLayers tiledmap
where runCheck l = (layerName l, runLintWriter l depth checkLayer)
+ tileset = V.toList . V.map runCheck $ tiledmapTilesets tiledmap
+ where runCheck l = (tilesetName l, runLintWriter l depth (checkTileset l))
-- lints collected from properties
generalLints =
@@ -98,11 +104,16 @@ instance PrettyPrint (Level, MapResult) where
then " all good!\n" else prettyLints
where
prettyLints = T.concat $ prettyGeneral <> prettyLayer
+ <> prettyTileset
-- TODO: this can be simplified further
prettyLayer :: [Text]
prettyLayer = mapMaybe
(\(_,l) -> Just $ prettyprint (level, l))
(toList . mapresultLayer $ mapResult)
+ prettyTileset :: [Text]
+ prettyTileset = mapMaybe
+ (\(_,t) -> Just $ prettyprint (level, t))
+ (toList . mapresultTileset $ mapResult)
prettyGeneral :: [Text]
prettyGeneral = map
((<> "\n") . prettyprint)
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
diff --git a/lib/Tiled2.hs b/lib/Tiled2.hs
index 724be1d..3fc8c31 100644
--- a/lib/Tiled2.hs
+++ b/lib/Tiled2.hs
@@ -309,7 +309,7 @@ data Tileset = Tileset { tilesetFirstgid :: GlobalId
-- ^ Width of source image in pixels
, tilesetImageheight :: Int
-- ^ Height of source image in pixels
- , tilesetProperties :: Map Text Text
+ , tilesetProperties :: [Property]
-- ^ String key-value pairs
, tilesetPropertytypes :: Map Text Text
-- ^ String key-value pairs
diff --git a/lib/Util.hs b/lib/Util.hs
index 47ee7f2..18dfb5b 100644
--- a/lib/Util.hs
+++ b/lib/Util.hs
@@ -9,8 +9,8 @@ module Util where
import Data.Aeson as Aeson
import Data.Text (Text)
import qualified Data.Text as T
-import Tiled2 (Layer (layerData), PropertyValue (..), layerName,
- mkTiledId)
+import Tiled2 (Layer (layerData), PropertyValue (..),
+ Tileset (tilesetName), layerName, mkTiledId)
-- | haskell's many string types are FUN …
showText :: Show a => a -> Text
@@ -43,6 +43,9 @@ instance PrettyPrint () where
instance PrettyPrint Layer where
prettyprint = (<>) "layer " . layerName
+instance PrettyPrint Tileset where
+ prettyprint = (<>) "tileset " . tilesetName
+
printPretty :: PrettyPrint a => a -> IO ()
printPretty = putStr . T.unpack . prettyprint
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-17 20:57:09 +0000