diff options
Diffstat (limited to 'Biz/Lint.hs')
-rw-r--r-- | Biz/Lint.hs | 72 |
1 files changed, 40 insertions, 32 deletions
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_] |