From c6be6366d6411d7b0b53fd8879537a33fefd5a88 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Mon, 20 Sep 2021 23:03:56 +0200
Subject: use PrettyPrinter more

---
 lib/CheckMap.hs   | 24 +++---------------------
 lib/LintWriter.hs | 12 +++++++++---
 lib/Properties.hs |  7 +++----
 lib/Util.hs       |  6 +++++-
 4 files changed, 20 insertions(+), 29 deletions(-)

diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 3966988..c03197c 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -5,7 +5,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 -- | Module that contains the high-level checking functions
-{-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-}
 module CheckMap (loadAndLintMap) where
 
 import           Data.Aeson   (ToJSON)
@@ -22,7 +21,7 @@ import           LintWriter   (LintResult (..), LintWriter, askContext,
 import           Properties   (checkLayerProperty, checkMap)
 import           Tiled2       (Layer (layerName, layerProperties),
                                Tiledmap (tiledmapLayers), loadTiledmap)
-import           Types        (Dep, Level (..), Lint (..), hint, lintLevel)
+import           Types        (Dep, Level (..), Lint (..), hint)
 import           Util         (PrettyPrint (prettyprint), prettyprint)
 
 
@@ -81,26 +80,9 @@ instance PrettyPrint a => PrettyPrint (MapResult a) where
     where
       -- TODO: this can be simplified further
       prettyLayer :: [Text]
-      prettyLayer = mapMaybe
-        (uncurry showResult)
+      prettyLayer = map
+        (prettyprint . snd)
         (maybe [] toList . mapresultLayer $ mapResult)
       prettyGeneral :: [Text]
       prettyGeneral = flip (<>) "\n" . prettyprint <$> mapresultGeneral mapResult
 
-
--- TODO: possibly expand this to something more detailed?
-showContext :: Text -> Text
-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 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
-      Info -> Nothing
-      _    -> Just $ prettyprint hint <> ctxtHint
-    ctxtHint = showContext ctxt
diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs
index de7d314..5ff56bd 100644
--- a/lib/LintWriter.hs
+++ b/lib/LintWriter.hs
@@ -14,12 +14,12 @@ import           Control.Monad.Writer       (MonadWriter (tell), WriterT,
 import           Data.Aeson                 (ToJSON (toJSON))
 import           Data.Text                  (Text)
 
-import           Control.Monad.Reader       (local)
 import           Control.Monad.Trans.Reader (Reader, asks, runReader)
 import           Control.Monad.Writer.Lazy  (lift)
 import           Data.Maybe                 (mapMaybe)
-import           GHC.Generics               (Generic)
+import qualified Data.Text                  as T
 import           Types
+import           Util                       (PrettyPrint (..))
 
 
 -- | for now, all context we have is how "deep" in the directory tree
@@ -38,9 +38,15 @@ newtype LintResult ctxt = LintResult (LintResult' ctxt)
 -- 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.
-instance ToJSON a => ToJSON (LintResult a) where
+instance ToJSON (LintResult a) where
   toJSON (LintResult res) = toJSON $ snd res
 
+instance PrettyPrint ctxt => PrettyPrint (LintResult ctxt) where
+  prettyprint (LintResult (ctxt, res)) =
+    T.concat (map showHint res)
+    where showHint hint = prettyprint hint <> context
+          context = " (" <> prettyprint ctxt <> ")\n"
+
 lintToDep :: Lint -> Maybe Dep
 lintToDep = \case
   Depends dep -> Just dep
diff --git a/lib/Properties.hs b/lib/Properties.hs
index 818378a..011b5ca 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -13,8 +13,8 @@ import           Tiled2        (Layer (..), Property (..), PropertyValue (..),
 import           Util          (layerIsEmpty, prettyprint)
 
 import           LintWriter    (LintWriter, askContext, askFileDepth, complain,
-                                dependsOn, forbid, info, suggest, warn)
-import           Paths
+                                dependsOn, forbid, suggest, warn)
+import           Paths         (RelPath (..), parsePath)
 import           Types         (Dep (Link, Local, LocalMap, MapLink))
 
 
@@ -88,8 +88,7 @@ checkLayerProperty :: Property -> LintWriter Layer
 checkLayerProperty p@(Property name _value) = case name of
     "jitsiRoom" -> do
       uselessEmptyLayer
-      unwrapString p $ \val -> do
-        info $ "found jitsi room: " <> prettyprint val
+      unwrapString p $ \_val -> do
         suggestProperty $ Property "jitsiTrigger" (StrProp "onaction")
     "jitsiTrigger" -> do
       isString p
diff --git a/lib/Util.hs b/lib/Util.hs
index 5cf27e3..47ee7f2 100644
--- a/lib/Util.hs
+++ b/lib/Util.hs
@@ -9,7 +9,8 @@ module Util where
 import           Data.Aeson as Aeson
 import           Data.Text  (Text)
 import qualified Data.Text  as T
-import           Tiled2     (Layer (layerData), PropertyValue (..), mkTiledId)
+import           Tiled2     (Layer (layerData), PropertyValue (..), layerName,
+                             mkTiledId)
 
 -- | haskell's many string types are FUN …
 showText :: Show a => a -> Text
@@ -39,6 +40,9 @@ instance PrettyPrint PropertyValue where
 instance PrettyPrint () where
   prettyprint _ = error "shouldn't pretty-print Unit"
 
+instance PrettyPrint Layer where
+  prettyprint = (<>) "layer " . layerName
+
 printPretty :: PrettyPrint a => a -> IO ()
 printPretty = putStr . T.unpack . prettyprint
 
-- 
cgit v1.2.3