From ffe3fd8a719be8d02b03bac6bc8232a7bc9fa692 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Tue, 22 Aug 2023 17:15:50 -0400 Subject: 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. --- Biz/Lint.hs | 104 ++++++++++++++++++++++++++++++++---------------------------- 1 file changed, 56 insertions(+), 48 deletions(-) (limited to 'Biz/Lint.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 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 -- cgit v1.2.3