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