From c00cbeaa5e8be56d5dcbd2cfcc3140a5e8d749a2 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Wed, 17 Feb 2021 21:34:16 -0500
Subject: Add lint --fix feature

---
 Biz/Lint.hs | 97 +++++++++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 68 insertions(+), 29 deletions(-)

diff --git a/Biz/Lint.hs b/Biz/Lint.hs
index d708c45..17edb37 100644
--- a/Biz/Lint.hs
+++ b/Biz/Lint.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
 -- : out lint
@@ -15,6 +16,7 @@ import Biz.Namespace (Ext (..), Namespace (..))
 import qualified Biz.Namespace as Namespace
 import Biz.Test ((@=?))
 import qualified Biz.Test as Test
+import Data.Maybe (fromJust)
 import qualified Data.String as String
 import qualified Data.Text as Text
 import qualified System.Directory as Directory
@@ -28,20 +30,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 +> exit
+  [] -> changedFiles +> run shouldFix +> exit
   files ->
     files
       |> filter notcab
       |> filterM Directory.doesFileExist
-      +> run
+      +> run shouldFix
       +> exit
+  where
+    shouldFix = Cli.has args (Cli.longOption "fix")
 
 test :: Test.Tree
 test =
   Test.group
     "Biz.Lint"
     [ Test.unit "haskell files return two Results" <| do
-        results <- run ["Biz/Lint.hs"]
+        results <- run False ["Biz/Lint.hs"]
         length results @=? 2
     ]
 
@@ -52,29 +56,31 @@ notcab _ = True
 help :: Cli.Docopt
 help =
   [Cli.docopt|
-lint
+all your lint are belong to us
 
 Usage:
+  lint --help
   lint test
-  lint [<file>...]
+  lint [--fix] [<file>...]
 |]
 
 exit :: [Result] -> IO ()
 exit results = Exit.exitWith <| if n > 0 then Exit.ExitFailure n else Exit.ExitSuccess
   where
     n = length <| filter bad results
-    bad (Warn _) = False
-    bad Ok {status = Bad _} = True
-    bad _ = False
+    bad = \case
+      (Warn _) -> False
+      Ok {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", linter_, Text.pack path_]
+printResult r@(Ok path_ Linter {..} (Bad err)) =
+  Log.fail ["lint", exe, Text.pack path_]
     >> Log.br
     >> if err == "" then pure r else putText (Text.pack err) >> pure r
-printResult r@(Ok path_ linter_ Good) =
-  Log.good ["lint", linter_, Text.pack path_]
+printResult r@(Ok path_ Linter {..} Good) =
+  Log.good ["lint", exe, Text.pack path_]
     >> Log.br
     >> pure r
 printResult r@(NoOp path_) =
@@ -91,7 +97,36 @@ changedFiles = mergeBase +> changed
       String.lines
         </ git ["diff", "--name-only", "--diff-filter=d", mb]
 
-type Linter = Text
+data Linter = Linter
+  { exe :: Text,
+    args :: [Text],
+    fixArgs :: Maybe [Text]
+  }
+  deriving (Show)
+
+ormolu :: Linter
+ormolu =
+  Linter
+    { exe = "ormolu",
+      args = ["--mode", "check"],
+      fixArgs = Just ["--mode", "inplace"]
+    }
+
+hlint :: Linter
+hlint =
+  Linter
+    { exe = "hlint",
+      args = [],
+      fixArgs = Nothing
+    }
+
+pylint :: Linter
+pylint =
+  Linter
+    { exe = "pylint",
+      args = ["--disable=invalid-name"],
+      fixArgs = Nothing
+    }
 
 data Status = Good | Bad String
   deriving (Show)
@@ -102,33 +137,37 @@ data Result
   | NoOp FilePath
   deriving (Show)
 
-run :: [FilePath] -> IO [Result]
-run paths = do
+run :: Bool -> [FilePath] -> IO [Result]
+run shouldFix paths = do
   cwd <- Directory.getCurrentDirectory
   root <- Environment.getEnv "BIZ_ROOT"
-  concat </ traverse (runOne root cwd) paths
+  concat </ traverse (runOne shouldFix root cwd) paths
 
-runOne :: FilePath -> FilePath -> FilePath -> IO [Result]
-runOne root cwd path_ = results +> traverse_ printResult >> results
+runOne :: Bool -> FilePath -> FilePath -> FilePath -> IO [Result]
+runOne shouldFix 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 "ormolu" ["--mode", "check"] path_,
-            lint "hlint" [] path_
-          ]
-        Just (Namespace _ Py) ->
-          [ lint "pylint" ["--disable=invalid-name"] path_
+          [ lint shouldFix ormolu path_,
+            lint shouldFix hlint path_
           ]
+        Just (Namespace _ Py) -> [lint shouldFix pylint 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_ =
-  Process.readProcessWithExitCode (Text.unpack bin) (args ++ [path_]) "" +> \case
-    (Exit.ExitSuccess, _, _) -> pure <| Ok path_ bin Good
-    (Exit.ExitFailure _, msg, _) ->
-      pure <| Ok path_ bin <| Bad msg
+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
+  where
+    args_ = map Text.unpack <| if shouldFix && isJust fixArgs then fromJust fixArgs else args
-- 
cgit v1.2.3