From 79fc1bd6a51a97b905b1f15c6b74c0a8062aaa89 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Sat, 16 Jan 2021 05:19:10 -0500
Subject: Add colors to tooling outputs

This makes scanning logs *much* easier. I figure keep it as simple as possible,
just red, yellow, and green.

I also added two spaces between labels in the log messages. It would be nice to
have a more structured logging system, but for now this works.
---
 Biz/Lint.hs | 44 +++++++++++++++++++++++++++++---------------
 1 file changed, 29 insertions(+), 15 deletions(-)

(limited to 'Biz/Lint.hs')

diff --git a/Biz/Lint.hs b/Biz/Lint.hs
index bf7fa09..ccbb393 100644
--- a/Biz/Lint.hs
+++ b/Biz/Lint.hs
@@ -5,6 +5,7 @@
 
 -- : out lint
 -- : dep async
+-- : dep rainbow
 -- : dep regex-applicative
 module Biz.Lint (main) where
 
@@ -17,6 +18,7 @@ import qualified Biz.Test as Test
 import qualified Control.Concurrent.Async as Async
 import qualified Data.String as String
 import qualified Data.Text as Text
+import Rainbow (chunk, fore, green, putChunkLn, red, yellow)
 import qualified System.Directory as Directory
 import qualified System.Environment as Environment
 import qualified System.Exit as Exit
@@ -27,14 +29,12 @@ main :: IO ()
 main = Cli.main <| Cli.Plan help move test
 
 move :: Cli.Arguments -> IO ()
-move args =
-  (return <| Cli.getAllArgs args (Cli.argument "file"))
-    >>= \case
-      [] -> changedFiles >>= run >>= mapM printResult >>= exit
-      files -> run (filter notcab files) >>= mapM printResult >>= exit
+move args = case Cli.getAllArgs args (Cli.argument "file") of
+  [] -> changedFiles >>= run >>= mapM printResult >>= exit
+  files -> run (filter notcab files) >>= mapM printResult >>= exit
 
 test :: Test.Tree
-test = Test.group "Biz.Bild" [Test.unit "id" <| 1 @=? 1]
+test = Test.group "Biz.Lint" [Test.unit "id" <| 1 @=? 1]
 
 notcab :: FilePath -> Bool
 notcab ('_' : _) = False
@@ -46,6 +46,7 @@ help =
 lint
 
 Usage:
+  lint test
   lint [<file>...]
 |]
 
@@ -53,19 +54,32 @@ exit :: [Result] -> IO ()
 exit results = Exit.exitWith <| if n > 0 then Exit.ExitFailure n else Exit.ExitSuccess
   where
     n = length <| filter bad results
-    bad (Error _) = False
+    -- we print errors in red, but don't count them as "bad"
+    bad (Warn _) = False
     bad Ok {status = Bad _} = True
     bad _ = False
 
+schunk = chunk <. Text.pack
+
 printResult :: Result -> IO Result
--- printResult r@(Error err) = (putText <| "lint: error: " <> err) >> pure r
-printResult r@(Error _) = pure r
+printResult r@(Warn err) =
+  (putChunkLn <| fore yellow <| "lint:  warn:  " <> chunk err) >> pure r
 printResult r@(Ok path_ linter_ (Bad err)) =
-  (putText <| "lint: badd: " <> Text.pack linter_ <> ": " <> Text.pack path_)
+  ( putChunkLn <| fore red <| "lint:  baad:  "
+      <> schunk linter_
+      <> ": "
+      <> schunk path_
+  )
     >> if err == "" then pure r else putText (Text.pack err) >> pure r
-printResult r@(Ok _ _ Good) = pure r
+printResult r@(Ok path_ linter_ Good) =
+  ( putChunkLn <| fore green <| "lint:  good:  "
+      <> schunk linter_
+      <> ":  "
+      <> schunk path_
+  )
+    >> pure r
 printResult r@(NoOp path_) =
-  (putText <| "lint: noop: " <> Text.pack path_)
+  (putText <| "lint:  noop:  " <> Text.pack path_)
     >> pure r
 
 changedFiles :: IO [FilePath]
@@ -84,7 +98,7 @@ data Status = Good | Bad String
 
 data Result
   = Ok {path :: FilePath, linter :: Linter, status :: Status}
-  | Error Text
+  | Warn Text
   | NoOp FilePath
   deriving (Show)
 
@@ -97,7 +111,7 @@ run paths = do
 runOne :: FilePath -> FilePath -> FilePath -> IO [Result]
 runOne root cwd path_ =
   sequence <| case Namespace.fromPath root (cwd </> path_) of
-    Nothing -> [pure <. Error <| "could not get namespace for " <> Text.pack path_]
+    Nothing -> [pure <. Warn <| "could not get namespace for " <> Text.pack path_]
     Just (Namespace _ Hs) ->
       [ lint "ormolu" ["--mode", "check"] path_,
         lint "hlint" [] path_
@@ -108,7 +122,7 @@ runOne root cwd path_ =
     Just (Namespace _ Sh) -> [pure <| NoOp path_] -- [lint "shellcheck" [] path_]
     Just (Namespace _ Nix) -> [pure <| NoOp path_]
     Just (Namespace _ Scm) -> [pure <| NoOp path_]
-    Just _ -> [pure <. Error <| "no linter for " <> Text.pack path_]
+    Just _ -> [pure <. Warn <| "no linter for " <> Text.pack path_]
 
 lint :: Linter -> [String] -> FilePath -> IO Result
 lint bin args path_ =
-- 
cgit v1.2.3