tame the strings

Adds a PrettyPrint typeclass which operates on Text and should replace
Show, since constantly converting strings from linked lists to arrays
seems somewhat silly.

1 files changed, 16 insertions, 17 deletions

diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 97e6a8c..0ff3fae 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -22,7 +22,7 @@ import           Properties                 (checkProperty)
 import           Tiled2                     (Layer (layerName, layerProperties),
                                              Tiledmap (tiledmapLayers),
                                              loadTiledmap)
-import           Util                       (showText)
+import           Util                       (prettyprint, PrettyPrint (prettyprint))
 
 -- | What this linter produces: lints for a single map
 data MapResult a = MapResult
@@ -61,35 +61,34 @@ checkLayer :: Layer -> LintWriter ()
 checkLayer layer =
   mapM_ (checkProperty layer) (layerProperties layer)
 
-
--- this instance of show produces a reasonably human-readable
--- list of lints that can be shown e.g. on a console
-instance Show a => Show (MapResult a) where
-  show mapResult = concat $ prettyGeneral <> prettyLayer
+-- human-readable lint output, e.g. for consoles
+instance PrettyPrint a => PrettyPrint (MapResult a) where
+  prettyprint mapResult = T.concat $ prettyGeneral <> prettyLayer
     where
       -- TODO: this can be simplified further
-      prettyLayer :: [String]
+      prettyLayer :: [Text]
       prettyLayer = mapMaybe
-        (\(name, lints) -> T.unpack <$> showResult name lints)
+        (uncurry showResult)
         (maybe [] toList . mapresultLayer $ mapResult)
-      prettyGeneral :: [String]
-      prettyGeneral = show <$> mapresultGeneral mapResult
+      prettyGeneral :: [Text]
+      prettyGeneral = 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 Show since
+-- | 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 :: Show a => Text -> LintResult a -> Maybe Text
-showResult ctxt (LintResult (Left hint)) = Just $ "ERROR: " <> hintMsg hint <> showContext ctxt
-showResult _ (LintResult (Right (_, []))) = Nothing
-showResult ctxt (LintResult (Right (_, hints))) = Just $ T.concat (mapMaybe showHint hints)
+showResult :: Text -> LintResult a -> Maybe Text
+showResult ctxt (LintResult res) = case res of
+  Left hint -> Just $ "ERROR: " <> hintMsg hint <> showContext ctxt
+  Right (_, []) -> Nothing
+  Right (_, hints) -> Just $ T.concat (mapMaybe showHint hints)
   where
     -- TODO: make the "log level" configurable
-    showHint Hint { hintMsg, hintLevel } = case hintLevel of
+    showHint hint = case hintLevel hint of
       Info -> Nothing
-      _    -> Just $ showText hintLevel <> ": " <> hintMsg <> ctxtHint
+      _    -> Just $ prettyprint hint <> ctxtHint
     ctxtHint = showContext ctxt