diff options
| -rw-r--r-- | Biz/Lint.hs | 97 |
1 files 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 |