Lint faster by grouping files by extension

Previously I would lint every file individually, in serial. This took
forever. Now I group the files by extension (by first getting the Namespace) and
run each linter on all relevant files at once. This is so much faster its
stupid.

Also I added formatters back into the dev env because my editor needs them to
autoformat.

4 files changed, 67 insertions, 51 deletions

diff --git a/Biz/Bild.nix b/Biz/Bild.nix
index 9017f17..b12b87a 100644
--- a/Biz/Bild.nix
+++ b/Biz/Bild.nix
@@ -123,12 +123,14 @@ in nixpkgs // { bild = rec {
     # this should just be dev tools
     buildInputs = with nixpkgs.pkgs; [
       bild
+      black
       ctags
       figlet
       git
       gitlint
       lolcat
       nixpkgs.haskell.packages.${constants.ghcCompiler}.fast-tags
+      ormolu
       wemux
     ];
     shellHook = ''
diff --git a/Biz/Ide/repl b/Biz/Ide/repl
index cf0378d..1d94e47 100755
--- a/Biz/Ide/repl
+++ b/Biz/Ide/repl
@@ -32,12 +32,12 @@ fi
   packageSet=$(jq --raw-output '.[].packageSet' <<< $json)
   BILD="(import ${BIZ_ROOT:?}/Biz/Bild.nix {})"
   for lib in ${sysdeps[@]}; do
-    flags+=(--packages "$BILD.private.nixpkgs.${lib}")
-    flags+=(--packages "$BILD.private.nixpkgs.pkg-config")
+    flags+=(--packages "$BILD.pkgs.${lib}")
+    flags+=(--packages "$BILD.pkgs.pkg-config")
   done
   case $exts in
     C)
-      flags+=(--packages "$BILD.private.nixpkgs.gcc")
+      flags+=(--packages "$BILD.pkgs.gcc")
       command="bash"
       ;;
     Hs)
diff --git a/Biz/Lint.hs b/Biz/Lint.hs
index 2742fae..1fb04b0 100644
--- a/Biz/Lint.hs
+++ b/Biz/Lint.hs
@@ -25,35 +25,48 @@ import Biz.Namespace (Ext (..), Namespace (..))
 import qualified Biz.Namespace as Namespace
 import Biz.Test ((@=?))
 import qualified Biz.Test as Test
+import qualified Data.Map as Map
 import qualified Data.String as String
 import qualified Data.Text as Text
 import qualified System.Directory as Directory
 import qualified System.Environment as Environment
 import qualified System.Exit as Exit
-import System.FilePath ((</>))
 import qualified System.Process as Process
 
 main :: IO ()
 main = Cli.main <| Cli.Plan help move test pure
 
 move :: Cli.Arguments -> IO ()
-move args = case Cli.getAllArgs args (Cli.argument "file") of
-  [] -> changedFiles +> run mode +> exit
-  files ->
-    files
-      |> filter (not <. Namespace.isCab)
-      |> filterM Directory.doesFileExist
-      +> run mode
-      +> exit
+move args =
+  Environment.getEnv "BIZ_ROOT" +> \root ->
+    case Cli.getAllArgs args (Cli.argument "file") of
+      [] ->
+        changedFiles
+          +> traverse Directory.makeAbsolute
+          /> map (Namespace.fromPath root)
+          /> catMaybes
+          /> Namespace.groupByExt
+          +> run mode
+          +> exit
+      files ->
+        files
+          |> filter (not <. Namespace.isCab)
+          |> traverse Directory.makeAbsolute
+          +> filterM Directory.doesFileExist
+          /> map (Namespace.fromPath root)
+          /> catMaybes
+          /> Namespace.groupByExt
+          +> run mode
+          +> exit
   where
-    mode = if Cli.has args (Cli.longOption "fix") then Fix else Check
+    mode = args `Cli.has` Cli.longOption "fix" ?: (Fix, Check)
 
 test :: Test.Tree
 test =
   Test.group
     "Biz.Lint"
     [ Test.unit "haskell files return two Results" <| do
-        results <- run Check ["Biz/Lint.hs"]
+        results <- run Check <| Map.singleton Hs <| [Namespace ["Biz", "Lint"] Hs]
         length results @=? 2
     ]
 
@@ -74,21 +87,21 @@ exit results = Exit.exitWith <| if n > 0 then Exit.ExitFailure n else Exit.ExitS
     n = length <| filter bad results
     bad = \case
       (Warn _) -> False
-      Ok {status = Bad _} -> True
+      Done {status = Bad _} -> True
       _ -> False
 
 printResult :: Result -> IO Result
 printResult r@(Warn err) = Log.warn ["lint", err] >> Log.br >> pure r
-printResult r@(Ok path_ Linter {..} (Bad err)) =
-  Log.fail ["lint", exe, Text.pack path_]
+printResult r@(Done Linter {..} (Bad err)) =
+  Log.fail ["lint", exe]
     >> Log.br
     >> if err == "" then pure r else putText (Text.pack err) >> pure r
