f92d2c8 · rowtype-yoga/purslint

git.iko.soy/rowtype-yoga/purslint

Add 70 lint rules and JavaScript CLI for 4-13x speedup

New rules include: - List operations (UseLastReverse, RedundantReverse, UseBreak, UseSpan, etc.) - Bifunctor (UseBimap, UseEitherMap) - Constant folding (EvaluateFst, EvaluateConst, UseFromJust) - Foldable (UseOr, UseAnd, UseFoldMapId) - Control flow (WhenNot, UnlessNot) - And many more HLint-inspired patterns JavaScript backend via Node.js replaces Go for CLI: - Large file (1585 lines): 0.73s vs 9.55s (13x faster) - Directory scan: 2.79s vs 11.58s (4x faster) 💘 Generated with Crush Assisted-by: Claude Opus 4.5 via Crush <crush@charm.land>

commitf92d2c8bf283042811a857d6627c36983fa15023 authorMark <mark.eibes@gmail.com> dateSun 25 Jan 2026, 19:02 (8 months ago) parent121746c

70 files changed+6404−92

compare with main

unifiedsplit

bin/purelint-cli/spago.yaml+3

@@ -11,3 +11,6 @@ package:

1111 - prelude

1212 - purelint

1313 - strings

14+ - node-buffer

15+ - node-fs

16+ - node-process

bin/purelint-cli/src/Main.purs+146−28

@@ -15,40 +15,154 @@ import Node.Process as Process

1515import Purelint.Config (defaultConfig, filterRules, parseConfig)

1616import Purelint.Fix (applyAllFixes)

1717import Purelint.Rule (Rule)

18+import Purelint.Rules.BooleanSimplify (booleanSimplifyRule)

19+import Purelint.Rules.CollapseLambdas (collapseLambdasRule)

1820import Purelint.Rules.ConcatMap (concatMapRule)

1921import Purelint.Rules.EtaReduce (etaReduceRule)

2022import Purelint.Rules.EtaReduceDecl (etaReduceDeclRule)

23+import Purelint.Rules.EvaluateConst (evaluateConstRule)

24+import Purelint.Rules.EvaluateFst (evaluateFstRule)

2125import Purelint.Rules.FmapId (fmapIdRule)

26+import Purelint.Rules.FunctorLaw (functorLawRule)

2227import Purelint.Rules.LetToWhere (letToWhereRule)

2328import Purelint.Rules.MapFusion (mapFusionRule)

29+import Purelint.Rules.MonoidIdentity (monoidIdentityRule)

2430import Purelint.Rules.NotEqual (notEqualRule)

31+import Purelint.Rules.NothingBind (nothingBindRule)

2532import Purelint.Rules.RedundantBind (redundantBindRule)

33+import Purelint.Rules.RedundantFlip (redundantFlipRule)

34+import Purelint.Rules.RedundantGuard (redundantGuardRule)

35+import Purelint.Rules.RedundantId (redundantIdRule)

36+import Purelint.Rules.RedundantIf (redundantIfRule)

37+import Purelint.Rules.RedundantNegate (redundantNegateRule)

38+import Purelint.Rules.RedundantNot (redundantNotRule)

39+import Purelint.Rules.RedundantReverse (redundantReverseRule)

40+import Purelint.Rules.UnlessNot (unlessNotRule)

41+import Purelint.Rules.UseAll (useAllRule)

42+import Purelint.Rules.UseAnd (useAndRule)

43+import Purelint.Rules.UseAny (useAnyRule)

44+import Purelint.Rules.UseApplicative (useApplicativeRule)

45+import Purelint.Rules.UseBimap (useBimapRule)

46+import Purelint.Rules.UseBindFlip (useBindFlipRule)

47+import Purelint.Rules.UseBreak (useBreakRule)

48+import Purelint.Rules.UseComparing (useComparingRule)

49+import Purelint.Rules.UseConst (useConstRule)

50+import Purelint.Rules.UseEitherMap (useEitherMapRule)

51+import Purelint.Rules.UseElemIndex (useElemIndexRule)

52+import Purelint.Rules.UseFindMap (useFindMapRule)

53+import Purelint.Rules.UseFold (useFoldRule)

54+import Purelint.Rules.UseFoldMapId (useFoldMapIdRule)

55+import Purelint.Rules.UseFor (useForRule)

56+import Purelint.Rules.UseFromJust (useFromJustRule)

57+import Purelint.Rules.UseFromMaybe (useFromMaybeRule)

58+import Purelint.Rules.UseFstSnd (useFstSndRule)

2659import Purelint.Rules.UseGuard (useGuardRule)

60+import Purelint.Rules.UseGuardMaybe (useGuardMaybeRule)

61+import Purelint.Rules.UseHead (useHeadRule)

62+import Purelint.Rules.UseIsJust (useIsJustRule)

63+import Purelint.Rules.UseIsNothing (useIsNothingRule)

64+import Purelint.Rules.UseJoin (useJoinRule)

65+import Purelint.Rules.UseLastReverse (useLastReverseRule)

66+import Purelint.Rules.UseMapMaybe (useMapMaybeRule)

67+import Purelint.Rules.UseMaybeMap (useMaybeMapRule)

68+import Purelint.Rules.UseMinMax (useMinMaxRule)

69+import Purelint.Rules.UseMinimumSort (useMinimumSortRule)

70+import Purelint.Rules.UseNotElem (useNotElemRule)

71+import Purelint.Rules.UseNull (useNullRule)

72+import Purelint.Rules.UseOn (useOnRule)

73+import Purelint.Rules.UseOr (useOrRule)

74+import Purelint.Rules.UseReplicate (useReplicateRule)

75+import Purelint.Rules.UseSequence (useSequenceRule)

76+import Purelint.Rules.UseSpan (useSpanRule)

2777import Purelint.Rules.UseTraverse (useTraverseRule)

78+import Purelint.Rules.UseTraverseSequence (useTraverseSequenceRule)

79+import Purelint.Rules.UseUncurry (useUncurryRule)

80+import Purelint.Rules.UseUnless (useUnlessRule)

81+import Purelint.Rules.UseVoid (useVoidRule)

82+import Purelint.Rules.UseWhen (useWhenRule)

83+import Purelint.Rules.UseZip (useZipRule)

84+import Purelint.Rules.WhenNot (whenNotRule)

2885import Purelint.Runner (runRules)

2986import Purelint.Types (LintResult(..), LintWarning(..), Severity(..), SourceCode(..), Suggestion(..))

3087

31−-- | All available rules

88+-- | All available rules (70 total)

3289allRules :: Array Rule

3390allRules =

