From 34c1949525e711beaeb6465a54338ec3bd811712 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 28 Oct 2021 23:15:55 +0200
Subject: 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.
---
 lib/LintWriter.hs | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

(limited to 'lib/LintWriter.hs')

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