summaryrefslogtreecommitdiff
path: root/Biz/Lint.hs
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2021-01-16 05:19:10 -0500
committerBen Sima <ben@bsima.me>2021-01-16 05:22:11 -0500
commit79fc1bd6a51a97b905b1f15c6b74c0a8062aaa89 (patch)
tree034488adbd9dabe199747b3a8fbbf3b610450d3d /Biz/Lint.hs
parentad89499b4e960044a4c894757dd2c500fe044759 (diff)
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.
Diffstat (limited to 'Biz/Lint.hs')
-rw-r--r--Biz/Lint.hs44
1 files changed, 29 insertions, 15 deletions
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_ =