-printResult r@(Ok path_ Linter {..} Good) =
-  Log.good ["lint", exe, Text.pack path_]
+printResult r@(Done Linter {..} Good) =
+  Log.good ["lint", exe]
     >> Log.br
     >> pure r
-printResult r@(NoOp path_) =
-  Log.info ["lint", "noop", Text.pack path_]
+printResult r@(NoOp ext) =
+  Log.info ["lint", "noop", show ext]
     >> pure r
 
 changedFiles :: IO [FilePath]
@@ -169,46 +182,41 @@ data Status = Good | Bad String
   deriving (Show)
 
 data Result
-  = Ok {path :: FilePath, linter :: Linter, status :: Status}
+  = Done {linter :: Linter, status :: Status}
   | Warn Text
-  | NoOp FilePath
+  | NoOp Namespace.Ext
   deriving (Show)
 
-run :: Mode -> [FilePath] -> IO [Result]
-run mode paths = do
-  cwd <- Directory.getCurrentDirectory
-  root <- Environment.getEnv "BIZ_ROOT"
-  concat </ traverse (runOne mode root cwd) paths
+run :: Mode -> Map Namespace.Ext [Namespace] -> IO [Result]
+run mode nsmap = nsmap |> Map.assocs |> traverse (runOne mode) /> concat
 
-runOne :: Mode -> FilePath -> FilePath -> FilePath -> IO [Result]
-runOne mode root cwd path_ = results +> traverse_ printResult >> results
+runOne :: Mode -> (Ext, [Namespace]) -> IO [Result]
+runOne mode (ext, ns's) = results +> traverse_ 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 mode ormolu path_,
-            lint mode hlint path_
+      sequence <| case ext of
+        Namespace.Hs ->
+          [ lint mode ormolu ns's,
+            lint mode hlint ns's
           ]
-        Just (Namespace _ Py) ->
-          [ lint mode black path_,
-            lint mode ruff path_
+        Namespace.Py ->
+          [ lint mode black ns's,
+            lint mode ruff ns's
           ]
-        Just (Namespace _ Sh) -> [lint mode shellcheck path_]
-        Just (Namespace _ Nix) -> [lint mode deadnix path_]
-        Just (Namespace _ Scm) -> [pure <| NoOp path_]
-        Just (Namespace _ C) -> [lint mode indent path_]
-        Just _ -> [pure <. Warn <| "no linter for " <> Text.pack path_]
-
-lint :: Mode -> Linter -> FilePath -> IO Result
-lint mode linter@Linter {..} path_ =
+        Namespace.Sh -> [lint mode shellcheck ns's]
+        Namespace.Nix -> [lint mode deadnix ns's]
+        Namespace.C -> [lint mode indent ns's]
+        _ -> [pure <. Warn <| "no linter for " <> show ext]
+
+lint :: Mode -> Linter -> [Namespace] -> IO Result
+lint mode linter@Linter {..} ns's =
   Process.readProcessWithExitCode (Text.unpack exe) args "" /> \case
     (Exit.ExitSuccess, _, _) ->
-      Ok path_ linter Good
+      Done linter Good
     (Exit.ExitFailure _, msg, _) ->
-      Ok path_ linter <| Bad msg
+      Done linter <| Bad msg
   where
     args = case (mode, fixArgs) of
-      (Fix, Just args_) -> map Text.unpack args_ ++ [path_]
-      (Fix, Nothing) -> [path_]
-      (Check, _) -> map Text.unpack checkArgs ++ [path_]
+      (Fix, Just args_) -> map Text.unpack args_ ++ map Namespace.toPath ns's
+      (Fix, Nothing) -> map Namespace.toPath ns's
+      (Check, _) -> map Text.unpack checkArgs ++ map Namespace.toPath ns's
diff --git a/Biz/Namespace.hs b/Biz/Namespace.hs
index 6d099fd..9621186 100644
--- a/Biz/Namespace.hs
+++ b/Biz/Namespace.hs
@@ -15,6 +15,7 @@ module Biz.Namespace
     toHaskellModule,
     toSchemeModule,
     isCab,
+    groupByExt,
   )
 where
 
@@ -24,6 +25,7 @@ import qualified Data.Aeson.Types as Aeson
 import qualified Data.Char as Char
 import qualified Data.List as List
 import qualified Data.List.Split as List
+import qualified Data.Map as Map
 import qualified Data.Text as Text
 import qualified Text.Regex.Applicative as Regex
 
@@ -134,3 +136,7 @@ reExt =
 isCab :: FilePath -> Bool
 isCab ('_' : _) = True
 isCab fp = "/_/" `List.isInfixOf` fp
+
+-- | Group a list of Namespaces keyed by their extensions
+groupByExt :: [Namespace] -> Map Ext [Namespace]
+groupByExt ns's = Map.fromListWith (++) [(ext ns, [ns]) | ns <- ns's]