From 68af04a4da6ba4ec61d1469337ce53457526d861 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 23 Sep 2021 04:34:02 +0200
Subject: prettier pretty printing and stuff

also, configurable log level, which only required relaxing the type
system once!
---
 lib/LintWriter.hs | 16 +++++++++++-----
 1 file changed, 11 insertions(+), 5 deletions(-)

(limited to 'lib/LintWriter.hs')

diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs
index 5ff56bd..e704a3c 100644
--- a/lib/LintWriter.hs
+++ b/lib/LintWriter.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE DeriveAnyClass    #-}
 {-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE NamedFieldPuns    #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -41,17 +43,21 @@ newtype LintResult ctxt = LintResult (LintResult' ctxt)
 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"
+instance PrettyPrint ctxt => PrettyPrint (Level, LintResult ctxt) where
+  prettyprint (level, LintResult (ctxt, res)) =
+    T.concat $ map ((<> context) . prettyprint) (filterLintLevel level res)
+    where context = " (" <> prettyprint ctxt <> ")\n"
 
 lintToDep :: Lint -> Maybe Dep
 lintToDep = \case
   Depends dep -> Just dep
   _           -> Nothing
 
+filterLintLevel :: Level -> [Lint] -> [Lint]
+filterLintLevel level = mapMaybe $ \l -> if level <= lintLevel l
+  then Just l
+  else Nothing
+
 resultToDeps :: LintResult a -> [Dep]
 resultToDeps (LintResult a) = mapMaybe lintToDep $ snd a
 
-- 
cgit v1.2.3