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