From c6be6366d6411d7b0b53fd8879537a33fefd5a88 Mon Sep 17 00:00:00 2001
From: stuebinm <stuebinm@disroot.org>
Date: Mon, 20 Sep 2021 23:03:56 +0200
Subject: [PATCH] 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
--
GitLab