From 79fc1bd6a51a97b905b1f15c6b74c0a8062aaa89 Mon Sep 17 00:00:00 2001 From: Ben Sima 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/Bild.hs | 45 ++++++++++++++++++++++++++++----------------- Biz/Bild/Deps/Haskell.nix | 1 + Biz/Lint.hs | 44 +++++++++++++++++++++++++++++--------------- 3 files changed, 58 insertions(+), 32 deletions(-) diff --git a/Biz/Bild.hs b/Biz/Bild.hs index 721da46..9c341b9 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -9,6 +9,9 @@ -- : out bild -- : dep docopt -- : dep regex-applicative +-- : dep rainbow +-- : dep tasty +-- : dep tasty-hunit -- -- == Design constraints -- @@ -125,6 +128,7 @@ import qualified Data.Char as Char import qualified Data.List as List import qualified Data.String as String import qualified Data.Text as Text +import Rainbow (chunk, fore, green, putChunkLn, red) import qualified System.Directory as Dir import qualified System.Environment as Env import System.FilePath (()) @@ -289,10 +293,10 @@ build andTest target@Target {..} = do root <- Env.getEnv "BIZ_ROOT" case compiler of GhcExe -> do - putStrLn <| "bild: dev: ghc-exe: " <> Namespace.toPath namespace + putStrLn <| "bild: dev: ghc-exe: " <> Namespace.toPath namespace let outDir = root "_/bild/dev/bin" Dir.createDirectoryIfMissing True outDir - putText <| "bild: dev: bilder: " <> Text.pack builder + putText <| "bild: dev: bilder: " <> Text.pack builder Process.callProcess "ghc" [ "-Werror", @@ -309,11 +313,12 @@ build andTest target@Target {..} = do outDir out ] when andTest <| do - putStrLn <| "bild: dev: test: " <> Namespace.toPath namespace + putStrLn <| "bild: dev: test: " <> Namespace.toPath namespace Process.callProcess (outDir out) ["test"] + putChunkLn <| fore green <| "bilt: " <> nschunk namespace GhcLib -> do - putStrLn <| "bild: dev: ghc-lib: " <> Namespace.toPath namespace - putText <| "bild: dev: bilder: " <> Text.pack builder + putStrLn <| "bild: dev: ghc-lib: " <> Namespace.toPath namespace + putText <| "bild: dev: bilder: " <> Text.pack builder Process.callProcess "ghc" [ "-Werror", @@ -325,11 +330,12 @@ build andTest target@Target {..} = do "--make", path ] + putChunkLn <| fore green <| "bilt: " <> nschunk namespace GhcjsExe -> do - putStrLn <| "bild: dev: ghcjs-exe: " <> Namespace.toPath namespace + putStrLn <| "bild: dev: ghcjs-exe: " <> Namespace.toPath namespace let outDir = root "_/bild/dev/static" Dir.createDirectoryIfMissing True outDir - putText <| "bild: dev: local: " <> Text.pack builder + putText <| "bild: dev: local: " <> Text.pack builder Process.callProcess "ghcjs" [ "-Werror", @@ -345,9 +351,10 @@ build andTest target@Target {..} = do "-o", outDir out ] + putChunkLn <| fore green <| "bilt: " <> nschunk namespace GhcjsLib -> do - putStrLn <| "bild: dev: ghcjs-lib: " <> Namespace.toPath namespace - putText <| "bild: dev: local: " <> Text.pack builder + putStrLn <| "bild: dev: ghcjs-lib: " <> Namespace.toPath namespace + putText <| "bild: dev: local: " <> Text.pack builder Process.callProcess "ghcjs" [ "-Werror", @@ -359,18 +366,19 @@ build andTest target@Target {..} = do "--make", path ] + putChunkLn <| fore green <| "bilt: " <> nschunk namespace Guile -> do - putStrLn <| "bild: dev: guile: " <> Namespace.toPath namespace - putText <| "bild: dev: local: " <> Text.pack builder - putText "bild: guile TODO" + putStrLn <| "bild: dev: guile: " <> Namespace.toPath namespace + putText <| "bild: dev: local: " <> Text.pack builder + putText "bild: guile: TODO" putText <| show target NixBuild -> do - putStrLn <| "bild: nix: " <> Namespace.toPath namespace + putStrLn <| "bild: nix: " <> Namespace.toPath namespace let outDir = root "_/bild/nix" Dir.createDirectoryIfMissing True outDir if null builder - then putText <| "bild: nix: local" - else putText <| "bild: nix: remote: " <> Text.pack builder + then putText <| "bild: nix: local" + else putText <| "bild: nix: remote: " <> Text.pack builder Process.callProcess "nix-build" [ path, @@ -391,11 +399,14 @@ build andTest target@Target {..} = do "--builders", builder ] + putChunkLn <| fore green <| "bilt: " <> nschunk namespace Copy -> do - putStrLn <| "bild: copy: " <> Namespace.toPath namespace - putText "bild: copy TODO" + putStrLn <| "bild: copy: " <> Namespace.toPath namespace + putText "bild: copy: TODO" putText <| show target +nschunk = chunk <. Text.pack <. Namespace.toPath + metaDep :: Regex.RE Char Dep metaDep = Regex.string "-- : dep " *> Regex.many (Regex.psym Char.isAlpha) diff --git a/Biz/Bild/Deps/Haskell.nix b/Biz/Bild/Deps/Haskell.nix index 13d952d..c08e353 100644 --- a/Biz/Bild/Deps/Haskell.nix +++ b/Biz/Bild/Deps/Haskell.nix @@ -35,6 +35,7 @@ with hpkgs; process protolude quickcheck-instances + rainbow random regex-applicative req 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 [...] |] @@ -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