summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/CheckMap.hs38
-rw-r--r--lib/Properties.hs5
2 files changed, 22 insertions, 21 deletions
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 9c869d9..53cd0c7 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -21,15 +21,14 @@ import GHC.Generics (Generic)
import Data.Aeson.Types ((.=))
import LintWriter (LintWriter, askContext, filterLintLevel,
- invertLintResult, lintToDep, resultToLints,
- runLintWriter)
+ invertLintResult, lintToDep, resultToDeps,
+ resultToLints, resultToOffers, runLintWriter)
import Properties (checkLayerProperty, checkMap, checkTileset)
import Tiled2 (HasName (getName),
- HasProperties (getProperties),
- Layer (layerName, layerProperties),
+ HasProperties (getProperties), Layer,
LoadResult (..),
Tiledmap (tiledmapLayers, tiledmapTilesets),
- Tileset (tilesetName), loadTiledmap)
+ Tileset, loadTiledmap)
import Types (Dep, Hint (hintLevel, hintMsg), Level (..),
Lint (..), hint)
import Util (PrettyPrint (prettyprint), prettyprint)
@@ -51,8 +50,8 @@ instance ToJSON MapResult where
, "tileset" .= CollectedLints (fmap getName <$> mapresultTileset res)
, "general" .= mapresultGeneral res
-- TODO: not sure if these are necessary of even useful
- , "depends" .= mapresultDepends res
- , "provides" .= mapresultProvides res
+ --, "depends" .= mapresultDepends res
+ --, "provides" .= mapresultProvides res
]
newtype CollectedLints = CollectedLints (Map Hint [Text])
@@ -85,23 +84,24 @@ loadAndLintMap path depth = loadTiledmap path >>= pure . \case
-- | lint a loaded map
runLinter :: Tiledmap -> Int -> MapResult
runLinter tiledmap depth = MapResult
- { mapresultLayer = layer'
- , mapresultTileset = tileset'-- fromList tileset
+ { mapresultLayer = invertThing layer
+ , mapresultTileset = invertThing tileset
, mapresultGeneral = generalLints
- , mapresultDepends = --concatMap (resultToDeps . snd) layer
- {-<>-} mapMaybe lintToDep generalLints
- -- <> concatMap (resultToDeps . snd) tileset
- , mapresultProvides = mempty --concatMap (resultToOffers . snd) layer
+ , mapresultDepends = mapMaybe lintToDep generalLints
+ <> concatMap resultToDeps layer
+ <> concatMap resultToDeps tileset
+ , mapresultProvides = concatMap resultToOffers layer
}
where
- layer' = M.unionsWith (<>) $ fmap invertLintResult layer
- tileset' = M.unionsWith (<>) $ fmap invertLintResult tileset
+ layer = checkThing tiledmapLayers checkLayer
+ tileset = checkThing tiledmapTilesets checkTileset
- layer = V.toList . V.map runCheck $ tiledmapLayers tiledmap
- where runCheck l = runLintWriter l depth checkLayer
- tileset = V.toList . V.map runCheck $ tiledmapTilesets tiledmap
- where runCheck l = runLintWriter l depth (checkTileset l)
+ checkThing getter checker = V.toList . V.map runCheck $ getter tiledmap
+ where runCheck thing = runLintWriter thing depth checker
+ -- | "inverts" a LintResult, i.e. groups it by lints instead of
+ -- layers / maps
+ invertThing thing = M.unionsWith (<>) $ fmap invertLintResult thing
-- lints collected from properties
generalLints =
resultToLints $ runLintWriter tiledmap depth checkMap
diff --git a/lib/Properties.hs b/lib/Properties.hs
index 1b0569d..78993ce 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -70,8 +70,9 @@ checkMapProperty (Property name _value) = case name of
-- | check an embedded tile set.
--
-- Important to collect dependency files
-checkTileset :: Tileset -> LintWriter Tileset
-checkTileset tileset = do
+checkTileset :: LintWriter Tileset
+checkTileset = do
+ tileset <- askContext
-- TODO: can tilesets be non-local dependencies?
unwrapPath (tilesetImage tileset) (dependsOn . Local)