From f0e260d791b26e54acbacfbbdfc642ffb6951a85 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Tue, 5 Jul 2022 15:18:23 -0400
Subject: Add Mode type

Removes 'boolean blindness'. I also fixed the issue with hlint erroring on
`--fix` and clarified the `args` field.
---
 Biz/Lint.hs | 72 ++++++++++++++++++++++++++++++++++---------------------------
 1 file changed, 40 insertions(+), 32 deletions(-)

(limited to 'Biz')

diff --git a/Biz/Lint.hs b/Biz/Lint.hs
index 82e52cc..23a6834 100644
--- a/Biz/Lint.hs
+++ b/Biz/Lint.hs
@@ -14,8 +14,6 @@ import Biz.Namespace (Ext (..), Namespace (..))
 import qualified Biz.Namespace as Namespace
 import Biz.Test ((@=?))
 import qualified Biz.Test as Test
-import qualified Data.List as List
-import Data.Maybe (fromJust)
 import qualified Data.String as String
 import qualified Data.Text as Text
 import qualified System.Directory as Directory
@@ -29,22 +27,22 @@ 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 shouldFix +> exit
+  [] -> changedFiles +> run mode +> exit
   files ->
     files
       |> filter (not <. Namespace.isCab)
       |> filterM Directory.doesFileExist
-      +> run shouldFix
+      +> run mode
       +> exit
   where
-    shouldFix = Cli.has args (Cli.longOption "fix")
+    mode = if Cli.has args (Cli.longOption "fix") then Fix else Check
 
 test :: Test.Tree
 test =
   Test.group
     "Biz.Lint"
     [ Test.unit "haskell files return two Results" <| do
-        results <- run False ["Biz/Lint.hs"]
+        results <- run Check ["Biz/Lint.hs"]
         length results @=? 2
     ]
 
@@ -92,9 +90,17 @@ changedFiles =
   where
     git args = Process.readProcess "git" args ""
 
+data Mode
+  = -- | Just check the files and return an exit code.
+    Check
+  | -- | Fix the files in place, return 0 if successful, otherwise return 1.
+    Fix
+
 data Linter = Linter
   { exe :: Text,
-    args :: [Text],
+    -- | Arguments added when in the "check" mode.
+    checkArgs :: [Text],
+    -- | Arguments added when in the "fix" mode.
     fixArgs :: Maybe [Text]
   }
   deriving (Show)
@@ -103,7 +109,7 @@ ormolu :: Linter
 ormolu =
   Linter
     { exe = "ormolu",
-      args = ["--mode", "check"],
+      checkArgs = ["--mode", "check"],
       fixArgs = Just ["--mode", "inplace"]
     }
 
@@ -111,20 +117,22 @@ hlint :: Linter
 hlint =
   Linter
     { exe = "hlint",
-      args = [],
-      fixArgs = Just ["--refactor", "--refactor-options=-i"]
+      checkArgs = [],
+      -- needs apply-refact >0.9.1.0, which needs ghc >9
+      --fixArgs = Just ["--refactor", "--refactor-options=-i"]
+      fixArgs = Nothing
     }
 
 pylint :: Linter
 pylint =
   Linter
     { exe = "pylint",
-      args = ["--disable=invalid-name"],
+      checkArgs = ["--disable=invalid-name"],
       fixArgs = Nothing
     }
 
 shellcheck :: Linter
-shellcheck = Linter {exe = "shellcheck", args = [], fixArgs = Nothing}
+shellcheck = Linter {exe = "shellcheck", checkArgs = [], fixArgs = Nothing}
 
 data Status = Good | Bad String
   deriving (Show)
@@ -135,37 +143,37 @@ data Result
   | NoOp FilePath
   deriving (Show)
 
-run :: Bool -> [FilePath] -> IO [Result]
-run shouldFix paths = do
+run :: Mode -> [FilePath] -> IO [Result]
+run mode paths = do
   cwd <- Directory.getCurrentDirectory
   root <- Environment.getEnv "BIZ_ROOT"
-  concat </ traverse (runOne shouldFix root cwd) paths
+  concat </ traverse (runOne mode root cwd) paths
 
-runOne :: Bool -> FilePath -> FilePath -> FilePath -> IO [Result]
-runOne shouldFix root cwd path_ = results +> traverse_ printResult >> results
+runOne :: Mode -> FilePath -> FilePath -> FilePath -> IO [Result]
+runOne mode root cwd path_ = 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 shouldFix ormolu path_,
-            lint shouldFix hlint path_
+          [ lint mode ormolu path_,
+            lint mode hlint path_
           ]
-        Just (Namespace _ Py) -> [lint shouldFix pylint path_]
-        Just (Namespace _ Sh) -> [lint shouldFix shellcheck path_]
+        Just (Namespace _ Py) -> [lint mode pylint path_]
+        Just (Namespace _ Sh) -> [lint mode shellcheck path_]
         Just (Namespace _ Nix) -> [pure <| NoOp path_]
         Just (Namespace _ Scm) -> [pure <| NoOp path_]
         Just _ -> [pure <. Warn <| "no linter for " <> Text.pack path_]
 
-lint :: Bool -> Linter -> FilePath -> IO Result
-lint shouldFix linter@Linter {..} path_ =
-  Process.readProcessWithExitCode
-    (Text.unpack exe)
-    (args_ ++ [path_])
-    ""
-    +> \case
-      (Exit.ExitSuccess, _, _) -> pure <| Ok path_ linter Good
-      (Exit.ExitFailure _, msg, _) ->
-        pure <| Ok path_ linter <| Bad msg
+lint :: Mode -> Linter -> FilePath -> IO Result
+lint mode linter@Linter {..} path_ =
+  Process.readProcessWithExitCode (Text.unpack exe) args "" /> \case
+    (Exit.ExitSuccess, _, _) ->
+      Ok path_ linter Good
+    (Exit.ExitFailure _, msg, _) ->
+      Ok path_ linter <| Bad msg
   where
-    args_ = map Text.unpack <| if shouldFix && isJust fixArgs then fromJust fixArgs else args
+    args = case (mode, fixArgs) of
+      (Fix, Just args_) -> map Text.unpack args_ ++ [path_]
+      (Fix, Nothing) -> [path_]
+      (Check, _) -> map Text.unpack checkArgs ++ [path_]
-- 
cgit v1.2.3