summaryrefslogtreecommitdiff
path: root/Biz
diff options
context:
space:
mode:
Diffstat (limited to 'Biz')
-rw-r--r--Biz/Lint.hs72
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_]