From 1f18a235aac4eab60d82b61c6f3fe11cf9f3b35a Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sat, 30 Oct 2021 14:56:05 +0200
Subject: also flipping tileset lint output structure

---
 lib/CheckMap.hs | 60 ++++++++++++++++++++++++++++++++-------------------------
 lib/Tiled2.hs   |  2 ++
 2 files changed, 36 insertions(+), 26 deletions(-)

(limited to 'lib')

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
 
-- 
cgit v1.2.3