1 files changed, 56 insertions, 48 deletions

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