diff options
| -rw-r--r-- | lib/CheckMap.hs | 60 | ||||
| -rw-r--r-- | lib/Tiled2.hs | 2 |
2 files changed, 36 insertions, 26 deletions
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs index 484fe83..9c869d9 100644 --- a/lib/CheckMap.hs +++ b/lib/CheckMap.hs @@ -10,7 +10,7 @@ module CheckMap (loadAndLintMap, MapResult(..)) where import Data.Aeson (ToJSON (toJSON)) import qualified Data.Aeson as A -import Data.Map (Map, fromList, toList) +import Data.Map (Map, toList) import qualified Data.Map as M import Data.Maybe (mapMaybe) import Data.Text (Text) @@ -20,10 +20,8 @@ import GHC.Generics (Generic) import Data.Aeson.Types ((.=)) -import Data.Map.Lazy (foldlWithKey) -import LintWriter (LintResult (..), LintWriter, askContext, - filterLintLevel, invertLintResult, lintToDep, - resultToDeps, resultToLints, resultToOffers, +import LintWriter (LintWriter, askContext, filterLintLevel, + invertLintResult, lintToDep, resultToLints, runLintWriter) import Properties (checkLayerProperty, checkMap, checkTileset) import Tiled2 (HasName (getName), @@ -40,8 +38,8 @@ import Util (PrettyPrint (prettyprint), prettyprint) -- | What this linter produces: lints for a single map data MapResult = MapResult - { mapresultLayer :: Map Hint [Layer] --Map Text (LintResult Layer) - , mapresultTileset :: Map Text (LintResult Tileset) + { mapresultLayer :: Map Hint [Layer] + , mapresultTileset :: Map Hint [Tileset] --Map Text (LintResult Tileset) , mapresultGeneral :: [Lint] , mapresultDepends :: [Dep] , mapresultProvides :: [Text] @@ -49,8 +47,8 @@ data MapResult = MapResult instance ToJSON MapResult where toJSON res = A.object - [ "layer" .= CollectedLints (fmap getName <$> mapresultLayer res) --mapresultLayer res - , "tileset" .= mapresultTileset res + [ "layer" .= CollectedLints (fmap getName <$> mapresultLayer res) + , "tileset" .= CollectedLints (fmap getName <$> mapresultTileset res) , "general" .= mapresultGeneral res -- TODO: not sure if these are necessary of even useful , "depends" .= mapresultDepends res @@ -88,20 +86,21 @@ loadAndLintMap path depth = loadTiledmap path >>= pure . \case runLinter :: Tiledmap -> Int -> MapResult runLinter tiledmap depth = MapResult { mapresultLayer = layer' - , mapresultTileset = fromList tileset + , mapresultTileset = tileset'-- fromList tileset , mapresultGeneral = generalLints , mapresultDepends = --concatMap (resultToDeps . snd) layer {-<>-} mapMaybe lintToDep generalLints - <> concatMap (resultToDeps . snd) tileset + -- <> concatMap (resultToDeps . snd) tileset , mapresultProvides = mempty --concatMap (resultToOffers . snd) layer } where layer' = M.unionsWith (<>) $ fmap invertLintResult layer + tileset' = M.unionsWith (<>) $ fmap invertLintResult tileset 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 = (tilesetName l, runLintWriter l depth (checkTileset l)) + where runCheck l = runLintWriter l depth (checkTileset l) -- lints collected from properties generalLints = @@ -116,21 +115,30 @@ checkLayer = do -- human-readable lint output, e.g. for consoles instance PrettyPrint (Level, MapResult) where - prettyprint (level, mapResult) = if prettyLints == "" - then " all good!\n" else prettyLints + prettyprint (level, mapResult) = if complete == "" + then " all good!\n" else complete where - prettyLints = T.concat $ prettyGeneral <> prettyLayer - <> prettyTileset - -- TODO: this can be simplified further - prettyLayer :: [Text] - prettyLayer = mapMaybe - (\(hint,layer) -> Just $ prettyprint hint - <> "\n (in " <> T.intercalate ", " (fmap getName layer) <> ")\n") - (toList . mapresultLayer $ mapResult) - prettyTileset :: [Text] - prettyTileset = mapMaybe - (\(_,t) -> Just $ prettyprint (level, t)) - (toList . mapresultTileset $ mapResult) + complete = T.concat $ prettyGeneral + <> prettyLints mapresultLayer + <> prettyLints mapresultTileset + + -- | pretty-prints a collection of Hints, printing each + -- Hint only once, then a list of its occurences line-wrapped + -- to fit onto a decent-sized terminal + prettyLints :: HasName a => (MapResult -> Map Hint [a]) -> [Text] + prettyLints getter = fmap + (\(h, cs) -> prettyprint h + <> "\n (in " + -- foldl :: ((length of current line, acc) -> next ctxt -> list) -> ... + <> snd (foldl (\(l,a) c -> case l of + 0 -> (T.length c, c) + _ | l < 70 -> (l+2+T.length c, a <> ", " <> c) + _ -> (6+T.length c, a <> ",\n " <> c) + ) + (0, "") (fmap getName cs)) + <> ")\n") + (toList . getter $ mapResult) + prettyGeneral :: [Text] prettyGeneral = map ((<> "\n") . prettyprint) diff --git a/lib/Tiled2.hs b/lib/Tiled2.hs index 2a9c5b5..0f20061 100644 --- a/lib/Tiled2.hs +++ b/lib/Tiled2.hs @@ -350,6 +350,8 @@ class HasName a where getName :: a -> Text instance HasName Layer where getName = layerName +instance HasName Tileset where + getName = tilesetName data LoadResult = Loaded Tiledmap | IOErr String | DecodeErr String |