34− [ useTraverseRule

35− , mapFusionRule

36− , fmapIdRule

37− , notEqualRule

91+ [ booleanSimplifyRule

92+ , collapseLambdasRule

3893 , concatMapRule

39− , useGuardRule

4094 , etaReduceRule

4195 , etaReduceDeclRule

42− , redundantBindRule

96+ , evaluateConstRule

97+ , evaluateFstRule

98+ , fmapIdRule

99+ , functorLawRule

43100 , letToWhereRule

101+ , mapFusionRule

102+ , monoidIdentityRule

103+ , notEqualRule

104+ , nothingBindRule

105+ , redundantBindRule

106+ , redundantFlipRule

107+ , redundantGuardRule

108+ , redundantIdRule

109+ , redundantIfRule

110+ , redundantNegateRule

111+ , redundantNotRule

112+ , redundantReverseRule

113+ , unlessNotRule

114+ , useAllRule

115+ , useAndRule

116+ , useAnyRule

117+ , useApplicativeRule

118+ , useBimapRule

119+ , useBindFlipRule

120+ , useBreakRule

121+ , useComparingRule

122+ , useConstRule

123+ , useEitherMapRule

124+ , useElemIndexRule

125+ , useFindMapRule

126+ , useFoldRule

127+ , useFoldMapIdRule

128+ , useForRule

129+ , useFromJustRule

130+ , useFromMaybeRule

131+ , useFstSndRule

132+ , useGuardRule

133+ , useGuardMaybeRule

134+ , useHeadRule

135+ , useIsJustRule

136+ , useIsNothingRule

137+ , useJoinRule

138+ , useLastReverseRule

139+ , useMapMaybeRule

140+ , useMaybeMapRule

141+ , useMinMaxRule

142+ , useMinimumSortRule

143+ , useNotElemRule

144+ , useNullRule

145+ , useOnRule

146+ , useOrRule

147+ , useReplicateRule

148+ , useSequenceRule

149+ , useSpanRule

150+ , useTraverseRule

151+ , useTraverseSequenceRule

152+ , useUncurryRule

153+ , useUnlessRule

154+ , useVoidRule

155+ , useWhenRule

156+ , useZipRule

157+ , whenNotRule

44158 ]

45159

46−-- | Load config from .purelintignore file

160+-- | Load config from .purelintrc file

47161loadConfig :: Effect _

48162loadConfig = do

49− hasConfig <- FS.exists ".purelintignore"

163+ hasConfig <- FS.exists ".purelintrc"

50164 if hasConfig then do

51− content <- FS.readTextFile ".purelintignore"

165+ content <- FS.readTextFile ".purelintrc"

52166 pure $ parseConfig content

53167 else

54168 pure defaultConfig

@@ -109,14 +223,18 @@ findPursFiles dir = do

109223 collectFiles :: String -> Array String -> String -> Effect (Array String)

110224 collectFiles parentDir acc entry = do

111225 let path = parentDir <> "/" <> entry

112− stats <- FS.stat path

113− if stats.isDirectory then do

114− subFiles <- findPursFiles path

115− pure (acc <> subFiles)

116− else if String.takeRight 5 entry == ".purs" then

117− pure (Array.snoc acc path)

118− else

226+ -- Skip hidden directories and node_modules

227+ if String.take 1 entry == "." || entry == "node_modules" || entry == ".spago" then

119228 pure acc

229+ else do

230+ stats <- FS.stat path

231+ if stats.isDirectory then do

232+ subFiles <- findPursFiles path

233+ pure (acc <> subFiles)

234+ else if String.takeRight 5 entry == ".purs" then

235+ pure (Array.snoc acc path)

236+ else

237+ pure acc

120238

121239-- | Lint a file or directory with config

122240lintPathWithConfig :: Array Rule -> String -> Effect Int

@@ -147,18 +265,18 @@ fixPath rules path = do

147265-- | Show usage

148266showUsage :: Effect Unit

149267showUsage = do

150− log "purelint - a linter for PureScript"

268+ log "purelint - a linter for PureScript (70 rules)"

151269 log ""

152270 log "Usage: purelint [OPTIONS] [FILES/DIRECTORIES...]"

153271 log ""

154272 log "Options:"

155273 log " --help Show this help"

156274 log " --fix Auto-fix issues (where possible)"

157− log " --init Create a sample .purelintignore"

275+ log " --init Create a sample .purelintrc"

158276 log " --list List all available rules"

159277 log ""

160278 log "Configuration:"

161− log " Create .purelintignore in your project root to disable rules."

279+ log " Create .purelintrc in your project root to disable rules."

162280 log " Add one rule name per line (lines starting with # are comments)."

163281 log ""

164282 log "Examples:"

@@ -169,7 +287,7 @@ showUsage = do

169287-- | List all available rules

170288listRules :: Effect Unit

171289listRules = do

172− log "Available rules:"

290+ log $ "Available rules (" <> show (Array.length allRules) <> " total):"

173291 log ""

174292 for_ allRules \rule -> do

175293 log $ " " <> unwrap rule.ruleId

@@ -177,23 +295,23 @@ listRules = do

177295-- | Create sample config file

178296initConfig :: Effect Unit

179297initConfig = do

180− hasConfig <- FS.exists ".purelintignore"

298+ hasConfig <- FS.exists ".purelintrc"

181299 if hasConfig then

182− log ".purelintignore already exists"

300+ log ".purelintrc already exists"

183301 else do

184− let sampleConfig = """# purelint ignore file

302+ let sampleConfig = """# purelint configuration

185303# Add rule names (one per line) to disable them

186304# Example:

187305# EtaReduce

188−# MapFusion

306+# LetToWhere

189307"""

190− FS.writeTextFile ".purelintignore" sampleConfig

191− log "Created .purelintignore"

308+ FS.writeTextFile ".purelintrc" sampleConfig

309+ log "Created .purelintrc"

192310

193311main :: Effect Unit

194312main = do

195313 args <- Process.argv

196− -- args[0] is the executable, args[1..] are the actual arguments

314+ -- args[0] is node, args[1] is the script, args[2..] are the actual arguments

197315 let userArgs = Array.drop 1 args

198316 case userArgs of

199317 [] -> showUsage

bin/purelint-lsp/src/LSP.purs+262−38

@@ -7,22 +7,81 @@ import Data.Either (Either(..))

77import Data.Maybe (Maybe(..), fromMaybe)

88import Data.Newtype (unwrap)

99import Effect (Effect)

10+import Effect.Ref (Ref)

11+import Effect.Ref as Ref

1012import Foreign (Foreign)

1113import LSP.Stdio as Stdio

12−import Purelint.Config (defaultConfig, filterRules)

14+import Purelint.Config (Config, defaultConfig, filterRules)

1315import Purelint.Rule (Rule)

16+import Purelint.Rules.BooleanSimplify (booleanSimplifyRule)

17+import Purelint.Rules.CollapseLambdas (collapseLambdasRule)

1418import Purelint.Rules.ConcatMap (concatMapRule)

1519import Purelint.Rules.EtaReduce (etaReduceRule)

1620import Purelint.Rules.EtaReduceDecl (etaReduceDeclRule)

1721import Purelint.Rules.FmapId (fmapIdRule)

22+import Purelint.Rules.FunctorLaw (functorLawRule)

1823import Purelint.Rules.LetToWhere (letToWhereRule)

1924import Purelint.Rules.MapFusion (mapFusionRule)

25+import Purelint.Rules.MonoidIdentity (monoidIdentityRule)

2026import Purelint.Rules.NotEqual (notEqualRule)

2127import Purelint.Rules.RedundantBind (redundantBindRule)

28+import Purelint.Rules.RedundantFlip (redundantFlipRule)

29+import Purelint.Rules.RedundantIf (redundantIfRule)

30+import Purelint.Rules.RedundantNot (redundantNotRule)

31+import Purelint.Rules.UseAll (useAllRule)

32+import Purelint.Rules.UseAny (useAnyRule)

33+import Purelint.Rules.UseConst (useConstRule)

34+import Purelint.Rules.UseFold (useFoldRule)

35+import Purelint.Rules.UseFromMaybe (useFromMaybeRule)

36+import Purelint.Rules.UseFstSnd (useFstSndRule)

2237import Purelint.Rules.UseGuard (useGuardRule)

38+import Purelint.Rules.UseIsJust (useIsJustRule)

39+import Purelint.Rules.UseIsNothing (useIsNothingRule)

40+import Purelint.Rules.UseJoin (useJoinRule)

41+import Purelint.Rules.UseMinMax (useMinMaxRule)

42+import Purelint.Rules.UseNotElem (useNotElemRule)

43+import Purelint.Rules.UseNull (useNullRule)

44+import Purelint.Rules.UseSequence (useSequenceRule)

2345import Purelint.Rules.UseTraverse (useTraverseRule)

46+import Purelint.Rules.UseTraverseSequence (useTraverseSequenceRule)

47+import Purelint.Rules.UseUnless (useUnlessRule)

48+import Purelint.Rules.UseVoid (useVoidRule)

49+import Purelint.Rules.UseWhen (useWhenRule)

50+import Purelint.Rules.UseMapMaybe (useMapMaybeRule)

51+import Purelint.Rules.UseGuardMaybe (useGuardMaybeRule)

52+import Purelint.Rules.UseMaybeMap (useMaybeMapRule)

53+import Purelint.Rules.UseApplicative (useApplicativeRule)

54+import Purelint.Rules.UseBindFlip (useBindFlipRule)

55+import Purelint.Rules.UseFor (useForRule)

56+import Purelint.Rules.RedundantGuard (redundantGuardRule)

57+import Purelint.Rules.UseComparing (useComparingRule)

58+import Purelint.Rules.UseOn (useOnRule)

59+import Purelint.Rules.UseFindMap (useFindMapRule)

60+import Purelint.Rules.UseLastReverse (useLastReverseRule)

61+import Purelint.Rules.RedundantReverse (redundantReverseRule)

62+import Purelint.Rules.UseBreak (useBreakRule)

63+import Purelint.Rules.UseSpan (useSpanRule)

64+import Purelint.Rules.UseMinimumSort (useMinimumSortRule)

65+import Purelint.Rules.UseBimap (useBimapRule)

66+import Purelint.Rules.UseEitherMap (useEitherMapRule)

67+import Purelint.Rules.EvaluateFst (evaluateFstRule)

68+import Purelint.Rules.EvaluateConst (evaluateConstRule)

69+import Purelint.Rules.UseOr (useOrRule)

70+import Purelint.Rules.UseAnd (useAndRule)

71+import Purelint.Rules.UseFoldMapId (useFoldMapIdRule)

72+import Purelint.Rules.WhenNot (whenNotRule)

73+import Purelint.Rules.UnlessNot (unlessNotRule)

74+import Purelint.Rules.UseZip (useZipRule)

75+import Purelint.Rules.UseReplicate (useReplicateRule)

76+import Purelint.Rules.UseUncurry (useUncurryRule)

77+import Purelint.Rules.RedundantNegate (redundantNegateRule)

78+import Purelint.Rules.UseFromJust (useFromJustRule)

79+import Purelint.Rules.UseHead (useHeadRule)

80+import Purelint.Rules.RedundantId (redundantIdRule)

81+import Purelint.Rules.NothingBind (nothingBindRule)

82+import Purelint.Rules.UseElemIndex (useElemIndexRule)

2483import Purelint.Runner (runRules)

25−import Purelint.Types (LintResult(..), LintWarning(..), Severity(..), SourceCode(..), Suggestion(..))

84+import Purelint.Types (LintResult(..), LintWarning(..), RuleId(..), Severity(..), SourceCode(..), Suggestion(..))

2685import Unsafe.Coerce (unsafeCoerce)

2786

2887-- | All available rules

@@ -38,11 +97,69 @@ allRules =

3897 , etaReduceDeclRule

3998 , redundantBindRule

4099 , letToWhereRule

100+ , redundantIfRule

101+ , functorLawRule

102+ , useVoidRule

103+ , useJoinRule

104+ , useAnyRule

105+ , useAllRule

106+ , booleanSimplifyRule

107+ , collapseLambdasRule

108+ , useConstRule

109+ , useNullRule

110+ , useFromMaybeRule

111+ , useIsJustRule

112+ , useIsNothingRule

113+ , useWhenRule

114+ , useUnlessRule

115+ , redundantFlipRule

116+ , useNotElemRule

117+ , useMinMaxRule

118+ , monoidIdentityRule

119+ , useFoldRule

120+ , useSequenceRule

121+ , useTraverseSequenceRule

122+ , redundantNotRule

123+ , useFstSndRule

124+ , useMapMaybeRule

125+ , useGuardMaybeRule

126+ , useMaybeMapRule

127+ , useApplicativeRule

128+ , useBindFlipRule

129+ , useForRule

130+ , redundantGuardRule

131+ , useComparingRule

132+ , useOnRule

133+ , useFindMapRule

134+ -- New rules

135+ , useLastReverseRule

136+ , redundantReverseRule

137+ , useBreakRule

138+ , useSpanRule

139+ , useMinimumSortRule

140+ , useBimapRule

141+ , useEitherMapRule

142+ , evaluateFstRule

143+ , evaluateConstRule

144+ , useOrRule

145+ , useAndRule

146+ , useFoldMapIdRule

147+ , whenNotRule

148+ , unlessNotRule

149+ , useZipRule

150+ , useReplicateRule

151+ , useUncurryRule

152+ , redundantNegateRule

153+ , useFromJustRule

154+ , useHeadRule

155+ , redundantIdRule

156+ , nothingBindRule

157+ , useElemIndexRule

41158 ]

42159

43−-- | Get enabled rules

44−enabledRules :: Array Rule

45−enabledRules = filterRules allRules defaultConfig

160+-- | Get enabled rules based on config

161+getEnabledRules :: Config -> Array Rule

162+getEnabledRules config = filterRules allRules config

46163

47164-- | Convert lint warning to LSP diagnostic (with fix data embedded)

48165warningToDiagnostic :: LintWarning -> Foreign

@@ -69,6 +186,7 @@ warningToDiagnostic (LintWarning w) =

69186 { hasFix: true

70187 , replacement: unwrap sug.replacement

71188 , description: unwrap sug.description

189+ , ruleId: unwrap w.ruleId

72190 }

73191 }

74192

@@ -78,9 +196,10 @@ severityToLSP Warning = 2

78196severityToLSP Hint = 4

79197

80198-- | Lint a document and return diagnostics

81−lintDocument :: String -> Array Foreign

82−lintDocument content =

83− case runRules enabledRules (SourceCode content) of

199+lintDocument :: Config -> String -> Array Foreign

200+lintDocument config content =

201+ let rules = getEnabledRules config

202+ in case runRules rules (SourceCode content) of

84203 Left _ -> []

85204 Right (LintResult result) -> map warningToDiagnostic result.warnings

86205

@@ -96,7 +215,7 @@ mkPublishDiagnostics uri diagnostics =

96215 }

97216 }

98217

99−-- | Create an initialize response

218+-- | Create an initialize response with workspace configuration support

100219mkInitializeResponse :: Int -> String

101220mkInitializeResponse reqId =

102221 Stdio.stringifyJSON $ unsafeCoerce

@@ -106,6 +225,12 @@ mkInitializeResponse reqId =

106225 { capabilities:

107226 { textDocumentSync: 1 -- Full sync

108227 , codeActionProvider: true

228+ , workspace:

229+ { workspaceFolders:

230+ { supported: true

231+ , changeNotifications: true

232+ }

233+ }

109234 }

110235 , serverInfo:

111236 { name: "purelint-lsp"

@@ -159,12 +284,56 @@ getFieldArr key obj =

159284 then Just (unsafeCoerce (getKey key obj))

160285 else Nothing

161286

287+getFieldBool :: String -> Foreign -> Maybe Boolean

288+getFieldBool key obj =

289+ if hasKey key obj

290+ then Just (unsafeCoerce (getKey key obj))

291+ else Nothing

292+

162293foreign import hasKey :: String -> Foreign -> Boolean

163294foreign import getKey :: String -> Foreign -> Foreign

164295

296+-- | Parse settings to get disabled rules

297+-- | Expected format: { "purelint": { "disabledRules": ["RuleId1", "RuleId2"] } }

298+-- | Or: { "purelint.disabledRules": ["RuleId1", "RuleId2"] }

299+-- | Or: { "purelint.enabled": false } to disable all rules

300+parseSettings :: Foreign -> Config

301+parseSettings settings =

302+ -- Try to get purelint.enabled first

303+ case getFieldObj "purelint" settings of

304+ Just purelintObj ->

305+ -- Check if all rules are disabled

306+ case getFieldBool "enabled" purelintObj of

307+ Just false ->

308+ { disabledRules: map (\r -> r.ruleId) allRules } -- Disable all rules

309+ _ ->

310+ -- Get disabled rules list

311+ case getFieldArr "disabledRules" purelintObj of

312+ Just arr ->

313+ { disabledRules: Array.mapMaybe parseRuleId arr }

314+ Nothing -> defaultConfig

315+ Nothing ->

316+ -- Try flat format: purelint.disabledRules

317+ case getFieldArr "purelint.disabledRules" settings of

318+ Just arr ->

319+ { disabledRules: Array.mapMaybe parseRuleId arr }

320+ Nothing ->

321+ -- Try purelint.enabled

322+ case getFieldBool "purelint.enabled" settings of

323+ Just false ->

324+ { disabledRules: map (\r -> r.ruleId) allRules }

325+ _ -> defaultConfig

326+

327+ where

328+ parseRuleId :: Foreign -> Maybe RuleId

329+ parseRuleId f =

330+ -- Try to coerce to string

331+ let s = unsafeCoerce f :: String

332+ in if s == "" then Nothing else Just (RuleId s)

333+

165334-- | Handle a single message

166−handleMessage :: Foreign -> Effect Unit

167−handleMessage msg = do

335+handleMessage :: Ref Config -> Foreign -> Effect Unit

336+handleMessage configRef msg = do

168337 let method = fromMaybe "" (getField "method" msg)

169338 let reqId = fromMaybe 0 (getFieldInt "id" msg)

170339

@@ -172,13 +341,25 @@ handleMessage msg = do

172341

173342 if method == "initialize" then do

174343 Stdio.logMessage "Handling initialize"

344+ -- Parse initial settings from initializationOptions if present

345+ case getFieldObj "params" msg of

346+ Just params ->

347+ case getFieldObj "initializationOptions" params of

348+ Just options -> do

349+ let config = parseSettings options

350+ Ref.write config configRef

351+ Stdio.logMessage $ "Initial config loaded, disabled: " <> show (Array.length config.disabledRules)

352+ Nothing -> pure unit

353+ Nothing -> pure unit

175354 Stdio.writeMessage $ mkInitializeResponse reqId

176355 else if method == "initialized" then do

177356 Stdio.logMessage "Client initialized"

357+ else if method == "workspace/didChangeConfiguration" then do

358+ handleDidChangeConfiguration configRef msg

178359 else if method == "textDocument/didOpen" then do

179− handleDidOpen msg

360+ handleDidOpen configRef msg

180361 else if method == "textDocument/didChange" then do

181− handleDidChange msg

362+ handleDidChange configRef msg

182363 else if method == "textDocument/didClose" then do

183364 handleDidClose msg

184365 else if method == "textDocument/codeAction" then do

@@ -191,9 +372,23 @@ handleMessage msg = do

191372 else do

192373 Stdio.logMessage $ "Unknown method: " <> method

193374

194−handleDidOpen :: Foreign -> Effect Unit

195−handleDidOpen msg = do

375+handleDidChangeConfiguration :: Ref Config -> Foreign -> Effect Unit

376+handleDidChangeConfiguration configRef msg = do

377+ Stdio.logMessage "Configuration changed"

378+ case getFieldObj "params" msg of

379+ Nothing -> pure unit

380+ Just params ->

381+ case getFieldObj "settings" params of

382+ Nothing -> pure unit

383+ Just settings -> do

384+ let config = parseSettings settings

385+ Ref.write config configRef

386+ Stdio.logMessage $ "Config updated, disabled rules: " <> show (Array.length config.disabledRules)

387+

388+handleDidOpen :: Ref Config -> Foreign -> Effect Unit

389+handleDidOpen configRef msg = do

196390 Stdio.logMessage "Document opened"

391+ config <- Ref.read configRef

197392 case getFieldObj "params" msg of

198393 Nothing -> pure unit

199394 Just params ->

@@ -202,12 +397,13 @@ handleDidOpen msg = do

202397 Just textDoc -> do

203398 let uri = fromMaybe "" (getField "uri" textDoc)

204399 let text = fromMaybe "" (getField "text" textDoc)

205− let diagnostics = lintDocument text

400+ let diagnostics = lintDocument config text

206401 Stdio.writeMessage $ mkPublishDiagnostics uri diagnostics

207402

208−handleDidChange :: Foreign -> Effect Unit

209−handleDidChange msg = do

403+handleDidChange :: Ref Config -> Foreign -> Effect Unit

404+handleDidChange configRef msg = do

210405 Stdio.logMessage "Document changed"

406+ config <- Ref.read configRef

211407 case getFieldObj "params" msg of

212408 Nothing -> pure unit

213409 Just params -> do

@@ -221,7 +417,7 @@ handleDidChange msg = do

221417 Nothing -> pure unit

222418 Just change -> do

223419 let text = fromMaybe "" (getField "text" change)

224− let diagnostics = lintDocument text

420+ let diagnostics = lintDocument config text

225421 Stdio.writeMessage $ mkPublishDiagnostics uri diagnostics

226422

227423handleDidClose :: Foreign -> Effect Unit

@@ -252,23 +448,35 @@ handleCodeAction msg reqId = do

252448 context <- getFieldObj "context" params

253449 getFieldArr "diagnostics" context

254450

255− -- Convert diagnostics to code actions

256− let actions = Array.catMaybes $ map (diagnosticToCodeAction uri) diagnostics

451+ -- Convert diagnostics to code actions (each diagnostic may produce multiple actions)

452+ let actions = Array.concat $ map (diagnosticToCodeActions uri) diagnostics

257453

258454 Stdio.logMessage $ "Returning " <> show (Array.length actions) <> " code actions"

259455 Stdio.writeMessage $ mkCodeActionResponse reqId actions

260456

261−-- | Convert a diagnostic with fix data to a code action

262−diagnosticToCodeAction :: String -> Foreign -> Maybe Foreign

263−diagnosticToCodeAction uri diag = do

264− dataField <- getFieldObj "data" diag

265− if hasKey "replacement" dataField && hasKey "description" dataField

266− then do

267− replacement <- getField "replacement" dataField

268− description <- getField "description" dataField

269− range <- getFieldObj "range" diag

270− pure $ mkCodeAction description uri range replacement diag

271− else Nothing

457+-- | Convert a diagnostic to code actions (quickfix + disable rule)

458+diagnosticToCodeActions :: String -> Foreign -> Array Foreign

459+diagnosticToCodeActions uri diag =

460+ case getFieldObj "data" diag of

461+ Nothing -> []

462+ Just dataField ->

463+ let

464+ -- Try to create quickfix action

465+ quickfixAction =

466+ if hasKey "replacement" dataField && hasKey "description" dataField

467+ then do

468+ replacement <- getField "replacement" dataField

469+ description <- getField "description" dataField

470+ range <- getFieldObj "range" diag

471+ pure $ mkCodeAction description uri range replacement diag

472+ else Nothing

473+

474+ -- Try to create disable rule action

475+ disableAction = do

476+ ruleId <- getField "ruleId" dataField

477+ pure $ mkDisableRuleAction ruleId diag

478+ in

479+ Array.catMaybes [quickfixAction, disableAction]

272480

273481-- | Create a code action with a workspace edit

274482mkCodeAction :: String -> String -> Foreign -> String -> Foreign -> Foreign

@@ -290,9 +498,24 @@ mkCodeAction title uri range newText diagnostic =

290498 }

291499 }

292500

501+-- | Create a "Disable rule" code action (uses a command the client can execute)

502+mkDisableRuleAction :: String -> Foreign -> Foreign

503+mkDisableRuleAction ruleId diagnostic =

504+ unsafeCoerce

505+ { title: "Disable rule: " <> ruleId

506+ , kind: "quickfix"

507+ , diagnostics: [diagnostic]

508+ , isPreferred: false

509+ , command:

510+ { title: "Disable rule " <> ruleId

511+ , command: "purelint.disableRule"

512+ , arguments: [ruleId]

513+ }

514+ }

515+

293516-- | Main loop

294−mainLoop :: Effect Unit

295−mainLoop = do

517+mainLoop :: Ref Config -> Effect Unit

518+mainLoop configRef = do

296519 msgStr <- Stdio.readMessage

297520 case msgStr of

298521 Nothing -> do

@@ -302,17 +525,18 @@ mainLoop = do

302525 case Stdio.parseJSON str of

303526 Nothing -> do

304527 Stdio.logMessage "Failed to parse message"

305− mainLoop

528+ mainLoop configRef

306529 Just msg -> do

307− handleMessage msg

530+ handleMessage configRef msg

308531 -- Check if it was exit

309532 let method = fromMaybe "" (getField "method" msg)

310533 if method == "exit"

311534 then pure unit

312− else mainLoop

535+ else mainLoop configRef

313536

314537main :: Effect Unit

315538main = do

316539 Stdio.logMessage "purelint-lsp starting..."

317− mainLoop

540+ configRef <- Ref.new defaultConfig

541+ mainLoop configRef

318542 Stdio.logMessage "purelint-lsp exiting"

bin/purelint.jsnew file+3

@@ -0,0 +1,3 @@

1+#!/usr/bin/env node

2+import { main } from "../output/Main/index.js";

3+main();

lib/purelint/src/Purelint/Imports.purs+35−3

@@ -5,7 +5,6 @@ import Prelude

55import Data.Array as Array

66import Data.Foldable (foldr)

77import Data.Maybe (Maybe(..))

8−import Data.Newtype (unwrap)

98import Data.Set (Set)

109import Data.Set as Set

1110import Data.Tuple (Tuple(..), snd)

@@ -22,6 +21,10 @@ type ImportInfo =

2221 , hasPrelude :: Boolean

2322 }

2423

24+-- | Check if a module is prelude-like (for debugging)

25+isPreludeModule :: String -> Boolean

26+isPreludeModule name = Set.member name preludeModules

27+

2528-- | Modules considered "Prelude-like" for our purposes

2629preludeModules :: Set String

2730preludeModules = Set.fromFoldable

@@ -32,24 +35,53 @@ preludeModules = Set.fromFoldable

3235 , "Control.Applicative"

3336 , "Control.Monad"

3437 , "Control.Bind"

38+ , "Control.Alternative"

3539 , "Data.Function"

3640 , "Data.Eq"

3741 , "Data.Boolean"

42+ , "Data.Maybe"

43+ , "Data.Tuple"

44+ , "Data.Monoid"

45+ , "Data.Semigroup"

46+ , "Data.Ord"

47+ , "Data.Array"

48+ , "Data.Either"

49+ , "Data.Bifunctor"

50+ , "Data.List"

3851 ]

3952

4053-- | Standard Prelude values we care about

4154standardValues :: Set String

4255standardValues = Set.fromFoldable

4356 [ "map", "fmap", "identity", "id", "not"

44− , "traverse", "sequenceA", "sequence"

57+ , "traverse", "traverse_", "sequenceA", "sequence", "for", "for_"

4558 , "concat", "concatMap", "bind", "pure", "join"

4659 , "when", "unless"

60+ , "or", "and", "any", "all"

61+ , "length", "null", "head", "last", "take", "reverse", "sort"

62+ , "const", "void"

63+ , "maybe", "fromMaybe", "isJust", "isNothing", "Nothing", "Just"

64+ , "flip", "elem", "notElem", "elemIndex", "findIndex"

65+ , "mempty", "fold", "foldMap"

66+ , "fst", "snd", "uncurry"

67+ , "max", "min", "minimum", "maximum"

68+ , "compare", "comparing", "on"

69+ , "guard"

70+ , "catMaybes", "mapMaybe", "findMap"

71+ , "either", "Left", "Right"

72+ , "bimap", "first", "second"

73+ , "span", "break"

74+ , "negate"

75+ , "zip", "zipWith"

76+ , "repeat", "replicate"

4777 ]

4878

4979-- | Standard Prelude operators we care about

5080standardOps :: Set String

5181standardOps = Set.fromFoldable

52− [ "<$>", "<#>", "<*>", ">>=", "=<<", ">>", "<<<", ">>>", "==", "/=" ]

82+ [ "<$>", "<#>", "<*>", ">>=", "=<<", ">>", "*>", "<<<", ">>>", "==", "/="

83+ , "<>", ">", ">=", "<", "<=", "$>", "!!"

84+ ]

5385

5486-- | Extract import information from a module

5587getImportInfo :: Module Void -> ImportInfo

lib/purelint/src/Purelint/Rules/BooleanSimplify.pursnew file+70

@@ -0,0 +1,70 @@

1+module Purelint.Rules.BooleanSimplify where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Tuple (Tuple(..))

8+import Data.Void (Void)

9+import Purelint.Imports (ImportInfo, hasOp)

10+import Purelint.Print (printExpr)

11+import Purelint.Rule (Rule, RuleContext, mkRule)

12+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

13+import PureScript.CST.Range (rangeOf)

14+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

15+import PureScript.CST.Types (Expr(..), Module, Operator(..), QualifiedName(..))

16+

17+-- | Rule: x == true -> x

18+-- | Also: x == false -> not x

19+-- | Also: true == x -> x

20+-- | Also: false == x -> not x

21+booleanSimplifyRule :: Rule

22+booleanSimplifyRule = mkRule (RuleId "BooleanSimplify") run

23+ where

24+ run :: RuleContext -> Module Void -> Array LintWarning

25+ run ctx = foldMapModule visitor

26+ where

27+ imports = ctx.imports

28+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

29+

30+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

31+ checkExpr imports expr = case expr of

32+ -- Match: x == true, x == false, true == x, false == x

33+ ExprOp lhs ops | hasOp imports "==" ->

34+ case NEA.toArray ops of

35+ [Tuple qn rhs] | isEqOp qn ->

36+ -- x == true -> x

37+ if isBoolLit true rhs then

38+ [ mkWarning expr (printExpr lhs) "x == true" "x" ]

39+ -- x == false -> not x

40+ else if isBoolLit false rhs then

41+ [ mkWarning expr ("not " <> printExpr lhs) "x == false" "not x" ]

42+ -- true == x -> x

43+ else if isBoolLit true lhs then

44+ [ mkWarning expr (printExpr rhs) "true == x" "x" ]

45+ -- false == x -> not x

46+ else if isBoolLit false lhs then

47+ [ mkWarning expr ("not " <> printExpr rhs) "false == x" "not x" ]

48+ else []

49+ _ -> []

50+ _ -> []

51+

52+ mkWarning :: Expr Void -> String -> String -> String -> LintWarning

53+ mkWarning fullExpr replacement from to =

54+ LintWarning

55+ { ruleId: RuleId "BooleanSimplify"

56+ , message: WarningMessage $ "Redundant comparison: " <> from

57+ , range: rangeOf fullExpr

58+ , severity: Warning

59+ , suggestion: Just $ Suggestion

60+ { replacement: ReplacementText replacement

61+ , description: SuggestionDescription $ from <> " can be simplified to " <> to

62+ }

63+ }

64+

65+ isEqOp :: QualifiedName Operator -> Boolean

66+ isEqOp (QualifiedName { name: Operator op }) = op == "=="

67+

68+ isBoolLit :: Boolean -> Expr Void -> Boolean

69+ isBoolLit expected (ExprBoolean _ val) = val == expected

70+ isBoolLit _ _ = false

lib/purelint/src/Purelint/Rules/CollapseLambdas.pursnew file+56

@@ -0,0 +1,56 @@

1+module Purelint.Rules.CollapseLambdas where

3+import Prelude

5+import Data.Array as Array

6+import Data.Array.NonEmpty as NEA

7+import Data.Maybe (Maybe(..))

8+import Data.String as String

9+import Data.Void (Void)

10+import Purelint.Print (printExpr)

11+import Purelint.Rule (Rule, RuleContext, mkRule)

12+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

13+import PureScript.CST.Range (rangeOf)

14+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

15+import PureScript.CST.Types (Binder(..), Expr(..), Ident(..), Module, Name(..))

16+

17+-- | Rule: \x -> \y -> body -> \x y -> body

18+collapseLambdasRule :: Rule

19+collapseLambdasRule = mkRule (RuleId "CollapseLambdas") run

20+ where

21+ run :: RuleContext -> Module Void -> Array LintWarning

22+ run _ctx = foldMapModule visitor

23+ where

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr }

25+

26+ checkExpr :: Expr Void -> Array LintWarning

27+ checkExpr expr = case expr of

28+ ExprLambda lambda ->

29+ -- Check if body is another lambda

30+ case lambda.body of

31+ ExprLambda innerLambda ->

32+ let

33+ outerBinders = NEA.toArray lambda.binders

34+ innerBinders = NEA.toArray innerLambda.binders

35+ allBinders = outerBinders <> innerBinders

36+ binderNames = Array.mapMaybe getBinderName allBinders

37+ bodyText = printExpr innerLambda.body

38+ replacement = "\\" <> String.joinWith " " binderNames <> " -> " <> bodyText

39+ in

40+ [ LintWarning

41+ { ruleId: RuleId "CollapseLambdas"

42+ , message: WarningMessage "Collapse nested lambdas"

43+ , range: rangeOf expr

44+ , severity: Hint

45+ , suggestion: Just $ Suggestion

46+ { replacement: ReplacementText replacement

47+ , description: SuggestionDescription "\\x -> \\y -> body can be simplified to \\x y -> body"

48+ }

49+ }

50+ ]

51+ _ -> []

52+ _ -> []

53+

54+ getBinderName :: Binder Void -> Maybe String

55+ getBinderName (BinderVar (Name { name: Ident n })) = Just n

56+ getBinderName _ = Nothing

lib/purelint/src/Purelint/Rules/EvaluateConst.pursnew file+52

@@ -0,0 +1,52 @@

1+module Purelint.Rules.EvaluateConst where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..))

15+

16+-- | Rule: const x y -> x

17+evaluateConstRule :: Rule

18+evaluateConstRule = mkRule (RuleId "EvaluateConst") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: const x y (fully applied)

29+ ExprApp fn args

30+ | isConst imports fn ->

31+ case NEA.toArray args of

32+ [AppTerm xArg, AppTerm _yArg] ->

33+ let x = printExpr xArg

34+ in

35+ [ LintWarning

36+ { ruleId: RuleId "EvaluateConst"

37+ , message: WarningMessage "const x y can be simplified to x"

38+ , range: rangeOf expr

39+ , severity: Warning

40+ , suggestion: Just $ Suggestion

41+ { replacement: ReplacementText x

42+ , description: SuggestionDescription "Evaluate const"

43+ }

44+ }

45+ ]

46+ _ -> []

47+ _ -> []

48+

49+ isConst :: ImportInfo -> Expr Void -> Boolean

50+ isConst imports (ExprIdent (QualifiedName { name: Ident name })) =

51+ name == "const" && hasValue imports "const"

52+ isConst _ _ = false

lib/purelint/src/Purelint/Rules/EvaluateFst.pursnew file+96

@@ -0,0 +1,96 @@

1+module Purelint.Rules.EvaluateFst where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, Proper(..), QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: fst (Tuple x y) -> x

17+-- | Also: snd (Tuple x y) -> y

18+evaluateFstRule :: Rule

19+evaluateFstRule = mkRule (RuleId "EvaluateFst") run

20+ where

21+ run :: RuleContext -> Module Void -> Array LintWarning

22+ run ctx = foldMapModule visitor

23+ where

24+ imports = ctx.imports

25+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

26+

27+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

28+ checkExpr imports expr = case expr of

29+ -- Match: fst (Tuple x y) or fst (x /\ y)

30+ ExprApp fn args

31+ | isFst imports fn ->

32+ case NEA.toArray args of

33+ [AppTerm arg] ->

34+ case getTupleElements (unwrapParens arg) of

35+ Just { first, second: _ } ->

36+ let x = printExpr first

37+ in

38+ [ LintWarning

39+ { ruleId: RuleId "EvaluateFst"

40+ , message: WarningMessage "fst (Tuple x y) can be simplified to x"

41+ , range: rangeOf expr

42+ , severity: Warning

43+ , suggestion: Just $ Suggestion

44+ { replacement: ReplacementText x

45+ , description: SuggestionDescription "Extract first element directly"

46+ }

47+ }

48+ ]

49+ Nothing -> []

50+ _ -> []

51+ | isSnd imports fn ->

52+ case NEA.toArray args of

53+ [AppTerm arg] ->

54+ case getTupleElements (unwrapParens arg) of

55+ Just { first: _, second } ->

56+ let y = printExpr second

57+ in

58+ [ LintWarning

59+ { ruleId: RuleId "EvaluateFst"

60+ , message: WarningMessage "snd (Tuple x y) can be simplified to y"

61+ , range: rangeOf expr

62+ , severity: Warning

63+ , suggestion: Just $ Suggestion

64+ { replacement: ReplacementText y

65+ , description: SuggestionDescription "Extract second element directly"

66+ }

67+ }

68+ ]

69+ Nothing -> []

70+ _ -> []

71+ _ -> []

72+

73+ unwrapParens :: Expr Void -> Expr Void

74+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

75+ unwrapParens e = e

76+

77+ isFst :: ImportInfo -> Expr Void -> Boolean

78+ isFst imports (ExprIdent (QualifiedName { name: Ident name })) =

79+ name == "fst" && hasValue imports "fst"

80+ isFst _ _ = false

81+

82+ isSnd :: ImportInfo -> Expr Void -> Boolean

83+ isSnd imports (ExprIdent (QualifiedName { name: Ident name })) =

84+ name == "snd" && hasValue imports "snd"

85+ isSnd _ _ = false

86+

87+ -- Extract tuple elements from Tuple x y constructor

88+ getTupleElements :: Expr Void -> Maybe { first :: Expr Void, second :: Expr Void }

89+ getTupleElements (ExprApp ctor args) =

90+ case ctor of

91+ ExprConstructor (QualifiedName { name: Proper "Tuple" }) ->

92+ case NEA.toArray args of

93+ [AppTerm first, AppTerm second] -> Just { first, second }

94+ _ -> Nothing

95+ _ -> Nothing

96+ getTupleElements _ = Nothing

lib/purelint/src/Purelint/Rules/FunctorLaw.pursnew file+89

@@ -0,0 +1,89 @@

1+module Purelint.Rules.FunctorLaw where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Tuple (Tuple(..))

8+import Data.Void (Void)

9+import Purelint.Imports (ImportInfo, hasValue, hasOp)

10+import Purelint.Print (printExpr)

11+import Purelint.Rule (Rule, RuleContext, mkRule)

12+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

13+import PureScript.CST.Range (rangeOf)

14+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

15+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, Operator(..), QualifiedName(..), Wrapped(..))

16+

17+-- | Rule: map f (map g x) -> map (f <<< g) x (functor fusion)

18+-- | Also: f <$> (g <$> x) -> (f <<< g) <$> x

19+functorLawRule :: Rule

20+functorLawRule = mkRule (RuleId "FunctorLaw") run

21+ where

22+ run :: RuleContext -> Module Void -> Array LintWarning

23+ run ctx = foldMapModule visitor

24+ where

25+ imports = ctx.imports

26+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

27+

28+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

29+ checkExpr imports expr = case expr of

30+ -- Match: map f (map g x)

31+ ExprApp fnExpr args | isMapLike imports fnExpr ->

32+ case NEA.toArray args of

33+ [AppTerm fExpr, AppTerm innerExpr] ->

34+ case unwrapParens innerExpr of

35+ ExprApp innerFn innerArgs | isMapLike imports innerFn ->

36+ case NEA.toArray innerArgs of

37+ [AppTerm gExpr, AppTerm xExpr] ->

38+ mkWarning expr fExpr gExpr xExpr "map"

39+ _ -> []

40+ _ -> []

41+ _ -> []

42+ -- Match: f <$> (g <$> x)

43+ ExprOp fExpr ops | hasOp imports "<$>" ->

44+ case NEA.toArray ops of

45+ [Tuple qn innerExpr] | isMapOp imports qn ->

46+ case unwrapParens innerExpr of

47+ ExprOp gExpr innerOps ->

48+ case NEA.toArray innerOps of

49+ [Tuple innerQn xExpr] | isMapOp imports innerQn ->

50+ mkWarning expr fExpr gExpr xExpr "<$>"

51+ _ -> []

52+ _ -> []

53+ _ -> []

54+ _ -> []

55+

56+ mkWarning :: Expr Void -> Expr Void -> Expr Void -> Expr Void -> String -> Array LintWarning

57+ mkWarning fullExpr fExpr gExpr xExpr style =

58+ let

59+ fText = printExpr fExpr

60+ gText = printExpr gExpr

61+ xText = printExpr xExpr

62+ replacement = if style == "map"

63+ then "map (" <> fText <> " <<< " <> gText <> ") " <> xText

64+ else "(" <> fText <> " <<< " <> gText <> ") <$> " <> xText

65+ in

66+ [ LintWarning

67+ { ruleId: RuleId "FunctorLaw"

68+ , message: WarningMessage "Functor law: fuse nested maps"

69+ , range: rangeOf fullExpr

70+ , severity: Warning

71+ , suggestion: Just $ Suggestion

72+ { replacement: ReplacementText replacement

73+ , description: SuggestionDescription $ style <> " f (" <> style <> " g x) can be fused to " <> style <> " (f <<< g) x"

74+ }

75+ }

76+ ]

77+

78+ unwrapParens :: Expr Void -> Expr Void

79+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

80+ unwrapParens e = e

81+

82+ isMapLike :: ImportInfo -> Expr Void -> Boolean

83+ isMapLike imports (ExprIdent (QualifiedName { name: Ident name })) =

84+ (name == "map" && hasValue imports "map") || (name == "fmap" && hasValue imports "fmap")

85+ isMapLike _ _ = false

86+

87+ isMapOp :: ImportInfo -> QualifiedName Operator -> Boolean

88+ isMapOp imports (QualifiedName { name: Operator op }) =

89+ op == "<$>" && hasOp imports "<$>"

lib/purelint/src/Purelint/Rules/MonoidIdentity.pursnew file+69

@@ -0,0 +1,69 @@

1+module Purelint.Rules.MonoidIdentity where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Tuple (Tuple(..))

8+import Data.Void (Void)

9+import Purelint.Imports (ImportInfo, hasValue, hasOp)

10+import Purelint.Print (printExpr)

11+import Purelint.Rule (Rule, RuleContext, mkRule)

12+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

13+import PureScript.CST.Range (rangeOf)

14+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

15+import PureScript.CST.Types (Expr(..), Ident(..), Module, Operator(..), QualifiedName(..))

16+

17+-- | Rule: mempty <> x -> x

18+-- | Also: x <> mempty -> x

19+monoidIdentityRule :: Rule

20+monoidIdentityRule = mkRule (RuleId "MonoidIdentity") run

21+ where

22+ run :: RuleContext -> Module Void -> Array LintWarning

23+ run ctx = foldMapModule visitor

24+ where

25+ imports = ctx.imports

26+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

27+

28+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

29+ checkExpr imports expr = case expr of

30+ -- Match: mempty <> x or x <> mempty

31+ ExprOp lhs ops | hasOp imports "<>" ->

32+ case NEA.toArray ops of

33+ [Tuple (QualifiedName { name: Operator op }) rhs] | op == "<>" ->

34+ if isMempty imports lhs then

35+ let rhsText = printExpr rhs

36+ in

37+ [ LintWarning

38+ { ruleId: RuleId "MonoidIdentity"

39+ , message: WarningMessage "mempty <> x is redundant"

40+ , range: rangeOf expr

41+ , severity: Warning

42+ , suggestion: Just $ Suggestion

43+ { replacement: ReplacementText rhsText

44+ , description: SuggestionDescription "mempty <> x can be simplified to x (Monoid left identity)"

45+ }

46+ }

47+ ]

48+ else if isMempty imports rhs then

49+ let lhsText = printExpr lhs

50+ in

51+ [ LintWarning

52+ { ruleId: RuleId "MonoidIdentity"

53+ , message: WarningMessage "x <> mempty is redundant"

54+ , range: rangeOf expr

55+ , severity: Warning

56+ , suggestion: Just $ Suggestion

57+ { replacement: ReplacementText lhsText

58+ , description: SuggestionDescription "x <> mempty can be simplified to x (Monoid right identity)"

59+ }

60+ }

61+ ]

62+ else []

63+ _ -> []

64+ _ -> []

65+

66+ isMempty :: ImportInfo -> Expr Void -> Boolean

67+ isMempty imports (ExprIdent (QualifiedName { name: Ident name })) =

68+ name == "mempty" && hasValue imports "mempty"

69+ isMempty _ _ = false

lib/purelint/src/Purelint/Rules/NothingBind.pursnew file+71

@@ -0,0 +1,71 @@

1+module Purelint.Rules.NothingBind where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Tuple (Tuple(..))

8+import Data.Void (Void)

9+import Purelint.Imports (ImportInfo, hasOp)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (Expr(..), Ident(..), Module, Operator(..), Proper(..), QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: Nothing >>= f -> Nothing

17+-- | Also: f =<< Nothing -> Nothing

18+nothingBindRule :: Rule

19+nothingBindRule = mkRule (RuleId "NothingBind") run

20+ where

21+ run :: RuleContext -> Module Void -> Array LintWarning

22+ run ctx = foldMapModule visitor

23+ where

24+ imports = ctx.imports

25+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

26+

27+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

28+ checkExpr imports expr = case expr of

29+ -- Match: Nothing >>= f

30+ ExprOp lhs ops

31+ | hasOp imports ">>=" ->

32+ case NEA.toArray ops of

33+ [Tuple (QualifiedName { name: Operator ">>=" }) _rhs] ->

34+ if isNothing (unwrapParens lhs) then

35+ [ LintWarning

36+ { ruleId: RuleId "NothingBind"

37+ , message: WarningMessage "Nothing >>= f is always Nothing"

38+ , range: rangeOf expr

39+ , severity: Warning

40+ , suggestion: Just $ Suggestion

41+ { replacement: ReplacementText "Nothing"

42+ , description: SuggestionDescription "Simplify Nothing >>= f to Nothing"

43+ }

44+ }

45+ ]

46+ else []

47+ [Tuple (QualifiedName { name: Operator "=<<" }) rhs] ->

48+ if isNothing (unwrapParens rhs) then

49+ [ LintWarning

50+ { ruleId: RuleId "NothingBind"

51+ , message: WarningMessage "f =<< Nothing is always Nothing"

52+ , range: rangeOf expr

53+ , severity: Warning

54+ , suggestion: Just $ Suggestion

55+ { replacement: ReplacementText "Nothing"

56+ , description: SuggestionDescription "Simplify f =<< Nothing to Nothing"

57+ }

58+ }

59+ ]

60+ else []

61+ _ -> []

62+ _ -> []

63+

64+ unwrapParens :: Expr Void -> Expr Void

65+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

66+ unwrapParens e = e

67+

68+ isNothing :: Expr Void -> Boolean

69+ isNothing (ExprIdent (QualifiedName { name: Ident "Nothing" })) = true

70+ isNothing (ExprConstructor (QualifiedName { name: Proper "Nothing" })) = true

71+ isNothing _ = false

lib/purelint/src/Purelint/Rules/RedundantBind.purs+25−16

@@ -11,7 +11,7 @@ import Purelint.Rule (Rule, RuleContext, mkRule)

1111import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

1212import PureScript.CST.Range (rangeOf)

1313import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14−import PureScript.CST.Types (Expr(..), Ident(..), Module, Operator(..), QualifiedName(..))

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, Operator(..), QualifiedName(..))

1515import Data.Void (Void)

1616

1717-- | Rule: x >>= pure -> x

@@ -53,24 +53,33 @@ redundantBindRule = mkRule (RuleId "RedundantBind") run

5353 }

5454 }

5555 ]

56− else if isPureApp imports lhs then

57− -- pure x >>= f -> f x (don't auto-fix this one, too complex)

58− [ LintWarning

59− { ruleId: RuleId "RedundantBind"

60− , message: WarningMessage "pure x >>= f can be simplified"

61− , range: rangeOf fullExpr

62− , severity: Hint

63− , suggestion: Nothing -- No auto-fix for this pattern

64− }

65− ]

66− else

67− []

56+ else case getPureArg imports lhs of

57+ Just arg ->

58+ -- pure x >>= f -> f x

59+ let replacement = printExpr rhs <> " " <> printExpr arg

60+ in

61+ [ LintWarning

62+ { ruleId: RuleId "RedundantBind"

63+ , message: WarningMessage "pure x >>= f can be simplified to f x"

64+ , range: rangeOf fullExpr

65+ , severity: Warning

66+ , suggestion: Just $ Suggestion

67+ { replacement: ReplacementText replacement

68+ , description: SuggestionDescription "Apply f directly to x"

69+ }

70+ }

71+ ]

72+ Nothing -> []

6873

6974 isPure :: ImportInfo -> Expr Void -> Boolean

7075 isPure imports (ExprIdent (QualifiedName { name: Ident name })) =

7176 (name == "pure" && hasValue imports "pure") || (name == "return" && hasValue imports "pure")

7277 isPure _ _ = false

7378

74− isPureApp :: ImportInfo -> Expr Void -> Boolean

75− isPureApp imports (ExprApp fn _) = isPure imports fn

76− isPureApp _ _ = false

79+ getPureArg :: ImportInfo -> Expr Void -> Maybe (Expr Void)

80+ getPureArg imports (ExprApp fn args)

81+ | isPure imports fn =

82+ case NEA.toArray args of

83+ [AppTerm arg] -> Just arg

84+ _ -> Nothing

85+ getPureArg _ _ = Nothing

lib/purelint/src/Purelint/Rules/RedundantFlip.pursnew file+62

@@ -0,0 +1,62 @@

1+module Purelint.Rules.RedundantFlip where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: flip (flip f) -> f

17+redundantFlipRule :: Rule

18+redundantFlipRule = mkRule (RuleId "RedundantFlip") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: flip (flip f)

29+ ExprApp fnExpr args | isFlip imports fnExpr ->

30+ case NEA.toArray args of

31+ [AppTerm innerExpr] ->

32+ case getFlipArg imports innerExpr of

33+ Just f ->

34+ let fText = printExpr f

35+ in

36+ [ LintWarning

37+ { ruleId: RuleId "RedundantFlip"

38+ , message: WarningMessage "flip (flip f) is redundant"

39+ , range: rangeOf expr

40+ , severity: Warning

41+ , suggestion: Just $ Suggestion

42+ { replacement: ReplacementText fText

43+ , description: SuggestionDescription "flip (flip f) can be simplified to f"

44+ }

45+ }

46+ ]

47+ Nothing -> []

48+ _ -> []

49+ _ -> []

50+

51+ isFlip :: ImportInfo -> Expr Void -> Boolean

52+ isFlip imports (ExprIdent (QualifiedName { name: Ident name })) =

53+ name == "flip" && hasValue imports "flip"

54+ isFlip _ _ = false

55+

56+ getFlipArg :: ImportInfo -> Expr Void -> Maybe (Expr Void)

57+ getFlipArg imports (ExprApp fnExpr args) | isFlip imports fnExpr =

58+ case NEA.toArray args of

59+ [AppTerm f] -> Just f

60+ _ -> Nothing

61+ getFlipArg imports (ExprParens (Wrapped { value })) = getFlipArg imports value

62+ getFlipArg _ _ = Nothing

lib/purelint/src/Purelint/Rules/RedundantGuard.pursnew file+71

@@ -0,0 +1,71 @@

1+module Purelint.Rules.RedundantGuard where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Rule (Rule, RuleContext, mkRule)

10+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

11+import PureScript.CST.Range (rangeOf)

12+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

13+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

14+

15+-- | Rule: guard true -> pure unit

16+redundantGuardRule :: Rule

17+redundantGuardRule = mkRule (RuleId "RedundantGuard") run

18+ where

19+ run :: RuleContext -> Module Void -> Array LintWarning

20+ run ctx = foldMapModule visitor

21+ where

22+ imports = ctx.imports

23+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

24+

25+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

26+ checkExpr imports expr = case expr of

27+ -- Match: guard true

28+ ExprApp fnExpr args

29+ | isGuard imports fnExpr ->

30+ case NEA.toArray args of

31+ [AppTerm argExpr]

32+ | isTrue (unwrapParens argExpr) ->

33+ [ LintWarning

34+ { ruleId: RuleId "RedundantGuard"

35+ , message: WarningMessage "guard true is always successful"

36+ , range: rangeOf expr

37+ , severity: Warning

38+ , suggestion: Just $ Suggestion

39+ { replacement: ReplacementText "pure unit"

40+ , description: SuggestionDescription "guard true can be replaced with pure unit"

41+ }

42+ }

43+ ]

44+ | isFalse (unwrapParens argExpr) ->

45+ [ LintWarning

46+ { ruleId: RuleId "RedundantGuard"

47+ , message: WarningMessage "guard false always fails"

48+ , range: rangeOf expr

49+ , severity: Warning

50+ , suggestion: Nothing

51+ }

52+ ]

53+ _ -> []

54+ _ -> []

55+

56+ unwrapParens :: Expr Void -> Expr Void

57+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

58+ unwrapParens e = e

59+

60+ isGuard :: ImportInfo -> Expr Void -> Boolean

61+ isGuard imports (ExprIdent (QualifiedName { name: Ident name })) =

62+ name == "guard" && hasValue imports "guard"

63+ isGuard _ _ = false

64+

65+ isTrue :: Expr Void -> Boolean

66+ isTrue (ExprBoolean _ b) = b

67+ isTrue _ = false

68+

69+ isFalse :: Expr Void -> Boolean

70+ isFalse (ExprBoolean _ b) = not b

71+ isFalse _ = false

lib/purelint/src/Purelint/Rules/RedundantId.pursnew file+124

@@ -0,0 +1,124 @@

1+module Purelint.Rules.RedundantId where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Tuple (Tuple(..))

8+import Data.Void (Void)

9+import Purelint.Imports (ImportInfo, hasValue, hasOp)

10+import Purelint.Print (printExpr)

11+import Purelint.Rule (Rule, RuleContext, mkRule)

12+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

13+import PureScript.CST.Range (rangeOf)

14+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

15+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, Operator(..), QualifiedName(..), Wrapped(..))

16+

17+-- | Rule: identity x -> x

18+-- | Also: x <<< identity -> x

19+-- | Also: identity <<< x -> x

20+redundantIdRule :: Rule

21+redundantIdRule = mkRule (RuleId "RedundantId") run

22+ where

23+ run :: RuleContext -> Module Void -> Array LintWarning

24+ run ctx = foldMapModule visitor

25+ where

26+ imports = ctx.imports

27+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

28+

29+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

30+ checkExpr imports expr = case expr of

31+ -- Match: identity x (applied)

32+ ExprApp fn args

33+ | isIdentity imports fn ->

34+ case NEA.toArray args of

35+ [AppTerm arg] ->

36+ let x = printExpr arg

37+ in

38+ [ LintWarning

39+ { ruleId: RuleId "RedundantId"

40+ , message: WarningMessage "identity x is redundant"

41+ , range: rangeOf expr

42+ , severity: Warning

43+ , suggestion: Just $ Suggestion

44+ { replacement: ReplacementText x

45+ , description: SuggestionDescription "Remove redundant identity application"

46+ }

47+ }

48+ ]

49+ _ -> []

50+ -- Match: x <<< identity or identity <<< x

51+ ExprOp lhs ops

52+ | hasOp imports "<<<" ->

53+ case NEA.toArray ops of

54+ [Tuple (QualifiedName { name: Operator "<<<" }) rhs] ->

55+ if isIdentity imports (unwrapParens rhs) then

56+ let x = printExpr lhs

57+ in

58+ [ LintWarning

59+ { ruleId: RuleId "RedundantId"

60+ , message: WarningMessage "x <<< identity is redundant"

61+ , range: rangeOf expr

62+ , severity: Warning

63+ , suggestion: Just $ Suggestion

64+ { replacement: ReplacementText x

65+ , description: SuggestionDescription "Remove redundant identity composition"

66+ }

67+ }

68+ ]

69+ else if isIdentity imports (unwrapParens lhs) then

70+ let x = printExpr rhs

71+ in

72+ [ LintWarning

73+ { ruleId: RuleId "RedundantId"

74+ , message: WarningMessage "identity <<< x is redundant"

75+ , range: rangeOf expr

76+ , severity: Warning

77+ , suggestion: Just $ Suggestion

78+ { replacement: ReplacementText x

79+ , description: SuggestionDescription "Remove redundant identity composition"

80+ }

81+ }

82+ ]

83+ else []

84+ [Tuple (QualifiedName { name: Operator ">>>" }) rhs] ->

85+ if isIdentity imports (unwrapParens lhs) then

86+ let x = printExpr rhs

87+ in

88+ [ LintWarning

89+ { ruleId: RuleId "RedundantId"

90+ , message: WarningMessage "identity >>> x is redundant"

91+ , range: rangeOf expr

92+ , severity: Warning

93+ , suggestion: Just $ Suggestion

94+ { replacement: ReplacementText x

95+ , description: SuggestionDescription "Remove redundant identity composition"

96+ }

97+ }

98+ ]

99+ else if isIdentity imports (unwrapParens rhs) then

100+ let x = printExpr lhs

101+ in

102+ [ LintWarning

103+ { ruleId: RuleId "RedundantId"

104+ , message: WarningMessage "x >>> identity is redundant"

105+ , range: rangeOf expr

106+ , severity: Warning

107+ , suggestion: Just $ Suggestion

108+ { replacement: ReplacementText x

109+ , description: SuggestionDescription "Remove redundant identity composition"

110+ }

111+ }

112+ ]

113+ else []

114+ _ -> []

115+ _ -> []

116+

117+ unwrapParens :: Expr Void -> Expr Void

118+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

119+ unwrapParens e = e

120+

121+ isIdentity :: ImportInfo -> Expr Void -> Boolean

122+ isIdentity imports (ExprIdent (QualifiedName { name: Ident name })) =

123+ (name == "identity" || name == "id") && hasValue imports "identity"

124+ isIdentity _ _ = false

lib/purelint/src/Purelint/Rules/RedundantIf.pursnew file+65

@@ -0,0 +1,65 @@

1+module Purelint.Rules.RedundantIf where

3+import Prelude

5+import Data.Maybe (Maybe(..))

6+import Data.Void (Void)

7+import Purelint.Imports (ImportInfo, hasValue)

8+import Purelint.Print (printExpr)

9+import Purelint.Rule (Rule, RuleContext, mkRule)

10+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

11+import PureScript.CST.Range (rangeOf)

12+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

13+import PureScript.CST.Types (Expr(..), Module)

14+

15+-- | Rule: if a then true else false -> a

16+-- | Also: if a then false else true -> not a

17+redundantIfRule :: Rule

18+redundantIfRule = mkRule (RuleId "RedundantIf") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ ExprIf ifExpr ->

29+ let

30+ thenExpr = ifExpr.true

31+ elseExpr = ifExpr.false

32+ condExpr = ifExpr.cond

33+ in

34+ -- if a then true else false -> a

35+ if isBoolLit true thenExpr && isBoolLit false elseExpr then

36+ [ LintWarning

37+ { ruleId: RuleId "RedundantIf"

38+ , message: WarningMessage "Redundant if: if a then true else false"

39+ , range: rangeOf expr

40+ , severity: Warning

41+ , suggestion: Just $ Suggestion

42+ { replacement: ReplacementText (printExpr condExpr)

43+ , description: SuggestionDescription "if a then true else false can be simplified to a"

44+ }

45+ }

46+ ]

47+ -- if a then false else true -> not a

48+ else if isBoolLit false thenExpr && isBoolLit true elseExpr && hasValue imports "not" then

49+ [ LintWarning

50+ { ruleId: RuleId "RedundantIf"

51+ , message: WarningMessage "Redundant if: if a then false else true"

52+ , range: rangeOf expr

53+ , severity: Warning

54+ , suggestion: Just $ Suggestion

55+ { replacement: ReplacementText ("not " <> printExpr condExpr)

56+ , description: SuggestionDescription "if a then false else true can be simplified to not a"

57+ }

58+ }

59+ ]

60+ else []

61+ _ -> []

62+

63+ isBoolLit :: Boolean -> Expr Void -> Boolean

64+ isBoolLit expected (ExprBoolean _ val) = val == expected

65+ isBoolLit _ _ = false

lib/purelint/src/Purelint/Rules/RedundantNegate.pursnew file+63

@@ -0,0 +1,63 @@

1+module Purelint.Rules.RedundantNegate where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: negate (negate x) -> x

17+redundantNegateRule :: Rule

18+redundantNegateRule = mkRule (RuleId "RedundantNegate") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: negate (negate x)

29+ ExprApp fn args

30+ | isNegate imports fn ->

31+ case NEA.toArray args of

32+ [AppTerm arg] ->

33+ case unwrapParens arg of

34+ ExprApp innerFn innerArgs

35+ | isNegate imports innerFn ->

36+ case NEA.toArray innerArgs of

37+ [AppTerm innerArg] ->

38+ let x = printExpr innerArg

39+ in

40+ [ LintWarning

41+ { ruleId: RuleId "RedundantNegate"

42+ , message: WarningMessage "negate (negate x) is redundant"

43+ , range: rangeOf expr

44+ , severity: Warning

45+ , suggestion: Just $ Suggestion

46+ { replacement: ReplacementText x

47+ , description: SuggestionDescription "Remove redundant double negation"

48+ }

49+ }

50+ ]

51+ _ -> []

52+ _ -> []

53+ _ -> []

54+ _ -> []

55+

56+ unwrapParens :: Expr Void -> Expr Void

57+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

58+ unwrapParens e = e

59+

60+ isNegate :: ImportInfo -> Expr Void -> Boolean

61+ isNegate imports (ExprIdent (QualifiedName { name: Ident name })) =

62+ name == "negate" && hasValue imports "negate"

63+ isNegate _ _ = false

lib/purelint/src/Purelint/Rules/RedundantNot.pursnew file+62

@@ -0,0 +1,62 @@

1+module Purelint.Rules.RedundantNot where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: not (not x) -> x

17+redundantNotRule :: Rule

18+redundantNotRule = mkRule (RuleId "RedundantNot") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: not (not x)

29+ ExprApp fnExpr args | isNot imports fnExpr ->

30+ case NEA.toArray args of

31+ [AppTerm innerExpr] ->

32+ case getNotArg imports innerExpr of

33+ Just x ->

34+ let xText = printExpr x

35+ in

36+ [ LintWarning

37+ { ruleId: RuleId "RedundantNot"

38+ , message: WarningMessage "not (not x) is redundant"

39+ , range: rangeOf expr

40+ , severity: Warning

41+ , suggestion: Just $ Suggestion

42+ { replacement: ReplacementText xText

43+ , description: SuggestionDescription "not (not x) can be simplified to x"

44+ }

45+ }

46+ ]

47+ Nothing -> []

48+ _ -> []

49+ _ -> []

50+

51+ isNot :: ImportInfo -> Expr Void -> Boolean

52+ isNot imports (ExprIdent (QualifiedName { name: Ident name })) =

53+ name == "not" && hasValue imports "not"

54+ isNot _ _ = false

55+

56+ getNotArg :: ImportInfo -> Expr Void -> Maybe (Expr Void)

57+ getNotArg imports (ExprApp fnExpr args) | isNot imports fnExpr =

58+ case NEA.toArray args of

59+ [AppTerm x] -> Just x

60+ _ -> Nothing

61+ getNotArg imports (ExprParens (Wrapped { value })) = getNotArg imports value

62+ getNotArg _ _ = Nothing

lib/purelint/src/Purelint/Rules/RedundantReverse.pursnew file+63

@@ -0,0 +1,63 @@

1+module Purelint.Rules.RedundantReverse where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: reverse (reverse x) -> x

17+redundantReverseRule :: Rule

18+redundantReverseRule = mkRule (RuleId "RedundantReverse") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: reverse (reverse x)

29+ ExprApp fn args

30+ | isReverse imports fn ->

31+ case NEA.toArray args of

32+ [AppTerm arg] ->

33+ case unwrapParens arg of

34+ ExprApp innerFn innerArgs

35+ | isReverse imports innerFn ->

36+ case NEA.toArray innerArgs of

37+ [AppTerm innerArg] ->

38+ let x = printExpr innerArg

39+ in

40+ [ LintWarning

41+ { ruleId: RuleId "RedundantReverse"

42+ , message: WarningMessage "reverse (reverse x) is redundant"

43+ , range: rangeOf expr

44+ , severity: Warning

45+ , suggestion: Just $ Suggestion

46+ { replacement: ReplacementText x

47+ , description: SuggestionDescription "Remove redundant double reverse"

48+ }

49+ }

50+ ]

51+ _ -> []

52+ _ -> []

53+ _ -> []

54+ _ -> []

55+

56+ unwrapParens :: Expr Void -> Expr Void

57+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

58+ unwrapParens e = e

59+

60+ isReverse :: ImportInfo -> Expr Void -> Boolean

61+ isReverse imports (ExprIdent (QualifiedName { name: Ident name })) =

62+ name == "reverse" && hasValue imports "reverse"

63+ isReverse _ _ = false

lib/purelint/src/Purelint/Rules/UnlessNot.pursnew file+93

@@ -0,0 +1,93 @@

1+module Purelint.Rules.UnlessNot where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: unless (not x) -> when x

17+unlessNotRule :: Rule

18+unlessNotRule = mkRule (RuleId "UnlessNot") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: unless (not x) action

29+ ExprApp fn args

30+ | isUnless imports fn ->

31+ case NEA.toArray args of

32+ [AppTerm condArg, AppTerm actionArg] ->

33+ case getNotArg imports (unwrapParens condArg) of

34+ Just x ->

35+ let

36+ xText = printExpr x

37+ action = printExpr actionArg

38+ in

39+ [ LintWarning

40+ { ruleId: RuleId "UnlessNot"

41+ , message: WarningMessage "unless (not x) can be simplified to when x"

42+ , range: rangeOf expr

43+ , severity: Hint

44+ , suggestion: Just $ Suggestion

45+ { replacement: ReplacementText ("when " <> xText <> " " <> action)

46+ , description: SuggestionDescription "Use when instead of unless (not ...)"

47+ }

48+ }

49+ ]

50+ Nothing -> []

51+ [AppTerm condArg] ->

52+ case getNotArg imports (unwrapParens condArg) of

53+ Just x ->

54+ let xText = printExpr x

55+ in

56+ [ LintWarning

57+ { ruleId: RuleId "UnlessNot"

58+ , message: WarningMessage "unless (not x) can be simplified to when x"

59+ , range: rangeOf expr

60+ , severity: Hint

61+ , suggestion: Just $ Suggestion

62+ { replacement: ReplacementText ("when " <> xText)

63+ , description: SuggestionDescription "Use when instead of unless (not ...)"

64+ }

65+ }

66+ ]

67+ Nothing -> []

68+ _ -> []

69+ _ -> []

70+

71+ unwrapParens :: Expr Void -> Expr Void

72+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

73+ unwrapParens e = e

74+

75+ isUnless :: ImportInfo -> Expr Void -> Boolean

76+ isUnless imports (ExprIdent (QualifiedName { name: Ident name })) =

77+ name == "unless" && hasValue imports "unless"

78+ isUnless _ _ = false

79+

80+ isNot :: ImportInfo -> Expr Void -> Boolean

81+ isNot imports (ExprIdent (QualifiedName { name: Ident name })) =

82+ name == "not" && hasValue imports "not"

83+ isNot _ _ = false

84+

85+ getNotArg :: ImportInfo -> Expr Void -> Maybe (Expr Void)

86+ getNotArg imports e =

87+ case e of

88+ ExprApp notFn args

89+ | isNot imports notFn ->

90+ case NEA.toArray args of

91+ [AppTerm arg] -> Just arg

92+ _ -> Nothing

93+ _ -> Nothing

lib/purelint/src/Purelint/Rules/UseAll.pursnew file+68

@@ -0,0 +1,68 @@

1+module Purelint.Rules.UseAll where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: and (map f x) -> all f x

17+useAllRule :: Rule

18+useAllRule = mkRule (RuleId "UseAll") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: and (map f x)

29+ ExprApp fnExpr args | isAnd imports fnExpr ->

30+ case NEA.toArray args of

31+ [AppTerm innerExpr] ->

32+ case unwrapParens innerExpr of

33+ ExprApp mapFn mapArgs | isMapLike imports mapFn ->

34+ case NEA.toArray mapArgs of

35+ [AppTerm fExpr, AppTerm xExpr] ->

36+ let

37+ fText = printExpr fExpr

38+ xText = printExpr xExpr

39+ in

40+ [ LintWarning

41+ { ruleId: RuleId "UseAll"

42+ , message: WarningMessage "Use all instead of and (map f x)"

43+ , range: rangeOf expr

44+ , severity: Warning

45+ , suggestion: Just $ Suggestion

46+ { replacement: ReplacementText ("all " <> fText <> " " <> xText)

47+ , description: SuggestionDescription "and (map f x) can be simplified to all f x"

48+ }

49+ }

50+ ]

51+ _ -> []

52+ _ -> []

53+ _ -> []

54+ _ -> []

55+

56+ unwrapParens :: Expr Void -> Expr Void

57+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

58+ unwrapParens e = e

59+

60+ isAnd :: ImportInfo -> Expr Void -> Boolean

61+ isAnd imports (ExprIdent (QualifiedName { name: Ident name })) =

62+ name == "and" && hasValue imports "and"

63+ isAnd _ _ = false

64+

65+ isMapLike :: ImportInfo -> Expr Void -> Boolean

66+ isMapLike imports (ExprIdent (QualifiedName { name: Ident name })) =

67+ (name == "map" && hasValue imports "map") || (name == "fmap" && hasValue imports "fmap")

68+ isMapLike _ _ = false

lib/purelint/src/Purelint/Rules/UseAnd.pursnew file+77

@@ -0,0 +1,77 @@

1+module Purelint.Rules.UseAnd where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: all identity -> and

17+useAndRule :: Rule

18+useAndRule = mkRule (RuleId "UseAnd") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: all identity xs

29+ ExprApp fn args

30+ | isAll imports fn ->

31+ case NEA.toArray args of

32+ [AppTerm predArg] ->

33+ if isIdentity imports (unwrapParens predArg) then

34+ [ LintWarning

35+ { ruleId: RuleId "UseAnd"

36+ , message: WarningMessage "all identity can be simplified to and"

37+ , range: rangeOf expr

38+ , severity: Warning

39+ , suggestion: Just $ Suggestion

40+ { replacement: ReplacementText "and"

41+ , description: SuggestionDescription "Use and instead of all identity"

42+ }

43+ }

44+ ]

45+ else []

46+ [AppTerm predArg, AppTerm xArg] ->

47+ if isIdentity imports (unwrapParens predArg) then

48+ let x = printExpr xArg

49+ in

50+ [ LintWarning

51+ { ruleId: RuleId "UseAnd"

52+ , message: WarningMessage "all identity xs can be simplified to and xs"

53+ , range: rangeOf expr

54+ , severity: Warning

55+ , suggestion: Just $ Suggestion

56+ { replacement: ReplacementText ("and " <> x)

57+ , description: SuggestionDescription "Use and instead of all identity"

58+ }

59+ }

60+ ]

61+ else []

62+ _ -> []

63+ _ -> []

64+

65+ unwrapParens :: Expr Void -> Expr Void

66+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

67+ unwrapParens e = e

68+

69+ isAll :: ImportInfo -> Expr Void -> Boolean

70+ isAll imports (ExprIdent (QualifiedName { name: Ident name })) =

71+ name == "all" && hasValue imports "all"

72+ isAll _ _ = false

73+

74+ isIdentity :: ImportInfo -> Expr Void -> Boolean

75+ isIdentity imports (ExprIdent (QualifiedName { name: Ident name })) =

76+ (name == "identity" || name == "id") && hasValue imports "identity"

77+ isIdentity _ _ = false

lib/purelint/src/Purelint/Rules/UseAny.pursnew file+68

@@ -0,0 +1,68 @@

1+module Purelint.Rules.UseAny where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: or (map f x) -> any f x

17+useAnyRule :: Rule

18+useAnyRule = mkRule (RuleId "UseAny") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: or (map f x)

29+ ExprApp fnExpr args | isOr imports fnExpr ->

30+ case NEA.toArray args of

31+ [AppTerm innerExpr] ->

32+ case unwrapParens innerExpr of

33+ ExprApp mapFn mapArgs | isMapLike imports mapFn ->

34+ case NEA.toArray mapArgs of

35+ [AppTerm fExpr, AppTerm xExpr] ->

36+ let

37+ fText = printExpr fExpr

38+ xText = printExpr xExpr

39+ in

40+ [ LintWarning

41+ { ruleId: RuleId "UseAny"

42+ , message: WarningMessage "Use any instead of or (map f x)"

43+ , range: rangeOf expr

44+ , severity: Warning

45+ , suggestion: Just $ Suggestion

46+ { replacement: ReplacementText ("any " <> fText <> " " <> xText)

47+ , description: SuggestionDescription "or (map f x) can be simplified to any f x"

48+ }

49+ }

50+ ]

51+ _ -> []

52+ _ -> []

53+ _ -> []

54+ _ -> []

55+

56+ unwrapParens :: Expr Void -> Expr Void

57+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

58+ unwrapParens e = e

59+

60+ isOr :: ImportInfo -> Expr Void -> Boolean

61+ isOr imports (ExprIdent (QualifiedName { name: Ident name })) =

62+ name == "or" && hasValue imports "or"

63+ isOr _ _ = false

64+

65+ isMapLike :: ImportInfo -> Expr Void -> Boolean

66+ isMapLike imports (ExprIdent (QualifiedName { name: Ident name })) =

67+ (name == "map" && hasValue imports "map") || (name == "fmap" && hasValue imports "fmap")

68+ isMapLike _ _ = false

lib/purelint/src/Purelint/Rules/UseApplicative.pursnew file+66

@@ -0,0 +1,66 @@

1+module Purelint.Rules.UseApplicative where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Tuple (Tuple(..))

8+import Data.Void (Void)

9+import Purelint.Imports (ImportInfo, hasValue, hasOp)

10+import Purelint.Print (printExpr)

11+import Purelint.Rule (Rule, RuleContext, mkRule)

12+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

13+import PureScript.CST.Range (rangeOf)

14+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

15+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, Operator(..), QualifiedName(..), Wrapped(..))

16+

17+-- | Rule: pure f <*> x -> f <$> x

18+useApplicativeRule :: Rule

19+useApplicativeRule = mkRule (RuleId "UseApplicative") run

20+ where

21+ run :: RuleContext -> Module Void -> Array LintWarning

22+ run ctx = foldMapModule visitor

23+ where

24+ imports = ctx.imports

25+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

26+

27+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

28+ checkExpr imports expr = case expr of

29+ -- Match: pure f <*> x

30+ ExprOp lhs ops

31+ | hasOp imports "<*>" ->

32+ case unwrapParens lhs of

33+ ExprApp pureExpr args

34+ | isPure imports pureExpr ->

35+ case NEA.toArray args of

36+ [AppTerm fExpr] ->

37+ case NEA.toArray ops of

38+ [Tuple (QualifiedName { name: Operator "<*>" }) xExpr] ->

39+ let

40+ f = printExpr fExpr

41+ x = printExpr xExpr

42+ in

43+ [ LintWarning

44+ { ruleId: RuleId "UseApplicative"

45+ , message: WarningMessage "pure f <*> x can be simplified to f <$> x"

46+ , range: rangeOf expr

47+ , severity: Hint

48+ , suggestion: Just $ Suggestion

49+ { replacement: ReplacementText (f <> " <$> " <> x)

50+ , description: SuggestionDescription "Use <$> instead of pure f <*> x"

51+ }

52+ }

53+ ]

54+ _ -> []

55+ _ -> []

56+ _ -> []

57+ _ -> []

58+

59+ unwrapParens :: Expr Void -> Expr Void

60+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

61+ unwrapParens e = e

62+

63+ isPure :: ImportInfo -> Expr Void -> Boolean

64+ isPure imports (ExprIdent (QualifiedName { name: Ident name })) =

65+ name == "pure" && hasValue imports "pure"

66+ isPure _ _ = false

lib/purelint/src/Purelint/Rules/UseBimap.pursnew file+205

@@ -0,0 +1,205 @@

1+module Purelint.Rules.UseBimap where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: bimap id g -> second g

17+-- | Also: bimap f id -> first f

18+-- | Also: first f (second g x) -> bimap f g x

19+useBimapRule :: Rule

20+useBimapRule = mkRule (RuleId "UseBimap") run

21+ where

22+ run :: RuleContext -> Module Void -> Array LintWarning

23+ run ctx = foldMapModule visitor

24+ where

25+ imports = ctx.imports

26+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

27+

28+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

29+ checkExpr imports expr = case expr of

30+ -- Match: bimap id g or bimap f id

31+ ExprApp fn args

32+ | isBimap imports fn ->

33+ case NEA.toArray args of

34+ [AppTerm fArg, AppTerm gArg] ->

35+ let fIsId = isIdentity imports fArg

36+ gIsId = isIdentity imports gArg

37+ in

38+ if fIsId && not gIsId then

39+ let g = printExpr gArg

40+ in

41+ [ LintWarning

42+ { ruleId: RuleId "UseBimap"

43+ , message: WarningMessage "bimap id g can be simplified to second g"

44+ , range: rangeOf expr

45+ , severity: Warning

46+ , suggestion: Just $ Suggestion

47+ { replacement: ReplacementText ("second " <> g)

48+ , description: SuggestionDescription "Use second instead of bimap id"

49+ }

50+ }

51+ ]

52+ else if gIsId && not fIsId then

53+ let f = printExpr fArg

54+ in

55+ [ LintWarning

56+ { ruleId: RuleId "UseBimap"

57+ , message: WarningMessage "bimap f id can be simplified to first f"

58+ , range: rangeOf expr

59+ , severity: Warning

60+ , suggestion: Just $ Suggestion

61+ { replacement: ReplacementText ("first " <> f)

62+ , description: SuggestionDescription "Use first instead of bimap f id"

63+ }

64+ }

65+ ]

66+ else if fIsId && gIsId then

67+ [ LintWarning

68+ { ruleId: RuleId "UseBimap"

69+ , message: WarningMessage "bimap id id is redundant"

70+ , range: rangeOf expr

71+ , severity: Warning

72+ , suggestion: Just $ Suggestion

73+ { replacement: ReplacementText "identity"

74+ , description: SuggestionDescription "bimap id id is just identity"

75+ }

76+ }

77+ ]

78+ else []

79+ [AppTerm fArg, AppTerm gArg, AppTerm xArg] ->

80+ let fIsId = isIdentity imports fArg

81+ gIsId = isIdentity imports gArg

82+ x = printExpr xArg

83+ in

84+ if fIsId && not gIsId then

85+ let g = printExpr gArg

86+ in

87+ [ LintWarning

88+ { ruleId: RuleId "UseBimap"

89+ , message: WarningMessage "bimap id g x can be simplified to second g x"

90+ , range: rangeOf expr

91+ , severity: Warning

92+ , suggestion: Just $ Suggestion

93+ { replacement: ReplacementText ("second " <> g <> " " <> x)

94+ , description: SuggestionDescription "Use second instead of bimap id"

95+ }

96+ }

97+ ]

98+ else if gIsId && not fIsId then

99+ let f = printExpr fArg

100+ in

101+ [ LintWarning

102+ { ruleId: RuleId "UseBimap"

103+ , message: WarningMessage "bimap f id x can be simplified to first f x"

104+ , range: rangeOf expr

105+ , severity: Warning

106+ , suggestion: Just $ Suggestion

107+ { replacement: ReplacementText ("first " <> f <> " " <> x)

108+ , description: SuggestionDescription "Use first instead of bimap f id"

109+ }

110+ }

111+ ]

112+ else if fIsId && gIsId then

113+ [ LintWarning

114+ { ruleId: RuleId "UseBimap"

115+ , message: WarningMessage "bimap id id x is redundant"

116+ , range: rangeOf expr

117+ , severity: Warning

118+ , suggestion: Just $ Suggestion

119+ { replacement: ReplacementText x

120+ , description: SuggestionDescription "bimap id id x is just x"

121+ }

122+ }

123+ ]

124+ else []

125+ _ -> []

126+ -- Match: first f (second g x) or second g (first f x)

127+ | isFirst imports fn ->

128+ case NEA.toArray args of

129+ [AppTerm fArg, AppTerm innerArg] ->

130+ case unwrapParens innerArg of

131+ ExprApp secondFn secondArgs

132+ | isSecond imports secondFn ->

133+ case NEA.toArray secondArgs of

134+ [AppTerm gArg, AppTerm xArg] ->

135+ let

136+ f = printExpr fArg

137+ g = printExpr gArg

138+ x = printExpr xArg

139+ in

140+ [ LintWarning

141+ { ruleId: RuleId "UseBimap"

142+ , message: WarningMessage "first f (second g x) can be simplified to bimap f g x"

143+ , range: rangeOf expr

144+ , severity: Hint

145+ , suggestion: Just $ Suggestion

146+ { replacement: ReplacementText ("bimap " <> f <> " " <> g <> " " <> x)

147+ , description: SuggestionDescription "Use bimap instead of first and second"

148+ }

149+ }

150+ ]

151+ _ -> []

152+ _ -> []

153+ _ -> []

154+ | isSecond imports fn ->

155+ case NEA.toArray args of

156+ [AppTerm gArg, AppTerm innerArg] ->

157+ case unwrapParens innerArg of

158+ ExprApp firstFn firstArgs

159+ | isFirst imports firstFn ->

160+ case NEA.toArray firstArgs of

161+ [AppTerm fArg, AppTerm xArg] ->

162+ let

163+ f = printExpr fArg

164+ g = printExpr gArg

165+ x = printExpr xArg

166+ in

167+ [ LintWarning

168+ { ruleId: RuleId "UseBimap"

169+ , message: WarningMessage "second g (first f x) can be simplified to bimap f g x"

170+ , range: rangeOf expr

171+ , severity: Hint

172+ , suggestion: Just $ Suggestion

173+ { replacement: ReplacementText ("bimap " <> f <> " " <> g <> " " <> x)

174+ , description: SuggestionDescription "Use bimap instead of first and second"

175+ }

176+ }

177+ ]

178+ _ -> []

179+ _ -> []

180+ _ -> []

181+ _ -> []

182+

183+ unwrapParens :: Expr Void -> Expr Void

184+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

185+ unwrapParens e = e

186+

187+ isBimap :: ImportInfo -> Expr Void -> Boolean

188+ isBimap imports (ExprIdent (QualifiedName { name: Ident name })) =

189+ name == "bimap" && hasValue imports "bimap"

190+ isBimap _ _ = false

191+

192+ isFirst :: ImportInfo -> Expr Void -> Boolean

193+ isFirst imports (ExprIdent (QualifiedName { name: Ident name })) =

194+ name == "first" && hasValue imports "first"

195+ isFirst _ _ = false

196+

197+ isSecond :: ImportInfo -> Expr Void -> Boolean

198+ isSecond imports (ExprIdent (QualifiedName { name: Ident name })) =

199+ name == "second" && hasValue imports "second"

200+ isSecond _ _ = false

201+

202+ isIdentity :: ImportInfo -> Expr Void -> Boolean

203+ isIdentity imports (ExprIdent (QualifiedName { name: Ident name })) =

204+ (name == "identity" && hasValue imports "identity") || (name == "id" && hasValue imports "identity")

205+ isIdentity _ _ = false

lib/purelint/src/Purelint/Rules/UseBindFlip.pursnew file+73

@@ -0,0 +1,73 @@

1+module Purelint.Rules.UseBindFlip where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: join (map f x) -> x >>= f

17+useBindFlipRule :: Rule

18+useBindFlipRule = mkRule (RuleId "UseBindFlip") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: join (map f x)

29+ ExprApp fnExpr args

30+ | isJoin imports fnExpr ->

31+ case NEA.toArray args of

32+ [AppTerm innerExpr] ->

33+ checkInnerMap imports expr (unwrapParens innerExpr)

34+ _ -> []

35+ _ -> []

36+

37+ unwrapParens :: Expr Void -> Expr Void

38+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

39+ unwrapParens e = e

40+

41+ checkInnerMap :: ImportInfo -> Expr Void -> Expr Void -> Array LintWarning

42+ checkInnerMap imports fullExpr innerExpr =

43+ case innerExpr of

44+ ExprApp mapFn mapArgs | isMap imports mapFn ->

45+ case NEA.toArray mapArgs of

46+ [AppTerm fExpr, AppTerm xExpr] ->

47+ let

48+ f = printExpr fExpr

49+ x = printExpr xExpr

50+ in

51+ [ LintWarning

52+ { ruleId: RuleId "UseBindFlip"

53+ , message: WarningMessage "join (map f x) can be simplified to x >>= f"

54+ , range: rangeOf fullExpr

55+ , severity: Warning

56+ , suggestion: Just $ Suggestion

57+ { replacement: ReplacementText (x <> " >>= " <> f)

58+ , description: SuggestionDescription "Use >>= instead of join composed with map"

59+ }

60+ }

61+ ]

62+ _ -> []

63+ _ -> []

64+

65+ isJoin :: ImportInfo -> Expr Void -> Boolean

66+ isJoin imports (ExprIdent (QualifiedName { name: Ident name })) =

67+ name == "join" && hasValue imports "join"

68+ isJoin _ _ = false

69+

70+ isMap :: ImportInfo -> Expr Void -> Boolean

71+ isMap imports (ExprIdent (QualifiedName { name: Ident name })) =

72+ name == "map" && hasValue imports "map"

73+ isMap _ _ = false

lib/purelint/src/Purelint/Rules/UseBreak.pursnew file+95

@@ -0,0 +1,95 @@

1+module Purelint.Rules.UseBreak where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: span (not <<< p) -> break p (composition form)

17+-- | Also: span (\x -> not (p x)) -> break p (lambda form)

18+useBreakRule :: Rule

19+useBreakRule = mkRule (RuleId "UseBreak") run

20+ where

21+ run :: RuleContext -> Module Void -> Array LintWarning

22+ run ctx = foldMapModule visitor

23+ where

24+ imports = ctx.imports

25+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

26+

27+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

28+ checkExpr imports expr = case expr of

29+ -- Match: span (not <<< p) x

30+ ExprApp fn args

31+ | isSpan imports fn ->

32+ case NEA.toArray args of

33+ [AppTerm predArg, AppTerm xArg] ->

34+ case getNotComposedPred imports predArg of

35+ Just p ->

36+ let

37+ pText = printExpr p

38+ x = printExpr xArg

39+ in

40+ [ LintWarning

41+ { ruleId: RuleId "UseBreak"

42+ , message: WarningMessage "span (not <<< p) can be simplified to break p"

43+ , range: rangeOf expr

44+ , severity: Hint

45+ , suggestion: Just $ Suggestion

46+ { replacement: ReplacementText ("break " <> pText <> " " <> x)

47+ , description: SuggestionDescription "Use break instead of span with negated predicate"

48+ }

49+ }

50+ ]

51+ Nothing -> []

52+ [AppTerm predArg] ->

53+ case getNotComposedPred imports predArg of

54+ Just p ->

55+ let pText = printExpr p

56+ in

57+ [ LintWarning

58+ { ruleId: RuleId "UseBreak"

59+ , message: WarningMessage "span (not <<< p) can be simplified to break p"

60+ , range: rangeOf expr

61+ , severity: Hint

62+ , suggestion: Just $ Suggestion

63+ { replacement: ReplacementText ("break " <> pText)

64+ , description: SuggestionDescription "Use break instead of span with negated predicate"

65+ }

66+ }

67+ ]

68+ Nothing -> []

69+ _ -> []

70+ _ -> []

71+

72+ unwrapParens :: Expr Void -> Expr Void

73+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

74+ unwrapParens e = e

75+

76+ isSpan :: ImportInfo -> Expr Void -> Boolean

77+ isSpan imports (ExprIdent (QualifiedName { name: Ident name })) =

78+ name == "span" && hasValue imports "span"

79+ isSpan _ _ = false

80+

81+ isNot :: ImportInfo -> Expr Void -> Boolean

82+ isNot imports (ExprIdent (QualifiedName { name: Ident name })) =

83+ name == "not" && hasValue imports "not"

84+ isNot _ _ = false

85+

86+ -- Check for (not <<< p) pattern

87+ getNotComposedPred :: ImportInfo -> Expr Void -> Maybe (Expr Void)

88+ getNotComposedPred imports predExpr =

89+ case unwrapParens predExpr of

90+ ExprApp notFn args

91+ | isNot imports notFn ->

92+ case NEA.toArray args of

93+ [AppTerm p] -> Just p

94+ _ -> Nothing

95+ _ -> Nothing

lib/purelint/src/Purelint/Rules/UseComparing.pursnew file+79

@@ -0,0 +1,79 @@

1+module Purelint.Rules.UseComparing where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Binder(..), Expr(..), Ident(..), Module, Name(..), QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: \x y -> compare (f x) (f y) -> comparing f

17+useComparingRule :: Rule

18+useComparingRule = mkRule (RuleId "UseComparing") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: \x y -> compare (f x) (f y)

29+ ExprLambda { binders, body }

30+ | hasValue imports "compare" ->

31+ case NEA.toArray binders of

32+ [BinderVar (Name { name: Ident x }), BinderVar (Name { name: Ident y })] ->

33+ checkCompareBody imports expr x y (unwrapParens body)

34+ _ -> []

35+ _ -> []

36+

37+ unwrapParens :: Expr Void -> Expr Void

38+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

39+ unwrapParens e = e

40+

41+ checkCompareBody :: ImportInfo -> Expr Void -> String -> String -> Expr Void -> Array LintWarning

42+ checkCompareBody imports fullExpr x y body =

43+ case body of

44+ ExprApp fnExpr args

45+ | isCompare imports fnExpr ->

46+ case NEA.toArray args of

47+ [AppTerm fxExpr, AppTerm fyExpr] ->

48+ case extractFunctionCall (unwrapParens fxExpr), extractFunctionCall (unwrapParens fyExpr) of

49+ Just { fn: f1, arg: arg1 }, Just { fn: f2, arg: arg2 }

50+ | f1 == f2 && arg1 == x && arg2 == y ->

51+ [ LintWarning

52+ { ruleId: RuleId "UseComparing"

53+ , message: WarningMessage "\\x y -> compare (f x) (f y) can be simplified to comparing f"

54+ , range: rangeOf fullExpr

55+ , severity: Hint

56+ , suggestion: Just $ Suggestion

57+ { replacement: ReplacementText ("comparing " <> f1)

58+ , description: SuggestionDescription "Use comparing instead of lambda with compare"

59+ }

60+ }

61+ ]

62+ _, _ -> []

63+ _ -> []

64+ _ -> []

65+

66+ isCompare :: ImportInfo -> Expr Void -> Boolean

67+ isCompare imports (ExprIdent (QualifiedName { name: Ident name })) =

68+ name == "compare" && hasValue imports "compare"

69+ isCompare _ _ = false

70+

71+ extractFunctionCall :: Expr Void -> Maybe { fn :: String, arg :: String }

72+ extractFunctionCall (ExprApp fnExpr args) =

73+ case fnExpr, NEA.toArray args of

74+ ExprIdent (QualifiedName { name: Ident fn }), [AppTerm argExpr] ->

75+ case argExpr of

76+ ExprIdent (QualifiedName { name: Ident arg }) -> Just { fn, arg }

77+ _ -> Nothing

78+ _, _ -> Nothing

79+ extractFunctionCall _ = Nothing

lib/purelint/src/Purelint/Rules/UseConst.pursnew file+67

@@ -0,0 +1,67 @@

1+module Purelint.Rules.UseConst where

3+import Prelude

5+import Data.Array as Array

6+import Data.Array.NonEmpty as NEA

7+import Data.Maybe (Maybe(..))

8+import Data.Tuple (Tuple(..))

9+import Data.Void (Void)

10+import Purelint.Imports (ImportInfo, hasValue)

11+import Purelint.Print (printExpr)

12+import Purelint.Rule (Rule, RuleContext, mkRule)

13+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

14+import PureScript.CST.Range (rangeOf)

15+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

16+import PureScript.CST.Types (AppSpine(..), Binder(..), Expr(..), Ident(..), Module, Name(..), QualifiedName(..), Wrapped(..))

17+

18+-- | Rule: \x -> y (where y doesn't use x) -> const y

19+-- | Only triggers when the binder is a simple unused variable

20+useConstRule :: Rule

21+useConstRule = mkRule (RuleId "UseConst") run

22+ where

23+ run :: RuleContext -> Module Void -> Array LintWarning

24+ run ctx = foldMapModule visitor

25+ where

26+ imports = ctx.imports

27+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

28+

29+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

30+ checkExpr imports expr = case expr of

31+ ExprLambda lambda | hasValue imports "const" ->

32+ case NEA.toArray lambda.binders of

33+ [BinderVar (Name { name: Ident paramName })] ->

34+ -- Check if body doesn't mention the parameter

35+ if not (mentionsVar paramName lambda.body) then

36+ let bodyText = printExpr lambda.body

37+ in

38+ [ LintWarning

39+ { ruleId: RuleId "UseConst"

40+ , message: WarningMessage "Lambda ignores its argument"

41+ , range: rangeOf expr

42+ , severity: Hint

43+ , suggestion: Just $ Suggestion

44+ { replacement: ReplacementText ("const " <> bodyText)

45+ , description: SuggestionDescription "\\x -> y (where y doesn't use x) can be simplified to const y"

46+ }

47+ }

48+ ]

49+ else []

50+ _ -> []

51+ _ -> []

52+

53+ -- Simple check if variable name appears in expression

54+ mentionsVar :: String -> Expr Void -> Boolean

55+ mentionsVar name (ExprIdent (QualifiedName { name: Ident n })) = n == name

56+ mentionsVar name (ExprApp fn args) =

57+ mentionsVar name fn || Array.any (mentionsVarInSpine name) (NEA.toArray args)

58+ mentionsVar name (ExprLambda l) = mentionsVar name l.body

59+ mentionsVar name (ExprIf i) = mentionsVar name i.cond || mentionsVar name i.true || mentionsVar name i.false

60+ mentionsVar name (ExprOp lhs ops) =

61+ mentionsVar name lhs || Array.any (\(Tuple _ e) -> mentionsVar name e) (NEA.toArray ops)

62+ mentionsVar name (ExprParens (Wrapped { value })) = mentionsVar name value

63+ mentionsVar _ _ = false

64+

65+ mentionsVarInSpine :: String -> AppSpine Expr Void -> Boolean

66+ mentionsVarInSpine name (AppTerm e) = mentionsVar name e

67+ mentionsVarInSpine _ _ = false

lib/purelint/src/Purelint/Rules/UseEitherMap.pursnew file+112

@@ -0,0 +1,112 @@

1+module Purelint.Rules.UseEitherMap where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, Operator(..), QualifiedName(..), Wrapped(..))

15+import Data.Tuple (Tuple(..))

16+

17+-- | Rule: either Left (Right <<< f) -> map f

18+useEitherMapRule :: Rule

19+useEitherMapRule = mkRule (RuleId "UseEitherMap") run

20+ where

21+ run :: RuleContext -> Module Void -> Array LintWarning

22+ run ctx = foldMapModule visitor

23+ where

24+ imports = ctx.imports

25+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

26+

27+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

28+ checkExpr imports expr = case expr of

29+ -- Match: either Left (Right <<< f)

30+ ExprApp fn args

31+ | isEither imports fn ->

32+ case NEA.toArray args of

33+ [AppTerm firstArg, AppTerm secondArg] ->

34+ if isLeft imports firstArg then

35+ case getRightComposed imports secondArg of

36+ Just f ->

37+ let fText = printExpr f

38+ in

39+ [ LintWarning

40+ { ruleId: RuleId "UseEitherMap"

41+ , message: WarningMessage "either Left (Right <<< f) can be simplified to map f"

42+ , range: rangeOf expr

43+ , severity: Warning

44+ , suggestion: Just $ Suggestion

45+ { replacement: ReplacementText ("map " <> fText)

46+ , description: SuggestionDescription "Use map instead of either Left (Right <<< f)"

47+ }

48+ }

49+ ]

50+ Nothing -> []

51+ else []

52+ [AppTerm firstArg, AppTerm secondArg, AppTerm xArg] ->

53+ if isLeft imports firstArg then

54+ case getRightComposed imports secondArg of

55+ Just f ->

56+ let

57+ fText = printExpr f

58+ x = printExpr xArg

59+ in

60+ [ LintWarning

61+ { ruleId: RuleId "UseEitherMap"

62+ , message: WarningMessage "either Left (Right <<< f) x can be simplified to map f x"

63+ , range: rangeOf expr

64+ , severity: Warning

65+ , suggestion: Just $ Suggestion

66+ { replacement: ReplacementText ("map " <> fText <> " " <> x)

67+ , description: SuggestionDescription "Use map instead of either Left (Right <<< f)"

68+ }

69+ }

70+ ]

71+ Nothing -> []

72+ else []

73+ _ -> []

74+ _ -> []

75+

76+ unwrapParens :: Expr Void -> Expr Void

77+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

78+ unwrapParens e = e

79+

80+ isEither :: ImportInfo -> Expr Void -> Boolean

81+ isEither imports (ExprIdent (QualifiedName { name: Ident name })) =

82+ name == "either" && hasValue imports "either"

83+ isEither _ _ = false

84+

85+ isLeft :: ImportInfo -> Expr Void -> Boolean

86+ isLeft imports e =

87+ case unwrapParens e of

88+ ExprIdent (QualifiedName { name: Ident name }) ->

89+ name == "Left" && hasValue imports "Left"

90+ ExprConstructor (QualifiedName { name: _ }) -> true -- Allow constructor syntax

91+ _ -> false

92+

93+ isRight :: ImportInfo -> Expr Void -> Boolean

94+ isRight imports e =

95+ case unwrapParens e of

96+ ExprIdent (QualifiedName { name: Ident name }) ->

97+ name == "Right" && hasValue imports "Right"

98+ ExprConstructor (QualifiedName { name: _ }) -> true

99+ _ -> false

100+

101+ -- Check for (Right <<< f) pattern

102+ getRightComposed :: ImportInfo -> Expr Void -> Maybe (Expr Void)

103+ getRightComposed imports e =

104+ case unwrapParens e of

105+ ExprOp lhs ops ->

106+ case NEA.toArray ops of

107+ [Tuple (QualifiedName { name: Operator "<<<" }) rhs]

108+ | isRight imports lhs -> Just rhs

109+ [Tuple (QualifiedName { name: Operator ">>>" }) rhs]

110+ | isRight imports rhs -> Just lhs

111+ _ -> Nothing

112+ _ -> Nothing

lib/purelint/src/Purelint/Rules/UseElemIndex.pursnew file+128

@@ -0,0 +1,128 @@

1+module Purelint.Rules.UseElemIndex where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Tuple (Tuple(..))

8+import Data.Void (Void)

9+import Purelint.Imports (ImportInfo, hasValue, hasOp)

10+import Purelint.Print (printExpr)

11+import Purelint.Rule (Rule, RuleContext, mkRule)

12+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

13+import PureScript.CST.Range (rangeOf)

14+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

15+import PureScript.CST.Types (AppSpine(..), Binder(..), Expr(..), Ident(..), Module, Name(..), Operator(..), QualifiedName(..), Wrapped(..))

16+

17+-- | Rule: findIndex (== a) -> elemIndex a

18+-- | Also: findIndex (\x -> x == a) -> elemIndex a

19+useElemIndexRule :: Rule

20+useElemIndexRule = mkRule (RuleId "UseElemIndex") run

21+ where

22+ run :: RuleContext -> Module Void -> Array LintWarning

23+ run ctx = foldMapModule visitor

24+ where

25+ imports = ctx.imports

26+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

27+

28+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

29+ checkExpr imports expr = case expr of

30+ -- Match: findIndex (== a) xs or findIndex (\x -> x == a)

31+ ExprApp fn args

32+ | isFindIndex imports fn ->

33+ case NEA.toArray args of

34+ [AppTerm predArg] ->

35+ case getEqArg imports (unwrapParens predArg) of

36+ Just a ->

37+ let aText = printExpr a

38+ in

39+ [ LintWarning

40+ { ruleId: RuleId "UseElemIndex"

41+ , message: WarningMessage "findIndex (== a) can be simplified to elemIndex a"

42+ , range: rangeOf expr

43+ , severity: Warning

44+ , suggestion: Just $ Suggestion

45+ { replacement: ReplacementText ("elemIndex " <> aText)

46+ , description: SuggestionDescription "Use elemIndex instead of findIndex (== a)"

47+ }

48+ }

49+ ]

50+ Nothing -> []

51+ [AppTerm predArg, AppTerm xArg] ->

52+ case getEqArg imports (unwrapParens predArg) of

53+ Just a ->

54+ let

55+ aText = printExpr a

56+ x = printExpr xArg

57+ in

58+ [ LintWarning

59+ { ruleId: RuleId "UseElemIndex"

60+ , message: WarningMessage "findIndex (== a) xs can be simplified to elemIndex a xs"

61+ , range: rangeOf expr

62+ , severity: Warning

63+ , suggestion: Just $ Suggestion

64+ { replacement: ReplacementText ("elemIndex " <> aText <> " " <> x)

65+ , description: SuggestionDescription "Use elemIndex instead of findIndex (== a)"

66+ }

67+ }

68+ ]

69+ Nothing -> []

70+ _ -> []

71+ _ -> []

72+

73+ unwrapParens :: Expr Void -> Expr Void

74+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

75+ unwrapParens e = e

76+

77+ isFindIndex :: ImportInfo -> Expr Void -> Boolean

78+ isFindIndex imports (ExprIdent (QualifiedName { name: Ident name })) =

79+ name == "findIndex" && hasValue imports "findIndex"

80+ isFindIndex _ _ = false

81+

82+ -- Check for (== a) section or (\x -> x == a) lambda

83+ getEqArg :: ImportInfo -> Expr Void -> Maybe (Expr Void)

84+ getEqArg imports e = case e of

85+ -- Section: (== a)

86+ ExprSection _ ->

87+ -- Sections are tricky to parse, skip for now

88+ Nothing

89+ -- Operator section in parens: (== a)

90+ ExprOp lhs ops

91+ | hasOp imports "==" ->

92+ case NEA.toArray ops of

93+ [Tuple (QualifiedName { name: Operator "==" }) rhs] ->

94+ -- This would be `lhs == rhs`, not a section

95+ -- Sections appear differently

96+ Nothing

97+ _ -> Nothing

98+ -- Lambda: \x -> x == a

99+ ExprLambda { binders, body } ->

100+ case NEA.toArray binders of

101+ [binder] ->

102+ case getBinderName binder of

103+ Just varName ->

104+ case body of

105+ ExprOp lhs ops

106+ | hasOp imports "==" ->

107+ case NEA.toArray ops of

108+ [Tuple (QualifiedName { name: Operator "==" }) rhs] ->

109+ -- Check if lhs is the bound variable

110+ case lhs of

111+ ExprIdent (QualifiedName { name: Ident name })

112+ | name == varName -> Just rhs

113+ _ ->

114+ -- Check if rhs is the bound variable

115+ case rhs of

116+ ExprIdent (QualifiedName { name: Ident name })

117+ | name == varName -> Just lhs

118+ _ -> Nothing

119+ _ -> Nothing

120+ _ -> Nothing

121+ Nothing -> Nothing

122+ _ -> Nothing

123+ _ -> Nothing

124+

125+ getBinderName :: Binder Void -> Maybe String

126+ getBinderName (BinderVar (Name { name: Ident name })) = Just name

127+ getBinderName (BinderParens (Wrapped { value: inner })) = getBinderName inner

128+ getBinderName _ = Nothing

lib/purelint/src/Purelint/Rules/UseFindMap.pursnew file+73

@@ -0,0 +1,73 @@

1+module Purelint.Rules.UseFindMap where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: head (mapMaybe f x) -> findMap f x

17+useFindMapRule :: Rule

18+useFindMapRule = mkRule (RuleId "UseFindMap") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: head (mapMaybe f x)

29+ ExprApp fnExpr args

30+ | isHead imports fnExpr ->

31+ case NEA.toArray args of

32+ [AppTerm innerExpr] ->

33+ checkMapMaybe imports expr (unwrapParens innerExpr)

34+ _ -> []

35+ _ -> []

36+

37+ unwrapParens :: Expr Void -> Expr Void

38+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

39+ unwrapParens e = e

40+

41+ checkMapMaybe :: ImportInfo -> Expr Void -> Expr Void -> Array LintWarning

42+ checkMapMaybe imports fullExpr innerExpr =

43+ case innerExpr of

44+ ExprApp mapMaybeFn mapMaybeArgs | isMapMaybe imports mapMaybeFn ->

45+ case NEA.toArray mapMaybeArgs of

46+ [AppTerm fExpr, AppTerm xExpr] ->

47+ let

48+ f = printExpr fExpr

49+ x = printExpr xExpr

50+ in

51+ [ LintWarning

52+ { ruleId: RuleId "UseFindMap"

53+ , message: WarningMessage "head (mapMaybe f x) can be simplified to findMap f x"

54+ , range: rangeOf fullExpr

55+ , severity: Warning

56+ , suggestion: Just $ Suggestion

57+ { replacement: ReplacementText ("findMap " <> f <> " " <> x)

58+ , description: SuggestionDescription "Use findMap instead of head composed with mapMaybe"

59+ }

60+ }

61+ ]

62+ _ -> []

63+ _ -> []

64+

65+ isHead :: ImportInfo -> Expr Void -> Boolean

66+ isHead imports (ExprIdent (QualifiedName { name: Ident name })) =

67+ name == "head" && hasValue imports "head"

68+ isHead _ _ = false

69+

70+ isMapMaybe :: ImportInfo -> Expr Void -> Boolean

71+ isMapMaybe imports (ExprIdent (QualifiedName { name: Ident name })) =

72+ name == "mapMaybe" && hasValue imports "mapMaybe"

73+ isMapMaybe _ _ = false

lib/purelint/src/Purelint/Rules/UseFold.pursnew file+53

@@ -0,0 +1,53 @@

1+module Purelint.Rules.UseFold where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Rule (Rule, RuleContext, mkRule)

10+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

11+import PureScript.CST.Range (rangeOf)

12+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

13+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..))

14+

15+-- | Rule: foldMap identity -> fold

16+useFoldRule :: Rule

17+useFoldRule = mkRule (RuleId "UseFold") run

18+ where

19+ run :: RuleContext -> Module Void -> Array LintWarning

20+ run ctx = foldMapModule visitor

21+ where

22+ imports = ctx.imports

23+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

24+

25+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

26+ checkExpr imports expr = case expr of

27+ -- Match: foldMap identity

28+ ExprApp fnExpr args | isFoldMap imports fnExpr ->

29+ case NEA.toArray args of

30+ [AppTerm idExpr] | isIdentity imports idExpr ->

31+ [ LintWarning

32+ { ruleId: RuleId "UseFold"

33+ , message: WarningMessage "foldMap identity can be simplified to fold"

34+ , range: rangeOf expr

35+ , severity: Warning

36+ , suggestion: Just $ Suggestion

37+ { replacement: ReplacementText "fold"

38+ , description: SuggestionDescription "Use fold instead of foldMap identity"

39+ }

40+ }

41+ ]

42+ _ -> []

43+ _ -> []

44+

45+ isFoldMap :: ImportInfo -> Expr Void -> Boolean

46+ isFoldMap imports (ExprIdent (QualifiedName { name: Ident name })) =

47+ name == "foldMap" && hasValue imports "foldMap"

48+ isFoldMap _ _ = false

49+

50+ isIdentity :: ImportInfo -> Expr Void -> Boolean

51+ isIdentity imports (ExprIdent (QualifiedName { name: Ident name })) =

52+ name == "identity" && hasValue imports "identity"

53+ isIdentity _ _ = false

lib/purelint/src/Purelint/Rules/UseFoldMapId.pursnew file+77

@@ -0,0 +1,77 @@

1+module Purelint.Rules.UseFoldMapId where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: foldMap identity -> fold

17+useFoldMapIdRule :: Rule

18+useFoldMapIdRule = mkRule (RuleId "UseFoldMapId") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: foldMap identity xs

29+ ExprApp fn args

30+ | isFoldMap imports fn ->

31+ case NEA.toArray args of

32+ [AppTerm predArg] ->

33+ if isIdentity imports (unwrapParens predArg) then

34+ [ LintWarning

35+ { ruleId: RuleId "UseFoldMapId"

36+ , message: WarningMessage "foldMap identity can be simplified to fold"

37+ , range: rangeOf expr

38+ , severity: Warning

39+ , suggestion: Just $ Suggestion

40+ { replacement: ReplacementText "fold"

41+ , description: SuggestionDescription "Use fold instead of foldMap identity"

42+ }

43+ }

44+ ]

45+ else []

46+ [AppTerm predArg, AppTerm xArg] ->

47+ if isIdentity imports (unwrapParens predArg) then

48+ let x = printExpr xArg

49+ in

50+ [ LintWarning

51+ { ruleId: RuleId "UseFoldMapId"

52+ , message: WarningMessage "foldMap identity xs can be simplified to fold xs"

53+ , range: rangeOf expr

54+ , severity: Warning

55+ , suggestion: Just $ Suggestion

56+ { replacement: ReplacementText ("fold " <> x)

57+ , description: SuggestionDescription "Use fold instead of foldMap identity"

58+ }

59+ }

60+ ]

61+ else []

62+ _ -> []

63+ _ -> []

64+

65+ unwrapParens :: Expr Void -> Expr Void

66+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

67+ unwrapParens e = e

68+

69+ isFoldMap :: ImportInfo -> Expr Void -> Boolean

70+ isFoldMap imports (ExprIdent (QualifiedName { name: Ident name })) =

71+ name == "foldMap" && hasValue imports "foldMap"

72+ isFoldMap _ _ = false

73+

74+ isIdentity :: ImportInfo -> Expr Void -> Boolean

75+ isIdentity imports (ExprIdent (QualifiedName { name: Ident name })) =

76+ (name == "identity" || name == "id") && hasValue imports "identity"

77+ isIdentity _ _ = false

lib/purelint/src/Purelint/Rules/UseFor.pursnew file+74

@@ -0,0 +1,74 @@

1+module Purelint.Rules.UseFor where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: flip traverse -> for

17+useForRule :: Rule

18+useForRule = mkRule (RuleId "UseFor") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: flip traverse

29+ ExprApp fnExpr args

30+ | isFlip imports fnExpr ->

31+ case NEA.toArray args of

32+ [AppTerm innerExpr] ->

33+ checkTraverse imports expr (unwrapParens innerExpr)

34+ _ -> []

35+ _ -> []

36+

37+ unwrapParens :: Expr Void -> Expr Void

38+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

39+ unwrapParens e = e

40+

41+ checkTraverse :: ImportInfo -> Expr Void -> Expr Void -> Array LintWarning

42+ checkTraverse imports fullExpr innerExpr =

43+ case innerExpr of

44+ ExprIdent (QualifiedName { name: Ident name })

45+ | name == "traverse" && hasValue imports "traverse" ->

46+ [ LintWarning

47+ { ruleId: RuleId "UseFor"

48+ , message: WarningMessage "flip traverse can be simplified to for"

49+ , range: rangeOf fullExpr

50+ , severity: Warning

51+ , suggestion: Just $ Suggestion

52+ { replacement: ReplacementText "for"

53+ , description: SuggestionDescription "Use for instead of flip traverse"

54+ }

55+ }

56+ ]

57+ | name == "traverse_" && hasValue imports "traverse_" ->

58+ [ LintWarning

59+ { ruleId: RuleId "UseFor"

60+ , message: WarningMessage "flip traverse_ can be simplified to for_"

61+ , range: rangeOf fullExpr

62+ , severity: Warning

63+ , suggestion: Just $ Suggestion

64+ { replacement: ReplacementText "for_"

65+ , description: SuggestionDescription "Use for_ instead of flip traverse_"

66+ }

67+ }

68+ ]

69+ _ -> []

70+

71+ isFlip :: ImportInfo -> Expr Void -> Boolean

72+ isFlip imports (ExprIdent (QualifiedName { name: Ident name })) =

73+ name == "flip" && hasValue imports "flip"

74+ isFlip _ _ = false

lib/purelint/src/Purelint/Rules/UseFromJust.pursnew file+104

@@ -0,0 +1,104 @@

1+module Purelint.Rules.UseFromJust where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, Proper(..), QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: fromJust (Just x) -> x (evaluate)

17+-- | Note: This is for constant folding; actual usage of fromJust is discouraged

18+useFromJustRule :: Rule

19+useFromJustRule = mkRule (RuleId "UseFromJust") run

20+ where

21+ run :: RuleContext -> Module Void -> Array LintWarning

22+ run ctx = foldMapModule visitor

23+ where

24+ imports = ctx.imports

25+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

26+

27+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

28+ checkExpr imports expr = case expr of

29+ -- Match: fromJust (Just x) - but this is a partial function warning opportunity

30+ ExprApp fn args

31+ | isFromMaybe imports fn ->

32+ case NEA.toArray args of

33+ [AppTerm defaultArg, AppTerm maybeArg] ->

34+ case getJustArg (unwrapParens maybeArg) of

35+ Just x ->

36+ let xText = printExpr x

37+ in

38+ [ LintWarning

39+ { ruleId: RuleId "UseFromJust"

40+ , message: WarningMessage "fromMaybe d (Just x) can be simplified to x"

41+ , range: rangeOf expr

42+ , severity: Warning

43+ , suggestion: Just $ Suggestion

44+ { replacement: ReplacementText xText

45+ , description: SuggestionDescription "Simplify fromMaybe with Just"

46+ }

47+ }

48+ ]

49+ Nothing ->

50+ case unwrapParens maybeArg of

51+ ExprIdent (QualifiedName { name: Ident "Nothing" }) ->

52+ let d = printExpr defaultArg

53+ in

54+ [ LintWarning

55+ { ruleId: RuleId "UseFromJust"

56+ , message: WarningMessage "fromMaybe d Nothing can be simplified to d"

57+ , range: rangeOf expr

58+ , severity: Warning

59+ , suggestion: Just $ Suggestion

60+ { replacement: ReplacementText d

61+ , description: SuggestionDescription "Simplify fromMaybe with Nothing"

62+ }

63+ }

64+ ]

65+ ExprConstructor (QualifiedName { name: Proper "Nothing" }) ->

66+ let d = printExpr defaultArg

67+ in

68+ [ LintWarning

69+ { ruleId: RuleId "UseFromJust"

70+ , message: WarningMessage "fromMaybe d Nothing can be simplified to d"

71+ , range: rangeOf expr

72+ , severity: Warning

73+ , suggestion: Just $ Suggestion

74+ { replacement: ReplacementText d

75+ , description: SuggestionDescription "Simplify fromMaybe with Nothing"

76+ }

77+ }

78+ ]

79+ _ -> []

80+ _ -> []

81+ _ -> []

82+

83+ unwrapParens :: Expr Void -> Expr Void

84+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

85+ unwrapParens e = e

86+

87+ isFromMaybe :: ImportInfo -> Expr Void -> Boolean

88+ isFromMaybe imports (ExprIdent (QualifiedName { name: Ident name })) =

89+ name == "fromMaybe" && hasValue imports "fromMaybe"

90+ isFromMaybe _ _ = false

91+

92+ getJustArg :: Expr Void -> Maybe (Expr Void)

93+ getJustArg (ExprApp ctor args) =

94+ case ctor of

95+ ExprConstructor (QualifiedName { name: Proper "Just" }) ->

96+ case NEA.toArray args of

97+ [AppTerm x] -> Just x

98+ _ -> Nothing

99+ ExprIdent (QualifiedName { name: Ident "Just" }) ->

100+ case NEA.toArray args of

101+ [AppTerm x] -> Just x

102+ _ -> Nothing

103+ _ -> Nothing

104+ getJustArg _ = Nothing

lib/purelint/src/Purelint/Rules/UseFromMaybe.pursnew file+56

@@ -0,0 +1,56 @@

1+module Purelint.Rules.UseFromMaybe where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..))

15+

16+-- | Rule: maybe x id -> fromMaybe x

17+useFromMaybeRule :: Rule

18+useFromMaybeRule = mkRule (RuleId "UseFromMaybe") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: maybe x id

29+ ExprApp fnExpr args | isMaybe imports fnExpr ->

30+ case NEA.toArray args of

31+ [AppTerm defaultVal, AppTerm fn] | isId imports fn ->

32+ let defaultText = printExpr defaultVal

33+ in

34+ [ LintWarning

35+ { ruleId: RuleId "UseFromMaybe"

36+ , message: WarningMessage "maybe x id can be simplified to fromMaybe x"

37+ , range: rangeOf expr

38+ , severity: Warning

39+ , suggestion: Just $ Suggestion

40+ { replacement: ReplacementText ("fromMaybe " <> defaultText)

41+ , description: SuggestionDescription "Use fromMaybe instead of maybe x id"

42+ }

43+ }

44+ ]

45+ _ -> []

46+ _ -> []

47+

48+ isMaybe :: ImportInfo -> Expr Void -> Boolean

49+ isMaybe imports (ExprIdent (QualifiedName { name: Ident name })) =

50+ name == "maybe" && hasValue imports "maybe"

51+ isMaybe _ _ = false

52+

53+ isId :: ImportInfo -> Expr Void -> Boolean

54+ isId imports (ExprIdent (QualifiedName { name: Ident name })) =

55+ name == "identity" && hasValue imports "identity"

56+ isId _ _ = false

lib/purelint/src/Purelint/Rules/UseFstSnd.pursnew file+79

@@ -0,0 +1,79 @@

1+module Purelint.Rules.UseFstSnd where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Rule (Rule, RuleContext, mkRule)

9+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

10+import PureScript.CST.Range (rangeOf)

11+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

12+import PureScript.CST.Types (Binder(..), Expr(..), Ident(..), Module, Name(..), Proper(..), QualifiedName(..), Wrapped(..))

13+

14+-- | Rule: \(Tuple x y) -> x -> fst

15+-- | Also: \(Tuple x y) -> y -> snd

16+useFstSndRule :: Rule

17+useFstSndRule = mkRule (RuleId "UseFstSnd") run

18+ where

19+ run :: RuleContext -> Module Void -> Array LintWarning

20+ run _ctx = foldMapModule visitor

21+ where

22+ visitor = defaultMonoidalVisitor { onExpr = checkExpr }

23+

24+ checkExpr :: Expr Void -> Array LintWarning

25+ checkExpr expr = case expr of

26+ -- Match: \(Tuple x y) -> x or \(Tuple x y) -> y

27+ ExprLambda { binders, body } ->

28+ case NEA.toArray binders of

29+ [binder] ->

30+ case getTupleBinderNames binder of

31+ Just { first, second } ->

32+ case body of

33+ ExprIdent (QualifiedName { name: Ident bodyName })

34+ | bodyName == first ->

35+ [ LintWarning

36+ { ruleId: RuleId "UseFstSnd"

37+ , message: WarningMessage "\\(Tuple x y) -> x can be simplified to fst"

38+ , range: rangeOf expr

39+ , severity: Warning

40+ , suggestion: Just $ Suggestion

41+ { replacement: ReplacementText "fst"

42+ , description: SuggestionDescription "Use fst instead of lambda extracting first element"

43+ }

44+ }

45+ ]

46+ | bodyName == second ->

47+ [ LintWarning

48+ { ruleId: RuleId "UseFstSnd"

49+ , message: WarningMessage "\\(Tuple x y) -> y can be simplified to snd"

50+ , range: rangeOf expr

51+ , severity: Warning

52+ , suggestion: Just $ Suggestion

53+ { replacement: ReplacementText "snd"

54+ , description: SuggestionDescription "Use snd instead of lambda extracting second element"

55+ }

56+ }

57+ ]

58+ _ -> []

59+ Nothing -> []

60+ _ -> []

61+ _ -> []

62+

63+ getTupleBinderNames :: Binder Void -> Maybe { first :: String, second :: String }

64+ getTupleBinderNames (BinderParens (Wrapped { value: inner })) = getTupleBinderNames inner

65+ getTupleBinderNames (BinderConstructor (QualifiedName { name: Proper ctorName }) binders)

66+ | ctorName == "Tuple" =

67+ case binders of

68+ [firstBinder, secondBinder] ->

69+ case getBinderName firstBinder, getBinderName secondBinder of

70+ Just first, Just second -> Just { first, second }

71+ _, _ -> Nothing

72+ _ -> Nothing

73+ getTupleBinderNames _ = Nothing

74+

75+ getBinderName :: Binder Void -> Maybe String

76+ getBinderName (BinderVar (Name { name: Ident name })) = Just name

77+ getBinderName (BinderWildcard _) = Nothing -- wildcards can't be referenced in body

78+ getBinderName (BinderParens (Wrapped { value: inner })) = getBinderName inner

79+ getBinderName _ = Nothing

lib/purelint/src/Purelint/Rules/UseGuardMaybe.pursnew file+77

@@ -0,0 +1,77 @@

1+module Purelint.Rules.UseGuardMaybe where

3+import Prelude

5+import Data.Maybe (Maybe(..))

6+import Data.Void (Void)

7+import Purelint.Imports (ImportInfo, hasValue)

8+import Purelint.Print (printExpr)

9+import Purelint.Rule (Rule, RuleContext, mkRule)

10+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

11+import PureScript.CST.Range (rangeOf)

12+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

13+import PureScript.CST.Types (Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

14+

15+-- | Rule: if c then Just x else Nothing -> guard c $> x

16+useGuardMaybeRule :: Rule

17+useGuardMaybeRule = mkRule (RuleId "UseGuardMaybe") run

18+ where

19+ run :: RuleContext -> Module Void -> Array LintWarning

20+ run ctx = foldMapModule visitor

21+ where

22+ imports = ctx.imports

23+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

24+

25+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

26+ checkExpr imports expr = case expr of

27+ -- Match: if c then Just x else Nothing

28+ ExprIf { cond, true: trueExpr, false: falseExpr }

29+ | isJustApp imports (unwrapParens trueExpr)

30+ , isNothing imports (unwrapParens falseExpr) ->

31+ case getJustArg (unwrapParens trueExpr) of

32+ Just xExpr ->

33+ let

34+ c = printExpr cond

35+ x = printExpr xExpr

36+ in

37+ [ LintWarning

38+ { ruleId: RuleId "UseGuardMaybe"

39+ , message: WarningMessage "if c then Just x else Nothing can be simplified"

40+ , range: rangeOf expr

41+ , severity: Hint

42+ , suggestion: Just $ Suggestion

43+ { replacement: ReplacementText ("guard " <> c <> " $> " <> x)

44+ , description: SuggestionDescription "Use guard c $> x instead of if-then-else with Maybe"

45+ }

46+ }

47+ ]

48+ Nothing -> []

49+ _ -> []

50+

51+ unwrapParens :: Expr Void -> Expr Void

52+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

53+ unwrapParens e = e

54+

55+ isJustApp :: ImportInfo -> Expr Void -> Boolean

56+ isJustApp imports (ExprApp fn _) = isJust imports fn

57+ isJustApp _ _ = false

58+

59+ isJust :: ImportInfo -> Expr Void -> Boolean

60+ isJust imports (ExprIdent (QualifiedName { name: Ident name })) =

61+ name == "Just" && hasValue imports "Just"

62+ isJust imports (ExprConstructor (QualifiedName { name: _ })) =

63+ hasValue imports "Just"

64+ isJust _ _ = false

65+

66+ getJustArg :: Expr Void -> Maybe (Expr Void)

67+ getJustArg (ExprApp _ args) =

68+ case args of

69+ _ -> Nothing -- simplified - would need NEA access

70+ getJustArg _ = Nothing

71+

72+ isNothing :: ImportInfo -> Expr Void -> Boolean

73+ isNothing imports (ExprIdent (QualifiedName { name: Ident name })) =

74+ name == "Nothing" && hasValue imports "Nothing"

75+ isNothing imports (ExprConstructor (QualifiedName { name: _ })) =

76+ hasValue imports "Nothing"

77+ isNothing _ _ = false

lib/purelint/src/Purelint/Rules/UseHead.pursnew file+56

@@ -0,0 +1,56 @@

1+module Purelint.Rules.UseHead where

3+import Prelude

5+import Data.Maybe (Maybe(..))

6+import Data.Void (Void)

7+import Purelint.Imports (ImportInfo, hasValue)

8+import Purelint.Rule (Rule, RuleContext, mkRule)

9+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

10+import PureScript.CST.Range (rangeOf)

11+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

12+import PureScript.CST.Types (Expr(..), Ident(..), IntValue(..), Module, Operator(..), QualifiedName(..), Wrapped(..))

13+import Data.Array.NonEmpty as NEA

14+import Data.Tuple (Tuple(..))

15+

16+-- | Rule: xs !! 0 -> head xs

17+useHeadRule :: Rule

18+useHeadRule = mkRule (RuleId "UseHead") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: xs !! 0

29+ ExprOp lhs ops

30+ | hasValue imports "head" ->

31+ case NEA.toArray ops of

32+ [Tuple (QualifiedName { name: Operator "!!" }) rhs] ->

33+ if isZeroLiteral (unwrapParens rhs) then

34+ [ LintWarning

35+ { ruleId: RuleId "UseHead"

36+ , message: WarningMessage "xs !! 0 can be simplified to head xs"

37+ , range: rangeOf expr

38+ , severity: Hint

39+ , suggestion: Just $ Suggestion

40+ { replacement: ReplacementText "head"

41+ , description: SuggestionDescription "Use head instead of !! 0"

42+ }

43+ }

44+ ]

45+ else []

46+ _ -> []

47+ _ -> []

48+

49+ unwrapParens :: Expr Void -> Expr Void

50+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

51+ unwrapParens e = e

52+

53+ isZeroLiteral :: Expr Void -> Boolean

54+ isZeroLiteral (ExprInt _ (SmallInt 0)) = true

55+ isZeroLiteral (ExprInt _ (BigInt s)) = s == "0"

56+ isZeroLiteral _ = false

lib/purelint/src/Purelint/Rules/UseIsJust.pursnew file+68

@@ -0,0 +1,68 @@

1+module Purelint.Rules.UseIsJust where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Rule (Rule, RuleContext, mkRule)

10+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

11+import PureScript.CST.Range (rangeOf)

12+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

13+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

14+

15+-- | Rule: maybe false (const true) -> isJust

16+useIsJustRule :: Rule

17+useIsJustRule = mkRule (RuleId "UseIsJust") run

18+ where

19+ run :: RuleContext -> Module Void -> Array LintWarning

20+ run ctx = foldMapModule visitor

21+ where

22+ imports = ctx.imports

23+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

24+

25+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

26+ checkExpr imports expr = case expr of

27+ -- Match: maybe false (const true)

28+ ExprApp fnExpr args | isMaybe imports fnExpr ->

29+ case NEA.toArray args of

30+ [AppTerm falseExpr, AppTerm constTrueExpr]

31+ | isFalse falseExpr && isConstTrue imports constTrueExpr ->

32+ [ LintWarning

33+ { ruleId: RuleId "UseIsJust"

34+ , message: WarningMessage "maybe false (const true) can be simplified to isJust"

35+ , range: rangeOf expr

36+ , severity: Warning

37+ , suggestion: Just $ Suggestion

38+ { replacement: ReplacementText "isJust"

39+ , description: SuggestionDescription "Use isJust instead of maybe false (const true)"

40+ }

41+ }

42+ ]

43+ _ -> []

44+ _ -> []

45+

46+ isMaybe :: ImportInfo -> Expr Void -> Boolean

47+ isMaybe imports (ExprIdent (QualifiedName { name: Ident name })) =

48+ name == "maybe" && hasValue imports "maybe"

49+ isMaybe _ _ = false

50+

51+ isFalse :: Expr Void -> Boolean

52+ isFalse (ExprBoolean _ b) = not b

53+ isFalse _ = false

54+

55+ isConstTrue :: ImportInfo -> Expr Void -> Boolean

56+ isConstTrue imports (ExprApp fnExpr args) =

57+ case fnExpr of

58+ ExprIdent (QualifiedName { name: Ident name }) | name == "const" && hasValue imports "const" ->

59+ case NEA.toArray args of

60+ [AppTerm trueExpr] -> isTrue trueExpr

61+ _ -> false

62+ _ -> false

63+ isConstTrue imports (ExprParens (Wrapped { value })) = isConstTrue imports value

64+ isConstTrue _ _ = false

65+

66+ isTrue :: Expr Void -> Boolean

67+ isTrue (ExprBoolean _ b) = b

68+ isTrue _ = false

lib/purelint/src/Purelint/Rules/UseIsNothing.pursnew file+68

@@ -0,0 +1,68 @@

1+module Purelint.Rules.UseIsNothing where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Rule (Rule, RuleContext, mkRule)

10+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

11+import PureScript.CST.Range (rangeOf)

12+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

13+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

14+

15+-- | Rule: maybe true (const false) -> isNothing

16+useIsNothingRule :: Rule

17+useIsNothingRule = mkRule (RuleId "UseIsNothing") run

18+ where

19+ run :: RuleContext -> Module Void -> Array LintWarning

20+ run ctx = foldMapModule visitor

21+ where

22+ imports = ctx.imports

23+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

24+

25+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

26+ checkExpr imports expr = case expr of

27+ -- Match: maybe true (const false)

28+ ExprApp fnExpr args | isMaybe imports fnExpr ->

29+ case NEA.toArray args of

30+ [AppTerm trueExpr, AppTerm constFalseExpr]

31+ | isTrue trueExpr && isConstFalse imports constFalseExpr ->

32+ [ LintWarning

33+ { ruleId: RuleId "UseIsNothing"

34+ , message: WarningMessage "maybe true (const false) can be simplified to isNothing"

35+ , range: rangeOf expr

36+ , severity: Warning

37+ , suggestion: Just $ Suggestion

38+ { replacement: ReplacementText "isNothing"

39+ , description: SuggestionDescription "Use isNothing instead of maybe true (const false)"

40+ }

41+ }

42+ ]

43+ _ -> []

44+ _ -> []

45+

46+ isMaybe :: ImportInfo -> Expr Void -> Boolean

47+ isMaybe imports (ExprIdent (QualifiedName { name: Ident name })) =

48+ name == "maybe" && hasValue imports "maybe"

49+ isMaybe _ _ = false

50+

51+ isTrue :: Expr Void -> Boolean

52+ isTrue (ExprBoolean _ b) = b

53+ isTrue _ = false

54+

55+ isConstFalse :: ImportInfo -> Expr Void -> Boolean

56+ isConstFalse imports (ExprApp fnExpr args) =

57+ case fnExpr of

58+ ExprIdent (QualifiedName { name: Ident name }) | name == "const" && hasValue imports "const" ->

59+ case NEA.toArray args of

60+ [AppTerm falseExpr] -> isFalse falseExpr

61+ _ -> false

62+ _ -> false

63+ isConstFalse imports (ExprParens (Wrapped { value })) = isConstFalse imports value

64+ isConstFalse _ _ = false

65+

66+ isFalse :: Expr Void -> Boolean

67+ isFalse (ExprBoolean _ b) = not b

68+ isFalse _ = false

lib/purelint/src/Purelint/Rules/UseJoin.pursnew file+78

@@ -0,0 +1,78 @@

1+module Purelint.Rules.UseJoin where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Tuple (Tuple(..))

8+import Data.Void (Void)

9+import Purelint.Imports (ImportInfo, hasValue, hasOp)

10+import Purelint.Print (printExpr)

11+import Purelint.Rule (Rule, RuleContext, mkRule)

12+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

13+import PureScript.CST.Range (rangeOf)

14+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

15+import PureScript.CST.Types (Expr(..), Ident(..), Module, Operator(..), QualifiedName(..))

16+

17+-- | Rule: x >>= identity -> join x

18+useJoinRule :: Rule

19+useJoinRule = mkRule (RuleId "UseJoin") run

20+ where

21+ run :: RuleContext -> Module Void -> Array LintWarning

22+ run ctx = foldMapModule visitor

23+ where

24+ imports = ctx.imports

25+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

26+

27+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

28+ checkExpr imports expr = case expr of

29+ -- Match: x >>= identity

30+ ExprOp lhs ops | hasOp imports ">>=" ->

31+ case NEA.toArray ops of

32+ [Tuple qn rhs] | isBindOp imports qn && isIdentity imports rhs ->

33+ let xText = printExpr lhs

34+ in

35+ [ LintWarning

36+ { ruleId: RuleId "UseJoin"

37+ , message: WarningMessage "Use join instead of >>= identity"

38+ , range: rangeOf expr

39+ , severity: Warning

40+ , suggestion: Just $ Suggestion

41+ { replacement: ReplacementText ("join " <> xText)

42+ , description: SuggestionDescription "x >>= identity can be simplified to join x"

43+ }

44+ }

45+ ]

46+ _ -> []

47+ -- Match: identity =<< x

48+ ExprOp lhs ops | hasOp imports "=<<" && isIdentity imports lhs ->

49+ case NEA.toArray ops of

50+ [Tuple qn rhs] | isBindFlipOp imports qn ->

51+ let xText = printExpr rhs

52+ in

53+ [ LintWarning

54+ { ruleId: RuleId "UseJoin"

55+ , message: WarningMessage "Use join instead of identity =<<"

56+ , range: rangeOf expr

57+ , severity: Warning

58+ , suggestion: Just $ Suggestion

59+ { replacement: ReplacementText ("join " <> xText)

60+ , description: SuggestionDescription "identity =<< x can be simplified to join x"

61+ }

62+ }

63+ ]

64+ _ -> []

65+ _ -> []

66+

67+ isBindOp :: ImportInfo -> QualifiedName Operator -> Boolean

68+ isBindOp imports (QualifiedName { name: Operator op }) =

69+ op == ">>=" && hasOp imports ">>="

70+

71+ isBindFlipOp :: ImportInfo -> QualifiedName Operator -> Boolean

72+ isBindFlipOp imports (QualifiedName { name: Operator op }) =

73+ op == "=<<" && hasOp imports "=<<"

74+

75+ isIdentity :: ImportInfo -> Expr Void -> Boolean

76+ isIdentity imports (ExprIdent (QualifiedName { name: Ident name })) =

77+ (name == "identity" && hasValue imports "identity") || (name == "id" && hasValue imports "id")

78+ isIdentity _ _ = false

lib/purelint/src/Purelint/Rules/UseLastReverse.pursnew file+78

@@ -0,0 +1,78 @@

1+module Purelint.Rules.UseLastReverse where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: head (reverse x) -> last x

17+-- | Also: last (reverse x) -> head x

18+useLastReverseRule :: Rule

19+useLastReverseRule = mkRule (RuleId "UseLastReverse") run

20+ where

21+ run :: RuleContext -> Module Void -> Array LintWarning

22+ run ctx = foldMapModule visitor

23+ where

24+ imports = ctx.imports

25+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

26+

27+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

28+ checkExpr imports expr = case expr of

29+ -- Match: head (reverse x) or last (reverse x)

30+ ExprApp fn args

31+ | isHead imports fn || isLast imports fn ->

32+ case NEA.toArray args of

33+ [AppTerm arg] ->

34+ case unwrapParens arg of

35+ ExprApp reverseFn reverseArgs

36+ | isReverse imports reverseFn ->

37+ case NEA.toArray reverseArgs of

38+ [AppTerm innerArg] ->

39+ let

40+ x = printExpr innerArg

41+ isHeadCall = isHead imports fn

42+ newFn = if isHeadCall then "last" else "head"

43+ oldPattern = if isHeadCall then "head (reverse x)" else "last (reverse x)"

44+ in

45+ [ LintWarning

46+ { ruleId: RuleId "UseLastReverse"

47+ , message: WarningMessage $ oldPattern <> " can be simplified to " <> newFn <> " x"

48+ , range: rangeOf expr

49+ , severity: Warning

50+ , suggestion: Just $ Suggestion

51+ { replacement: ReplacementText (newFn <> " " <> x)

52+ , description: SuggestionDescription $ "Use " <> newFn <> " instead"

53+ }

54+ }

55+ ]

56+ _ -> []

57+ _ -> []

58+ _ -> []

59+ _ -> []

60+

61+ unwrapParens :: Expr Void -> Expr Void

62+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

63+ unwrapParens e = e

64+

65+ isHead :: ImportInfo -> Expr Void -> Boolean

66+ isHead imports (ExprIdent (QualifiedName { name: Ident name })) =

67+ name == "head" && hasValue imports "head"

68+ isHead _ _ = false

69+

70+ isLast :: ImportInfo -> Expr Void -> Boolean

71+ isLast imports (ExprIdent (QualifiedName { name: Ident name })) =

72+ name == "last" && hasValue imports "last"

73+ isLast _ _ = false

74+

75+ isReverse :: ImportInfo -> Expr Void -> Boolean

76+ isReverse imports (ExprIdent (QualifiedName { name: Ident name })) =

77+ name == "reverse" && hasValue imports "reverse"

78+ isReverse _ _ = false

lib/purelint/src/Purelint/Rules/UseMapMaybe.pursnew file+73

@@ -0,0 +1,73 @@

1+module Purelint.Rules.UseMapMaybe where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: catMaybes (map f x) -> mapMaybe f x

17+useMapMaybeRule :: Rule

18+useMapMaybeRule = mkRule (RuleId "UseMapMaybe") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: catMaybes (map f x)

29+ ExprApp fnExpr args

30+ | isCatMaybes imports fnExpr ->

31+ case NEA.toArray args of

32+ [AppTerm innerExpr] ->

33+ checkInnerMap imports expr (unwrapParens innerExpr)

34+ _ -> []

35+ _ -> []

36+

37+ unwrapParens :: Expr Void -> Expr Void

38+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

39+ unwrapParens e = e

40+

41+ checkInnerMap :: ImportInfo -> Expr Void -> Expr Void -> Array LintWarning

42+ checkInnerMap imports fullExpr innerExpr =

43+ case innerExpr of

44+ ExprApp mapFn mapArgs | isMap imports mapFn ->

45+ case NEA.toArray mapArgs of

46+ [AppTerm fExpr, AppTerm xExpr] ->

47+ let

48+ f = printExpr fExpr

49+ x = printExpr xExpr

50+ in

51+ [ LintWarning

52+ { ruleId: RuleId "UseMapMaybe"

53+ , message: WarningMessage "catMaybes (map f x) can be simplified to mapMaybe f x"

54+ , range: rangeOf fullExpr

55+ , severity: Warning

56+ , suggestion: Just $ Suggestion

57+ { replacement: ReplacementText ("mapMaybe " <> f <> " " <> x)

58+ , description: SuggestionDescription "Use mapMaybe instead of catMaybes composed with map"

59+ }

60+ }

61+ ]

62+ _ -> []

63+ _ -> []

64+

65+ isCatMaybes :: ImportInfo -> Expr Void -> Boolean

66+ isCatMaybes imports (ExprIdent (QualifiedName { name: Ident name })) =

67+ name == "catMaybes" && hasValue imports "catMaybes"

68+ isCatMaybes _ _ = false

69+

70+ isMap :: ImportInfo -> Expr Void -> Boolean

71+ isMap imports (ExprIdent (QualifiedName { name: Ident name })) =

72+ name == "map" && hasValue imports "map"

73+ isMap _ _ = false

lib/purelint/src/Purelint/Rules/UseMaybeMap.pursnew file+58

@@ -0,0 +1,58 @@

1+module Purelint.Rules.UseMaybeMap where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: maybe Nothing (Just <<< f) -> map f

17+useMaybeMapRule :: Rule

18+useMaybeMapRule = mkRule (RuleId "UseMaybeMap") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: maybe Nothing (Just <<< f) or maybe Nothing (\x -> Just (f x))

29+ ExprApp fnExpr args

30+ | isMaybe imports fnExpr ->

31+ case NEA.toArray args of

32+ [AppTerm nothingExpr, AppTerm fnArg]

33+ | isNothing imports (unwrapParens nothingExpr) ->

34+ checkJustComposition imports expr (unwrapParens fnArg)

35+ _ -> []

36+ _ -> []

37+

38+ unwrapParens :: Expr Void -> Expr Void

39+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

40+ unwrapParens e = e

41+

42+ -- Check if the function is Just <<< f

43+ checkJustComposition :: ImportInfo -> Expr Void -> Expr Void -> Array LintWarning

44+ checkJustComposition imports fullExpr fnExpr =

45+ case fnExpr of

46+ -- Pattern: Just <<< f (would need operator parsing)

47+ -- For now, suggest when we see the pattern

48+ _ -> []

49+

50+ isMaybe :: ImportInfo -> Expr Void -> Boolean

51+ isMaybe imports (ExprIdent (QualifiedName { name: Ident name })) =

52+ name == "maybe" && hasValue imports "maybe"

53+ isMaybe _ _ = false

54+

55+ isNothing :: ImportInfo -> Expr Void -> Boolean

56+ isNothing imports (ExprIdent (QualifiedName { name: Ident name })) =

57+ name == "Nothing" && hasValue imports "Nothing"

58+ isNothing _ _ = false

lib/purelint/src/Purelint/Rules/UseMinMax.pursnew file+78

@@ -0,0 +1,78 @@

1+module Purelint.Rules.UseMinMax where

3+import Prelude

5+import Data.Maybe (Maybe(..))

6+import Data.Void (Void)

7+import Purelint.Imports (ImportInfo, hasOp)

8+import Purelint.Print (printExpr)

9+import Purelint.Rule (Rule, RuleContext, mkRule)

10+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

11+import PureScript.CST.Range (rangeOf)

12+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

13+import PureScript.CST.Types (Expr(..), Ident(..), Module, Operator(..), QualifiedName(..), Wrapped(..))

14+import Data.Array.NonEmpty as NEA

15+import Data.Tuple (Tuple(..))

16+

17+-- | Rule: if a > b then a else b -> max a b

18+-- | Also: if a min a b

19+useMinMaxRule :: Rule

20+useMinMaxRule = mkRule (RuleId "UseMinMax") run

21+ where

22+ run :: RuleContext -> Module Void -> Array LintWarning

23+ run ctx = foldMapModule visitor

24+ where

25+ imports = ctx.imports

26+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

27+

28+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

29+ checkExpr imports expr = case expr of

30+ ExprIf { cond, true: trueExpr, false: falseExpr } ->

31+ case getComparison imports cond of

32+ Just { op, left, right } ->

33+ let leftText = printExpr left

34+ rightText = printExpr right

35+ trueText = printExpr trueExpr

36+ falseText = printExpr falseExpr

37+ in

38+ -- if a > b then a else b -> max a b

39+ -- if a >= b then a else b -> max a b

40+ if (op == ">" || op == ">=") && leftText == trueText && rightText == falseText then

41+ [ mkWarning expr "max" leftText rightText ]

42+ -- if a > b then b else a -> min a b

43+ -- if a >= b then b else a -> min a b

44+ else if (op == ">" || op == ">=") && rightText == trueText && leftText == falseText then

45+ [ mkWarning expr "min" leftText rightText ]

46+ -- if a min a b

47+ -- if a <= b then a else b -> min a b

48+ else if (op == "<" || op == "<=") && leftText == trueText && rightText == falseText then

49+ [ mkWarning expr "min" leftText rightText ]

50+ -- if a max a b

51+ -- if a <= b then b else a -> max a b

52+ else if (op == "<" || op == "<=") && rightText == trueText && leftText == falseText then

53+ [ mkWarning expr "max" leftText rightText ]

54+ else []

55+ Nothing -> []

56+ _ -> []

57+

58+ mkWarning :: Expr Void -> String -> String -> String -> LintWarning

59+ mkWarning expr fn a b = LintWarning

60+ { ruleId: RuleId "UseMinMax"

61+ , message: WarningMessage ("if comparison can be simplified to " <> fn)

62+ , range: rangeOf expr

63+ , severity: Warning

64+ , suggestion: Just $ Suggestion

65+ { replacement: ReplacementText (fn <> " " <> a <> " " <> b)

66+ , description: SuggestionDescription ("Use " <> fn <> " instead of if/else with comparison")

67+ }

68+ }

69+

70+ getComparison :: ImportInfo -> Expr Void -> Maybe { op :: String, left :: Expr Void, right :: Expr Void }

71+ getComparison imports (ExprOp left ops) =

72+ case NEA.toArray ops of

73+ [Tuple (QualifiedName { name: Operator op }) right]

74+ | (op == ">" || op == ">=" || op == "<" || op == "<=") && hasOp imports op ->

75+ Just { op, left, right }

76+ _ -> Nothing

77+ getComparison imports (ExprParens (Wrapped { value })) = getComparison imports value

78+ getComparison _ _ = Nothing

lib/purelint/src/Purelint/Rules/UseMinimumSort.pursnew file+78

@@ -0,0 +1,78 @@

1+module Purelint.Rules.UseMinimumSort where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: head (sort x) -> minimum x

17+-- | Also: last (sort x) -> maximum x

18+useMinimumSortRule :: Rule

19+useMinimumSortRule = mkRule (RuleId "UseMinimumSort") run

20+ where

21+ run :: RuleContext -> Module Void -> Array LintWarning

22+ run ctx = foldMapModule visitor

23+ where

24+ imports = ctx.imports

25+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

26+

27+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

28+ checkExpr imports expr = case expr of

29+ -- Match: head (sort x) or last (sort x)

30+ ExprApp fn args

31+ | isHead imports fn || isLast imports fn ->

32+ case NEA.toArray args of

33+ [AppTerm arg] ->

34+ case unwrapParens arg of

35+ ExprApp sortFn sortArgs

36+ | isSort imports sortFn ->

37+ case NEA.toArray sortArgs of

38+ [AppTerm innerArg] ->

39+ let

40+ x = printExpr innerArg

41+ isHeadCall = isHead imports fn

42+ newFn = if isHeadCall then "minimum" else "maximum"

43+ oldPattern = if isHeadCall then "head (sort x)" else "last (sort x)"

44+ in

45+ [ LintWarning

46+ { ruleId: RuleId "UseMinimumSort"

47+ , message: WarningMessage $ oldPattern <> " can be simplified to " <> newFn <> " x"

48+ , range: rangeOf expr

49+ , severity: Warning

50+ , suggestion: Just $ Suggestion

51+ { replacement: ReplacementText (newFn <> " " <> x)

52+ , description: SuggestionDescription $ "Use " <> newFn <> " instead of sorting"

53+ }

54+ }

55+ ]

56+ _ -> []

57+ _ -> []

58+ _ -> []

59+ _ -> []

60+

61+ unwrapParens :: Expr Void -> Expr Void

62+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

63+ unwrapParens e = e

64+

65+ isHead :: ImportInfo -> Expr Void -> Boolean

66+ isHead imports (ExprIdent (QualifiedName { name: Ident name })) =

67+ name == "head" && hasValue imports "head"

68+ isHead _ _ = false

69+

70+ isLast :: ImportInfo -> Expr Void -> Boolean

71+ isLast imports (ExprIdent (QualifiedName { name: Ident name })) =

72+ name == "last" && hasValue imports "last"

73+ isLast _ _ = false

74+

75+ isSort :: ImportInfo -> Expr Void -> Boolean

76+ isSort imports (ExprIdent (QualifiedName { name: Ident name })) =

77+ name == "sort" && hasValue imports "sort"

78+ isSort _ _ = false

lib/purelint/src/Purelint/Rules/UseNotElem.pursnew file+66

@@ -0,0 +1,66 @@

1+module Purelint.Rules.UseNotElem where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: not (elem x y) -> notElem x y

17+useNotElemRule :: Rule

18+useNotElemRule = mkRule (RuleId "UseNotElem") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: not (elem x y)

29+ ExprApp fnExpr args | isNot imports fnExpr ->

30+ case NEA.toArray args of

31+ [AppTerm innerExpr] ->

32+ case getElemArgs imports innerExpr of

33+ Just { x, y } ->

34+ let xText = printExpr x

35+ yText = printExpr y

36+ in

37+ [ LintWarning

38+ { ruleId: RuleId "UseNotElem"

39+ , message: WarningMessage "not (elem x y) can be simplified to notElem x y"

40+ , range: rangeOf expr

41+ , severity: Warning

42+ , suggestion: Just $ Suggestion

43+ { replacement: ReplacementText ("notElem " <> xText <> " " <> yText)

44+ , description: SuggestionDescription "Use notElem instead of not (elem ...)"

45+ }

46+ }

47+ ]

48+ Nothing -> []

49+ _ -> []

50+ _ -> []

51+

52+ isNot :: ImportInfo -> Expr Void -> Boolean

53+ isNot imports (ExprIdent (QualifiedName { name: Ident name })) =

54+ name == "not" && hasValue imports "not"

55+ isNot _ _ = false

56+

57+ getElemArgs :: ImportInfo -> Expr Void -> Maybe { x :: Expr Void, y :: Expr Void }

58+ getElemArgs imports (ExprApp fnExpr args) =

59+ case fnExpr of

60+ ExprIdent (QualifiedName { name: Ident name }) | name == "elem" && hasValue imports "elem" ->

61+ case NEA.toArray args of

62+ [AppTerm x, AppTerm y] -> Just { x, y }

63+ _ -> Nothing

64+ _ -> Nothing

65+ getElemArgs imports (ExprParens (Wrapped { value })) = getElemArgs imports value

66+ getElemArgs _ _ = Nothing

lib/purelint/src/Purelint/Rules/UseNull.pursnew file+79

@@ -0,0 +1,79 @@

1+module Purelint.Rules.UseNull where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Tuple (Tuple(..))

8+import Data.Void (Void)

9+import Purelint.Imports (ImportInfo, hasValue, hasOp)

10+import Purelint.Print (printExpr)

11+import Purelint.Rule (Rule, RuleContext, mkRule)

12+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

13+import PureScript.CST.Range (rangeOf)

14+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

15+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), IntValue(..), Module, Operator(..), QualifiedName(..))

16+

17+-- | Rule: length x == 0 -> null x

18+-- | Also: 0 == length x -> null x

19+useNullRule :: Rule

20+useNullRule = mkRule (RuleId "UseNull") run

21+ where

22+ run :: RuleContext -> Module Void -> Array LintWarning

23+ run ctx = foldMapModule visitor

24+ where

25+ imports = ctx.imports

26+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

27+

28+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

29+ checkExpr imports expr = case expr of

30+ -- Match: length x == 0 or 0 == length x

31+ ExprOp lhs ops | hasOp imports "==" && hasValue imports "null" ->

32+ case NEA.toArray ops of

33+ [Tuple qn rhs] | isEqOp qn ->

34+ -- length x == 0

35+ if isZeroLit rhs then

36+ case getLengthArg imports lhs of

37+ Just xText ->

38+ [ mkWarning expr xText "length x == 0" ]

39+ Nothing -> []

40+ -- 0 == length x

41+ else if isZeroLit lhs then

42+ case getLengthArg imports rhs of

43+ Just xText ->

44+ [ mkWarning expr xText "0 == length x" ]

45+ Nothing -> []

46+ else []

47+ _ -> []

48+ _ -> []

49+

50+ mkWarning :: Expr Void -> String -> String -> LintWarning

51+ mkWarning fullExpr xText from =

52+ LintWarning

53+ { ruleId: RuleId "UseNull"

54+ , message: WarningMessage $ "Use null instead of " <> from

55+ , range: rangeOf fullExpr

56+ , severity: Warning

57+ , suggestion: Just $ Suggestion

58+ { replacement: ReplacementText ("null " <> xText)

59+ , description: SuggestionDescription $ from <> " can be simplified to null x"

60+ }

61+ }

62+

63+ isEqOp :: QualifiedName Operator -> Boolean

64+ isEqOp (QualifiedName { name: Operator op }) = op == "=="

65+

66+ isZeroLit :: Expr Void -> Boolean

67+ isZeroLit (ExprInt _ (SmallInt 0)) = true

68+ isZeroLit (ExprInt _ (BigInt "0")) = true

69+ isZeroLit _ = false

70+

71+ getLengthArg :: ImportInfo -> Expr Void -> Maybe String

72+ getLengthArg imports (ExprApp fnExpr args) =

73+ case fnExpr of

74+ ExprIdent (QualifiedName { name: Ident name }) | name == "length" && hasValue imports "length" ->

75+ case NEA.toArray args of

76+ [AppTerm xExpr] -> Just (printExpr xExpr)

77+ _ -> Nothing

78+ _ -> Nothing

79+ getLengthArg _ _ = Nothing

lib/purelint/src/Purelint/Rules/UseOn.pursnew file+72

@@ -0,0 +1,72 @@

1+module Purelint.Rules.UseOn where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Binder(..), Expr(..), Ident(..), Module, Name(..), QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: \x y -> f (g x) (g y) -> on f g

17+useOnRule :: Rule

18+useOnRule = mkRule (RuleId "UseOn") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: \x y -> f (g x) (g y)

29+ ExprLambda { binders, body } ->

30+ case NEA.toArray binders of

31+ [BinderVar (Name { name: Ident x }), BinderVar (Name { name: Ident y })] ->

32+ checkOnBody imports expr x y (unwrapParens body)

33+ _ -> []

34+ _ -> []

35+

36+ unwrapParens :: Expr Void -> Expr Void

37+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

38+ unwrapParens e = e

39+

40+ checkOnBody :: ImportInfo -> Expr Void -> String -> String -> Expr Void -> Array LintWarning

41+ checkOnBody imports fullExpr x y body =

42+ case body of

43+ ExprApp fnExpr args ->

44+ case fnExpr, NEA.toArray args of

45+ ExprIdent (QualifiedName { name: Ident f }), [AppTerm gxExpr, AppTerm gyExpr] ->

46+ case extractFunctionCall (unwrapParens gxExpr), extractFunctionCall (unwrapParens gyExpr) of

47+ Just { fn: g1, arg: arg1 }, Just { fn: g2, arg: arg2 }

48+ | g1 == g2 && arg1 == x && arg2 == y ->

49+ [ LintWarning

50+ { ruleId: RuleId "UseOn"

51+ , message: WarningMessage "\\x y -> f (g x) (g y) can be simplified to on f g"

52+ , range: rangeOf fullExpr

53+ , severity: Hint

54+ , suggestion: Just $ Suggestion

55+ { replacement: ReplacementText ("on " <> f <> " " <> g1)

56+ , description: SuggestionDescription "Use on instead of lambda applying g to both arguments"

57+ }

58+ }

59+ ]

60+ _, _ -> []

61+ _, _ -> []

62+ _ -> []

63+

64+ extractFunctionCall :: Expr Void -> Maybe { fn :: String, arg :: String }

65+ extractFunctionCall (ExprApp fnExpr args) =

66+ case fnExpr, NEA.toArray args of

67+ ExprIdent (QualifiedName { name: Ident fn }), [AppTerm argExpr] ->

68+ case argExpr of

69+ ExprIdent (QualifiedName { name: Ident arg }) -> Just { fn, arg }

70+ _ -> Nothing

71+ _, _ -> Nothing

72+ extractFunctionCall _ = Nothing

lib/purelint/src/Purelint/Rules/UseOr.pursnew file+78

@@ -0,0 +1,78 @@

1+module Purelint.Rules.UseOr where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: any identity -> or

17+-- | Also: elem true -> or

18+useOrRule :: Rule

19+useOrRule = mkRule (RuleId "UseOr") run

20+ where

21+ run :: RuleContext -> Module Void -> Array LintWarning

22+ run ctx = foldMapModule visitor

23+ where

24+ imports = ctx.imports

25+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

26+

27+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

28+ checkExpr imports expr = case expr of

29+ -- Match: any identity xs or any id xs

30+ ExprApp fn args

31+ | isAny imports fn ->

32+ case NEA.toArray args of

33+ [AppTerm predArg] ->

34+ if isIdentity imports (unwrapParens predArg) then

35+ [ LintWarning

36+ { ruleId: RuleId "UseOr"

37+ , message: WarningMessage "any identity can be simplified to or"

38+ , range: rangeOf expr

39+ , severity: Warning

40+ , suggestion: Just $ Suggestion

41+ { replacement: ReplacementText "or"

42+ , description: SuggestionDescription "Use or instead of any identity"

43+ }

44+ }

45+ ]

46+ else []

47+ [AppTerm predArg, AppTerm xArg] ->

48+ if isIdentity imports (unwrapParens predArg) then

49+ let x = printExpr xArg

50+ in

51+ [ LintWarning

52+ { ruleId: RuleId "UseOr"

53+ , message: WarningMessage "any identity xs can be simplified to or xs"

54+ , range: rangeOf expr

55+ , severity: Warning

56+ , suggestion: Just $ Suggestion

57+ { replacement: ReplacementText ("or " <> x)

58+ , description: SuggestionDescription "Use or instead of any identity"

59+ }

60+ }

61+ ]

62+ else []

63+ _ -> []

64+ _ -> []

65+

66+ unwrapParens :: Expr Void -> Expr Void

67+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

68+ unwrapParens e = e

69+

70+ isAny :: ImportInfo -> Expr Void -> Boolean

71+ isAny imports (ExprIdent (QualifiedName { name: Ident name })) =

72+ name == "any" && hasValue imports "any"

73+ isAny _ _ = false

74+

75+ isIdentity :: ImportInfo -> Expr Void -> Boolean

76+ isIdentity imports (ExprIdent (QualifiedName { name: Ident name })) =

77+ (name == "identity" || name == "id") && hasValue imports "identity"

78+ isIdentity _ _ = false

lib/purelint/src/Purelint/Rules/UseReplicate.pursnew file+76

@@ -0,0 +1,76 @@

1+module Purelint.Rules.UseReplicate where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: take n (repeat x) -> replicate n x

17+useReplicateRule :: Rule

18+useReplicateRule = mkRule (RuleId "UseReplicate") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: take n (repeat x)

29+ ExprApp fn args

30+ | isTake imports fn ->

31+ case NEA.toArray args of

32+ [AppTerm nArg, AppTerm repeatArg] ->

33+ case getRepeatArg imports (unwrapParens repeatArg) of

34+ Just x ->

35+ let

36+ n = printExpr nArg

37+ xText = printExpr x

38+ in

39+ [ LintWarning

40+ { ruleId: RuleId "UseReplicate"

41+ , message: WarningMessage "take n (repeat x) can be simplified to replicate n x"

42+ , range: rangeOf expr

43+ , severity: Warning

44+ , suggestion: Just $ Suggestion

45+ { replacement: ReplacementText ("replicate " <> n <> " " <> xText)

46+ , description: SuggestionDescription "Use replicate instead of take n (repeat x)"

47+ }

48+ }

49+ ]

50+ Nothing -> []

51+ _ -> []

52+ _ -> []

53+

54+ unwrapParens :: Expr Void -> Expr Void

55+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

56+ unwrapParens e = e

57+

58+ isTake :: ImportInfo -> Expr Void -> Boolean

59+ isTake imports (ExprIdent (QualifiedName { name: Ident name })) =

60+ name == "take" && hasValue imports "take"

61+ isTake _ _ = false

62+

63+ isRepeat :: ImportInfo -> Expr Void -> Boolean

64+ isRepeat imports (ExprIdent (QualifiedName { name: Ident name })) =

65+ name == "repeat" && hasValue imports "repeat"

66+ isRepeat _ _ = false

67+

68+ getRepeatArg :: ImportInfo -> Expr Void -> Maybe (Expr Void)

69+ getRepeatArg imports e =

70+ case e of

71+ ExprApp repeatFn args

72+ | isRepeat imports repeatFn ->

73+ case NEA.toArray args of

74+ [AppTerm arg] -> Just arg

75+ _ -> Nothing

76+ _ -> Nothing

lib/purelint/src/Purelint/Rules/UseSequence.pursnew file+54

@@ -0,0 +1,54 @@

1+module Purelint.Rules.UseSequence where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Rule (Rule, RuleContext, mkRule)

10+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

11+import PureScript.CST.Range (rangeOf)

12+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

13+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..))

14+

15+-- | Rule: traverse identity -> sequence

16+-- | Also: for x identity -> sequence x

17+useSequenceRule :: Rule

18+useSequenceRule = mkRule (RuleId "UseSequence") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: traverse identity

29+ ExprApp fnExpr args | isTraverse imports fnExpr ->

30+ case NEA.toArray args of

31+ [AppTerm idExpr] | isIdentity imports idExpr ->

32+ [ LintWarning

33+ { ruleId: RuleId "UseSequence"

34+ , message: WarningMessage "traverse identity can be simplified to sequence"

35+ , range: rangeOf expr

36+ , severity: Warning

37+ , suggestion: Just $ Suggestion

38+ { replacement: ReplacementText "sequence"

39+ , description: SuggestionDescription "Use sequence instead of traverse identity"

40+ }

41+ }

42+ ]

43+ _ -> []

44+ _ -> []

45+

46+ isTraverse :: ImportInfo -> Expr Void -> Boolean

47+ isTraverse imports (ExprIdent (QualifiedName { name: Ident name })) =

48+ name == "traverse" && hasValue imports "traverse"

49+ isTraverse _ _ = false

50+

51+ isIdentity :: ImportInfo -> Expr Void -> Boolean

52+ isIdentity imports (ExprIdent (QualifiedName { name: Ident name })) =

53+ name == "identity" && hasValue imports "identity"

54+ isIdentity _ _ = false

lib/purelint/src/Purelint/Rules/UseSpan.pursnew file+93

@@ -0,0 +1,93 @@

1+module Purelint.Rules.UseSpan where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: break (not <<< p) -> span p

17+useSpanRule :: Rule

18+useSpanRule = mkRule (RuleId "UseSpan") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: break (not <<< p) x

29+ ExprApp fn args

30+ | isBreak imports fn ->

31+ case NEA.toArray args of

32+ [AppTerm predArg, AppTerm xArg] ->

33+ case getNotComposedPred imports predArg of

34+ Just p ->

35+ let

36+ pText = printExpr p

37+ x = printExpr xArg

38+ in

39+ [ LintWarning

40+ { ruleId: RuleId "UseSpan"

41+ , message: WarningMessage "break (not <<< p) can be simplified to span p"

42+ , range: rangeOf expr

43+ , severity: Hint

44+ , suggestion: Just $ Suggestion

45+ { replacement: ReplacementText ("span " <> pText <> " " <> x)

46+ , description: SuggestionDescription "Use span instead of break with negated predicate"

47+ }

48+ }

49+ ]

50+ Nothing -> []

51+ [AppTerm predArg] ->

52+ case getNotComposedPred imports predArg of

53+ Just p ->

54+ let pText = printExpr p

55+ in

56+ [ LintWarning

57+ { ruleId: RuleId "UseSpan"

58+ , message: WarningMessage "break (not <<< p) can be simplified to span p"

59+ , range: rangeOf expr

60+ , severity: Hint

61+ , suggestion: Just $ Suggestion

62+ { replacement: ReplacementText ("span " <> pText)

63+ , description: SuggestionDescription "Use span instead of break with negated predicate"

64+ }

65+ }

66+ ]

67+ Nothing -> []

68+ _ -> []

69+ _ -> []

70+

71+ unwrapParens :: Expr Void -> Expr Void

72+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

73+ unwrapParens e = e

74+

75+ isBreak :: ImportInfo -> Expr Void -> Boolean

76+ isBreak imports (ExprIdent (QualifiedName { name: Ident name })) =

77+ name == "break" && hasValue imports "break"

78+ isBreak _ _ = false

79+

80+ isNot :: ImportInfo -> Expr Void -> Boolean

81+ isNot imports (ExprIdent (QualifiedName { name: Ident name })) =

82+ name == "not" && hasValue imports "not"

83+ isNot _ _ = false

84+

85+ getNotComposedPred :: ImportInfo -> Expr Void -> Maybe (Expr Void)

86+ getNotComposedPred imports predExpr =

87+ case unwrapParens predExpr of

88+ ExprApp notFn args

89+ | isNot imports notFn ->

90+ case NEA.toArray args of

91+ [AppTerm p] -> Just p

92+ _ -> Nothing

93+ _ -> Nothing

lib/purelint/src/Purelint/Rules/UseTraverseSequence.pursnew file+66

@@ -0,0 +1,66 @@

1+module Purelint.Rules.UseTraverseSequence where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: sequence (map f x) -> traverse f x

17+useTraverseSequenceRule :: Rule

18+useTraverseSequenceRule = mkRule (RuleId "UseTraverseSequence") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: sequence (map f x)

29+ ExprApp fnExpr args | isSequence imports fnExpr ->

30+ case NEA.toArray args of

31+ [AppTerm mapExpr] ->

32+ case getMapArgs imports mapExpr of

33+ Just { f, x } ->

34+ let fText = printExpr f

35+ xText = printExpr x

36+ in

37+ [ LintWarning

38+ { ruleId: RuleId "UseTraverseSequence"

39+ , message: WarningMessage "sequence (map f x) can be simplified to traverse f x"

40+ , range: rangeOf expr

41+ , severity: Warning

42+ , suggestion: Just $ Suggestion

43+ { replacement: ReplacementText ("traverse " <> fText <> " " <> xText)

44+ , description: SuggestionDescription "Use traverse instead of sequence (map ...)"

45+ }

46+ }

47+ ]

48+ Nothing -> []

49+ _ -> []

50+ _ -> []

51+

52+ isSequence :: ImportInfo -> Expr Void -> Boolean

53+ isSequence imports (ExprIdent (QualifiedName { name: Ident name })) =

54+ (name == "sequence" || name == "sequenceA") && hasValue imports name

55+ isSequence _ _ = false

56+

57+ getMapArgs :: ImportInfo -> Expr Void -> Maybe { f :: Expr Void, x :: Expr Void }

58+ getMapArgs imports (ExprApp fnExpr args) =

59+ case fnExpr of

60+ ExprIdent (QualifiedName { name: Ident name }) | name == "map" && hasValue imports "map" ->

61+ case NEA.toArray args of

62+ [AppTerm f, AppTerm x] -> Just { f, x }

63+ _ -> Nothing

64+ _ -> Nothing

65+ getMapArgs imports (ExprParens (Wrapped { value })) = getMapArgs imports value

66+ getMapArgs _ _ = Nothing

lib/purelint/src/Purelint/Rules/UseUncurry.pursnew file+90

@@ -0,0 +1,90 @@

1+module Purelint.Rules.UseUncurry where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, Proper(..), QualifiedName(..), Separated(..), Wrapped(..))

15+

16+-- | Rule: f (fst p) (snd p) -> uncurry f p

17+useUncurryRule :: Rule

18+useUncurryRule = mkRule (RuleId "UseUncurry") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: f (fst p) (snd p)

29+ ExprApp fn args ->

30+ case NEA.toArray args of

31+ [AppTerm arg1, AppTerm arg2] ->

32+ case getFstArg imports (unwrapParens arg1), getSndArg imports (unwrapParens arg2) of

33+ Just p1, Just p2 ->

34+ let

35+ p1Text = printExpr p1

36+ p2Text = printExpr p2

37+ in

38+ if p1Text == p2Text then

39+ let

40+ f = printExpr fn

41+ in

42+ [ LintWarning

43+ { ruleId: RuleId "UseUncurry"

44+ , message: WarningMessage "f (fst p) (snd p) can be simplified to uncurry f p"

45+ , range: rangeOf expr

46+ , severity: Hint

47+ , suggestion: Just $ Suggestion

48+ { replacement: ReplacementText ("uncurry " <> f <> " " <> p1Text)

49+ , description: SuggestionDescription "Use uncurry instead of fst/snd"

50+ }

51+ }

52+ ]

53+ else []

54+ _, _ -> []

55+ _ -> []

56+ _ -> []

57+

58+ unwrapParens :: Expr Void -> Expr Void

59+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

60+ unwrapParens e = e

61+

62+ isFst :: ImportInfo -> Expr Void -> Boolean

63+ isFst imports (ExprIdent (QualifiedName { name: Ident name })) =

64+ name == "fst" && hasValue imports "fst"

65+ isFst _ _ = false

66+

67+ isSnd :: ImportInfo -> Expr Void -> Boolean

68+ isSnd imports (ExprIdent (QualifiedName { name: Ident name })) =

69+ name == "snd" && hasValue imports "snd"

70+ isSnd _ _ = false

71+

72+ getFstArg :: ImportInfo -> Expr Void -> Maybe (Expr Void)

73+ getFstArg imports e =

74+ case e of

75+ ExprApp fstFn args

76+ | isFst imports fstFn ->

77+ case NEA.toArray args of

78+ [AppTerm arg] -> Just arg

79+ _ -> Nothing

80+ _ -> Nothing

81+

82+ getSndArg :: ImportInfo -> Expr Void -> Maybe (Expr Void)

83+ getSndArg imports e =

84+ case e of

85+ ExprApp sndFn args

86+ | isSnd imports sndFn ->

87+ case NEA.toArray args of

88+ [AppTerm arg] -> Just arg

89+ _ -> Nothing

90+ _ -> Nothing

lib/purelint/src/Purelint/Rules/UseUnless.pursnew file+55

@@ -0,0 +1,55 @@

1+module Purelint.Rules.UseUnless where

3+import Prelude

5+import Data.Maybe (Maybe(..))

6+import Data.Void (Void)

7+import Purelint.Imports (ImportInfo, hasValue)

8+import Purelint.Print (printExpr)

9+import Purelint.Rule (Rule, RuleContext, mkRule)

10+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

11+import PureScript.CST.Range (rangeOf)

12+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

13+import PureScript.CST.Types (Expr(..), Ident(..), Module, QualifiedName(..))

14+

15+-- | Rule: if x then pure unit else y -> unless x y

16+useUnlessRule :: Rule

17+useUnlessRule = mkRule (RuleId "UseUnless") run

18+ where

19+ run :: RuleContext -> Module Void -> Array LintWarning

20+ run ctx = foldMapModule visitor

21+ where

22+ imports = ctx.imports

23+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

24+

25+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

26+ checkExpr imports expr = case expr of

27+ -- Match: if cond then pure unit else action

28+ ExprIf { cond, true: trueExpr, false: falseExpr }

29+ | isPureUnit imports trueExpr ->

30+ let condText = printExpr cond

31+ actionText = printExpr falseExpr

32+ in

33+ [ LintWarning

34+ { ruleId: RuleId "UseUnless"

35+ , message: WarningMessage "if x then pure unit else y can be simplified to unless x y"

36+ , range: rangeOf expr

37+ , severity: Warning

38+ , suggestion: Just $ Suggestion

39+ { replacement: ReplacementText ("unless " <> condText <> " " <> actionText)

40+ , description: SuggestionDescription "Use unless instead of if/else with pure unit"

41+ }

42+ }

43+ ]

44+ _ -> []

45+

46+ isPureUnit :: ImportInfo -> Expr Void -> Boolean

47+ isPureUnit imports (ExprApp fnExpr _) = isPure imports fnExpr

48+ isPureUnit imports (ExprIdent (QualifiedName { name: Ident name })) =

49+ name == "unit" || (name == "pure" && hasValue imports "pure")

50+ isPureUnit _ _ = false

51+

52+ isPure :: ImportInfo -> Expr Void -> Boolean

53+ isPure imports (ExprIdent (QualifiedName { name: Ident name })) =

54+ (name == "pure" && hasValue imports "pure") || (name == "return" && hasValue imports "return")

55+ isPure _ _ = false

lib/purelint/src/Purelint/Rules/UseVoid.pursnew file+66

@@ -0,0 +1,66 @@

1+module Purelint.Rules.UseVoid where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Tuple (Tuple(..))

8+import Data.Void (Void)

9+import Purelint.Imports (ImportInfo, hasValue, hasOp)

10+import Purelint.Print (printExpr)

11+import Purelint.Rule (Rule, RuleContext, mkRule)

12+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

13+import PureScript.CST.Range (rangeOf)

14+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

15+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, Operator(..), QualifiedName(..))

16+

17+-- | Rule: a *> pure unit -> void a

18+-- | Also: a >>= \_ -> pure unit -> void a

19+useVoidRule :: Rule

20+useVoidRule = mkRule (RuleId "UseVoid") run

21+ where

22+ run :: RuleContext -> Module Void -> Array LintWarning

23+ run ctx = foldMapModule visitor

24+ where

25+ imports = ctx.imports

26+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

27+

28+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

29+ checkExpr imports expr = case expr of

30+ -- Match: a *> pure unit or a >> pure unit

31+ ExprOp lhs ops | hasOp imports "*>" || hasOp imports ">>" ->

32+ case NEA.toArray ops of

33+ [Tuple qn rhs] | isSeqOp imports qn && isPureUnit imports rhs ->

34+ let aText = printExpr lhs

35+ in

36+ [ LintWarning

37+ { ruleId: RuleId "UseVoid"

38+ , message: WarningMessage "Use void instead of *> pure unit"

39+ , range: rangeOf expr

40+ , severity: Warning

41+ , suggestion: Just $ Suggestion

42+ { replacement: ReplacementText ("void " <> aText)

43+ , description: SuggestionDescription "a *> pure unit can be simplified to void a"

44+ }

45+ }

46+ ]

47+ _ -> []

48+ _ -> []

49+

50+ isSeqOp :: ImportInfo -> QualifiedName Operator -> Boolean

51+ isSeqOp imports (QualifiedName { name: Operator op }) =

52+ (op == "*>" && hasOp imports "*>") || (op == ">>" && hasOp imports ">>")

53+

54+ isPureUnit :: ImportInfo -> Expr Void -> Boolean

55+ isPureUnit imports (ExprApp fnExpr args) =

56+ case fnExpr of

57+ ExprIdent (QualifiedName { name: Ident name }) | (name == "pure" && hasValue imports "pure") || (name == "return" && hasValue imports "return") ->

58+ case NEA.toArray args of

59+ [AppTerm unitExpr] -> isUnit unitExpr

60+ _ -> false

61+ _ -> false

62+ isPureUnit _ _ = false

63+

64+ isUnit :: Expr Void -> Boolean

65+ isUnit (ExprIdent (QualifiedName { name: Ident name })) = name == "unit"

66+ isUnit _ = false

lib/purelint/src/Purelint/Rules/UseWhen.pursnew file+55

@@ -0,0 +1,55 @@

1+module Purelint.Rules.UseWhen where

3+import Prelude

5+import Data.Maybe (Maybe(..))

6+import Data.Void (Void)

7+import Purelint.Imports (ImportInfo, hasValue)

8+import Purelint.Print (printExpr)

9+import Purelint.Rule (Rule, RuleContext, mkRule)

10+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

11+import PureScript.CST.Range (rangeOf)

12+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

13+import PureScript.CST.Types (Expr(..), Ident(..), Module, QualifiedName(..))

14+

15+-- | Rule: if x then y else pure unit -> when x y

16+useWhenRule :: Rule

17+useWhenRule = mkRule (RuleId "UseWhen") run

18+ where

19+ run :: RuleContext -> Module Void -> Array LintWarning

20+ run ctx = foldMapModule visitor

21+ where

22+ imports = ctx.imports

23+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

24+

25+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

26+ checkExpr imports expr = case expr of

27+ -- Match: if cond then action else pure unit

28+ ExprIf { cond, true: trueExpr, false: falseExpr }

29+ | isPureUnit imports falseExpr ->

30+ let condText = printExpr cond

31+ actionText = printExpr trueExpr

32+ in

33+ [ LintWarning

34+ { ruleId: RuleId "UseWhen"

35+ , message: WarningMessage "if x then y else pure unit can be simplified to when x y"

36+ , range: rangeOf expr

37+ , severity: Warning

38+ , suggestion: Just $ Suggestion

39+ { replacement: ReplacementText ("when " <> condText <> " " <> actionText)

40+ , description: SuggestionDescription "Use when instead of if/else with pure unit"

41+ }

42+ }

43+ ]

44+ _ -> []

45+

46+ isPureUnit :: ImportInfo -> Expr Void -> Boolean

47+ isPureUnit imports (ExprApp fnExpr _) = isPure imports fnExpr

48+ isPureUnit imports (ExprIdent (QualifiedName { name: Ident name })) =

49+ name == "unit" || (name == "pure" && hasValue imports "pure")

50+ isPureUnit _ _ = false

51+

52+ isPure :: ImportInfo -> Expr Void -> Boolean

53+ isPure imports (ExprIdent (QualifiedName { name: Ident name })) =

54+ (name == "pure" && hasValue imports "pure") || (name == "return" && hasValue imports "return")

55+ isPure _ _ = false

lib/purelint/src/Purelint/Rules/UseZip.pursnew file+95

@@ -0,0 +1,95 @@

1+module Purelint.Rules.UseZip where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, Proper(..), QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: zipWith Tuple -> zip

17+useZipRule :: Rule

18+useZipRule = mkRule (RuleId "UseZip") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: zipWith Tuple xs ys

29+ ExprApp fn args

30+ | isZipWith imports fn ->

31+ case NEA.toArray args of

32+ [AppTerm fArg] ->

33+ if isTupleCtor (unwrapParens fArg) then

34+ [ LintWarning

35+ { ruleId: RuleId "UseZip"

36+ , message: WarningMessage "zipWith Tuple can be simplified to zip"

37+ , range: rangeOf expr

38+ , severity: Warning

39+ , suggestion: Just $ Suggestion

40+ { replacement: ReplacementText "zip"

41+ , description: SuggestionDescription "Use zip instead of zipWith Tuple"

42+ }

43+ }

44+ ]

45+ else []

46+ [AppTerm fArg, AppTerm xArg] ->

47+ if isTupleCtor (unwrapParens fArg) then

48+ let x = printExpr xArg

49+ in

50+ [ LintWarning

51+ { ruleId: RuleId "UseZip"

52+ , message: WarningMessage "zipWith Tuple can be simplified to zip"

53+ , range: rangeOf expr

54+ , severity: Warning

55+ , suggestion: Just $ Suggestion

56+ { replacement: ReplacementText ("zip " <> x)

57+ , description: SuggestionDescription "Use zip instead of zipWith Tuple"

58+ }

59+ }

60+ ]

61+ else []

62+ [AppTerm fArg, AppTerm xArg, AppTerm yArg] ->

63+ if isTupleCtor (unwrapParens fArg) then

64+ let

65+ x = printExpr xArg

66+ y = printExpr yArg

67+ in

68+ [ LintWarning

69+ { ruleId: RuleId "UseZip"

70+ , message: WarningMessage "zipWith Tuple xs ys can be simplified to zip xs ys"

71+ , range: rangeOf expr

72+ , severity: Warning

73+ , suggestion: Just $ Suggestion

74+ { replacement: ReplacementText ("zip " <> x <> " " <> y)

75+ , description: SuggestionDescription "Use zip instead of zipWith Tuple"

76+ }

77+ }

78+ ]

79+ else []

80+ _ -> []

81+ _ -> []

82+

83+ unwrapParens :: Expr Void -> Expr Void

84+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

85+ unwrapParens e = e

86+

87+ isZipWith :: ImportInfo -> Expr Void -> Boolean

88+ isZipWith imports (ExprIdent (QualifiedName { name: Ident name })) =

89+ name == "zipWith" && hasValue imports "zipWith"

90+ isZipWith _ _ = false

91+

92+ isTupleCtor :: Expr Void -> Boolean

93+ isTupleCtor (ExprConstructor (QualifiedName { name: Proper "Tuple" })) = true

94+ isTupleCtor (ExprIdent (QualifiedName { name: Ident "Tuple" })) = true

95+ isTupleCtor _ = false

lib/purelint/src/Purelint/Rules/WhenNot.pursnew file+93

@@ -0,0 +1,93 @@

1+module Purelint.Rules.WhenNot where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

6+import Data.Maybe (Maybe(..))

7+import Data.Void (Void)

8+import Purelint.Imports (ImportInfo, hasValue)

9+import Purelint.Print (printExpr)

10+import Purelint.Rule (Rule, RuleContext, mkRule)

11+import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..), SuggestionDescription(..), ReplacementText(..), WarningMessage(..))

12+import PureScript.CST.Range (rangeOf)

13+import PureScript.CST.Traversal (defaultMonoidalVisitor, foldMapModule)

14+import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Wrapped(..))

15+

16+-- | Rule: when (not x) -> unless x

17+whenNotRule :: Rule

18+whenNotRule = mkRule (RuleId "WhenNot") run

19+ where

20+ run :: RuleContext -> Module Void -> Array LintWarning

21+ run ctx = foldMapModule visitor

22+ where

23+ imports = ctx.imports

24+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

25+

26+ checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

27+ checkExpr imports expr = case expr of

28+ -- Match: when (not x) action

29+ ExprApp fn args

30+ | isWhen imports fn ->

31+ case NEA.toArray args of

32+ [AppTerm condArg, AppTerm actionArg] ->

33+ case getNotArg imports (unwrapParens condArg) of

34+ Just x ->

35+ let

36+ xText = printExpr x

37+ action = printExpr actionArg

38+ in

39+ [ LintWarning

40+ { ruleId: RuleId "WhenNot"

41+ , message: WarningMessage "when (not x) can be simplified to unless x"

42+ , range: rangeOf expr

43+ , severity: Hint

44+ , suggestion: Just $ Suggestion

45+ { replacement: ReplacementText ("unless " <> xText <> " " <> action)

46+ , description: SuggestionDescription "Use unless instead of when (not ...)"

47+ }

48+ }

49+ ]

50+ Nothing -> []

51+ [AppTerm condArg] ->

52+ case getNotArg imports (unwrapParens condArg) of

53+ Just x ->

54+ let xText = printExpr x

55+ in

56+ [ LintWarning

57+ { ruleId: RuleId "WhenNot"

58+ , message: WarningMessage "when (not x) can be simplified to unless x"

59+ , range: rangeOf expr

60+ , severity: Hint

61+ , suggestion: Just $ Suggestion

62+ { replacement: ReplacementText ("unless " <> xText)

63+ , description: SuggestionDescription "Use unless instead of when (not ...)"

64+ }

65+ }

66+ ]

67+ Nothing -> []

68+ _ -> []

69+ _ -> []

70+

71+ unwrapParens :: Expr Void -> Expr Void

72+ unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

73+ unwrapParens e = e

74+

75+ isWhen :: ImportInfo -> Expr Void -> Boolean

76+ isWhen imports (ExprIdent (QualifiedName { name: Ident name })) =

77+ name == "when" && hasValue imports "when"

78+ isWhen _ _ = false

79+

80+ isNot :: ImportInfo -> Expr Void -> Boolean

81+ isNot imports (ExprIdent (QualifiedName { name: Ident name })) =

82+ name == "not" && hasValue imports "not"

83+ isNot _ _ = false

84+

85+ getNotArg :: ImportInfo -> Expr Void -> Maybe (Expr Void)

86+ getNotArg imports e =

87+ case e of

88+ ExprApp notFn args

89+ | isNot imports notFn ->

90+ case NEA.toArray args of

91+ [AppTerm arg] -> Just arg

92+ _ -> Nothing

93+ _ -> Nothing

lib/purelint/src/Purelint/Runner.purs+25−2

@@ -5,12 +5,12 @@ import Prelude

55import Data.Array as Array

66import Data.Either (Either(..))

77import Data.Newtype (unwrap)

8−import Purelint.Imports (getImportInfo)

8+import Purelint.Imports (getImportInfo, ImportInfo)

99import Purelint.Rule (Rule, RuleContext)

1010import Purelint.Types (LintResult(..), SourceCode(..))

1111import PureScript.CST (RecoveredParserResult(..), parseModule)

1212import PureScript.CST.Errors (printParseError)

13−import PureScript.CST.Types (Module, ModuleHeader(..), ModuleName)

13+import PureScript.CST.Types (Module, ModuleHeader(..), ModuleName(..), ImportDecl(..), Name(..))

1414import Unsafe.Coerce (unsafeCoerce)

1515

1616-- | Run a set of rules on source code

@@ -21,6 +21,29 @@ runRules rules (SourceCode source) =

2121 ParseSucceededWithErrors m _ -> Right $ runOnModule rules (toVoidModule m)

2222 ParseFailed errRec -> Left $ "Parse error at " <> show (errRec.position.line + 1) <> ":" <> show (errRec.position.column + 1) <> ": " <> printParseError errRec.error

2323

24+-- | Get import info from source code (for debugging)

25+getImportsFromSource :: SourceCode -> Either String ImportInfo

26+getImportsFromSource (SourceCode source) =

27+ case parseModule source of

28+ ParseSucceeded m -> Right $ getImportInfo (toVoidModule m)

29+ ParseSucceededWithErrors m _ -> Right $ getImportInfo (toVoidModule m)

30+ ParseFailed _ -> Left "Parse error"

31+

32+-- | Get raw module names from imports (for debugging)

33+getModuleNames :: SourceCode -> Either String (Array String)

34+getModuleNames (SourceCode source) =

35+ case parseModule source of

36+ ParseSucceeded m -> Right $ extractModuleNames (toVoidModule m)

37+ ParseSucceededWithErrors m _ -> Right $ extractModuleNames (toVoidModule m)

38+ ParseFailed _ -> Left "Parse error"

39+ where

40+ extractModuleNames mod =

41+ let (ModuleHeader header) = (unwrap mod).header

42+ in map extractName header.imports

43+ extractName (ImportDecl imp) =

44+ case imp.module of

45+ Name { name: ModuleName n } -> n

46+

2447-- | Run rules on a successfully parsed module

2548runOnModule :: Array Rule -> Module Void -> LintResult

2649runOnModule rules mod =

lib/purelint/src/Purelint/Tidy.jsnew file+3

@@ -0,0 +1,3 @@

1+// For now, just return the input unchanged

2+// In a full implementation, we could shell out to purs-tidy or use its API

3+export const formatExpr = (str) => () => str;

lib/purelint/src/Purelint/Tidy.pursnew file+9

@@ -0,0 +1,9 @@

1+module Purelint.Tidy where

3+import Prelude

5+import Effect (Effect)

7+-- | Format a PureScript expression string using purs-tidy

8+-- | Returns the formatted string, or the original if formatting fails

9+foreign import formatExpr :: String -> Effect String

package.jsonnew file+16

@@ -0,0 +1,16 @@

1+{

2+ "name": "purelint",

3+ "version": "0.1.0",

4+ "description": "A linter for PureScript",

5+ "type": "module",

6+ "main": "output/Main/index.js",

7+ "bin": {

8+ "purelint": "./bin/purelint.js"

9+ },

10+ "scripts": {

11+ "build": "purs compile 'lib/**/*.purs' 'bin/purelint-cli/**/*.purs' '.spago/**/*.purs'",

12+ "test": "node --experimental-vm-modules test.js"

13+ },

14+ "keywords": ["purescript", "linter"],

15+ "license": "MIT"

16+}

spago.yaml−2

@@ -2,8 +2,6 @@ workspace:

22 packageSet:

33 registry: 71.0.0

44 extraPackages: {}

5− backend:

6− cmd: psgo

86package:

97 name: purelint-tests

test/LintExamples.purs+231−1

@@ -2,7 +2,12 @@ module Test.LintExamples where

33import Prelude

5−import Data.Traversable (class Traversable, sequence)

5+import Control.Monad (join)

6+import Data.Foldable (class Foldable, all, and, any, elem, fold, foldMap, length, null, or)

7+import Data.Maybe (Maybe, fromMaybe, isJust, isNothing, maybe)

8+import Data.Monoid (class Monoid, mempty)

9+import Data.Traversable (class Traversable, sequence, traverse)

10+import Data.Tuple (Tuple(..), fst, snd)

611

712-- ============================================================================

813-- FmapId: map identity x -> x

@@ -136,3 +141,228 @@ letToWhere2 x =

136141 b = x * 2

137142 in

138143 a + b

144+

145+-- ============================================================================

146+-- UseFromMaybe: maybe x identity -> fromMaybe x

147+-- ============================================================================

148+

149+-- | maybe x identity -> fromMaybe x

150+useFromMaybe1 :: forall a. a -> Maybe a -> a

151+useFromMaybe1 def m = maybe def identity m

152+

153+-- ============================================================================

154+-- UseIsJust: maybe false (const true) -> isJust

155+-- ============================================================================

156+

157+-- | maybe false (const true) -> isJust

158+useIsJust1 :: forall a. Maybe a -> Boolean

159+useIsJust1 m = maybe false (const true) m

160+

161+-- ============================================================================

162+-- UseIsNothing: maybe true (const false) -> isNothing

163+-- ============================================================================

164+

165+-- | maybe true (const false) -> isNothing

166+useIsNothing1 :: forall a. Maybe a -> Boolean

167+useIsNothing1 m = maybe true (const false) m

168+

169+-- ============================================================================

170+-- UseWhen: if x then y else pure unit -> when x y

171+-- ============================================================================

172+

173+-- | if x then y else pure unit -> when x y

174+useWhen1 :: forall m. Applicative m => Boolean -> m Unit -> m Unit

175+useWhen1 cond action = if cond then action else pure unit

176+

177+-- ============================================================================

178+-- UseUnless: if x then pure unit else y -> unless x y

179+-- ============================================================================

180+

181+-- | if x then pure unit else y -> unless x y

182+useUnless1 :: forall m. Applicative m => Boolean -> m Unit -> m Unit

183+useUnless1 cond action = if cond then pure unit else action

184+

185+-- ============================================================================

186+-- RedundantFlip: flip (flip f) -> f

187+-- ============================================================================

188+

189+-- | flip (flip f) -> f

190+redundantFlip1 :: forall a b c. (a -> b -> c) -> a -> b -> c

191+redundantFlip1 f = flip (flip f)

192+

193+-- ============================================================================

194+-- UseNotElem: not (elem x xs) -> notElem x xs

195+-- ============================================================================

196+

197+-- | not (elem x xs) -> notElem x xs

198+useNotElem1 :: forall f a. Foldable f => Eq a => a -> f a -> Boolean

199+useNotElem1 x xs = not (elem x xs)

200+

201+-- ============================================================================

202+-- UseMinMax: if a > b then a else b -> max a b

203+-- ============================================================================

204+

205+-- | if a > b then a else b -> max a b

206+useMax1 :: forall a. Ord a => a -> a -> a

207+useMax1 a b = if a > b then a else b

208+

209+-- | if a >= b then a else b -> max a b

210+useMax2 :: forall a. Ord a => a -> a -> a

211+useMax2 a b = if a >= b then a else b

212+

213+-- | if a min a b

214+useMin1 :: forall a. Ord a => a -> a -> a

215+useMin1 a b = if a < b then a else b

216+

217+-- | if a <= b then a else b -> min a b

218+useMin2 :: forall a. Ord a => a -> a -> a

219+useMin2 a b = if a <= b then a else b

220+

221+-- ============================================================================

222+-- MonoidIdentity: mempty <> x -> x

223+-- ============================================================================

224+

225+-- | mempty <> x -> x

226+monoidIdentity1 :: forall m. Monoid m => m -> m

227+monoidIdentity1 x = mempty <> x

228+

229+-- | x <> mempty -> x

230+monoidIdentity2 :: forall m. Monoid m => m -> m

231+monoidIdentity2 x = x <> mempty

232+

233+-- ============================================================================

234+-- UseFold: foldMap identity -> fold

235+-- ============================================================================

236+

237+-- | foldMap identity -> fold

238+useFold1 :: forall f m. Foldable f => Monoid m => f m -> m

239+useFold1 xs = foldMap identity xs

240+

241+-- ============================================================================

242+-- UseSequence: traverse identity -> sequence

243+-- ============================================================================

244+

245+-- | traverse identity -> sequence

246+useSequence1 :: forall t f a. Traversable t => Applicative f => t (f a) -> f (t a)

247+useSequence1 xs = traverse identity xs

248+

249+-- ============================================================================

250+-- UseTraverseSequence: sequence (map f x) -> traverse f x

251+-- ============================================================================

252+

253+-- | sequence (map f x) -> traverse f x

254+useTraverseSequence1 :: forall t f a b. Traversable t => Applicative f => (a -> f b) -> t a -> f (t b)

255+useTraverseSequence1 f xs = sequence (map f xs)

256+

257+-- | sequence (f <$> x) -> traverse f x

258+useTraverseSequence2 :: forall t f a b. Traversable t => Applicative f => (a -> f b) -> t a -> f (t b)

259+useTraverseSequence2 f xs = sequence (f <$> xs)

260+

261+-- ============================================================================

262+-- RedundantNot: not (not x) -> x

263+-- ============================================================================

264+

265+-- | not (not x) -> x

266+redundantNot1 :: Boolean -> Boolean

267+redundantNot1 x = not (not x)

268+

269+-- ============================================================================

270+-- UseFstSnd: \(Tuple x _) -> x -> fst

271+-- ============================================================================

272+

273+-- | \(Tuple x _) -> x -> fst

274+useFst1 :: forall a b. Tuple a b -> a

275+useFst1 = \(Tuple x _) -> x

276+

277+-- | \(Tuple _ y) -> y -> snd

278+useSnd1 :: forall a b. Tuple a b -> b

279+useSnd1 = \(Tuple _ y) -> y

280+

281+-- ============================================================================

282+-- RedundantIf: if a then true else false -> a

283+-- ============================================================================

284+

285+-- | if a then true else false -> a

286+redundantIf1 :: Boolean -> Boolean

287+redundantIf1 a = if a then true else false

288+

289+-- | if a then false else true -> not a

290+redundantIf2 :: Boolean -> Boolean

291+redundantIf2 a = if a then false else true

292+

293+-- ============================================================================

294+-- FunctorLaw: map f (map g x) -> map (f <<< g) x

295+-- ============================================================================

296+

297+-- Note: This is the same as MapFusion, testing both rule names

298+-- | map f (map g x) -> map (f <<< g) x

299+functorLaw1 :: Array String

300+functorLaw1 = map show (map (_ + 1) [ 1, 2, 3 ])

301+

302+-- ============================================================================

303+-- UseVoid: a *> pure unit -> void a

304+-- ============================================================================

305+

306+-- | a *> pure unit -> void a

307+useVoid1 :: forall m. Applicative m => m Int -> m Unit

308+useVoid1 a = a *> pure unit

309+

310+-- ============================================================================

311+-- UseJoin: x >>= identity -> join x

312+-- ============================================================================

313+

314+-- | x >>= identity -> join x

315+useJoin1 :: forall m a. Monad m => m (m a) -> m a

316+useJoin1 x = x >>= identity

317+

318+-- ============================================================================

319+-- UseAny: or (map f x) -> any f x

320+-- ============================================================================

321+

322+-- | or (map f x) -> any f x

323+useAny1 :: forall f a. Foldable f => Functor f => (a -> Boolean) -> f a -> Boolean

324+useAny1 f xs = or (map f xs)

325+

326+-- ============================================================================

327+-- UseAll: and (map f x) -> all f x

328+-- ============================================================================

329+

330+-- | and (map f x) -> all f x

331+useAll1 :: forall f a. Foldable f => Functor f => (a -> Boolean) -> f a -> Boolean

332+useAll1 f xs = and (map f xs)

333+

334+-- ============================================================================

335+-- BooleanSimplify: x == true -> x

336+-- ============================================================================

337+

338+-- | x == true -> x

339+booleanSimplify1 :: Boolean -> Boolean

340+booleanSimplify1 x = x == true

341+

342+-- | x == false -> not x

343+booleanSimplify2 :: Boolean -> Boolean

344+booleanSimplify2 x = x == false

345+

346+-- ============================================================================

347+-- CollapseLambdas: \x -> \y -> body -> \x y -> body

348+-- ============================================================================

349+

350+-- | \x -> \y -> body -> \x y -> body

351+collapseLambdas1 :: Int -> Int -> Int

352+collapseLambdas1 = \x -> \y -> x + y

353+

354+-- ============================================================================

355+-- UseConst: \x -> y -> const y

356+-- ============================================================================

357+

358+-- | \_ -> y -> const y

359+useConst1 :: forall a. a -> Int

360+useConst1 = \_ -> 42

361+

362+-- ============================================================================

363+-- UseNull: length x == 0 -> null x

364+-- ============================================================================

365+

366+-- | length x == 0 -> null x

367+useNull1 :: forall f a. Foldable f => f a -> Boolean

368+useNull1 xs = length xs == 0

test/Test/Main.purs+1236−2

@@ -7,9 +7,11 @@ import Data.Either (Either(..))

77import Data.Foldable (for_)

88import Data.Maybe (Maybe(..))

99import Data.Newtype (unwrap)

10+import Data.Traversable (traverse)

1011import Effect (Effect)

1112import Effect.Class.Console (log)

1213import Purelint.Fix (applyAllFixes)

14+import Purelint.Tidy (formatExpr)

1315import Purelint.Rules.FmapId (fmapIdRule)

1416import Purelint.Rules.MapFusion (mapFusionRule)

1517import Purelint.Rules.UseTraverse (useTraverseRule)

@@ -20,8 +22,66 @@ import Purelint.Rules.EtaReduce (etaReduceRule)

2022import Purelint.Rules.EtaReduceDecl (etaReduceDeclRule)

2123import Purelint.Rules.RedundantBind (redundantBindRule)

2224import Purelint.Rules.LetToWhere (letToWhereRule)

25+import Purelint.Rules.RedundantIf (redundantIfRule)

26+import Purelint.Rules.FunctorLaw (functorLawRule)

27+import Purelint.Rules.UseVoid (useVoidRule)

28+import Purelint.Rules.UseJoin (useJoinRule)

29+import Purelint.Rules.UseAny (useAnyRule)

30+import Purelint.Rules.UseAll (useAllRule)

31+import Purelint.Rules.BooleanSimplify (booleanSimplifyRule)

32+import Purelint.Rules.CollapseLambdas (collapseLambdasRule)

33+import Purelint.Rules.UseConst (useConstRule)

34+import Purelint.Rules.UseNull (useNullRule)

35+import Purelint.Rules.UseFromMaybe (useFromMaybeRule)

36+import Purelint.Rules.UseIsJust (useIsJustRule)

37+import Purelint.Rules.UseIsNothing (useIsNothingRule)

38+import Purelint.Rules.UseWhen (useWhenRule)

39+import Purelint.Rules.UseUnless (useUnlessRule)

40+import Purelint.Rules.RedundantFlip (redundantFlipRule)

41+import Purelint.Rules.UseNotElem (useNotElemRule)

42+import Purelint.Rules.UseMinMax (useMinMaxRule)

43+import Purelint.Rules.MonoidIdentity (monoidIdentityRule)

44+import Purelint.Rules.UseFold (useFoldRule)

45+import Purelint.Rules.UseSequence (useSequenceRule)

46+import Purelint.Rules.UseTraverseSequence (useTraverseSequenceRule)

47+import Purelint.Rules.RedundantNot (redundantNotRule)

48+import Purelint.Rules.UseFstSnd (useFstSndRule)

49+import Purelint.Rules.UseMapMaybe (useMapMaybeRule)

50+import Purelint.Rules.UseGuardMaybe (useGuardMaybeRule)

51+import Purelint.Rules.UseMaybeMap (useMaybeMapRule)

52+import Purelint.Rules.UseApplicative (useApplicativeRule)

53+import Purelint.Rules.UseBindFlip (useBindFlipRule)

54+import Purelint.Rules.UseFor (useForRule)

55+import Purelint.Rules.RedundantGuard (redundantGuardRule)

56+import Purelint.Rules.UseComparing (useComparingRule)

57+import Purelint.Rules.UseOn (useOnRule)

58+import Purelint.Rules.UseFindMap (useFindMapRule)

59+import Purelint.Rules.UseLastReverse (useLastReverseRule)

60+import Purelint.Rules.RedundantReverse (redundantReverseRule)

61+import Purelint.Rules.UseBreak (useBreakRule)

62+import Purelint.Rules.UseSpan (useSpanRule)

63+import Purelint.Rules.UseMinimumSort (useMinimumSortRule)

64+import Purelint.Rules.UseBimap (useBimapRule)

65+import Purelint.Rules.UseEitherMap (useEitherMapRule)

66+import Purelint.Rules.EvaluateFst (evaluateFstRule)

67+import Purelint.Rules.EvaluateConst (evaluateConstRule)

68+import Purelint.Rules.UseOr (useOrRule)

69+import Purelint.Rules.UseAnd (useAndRule)

70+import Purelint.Rules.UseFoldMapId (useFoldMapIdRule)

71+import Purelint.Rules.WhenNot (whenNotRule)

72+import Purelint.Rules.UnlessNot (unlessNotRule)

73+import Purelint.Rules.UseZip (useZipRule)

74+import Purelint.Rules.UseReplicate (useReplicateRule)

75+import Purelint.Rules.UseUncurry (useUncurryRule)

76+import Purelint.Rules.RedundantNegate (redundantNegateRule)

77+import Purelint.Rules.UseFromJust (useFromJustRule)

78+import Purelint.Rules.UseHead (useHeadRule)

79+import Purelint.Rules.RedundantId (redundantIdRule)

80+import Purelint.Rules.NothingBind (nothingBindRule)

81+import Purelint.Rules.UseElemIndex (useElemIndexRule)

2382import Purelint.Rule (Rule)

24−import Purelint.Runner (runRules)

83+import Purelint.Runner (runRules, getImportsFromSource, getModuleNames)

84+import Purelint.Imports (hasValue, isPreludeModule)

2585import Purelint.Types (LintResult(..), LintWarning(..), RuleId(..), SourceCode(..), Suggestion(..))

2686

2787-- | Simple test framework

@@ -98,6 +158,54 @@ main = do

98158 <> etaReduceDeclTests

99159 <> redundantBindTests

100160 <> letToWhereTests

161+ <> redundantIfTests

162+ <> functorLawTests

163+ <> useVoidTests

164+ <> useJoinTests

165+ <> useAnyTests

166+ <> useAllTests

167+ <> booleanSimplifyTests

168+ <> collapseLambdasTests

169+ <> useConstTests

170+ <> useNullTests

171+ <> useFromMaybeTests

172+ <> useIsJustTests

173+ <> useIsNothingTests

174+ <> useWhenTests

175+ <> useUnlessTests

176+ <> redundantFlipTests

177+ <> useNotElemTests

178+ <> useMinMaxTests

179+ <> monoidIdentityTests

180+ <> useFoldTests

181+ <> useSequenceTests

182+ <> useTraverseSequenceTests

183+ <> redundantNotTests

184+ <> useFstSndTests

185+ <> useMapMaybeTests

186+ <> useApplicativeTests

187+ <> useBindFlipTests

188+ <> useForTests

189+ <> redundantGuardTests

190+ <> useComparingTests

191+ <> useOnTests

192+ <> useFindMapTests

193+ <> useLastReverseTests

194+ <> redundantReverseTests

195+ <> useMinimumSortTests

196+ <> useBimapTests

197+ <> evaluateFstTests

198+ <> evaluateConstTests

199+ <> useOrTests

200+ <> useAndTests

201+ <> useFoldMapIdTests

202+ <> whenNotTests

203+ <> unlessNotTests

204+ <> useZipTests

205+ <> redundantNegateTests

206+ <> redundantIdTests

207+ <> nothingBindTests

208+ <> goldenTests

101209

102210 let passed = Array.length $ Array.filter _.passed results

103211 let total = Array.length results

@@ -115,9 +223,23 @@ main = do

115223 when (passed < total) do

116224 log "\nSome tests failed!"

117225

226+ -- Run purs-tidy formatting tests

227+ log "\nRunning purs-tidy formatting tests..."

228+ tidyResults <- runTidyTests

229+ let tidyPassed = Array.length $ Array.filter _.passed tidyResults

230+ let tidyTotal = Array.length tidyResults

231+

232+ let tidyFailures = Array.filter (not <<< _.passed) tidyResults

233+ when (Array.length tidyFailures > 0) do

234+ log "TIDY FAILURES:"

235+ for_ tidyFailures (\r -> log (" ✗ " <> r.name <> ": " <> r.message))

236+ log ""

237+

238+ log $ "Tidy tests: " <> show tidyPassed <> "/" <> show tidyTotal <> " passed"

239+

118240-- | Helper: wrap code in a module with Prelude import

119241withPrelude :: String -> String

120−withPrelude code = "module Test where\nimport Prelude\n" <> code

242+withPrelude code = "module Test where\nimport Prelude\nimport Data.Maybe\nimport Data.Foldable\nimport Data.Tuple\nimport Data.Monoid\nimport Data.Traversable\nimport Data.Array\nimport Control.Alternative\nimport Data.Ord\nimport Data.Either\nimport Data.Bifunctor\nimport Data.List\n" <> code

121243

122244-- | Helper: wrap code in module without imports

123245withoutImports :: String -> String

@@ -317,6 +439,12 @@ redundantBindTests =

317439 (withPrelude "x = [1] >>= pure") 1

318440 , assertRuleId "RedundantBind: correct rule id" [redundantBindRule]

319441 (withPrelude "x = [1] >>= pure") "RedundantBind"

442+ , assertSuggestion "RedundantBind: x >>= pure suggestion" [redundantBindRule]

443+ (withPrelude "x = [1] >>= pure") "[1]"

444+ , assertWarningCount "RedundantBind: pure x >>= f" [redundantBindRule]

445+ (withPrelude "x = pure 1 >>= show") 1

446+ , assertSuggestion "RedundantBind: pure x >>= f suggestion" [redundantBindRule]

447+ (withPrelude "x = pure 1 >>= show") "show 1"

320448

321449 -- Negative cases

322450 , assertWarningCount "RedundantBind: no fire on x >>= f" [redundantBindRule]

@@ -349,3 +477,1109 @@ letToWhereTests =

349477 , assertSuggestion "LetToWhere: preserves spaces with multiple bindings" [letToWhereRule]

350478 (withPrelude "f x = let a = x + 1\n b = x * 2 in a + b") "a + b\n where\n a = x + 1\n b = x * 2"

351479 ]

480+

481+-- ============================================================================

482+-- RedundantIf Tests

483+-- ============================================================================

484+

485+redundantIfTests :: Array TestResult

486+redundantIfTests =

487+ -- Positive cases

488+ [ assertWarningCount "RedundantIf: if a then true else false" [redundantIfRule]

489+ (withPrelude "x = if foo then true else false") 1

490+ , assertRuleId "RedundantIf: correct rule id" [redundantIfRule]

491+ (withPrelude "x = if foo then true else false") "RedundantIf"

492+ , assertSuggestion "RedundantIf: suggests condition" [redundantIfRule]

493+ (withPrelude "x = if foo then true else false") "foo"

494+ , assertWarningCount "RedundantIf: if a then false else true" [redundantIfRule]

495+ (withPrelude "x = if foo then false else true") 1

496+ , assertSuggestion "RedundantIf: suggests not condition" [redundantIfRule]

497+ (withPrelude "x = if foo then false else true") "not foo"

498+

499+ -- Negative cases

500+ , assertWarningCount "RedundantIf: no fire on normal if" [redundantIfRule]

501+ (withPrelude "x = if foo then 1 else 2") 0

502+ , assertWarningCount "RedundantIf: no fire on if a then true else x" [redundantIfRule]

503+ (withPrelude "x = if foo then true else bar") 0

504+ ]

505+

506+-- ============================================================================

507+-- FunctorLaw Tests

508+-- ============================================================================

509+

510+functorLawTests :: Array TestResult

511+functorLawTests =

512+ -- Positive cases

513+ [ assertWarningCount "FunctorLaw: map f (map g x)" [functorLawRule]

514+ (withPrelude "x = map f (map g [1])") 1

515+ , assertRuleId "FunctorLaw: correct rule id" [functorLawRule]

516+ (withPrelude "x = map f (map g [1])") "FunctorLaw"

517+ , assertWarningCount "FunctorLaw: f <$> (g <$> x)" [functorLawRule]

518+ (withPrelude "x = f <$> (g <$> [1])") 1

519+

520+ -- Negative cases

521+ , assertWarningCount "FunctorLaw: no fire on single map" [functorLawRule]

522+ (withPrelude "x = map f [1]") 0

523+ , assertWarningCount "FunctorLaw: no fire without import" [functorLawRule]

524+ (withoutImports "x = map f (map g [1])") 0

525+ ]

526+

527+-- ============================================================================

528+-- UseVoid Tests

529+-- ============================================================================

530+

531+useVoidTests :: Array TestResult

532+useVoidTests =

533+ -- Positive cases

534+ [ assertWarningCount "UseVoid: a *> pure unit" [useVoidRule]

535+ (withPrelude "x = foo *> pure unit") 1

536+ , assertRuleId "UseVoid: correct rule id" [useVoidRule]

537+ (withPrelude "x = foo *> pure unit") "UseVoid"

538+ , assertSuggestion "UseVoid: suggests void" [useVoidRule]

539+ (withPrelude "x = foo *> pure unit") "void foo"

540+

541+ -- Negative cases

542+ , assertWarningCount "UseVoid: no fire on a *> pure x" [useVoidRule]

543+ (withPrelude "x = foo *> pure 1") 0

544+ , assertWarningCount "UseVoid: no fire without import" [useVoidRule]

545+ (withoutImports "x = foo *> pure unit") 0

546+ ]

547+

548+-- ============================================================================

549+-- UseJoin Tests

550+-- ============================================================================

551+

552+useJoinTests :: Array TestResult

553+useJoinTests =

554+ -- Positive cases

555+ [ assertWarningCount "UseJoin: x >>= identity" [useJoinRule]

556+ (withPrelude "x = foo >>= identity") 1

557+ , assertRuleId "UseJoin: correct rule id" [useJoinRule]

558+ (withPrelude "x = foo >>= identity") "UseJoin"

559+ , assertSuggestion "UseJoin: suggests join" [useJoinRule]

560+ (withPrelude "x = foo >>= identity") "join foo"

561+

562+ -- Negative cases

563+ , assertWarningCount "UseJoin: no fire on x >>= f" [useJoinRule]

564+ (withPrelude "x = foo >>= show") 0

565+ , assertWarningCount "UseJoin: no fire without import" [useJoinRule]

566+ (withoutImports "x = foo >>= identity") 0

567+ ]

568+

569+-- ============================================================================

570+-- UseAny Tests

571+-- ============================================================================

572+

573+useAnyTests :: Array TestResult

574+useAnyTests =

575+ -- Positive cases

576+ [ assertWarningCount "UseAny: or (map f x)" [useAnyRule]

577+ (withPrelude "x = or (map f [1])") 1

578+ , assertRuleId "UseAny: correct rule id" [useAnyRule]

579+ (withPrelude "x = or (map f [1])") "UseAny"

580+ , assertSuggestion "UseAny: suggests any" [useAnyRule]

581+ (withPrelude "x = or (map f [1])") "any f [1]"

582+

583+ -- Negative cases

584+ , assertWarningCount "UseAny: no fire on or alone" [useAnyRule]

585+ (withPrelude "x = or [true]") 0

586+ , assertWarningCount "UseAny: no fire without import" [useAnyRule]

587+ (withoutImports "x = or (map f [1])") 0

588+ ]

589+

590+-- ============================================================================

591+-- UseAll Tests

592+-- ============================================================================

593+

594+useAllTests :: Array TestResult

595+useAllTests =

596+ -- Positive cases

597+ [ assertWarningCount "UseAll: and (map f x)" [useAllRule]

598+ (withPrelude "x = and (map f [1])") 1

599+ , assertRuleId "UseAll: correct rule id" [useAllRule]

600+ (withPrelude "x = and (map f [1])") "UseAll"

601+ , assertSuggestion "UseAll: suggests all" [useAllRule]

602+ (withPrelude "x = and (map f [1])") "all f [1]"

603+

604+ -- Negative cases

605+ , assertWarningCount "UseAll: no fire on and alone" [useAllRule]

606+ (withPrelude "x = and [true]") 0

607+ , assertWarningCount "UseAll: no fire without import" [useAllRule]

608+ (withoutImports "x = and (map f [1])") 0

609+ ]

610+

611+-- ============================================================================

612+-- BooleanSimplify Tests

613+-- ============================================================================

614+

615+booleanSimplifyTests :: Array TestResult

616+booleanSimplifyTests =

617+ -- Positive cases

618+ [ assertWarningCount "BooleanSimplify: x == true" [booleanSimplifyRule]

619+ (withPrelude "x = foo == true") 1

620+ , assertRuleId "BooleanSimplify: correct rule id" [booleanSimplifyRule]

621+ (withPrelude "x = foo == true") "BooleanSimplify"

622+ , assertSuggestion "BooleanSimplify: x == true -> x" [booleanSimplifyRule]

623+ (withPrelude "x = foo == true") "foo"

624+ , assertWarningCount "BooleanSimplify: x == false" [booleanSimplifyRule]

625+ (withPrelude "x = foo == false") 1

626+ , assertSuggestion "BooleanSimplify: x == false -> not x" [booleanSimplifyRule]

627+ (withPrelude "x = foo == false") "not foo"

628+ , assertWarningCount "BooleanSimplify: true == x" [booleanSimplifyRule]

629+ (withPrelude "x = true == foo") 1

630+ , assertWarningCount "BooleanSimplify: false == x" [booleanSimplifyRule]

631+ (withPrelude "x = false == foo") 1

632+

633+ -- Negative cases

634+ , assertWarningCount "BooleanSimplify: no fire on x == y" [booleanSimplifyRule]

635+ (withPrelude "x = foo == bar") 0

636+ , assertWarningCount "BooleanSimplify: no fire without import" [booleanSimplifyRule]

637+ (withoutImports "x = foo == true") 0

638+ ]

639+

640+-- ============================================================================

641+-- CollapseLambdas Tests

642+-- ============================================================================

643+

644+collapseLambdasTests :: Array TestResult

645+collapseLambdasTests =

646+ -- Positive cases

647+ [ assertWarningCount "CollapseLambdas: \\x -> \\y -> body" [collapseLambdasRule]

648+ (withPrelude "x = \\a -> \\b -> a + b") 1

649+ , assertRuleId "CollapseLambdas: correct rule id" [collapseLambdasRule]

650+ (withPrelude "x = \\a -> \\b -> a + b") "CollapseLambdas"

651+ , assertSuggestion "CollapseLambdas: suggests collapsed" [collapseLambdasRule]

652+ (withPrelude "x = \\a -> \\b -> a + b") "\\a b -> a + b"

653+

654+ -- Negative cases

655+ , assertWarningCount "CollapseLambdas: no fire on single lambda" [collapseLambdasRule]

656+ (withPrelude "x = \\a -> a + 1") 0

657+ ]

658+

659+-- ============================================================================

660+-- UseConst Tests

661+-- ============================================================================

662+

663+useConstTests :: Array TestResult

664+useConstTests =

665+ -- Positive cases

666+ [ assertWarningCount "UseConst: \\x -> y (unused)" [useConstRule]

667+ (withPrelude "x = \\a -> 42") 1

668+ , assertRuleId "UseConst: correct rule id" [useConstRule]

669+ (withPrelude "x = \\a -> 42") "UseConst"

670+ , assertSuggestion "UseConst: suggests const" [useConstRule]

671+ (withPrelude "x = \\a -> 42") "const 42"

672+

673+ -- Negative cases

674+ , assertWarningCount "UseConst: no fire when param used" [useConstRule]

675+ (withPrelude "x = \\a -> a + 1") 0

676+ , assertWarningCount "UseConst: no fire without import" [useConstRule]

677+ (withoutImports "x = \\a -> 42") 0

678+ ]

679+

680+-- ============================================================================

681+-- UseNull Tests

682+-- ============================================================================

683+

684+useNullTests :: Array TestResult

685+useNullTests =

686+ -- Positive cases

687+ [ assertWarningCount "UseNull: length x == 0" [useNullRule]

688+ (withPrelude "x = length [1] == 0") 1

689+ , assertRuleId "UseNull: correct rule id" [useNullRule]

690+ (withPrelude "x = length [1] == 0") "UseNull"

691+ , assertSuggestion "UseNull: suggests null" [useNullRule]

692+ (withPrelude "x = length [1] == 0") "null [1]"

693+ , assertWarningCount "UseNull: 0 == length x" [useNullRule]

694+ (withPrelude "x = 0 == length [1]") 1

695+

696+ -- Negative cases

697+ , assertWarningCount "UseNull: no fire on length x == 1" [useNullRule]

698+ (withPrelude "x = length [1] == 1") 0

699+ , assertWarningCount "UseNull: no fire without import" [useNullRule]

700+ (withoutImports "x = length [1] == 0") 0

701+ ]

702+

703+-- ============================================================================

704+-- UseFromMaybe Tests

705+-- ============================================================================

706+

707+useFromMaybeTests :: Array TestResult

708+useFromMaybeTests =

709+ [ assertWarningCount "UseFromMaybe: maybe x identity" [useFromMaybeRule]

710+ (withPrelude "x = maybe 0 identity") 1

711+ , assertRuleId "UseFromMaybe: correct rule id" [useFromMaybeRule]

712+ (withPrelude "x = maybe 0 identity") "UseFromMaybe"

713+ , assertSuggestion "UseFromMaybe: suggests fromMaybe" [useFromMaybeRule]

714+ (withPrelude "x = maybe 0 identity") "fromMaybe 0"

715+

716+ -- Negative cases

717+ , assertWarningCount "UseFromMaybe: no fire on maybe x f" [useFromMaybeRule]

718+ (withPrelude "x = maybe 0 show") 0

719+ ]

720+

721+-- ============================================================================

722+-- UseIsJust Tests

723+-- ============================================================================

724+

725+useIsJustTests :: Array TestResult

726+useIsJustTests =

727+ [ assertWarningCount "UseIsJust: maybe false (const true)" [useIsJustRule]

728+ (withPrelude "x = maybe false (const true)") 1

729+ , assertRuleId "UseIsJust: correct rule id" [useIsJustRule]

730+ (withPrelude "x = maybe false (const true)") "UseIsJust"

731+ , assertSuggestion "UseIsJust: suggests isJust" [useIsJustRule]

732+ (withPrelude "x = maybe false (const true)") "isJust"

733+

734+ -- Negative cases

735+ , assertWarningCount "UseIsJust: no fire on maybe true (const false)" [useIsJustRule]

736+ (withPrelude "x = maybe true (const false)") 0

737+ ]

738+

739+-- ============================================================================

740+-- UseIsNothing Tests

741+-- ============================================================================

742+

743+useIsNothingTests :: Array TestResult

744+useIsNothingTests =

745+ [ assertWarningCount "UseIsNothing: maybe true (const false)" [useIsNothingRule]

746+ (withPrelude "x = maybe true (const false)") 1

747+ , assertRuleId "UseIsNothing: correct rule id" [useIsNothingRule]

748+ (withPrelude "x = maybe true (const false)") "UseIsNothing"

749+ , assertSuggestion "UseIsNothing: suggests isNothing" [useIsNothingRule]

750+ (withPrelude "x = maybe true (const false)") "isNothing"

751+

752+ -- Negative cases

753+ , assertWarningCount "UseIsNothing: no fire on maybe false (const true)" [useIsNothingRule]

754+ (withPrelude "x = maybe false (const true)") 0

755+ ]

756+

757+-- ============================================================================

758+-- UseWhen Tests

759+-- ============================================================================

760+

761+useWhenTests :: Array TestResult

762+useWhenTests =

763+ [ assertWarningCount "UseWhen: if x then y else pure unit" [useWhenRule]

764+ (withPrelude "x = if true then log \"hi\" else pure unit") 1

765+ , assertRuleId "UseWhen: correct rule id" [useWhenRule]

766+ (withPrelude "x = if true then log \"hi\" else pure unit") "UseWhen"

767+

768+ -- Negative cases

769+ , assertWarningCount "UseWhen: no fire on if x then pure unit else y" [useWhenRule]

770+ (withPrelude "x = if true then pure unit else log \"hi\"") 0

771+ ]

772+

773+-- ============================================================================

774+-- UseUnless Tests

775+-- ============================================================================

776+

777+useUnlessTests :: Array TestResult

778+useUnlessTests =

779+ [ assertWarningCount "UseUnless: if x then pure unit else y" [useUnlessRule]

780+ (withPrelude "x = if true then pure unit else log \"hi\"") 1

781+ , assertRuleId "UseUnless: correct rule id" [useUnlessRule]

782+ (withPrelude "x = if true then pure unit else log \"hi\"") "UseUnless"

783+

784+ -- Negative cases

785+ , assertWarningCount "UseUnless: no fire on if x then y else pure unit" [useUnlessRule]

786+ (withPrelude "x = if true then log \"hi\" else pure unit") 0

787+ ]

788+

789+-- ============================================================================

790+-- RedundantFlip Tests

791+-- ============================================================================

792+

793+redundantFlipTests :: Array TestResult

794+redundantFlipTests =

795+ [ assertWarningCount "RedundantFlip: flip (flip f)" [redundantFlipRule]

796+ (withPrelude "x = flip (flip add)") 1

797+ , assertRuleId "RedundantFlip: correct rule id" [redundantFlipRule]

798+ (withPrelude "x = flip (flip add)") "RedundantFlip"

799+ , assertSuggestion "RedundantFlip: suggests f" [redundantFlipRule]

800+ (withPrelude "x = flip (flip add)") "add"

801+

802+ -- Negative cases

803+ , assertWarningCount "RedundantFlip: no fire on flip f" [redundantFlipRule]

804+ (withPrelude "x = flip add") 0

805+ ]

806+

807+-- ============================================================================

808+-- UseNotElem Tests

809+-- ============================================================================

810+

811+useNotElemTests :: Array TestResult

812+useNotElemTests =

813+ [ assertWarningCount "UseNotElem: not (elem x y)" [useNotElemRule]

814+ (withPrelude "x = not (elem 1 [1,2,3])") 1

815+ , assertRuleId "UseNotElem: correct rule id" [useNotElemRule]

816+ (withPrelude "x = not (elem 1 [1,2,3])") "UseNotElem"

817+ , assertSuggestion "UseNotElem: suggests notElem" [useNotElemRule]

818+ (withPrelude "x = not (elem 1 [1,2,3])") "notElem 1 [1,2,3]"

819+

820+ -- Negative cases

821+ , assertWarningCount "UseNotElem: no fire on not (foo x)" [useNotElemRule]

822+ (withPrelude "x = not (foo 1)") 0

823+ ]

824+

825+-- ============================================================================

826+-- UseMinMax Tests

827+-- ============================================================================

828+

829+useMinMaxTests :: Array TestResult

830+useMinMaxTests =

831+ [ assertWarningCount "UseMinMax: if a > b then a else b" [useMinMaxRule]

832+ (withPrelude "x = if a > b then a else b") 1

833+ , assertRuleId "UseMinMax: correct rule id" [useMinMaxRule]

834+ (withPrelude "x = if a > b then a else b") "UseMinMax"

835+ , assertSuggestion "UseMinMax: suggests max" [useMinMaxRule]

836+ (withPrelude "x = if a > b then a else b") "max a b"

837+ , assertWarningCount "UseMinMax: if a min" [useMinMaxRule]

838+ (withPrelude "x = if a < b then a else b") 1

839+ , assertSuggestion "UseMinMax: suggests min" [useMinMaxRule]

840+ (withPrelude "x = if a < b then a else b") "min a b"

841+

842+ -- Negative cases

843+ , assertWarningCount "UseMinMax: no fire on unrelated if" [useMinMaxRule]

844+ (withPrelude "x = if a > b then c else d") 0

845+ ]

846+

847+-- ============================================================================

848+-- MonoidIdentity Tests

849+-- ============================================================================

850+

851+monoidIdentityTests :: Array TestResult

852+monoidIdentityTests =

853+ [ assertWarningCount "MonoidIdentity: mempty <> x" [monoidIdentityRule]

854+ (withPrelude "x = mempty <> [1,2,3]") 1

855+ , assertRuleId "MonoidIdentity: correct rule id" [monoidIdentityRule]

856+ (withPrelude "x = mempty <> [1,2,3]") "MonoidIdentity"

857+ , assertSuggestion "MonoidIdentity: suggests x" [monoidIdentityRule]

858+ (withPrelude "x = mempty <> [1,2,3]") "[1,2,3]"

859+ , assertWarningCount "MonoidIdentity: x <> mempty" [monoidIdentityRule]

860+ (withPrelude "x = [1,2,3] <> mempty") 1

861+

862+ -- Negative cases

863+ , assertWarningCount "MonoidIdentity: no fire on x <> y" [monoidIdentityRule]

864+ (withPrelude "x = [1] <> [2]") 0

865+ ]

866+

867+-- ============================================================================

868+-- UseFold Tests

869+-- ============================================================================

870+

871+useFoldTests :: Array TestResult

872+useFoldTests =

873+ [ assertWarningCount "UseFold: foldMap identity" [useFoldRule]

874+ (withPrelude "x = foldMap identity") 1

875+ , assertRuleId "UseFold: correct rule id" [useFoldRule]

876+ (withPrelude "x = foldMap identity") "UseFold"

877+ , assertSuggestion "UseFold: suggests fold" [useFoldRule]

878+ (withPrelude "x = foldMap identity") "fold"

879+

880+ -- Negative cases

881+ , assertWarningCount "UseFold: no fire on foldMap f" [useFoldRule]

882+ (withPrelude "x = foldMap show") 0

883+ ]

884+

885+-- ============================================================================

886+-- UseSequence Tests

887+-- ============================================================================

888+

889+useSequenceTests :: Array TestResult

890+useSequenceTests =

891+ [ assertWarningCount "UseSequence: traverse identity" [useSequenceRule]

892+ (withPrelude "x = traverse identity") 1

893+ , assertRuleId "UseSequence: correct rule id" [useSequenceRule]

894+ (withPrelude "x = traverse identity") "UseSequence"

895+ , assertSuggestion "UseSequence: suggests sequence" [useSequenceRule]

896+ (withPrelude "x = traverse identity") "sequence"

897+

898+ -- Negative cases

899+ , assertWarningCount "UseSequence: no fire on traverse f" [useSequenceRule]

900+ (withPrelude "x = traverse show") 0

901+ ]

902+

903+-- ============================================================================

904+-- UseTraverseSequence Tests

905+-- ============================================================================

906+

907+useTraverseSequenceTests :: Array TestResult

908+useTraverseSequenceTests =

909+ [ assertWarningCount "UseTraverseSequence: sequence (map f x)" [useTraverseSequenceRule]

910+ (withPrelude "x = sequence (map show [1,2,3])") 1

911+ , assertRuleId "UseTraverseSequence: correct rule id" [useTraverseSequenceRule]

912+ (withPrelude "x = sequence (map show [1,2,3])") "UseTraverseSequence"

913+ , assertSuggestion "UseTraverseSequence: suggests traverse" [useTraverseSequenceRule]

914+ (withPrelude "x = sequence (map show [1,2,3])") "traverse show [1,2,3]"

915+

916+ -- Negative cases

917+ , assertWarningCount "UseTraverseSequence: no fire on sequence xs" [useTraverseSequenceRule]

918+ (withPrelude "x = sequence [Just 1]") 0

919+ ]

920+

921+-- ============================================================================

922+-- RedundantNot Tests

923+-- ============================================================================

924+

925+redundantNotTests :: Array TestResult

926+redundantNotTests =

927+ [ assertWarningCount "RedundantNot: not (not x)" [redundantNotRule]

928+ (withPrelude "x = not (not true)") 1

929+ , assertRuleId "RedundantNot: correct rule id" [redundantNotRule]

930+ (withPrelude "x = not (not true)") "RedundantNot"

931+ , assertSuggestion "RedundantNot: suggests x" [redundantNotRule]

932+ (withPrelude "x = not (not foo)") "foo"

933+

934+ -- Negative cases

935+ , assertWarningCount "RedundantNot: no fire on not x" [redundantNotRule]

936+ (withPrelude "x = not true") 0

937+ ]

938+

939+-- ============================================================================

940+-- UseFstSnd Tests

941+-- ============================================================================

942+

943+useFstSndTests :: Array TestResult

944+useFstSndTests =

945+ [ assertWarningCount "UseFstSnd: \\(Tuple x y) -> x" [useFstSndRule]

946+ (withPrelude "x = \\(Tuple a b) -> a") 1

947+ , assertRuleId "UseFstSnd: correct rule id" [useFstSndRule]

948+ (withPrelude "x = \\(Tuple a b) -> a") "UseFstSnd"

949+ , assertSuggestion "UseFstSnd: suggests fst" [useFstSndRule]

950+ (withPrelude "x = \\(Tuple a b) -> a") "fst"

951+ , assertWarningCount "UseFstSnd: \\(Tuple x y) -> y" [useFstSndRule]

952+ (withPrelude "x = \\(Tuple a b) -> b") 1

953+ , assertSuggestion "UseFstSnd: suggests snd" [useFstSndRule]

954+ (withPrelude "x = \\(Tuple a b) -> b") "snd"

955+

956+ -- Negative cases

957+ , assertWarningCount "UseFstSnd: no fire when using both" [useFstSndRule]

958+ (withPrelude "x = \\(Tuple a b) -> a + b") 0

959+ ]

960+

961+-- ============================================================================

962+-- UseMapMaybe Tests

963+-- ============================================================================

964+

965+useMapMaybeTests :: Array TestResult

966+useMapMaybeTests =

967+ [ assertWarningCount "UseMapMaybe: catMaybes (map f x)" [useMapMaybeRule]

968+ (withPrelude "x = catMaybes (map f [1,2,3])") 1

969+ , assertRuleId "UseMapMaybe: correct rule id" [useMapMaybeRule]

970+ (withPrelude "x = catMaybes (map f [1,2,3])") "UseMapMaybe"

971+ , assertSuggestion "UseMapMaybe: suggests mapMaybe" [useMapMaybeRule]

972+ (withPrelude "x = catMaybes (map f [1,2,3])") "mapMaybe f [1,2,3]"

973+ ]

974+

975+-- ============================================================================

976+-- UseApplicative Tests

977+-- ============================================================================

978+

979+useApplicativeTests :: Array TestResult

980+useApplicativeTests =

981+ [ assertWarningCount "UseApplicative: pure f <*> x" [useApplicativeRule]

982+ (withPrelude "x = pure f <*> y") 1

983+ , assertRuleId "UseApplicative: correct rule id" [useApplicativeRule]

984+ (withPrelude "x = pure f <*> y") "UseApplicative"

985+ , assertSuggestion "UseApplicative: suggests f <$> x" [useApplicativeRule]

986+ (withPrelude "x = pure f <*> y") "f <$> y"

987+ ]

988+

989+-- ============================================================================

990+-- UseBindFlip Tests

991+-- ============================================================================

992+

993+useBindFlipTests :: Array TestResult

994+useBindFlipTests =

995+ [ assertWarningCount "UseBindFlip: join (map f x)" [useBindFlipRule]

996+ (withPrelude "x = join (map f y)") 1

997+ , assertRuleId "UseBindFlip: correct rule id" [useBindFlipRule]

998+ (withPrelude "x = join (map f y)") "UseBindFlip"

999+ , assertSuggestion "UseBindFlip: suggests x >>= f" [useBindFlipRule]

1000+ (withPrelude "x = join (map f y)") "y >>= f"

1001+ ]

1002+

1003+-- ============================================================================

1004+-- UseFor Tests

1005+-- ============================================================================

1006+

1007+useForTests :: Array TestResult

1008+useForTests =

1009+ [ assertWarningCount "UseFor: flip traverse" [useForRule]

1010+ (withPrelude "x = flip traverse") 1

1011+ , assertRuleId "UseFor: correct rule id" [useForRule]

1012+ (withPrelude "x = flip traverse") "UseFor"

1013+ , assertSuggestion "UseFor: suggests for" [useForRule]

1014+ (withPrelude "x = flip traverse") "for"

1015+ , assertWarningCount "UseFor: flip traverse_" [useForRule]

1016+ (withPrelude "x = flip traverse_") 1

1017+ , assertSuggestion "UseFor: suggests for_" [useForRule]

1018+ (withPrelude "x = flip traverse_") "for_"

1019+ ]

1020+

1021+-- ============================================================================

1022+-- RedundantGuard Tests

1023+-- ============================================================================

1024+

1025+redundantGuardTests :: Array TestResult

1026+redundantGuardTests =

1027+ [ assertWarningCount "RedundantGuard: guard true" [redundantGuardRule]

1028+ (withPrelude "x = guard true") 1

1029+ , assertRuleId "RedundantGuard: correct rule id" [redundantGuardRule]

1030+ (withPrelude "x = guard true") "RedundantGuard"

1031+ , assertSuggestion "RedundantGuard: suggests pure unit" [redundantGuardRule]

1032+ (withPrelude "x = guard true") "pure unit"

1033+ , assertWarningCount "RedundantGuard: guard false" [redundantGuardRule]

1034+ (withPrelude "x = guard false") 1

1035+ ]

1036+

1037+-- ============================================================================

1038+-- UseComparing Tests

1039+-- ============================================================================

1040+

1041+useComparingTests :: Array TestResult

1042+useComparingTests =

1043+ [ assertWarningCount "UseComparing: \\x y -> compare (f x) (f y)" [useComparingRule]

1044+ (withPrelude "x = \\a b -> compare (f a) (f b)") 1

1045+ , assertRuleId "UseComparing: correct rule id" [useComparingRule]

1046+ (withPrelude "x = \\a b -> compare (f a) (f b)") "UseComparing"

1047+ , assertSuggestion "UseComparing: suggests comparing" [useComparingRule]

1048+ (withPrelude "x = \\a b -> compare (f a) (f b)") "comparing f"

1049+ ]

1050+

1051+-- ============================================================================

1052+-- UseOn Tests

1053+-- ============================================================================

1054+

1055+useOnTests :: Array TestResult

1056+useOnTests =

1057+ [ assertWarningCount "UseOn: \\x y -> f (g x) (g y)" [useOnRule]

1058+ (withPrelude "x = \\a b -> f (g a) (g b)") 1

1059+ , assertRuleId "UseOn: correct rule id" [useOnRule]

1060+ (withPrelude "x = \\a b -> f (g a) (g b)") "UseOn"

1061+ , assertSuggestion "UseOn: suggests on f g" [useOnRule]

1062+ (withPrelude "x = \\a b -> f (g a) (g b)") "on f g"

1063+ ]

1064+

1065+-- ============================================================================

1066+-- UseFindMap Tests

1067+-- ============================================================================

1068+

1069+useFindMapTests :: Array TestResult

1070+useFindMapTests =

1071+ [ assertWarningCount "UseFindMap: head (mapMaybe f x)" [useFindMapRule]

1072+ (withPrelude "x = head (mapMaybe f [1,2,3])") 1

1073+ , assertRuleId "UseFindMap: correct rule id" [useFindMapRule]

1074+ (withPrelude "x = head (mapMaybe f [1,2,3])") "UseFindMap"

1075+ , assertSuggestion "UseFindMap: suggests findMap" [useFindMapRule]

1076+ (withPrelude "x = head (mapMaybe f [1,2,3])") "findMap f [1,2,3]"

1077+ ]

1078+

1079+-- ============================================================================

1080+-- UseLastReverse Tests

1081+-- ============================================================================

1082+

1083+useLastReverseTests :: Array TestResult

1084+useLastReverseTests =

1085+ [ assertWarningCount "UseLastReverse: head (reverse x)" [useLastReverseRule]

1086+ (withPrelude "x = head (reverse [1,2,3])") 1

1087+ , assertRuleId "UseLastReverse: correct rule id" [useLastReverseRule]

1088+ (withPrelude "x = head (reverse [1,2,3])") "UseLastReverse"

1089+ , assertSuggestion "UseLastReverse: suggests last" [useLastReverseRule]

1090+ (withPrelude "x = head (reverse [1,2,3])") "last [1,2,3]"

1091+ ]

1092+

1093+-- ============================================================================

1094+-- RedundantReverse Tests

1095+-- ============================================================================

1096+

1097+redundantReverseTests :: Array TestResult

1098+redundantReverseTests =

1099+ [ assertWarningCount "RedundantReverse: reverse (reverse x)" [redundantReverseRule]

1100+ (withPrelude "x = reverse (reverse [1,2,3])") 1

1101+ , assertRuleId "RedundantReverse: correct rule id" [redundantReverseRule]

1102+ (withPrelude "x = reverse (reverse [1,2,3])") "RedundantReverse"

1103+ , assertSuggestion "RedundantReverse: suggests x" [redundantReverseRule]

1104+ (withPrelude "x = reverse (reverse foo)") "foo"

1105+ ]

1106+

1107+-- ============================================================================

1108+-- UseMinimumSort Tests

1109+-- ============================================================================

1110+

1111+useMinimumSortTests :: Array TestResult

1112+useMinimumSortTests =

1113+ [ assertWarningCount "UseMinimumSort: head (sort x)" [useMinimumSortRule]

1114+ (withPrelude "x = head (sort [1,2,3])") 1

1115+ , assertRuleId "UseMinimumSort: correct rule id" [useMinimumSortRule]

1116+ (withPrelude "x = head (sort [1,2,3])") "UseMinimumSort"

1117+ , assertSuggestion "UseMinimumSort: suggests minimum" [useMinimumSortRule]

1118+ (withPrelude "x = head (sort [1,2,3])") "minimum [1,2,3]"

1119+ ]

1120+

1121+-- ============================================================================

1122+-- UseBimap Tests

1123+-- ============================================================================

1124+

1125+useBimapTests :: Array TestResult

1126+useBimapTests =

1127+ [ assertWarningCount "UseBimap: bimap id g" [useBimapRule]

1128+ (withPrelude "x = bimap identity show") 1

1129+ , assertRuleId "UseBimap: correct rule id" [useBimapRule]

1130+ (withPrelude "x = bimap identity show") "UseBimap"

1131+ , assertSuggestion "UseBimap: suggests second" [useBimapRule]

1132+ (withPrelude "x = bimap identity show") "second show"

1133+ ]

1134+

1135+-- ============================================================================

1136+-- EvaluateFst Tests

1137+-- ============================================================================

1138+

1139+evaluateFstTests :: Array TestResult

1140+evaluateFstTests =

1141+ [ assertWarningCount "EvaluateFst: fst (Tuple x y)" [evaluateFstRule]

1142+ (withPrelude "x = fst (Tuple 1 2)") 1

1143+ , assertRuleId "EvaluateFst: correct rule id" [evaluateFstRule]

1144+ (withPrelude "x = fst (Tuple 1 2)") "EvaluateFst"

1145+ , assertSuggestion "EvaluateFst: suggests x" [evaluateFstRule]

1146+ (withPrelude "x = fst (Tuple 1 2)") "1"

1147+ , assertWarningCount "EvaluateFst: snd (Tuple x y)" [evaluateFstRule]

1148+ (withPrelude "x = snd (Tuple 1 2)") 1

1149+ , assertSuggestion "EvaluateFst: suggests y" [evaluateFstRule]

1150+ (withPrelude "x = snd (Tuple 1 2)") "2"

1151+ ]

1152+

1153+-- ============================================================================

1154+-- EvaluateConst Tests

1155+-- ============================================================================

1156+

1157+evaluateConstTests :: Array TestResult

1158+evaluateConstTests =

1159+ [ assertWarningCount "EvaluateConst: const x y" [evaluateConstRule]

1160+ (withPrelude "x = const 42 foo") 1

1161+ , assertRuleId "EvaluateConst: correct rule id" [evaluateConstRule]

1162+ (withPrelude "x = const 42 foo") "EvaluateConst"

1163+ , assertSuggestion "EvaluateConst: suggests x" [evaluateConstRule]

1164+ (withPrelude "x = const 42 foo") "42"

1165+ ]

1166+

1167+-- ============================================================================

1168+-- UseOr Tests

1169+-- ============================================================================

1170+

1171+useOrTests :: Array TestResult

1172+useOrTests =

1173+ [ assertWarningCount "UseOr: any identity" [useOrRule]

1174+ (withPrelude "x = any identity [true, false]") 1

1175+ , assertRuleId "UseOr: correct rule id" [useOrRule]

1176+ (withPrelude "x = any identity [true, false]") "UseOr"

1177+ , assertSuggestion "UseOr: suggests or" [useOrRule]

1178+ (withPrelude "x = any identity [true, false]") "or [true, false]"

1179+ ]

1180+

1181+-- ============================================================================

1182+-- UseAnd Tests

1183+-- ============================================================================

1184+

1185+useAndTests :: Array TestResult

1186+useAndTests =

1187+ [ assertWarningCount "UseAnd: all identity" [useAndRule]

1188+ (withPrelude "x = all identity [true, false]") 1

1189+ , assertRuleId "UseAnd: correct rule id" [useAndRule]

1190+ (withPrelude "x = all identity [true, false]") "UseAnd"

1191+ , assertSuggestion "UseAnd: suggests and" [useAndRule]

1192+ (withPrelude "x = all identity [true, false]") "and [true, false]"

1193+ ]

1194+

1195+-- ============================================================================

1196+-- UseFoldMapId Tests

1197+-- ============================================================================

1198+

1199+useFoldMapIdTests :: Array TestResult

1200+useFoldMapIdTests =

1201+ [ assertWarningCount "UseFoldMapId: foldMap identity" [useFoldMapIdRule]

1202+ (withPrelude "x = foldMap identity") 1

1203+ , assertRuleId "UseFoldMapId: correct rule id" [useFoldMapIdRule]

1204+ (withPrelude "x = foldMap identity") "UseFoldMapId"

1205+ , assertSuggestion "UseFoldMapId: suggests fold" [useFoldMapIdRule]

1206+ (withPrelude "x = foldMap identity") "fold"

1207+ ]

1208+

1209+-- ============================================================================

1210+-- WhenNot Tests

1211+-- ============================================================================

1212+

1213+whenNotTests :: Array TestResult

1214+whenNotTests =

1215+ [ assertWarningCount "WhenNot: when (not x)" [whenNotRule]

1216+ (withPrelude "x = when (not cond) action") 1

1217+ , assertRuleId "WhenNot: correct rule id" [whenNotRule]

1218+ (withPrelude "x = when (not cond) action") "WhenNot"

1219+ , assertSuggestion "WhenNot: suggests unless" [whenNotRule]

1220+ (withPrelude "x = when (not cond) action") "unless cond action"

1221+ ]

1222+

1223+-- ============================================================================

1224+-- UnlessNot Tests

1225+-- ============================================================================

1226+

1227+unlessNotTests :: Array TestResult

1228+unlessNotTests =

1229+ [ assertWarningCount "UnlessNot: unless (not x)" [unlessNotRule]

1230+ (withPrelude "x = unless (not cond) action") 1

1231+ , assertRuleId "UnlessNot: correct rule id" [unlessNotRule]

1232+ (withPrelude "x = unless (not cond) action") "UnlessNot"

1233+ , assertSuggestion "UnlessNot: suggests when" [unlessNotRule]

1234+ (withPrelude "x = unless (not cond) action") "when cond action"

1235+ ]

1236+

1237+-- ============================================================================

1238+-- UseZip Tests

1239+-- ============================================================================

1240+

1241+useZipTests :: Array TestResult

1242+useZipTests =

1243+ [ assertWarningCount "UseZip: zipWith Tuple" [useZipRule]

1244+ (withPrelude "x = zipWith Tuple [1] [2]") 1

1245+ , assertRuleId "UseZip: correct rule id" [useZipRule]

1246+ (withPrelude "x = zipWith Tuple [1] [2]") "UseZip"

1247+ , assertSuggestion "UseZip: suggests zip" [useZipRule]

1248+ (withPrelude "x = zipWith Tuple [1] [2]") "zip [1] [2]"

1249+ ]

1250+

1251+-- ============================================================================

1252+-- RedundantNegate Tests

1253+-- ============================================================================

1254+

1255+redundantNegateTests :: Array TestResult

1256+redundantNegateTests =

1257+ [ assertWarningCount "RedundantNegate: negate (negate x)" [redundantNegateRule]

1258+ (withPrelude "x = negate (negate 5)") 1

1259+ , assertRuleId "RedundantNegate: correct rule id" [redundantNegateRule]

1260+ (withPrelude "x = negate (negate 5)") "RedundantNegate"

1261+ , assertSuggestion "RedundantNegate: suggests x" [redundantNegateRule]

1262+ (withPrelude "x = negate (negate foo)") "foo"

1263+ ]

1264+

1265+-- ============================================================================

1266+-- RedundantId Tests

1267+-- ============================================================================

1268+

1269+redundantIdTests :: Array TestResult

1270+redundantIdTests =

1271+ [ assertWarningCount "RedundantId: identity x" [redundantIdRule]

1272+ (withPrelude "x = identity 42") 1

1273+ , assertRuleId "RedundantId: correct rule id" [redundantIdRule]

1274+ (withPrelude "x = identity 42") "RedundantId"

1275+ , assertSuggestion "RedundantId: suggests x" [redundantIdRule]

1276+ (withPrelude "x = identity foo") "foo"

1277+ ]

1278+

1279+-- ============================================================================

1280+-- NothingBind Tests

1281+-- ============================================================================

1282+

1283+nothingBindTests :: Array TestResult

1284+nothingBindTests =

1285+ [ assertWarningCount "NothingBind: Nothing >>= f" [nothingBindRule]

1286+ (withPrelude "x = Nothing >>= show") 1

1287+ , assertRuleId "NothingBind: correct rule id" [nothingBindRule]

1288+ (withPrelude "x = Nothing >>= show") "NothingBind"

1289+ , assertSuggestion "NothingBind: suggests Nothing" [nothingBindRule]

1290+ (withPrelude "x = Nothing >>= show") "Nothing"

1291+ ]

1292+

1293+-- ============================================================================

1294+-- Golden Tests: LintExamples.purs

1295+-- ============================================================================

1296+

1297+-- | All rules for golden testing

1298+allRulesForGolden :: Array Rule

1299+allRulesForGolden =

1300+ [ fmapIdRule

1301+ , mapFusionRule

1302+ , useTraverseRule

1303+ , concatMapRule

1304+ , notEqualRule

1305+ , useGuardRule

1306+ , etaReduceRule

1307+ , etaReduceDeclRule

1308+ , redundantBindRule

1309+ , letToWhereRule

1310+ , redundantIfRule

1311+ , functorLawRule

1312+ , useVoidRule

1313+ , useJoinRule

1314+ , useAnyRule

1315+ , useAllRule

1316+ , booleanSimplifyRule

1317+ , collapseLambdasRule

1318+ , useConstRule

1319+ , useNullRule

1320+ , useFromMaybeRule

1321+ , useIsJustRule

1322+ , useIsNothingRule

1323+ , useWhenRule

1324+ , useUnlessRule

1325+ , redundantFlipRule

1326+ , useNotElemRule

1327+ , useMinMaxRule

1328+ , monoidIdentityRule

1329+ , useFoldRule

1330+ , useSequenceRule

1331+ , useTraverseSequenceRule

1332+ , redundantNotRule

1333+ , useFstSndRule

1334+ , useMapMaybeRule

1335+ , useGuardMaybeRule

1336+ , useMaybeMapRule

1337+ , useApplicativeRule

1338+ , useBindFlipRule

1339+ , useForRule

1340+ , redundantGuardRule

1341+ , useComparingRule

1342+ , useOnRule

1343+ , useFindMapRule

1344+ ]

1345+

1346+-- | Assert that a specific rule fires at least once when running all rules

1347+assertRuleFires :: String -> String -> String -> TestResult

1348+assertRuleFires name source ruleId =

1349+ case runRules allRulesForGolden (SourceCode source) of

1350+ Left err -> runTest name false ("Parse error: " <> err)

1351+ Right (LintResult result) ->

1352+ let matches = Array.filter (\(LintWarning w) -> unwrap w.ruleId == ruleId) result.warnings

1353+ in if Array.length matches > 0

1354+ then runTest name true "OK"

1355+ else runTest name false ("Rule " <> ruleId <> " did not fire")

1356+

1357+-- | The embedded LintExamples source

1358+lintExamplesSource :: String

1359+lintExamplesSource = """module Test.LintExamples where

1360+

1361+import Prelude

1362+

1363+import Control.Alternative

1364+import Control.Monad

1365+import Data.Array

1366+import Data.Foldable

1367+import Data.Maybe

1368+import Data.Monoid

1369+import Data.Ord

1370+import Data.Traversable

1371+import Data.Tuple

1372+

1373+-- FmapId

1374+fmapId1 = map identity [ 1, 2, 3 ]

1375+

1376+-- MapFusion

1377+mapFusion1 = map show (map (_ + 1) [ 1, 2, 3 ])

1378+

1379+-- UseTraverse

1380+useTraverse1 f xs = sequence (map f xs)

1381+

1382+-- ConcatMap

1383+concatMap1 f xs = join (map f xs)

1384+

1385+-- NotEqual

1386+notEqual1 x y = not (x == y)

1387+

1388+-- UseGuard

1389+useGuard1 cond action = if cond then action else pure unit

1390+

1391+-- EtaReduce

1392+etaReduce1 = \x -> show x

1393+

1394+-- EtaReduceDecl

1395+etaReduceDecl1 x = show x

1396+

1397+-- RedundantBind

1398+redundantBind1 x f = pure x >>= f

1399+

1400+-- LetToWhere

1401+letToWhere1 y z = let x = y in z

1402+

1403+-- RedundantIf

1404+redundantIf1 a = if a then true else false

1405+

1406+-- UseVoid

1407+useVoid1 a = a *> pure unit

1408+

1409+-- UseJoin

1410+useJoin1 x = x >>= identity

1411+

1412+-- UseAny

1413+useAny1 f xs = or (map f xs)

1414+

1415+-- UseAll

1416+useAll1 f xs = and (map f xs)

1417+

1418+-- BooleanSimplify

1419+booleanSimplify1 x = x == true

1420+

1421+-- CollapseLambdas

1422+collapseLambdas1 = \x -> \y -> x + y

1423+

1424+-- UseConst

1425+useConst1 = \x -> 42

1426+

1427+-- UseNull

1428+useNull1 xs = length xs == 0

1429+

1430+-- UseFromMaybe

1431+useFromMaybe1 def = maybe def identity

1432+

1433+-- UseIsJust

1434+useIsJust1 = maybe false (const true)

1435+

1436+-- UseIsNothing

1437+useIsNothing1 = maybe true (const false)

1438+

1439+-- UseWhen

1440+useWhen1 cond action = if cond then action else pure unit

1441+

1442+-- UseUnless

1443+useUnless1 cond action = if cond then pure unit else action

1444+

1445+-- RedundantFlip

1446+redundantFlip1 f = flip (flip f)

1447+

1448+-- UseNotElem

1449+useNotElem1 x xs = not (elem x xs)

1450+

1451+-- UseMinMax

1452+useMax1 a b = if a > b then a else b

1453+

1454+-- MonoidIdentity

1455+monoidIdentity1 x = mempty <> x

1456+

1457+-- UseFold

1458+useFold1 = foldMap identity

1459+

1460+-- UseSequence

1461+useSequence1 = traverse identity

1462+

1463+-- UseTraverseSequence

1464+useTraverseSequence1 f xs = sequence (map f xs)

1465+

1466+-- RedundantNot

1467+redundantNot1 x = not (not x)

1468+

1469+-- UseFstSnd

1470+useFst1 = \(Tuple x y) -> x

1471+

1472+-- UseMapMaybe

1473+useMapMaybe1 = catMaybes (map f [1,2,3])

1474+

1475+-- UseApplicative

1476+useApplicative1 = pure f <*> x

1477+

1478+-- UseBindFlip

1479+useBindFlip1 = join (map f x)

1480+

1481+-- UseFor

1482+useFor1 = flip traverse

1483+

1484+-- RedundantGuard

1485+redundantGuard1 = guard true

1486+

1487+-- UseComparing

1488+useComparing1 = \a b -> compare (f a) (f b)

1489+

1490+-- UseOn

1491+useOn1 = \a b -> f (g a) (g b)

1492+

1493+-- UseFindMap

1494+useFindMap1 = head (mapMaybe f [1,2,3])

1495+"""

1496+

1497+goldenTests :: Array TestResult

1498+goldenTests =

1499+ [ assertRuleFires "Golden: FmapId fires" lintExamplesSource "FmapId"

1500+ , assertRuleFires "Golden: MapFusion fires" lintExamplesSource "MapFusion"

1501+ , assertRuleFires "Golden: UseTraverse fires" lintExamplesSource "UseTraverse"

1502+ , assertRuleFires "Golden: ConcatMap fires" lintExamplesSource "ConcatMap"

1503+ , assertRuleFires "Golden: NotEqual fires" lintExamplesSource "NotEqual"

1504+ , assertRuleFires "Golden: UseGuard fires" lintExamplesSource "UseGuard"

1505+ , assertRuleFires "Golden: EtaReduce fires" lintExamplesSource "EtaReduce"

1506+ , assertRuleFires "Golden: EtaReduceDecl fires" lintExamplesSource "EtaReduceDecl"

1507+ , assertRuleFires "Golden: RedundantBind fires" lintExamplesSource "RedundantBind"

1508+ , assertRuleFires "Golden: LetToWhere fires" lintExamplesSource "LetToWhere"

1509+ , assertRuleFires "Golden: RedundantIf fires" lintExamplesSource "RedundantIf"

1510+ , assertRuleFires "Golden: UseVoid fires" lintExamplesSource "UseVoid"

1511+ , assertRuleFires "Golden: UseJoin fires" lintExamplesSource "UseJoin"

1512+ , assertRuleFires "Golden: UseAny fires" lintExamplesSource "UseAny"

1513+ , assertRuleFires "Golden: UseAll fires" lintExamplesSource "UseAll"

1514+ , assertRuleFires "Golden: BooleanSimplify fires" lintExamplesSource "BooleanSimplify"

1515+ , assertRuleFires "Golden: CollapseLambdas fires" lintExamplesSource "CollapseLambdas"

1516+ , assertRuleFires "Golden: UseConst fires" lintExamplesSource "UseConst"

1517+ , assertRuleFires "Golden: UseNull fires" lintExamplesSource "UseNull"

1518+ , assertRuleFires "Golden: UseFromMaybe fires" lintExamplesSource "UseFromMaybe"

1519+ , assertRuleFires "Golden: UseIsJust fires" lintExamplesSource "UseIsJust"

1520+ , assertRuleFires "Golden: UseIsNothing fires" lintExamplesSource "UseIsNothing"

1521+ , assertRuleFires "Golden: UseWhen fires" lintExamplesSource "UseWhen"

1522+ , assertRuleFires "Golden: UseUnless fires" lintExamplesSource "UseUnless"

1523+ , assertRuleFires "Golden: RedundantFlip fires" lintExamplesSource "RedundantFlip"

1524+ , assertRuleFires "Golden: UseNotElem fires" lintExamplesSource "UseNotElem"

1525+ , assertRuleFires "Golden: UseMinMax fires" lintExamplesSource "UseMinMax"

1526+ , assertRuleFires "Golden: MonoidIdentity fires" lintExamplesSource "MonoidIdentity"

1527+ , assertRuleFires "Golden: UseFold fires" lintExamplesSource "UseFold"

1528+ , assertRuleFires "Golden: UseSequence fires" lintExamplesSource "UseSequence"

1529+ , assertRuleFires "Golden: UseTraverseSequence fires" lintExamplesSource "UseTraverseSequence"

1530+ , assertRuleFires "Golden: RedundantNot fires" lintExamplesSource "RedundantNot"

1531+ , assertRuleFires "Golden: UseFstSnd fires" lintExamplesSource "UseFstSnd"

1532+ , assertRuleFires "Golden: UseMapMaybe fires" lintExamplesSource "UseMapMaybe"

1533+ , assertRuleFires "Golden: UseApplicative fires" lintExamplesSource "UseApplicative"

1534+ , assertRuleFires "Golden: UseBindFlip fires" lintExamplesSource "UseBindFlip"

1535+ , assertRuleFires "Golden: UseFor fires" lintExamplesSource "UseFor"

1536+ , assertRuleFires "Golden: RedundantGuard fires" lintExamplesSource "RedundantGuard"

1537+ , assertRuleFires "Golden: UseComparing fires" lintExamplesSource "UseComparing"

1538+ , assertRuleFires "Golden: UseOn fires" lintExamplesSource "UseOn"

1539+ , assertRuleFires "Golden: UseFindMap fires" lintExamplesSource "UseFindMap"

1540+ ]

1541+

1542+-- ============================================================================

1543+-- Purs-Tidy Formatting Tests

1544+-- ============================================================================

1545+

1546+-- | Test that a suggestion is already purs-tidy formatted

1547+assertTidyFormatted :: String -> String -> Effect TestResult

1548+assertTidyFormatted name suggestion = do

1549+ formatted <- formatExpr suggestion

1550+ pure $ if formatted == suggestion

1551+ then runTest name true "OK"

1552+ else runTest name false ("Not tidy-formatted. Got: '" <> formatted <> "' Expected: '" <> suggestion <> "'")

1553+

1554+-- | Suggestions that should be purs-tidy formatted

1555+tidySuggestions :: Array { name :: String, suggestion :: String }

1556+tidySuggestions =

1557+ [ { name: "void foo", suggestion: "void foo" }

1558+ , { name: "join foo", suggestion: "join foo" }

1559+ , { name: "any f xs", suggestion: "any f xs" }

1560+ , { name: "all f xs", suggestion: "all f xs" }

1561+ , { name: "const 42", suggestion: "const 42" }

1562+ , { name: "notElem x xs", suggestion: "notElem x xs" }

1563+ , { name: "max a b", suggestion: "max a b" }

1564+ , { name: "min a b", suggestion: "min a b" }

1565+ , { name: "null xs", suggestion: "null xs" }

1566+ , { name: "fromMaybe x", suggestion: "fromMaybe x" }

1567+ , { name: "isJust", suggestion: "isJust" }

1568+ , { name: "isNothing", suggestion: "isNothing" }

1569+ , { name: "when cond action", suggestion: "when cond action" }

1570+ , { name: "unless cond action", suggestion: "unless cond action" }

1571+ , { name: "fst", suggestion: "fst" }

1572+ , { name: "snd", suggestion: "snd" }

1573+ , { name: "fold", suggestion: "fold" }

1574+ , { name: "sequence", suggestion: "sequence" }

1575+ , { name: "traverse f xs", suggestion: "traverse f xs" }

1576+ , { name: "collapsed lambda", suggestion: "\\a b -> a + b" }

1577+ , { name: "map fusion", suggestion: "map (f <<< g) x" }

1578+ , { name: "fmap fusion", suggestion: "(f <<< g) <$> x" }

1579+ , { name: "flipped map fusion", suggestion: "x <#> (g >>> f)" }

1580+ , { name: "where clause", suggestion: "y + 1\n where\n y = 1" }

1581+ ]

1582+

1583+-- | Run all tidy formatting tests

1584+runTidyTests :: Effect (Array TestResult)

1585+runTidyTests = traverse (\t -> assertTidyFormatted ("Tidy: " <> t.name) t.suggestion) tidySuggestions