summaryrefslogtreecommitdiff
path: root/lib/LintWriter.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/LintWriter.hs')
-rw-r--r--lib/LintWriter.hs16
1 files changed, 11 insertions, 5 deletions
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