From 1f18a235aac4eab60d82b61c6f3fe11cf9f3b35a Mon Sep 17 00:00:00 2001
From: stuebinm <stuebinm@disroot.org>
Date: Sat, 30 Oct 2021 14:56:05 +0200
Subject: [PATCH] also flipping tileset lint output structure
---
lib/CheckMap.hs | 60 ++++++++++++++++++++++++++++---------------------
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
--
GitLab