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.

4 files changed, 49 insertions, 19 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
diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs
index cdec972..d71d037 100644
--- a/lib/LintWriter.hs
+++ b/lib/LintWriter.hs
@@ -8,6 +8,7 @@
 {-# LANGUAGE RankNTypes        #-}
 
 -- | a monad that collects warnings, outputs, etc,
+{-# LANGUAGE TupleSections     #-}
 module LintWriter where
 
 import           Control.Monad.Trans.Maybe  ()
@@ -18,8 +19,10 @@ import           Data.Text                  (Text)
 
 import           Control.Monad.Trans.Reader (Reader, asks, runReader)
 import           Control.Monad.Writer.Lazy  (lift)
+import           Data.Map                   (Map, fromListWith)
 import           Data.Maybe                 (mapMaybe)
 import qualified Data.Text                  as T
+import           Tiled2                     (HasName (getName))
 import           Types
 import           Util                       (PrettyPrint (..))
 
@@ -28,7 +31,7 @@ import           Util                       (PrettyPrint (..))
 -- we currently are
 type Context = Int
 
--- | a monad to collect hints, with some context
+-- | a monad to collect hints, with some context (usually the containing layer/etc.)
 type LintWriter ctxt = LintWriter' ctxt ()
 type LintWriter' ctxt res = WriterT [Lint] (Reader (Context, ctxt)) res
 
@@ -37,6 +40,10 @@ type LintResult' ctxt = (ctxt, [Lint]) -- Either Lint (a, [Lint])
 newtype LintResult ctxt = LintResult (LintResult' ctxt)
 
 
+invertLintResult :: HasName ctxt => LintResult ctxt -> Map Hint [ctxt]
+invertLintResult (LintResult (ctxt, lints)) =
+  fromListWith (<>) $ fmap (, [ctxt]) $ lintsToHints lints
+
 -- better, less confusing serialisation of an Either Hint (a, [Hint]).
 -- Note that Left hint is also serialised as a list to make the resulting
 -- json schema more regular.
diff --git a/lib/Tiled2.hs b/lib/Tiled2.hs
index 45b8ad0..3c881ec 100644
--- a/lib/Tiled2.hs
+++ b/lib/Tiled2.hs
@@ -1,10 +1,10 @@
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase                 #-}
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE NamedFieldPuns             #-}
+{-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
 
 -- | This module provides Haskell types for Tiled's JSON exports, which you can
 -- read about at http://doc.mapeditor.org/en/latest/reference/json-map-format/.
@@ -325,7 +325,10 @@ instance HasProperties Layer where
 instance HasProperties Tileset where
   getProperties = fromMaybe [] . tilesetProperties
 
-
+class HasName a where
+  getName :: a -> Text
+instance HasName Layer where
+  getName = layerName
 
 data LoadResult = Loaded Tiledmap | IOErr String | DecodeErr String
 
diff --git a/lib/Types.hs b/lib/Types.hs
index c39297f..ab9f8a2 100644
--- a/lib/Types.hs
+++ b/lib/Types.hs
@@ -10,11 +10,12 @@
 module Types where
 
 import           Control.Monad.Trans.Maybe ()
-import           Data.Aeson                (ToJSON (toJSON), (.=))
+import           Data.Aeson                (ToJSON (toJSON), ToJSONKey, (.=))
 import           Data.Text                 (Text)
 import           GHC.Generics              (Generic)
 
 import qualified Data.Aeson                as A
+import           Data.Maybe                (mapMaybe)
 import           Paths                     (RelPath)
 import           Util                      (PrettyPrint (..), showText)
 import           WithCli                   (Argument, Proxy (..),
@@ -46,6 +47,7 @@ instance HasArguments Level where
 -- | a hint comes with an explanation (and a level), or is a dependency
 -- (in which case it'll be otherwise treated as an info hint)
 data Lint = Depends Dep | Offers Text | Lint Hint
+  deriving (Ord, Eq, Generic, ToJSONKey)
 
 -- | TODO: add a reasonable representation of possible urls
 data Dep = Local RelPath | Link Text | MapLink Text | LocalMap RelPath
@@ -54,7 +56,7 @@ data Dep = Local RelPath | Link Text | MapLink Text | LocalMap RelPath
 data Hint = Hint
   { hintLevel :: Level
   , hintMsg   :: Text
-  } deriving (Generic)
+  } deriving (Generic, Ord, Eq)
 
 -- | shorter constructor (called hint because (a) older name and
 -- (b) lint also exists and is monadic)
@@ -66,6 +68,9 @@ lintLevel :: Lint -> Level
 lintLevel (Lint h) = hintLevel h
 lintLevel _        = Info
 
+lintsToHints :: [Lint] -> [Hint]
+lintsToHints = mapMaybe (\case {Lint hint -> Just hint ; _ -> Nothing})
+
 instance PrettyPrint Lint where
   prettyprint (Lint  Hint { hintMsg, hintLevel } ) =
     "  " <> showText hintLevel <> ": " <> hintMsg