1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- : out lint
module Biz.Lint (main) where
import Alpha
import qualified Biz.Cli as Cli
import qualified Biz.Log as Log
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
import qualified System.Environment as Environment
import qualified System.Exit as Exit
import System.FilePath ((</>))
import qualified System.Process as Process
main :: IO ()
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
files ->
files
|> filter notcab
|> filterM Directory.doesFileExist
+> 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 False ["Biz/Lint.hs"]
length results @=? 2
]
notcab :: FilePath -> Bool
notcab ('_' : _) = False
notcab _ = True
help :: Cli.Docopt
help =
[Cli.docopt|
all your lint are belong to us
Usage:
lint --help
lint test
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 = \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", 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", exe, Text.pack path_]
>> Log.br
>> pure r
printResult r@(NoOp path_) =
Log.info ["lint", "noop", Text.pack path_]
>> Log.br
>> pure r
changedFiles :: IO [FilePath]
changedFiles =
git ["merge-base", "HEAD", "origin/master"]
/> filter (/= '\n')
+> (\mb -> git ["diff", "--name-only", "--diff-filter=d", mb])
/> String.lines
where
git args = Process.readProcess "git" args ""
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 = Just ["--refactor", "--refactor-options=-i"]
}
pylint :: Linter
pylint =
Linter
{ exe = "pylint",
args = ["--disable=invalid-name"],
fixArgs = Nothing
}
shellcheck :: Linter
shellcheck = Linter {exe = "shellcheck", args = [], fixArgs = Nothing}
data Status = Good | Bad String
deriving (Show)
data Result
= Ok {path :: FilePath, linter :: Linter, status :: Status}
| Warn Text
| NoOp FilePath
deriving (Show)
run :: Bool -> [FilePath] -> IO [Result]
run shouldFix paths = do
cwd <- Directory.getCurrentDirectory
root <- Environment.getEnv "BIZ_ROOT"
concat </ traverse (runOne shouldFix root cwd) paths
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 shouldFix ormolu path_,
lint shouldFix hlint path_
]
Just (Namespace _ Py) -> [lint shouldFix pylint path_]
Just (Namespace _ Sh) -> [lint shouldFix 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
where
args_ = map Text.unpack <| if shouldFix && isJust fixArgs then fromJust fixArgs else args
|
