diff options
author | stuebinm | 2021-10-28 23:15:55 +0200 |
---|---|---|
committer | stuebinm | 2021-10-30 15:44:25 +0200 |
commit | 34c1949525e711beaeb6465a54338ec3bd811712 (patch) | |
tree | 2ff70ab49bdbeefcbbc36dfc82af73ab38c8c896 /lib/CheckMap.hs | |
parent | d2983b867a106ee0581d8dc1d8f413178cdd4027 (diff) |
flipping the output map structure
for now, just with layers. Instead of listing by layer (and giving
lints multiple times), list by lint type (and list all layers in which
this lint was applicable).
This is a bit wonky for now, but readability of output is much better.
Diffstat (limited to 'lib/CheckMap.hs')
-rw-r--r-- | lib/CheckMap.hs | 41 |
1 files changed, 28 insertions, 13 deletions
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs index d7d45c0..93c8696 100644 --- a/lib/CheckMap.hs +++ b/lib/CheckMap.hs @@ -8,9 +8,10 @@ -- | Module that contains the high-level checking functions module CheckMap (loadAndLintMap, MapResult(..)) where -import Data.Aeson (ToJSON) +import Data.Aeson (ToJSON (toJSON)) import qualified Data.Aeson as A import Data.Map (Map, fromList, toList) +import qualified Data.Map as M import Data.Maybe (mapMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -19,23 +20,27 @@ import GHC.Generics (Generic) import Data.Aeson.Types ((.=)) +import Data.Map.Lazy (foldlWithKey) import LintWriter (LintResult (..), LintWriter, askContext, - filterLintLevel, lintToDep, resultToDeps, - resultToLints, resultToOffers, runLintWriter) + filterLintLevel, invertLintResult, lintToDep, + resultToDeps, resultToLints, resultToOffers, + runLintWriter) import Properties (checkLayerProperty, checkMap, checkTileset) -import Tiled2 (HasProperties (getProperties), +import Tiled2 (HasName (getName), + HasProperties (getProperties), Layer (layerName, layerProperties), LoadResult (..), Tiledmap (tiledmapLayers, tiledmapTilesets), Tileset (tilesetName), loadTiledmap) -import Types (Dep, Level (..), Lint (..), hint) +import Types (Dep, Hint (hintLevel, hintMsg), Level (..), + Lint (..), hint) import Util (PrettyPrint (prettyprint), prettyprint) -- | What this linter produces: lints for a single map data MapResult = MapResult - { mapresultLayer :: Map Text (LintResult Layer) + { mapresultLayer :: Map Hint [Layer] --Map Text (LintResult Layer) , mapresultTileset :: Map Text (LintResult Tileset) , mapresultGeneral :: [Lint] , mapresultDepends :: [Dep] @@ -44,7 +49,7 @@ data MapResult = MapResult instance ToJSON MapResult where toJSON res = A.object - [ "layer" .= mapresultLayer res + [ "layer" .= CollectedLints (fmap getName <$> mapresultLayer res) --mapresultLayer res , "tileset" .= mapresultTileset res , "general" .= mapresultGeneral res -- TODO: not sure if these are necessary of even useful @@ -52,6 +57,14 @@ instance ToJSON MapResult where , "provides" .= mapresultProvides res ] +newtype CollectedLints = CollectedLints (Map Hint [Text]) + +instance ToJSON CollectedLints where + toJSON (CollectedLints col) = toJSON + . M.mapKeys hintMsg + $ M.mapWithKey (\h cs -> A.object [ "level" .= hintLevel h, "in" .= cs ]) col + + -- | this module's raison d'ĂȘtre -- Lints the map at `path`, and limits local links to at most `depth` -- layers upwards in the file hierarchy @@ -74,17 +87,19 @@ loadAndLintMap path depth = loadTiledmap path >>= pure . \case -- | lint a loaded map runLinter :: Tiledmap -> Int -> MapResult runLinter tiledmap depth = MapResult - { mapresultLayer = fromList layer + { mapresultLayer = layer' , mapresultTileset = fromList tileset , mapresultGeneral = generalLints - , mapresultDepends = concatMap (resultToDeps . snd) layer - <> mapMaybe lintToDep generalLints + , mapresultDepends = --concatMap (resultToDeps . snd) layer + {-<>-} mapMaybe lintToDep generalLints <> concatMap (resultToDeps . snd) tileset - , mapresultProvides = concatMap (resultToOffers . snd) layer + , mapresultProvides = mempty --concatMap (resultToOffers . snd) layer } where + layer' = M.unionsWith (<>) $ fmap invertLintResult layer + layer = V.toList . V.map runCheck $ tiledmapLayers tiledmap - where runCheck l = (layerName l, runLintWriter l depth checkLayer) + where runCheck l = runLintWriter l depth checkLayer tileset = V.toList . V.map runCheck $ tiledmapTilesets tiledmap where runCheck l = (tilesetName l, runLintWriter l depth (checkTileset l)) @@ -109,7 +124,7 @@ instance PrettyPrint (Level, MapResult) where -- TODO: this can be simplified further prettyLayer :: [Text] prettyLayer = mapMaybe - (\(_,l) -> Just $ prettyprint (level, l)) + (\(_,l) -> Just $ {-prettyprint level <> -}(T.concat $ fmap prettyprint $ fmap getName l)) (toList . mapresultLayer $ mapResult) prettyTileset :: [Text] prettyTileset = mapMaybe |