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/CheckDir.hs | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

(limited to 'lib/CheckDir.hs')

diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs
index f551e6a..ab231b9 100644
--- a/lib/CheckDir.hs
+++ b/lib/CheckDir.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveAnyClass    #-}
 {-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TupleSections     #-}
@@ -21,7 +22,8 @@ import           Paths                 (normalise)
 import           System.FilePath       (splitPath, (</>))
 import qualified System.FilePath       as FP
 import           System.FilePath.Posix (takeDirectory)
-import           Types                 (Dep (LocalMap))
+import           Types                 (Dep (LocalMap), Hint (hintLevel),
+                                        Level (Info))
 import           Util                  (PrettyPrint (prettyprint))
 
 -- based on the startling observation that Data.Map has lower complexity
@@ -38,10 +40,13 @@ data DirResult = DirResult
   , dirresultDeps :: [Text]
   } deriving (Generic, ToJSON)
 
-
-instance PrettyPrint DirResult where
-  prettyprint res = T.concat
-    (map (\(p,lints) -> "\nin " <> T.pack p <> ":\n" <> prettyprint lints) $ M.toList $ dirresultMaps res)
+instance PrettyPrint (Level, DirResult) where
+  prettyprint (level, res) = T.concat
+    (map prettyLint $ M.toList $ dirresultMaps res)
+    where
+      prettyLint :: (FilePath, MapResult) -> Text
+      prettyLint (p, lint) =
+        "\nin " <> T.pack p <> ":\n" <> prettyprint (level, lint)
 
 instance Semigroup DirResult where
   a <> b = DirResult
@@ -70,7 +75,6 @@ recursiveCheckDir prefix root = recursiveCheckDir' prefix [root] mempty mempty
 -- like this seemed convenient at the time
 recursiveCheckDir' :: FilePath -> [FilePath] -> Set FilePath -> DirResult -> IO DirResult
 recursiveCheckDir' prefix paths done acc = do
-  putStrLn $ "linting " <> show paths
 
   -- lint all maps in paths
   lints <-
-- 
cgit v1.2.3