From 6c72ee7b29b5b69e93854fde67cbc7a53f998ed7 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Tue, 26 Jan 2021 19:54:06 -0500
Subject: Refactor lint

- print results sequentially instead of all at once at the end
- don't try and run all linters concurrently
- filter out directories (can't lint those)
---
 Biz/Lint.hs | 44 ++++++++++++++++++++++++--------------------
 1 file changed, 24 insertions(+), 20 deletions(-)

(limited to 'Biz')

diff --git a/Biz/Lint.hs b/Biz/Lint.hs
index 26d4e6d..8689308 100644
--- a/Biz/Lint.hs
+++ b/Biz/Lint.hs
@@ -4,7 +4,6 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 
 -- : out lint
--- : dep async
 -- : dep rainbow
 -- : dep regex-applicative
 module Biz.Lint (main) where
@@ -16,7 +15,6 @@ import Biz.Namespace (Ext (..), Namespace (..))
 import qualified Biz.Namespace as Namespace
 import Biz.Test ((@=?))
 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 qualified System.Directory as Directory
@@ -30,8 +28,13 @@ main = Cli.main <| Cli.Plan help move test
 
 move :: Cli.Arguments -> IO ()
 move args = case Cli.getAllArgs args (Cli.argument "file") of
-  [] -> changedFiles >>= run >>= mapM printResult >>= exit
-  files -> run (filter notcab files) >>= mapM printResult >>= exit
+  [] -> changedFiles >>= run >>= exit
+  files ->
+    files
+      |> filter notcab
+      /> filterM Directory.doesFileExist
+      >>= run
+      >>= exit
 
 test :: Test.Tree
 test =
@@ -60,7 +63,6 @@ exit :: [Result] -> IO ()
 exit results = Exit.exitWith <| if n > 0 then Exit.ExitFailure n else Exit.ExitSuccess
   where
     n = length <| filter bad results
-    -- we print errors in red, but don't count them as "bad"
     bad (Warn _) = False
     bad Ok {status = Bad _} = True
     bad _ = False
@@ -104,23 +106,25 @@ run :: [FilePath] -> IO [Result]
 run paths = do
   cwd <- Directory.getCurrentDirectory
   root <- Environment.getEnv "BIZ_ROOT"
-  concat </ Async.mapConcurrently (runOne root cwd) paths
+  concat </ mapM (runOne root cwd) paths
 
 runOne :: FilePath -> FilePath -> FilePath -> IO [Result]
-runOne root cwd path_ =
-  sequence <| case Namespace.fromPath root (cwd </> path_) of
-    Nothing -> [pure <. Warn <| "could not get namespace for " <> Text.pack path_]
-    Just (Namespace _ Hs) ->
-      [ lint "ormolu" ["--mode", "check"] path_,
-        lint "hlint" [] path_
-      ]
-    Just (Namespace _ Py) ->
-      [ lint "pylint" ["--disable=invalid-name"] path_
-      ]
-    Just (Namespace _ Sh) -> [pure <| NoOp path_] -- [lint "shellcheck" [] path_]
-    Just (Namespace _ Nix) -> [pure <| NoOp path_]
-    Just (Namespace _ Scm) -> [pure <| NoOp path_]
-    Just _ -> [pure <. Warn <| "no linter for " <> Text.pack path_]
+runOne root cwd path_ = results >>= mapM_ printResult >> results
+  where
+    results =
+      sequence <| case Namespace.fromPath root (cwd </> path_) of
+        Nothing -> [pure <. Warn <| "could not get namespace for " <> Text.pack path_]
+        Just (Namespace _ Hs) ->
+          [ lint "ormolu" ["--mode", "check"] path_,
+            lint "hlint" [] path_
+          ]
+        Just (Namespace _ Py) ->
+          [ lint "pylint" ["--disable=invalid-name"] path_
+          ]
+        Just (Namespace _ Sh) -> [pure <| NoOp path_] -- [lint "shellcheck" [] path_]
+        Just (Namespace _ Nix) -> [pure <| NoOp path_]
+        Just (Namespace _ Scm) -> [pure <| NoOp path_]
+        Just _ -> [pure <. Warn <| "no linter for " <> Text.pack path_]
 
 lint :: Linter -> [String] -> FilePath -> IO Result
 lint bin args path_ =
-- 
cgit v1.2.3