rebuilding the core LintWriter monad

it is no longer an Either since that wasn't used anyways, but is now
also a Reader.

1 files changed, 28 insertions, 31 deletions

diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 0de9094..b32bad6 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -5,33 +5,31 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 -- | Module that contains the high-level checking functions
+{-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-}
 module CheckMap (loadAndLintMap) where
 
-import           Control.Monad.Trans.Writer (WriterT (runWriterT))
-import           Data.Aeson                 (ToJSON)
-import           Data.Map                   (Map, fromList, toList)
-import           Data.Maybe                 (mapMaybe)
-import           Data.Text                  (Text)
-import qualified Data.Text                  as T
-import qualified Data.Vector                as V
-import           GHC.Generics               (Generic)
-
-import           LintWriter                 (LintResult (..), LintWriter,
-                                             lintResultToDeps, lintToDep,
-                                             runLintWriter)
-import           Properties                 (checkLayerProperty, checkMap)
-import           Tiled2                     (Layer (layerName, layerProperties),
-                                             Tiledmap (tiledmapLayers),
-                                             loadTiledmap)
-import           Types                      (Dep, Level (..), Lint (..), hint,
-                                             lintLevel)
-import           Util                       (PrettyPrint (prettyprint),
-                                             prettyprint)
+import           Data.Aeson   (ToJSON)
+import           Data.Map     (Map, fromList, toList)
+import           Data.Maybe   (mapMaybe)
+import           Data.Text    (Text)
+import qualified Data.Text    as T
+import qualified Data.Vector  as V
+import           GHC.Generics (Generic)
+
+import           LintWriter   (LayerContext (..), LintResult (..), LintWriter,
+                               lintToDep, resultToDeps, resultToLints,
+                               runLintWriter)
+import           Properties   (checkLayerProperty, checkMap)
+import           Tiled2       (Layer (layerName, layerProperties),
+                               Tiledmap (tiledmapLayers), loadTiledmap)
+import           Types        (Dep, Level (..), Lint (..), hint, lintLevel)
+import           Util         (PrettyPrint (prettyprint), prettyprint)
+
 
 
 -- | What this linter produces: lints for a single map
 data MapResult a = MapResult
-  { mapresultLayer   :: Maybe (Map Text (LintResult a))
+  { mapresultLayer   :: Maybe (Map Text (LintResult LayerContext))
   , mapresultGeneral :: [Lint]
   , mapresultDepends :: [Dep]
   } deriving (Generic, ToJSON)
@@ -57,21 +55,22 @@ runLinter :: Tiledmap -> MapResult ()
 runLinter tiledmap = MapResult
   { mapresultLayer = Just layerMap
   , mapresultGeneral = generalLints  -- no general lints for now
-  , mapresultDepends = concatMap (lintResultToDeps . snd) layer
+  , mapresultDepends = concatMap (resultToDeps . snd) layer
     <> mapMaybe lintToDep generalLints
   }
   where
-    layerMap :: Map Text (LintResult ())
+    layerMap :: Map Text (LintResult LayerContext)
     layerMap = fromList layer
     layer = V.toList . V.map runCheck $ tiledmapLayers tiledmap
-      where runCheck l = (layerName l, LintResult $ runWriterT (checkLayer l))
+      where runCheck l = (layerName l, runLintWriter (LayerContext ()) (checkLayer l))
 
     -- lints collected from properties
-    generalLints = runLintWriter (checkMap tiledmap)
+    generalLints =
+      resultToLints $ runLintWriter () (checkMap tiledmap)
 
 
 -- | collect lints on a single map layer
-checkLayer :: Layer -> LintWriter ()
+checkLayer :: Layer -> LintWriter LayerContext
 checkLayer layer =
   mapM_ (checkLayerProperty layer) (layerProperties layer)
 
@@ -95,11 +94,9 @@ showContext ctxt = " (in layer " <> ctxt <> ")\n"
 -- | pretty-printer for a LintResult. Isn't an instance of PrettyPrint since
 -- it needs to know about the result's context (yes, there could be
 -- a wrapper type for that – but I wasn't really in the mood)
-showResult :: Text -> LintResult a -> Maybe Text
-showResult ctxt (LintResult res) = case res of
-  Left hint        -> Just $ "Fatal: " <> prettyprint hint
-  Right (_, [])    -> Nothing
-  Right (_, hints) -> Just $ T.concat (mapMaybe showHint hints)
+showResult :: Text -> LintResult c -> Maybe Text
+showResult ctxt (LintResult (_, lints)) =
+  Just $ T.concat (mapMaybe showHint lints)
   where
     -- TODO: make the "log level" configurable
     showHint hint = case lintLevel hint of