d246efa · rowtype-yoga/purslint

git.iko.soy/rowtype-yoga/purslint

Add Refactor severity, new rules, and improvements

- Add Refactor severity for code actions without diagnostics - Rename FmapId to MapIdentity (PureScript uses map, not fmap) - Add LetToDo rule: convert let...in to do notation - Add UsePatternGuards rule: flatten nested case expressions - Add UseCaseOf rule: convert multi-clause functions to case _ of - Add UseApplyFlipped rule (Refactor): f a b -> b # f a - Make LetToWhere use Refactor severity - Fix UsePatternGuards to preserve do-let body structure - Fix LetToDo to place 'do' at end of previous line - Add document storage in LSP for refactor code actions - Add golden tests for pattern guards and let-to-do - Update tests for MapIdentity rename 💘 Generated with Crush Assisted-by: Claude Opus 4.5 via Crush <crush@charm.land>

commitd246efaeaf6717c8437241f8818908f085af495a authorMark <mark.eibes@gmail.com> dateMon 26 Jan 2026, 09:33 (8 months ago) parent70655d5

63 files changed+3403−961

compare with main

unifiedsplit

.gitignore+1

@@ -15,3 +15,4 @@ package-lock.json

1515

1616# Zed extension build

1717zed-extension/target/

18+test-lsp/

bin/purelint-cli/src/Main.purs+25−4

@@ -20,12 +20,17 @@ import Purelint.Rules.CollapseLambdas (collapseLambdasRule)

2020import Purelint.Rules.ConcatMap (concatMapRule)

2121import Purelint.Rules.EtaReduce (etaReduceRule)

2222import Purelint.Rules.EtaReduceDecl (etaReduceDeclRule)

23+import Purelint.Rules.AlternativeLaw (alternativeLawRule)

24+import Purelint.Rules.EvaluateBool (evaluateBoolRule)

2325import Purelint.Rules.EvaluateConst (evaluateConstRule)

26+import Purelint.Rules.EvaluateEither (evaluateEitherRule)

2427import Purelint.Rules.EvaluateFst (evaluateFstRule)

25−import Purelint.Rules.FmapId (fmapIdRule)

28+import Purelint.Rules.MapIdentity (mapIdentityRule)

2629import Purelint.Rules.FunctorLaw (functorLawRule)

30+import Purelint.Rules.LetToDo (letToDoRule)

2731import Purelint.Rules.LetToWhere (letToWhereRule)

2832import Purelint.Rules.MapFusion (mapFusionRule)

33+import Purelint.Rules.MonadLaw (monadLawRule)

2934import Purelint.Rules.MonoidIdentity (monoidIdentityRule)

3035import Purelint.Rules.NotEqual (notEqualRule)

3136import Purelint.Rules.NothingBind (nothingBindRule)

@@ -42,6 +47,7 @@ import Purelint.Rules.UseAll (useAllRule)

4247import Purelint.Rules.UseAnd (useAndRule)

4348import Purelint.Rules.UseAny (useAnyRule)

4449import Purelint.Rules.UseApplicative (useApplicativeRule)

50+import Purelint.Rules.UseApplyFlipped (useApplyFlippedRule)

4551import Purelint.Rules.UseBimap (useBimapRule)

4652import Purelint.Rules.UseBindFlip (useBindFlipRule)

4753import Purelint.Rules.UseBreak (useBreakRule)

@@ -51,6 +57,8 @@ import Purelint.Rules.UseEitherMap (useEitherMapRule)

5157import Purelint.Rules.UseElemIndex (useElemIndexRule)

5258import Purelint.Rules.UseFindMap (useFindMapRule)

5359import Purelint.Rules.UseFold (useFoldRule)

60+import Purelint.Rules.UseFoldBool (useFoldBoolRule)

61+import Purelint.Rules.UseFoldMap (useFoldMapRule)

5462import Purelint.Rules.UseFoldMapId (useFoldMapIdRule)

5563import Purelint.Rules.UseFor (useForRule)

5664import Purelint.Rules.UseFromJust (useFromJustRule)

@@ -71,6 +79,7 @@ import Purelint.Rules.UseNotElem (useNotElemRule)

7179import Purelint.Rules.UseNull (useNullRule)

7280import Purelint.Rules.UseOn (useOnRule)

7381import Purelint.Rules.UseOr (useOrRule)

82+import Purelint.Rules.UsePatternGuards (usePatternGuardsRule)

7483import Purelint.Rules.UseReplicate (useReplicateRule)

7584import Purelint.Rules.UseSequence (useSequenceRule)

7685import Purelint.Rules.UseSpan (useSpanRule)

@@ -78,6 +87,7 @@ import Purelint.Rules.UseTraverse (useTraverseRule)

7887import Purelint.Rules.UseTraverseSequence (useTraverseSequenceRule)

7988import Purelint.Rules.UseUncurry (useUncurryRule)

8089import Purelint.Rules.UseUnless (useUnlessRule)

90+import Purelint.Rules.UseUnwrap (useUnwrapRule)

8191import Purelint.Rules.UseVoid (useVoidRule)

8292import Purelint.Rules.UseWhen (useWhenRule)

8393import Purelint.Rules.UseZip (useZipRule)

@@ -85,20 +95,25 @@ import Purelint.Rules.WhenNot (whenNotRule)

8595import Purelint.Runner (runRules)

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

8797

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

98+-- | All available rules (76 total)

8999allRules :: Array Rule

90100allRules =

91− [ booleanSimplifyRule

101+ [ alternativeLawRule

102+ , booleanSimplifyRule

92103 , collapseLambdasRule

93104 , concatMapRule

94105 , etaReduceRule

95106 , etaReduceDeclRule

107+ , evaluateBoolRule

96108 , evaluateConstRule

109+ , evaluateEitherRule

97110 , evaluateFstRule

98− , fmapIdRule

111+ , mapIdentityRule

99112 , functorLawRule

113+ , letToDoRule

100114 , letToWhereRule

101115 , mapFusionRule

116+ , monadLawRule

102117 , monoidIdentityRule

103118 , notEqualRule

104119 , nothingBindRule

@@ -115,6 +130,7 @@ allRules =

115130 , useAndRule

116131 , useAnyRule

117132 , useApplicativeRule

133+ , useApplyFlippedRule

118134 , useBimapRule

119135 , useBindFlipRule

120136 , useBreakRule

@@ -124,6 +140,8 @@ allRules =

124140 , useElemIndexRule

125141 , useFindMapRule

126142 , useFoldRule

143+ , useFoldBoolRule

144+ , useFoldMapRule

127145 , useFoldMapIdRule

128146 , useForRule

129147 , useFromJustRule

@@ -144,6 +162,7 @@ allRules =

144162 , useNullRule

145163 , useOnRule

146164 , useOrRule

165+ , usePatternGuardsRule

147166 , useReplicateRule

148167 , useSequenceRule

149168 , useSpanRule

@@ -151,6 +170,7 @@ allRules =

151170 , useTraverseSequenceRule

152171 , useUncurryRule

153172 , useUnlessRule

173+ , useUnwrapRule

154174 , useVoidRule

155175 , useWhenRule

156176 , useZipRule

@@ -173,6 +193,7 @@ formatRange r = show (r.start.line + 1) <> ":" <> show (r.start.column + 1) <> "

173193

174194-- | Format severity for display

175195formatSeverity :: Severity -> String

196+formatSeverity Refactor = "[refactor]"

176197formatSeverity Hint = "[hint]"

177198formatSeverity Warning = "[warning]"

178199formatSeverity Error = "[error]"

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

@@ -4,6 +4,8 @@ import Prelude

55import Data.Array as Array

66import Data.Either (Either(..))

7+import Data.Map (Map)

8+import Data.Map as Map

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

810import Data.Newtype (unwrap)

911import Effect (Effect)

@@ -18,10 +20,12 @@ import Purelint.Rules.CollapseLambdas (collapseLambdasRule)

1820import Purelint.Rules.ConcatMap (concatMapRule)

1921import Purelint.Rules.EtaReduce (etaReduceRule)

2022import Purelint.Rules.EtaReduceDecl (etaReduceDeclRule)

21−import Purelint.Rules.FmapId (fmapIdRule)

23+import Purelint.Rules.MapIdentity (mapIdentityRule)

2224import Purelint.Rules.FunctorLaw (functorLawRule)

25+import Purelint.Rules.LetToDo (letToDoRule)

2326import Purelint.Rules.LetToWhere (letToWhereRule)

2427import Purelint.Rules.MapFusion (mapFusionRule)

28+import Purelint.Rules.MonadLaw (monadLawRule)

2529import Purelint.Rules.MonoidIdentity (monoidIdentityRule)

2630import Purelint.Rules.NotEqual (notEqualRule)

2731import Purelint.Rules.RedundantBind (redundantBindRule)

@@ -45,12 +49,14 @@ import Purelint.Rules.UseSequence (useSequenceRule)

4549import Purelint.Rules.UseTraverse (useTraverseRule)

4650import Purelint.Rules.UseTraverseSequence (useTraverseSequenceRule)

4751import Purelint.Rules.UseUnless (useUnlessRule)

52+import Purelint.Rules.UseUnwrap (useUnwrapRule)

4853import Purelint.Rules.UseVoid (useVoidRule)

4954import Purelint.Rules.UseWhen (useWhenRule)

5055import Purelint.Rules.UseMapMaybe (useMapMaybeRule)

5156import Purelint.Rules.UseGuardMaybe (useGuardMaybeRule)

5257import Purelint.Rules.UseMaybeMap (useMaybeMapRule)

5358import Purelint.Rules.UseApplicative (useApplicativeRule)

59+import Purelint.Rules.UseApplyFlipped (useApplyFlippedRule)

5460import Purelint.Rules.UseBindFlip (useBindFlipRule)

5561import Purelint.Rules.UseFor (useForRule)

5662import Purelint.Rules.RedundantGuard (redundantGuardRule)

@@ -64,10 +70,14 @@ import Purelint.Rules.UseSpan (useSpanRule)

6470import Purelint.Rules.UseMinimumSort (useMinimumSortRule)

6571import Purelint.Rules.UseBimap (useBimapRule)

6672import Purelint.Rules.UseEitherMap (useEitherMapRule)

67−import Purelint.Rules.EvaluateFst (evaluateFstRule)

73+import Purelint.Rules.AlternativeLaw (alternativeLawRule)

74+import Purelint.Rules.EvaluateBool (evaluateBoolRule)

6875import Purelint.Rules.EvaluateConst (evaluateConstRule)

76+import Purelint.Rules.EvaluateEither (evaluateEitherRule)

77+import Purelint.Rules.EvaluateFst (evaluateFstRule)

6978import Purelint.Rules.UseOr (useOrRule)

7079import Purelint.Rules.UseAnd (useAndRule)

80+import Purelint.Rules.UseFoldMap (useFoldMapRule)

7181import Purelint.Rules.UseFoldMapId (useFoldMapIdRule)

7282import Purelint.Rules.WhenNot (whenNotRule)

7383import Purelint.Rules.UnlessNot (unlessNotRule)

@@ -80,6 +90,8 @@ import Purelint.Rules.UseHead (useHeadRule)

8090import Purelint.Rules.RedundantId (redundantIdRule)

8191import Purelint.Rules.NothingBind (nothingBindRule)

8292import Purelint.Rules.UseElemIndex (useElemIndexRule)

93+import Purelint.Rules.UseFoldBool (useFoldBoolRule)

94+import Purelint.Rules.UsePatternGuards (usePatternGuardsRule)

8395import Purelint.Runner (runRules)

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

8597import Unsafe.Coerce (unsafeCoerce)

@@ -89,16 +101,18 @@ allRules :: Array Rule

89101allRules =

90102 [ useTraverseRule

91103 , mapFusionRule

92− , fmapIdRule

104+ , mapIdentityRule

93105 , notEqualRule

94106 , concatMapRule

95107 , useGuardRule

96108 , etaReduceRule

97109 , etaReduceDeclRule

98110 , redundantBindRule

111+ , letToDoRule

99112 , letToWhereRule

100113 , redundantIfRule

101114 , functorLawRule

115+ , useUnwrapRule

102116 , useVoidRule

103117 , useJoinRule

104118 , useAnyRule

@@ -125,6 +139,7 @@ allRules =

125139 , useGuardMaybeRule

126140 , useMaybeMapRule

127141 , useApplicativeRule

142+ , useApplyFlippedRule

128143 , useBindFlipRule

129144 , useForRule

130145 , redundantGuardRule

@@ -140,10 +155,16 @@ allRules =

140155 , useBimapRule

141156 , useEitherMapRule

142157 , evaluateFstRule

158+ , evaluateBoolRule

159+ , evaluateEitherRule

143160 , evaluateConstRule

144161 , useOrRule

145162 , useAndRule

163+ , useFoldMapRule

146164 , useFoldMapIdRule

165+ , useFoldBoolRule

166+ , monadLawRule

167+ , alternativeLawRule

147168 , whenNotRule

148169 , unlessNotRule

149170 , useZipRule

@@ -155,12 +176,19 @@ allRules =

155176 , redundantIdRule

156177 , nothingBindRule

157178 , useElemIndexRule

179+ , usePatternGuardsRule

158180 ]

159181

160182-- | Get enabled rules based on config

161183getEnabledRules :: Config -> Array Rule

162184getEnabledRules config = filterRules allRules config

163185

186+-- | LSP server state

187+type LSPState =

188+ { config :: Config

189+ , documents :: Map String String -- URI -> content

190+ }

191+

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

165193warningToDiagnostic :: LintWarning -> Foreign

166194warningToDiagnostic (LintWarning w) =

@@ -194,14 +222,18 @@ severityToLSP :: Severity -> Int

194222severityToLSP Error = 1

195223severityToLSP Warning = 2

196224severityToLSP Hint = 4

225+severityToLSP Refactor = 4 -- Same as Hint, but filtered out

197226

198−-- | Lint a document and return diagnostics

227+-- | Lint a document and return diagnostics (excludes Refactor severity)

199228lintDocument :: Config -> String -> Array Foreign

200229lintDocument config content =

201230 let rules = getEnabledRules config

202231 in case runRules rules (SourceCode content) of

203232 Left _ -> []

204− Right (LintResult result) -> map warningToDiagnostic result.warnings

233+ Right (LintResult result) ->

234+ map warningToDiagnostic $ Array.filter (not <<< isRefactor) result.warnings

235+ where

236+ isRefactor (LintWarning w) = w.severity == Refactor

205237

206238-- | Create a publishDiagnostics notification

207239mkPublishDiagnostics :: String -> Array Foreign -> String

@@ -332,8 +364,8 @@ parseSettings settings =

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

333365

334366-- | Handle a single message

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

336−handleMessage configRef msg = do

367+handleMessage :: Ref LSPState -> Foreign -> Effect Unit

368+handleMessage stateRef msg = do

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

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

339371

@@ -347,7 +379,7 @@ handleMessage configRef msg = do

347379 case getFieldObj "initializationOptions" params of

348380 Just options -> do

349381 let config = parseSettings options

350− Ref.write config configRef

382+ Ref.modify_ (_ { config = config }) stateRef

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

352384 Nothing -> pure unit

353385 Nothing -> pure unit

@@ -355,15 +387,15 @@ handleMessage configRef msg = do

355387 else if method == "initialized" then do

356388 Stdio.logMessage "Client initialized"

357389 else if method == "workspace/didChangeConfiguration" then do

358− handleDidChangeConfiguration configRef msg

390+ handleDidChangeConfiguration stateRef msg

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

360− handleDidOpen configRef msg

392+ handleDidOpen stateRef msg

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

362− handleDidChange configRef msg

394+ handleDidChange stateRef msg

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

364− handleDidClose msg

396+ handleDidClose stateRef msg

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

366− handleCodeAction msg reqId

398+ handleCodeAction stateRef msg reqId

367399 else if method == "shutdown" then do

368400 Stdio.logMessage "Shutdown"

369401 Stdio.writeMessage $ mkResponse reqId

@@ -372,8 +404,8 @@ handleMessage configRef msg = do

372404 else do

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

374406

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

376−handleDidChangeConfiguration configRef msg = do

407+handleDidChangeConfiguration :: Ref LSPState -> Foreign -> Effect Unit

408+handleDidChangeConfiguration stateRef msg = do

377409 Stdio.logMessage "Configuration changed"

378410 case getFieldObj "params" msg of

379411 Nothing -> pure unit

@@ -382,13 +414,12 @@ handleDidChangeConfiguration configRef msg = do

382414 Nothing -> pure unit

383415 Just settings -> do

384416 let config = parseSettings settings

385− Ref.write config configRef

417+ Ref.modify_ (_ { config = config }) stateRef

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

387419

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

389−handleDidOpen configRef msg = do

420+handleDidOpen :: Ref LSPState -> Foreign -> Effect Unit

421+handleDidOpen stateRef msg = do

390422 Stdio.logMessage "Document opened"

391− config <- Ref.read configRef

392423 case getFieldObj "params" msg of

393424 Nothing -> pure unit

394425 Just params ->

@@ -397,13 +428,15 @@ handleDidOpen configRef msg = do

397428 Just textDoc -> do

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

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

400− let diagnostics = lintDocument config text

431+ -- Store document content

432+ Ref.modify_ (\s -> s { documents = Map.insert uri text s.documents }) stateRef

433+ state <- Ref.read stateRef

434+ let diagnostics = lintDocument state.config text

401435 Stdio.writeMessage $ mkPublishDiagnostics uri diagnostics

402436

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

404−handleDidChange configRef msg = do

437+handleDidChange :: Ref LSPState -> Foreign -> Effect Unit

438+handleDidChange stateRef msg = do

405439 Stdio.logMessage "Document changed"

406− config <- Ref.read configRef

407440 case getFieldObj "params" msg of

408441 Nothing -> pure unit

409442 Just params -> do

@@ -417,11 +450,14 @@ handleDidChange configRef msg = do

417450 Nothing -> pure unit

418451 Just change -> do

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

420− let diagnostics = lintDocument config text

453+ -- Update stored document content

454+ Ref.modify_ (\s -> s { documents = Map.insert uri text s.documents }) stateRef

455+ state <- Ref.read stateRef

456+ let diagnostics = lintDocument state.config text

421457 Stdio.writeMessage $ mkPublishDiagnostics uri diagnostics

422458

423−handleDidClose :: Foreign -> Effect Unit

424−handleDidClose msg = do

459+handleDidClose :: Ref LSPState -> Foreign -> Effect Unit

460+handleDidClose stateRef msg = do

425461 Stdio.logMessage "Document closed"

426462 case getFieldObj "params" msg of

427463 Nothing -> pure unit

@@ -430,11 +466,14 @@ handleDidClose msg = do

430466 Nothing -> pure unit

431467 Just textDoc -> do

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

469+ -- Remove document from store

470+ Ref.modify_ (\s -> s { documents = Map.delete uri s.documents }) stateRef

433471 Stdio.writeMessage $ mkPublishDiagnostics uri []

434472

435−handleCodeAction :: Foreign -> Int -> Effect Unit

436−handleCodeAction msg reqId = do

473+handleCodeAction :: Ref LSPState -> Foreign -> Int -> Effect Unit

474+handleCodeAction stateRef msg reqId = do

437475 Stdio.logMessage "Code action requested"

476+ state <- Ref.read stateRef

438477 case getFieldObj "params" msg of

439478 Nothing -> Stdio.writeMessage $ mkCodeActionResponse reqId []

440479 Just params -> do

@@ -443,17 +482,78 @@ handleCodeAction msg reqId = do

443482 textDoc <- getFieldObj "textDocument" params

444483 getField "uri" textDoc

445484

446− -- Get diagnostics from the request context

485+ -- Get the requested range

486+ let requestedRange = getFieldObj "range" params

487+

488+ -- Get diagnostics from the request context (for regular rules)

447489 let diagnostics = fromMaybe [] $ do

448490 context <- getFieldObj "context" params

449491 getFieldArr "diagnostics" context

450492

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

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

493+ -- Convert diagnostics to code actions (quickfix + disable rule)

494+ let diagnosticActions = Array.concat $ map (diagnosticToCodeActions uri) diagnostics

495+

496+ -- Get refactor actions from Refactor-severity rules

497+ let refactorActions = case Map.lookup uri state.documents of

498+ Nothing -> []

499+ Just content -> getRefactorActions state.config uri requestedRange content

500+

501+ let actions = diagnosticActions <> refactorActions

453502

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

455504 Stdio.writeMessage $ mkCodeActionResponse reqId actions

456505

506+-- | Get code actions from Refactor-severity rules

507+getRefactorActions :: Config -> String -> Maybe Foreign -> String -> Array Foreign

508+getRefactorActions config uri maybeRange content =

509+ let rules = getEnabledRules config

510+ in case runRules rules (SourceCode content) of

511+ Left _ -> []

512+ Right (LintResult result) ->

513+ let refactorWarnings = Array.filter isRefactor result.warnings

514+ inRangeWarnings = case maybeRange of

515+ Nothing -> refactorWarnings

516+ Just range -> Array.filter (warningInRange range) refactorWarnings

517+ in Array.mapMaybe (warningToRefactorAction uri) inRangeWarnings

518+ where

519+ isRefactor (LintWarning w) = w.severity == Refactor

520+

521+ warningInRange :: Foreign -> LintWarning -> Boolean

522+ warningInRange range (LintWarning w) =

523+ let

524+ startLine = fromMaybe 0 $ getFieldObj "start" range >>= getFieldInt "line"

525+ endLine = fromMaybe 0 $ getFieldObj "end" range >>= getFieldInt "line"

526+ in

527+ w.range.start.line <= endLine && w.range.end.line >= startLine

528+

529+ warningToRefactorAction :: String -> LintWarning -> Maybe Foreign

530+ warningToRefactorAction docUri (LintWarning w) = do

531+ Suggestion sug <- w.suggestion

532+ let range =

533+ { start: { line: w.range.start.line, character: w.range.start.column }

534+ , end: { line: w.range.end.line, character: w.range.end.column }

535+ }

536+ pure $ mkRefactorAction (unwrap sug.description) docUri range (unwrap sug.replacement)

537+

538+-- | Create a refactor code action (no associated diagnostic)

539+mkRefactorAction :: String -> String -> { start :: { line :: Int, character :: Int }, end :: { line :: Int, character :: Int } } -> String -> Foreign

540+mkRefactorAction title uri range newText =

541+ unsafeCoerce

542+ { title: title

543+ , kind: "refactor.rewrite"

544+ , isPreferred: false

545+ , edit:

546+ { documentChanges:

547+ [ { textDocument:

548+ { uri: uri

549+ , version: mkNull unit

550+ }

551+ , edits: [{ range: range, newText: newText }]

552+ }

553+ ]

554+ }

555+ }

556+

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

458558diagnosticToCodeActions :: String -> Foreign -> Array Foreign

459559diagnosticToCodeActions uri diag =

@@ -514,8 +614,8 @@ mkDisableRuleAction ruleId diagnostic =

514614 }

515615

516616-- | Main loop

517−mainLoop :: Ref Config -> Effect Unit

518−mainLoop configRef = do

617+mainLoop :: Ref LSPState -> Effect Unit

618+mainLoop stateRef = do

519619 msgStr <- Stdio.readMessage

520620 case msgStr of

521621 Nothing -> do

@@ -525,18 +625,18 @@ mainLoop configRef = do

525625 case Stdio.parseJSON str of

526626 Nothing -> do

527627 Stdio.logMessage "Failed to parse message"

528− mainLoop configRef

628+ mainLoop stateRef

529629 Just msg -> do

530− handleMessage configRef msg

630+ handleMessage stateRef msg

531631 -- Check if it was exit

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

533633 if method == "exit"

534634 then pure unit

535− else mainLoop configRef

635+ else mainLoop stateRef

536636

537637main :: Effect Unit

538638main = do

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

540− configRef <- Ref.new defaultConfig

541− mainLoop configRef

640+ stateRef <- Ref.new { config: defaultConfig, documents: Map.empty }

641+ mainLoop stateRef

542642 Stdio.logMessage "purelint-lsp exiting"

bin/purelint-lsp/src/LSP/Stdio.js+8−8

@@ -2,8 +2,6 @@

22import * as fs from 'fs';

44// PureScript Maybe representation that works for both standard and optimized backends

5−// Standard: { value0: x } for Just, Nothing.value for Nothing

6−// Optimized: { tag: 1, _1: x } for Just, { tag: 0 } for Nothing

75const mkJust = (x) => ({ tag: 1, _1: x, value0: x });

86const mkNothing = { tag: 0 };

@@ -38,13 +36,17 @@ export const readMessage = () => {

3836 return mkJust(msg);

3937 }

4038

41− // Need to read more data synchronously from stdin

42− const fd = fs.openSync('/dev/stdin', 'r');

43−

39+ // Read synchronously from stdin fd (0)

4440 try {

4541 while (true) {

4642 const chunk = Buffer.alloc(4096);

47− const bytesRead = fs.readSync(fd, chunk, 0, 4096);

43+ let bytesRead;

44+ try {

45+ bytesRead = fs.readSync(0, chunk, 0, 4096);

46+ } catch (e) {

47+ // EAGAIN or other read error

48+ return mkNothing;

49+ }

4850

4951 if (bytesRead === 0) {

5052 // EOF

@@ -60,8 +62,6 @@ export const readMessage = () => {

6062 }

6163 } catch (e) {

6264 return mkNothing;

63− } finally {

64− fs.closeSync(fd);

6565 }

6666};

6767

examples/BadCode.purs+1−1

@@ -10,7 +10,7 @@ test1 xs = sequenceA (map pure xs)

1010-- MapFusion: map f (map g x) -> map (f <<< g) x

1111test2 xs = map show (map (_ + 1) xs)

1212

13−-- FmapId: map identity x -> x

13+-- MapIdentity: map identity x -> x

1414test3 xs = map identity xs

1515

1616-- NotEqual: not (a == b) -> a /= b

examples/TestFix.purs+5−5

@@ -5,16 +5,16 @@ import Data.Traversable (sequenceA)

55import Data.Array (concat)

77-- UseTraverse: sequenceA (map f x) -> traverse f x

8−test1 xs = traverse pure xs

8+test1 xs = traverse pure xs

1010-- MapFusion: map f (map g x) -> map (f <<< g) x

1111test2 xs = map (f <<< g) x

1212

13−-- FmapId: map identity x -> x

13+-- MapIdentity: map identity x -> x

1414test3 xs = xs

1515

1616-- NotEqual: not (a == b) -> a /= b

17−test4 a b = a /= b

17+test4 a b = a /= b

1818

1919-- ConcatMap: concat (map f x) -> concatMap f x

2020test5 xs = concatMap f x

@@ -23,7 +23,7 @@ test5 xs = concatMap f x

2323test6 cond x = when cond action

2424

2525-- EtaReduce: \x -> f x -> f

26−test7 = show

26+test7 = show

2727

2828-- RedundantBind: x >>= pure -> x

29−test8 mx = mx

29+test8 mx = mx

lib/purelint/src/Purelint/Config.purs+12−13

@@ -2,6 +2,7 @@ module Purelint.Config where

33import Prelude

5+import Data.Array (notElem)

56import Data.Array as Array

67import Data.String as String

78import Purelint.Types (RuleId(..))

@@ -18,24 +19,22 @@ defaultConfig =

1819

1920-- | Parse simple line-based config

2021parseConfig :: String -> Config

21−parseConfig str =

22− let

23− lines = String.split (String.Pattern "\n") str

24− nonEmpty = Array.filter (\l -> String.length l > 0 && not (isComment l)) lines

25− rules = map (RuleId <<< String.trim) nonEmpty

26− in

27− { disabledRules: rules }

28−

22+parseConfig str =

23+ { disabledRules: rules }

2924 where

25+ lines = str # String.split (String.Pattern "\n")

26+ nonEmpty = lines # Array.filter \l -> String.length l > 0 && not (isComment l)

27+ rules = (RuleId <<< String.trim) <$> nonEmpty

28+

3029 isComment :: String -> Boolean

31− isComment line =

32− let trimmed = String.trim line

33− in String.take 1 trimmed == "#"

30+ isComment line = (trimmed # String.take 1) == "#"

31+ where

32+ trimmed = String.trim line

3433

3534-- | Check if a rule is enabled given the config

3635isRuleEnabled :: Config -> RuleId -> Boolean

37−isRuleEnabled config ruleId = not (Array.elem ruleId config.disabledRules)

36+isRuleEnabled config ruleId = notElem ruleId config.disabledRules

3837

3938-- | Filter rules by config

4039filterRules :: forall a. Array { ruleId :: RuleId | a } -> Config -> Array { ruleId :: RuleId | a }

41−filterRules rules config = Array.filter (\r -> isRuleEnabled config r.ruleId) rules

40+filterRules rules config = rules # Array.filter \r -> r.ruleId # isRuleEnabled config

lib/purelint/src/Purelint/Fix.purs+51−65

@@ -3,105 +3,91 @@ module Purelint.Fix where

33import Prelude

55import Data.Array as Array

6+import Data.Foldable (foldMap)

67import Data.Maybe (Maybe(..))

7−import Data.Newtype (unwrap)

8+import Data.Newtype (un, unwrap)

89import Data.String as String

910import Data.String.CodeUnits as StringCU

10−import Purelint.Types (LintResult(..), LintWarning(..), Suggestion(..))

1111import PureScript.CST.Types (SourceRange)

12+import Purelint.Types (LintResult(..), LintWarning(..), ReplacementText(..), Suggestion(..))

1213

1314-- | Extract text at a source range from source code

1415extractRange :: String -> SourceRange -> String

1516extractRange source range =

16− let

17− lines = String.split (String.Pattern "\n") source

18− startLine = range.start.line

19− endLine = range.end.line

20− startCol = range.start.column

21− endCol = range.end.column

22− in

23− if startLine == endLine then

24− -- Single line extraction

25− case Array.index lines startLine of

26− Nothing -> ""

27− Just line -> StringCU.slice startCol endCol line

28− else

29− -- Multi-line extraction

30− let

31− firstLine = case Array.index lines startLine of

32− Nothing -> ""

33− Just line -> StringCU.drop startCol line

34− middleLines = Array.slice (startLine + 1) endLine lines

35− lastLine = case Array.index lines endLine of

36− Nothing -> ""

37− Just line -> StringCU.take endCol line

38− in

39− String.joinWith "\n" ([firstLine] <> middleLines <> [lastLine])

17+ if startLine == endLine then

18+ -- Single line extraction

19+ Array.index lines startLine # foldMap \line -> StringCU.slice startCol endCol line

20+ else do

21+ -- Multi-line extraction

22+ let

23+ firstLine = startLine # Array.index lines # foldMap (StringCU.drop startCol)

24+ middleLines = Array.slice (startLine + 1) endLine lines

25+ lastLine = endLine # Array.index lines # foldMap (StringCU.take endCol)

26+ ([ firstLine ] <> middleLines <> [ lastLine ]) # String.joinWith "\n"

27+ where

28+ lines = source # String.split (String.Pattern "\n")

29+ startLine = range.start.line

30+ endLine = range.end.line

31+ startCol = range.start.column

32+ endCol = range.end.column

4033

4134-- | Replace text at a source range with new text

4235replaceRange :: String -> SourceRange -> String -> String

43−replaceRange source range replacement =

36+replaceRange source range replacement = do

4437 let

45− lines = String.split (String.Pattern "\n") source

38+ lines = source # String.split (String.Pattern "\n")

4639 startLine = range.start.line

4740 endLine = range.end.line

4841 startCol = range.start.column

4942 endCol = range.end.column

50− in

51− if startLine == endLine then

52− -- Single line replacement

53− case Array.index lines startLine of

54− Nothing -> source

55− Just line ->

56− let

57− before = StringCU.take startCol line

58− after = StringCU.drop endCol line

59− newLine = before <> replacement <> after

60− newLines = Array.updateAt startLine newLine lines

61− in

62− case newLines of

63− Nothing -> source

64− Just ls -> String.joinWith "\n" ls

65− else

66− -- Multi-line replacement

67− let

68− beforeLines = Array.take startLine lines

69− afterLines = Array.drop (endLine + 1) lines

70− firstLinePart = case Array.index lines startLine of

71− Nothing -> ""

72− Just line -> StringCU.take startCol line

73− lastLinePart = case Array.index lines endLine of

74− Nothing -> ""

75− Just line -> StringCU.drop endCol line

76− newLine = firstLinePart <> replacement <> lastLinePart

77− in

78− String.joinWith "\n" (beforeLines <> [newLine] <> afterLines)

43+ if startLine == endLine then

44+ -- Single line replacement

45+ case Array.index lines startLine of

46+ Nothing -> source

47+ Just line ->

48+ let

49+ before = StringCU.take startCol line

50+ after = StringCU.drop endCol line

51+ newLine = before <> replacement <> after

52+ newLines = Array.updateAt startLine newLine lines

53+ in

54+ case newLines of

55+ Nothing -> source

56+ Just ls -> String.joinWith "\n" ls

57+ else do

58+ -- Multi-line replacement

59+ let

60+ beforeLines = lines # Array.take startLine

61+ afterLines = lines # Array.drop (endLine + 1)

62+ firstLinePart = startLine # Array.index lines # foldMap (StringCU.take startCol)

63+ lastLinePart = endLine # Array.index lines # foldMap (StringCU.drop endCol)

64+ newLine = firstLinePart <> replacement <> lastLinePart

65+ (beforeLines <> [ newLine ] <> afterLines) # String.joinWith "\n"

7966

8067-- | Apply a single fix to source code

8168applyFix :: String -> LintWarning -> Maybe String

8269applyFix source (LintWarning w) = do

8370 Suggestion s <- w.suggestion

84− let replacement = unwrap s.replacement

71+ let replacement = s.replacement # un ReplacementText

8572 Just $ replaceRange source w.range replacement

8673

8774-- | Apply all fixes to source code (in reverse order to preserve ranges)

8875applyAllFixes :: String -> LintResult -> String

8976applyAllFixes source (LintResult result) =

9077 -- Sort warnings by range in reverse order (end of file first)

91− let

92− sortedWarnings = Array.sortBy compareRangesReverse result.warnings

93− in

94− Array.foldl applyFixIfPossible source sortedWarnings

78+ Array.foldl applyFixIfPossible source sortedWarnings

9579 where

80+ sortedWarnings = result.warnings # Array.sortBy compareRangesReverse

81+

9682 compareRangesReverse :: LintWarning -> LintWarning -> Ordering

9783 compareRangesReverse (LintWarning a) (LintWarning b) =

9884 -- Compare in reverse: later positions first

99− case compare b.range.start.line a.range.start.line of

100− EQ -> compare b.range.start.column a.range.start.column

85+ case a.range.start.line # compare b.range.start.line of

86+ EQ -> a.range.start.column # compare b.range.start.column

10187 other -> other

10288

10389 applyFixIfPossible :: String -> LintWarning -> String

10490 applyFixIfPossible src warning =

105− case applyFix src warning of

91+ case warning # applyFix src of

10692 Nothing -> src

10793 Just fixed -> fixed

lib/purelint/src/Purelint/Imports.purs+4−4

@@ -53,7 +53,7 @@ preludeModules = Set.fromFoldable

5353-- | Standard Prelude values we care about

5454standardValues :: Set String

5555standardValues = Set.fromFoldable

56− [ "map", "fmap", "identity", "id", "not"

56+ [ "map", "identity", "id", "not"

5757 , "traverse", "traverse_", "sequenceA", "sequence", "for", "for_"

5858 , "concat", "concatMap", "bind", "pure", "join"

5959 , "when", "unless"

@@ -62,11 +62,11 @@ standardValues = Set.fromFoldable

6262 , "const", "void"

6363 , "maybe", "fromMaybe", "isJust", "isNothing", "Nothing", "Just"

6464 , "flip", "elem", "notElem", "elemIndex", "findIndex"

65− , "mempty", "fold", "foldMap"

65+ , "mempty", "fold", "foldMap", "foldr", "foldl"

6666 , "fst", "snd", "uncurry"

6767 , "max", "min", "minimum", "maximum"

6868 , "compare", "comparing", "on"

69− , "guard"

69+ , "guard", "empty"

7070 , "catMaybes", "mapMaybe", "findMap"

7171 , "either", "Left", "Right"

7272 , "bimap", "first", "second"

@@ -80,7 +80,7 @@ standardValues = Set.fromFoldable

8080standardOps :: Set String

8181standardOps = Set.fromFoldable

8282 [ "<$>", "<#>", "<*>", ">>=", "=<<", ">>", "*>", "<<<", ">>>", "==", "/="

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

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

8484 ]

8585

8686-- | Extract import information from a module

lib/purelint/src/Purelint/Print.purs+93−12

@@ -2,27 +2,108 @@ module Purelint.Print where

33import Prelude

5−import Data.Foldable (foldMap)

5+import Data.Array as Array

6+import Data.Foldable (foldl, foldMap)

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

68import Data.String as String

79import Data.String.Regex (regex, replace)

810import Data.String.Regex.Flags (global)

911import Data.Either (either)

1012import Data.Void (Void)

11−import PureScript.CST.Print (printSourceToken)

12−import PureScript.CST.Range (class TokensOf, tokensOf)

13+import PureScript.CST.Print (printToken, printSourceToken)

14+import PureScript.CST.Range (tokensOf)

1315import PureScript.CST.Range.TokenList as TokenList

14−import PureScript.CST.Types (Expr)

16+import PureScript.CST.Types (Binder, Expr, SourceToken, Token(..))

1517

16−-- | Print an expression back to source code, normalizing whitespace

18+-- | Print an expression back to source code with tidy-style formatting

1719printExpr :: Expr Void -> String

18−printExpr expr =

19− let raw = foldMap printSourceToken (TokenList.toArray (tokensOf expr))

20− in normalizeWhitespace raw

20+printExpr expr = do

21+ let tokens = TokenList.toArray (tokensOf expr)

22+ printTokens tokens

23+

24+-- | Print an expression preserving original whitespace/newlines

25+printExprMultiline :: Expr Void -> String

26+printExprMultiline expr = do

27+ let tokens = TokenList.toArray (tokensOf expr)

28+ String.trim $ foldMap printSourceToken tokens

29+

30+-- | Print an expression without comments with tidy-style formatting

31+printExprNoComments :: Expr Void -> String

32+printExprNoComments = printExpr

33+

34+-- | Print a binder back to source code with tidy-style formatting

35+printBinder :: Binder Void -> String

36+printBinder binder = do

37+ let tokens = TokenList.toArray (tokensOf binder)

38+ printTokens tokens

39+

40+-- | Print tokens with tidy-style spacing

41+printTokens :: Array SourceToken -> String

42+printTokens tokens =

43+ String.trim $ foldl go { prev: Nothing, result: "" } tokens # _.result

44+ where

45+ go :: { prev :: Maybe Token, result :: String } -> SourceToken -> { prev :: Maybe Token, result :: String }

46+ go acc tok =

47+ let

48+ t = tok.value

49+ printed = printToken t

50+ space = needsSpaceBetween acc.prev t

51+ in

52+ { prev: Just t

53+ , result: acc.result <> space <> printed

54+ }

55+

56+-- | Determine spacing between two tokens (tidy-style)

57+needsSpaceBetween :: Maybe Token -> Token -> String

58+needsSpaceBetween prev curr = case prev of

59+ Nothing -> ""

60+ Just p ->

61+ -- Space after opening brackets: [ x, { a:

62+ if needsSpaceAfter p then " "

63+ -- Space before closing brackets: x ], a }

64+ else if needsSpaceBefore curr then " "

65+ -- No space after certain tokens

66+ else if noSpaceAfter p then ""

67+ -- No space before certain tokens

68+ else if noSpaceBefore curr then ""

69+ -- Default: space between tokens

70+ else " "

71+

72+-- | Tokens that need space after them (tidy-style)

73+needsSpaceAfter :: Token -> Boolean

74+needsSpaceAfter = case _ of

75+ TokLeftSquare -> true -- [ x

76+ TokLeftBrace -> true -- { a

77+ _ -> false

78+

79+-- | Tokens that need space before them (tidy-style)

80+needsSpaceBefore :: Token -> Boolean

81+needsSpaceBefore = case _ of

82+ TokRightSquare -> true -- x ]

83+ TokRightBrace -> true -- a }

84+ _ -> false

85+

86+-- | Tokens that should NOT have space after them

87+noSpaceAfter :: Token -> Boolean

88+noSpaceAfter = case _ of

89+ TokBackslash -> true -- \x

90+ TokLeftParen -> true -- (x

91+ TokDot -> true -- a.b

92+ TokAt -> true -- @x

93+ TokPipe -> true -- |x in guards

94+ _ -> false

95+

96+-- | Tokens that should NOT have space before them

97+noSpaceBefore :: Token -> Boolean

98+noSpaceBefore = case _ of

99+ TokRightParen -> true -- x)

100+ TokComma -> true -- x,

101+ TokDot -> true -- a.b

102+ _ -> false

21103

22104-- | Collapse multiple spaces into single space and trim

23105normalizeWhitespace :: String -> String

24−normalizeWhitespace s =

25− let

26− -- Replace multiple spaces/newlines with single space

106+normalizeWhitespace s = do

107+ let

27108 collapsed = either (const s) (\r -> replace r " " s) (regex "\\s+" global)

28− in String.trim collapsed

109+ String.trim collapsed

lib/purelint/src/Purelint/Rules/AlternativeLaw.pursnew file+74

@@ -0,0 +1,74 @@

1+module Purelint.Rules.AlternativeLaw where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

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

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

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

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 (Expr(..), Ident(..), Module, Operator(..), QualifiedName(..), Proper(..), Wrapped(..))

15+

16+-- | Alternative law rules:

17+-- | - empty <|> x -> x (left identity)

18+-- | - x <|> empty -> x (right identity)

19+alternativeLawRule :: Rule

20+alternativeLawRule = mkRule (RuleId "AlternativeLaw") 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+ ExprOp lhs ops ->

31+ case NEA.toArray ops of

32+ [Tuple (QualifiedName { name: Operator op }) rhs]

33+ | op == "<|>" && hasOp imports "<|>" -> checkAlt imports expr lhs rhs

34+ _ -> []

35+ _ -> []

36+

37+ checkAlt :: ImportInfo -> Expr Void -> Expr Void -> Expr Void -> Array LintWarning

38+ checkAlt imports fullExpr lhs rhs

39+ -- empty <|> x -> x

40+ | isEmpty imports lhs =

41+ [ LintWarning

42+ { ruleId: RuleId "AlternativeLaw"

43+ , message: WarningMessage "Alternative law: empty <|> x simplifies to x"

44+ , range: rangeOf fullExpr

45+ , severity: Warning

46+ , suggestion: Just $ Suggestion

47+ { replacement: ReplacementText (printExpr rhs)

48+ , description: SuggestionDescription "empty is the identity for <|> (left identity)"

49+ }

50+ }

51+ ]

52+ -- x <|> empty -> x

53+ | isEmpty imports rhs =

54+ [ LintWarning

55+ { ruleId: RuleId "AlternativeLaw"

56+ , message: WarningMessage "Alternative law: x <|> empty simplifies to x"

57+ , range: rangeOf fullExpr

58+ , severity: Warning

59+ , suggestion: Just $ Suggestion

60+ { replacement: ReplacementText (printExpr lhs)

61+ , description: SuggestionDescription "empty is the identity for <|> (right identity)"

62+ }

63+ }

64+ ]

65+ | otherwise = []

66+

67+ isEmpty :: ImportInfo -> Expr Void -> Boolean

68+ isEmpty imports (ExprIdent (QualifiedName { name: Ident name })) =

69+ (name == "empty" && hasValue imports "empty") ||

70+ (name == "mempty" && hasValue imports "mempty")

71+ isEmpty imports (ExprConstructor (QualifiedName { name: Proper "Nothing" })) =

72+ hasValue imports "Nothing"

73+ isEmpty _ (ExprArray (Wrapped { value: Nothing })) = true -- []

74+ isEmpty _ _ = false

lib/purelint/src/Purelint/Rules/BooleanSimplify.purs+33−19

@@ -19,7 +19,7 @@ import PureScript.CST.Types (Expr(..), Module, Operator(..), QualifiedName(..))

1919-- | Also: true == x -> x

2020-- | Also: false == x -> not x

2121booleanSimplifyRule :: Rule

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

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

2323 where

2424 run :: RuleContext -> Module Void -> Array LintWarning

2525 run ctx = foldMapModule visitor

@@ -29,24 +29,38 @@ booleanSimplifyRule = mkRule (RuleId "BooleanSimplify") run

2929

3030 checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

3131 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− _ -> []

32+

33+ -- x == true -> x

34+ ExprOp lhs ops

35+ | "==" # hasOp imports

36+ , [ Tuple qn rhs ] <- NEA.toArray ops

37+ , isEqOp qn

38+ , rhs # isBoolLit true ->

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

40+

41+ -- x == false -> not x

42+ ExprOp lhs ops

43+ | "==" # hasOp imports

44+ , [ Tuple qn rhs ] <- NEA.toArray ops

45+ , isEqOp qn

46+ , rhs # isBoolLit false ->

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

48+

49+ -- true == x -> x

50+ ExprOp lhs ops

51+ | "==" # hasOp imports

52+ , [ Tuple qn rhs ] <- NEA.toArray ops

53+ , isEqOp qn

54+ , lhs # isBoolLit true ->

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

56+

57+ -- false == x -> not x

58+ ExprOp lhs ops

59+ | "==" # hasOp imports

60+ , [ Tuple qn rhs ] <- NEA.toArray ops

61+ , isEqOp qn

62+ , lhs # isBoolLit false ->

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

5064 _ -> []

5165

5266 mkWarning :: Expr Void -> String -> String -> String -> LintWarning

lib/purelint/src/Purelint/Rules/CollapseLambdas.purs+13−15

@@ -6,7 +6,6 @@ import Data.Array as Array

66import Data.Array.NonEmpty as NEA

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

88import Data.String as String

9−import Data.Void (Void)

109import Purelint.Print (printExpr)

1110import Purelint.Rule (Rule, RuleContext, mkRule)

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

@@ -16,7 +15,7 @@ import PureScript.CST.Types (Binder(..), Expr(..), Ident(..), Module, Name(..))

1615

1716-- | Rule: \x -> \y -> body -> \x y -> body

1817collapseLambdasRule :: Rule

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

18+collapseLambdasRule = run # mkRule (RuleId "CollapseLambdas")

2019 where

2120 run :: RuleContext -> Module Void -> Array LintWarning

2221 run _ctx = foldMapModule visitor

@@ -28,7 +27,7 @@ collapseLambdasRule = mkRule (RuleId "CollapseLambdas") run

2827 ExprLambda lambda ->

2928 -- Check if body is another lambda

3029 case lambda.body of

31− ExprLambda innerLambda ->

30+ ExprLambda innerLambda -> do

3231 let

3332 outerBinders = NEA.toArray lambda.binders

3433 innerBinders = NEA.toArray innerLambda.binders

@@ -36,18 +35,17 @@ collapseLambdasRule = mkRule (RuleId "CollapseLambdas") run

3635 binderNames = Array.mapMaybe getBinderName allBinders

3736 bodyText = printExpr innerLambda.body

3837 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− ]

38+ [ LintWarning

39+ { ruleId: RuleId "CollapseLambdas"

40+ , message: WarningMessage "Collapse nested lambdas"

41+ , range: rangeOf expr

42+ , severity: Hint

43+ , suggestion: Just $ Suggestion

44+ { replacement: ReplacementText replacement

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

46+ }

47+ }

48+ ]

5149 _ -> []

5250 _ -> []

5351

lib/purelint/src/Purelint/Rules/ConcatMap.purs+12−17

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

55import Data.Array.NonEmpty as NEA

66import Data.Maybe (Maybe(..))

7−import Data.Void (Void)

87import Purelint.Imports (ImportInfo, hasValue)

98import Purelint.Print (printExpr)

109import Purelint.Rule (Rule, RuleContext, mkRule)

@@ -27,13 +26,10 @@ concatMapRule = mkRule (RuleId "ConcatMap") run

2726 checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

2827 checkExpr imports expr = case expr of

2928 -- Match: concat (map f x) or join (map f x)

30− ExprApp fnExpr args ->

31− case fnExpr of

32− ExprIdent qn | isConcatOrJoin imports qn ->

33− case NEA.head args of

34− AppTerm innerExpr -> checkInnerMap imports expr qn (unwrapParens innerExpr)

35− _ -> []

36− _ -> []

29+ ExprApp (ExprIdent qn) args

30+ | qn # isConcatOrJoin imports

31+ , AppTerm innerExpr <- NEA.head args ->

32+ checkInnerMap imports expr qn (unwrapParens innerExpr)

3733 _ -> []

3834

3935 unwrapParens :: Expr Void -> Expr Void

@@ -41,12 +37,12 @@ concatMapRule = mkRule (RuleId "ConcatMap") run

4137 unwrapParens e = e

4238

4339 checkInnerMap :: ImportInfo -> Expr Void -> QualifiedName Ident -> Expr Void -> Array LintWarning

44− checkInnerMap imports fullExpr fnQn innerExpr =

40+ checkInnerMap imports fullExpr fnQn innerExpr =

4541 case innerExpr of

46− ExprApp mapFn innerArgs | isMapApp imports mapFn ->

47− case NEA.toArray innerArgs of

48− [AppTerm fExpr, AppTerm xExpr] ->

49− let

42+ ExprApp mapFn innerArgs

43+ | isMapApp imports mapFn

44+ , [ AppTerm fExpr, AppTerm xExpr ] <- NEA.toArray innerArgs ->

45+ let

5046 fnName = getIdentName fnQn

5147 replacementFn = if fnName == "concat" then "concatMap" else "(=<<)"

5248 f = printExpr fExpr

@@ -65,7 +61,6 @@ concatMapRule = mkRule (RuleId "ConcatMap") run

6561 }

6662 }

6763 ]

68− _ -> []

6964 _ -> []

7065

7166 isMapApp :: ImportInfo -> Expr Void -> Boolean

@@ -73,11 +68,11 @@ concatMapRule = mkRule (RuleId "ConcatMap") run

7368 isMapApp _ _ = false

7469

7570 isMap :: ImportInfo -> QualifiedName Ident -> Boolean

76− isMap imports (QualifiedName { name: Ident name }) =

77− (name == "map" && hasValue imports "map") || (name == "fmap" && hasValue imports "fmap")

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

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

7873

7974 isConcatOrJoin :: ImportInfo -> QualifiedName Ident -> Boolean

80− isConcatOrJoin imports (QualifiedName { name: Ident name }) =

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

8176 (name == "concat" && hasValue imports "concat") || (name == "join" && hasValue imports "join")

8277

8378 getIdentName :: QualifiedName Ident -> String

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

@@ -11,7 +11,6 @@ import Purelint.Types (LintWarning(..), RuleId(..), Severity(..), Suggestion(..)

1111import PureScript.CST.Range (rangeOf)

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

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

14−import Data.Void (Void)

1514

1615-- | Rule: \x -> f x -> f (eta reduction)

1716-- | Detects simple lambda functions that can be eta reduced

@@ -26,15 +25,14 @@ etaReduceRule = mkRule (RuleId "EtaReduce") run

2625 checkExpr :: Expr Void -> Array LintWarning

2726 checkExpr expr = case expr of

2827 -- Match: \x -> f x

29− ExprLambda lambda ->

30− checkLambda expr lambda

28+ ExprLambda lambda -> lambda # checkLambda expr

3129 _ -> []

3230

3331 checkLambda :: Expr Void -> _ -> Array LintWarning

3432 checkLambda fullExpr lambda =

3533 -- Check for single binder that's a simple variable

3634 case NEA.toArray lambda.binders of

37− [BinderVar (Name { name: Ident paramName })] ->

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

3836 -- Check if body is f x where x matches the param

3937 checkBody fullExpr paramName (unwrapParens lambda.body)

4038 _ -> []

@@ -42,15 +40,21 @@ etaReduceRule = mkRule (RuleId "EtaReduce") run

4240 checkBody :: Expr Void -> String -> Expr Void -> Array LintWarning

4341 checkBody fullExpr paramName body =

4442 case body of

45− ExprApp fn args ->

43+ ExprApp fn args -> do

4644 -- Check if the last argument is just our parameter

47− let argsArr = NEA.toArray args in

45+ let argsArr = NEA.toArray args

4846 case Array.last argsArr of

49− Just (AppTerm (ExprIdent (QualifiedName { name: Ident argName })))

50− | argName == paramName && not (mentionsParam paramName fn) && Array.length argsArr == 1 ->

51− -- Single arg case: \x -> f x -> f

52− let fnText = printExpr fn

53− in

47+ Just (AppTerm (ExprIdent (QualifiedName { name: Ident argName })))

48+ | argName == paramName

49+ , not (fn # mentionsParam paramName)

50+ , not ((argsArr # Array.dropEnd 1) # Array.any (checkArg paramName)) -> do

51+ -- Can eta reduce

52+ let

53+ remainingArgs = Array.dropEnd 1 argsArr

54+ -- If there are remaining args, wrap in parens for safety

55+ fnText =

56+ if Array.null remainingArgs then printExpr fn

57+ else "(" <> printExpr fn <> " " <> Array.intercalate " " (map printAppSpine remainingArgs) <> ")"

5458 [ LintWarning

5559 { ruleId: RuleId "EtaReduce"

5660 , message: WarningMessage "Lambda can be eta reduced"

@@ -65,6 +69,10 @@ etaReduceRule = mkRule (RuleId "EtaReduce") run

6569 _ -> []

6670 _ -> []

6771

72+ printAppSpine :: AppSpine Expr Void -> String

73+ printAppSpine (AppTerm e) = printExpr e

74+ printAppSpine (AppType _ _) = "@_"

75+

6876 unwrapParens :: Expr Void -> Expr Void

6977 unwrapParens (ExprParens (Wrapped { value })) = unwrapParens value

7078 unwrapParens e = e

@@ -72,11 +80,12 @@ etaReduceRule = mkRule (RuleId "EtaReduce") run

7280 -- Check if expression mentions the parameter (crude check)

7381 mentionsParam :: String -> Expr Void -> Boolean

7482 mentionsParam name (ExprIdent (QualifiedName { name: Ident n })) = n == name

75− mentionsParam name (ExprApp fn args) =

76− mentionsParam name fn || Array.any (checkArg name) (NEA.toArray args)

77− mentionsParam name (ExprParens (Wrapped { value })) = mentionsParam name value

83+ mentionsParam name (ExprApp fn args) =

84+ (fn # mentionsParam name) || ((NEA.toArray args) # Array.any (checkArg name))

85+ mentionsParam name (ExprParens (Wrapped { value })) = value # mentionsParam name

7886 mentionsParam _ _ = false

7987

8088 checkArg :: String -> AppSpine Expr Void -> Boolean

81− checkArg name (AppTerm e) = mentionsParam name e

82− checkArg _ _ = false

89+ checkArg = case _, _ of

90+ name, (AppTerm e) -> e # mentionsParam name

91+ _, _ -> false

lib/purelint/src/Purelint/Rules/EtaReduceDecl.purs+27−40

@@ -34,48 +34,35 @@ etaReduceDeclRule = mkRule (RuleId "EtaReduceDecl") run

3434 -- Check for pattern: foo x = expr x (single binder, unconditional)

3535 case vb.guarded of

3636 Unconditional _ (Where { expr, bindings: Nothing }) ->

37− checkEtaReducible vb.binders (unwrapParens expr)

37+ unwrapParens expr # checkEtaReducible vb.binders

3838 _ -> []

3939

4040 checkEtaReducible :: Array (Binder Void) -> Expr Void -> Array LintWarning

41− checkEtaReducible binders body =

42− -- Get the last binder if it's a simple variable

43− case Array.last binders of

44− Just lastBinder@(BinderVar (Name { name: Ident paramName })) ->

45− -- Check if body is `f ... x` where x is our param

46− case body of

47− ExprApp fn args ->

48− let argsArr = NEA.toArray args in

49− case Array.last argsArr of

50− Just (AppTerm (ExprIdent (QualifiedName { name: Ident argName })))

51− | argName == paramName

52− && not (mentionsParam paramName fn)

53− && not (Array.any (checkArgMentions paramName) (Array.dropEnd 1 argsArr)) ->

54− -- Can eta reduce - build the new RHS

55− let

56− remainingArgs = Array.dropEnd 1 argsArr

57− newRhs = if Array.null remainingArgs

58− then printExpr fn

59− else printExpr fn <> " " <> Array.intercalate " " (map printAppSpine remainingArgs)

60− -- Range from last binder to end of body

61− binderRange = rangeOf lastBinder

62− bodyRange = rangeOf body

63− fullRange = { start: binderRange.start, end: bodyRange.end }

64− in

65− [ LintWarning

66− { ruleId: RuleId "EtaReduceDecl"

67− , message: WarningMessage "Declaration can be eta reduced"

68− , range: fullRange

69− , severity: Hint

70− , suggestion: Just $ Suggestion

71− { replacement: ReplacementText ("= " <> newRhs)

72− , description: SuggestionDescription "Remove redundant parameter"

73− }

74− }

75− ]

76− _ -> []

77− _ -> []

78− _ -> []

41+ checkEtaReducible binders body

42+ | Just lastBinder@(BinderVar (Name { name: Ident paramName })) <- Array.last binders

43+ , ExprApp fn args <- body

44+ , argsArr <- NEA.toArray args

45+ , Just (AppTerm (ExprIdent (QualifiedName { name: Ident argName }))) <- Array.last argsArr

46+ , argName == paramName

47+ , not mentionsParam paramName fn

48+ , remainingArgs <- Array.dropEnd 1 argsArr

49+ , not (Array.any (checkArgMentions paramName) remainingArgs)

50+ , newRhs <-

51+ if Array.null remainingArgs then printExpr fn

52+ else printExpr fn <> " " <> Array.intercalate " " (map printAppSpine remainingArgs)

53+ , fullRange <- { start: (rangeOf lastBinder).start, end: (rangeOf body).end } =

54+ [ LintWarning

55+ { ruleId: RuleId "EtaReduceDecl"

56+ , message: WarningMessage "Declaration can be eta reduced"

57+ , range: fullRange

58+ , severity: Hint

59+ , suggestion: Just $ Suggestion

60+ { replacement: ReplacementText ("= " <> newRhs)

61+ , description: SuggestionDescription "Remove redundant parameter"

62+ }

63+ }

64+ ]

65+ | otherwise = []

7966

8067 printAppSpine :: AppSpine Expr Void -> String

8168 printAppSpine (AppTerm e) = printExpr e

@@ -92,7 +79,7 @@ etaReduceDeclRule = mkRule (RuleId "EtaReduceDecl") run

9279 -- Check if expression mentions the parameter

9380 mentionsParam :: String -> Expr Void -> Boolean

9481 mentionsParam name (ExprIdent (QualifiedName { name: Ident n })) = n == name

95− mentionsParam name (ExprApp fn args) =

82+ mentionsParam name (ExprApp fn args) =

9683 mentionsParam name fn || Array.any (checkArg name) (NEA.toArray args)

9784 mentionsParam name (ExprParens (Wrapped { value })) = mentionsParam name value

9885 mentionsParam _ _ = false

lib/purelint/src/Purelint/Rules/EvaluateBool.pursnew file+88

@@ -0,0 +1,88 @@

1+module Purelint.Rules.EvaluateBool where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

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

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

8+import Purelint.Imports (ImportInfo, hasOp)

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 (Expr(..), Module, Operator(..), QualifiedName(..))

15+

16+-- | Constant folding for boolean expressions:

17+-- | - true && x -> x

18+-- | - false && x -> false

19+-- | - x && true -> x

20+-- | - x && false -> false

21+-- | - true || x -> true

22+-- | - false || x -> x

23+-- | - x || true -> true

24+-- | - x || false -> x

25+evaluateBoolRule :: Rule

26+evaluateBoolRule = run # mkRule (RuleId "EvaluateBool")

27+ where

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

29+ run ctx = foldMapModule visitor

30+ where

31+ imports = ctx.imports

32+ visitor = defaultMonoidalVisitor { onExpr = checkExpr imports }

33+

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

35+ checkExpr imports expr = case expr of

36+ ExprOp lhs ops ->

37+ case NEA.toArray ops of

38+ [ Tuple (QualifiedName { name: Operator op }) rhs ]

39+ | op == "&&" && hasOp imports "&&" -> checkAnd imports expr lhs rhs

40+ | op == "||" && hasOp imports "||" -> checkOr imports expr lhs rhs

41+ _ -> []

42+ _ -> []

43+

44+ checkAnd :: ImportInfo -> Expr Void -> Expr Void -> Expr Void -> Array LintWarning

45+ checkAnd _ fullExpr lhs rhs

46+ -- true && x -> x

47+ | isTrue lhs = mkWarning fullExpr "true && x" (printExpr rhs) "x"

48+ -- false && x -> false

49+ | isFalse lhs = mkWarning fullExpr "false && x" "false" "false"

50+ -- x && true -> x

51+ | isTrue rhs = mkWarning fullExpr "x && true" (printExpr lhs) "x"

52+ -- x && false -> false

53+ | isFalse rhs = mkWarning fullExpr "x && false" "false" "false"

54+ | otherwise = []

55+

56+ checkOr :: ImportInfo -> Expr Void -> Expr Void -> Expr Void -> Array LintWarning

57+ checkOr _ fullExpr lhs rhs

58+ -- true || x -> true

59+ | isTrue lhs = mkWarning fullExpr "true || x" "true" "true"

60+ -- false || x -> x

61+ | isFalse lhs = mkWarning fullExpr "false || x" (printExpr rhs) "x"

62+ -- x || true -> true

63+ | isTrue rhs = mkWarning fullExpr "x || true" "true" "true"

64+ -- x || false -> x

65+ | isFalse rhs = mkWarning fullExpr "x || false" (printExpr lhs) "x"

66+ | otherwise = []

67+

68+ isTrue :: Expr Void -> Boolean

69+ isTrue (ExprBoolean _ b) = b

70+ isTrue _ = false

71+

72+ isFalse :: Expr Void -> Boolean

73+ isFalse (ExprBoolean _ b) = not b

74+ isFalse _ = false

75+

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

77+ mkWarning fullExpr pattern replacement desc =

78+ [ LintWarning

79+ { ruleId: RuleId "EvaluateBool"

80+ , message: WarningMessage $ pattern <> " can be simplified"

81+ , range: rangeOf fullExpr

82+ , severity: Warning

83+ , suggestion: Just $ Suggestion

84+ { replacement: ReplacementText replacement

85+ , description: SuggestionDescription $ "Simplifies to " <> desc

86+ }

87+ }

88+ ]

lib/purelint/src/Purelint/Rules/EvaluateEither.pursnew file+119

@@ -0,0 +1,119 @@

1+module Purelint.Rules.EvaluateEither where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

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

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 (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..), Proper(..), Wrapped(..))

14+

15+-- | Either constant folding rules:

16+-- | - either f g (Left x) -> f x

17+-- | - either f g (Right y) -> g y

18+evaluateEitherRule :: Rule

19+evaluateEitherRule = mkRule (RuleId "EvaluateEither") 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 f g (Left x) or either f g (Right y)

30+ ExprApp fn args

31+ | isEither imports fn ->

32+ case NEA.toArray args of

33+ [AppTerm f, AppTerm g, AppTerm eitherArg] ->

34+ checkEitherApp imports expr f g eitherArg

35+ _ -> []

36+ _ -> []

37+

38+ checkEitherApp :: ImportInfo -> Expr Void -> Expr Void -> Expr Void -> Expr Void -> Array LintWarning

39+ checkEitherApp imports fullExpr f g eitherArg =

40+ case getLeftArg imports eitherArg of

41+ Just x ->

42+ -- either f g (Left x) -> f x

43+ let replacement = printExpr f <> " " <> wrapIfNeeded x

44+ in

45+ [ LintWarning

46+ { ruleId: RuleId "EvaluateEither"

47+ , message: WarningMessage "either f g (Left x) simplifies to f x"

48+ , range: rangeOf fullExpr

49+ , severity: Warning

50+ , suggestion: Just $ Suggestion

51+ { replacement: ReplacementText replacement

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

53+ }

54+ }

55+ ]

56+ Nothing ->

57+ case getRightArg imports eitherArg of

58+ Just y ->

59+ -- either f g (Right y) -> g y

60+ let replacement = printExpr g <> " " <> wrapIfNeeded y

61+ in

62+ [ LintWarning

63+ { ruleId: RuleId "EvaluateEither"

64+ , message: WarningMessage "either f g (Right y) simplifies to g y"

65+ , range: rangeOf fullExpr

66+ , severity: Warning

67+ , suggestion: Just $ Suggestion

68+ { replacement: ReplacementText replacement

69+ , description: SuggestionDescription "Apply g directly to y"

70+ }

71+ }

72+ ]

73+ Nothing -> []

74+

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

76+ isEither imports (ExprIdent (QualifiedName { name: Ident "either" })) =

77+ hasValue imports "either"

78+ isEither _ _ = false

79+

80+ getLeftArg :: ImportInfo -> Expr Void -> Maybe (Expr Void)

81+ getLeftArg imports (ExprApp ctor args)

82+ | isLeft imports ctor =

83+ case NEA.toArray args of

84+ [AppTerm arg] -> Just arg

85+ _ -> Nothing

86+ getLeftArg imports (ExprParens (Wrapped { value: inner })) = getLeftArg imports inner

87+ getLeftArg _ _ = Nothing

88+

89+ getRightArg :: ImportInfo -> Expr Void -> Maybe (Expr Void)

90+ getRightArg imports (ExprApp ctor args)

91+ | isRight imports ctor =

92+ case NEA.toArray args of

93+ [AppTerm arg] -> Just arg

94+ _ -> Nothing

95+ getRightArg imports (ExprParens (Wrapped { value: inner })) = getRightArg imports inner

96+ getRightArg _ _ = Nothing

97+

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

99+ isLeft imports (ExprConstructor (QualifiedName { name: Proper "Left" })) =

100+ hasValue imports "Left"

101+ isLeft _ _ = false

102+

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

104+ isRight imports (ExprConstructor (QualifiedName { name: Proper "Right" })) =

105+ hasValue imports "Right"

106+ isRight _ _ = false

107+

108+ wrapIfNeeded :: Expr Void -> String

109+ wrapIfNeeded e = case e of

110+ ExprIdent _ -> printExpr e

111+ ExprConstructor _ -> printExpr e

112+ ExprInt _ _ -> printExpr e

113+ ExprNumber _ _ -> printExpr e

114+ ExprString _ _ -> printExpr e

115+ ExprChar _ _ -> printExpr e

116+ ExprArray _ -> printExpr e

117+ ExprRecord _ -> printExpr e

118+ ExprParens _ -> printExpr e

119+ _ -> "(" <> printExpr e <> ")"

lib/purelint/src/Purelint/Rules/FlattenCase.pursnew file+143

@@ -0,0 +1,143 @@

1+module Purelint.Rules.FlattenCase 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.Tuple (Tuple(..))

10+import Data.Void (Void)

11+import Purelint.Print (printBinder, 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 (Binder(..), Expr(..), Guarded(..), Module, Separated(..), Where(..), Wrapped(..))

17+

18+-- | Rule: Nested case expressions with same fallback can use tuple patterns

19+-- |

20+-- | case x of

21+-- | A -> case y of

22+-- | B -> result

23+-- | _ -> fallback

24+-- | _ -> fallback

25+-- |

26+-- | becomes:

27+-- |

28+-- | case x, y of

29+-- | A, B -> result

30+-- | _, _ -> fallback

31+flattenCaseRule :: Rule

32+flattenCaseRule = mkRule (RuleId "FlattenCase") run

33+ where

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

35+ run _ctx = foldMapModule visitor

36+ where

37+ visitor = defaultMonoidalVisitor { onExpr = checkExpr }

38+

39+ checkExpr :: Expr Void -> Array LintWarning

40+ checkExpr expr = case expr of

41+ ExprCase caseOf ->

42+ case analyzeNestedCase caseOf.head (NEA.toArray caseOf.branches) of

43+ Just { depth, fallback, arms, headExprs } | depth >= 2 ->

44+ let

45+ headStr = String.joinWith ", " headExprs

46+ armsStr = arms # map formatArm # String.joinWith "\n "

47+ fallbackPatterns = Array.replicate depth "_" # String.joinWith ", "

48+ fallbackStr = fallbackPatterns <> " -> " <> fallback

49+ replacement = "case " <> headStr <> " of\n " <> armsStr <> "\n " <> fallbackStr

50+ in

51+ [ LintWarning

52+ { ruleId: RuleId "FlattenCase"

53+ , message: WarningMessage "Nested case expressions with same fallback can be flattened"

54+ , range: rangeOf expr

55+ , severity: Hint

56+ , suggestion: Just $ Suggestion

57+ { replacement: ReplacementText replacement

58+ , description: SuggestionDescription $ "Use case with " <> show depth <> " scrutinees instead of nested cases"

59+ }

60+ }

61+ ]

62+ _ -> []

63+ _ -> []

64+

65+ -- Analyze nested case to find depth, common fallback, and arms

66+ analyzeNestedCase

67+ :: Separated (Expr Void)

68+ -> Array (Tuple (Separated (Binder Void)) (Guarded Void))

69+ -> Maybe { depth :: Int, fallback :: String, arms :: Array { patterns :: Array String, body :: String }, headExprs :: Array String }

70+ analyzeNestedCase (Separated { head: scrutinee }) branches = do

71+ -- Need exactly 2 branches: one match and one wildcard fallback

72+ case branches of

73+ [ branch1, branch2 ] -> do

74+ let fb1 = getFallbackBody branch1

75+ let fb2 = getFallbackBody branch2

76+ case fb1, fb2 of

77+ -- branch2 is the fallback (wildcard pattern)

78+ Nothing, Just fallback ->

79+ analyzeMatchBranch (printExpr scrutinee) fallback branch1

80+ -- branch1 is the fallback

81+ Just fallback, Nothing ->

82+ analyzeMatchBranch (printExpr scrutinee) fallback branch2

83+ _, _ -> Nothing

84+ _ -> Nothing

85+

86+ -- Check if a branch is a wildcard fallback, return its body

87+ getFallbackBody :: Tuple (Separated (Binder Void)) (Guarded Void) -> Maybe String

88+ getFallbackBody (Tuple (Separated { head: binder, tail: [] }) guarded) =

89+ if isWildcard binder then

90+ case guarded of

91+ Unconditional _ (Where { expr, bindings: Nothing }) -> Just (printExpr expr)

92+ _ -> Nothing

93+ else Nothing

94+ getFallbackBody _ = Nothing

95+

96+ isWildcard :: Binder Void -> Boolean

97+ isWildcard (BinderWildcard _) = true

98+ isWildcard _ = false

99+

100+ -- Analyze a match branch to find nested structure

101+ analyzeMatchBranch

102+ :: String

103+ -> String

104+ -> Tuple (Separated (Binder Void)) (Guarded Void)

105+ -> Maybe { depth :: Int, fallback :: String, arms :: Array { patterns :: Array String, body :: String }, headExprs :: Array String }

106+ analyzeMatchBranch scrutineeStr fallback (Tuple (Separated { head: pattern1, tail: [] }) guarded) =

107+ case guarded of

108+ Unconditional _ (Where { expr, bindings: Nothing }) ->

109+ let pat1Str = printBinder pattern1

110+ in case expr of

111+ -- Check for nested case with same fallback

112+ ExprCase innerCaseOf ->

113+ case analyzeNestedCase innerCaseOf.head (NEA.toArray innerCaseOf.branches) of

114+ Just nested | nested.fallback == fallback ->

115+ -- Found nested case with same fallback - extend it

116+ Just

117+ { depth: nested.depth + 1

118+ , fallback

119+ , arms: nested.arms # map \arm -> arm { patterns = Array.cons pat1Str arm.patterns }

120+ , headExprs: Array.cons scrutineeStr nested.headExprs

121+ }

122+ _ ->

123+ -- Inner case has different fallback or structure - this is a leaf

124+ Just

125+ { depth: 1

126+ , fallback

127+ , arms: [ { patterns: [pat1Str], body: printExpr expr } ]

128+ , headExprs: [scrutineeStr]

129+ }

130+ -- Not a nested case - this is a leaf arm

131+ _ ->

132+ Just

133+ { depth: 1

134+ , fallback

135+ , arms: [ { patterns: [pat1Str], body: printExpr expr } ]

136+ , headExprs: [scrutineeStr]

137+ }

138+ _ -> Nothing

139+ analyzeMatchBranch _ _ _ = Nothing

140+

141+ formatArm :: { patterns :: Array String, body :: String } -> String

142+ formatArm { patterns, body } =

143+ String.joinWith ", " patterns <> " -> " <> body

lib/purelint/src/Purelint/Rules/FmapId.pursdeleted−105

@@ -1,105 +0,0 @@

1−module Purelint.Rules.FmapId where

2−

3−import Prelude

4−

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, hasOp)

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(..), Expr(..), Ident(..), Module, Operator(..), QualifiedName(..))

17−

18−-- | Rule: map identity x -> x

19−-- | Also: fmap identity x -> x, identity <$> x -> x, x <#> identity -> x

20−fmapIdRule :: Rule

21−fmapIdRule = mkRule (RuleId "FmapId") 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: map identity x or fmap identity x

32− ExprApp fnExpr args ->

33− case fnExpr of

34− ExprIdent qn | isMapLike imports qn ->

35− case NEA.toArray args of

36− [AppTerm idExpr, AppTerm xExpr] | isIdentity imports idExpr ->

37− let xText = printExpr xExpr

38− in

39− [ LintWarning

40− { ruleId: RuleId "FmapId"

41− , message: WarningMessage "map identity is redundant"

42− , range: rangeOf expr

43− , severity: Warning

44− , suggestion: Just $ Suggestion

45− { replacement: ReplacementText xText

46− , description: SuggestionDescription "map identity x can be simplified to x"

47− }

48− }

49− ]

50− _ -> []

51− _ -> []

52− -- Match: identity <$> x

53− ExprOp lhs ops | isIdentity imports lhs ->

54− case NEA.toArray ops of

55− [Tuple qn xExpr] | isMapOp imports qn ->

56− let xText = printExpr xExpr

57− in

58− [ LintWarning

59− { ruleId: RuleId "FmapId"

60− , message: WarningMessage "identity <$> is redundant"

61− , range: rangeOf expr

62− , severity: Warning

63− , suggestion: Just $ Suggestion

64− { replacement: ReplacementText xText

65− , description: SuggestionDescription "identity <$> x can be simplified to x"

66− }

67− }

68− ]

69− _ -> []

70− -- Match: x <#> identity

71− ExprOp lhs ops ->

72− case NEA.toArray ops of

73− [Tuple qn idExpr] | isFlippedMapOp imports qn && isIdentity imports idExpr ->

74− let xText = printExpr lhs

75− in

76− [ LintWarning

77− { ruleId: RuleId "FmapId"

78− , message: WarningMessage "<#> identity is redundant"

79− , range: rangeOf expr

80− , severity: Warning

81− , suggestion: Just $ Suggestion

82− { replacement: ReplacementText xText

83− , description: SuggestionDescription "x <#> identity can be simplified to x"

84− }

85− }

86− ]

87− _ -> []

88− _ -> []

89−

90− isMapLike :: ImportInfo -> QualifiedName Ident -> Boolean

91− isMapLike imports (QualifiedName { name: Ident name }) =

92− (name == "map" && hasValue imports "map") || (name == "fmap" && hasValue imports "fmap")

93−

94− isMapOp :: ImportInfo -> QualifiedName Operator -> Boolean

95− isMapOp imports (QualifiedName { name: Operator op }) =

96− (op == "<$>" || op == "<$$>") && hasOp imports "<$>"

97−

98− isFlippedMapOp :: ImportInfo -> QualifiedName Operator -> Boolean

99− isFlippedMapOp imports (QualifiedName { name: Operator op }) =

100− (op == "<#>" || op == "<##>") && hasOp imports "<#>"

101−

102− isIdentity :: ImportInfo -> Expr Void -> Boolean

103− isIdentity imports (ExprIdent (QualifiedName { name: Ident name })) =

104− (name == "identity" && hasValue imports "identity") || (name == "id" && hasValue imports "id")

105− isIdentity _ _ = false

lib/purelint/src/Purelint/Rules/FunctorLaw.purs+26−23

@@ -28,29 +28,32 @@ functorLawRule = mkRule (RuleId "FunctorLaw") run

2828 checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

2929 checkExpr imports expr = case expr of

3030 -- 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− _ -> []

31+ ExprApp fnExpr args

32+ | isMapLike imports fnExpr

33+ , [AppTerm fExpr, AppTerm innerExpr] <- NEA.toArray args ->

34+ checkInnerMap imports expr fExpr (unwrapParens innerExpr)

4235 -- 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− _ -> []

36+ ExprOp fExpr ops

37+ | hasOp imports "<$>"

38+ , [Tuple qn innerExpr] <- NEA.toArray ops

39+ , isMapOp imports qn ->

40+ checkInnerOp imports expr fExpr (unwrapParens innerExpr)

41+ _ -> []

42+

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

44+ checkInnerMap imports fullExpr fExpr inner = case inner of

45+ ExprApp innerFn innerArgs

46+ | isMapLike imports innerFn

47+ , [AppTerm gExpr, AppTerm xExpr] <- NEA.toArray innerArgs ->

48+ mkWarning fullExpr fExpr gExpr xExpr "map"

49+ _ -> []

50+

51+ checkInnerOp :: ImportInfo -> Expr Void -> Expr Void -> Expr Void -> Array LintWarning

52+ checkInnerOp imports fullExpr fExpr inner = case inner of

53+ ExprOp gExpr innerOps

54+ | [Tuple innerQn xExpr] <- NEA.toArray innerOps

55+ , isMapOp imports innerQn ->

56+ mkWarning fullExpr fExpr gExpr xExpr "<$>"

5457 _ -> []

5558

5659 mkWarning :: Expr Void -> Expr Void -> Expr Void -> Expr Void -> String -> Array LintWarning

@@ -81,7 +84,7 @@ functorLawRule = mkRule (RuleId "FunctorLaw") run

8184

8285 isMapLike :: ImportInfo -> Expr Void -> Boolean

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

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

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

8588 isMapLike _ _ = false

8689

8790 isMapOp :: ImportInfo -> QualifiedName Operator -> Boolean

lib/purelint/src/Purelint/Rules/LetToDo.pursnew file+151

@@ -0,0 +1,151 @@

1+module Purelint.Rules.LetToDo where

3+import Prelude

5+import Data.Array as Array

6+import Data.Array.NonEmpty as NEA

7+import Data.Foldable (foldMap)

8+import Data.Maybe (Maybe(..))

9+import Data.Monoid (power)

10+import Data.String (joinWith) as String

11+import Data.String as Str

12+import Data.Tuple.Nested ((/\))

13+import Data.Void (Void, absurd)

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

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

16+import PureScript.CST.Print (printToken)

17+import PureScript.CST.Range (rangeOf, tokensOf)

18+import PureScript.CST.Range.TokenList as TokenList

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

20+import PureScript.CST.Types (Comment(..), Declaration(..), Expr(..), Guarded(..), LetBinding, LineFeed, Module, SourceToken, Where(..))

21+

22+-- | Rule: let x = y in z -> do let x = y; z

23+-- | Suggests replacing let...in expressions with do notation

24+letToDoRule :: Rule

25+letToDoRule = mkRule (RuleId "LetToDo") run

26+ where

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

28+ run _ctx = foldMapModule visitor

29+ where

30+ visitor = defaultMonoidalVisitor

31+ { onDecl = checkDecl

32+ , onExpr = checkExpr

33+ }

34+

35+ checkDecl :: Declaration Void -> Array LintWarning

36+ checkDecl = case _ of

37+ -- Top-level let...in: can put do on the = line

38+ DeclValue { guarded: Unconditional eqToken (Where { expr: ExprLet letIn, bindings: Nothing }) } ->

39+ mkWarningTopLevel eqToken (ExprLet letIn)

40+ _ -> []

41+

42+ checkExpr :: Expr Void -> Array LintWarning

43+ checkExpr = case _ of

44+ -- Match any nested let...in expression

45+ e@(ExprLet _) -> mkWarningNested e

46+ _ -> []

47+

48+ mkWarningTopLevel :: SourceToken -> Expr Void -> Array LintWarning

49+ mkWarningTopLevel eqToken expr = case expr of

50+ ExprLet letIn ->

51+ let

52+ letCol = (rangeOf expr).start.column

53+ doIndent = power " " letCol

54+ letIndent = doIndent <> " "

55+

56+ bodyText = printTokensPreserveNewlines letCol letIn.body

57+ bindings = NEA.toArray letIn.bindings # map (printBindingTokens (letCol + 2))

58+ bindingsText = String.joinWith ("\n" <> letIndent) bindings

59+

60+ replacement = "= do\n" <> doIndent <> "let\n" <> letIndent <> bindingsText <> "\n" <> doIndent <> bodyText

61+ fullRange = { start: eqToken.range.start, end: (rangeOf expr).end }

62+ in

63+ [ LintWarning

64+ { ruleId: RuleId "LetToDo"

65+ , message: WarningMessage "let...in can be written using do notation"

66+ , range: fullRange

67+ , severity: Refactor

68+ , suggestion: Just $ Suggestion

69+ { replacement: ReplacementText replacement

70+ , description: SuggestionDescription "Convert to do notation"

71+ }

72+ }

73+ ]

74+ _ -> []

75+

76+ mkWarningNested :: Expr Void -> Array LintWarning

77+ mkWarningNested expr = case expr of

78+ ExprLet letIn ->

79+ let

80+ letCol = (rangeOf expr).start.column

81+ doIndent = power " " letCol

82+ letIndent = doIndent <> " "

83+

84+ bodyText = printTokensPreserveNewlines letCol letIn.body

85+ bindings = NEA.toArray letIn.bindings # map (printBindingTokens (letCol + 2))

86+ bindingsText = String.joinWith ("\n" <> letIndent) bindings

87+

88+ -- Check if let is on its own line (has Line in leading comments)

89+ hasNewlineBefore = Array.any isLine letIn.keyword.leadingComments

90+

91+ exprRange = rangeOf expr

92+ letLine = exprRange.start.line

93+

94+ -- If let is on its own line, extend range back to end of previous line

95+ -- and put " do" there, then newline + the do block

96+ range /\ replacement =

97+ if hasNewlineBefore && letLine > 0 then

98+ -- Start range at end of previous line (column 9999 will be clamped to EOL)

99+ { start: { line: letLine - 1, column: 9999 }, end: exprRange.end }

100+ /\ (" do\n" <> doIndent <> "let\n" <> letIndent <> bindingsText <> "\n" <> doIndent <> bodyText)

101+ else

102+ -- let is inline or on first line, just replace with do block

103+ exprRange

104+ /\ ("do\n" <> doIndent <> "let\n" <> letIndent <> bindingsText <> "\n" <> doIndent <> bodyText)

105+ in

106+ [ LintWarning

107+ { ruleId: RuleId "LetToDo"

108+ , message: WarningMessage "let...in can be written using do notation"

109+ , range

110+ , severity: Refactor

111+ , suggestion: Just $ Suggestion

112+ { replacement: ReplacementText replacement

113+ , description: SuggestionDescription "Convert to do notation"

114+ }

115+ }

116+ ]

117+ _ -> []

118+

119+ isLine :: Comment LineFeed -> Boolean

120+ isLine (Line _ _) = true

121+ isLine _ = false

122+

123+ printTokensPreserveNewlines :: Int -> Expr Void -> String

124+ printTokensPreserveNewlines targetCol e =

125+ let bodyCol = (rangeOf e).start.column

126+ shiftAmount = targetCol - bodyCol

127+ in Str.trim $ foldMap (printSourceToken shiftAmount) (TokenList.toArray (tokensOf e))

128+

129+ printBindingTokens :: Int -> LetBinding Void -> String

130+ printBindingTokens targetCol b =

131+ let bindingCol = (rangeOf b).start.column

132+ shiftAmount = (targetCol + 2) - bindingCol

133+ in Str.trim $ foldMap (printSourceToken shiftAmount) (TokenList.toArray (tokensOf b))

134+

135+ printSourceToken :: Int -> SourceToken -> String

136+ printSourceToken shiftAmount tok =

137+ foldMap (printLeadingComment shiftAmount) tok.leadingComments

138+ <> printToken tok.value

139+ <> foldMap printTrailingComment tok.trailingComments

140+

141+ printLeadingComment :: Int -> Comment LineFeed -> String

142+ printLeadingComment shiftAmount = case _ of

143+ Comment str -> str

144+ Space n -> power " " (max 0 (n + shiftAmount))

145+ Line _ n -> "\n" <> power " " (max 0 (n + shiftAmount))

146+

147+ printTrailingComment :: Comment Void -> String

148+ printTrailingComment = case _ of

149+ Comment str -> str

150+ Space n -> power " " n

151+ Line v _ -> absurd v

lib/purelint/src/Purelint/Rules/LetToWhere.purs+71−28

@@ -2,71 +2,114 @@ module Purelint.Rules.LetToWhere where

33import Prelude

5+import Data.Array as Array

56import Data.Array.NonEmpty as NEA

67import Data.Foldable (foldMap)

78import Data.Maybe (Maybe(..))

89import Data.Monoid (power)

910import Data.String (joinWith) as String

1011import Data.String as Str

12+import Data.Tuple.Nested ((/\))

1113import Purelint.Rule (Rule, RuleContext, mkRule)

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

1315import PureScript.CST.Print (printToken)

14−import PureScript.CST.Range (rangeOf, tokensOf)

16+import PureScript.CST.Range (class RangeOf, rangeOf, tokensOf)

1517import PureScript.CST.Range.TokenList as TokenList

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

17−import PureScript.CST.Types (Comment(..), Expr(..), LetBinding, Module, SourceToken)

19+import PureScript.CST.Types (Comment(..), Declaration(..), Expr(..), Guarded(..), LetBinding, LineFeed, Module, SourceToken, Where(..))

1820

1921-- | Rule: let x = y in z -> z where x = y

2022-- | Suggests replacing let...in expressions with where clauses

23+-- | When there's an existing where clause, appends to it instead of creating a new one

2124letToWhereRule :: Rule

2225letToWhereRule = mkRule (RuleId "LetToWhere") run

2326 where

2427 run :: RuleContext -> Module Void -> Array LintWarning

2528 run _ctx = foldMapModule visitor

2629 where

27− visitor = defaultMonoidalVisitor { onExpr = checkExpr }

30+ visitor = defaultMonoidalVisitor { onDecl = checkDecl }

2831

29− checkExpr :: Expr Void -> Array LintWarning

30− checkExpr expr = case expr of

32+ checkDecl :: Declaration Void -> Array LintWarning

33+ checkDecl = case _ of

34+ -- No existing where clause - create one

35+ DeclValue { guarded: Unconditional _ wh@(Where { expr: ExprLet letIn, bindings: Nothing }) } ->

36+ mkWarning wh (ExprLet letIn) Nothing

37+ -- Existing where clause - append to it

38+ DeclValue { guarded: Unconditional _ wh@(Where { expr: ExprLet letIn, bindings: Just existingBindings }) } ->

39+ mkWarning wh (ExprLet letIn) (Just existingBindings)

40+ _ -> []

41+

42+ mkWarning :: Where Void -> Expr Void -> Maybe _ -> Array LintWarning

43+ mkWarning wh expr existingBindings = case expr of

3144 ExprLet letIn ->

3245 let

33− bodyText = printTokens letIn.body

34− bindings = NEA.toArray letIn.bindings # map printBindingTokens

35− bindingsText = String.joinWith "\n " bindings

36− replacement = bodyText <> "\n where\n " <> bindingsText

46+ -- Target indent is where the let expression starts

47+ targetCol = (rangeOf expr).start.column

48+ targetIndent = power " " targetCol

49+ -- Body's current indent (where the body expression starts)

50+ bodyCol = (rangeOf letIn.body).start.column

51+ -- Shift amount: how much to adjust indentation

52+ shiftAmount = targetCol - bodyCol

53+

54+ bodyText = printTokensPreserveNewlines shiftAmount letIn.body

55+ newBindings = NEA.toArray letIn.bindings # map (printBindingTokens targetCol)

56+ newBindingsText = String.joinWith ("\n" <> targetIndent) newBindings

57+

58+ replacement /\ range = case existingBindings of

59+ Nothing ->

60+ -- No existing where - just replace the let expr

61+ (bodyText <> "\n" <> targetIndent <> "where\n" <> targetIndent <> newBindingsText) /\ rangeOf expr

62+ Just (_ /\ existingArr) ->

63+ -- Has existing where - replace from let to end of where bindings

64+ let

65+ existingTexts = NEA.toArray existingArr # map (printBindingTokens targetCol)

66+ allBindingsText = String.joinWith ("\n" <> targetIndent) (newBindings <> existingTexts)

67+ lastBinding = NEA.last existingArr

68+ fullRange = { start: (rangeOf expr).start, end: (rangeOf lastBinding).end }

69+ in

70+ (bodyText <> "\n" <> targetIndent <> "where\n" <> targetIndent <> allBindingsText) /\ fullRange

3771 in

3872 [ LintWarning

3973 { ruleId: RuleId "LetToWhere"

4074 , message: WarningMessage "Use where clause instead of let...in"

41− , range: rangeOf expr

42− , severity: Hint

75+ , range: range

76+ , severity: Refactor

4377 , suggestion: Just $ Suggestion

4478 { replacement: ReplacementText replacement

45− , description: SuggestionDescription "let x = y in z can be rewritten as z where x = y"

79+ , description: SuggestionDescription "Convert to where clause"

4680 }

4781 }

4882 ]

4983 _ -> []

5084

51− -- | Print tokens preserving spaces but collapsing newlines to single space

52− printTokens :: Expr Void -> String

53− printTokens e =

54− Str.trim $ foldMap printSourceTokenWithSpaces (TokenList.toArray (tokensOf e))

85+ -- | Print tokens preserving newlines and adjusting indentation by shiftAmount

86+ printTokensPreserveNewlines :: Int -> Expr Void -> String

87+ printTokensPreserveNewlines shiftAmount e =

88+ Str.trim $ foldMap (printSourceToken shiftAmount) (TokenList.toArray (tokensOf e))

5589

56− printBindingTokens :: LetBinding Void -> String

57− printBindingTokens b =

58− Str.trim $ foldMap printSourceTokenWithSpaces (TokenList.toArray (tokensOf b))

90+ printBindingTokens :: Int -> LetBinding Void -> String

91+ printBindingTokens targetCol b =

92+ let bindingCol = (rangeOf b).start.column

93+ shiftAmount = targetCol - bindingCol

94+ in Str.trim $ foldMap (printSourceToken shiftAmount) (TokenList.toArray (tokensOf b))

5995

60− -- | Print a source token, keeping spaces but converting newlines to spaces

61− printSourceTokenWithSpaces :: SourceToken -> String

62− printSourceTokenWithSpaces tok =

63− foldMap printCommentSpacesOnly tok.leadingComments

96+ -- | Print a source token, preserving newlines and adjusting indentation

97+ printSourceToken :: Int -> SourceToken -> String

98+ printSourceToken shiftAmount tok =

99+ foldMap (printLeadingComment shiftAmount) tok.leadingComments

64100 <> printToken tok.value

65− <> foldMap printCommentSpacesOnly tok.trailingComments

101+ <> foldMap printTrailingComment tok.trailingComments

102+

103+ -- | Print leading comment (has LineFeed), preserving newlines and adjusting indentation

104+ printLeadingComment :: Int -> Comment LineFeed -> String

105+ printLeadingComment shiftAmount = case _ of

106+ Comment str -> str

107+ Space n -> power " " (max 0 (n + shiftAmount))

108+ Line _ n -> "\n" <> power " " (max 0 (n + shiftAmount))

66109

67− -- | Print comment, keeping spaces but skipping newlines

68− printCommentSpacesOnly :: forall l. Comment l -> String

69− printCommentSpacesOnly = case _ of

110+ -- | Print trailing comment (has Void, so Line is impossible)

111+ printTrailingComment :: Comment Void -> String

112+ printTrailingComment = case _ of

70113 Comment str -> str

71114 Space n -> power " " n

72− Line _ _ -> " "

115+ Line v _ -> absurd v

lib/purelint/src/Purelint/Rules/MapFusion.purs+49−50

@@ -29,18 +29,14 @@ mapFusionRule = mkRule (RuleId "MapFusion") run

2929 checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

3030 checkExpr imports expr = case expr of

3131 -- Match: map f (map g x)

32− ExprApp fnExpr args ->

33− case fnExpr of

34− ExprIdent qn | isMap imports qn ->

35− -- Check if we have at least 2 args and the second is map g x

36− case NEA.toArray args of

37− [AppTerm fExpr, AppTerm innerExpr] ->

38− checkInnerMap imports expr fExpr (unwrapParens innerExpr)

39− _ -> []

40− _ -> []

32+ ExprApp (ExprIdent qn) args

33+ | isMap imports qn

34+ , [AppTerm fExpr, AppTerm innerExpr] <- NEA.toArray args ->

35+ checkInnerMap imports expr fExpr (unwrapParens innerExpr)

4136 -- Match: f <$> (g <$> x) or f <$> g <$> x

42− ExprOp fExpr ops | NEA.length ops >= 1 ->

43− checkOpChain imports expr fExpr (NEA.toArray ops)

37+ ExprOp fExpr ops

38+ | NEA.length ops >= 1 ->

39+ checkOpChain imports expr fExpr (NEA.toArray ops)

4440 _ -> []

4541

4642 unwrapParens :: Expr Void -> Expr Void

@@ -51,17 +47,15 @@ mapFusionRule = mkRule (RuleId "MapFusion") run

5147 checkInnerMap :: ImportInfo -> Expr Void -> Expr Void -> Expr Void -> Array LintWarning

5248 checkInnerMap imports fullExpr fExpr innerExpr =

5349 case innerExpr of

54− ExprApp mapFn innerArgs | isMapApp imports mapFn ->

55− case NEA.toArray innerArgs of

56− [AppTerm gExpr, AppTerm xExpr] ->

50+ ExprApp mapFn innerArgs

51+ | isMapApp imports mapFn

52+ , [AppTerm gExpr, AppTerm xExpr] <- NEA.toArray innerArgs ->

5753 mkFusionWarning fullExpr fExpr gExpr xExpr "map"

58− _ -> []

5954 -- Also check: map f (g <$> x)

60− ExprOp gExpr innerOps ->

61− case NEA.toArray innerOps of

62− [Tuple qn xExpr] | isMapOp imports qn ->

55+ ExprOp gExpr innerOps

56+ | [Tuple qn xExpr] <- NEA.toArray innerOps

57+ , isMapOp imports qn ->

6358 mkFusionWarning fullExpr fExpr gExpr xExpr "map"

64− _ -> []

6559 _ -> []

6660

6761 -- Check operator form: f <$> (g <$> x) or f <$> g <$> x

@@ -69,40 +63,45 @@ mapFusionRule = mkRule (RuleId "MapFusion") run

6963 checkOpChain imports fullExpr fExpr ops =

7064 case ops of

7165 -- f <$> (g <$> x) - inner is parenthesized

72− [Tuple op1 innerExpr] | isMapOp imports op1 ->

73− case unwrapParens innerExpr of

74− ExprOp gExpr innerOps ->

75− case NEA.toArray innerOps of

76− [Tuple op2 xExpr] | isMapOp imports op2 ->

77− mkFusionWarning fullExpr fExpr gExpr xExpr "<$>"

78− _ -> []

79− ExprApp mapFn innerArgs | isMapApp imports mapFn ->

80− case NEA.toArray innerArgs of

81− [AppTerm gExpr, AppTerm xExpr] ->

82− mkFusionWarning fullExpr fExpr gExpr xExpr "<$>"

83− _ -> []

84− _ -> []

66+ [Tuple op1 innerExpr]

67+ | isMapOp imports op1 ->

68+ checkInnerOpExpr imports fullExpr fExpr (unwrapParens innerExpr)

8569 -- x <#> g <#> f - flipped map chain

86− [Tuple op1 gExpr, Tuple op2 fExpr'] | isFlippedMapOp imports op1 && isFlippedMapOp imports op2 ->

87− let

88− x = printExpr fExpr -- fExpr is actually x in this case

89− g = printExpr gExpr

90− f = printExpr fExpr'

91− replacement = x <> " <#> (" <> g <> " >>> " <> f <> ")"

92− in

93− [ LintWarning

94− { ruleId: RuleId "MapFusion"

95− , message: WarningMessage "Fuse nested maps using composition"

96− , range: rangeOf fullExpr

97− , severity: Hint

98− , suggestion: Just $ Suggestion

99− { replacement: ReplacementText replacement

100− , description: SuggestionDescription "x <#> g <#> f can be replaced with x <#> (g >>> f)"

70+ [Tuple op1 gExpr, Tuple op2 fExpr']

71+ | isFlippedMapOp imports op1

72+ , isFlippedMapOp imports op2 ->

73+ let

74+ x = printExpr fExpr -- fExpr is actually x in this case

75+ g = printExpr gExpr

76+ f = printExpr fExpr'

77+ replacement = x <> " <#> (" <> g <> " >>> " <> f <> ")"

78+ in

79+ [ LintWarning

80+ { ruleId: RuleId "MapFusion"

81+ , message: WarningMessage "Fuse nested maps using composition"

82+ , range: rangeOf fullExpr

83+ , severity: Hint

84+ , suggestion: Just $ Suggestion

85+ { replacement: ReplacementText replacement

86+ , description: SuggestionDescription "x <#> g <#> f can be replaced with x <#> (g >>> f)"

87+ }

10188 }

102− }

103− ]

89+ ]

10490 _ -> []

10591

92+ -- Helper: check the inner expression of f <$> (...)

93+ checkInnerOpExpr :: ImportInfo -> Expr Void -> Expr Void -> Expr Void -> Array LintWarning

94+ checkInnerOpExpr imports fullExpr fExpr inner = case inner of

95+ ExprOp gExpr innerOps

96+ | [Tuple op2 xExpr] <- NEA.toArray innerOps

97+ , isMapOp imports op2 ->

98+ mkFusionWarning fullExpr fExpr gExpr xExpr "<$>"

99+ ExprApp mapFn innerArgs

100+ | isMapApp imports mapFn

101+ , [AppTerm gExpr, AppTerm xExpr] <- NEA.toArray innerArgs ->

102+ mkFusionWarning fullExpr fExpr gExpr xExpr "<$>"

103+ _ -> []

104+

106105 mkFusionWarning :: Expr Void -> Expr Void -> Expr Void -> Expr Void -> String -> Array LintWarning

107106 mkFusionWarning fullExpr fExpr gExpr xExpr style =

108107 let

@@ -131,7 +130,7 @@ mapFusionRule = mkRule (RuleId "MapFusion") run

131130

132131 isMap :: ImportInfo -> QualifiedName Ident -> Boolean

133132 isMap imports (QualifiedName { name: Ident name }) =

134− (name == "map" && hasValue imports "map") || (name == "fmap" && hasValue imports "fmap")

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

135134

136135 isMapOp :: ImportInfo -> QualifiedName Operator -> Boolean

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

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

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

1+module Purelint.Rules.MapIdentity 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, hasOp)

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(..), Expr(..), Ident(..), Module, Operator(..), QualifiedName(..))

17+

18+-- | Rule: map identity x -> x

19+-- | Also: identity <$> x -> x, x <#> identity -> x

20+mapIdentityRule :: Rule

21+mapIdentityRule = run # mkRule (RuleId "MapIdentity")

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: map identity x

32+ ExprApp (ExprIdent qn) args

33+ | qn # isMap imports

34+ , [ AppTerm idExpr, AppTerm xExpr ] <- NEA.toArray args

35+ , idExpr # isIdentity imports ->

36+ [ LintWarning

37+ { ruleId: RuleId "MapIdentity"

38+ , message: WarningMessage "map identity is redundant"

39+ , range: rangeOf expr

40+ , severity: Warning

41+ , suggestion: Just $ Suggestion

42+ { replacement: ReplacementText (printExpr xExpr)

43+ , description: SuggestionDescription "map identity x can be simplified to x"

44+ }

45+ }

46+ ]

47+ -- Match: identity <$> x

48+ ExprOp lhs ops

49+ | isIdentity imports lhs

50+ , [ Tuple qn xExpr ] <- NEA.toArray ops

51+ , isMapOp imports qn ->

52+ [ LintWarning

53+ { ruleId: RuleId "MapIdentity"

54+ , message: WarningMessage "identity <$> is redundant"

55+ , range: rangeOf expr

56+ , severity: Warning

57+ , suggestion: Just $ Suggestion

58+ { replacement: ReplacementText (printExpr xExpr)

59+ , description: SuggestionDescription "identity <$> x can be simplified to x"

60+ }

61+ }

62+ ]

63+ -- Match: x <#> identity

64+ ExprOp lhs ops

65+ | [ Tuple qn idExpr ] <- NEA.toArray ops

66+ , isFlippedMapOp imports qn

67+ , isIdentity imports idExpr ->

68+ [ LintWarning

69+ { ruleId: RuleId "MapIdentity"

70+ , message: WarningMessage "<#> identity is redundant"

71+ , range: rangeOf expr

72+ , severity: Warning

73+ , suggestion: Just $ Suggestion

74+ { replacement: ReplacementText (printExpr lhs)

75+ , description: SuggestionDescription "x <#> identity can be simplified to x"

76+ }

77+ }

78+ ]

79+ _ -> []

80+

81+ isMap :: ImportInfo -> QualifiedName Ident -> Boolean

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

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

84+

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

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

87+ (op == "<$>" || op == "<$$>") && hasOp imports "<$>"

88+

89+ isFlippedMapOp :: ImportInfo -> QualifiedName Operator -> Boolean

90+ isFlippedMapOp imports (QualifiedName { name: Operator op }) =

91+ (op == "<#>" || op == "<##>") && hasOp imports "<#>"

92+

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

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

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

96+ isIdentity _ _ = false

lib/purelint/src/Purelint/Rules/MonadLaw.pursnew file+97

@@ -0,0 +1,97 @@

1+module Purelint.Rules.MonadLaw where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

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

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

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

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(..))

15+

16+-- | Monad law rules:

17+-- | - m >>= pure -> m (right identity, covered by RedundantBind)

18+-- | - pure a >>= f -> f a (left identity, covered by RedundantBind)

19+-- | - f =<< pure a -> f a (left identity, flipped)

20+-- | - pure =<< m -> m (right identity, flipped)

21+monadLawRule :: Rule

22+monadLawRule = mkRule (RuleId "MonadLaw") 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: f =<< pure a

33+ ExprOp lhs ops ->

34+ case NEA.toArray ops of

35+ [Tuple (QualifiedName { name: Operator op }) rhs]

36+ | op == "=<<" && hasOp imports ">>=" -> checkFlippedBind imports expr lhs rhs

37+ _ -> []

38+ _ -> []

39+

40+ checkFlippedBind :: ImportInfo -> Expr Void -> Expr Void -> Expr Void -> Array LintWarning

41+ checkFlippedBind imports fullExpr f m =

42+ -- f =<< pure a -> f a

43+ case getPureArg imports m of

44+ Just arg ->

45+ let replacement = printExpr f <> " " <> wrapIfNeeded arg

46+ in

47+ [ LintWarning

48+ { ruleId: RuleId "MonadLaw"

49+ , message: WarningMessage "Monad law: f =<< pure a simplifies to f a"

50+ , range: rangeOf fullExpr

51+ , severity: Warning

52+ , suggestion: Just $ Suggestion

53+ { replacement: ReplacementText replacement

54+ , description: SuggestionDescription "Apply f directly to a (left identity)"

55+ }

56+ }

57+ ]

58+ Nothing ->

59+ -- pure =<< m -> m

60+ if isPure imports f then

61+ [ LintWarning

62+ { ruleId: RuleId "MonadLaw"

63+ , message: WarningMessage "Monad law: pure =<< m simplifies to m"

64+ , range: rangeOf fullExpr

65+ , severity: Warning

66+ , suggestion: Just $ Suggestion

67+ { replacement: ReplacementText (printExpr m)

68+ , description: SuggestionDescription "pure =<< m is just m (right identity)"

69+ }

70+ }

71+ ]

72+ else []

73+

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

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

76+ (name == "pure" && hasValue imports "pure") || (name == "return" && hasValue imports "pure")

77+ isPure _ _ = false

78+

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

86+

87+ wrapIfNeeded :: Expr Void -> String

88+ wrapIfNeeded e = case e of

89+ ExprIdent _ -> printExpr e

90+ ExprInt _ _ -> printExpr e

91+ ExprNumber _ _ -> printExpr e

92+ ExprString _ _ -> printExpr e

93+ ExprChar _ _ -> printExpr e

94+ ExprArray _ -> printExpr e

95+ ExprRecord _ -> printExpr e

96+ ExprParens _ -> printExpr e

97+ _ -> "(" <> printExpr e <> ")"

lib/purelint/src/Purelint/Rules/UseAll.purs+1−1

@@ -64,5 +64,5 @@ useAllRule = mkRule (RuleId "UseAll") run

6464

6565 isMapLike :: ImportInfo -> Expr Void -> Boolean

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

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

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

6868 isMapLike _ _ = false

lib/purelint/src/Purelint/Rules/UseAny.purs+22−29

@@ -25,32 +25,25 @@ useAnyRule = mkRule (RuleId "UseAny") run

2525

2626 checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

2727 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− _ -> []

28+ ExprApp fnExpr args

29+ | isOr imports fnExpr

30+ , [ AppTerm innerExpr ] <- NEA.toArray args

31+ , ExprApp mapFn mapArgs <- unwrapParens innerExpr

32+ , isMapLike imports mapFn

33+ , [ AppTerm fExpr, AppTerm xExpr ] <- NEA.toArray mapArgs -> do

34+ let fText = printExpr fExpr

35+ let xText = printExpr xExpr

36+ [ LintWarning

37+ { ruleId: RuleId "UseAny"

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

39+ , range: rangeOf expr

40+ , severity: Warning

41+ , suggestion: Just $ Suggestion

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

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

44+ }

45+ }

46+ ]

5447 _ -> []

5548

5649 unwrapParens :: Expr Void -> Expr Void

@@ -58,11 +51,11 @@ useAnyRule = mkRule (RuleId "UseAny") run

5851 unwrapParens e = e

5952

6053 isOr :: ImportInfo -> Expr Void -> Boolean

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

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

6255 name == "or" && hasValue imports "or"

6356 isOr _ _ = false

6457

6558 isMapLike :: ImportInfo -> Expr Void -> Boolean

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

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

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

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

6861 isMapLike _ _ = false

lib/purelint/src/Purelint/Rules/UseApplicative.purs+20−28

@@ -16,7 +16,7 @@ import PureScript.CST.Types (AppSpine(..), Expr(..), Ident(..), Module, Operator

1616

1717-- | Rule: pure f <*> x -> f <$> x

1818useApplicativeRule :: Rule

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

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

2020 where

2121 run :: RuleContext -> Module Void -> Array LintWarning

2222 run ctx = foldMapModule visitor

@@ -26,34 +26,26 @@ useApplicativeRule = mkRule (RuleId "UseApplicative") run

2626

2727 checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

2828 checkExpr imports expr = case expr of

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

3029 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− _ -> []

30+ | hasOp imports "<*>"

31+ , ExprApp pureExpr args <- unwrapParens lhs

32+ , isPure imports pureExpr

33+ , [ AppTerm fExpr ] <- NEA.toArray args

34+ , [ Tuple (QualifiedName { name: Operator "<*>" }) xExpr ] <- NEA.toArray ops -> do

35+ let

36+ f = printExpr fExpr

37+ x = printExpr xExpr

38+ [ LintWarning

39+ { ruleId: RuleId "UseApplicative"

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

41+ , range: rangeOf expr

42+ , severity: Hint

43+ , suggestion: Just $ Suggestion

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

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

46+ }

47+ }

48+ ]

5749 _ -> []

5850

5951 unwrapParens :: Expr Void -> Expr Void

lib/purelint/src/Purelint/Rules/UseApplyFlipped.pursnew file+55

@@ -0,0 +1,55 @@

1+module Purelint.Rules.UseApplyFlipped where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

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

7+import Data.Void (Void)

8+import Purelint.Print (printExprNoComments)

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(..), Module, Wrapped(..))

14+

15+-- | Rule: f arg -> arg # f (when f is complex like a lambda or partial application)

16+-- | Suggests using # for better readability when the function is more complex than the argument

17+useApplyFlippedRule :: Rule

18+useApplyFlippedRule = mkRule (RuleId "UseApplyFlipped") run

19+ where

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

21+ run _ctx = foldMapModule visitor

22+ where

23+ visitor = defaultMonoidalVisitor { onExpr = checkExpr }

24+

25+ checkExpr :: Expr Void -> Array LintWarning

26+ checkExpr expr = case expr of

27+ -- Match: f arg1 arg2 --> arg2 # f arg1

28+ -- Triggers for any 2-arg application

29+ ExprApp fn args

30+ | [AppTerm firstArg, AppTerm lastArg] <- NEA.toArray args

31+ -> let

32+ fnText = printExprNoComments fn

33+ -- For lambdas, unwrap parens so we get `\x -> ...` not `(\x -> ...)`

34+ firstArgText = case unwrapParens firstArg of

35+ l@(ExprLambda _) -> printExprNoComments l

36+ _ -> printExprNoComments firstArg

37+ lastArgText = printExprNoComments lastArg

38+ replacement = lastArgText <> " # " <> fnText <> " " <> firstArgText

39+ in

40+ [ LintWarning

41+ { ruleId: RuleId "UseApplyFlipped"

42+ , message: WarningMessage "Consider using # for better readability"

43+ , range: rangeOf expr

44+ , severity: Refactor

45+ , suggestion: Just $ Suggestion

46+ { replacement: ReplacementText replacement

47+ , description: SuggestionDescription ("Rewrite as: " <> replacement)

48+ }

49+ }

50+ ]

51+ _ -> []

52+

53+ unwrapParens :: Expr Void -> Expr Void

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

55+ unwrapParens e = e

lib/purelint/src/Purelint/Rules/UseBimap.purs+122−124

@@ -30,154 +30,152 @@ useBimapRule = mkRule (RuleId "UseBimap") run

3030 -- Match: bimap id g or bimap f id

3131 ExprApp fn args

3232 | isBimap imports fn ->

33− case NEA.toArray args of

34− [AppTerm fArg, AppTerm gArg] ->

35− let fIsId = isIdentity imports fArg

33+ case NEA.toArray args of

34+ [ AppTerm fArg, AppTerm gArg ] ->

35+ let

36+ fIsId = isIdentity imports fArg

3637 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

38+ in

39+ if fIsId && not gIsId then

40+ let

41+ g = printExpr gArg

42+ in

43+ [ LintWarning

44+ { ruleId: RuleId "UseBimap"

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

46+ , range: rangeOf expr

47+ , severity: Warning

48+ , suggestion: Just $ Suggestion

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

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

51+ }

52+ }

53+ ]

54+ else if gIsId && not fIsId then

55+ let

56+ f = printExpr fArg

57+ in

58+ [ LintWarning

59+ { ruleId: RuleId "UseBimap"

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

61+ , range: rangeOf expr

62+ , severity: Warning

63+ , suggestion: Just $ Suggestion

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

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

66+ }

67+ }

68+ ]

69+ else if fIsId && gIsId then

5570 [ LintWarning

5671 { ruleId: RuleId "UseBimap"

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

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

5873 , range: rangeOf expr

5974 , severity: Warning

6075 , suggestion: Just $ Suggestion

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

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

76+ { replacement: ReplacementText "identity"

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

6378 }

6479 }

6580 ]

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+ else []

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

83+ let

84+ fIsId = isIdentity imports fArg

8185 gIsId = isIdentity imports gArg

8286 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

87+ in

88+ if fIsId && not gIsId then

89+ let

90+ g = printExpr gArg

91+ in

92+ [ LintWarning

93+ { ruleId: RuleId "UseBimap"

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

95+ , range: rangeOf expr

96+ , severity: Warning

97+ , suggestion: Just $ Suggestion

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

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

100+ }

101+ }

102+ ]

103+ else if gIsId && not fIsId then

104+ let

105+ f = printExpr fArg

106+ in

107+ [ LintWarning

108+ { ruleId: RuleId "UseBimap"

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

110+ , range: rangeOf expr

111+ , severity: Warning

112+ , suggestion: Just $ Suggestion

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

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

115+ }

116+ }

117+ ]

118+ else if fIsId && gIsId then

101119 [ LintWarning

102120 { ruleId: RuleId "UseBimap"

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

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

104122 , range: rangeOf expr

105123 , severity: Warning

106124 , suggestion: Just $ Suggestion

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

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

125+ { replacement: ReplacementText x

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

109127 }

110128 }

111129 ]

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− _ -> []

130+ else []

131+ _ -> []

126132 -- Match: first f (second g x) or second g (first f x)

127133 | 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− }

134+ case NEA.toArray args of

135+ [ AppTerm fArg, AppTerm innerArg ]

136+ | ExprApp secondFn secondArgs <- unwrapParens innerArg

137+ , isSecond imports secondFn

138+ , [ AppTerm gArg, AppTerm xArg ] <- NEA.toArray secondArgs ->

139+ let

140+ f = printExpr fArg

141+ g = printExpr gArg

142+ x = printExpr xArg

143+ in

144+ [ LintWarning

145+ { ruleId: RuleId "UseBimap"

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

147+ , range: rangeOf expr

148+ , severity: Hint

149+ , suggestion: Just $ Suggestion

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

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

149152 }

150− ]

151− _ -> []

152− _ -> []

153− _ -> []

153+ }

154+ ]

155+ _ -> []

154156 | 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− }

157+ case NEA.toArray args of

158+ [ AppTerm gArg, AppTerm innerArg ]

159+ | ExprApp firstFn firstArgs <- unwrapParens innerArg

160+ , isFirst imports firstFn

161+ , [ AppTerm fArg, AppTerm xArg ] <- NEA.toArray firstArgs ->

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"

176175 }

177− ]

178− _ -> []

179− _ -> []

180− _ -> []

176+ }

177+ ]

178+ _ -> []

181179 _ -> []

182180

183181 unwrapParens :: Expr Void -> Expr Void

lib/purelint/src/Purelint/Rules/UseBindFlip.purs+17−22

@@ -25,13 +25,10 @@ useBindFlipRule = mkRule (RuleId "UseBindFlip") run

2525

2626 checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

2727 checkExpr imports expr = case expr of

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

2928 ExprApp fnExpr args

30− | isJoin imports fnExpr ->

31− case NEA.toArray args of

32− [AppTerm innerExpr] ->

33− checkInnerMap imports expr (unwrapParens innerExpr)

34− _ -> []

29+ | isJoin imports fnExpr

30+ , [ AppTerm innerExpr ] <- NEA.toArray args ->

31+ checkInnerMap imports expr (unwrapParens innerExpr)

3532 _ -> []

3633

3734 unwrapParens :: Expr Void -> Expr Void

@@ -41,25 +38,23 @@ useBindFlipRule = mkRule (RuleId "UseBindFlip") run

4138 checkInnerMap :: ImportInfo -> Expr Void -> Expr Void -> Array LintWarning

4239 checkInnerMap imports fullExpr innerExpr =

4340 case innerExpr of

44− ExprApp mapFn mapArgs | isMap imports mapFn ->

45− case NEA.toArray mapArgs of

46− [AppTerm fExpr, AppTerm xExpr] ->

41+ ExprApp mapFn mapArgs

42+ | isMap imports mapFn

43+ , [ AppTerm fExpr, AppTerm xExpr ] <- NEA.toArray mapArgs -> do

4744 let

4845 f = printExpr fExpr

4946 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− _ -> []

47+ [ LintWarning

48+ { ruleId: RuleId "UseBindFlip"

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

50+ , range: rangeOf fullExpr

51+ , severity: Warning

52+ , suggestion: Just $ Suggestion

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

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

55+ }

56+ }

57+ ]

6358 _ -> []

6459

6560 isJoin :: ImportInfo -> Expr Void -> Boolean

lib/purelint/src/Purelint/Rules/UseCaseOf.pursnew file+169

@@ -0,0 +1,169 @@

1+module Purelint.Rules.UseCaseOf where

3+import Prelude

5+import Data.Array as Array

6+import Data.Array.NonEmpty as NEA

7+import Data.Foldable (foldMap)

8+import Data.Maybe (Maybe(..))

9+import Data.Monoid (power)

10+import Data.Newtype (un)

11+import Data.String as String

12+import Data.Tuple (Tuple(..), snd)

13+import Data.Tuple.Nested ((/\))

14+import Data.Void (Void)

15+import Purelint.Print (printBinder, printExpr)

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

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

18+import PureScript.CST.Range (rangeOf)

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

20+import PureScript.CST.Types (Binder(..), Declaration(..), Guarded(..), GuardedExpr(..), Ident(..), LetBinding(..), Module(..), ModuleBody(..), Name(..), ValueBindingFields, Where(..))

21+

22+-- | Rule: Functions with multiple clauses where the name repeats can use case _ of

23+-- |

24+-- | foo x = expr1

25+-- | foo y = expr2

26+-- |

27+-- | becomes:

28+-- |

29+-- | foo = case _ of

30+-- | x -> expr1

31+-- | y -> expr2

32+useCaseOfRule :: Rule

33+useCaseOfRule = mkRule (RuleId "UseCaseOf") run

34+ where

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

36+ run _ctx mod@(Module m) =

37+ let

38+ ModuleBody body = m.body

39+ topLevelWarnings = groupByName body.decls # Array.concatMap (checkGroup 0)

40+ nestedWarnings = foldMapModule visitor mod

41+ in topLevelWarnings <> nestedWarnings

42+ where

43+ visitor = defaultMonoidalVisitor { onDecl = checkDecl }

44+

45+ -- Check where bindings in declarations

46+ checkDecl :: Declaration Void -> Array LintWarning

47+ checkDecl = case _ of

48+ DeclValue { guarded } -> checkGuarded guarded

49+ _ -> []

50+

51+ checkGuarded :: Guarded Void -> Array LintWarning

52+ checkGuarded = case _ of

53+ Unconditional _ (Where { bindings: Just (Tuple _ letBindings) }) ->

54+ checkLetBindings letBindings

55+ Guarded guards -> foldMap checkGuardedExpr (NEA.toArray guards)

56+ _ -> []

57+

58+ checkGuardedExpr :: GuardedExpr Void -> Array LintWarning

59+ checkGuardedExpr (GuardedExpr { where: Where { bindings: Just (Tuple _ letBindings) } }) =

60+ checkLetBindings letBindings

61+ checkGuardedExpr _ = []

62+

63+ checkLetBindings :: NEA.NonEmptyArray (LetBinding Void) -> Array LintWarning

64+ checkLetBindings bindings =

65+ let

66+ vbs = NEA.toArray bindings # Array.mapMaybe case _ of

67+ LetBindingName vb -> Just vb

68+ _ -> Nothing

69+ -- Get the base indentation from first binding

70+ baseCol = case Array.head vbs of

71+ Just vb -> (rangeOf (LetBindingName vb)).start.column

72+ Nothing -> 0

73+ groups = groupByNameVB vbs

74+ in groups # Array.concatMap (checkGroup baseCol)

75+

76+ -- Group consecutive DeclValue with same name (for top-level)

77+ groupByName :: Array (Declaration Void) -> Array (Array (ValueBindingFields Void))

78+ groupByName decls = go [] Nothing decls

79+ where

80+ go :: Array (Array (ValueBindingFields Void)) -> Maybe { name :: String, clauses :: Array (ValueBindingFields Void) } -> Array (Declaration Void) -> Array (Array (ValueBindingFields Void))

81+ go acc current arr = case Array.uncons arr of

82+ Nothing -> case current of

83+ Nothing -> acc

84+ Just c -> Array.snoc acc c.clauses

85+ Just { head: d, tail: rest } -> case d of

86+ DeclValue vb ->

87+ let name = getName vb

88+ in case current of

89+ Nothing -> go acc (Just { name, clauses: [vb] }) rest

90+ Just c | c.name == name -> go acc (Just { name, clauses: Array.snoc c.clauses vb }) rest

91+ Just c -> go (Array.snoc acc c.clauses) (Just { name, clauses: [vb] }) rest

92+ _ -> case current of

93+ Nothing -> go acc Nothing rest

94+ Just c -> go (Array.snoc acc c.clauses) Nothing rest

95+

96+ -- Group consecutive ValueBindingFields with same name (for where bindings)

97+ groupByNameVB :: Array (ValueBindingFields Void) -> Array (Array (ValueBindingFields Void))

98+ groupByNameVB vbs = go [] Nothing vbs

99+ where

100+ go :: Array (Array (ValueBindingFields Void)) -> Maybe { name :: String, clauses :: Array (ValueBindingFields Void) } -> Array (ValueBindingFields Void) -> Array (Array (ValueBindingFields Void))

101+ go acc current arr = case Array.uncons arr of

102+ Nothing -> case current of

103+ Nothing -> acc

104+ Just c -> Array.snoc acc c.clauses

105+ Just { head: vb, tail: rest } ->

106+ let name = getName vb

107+ in case current of

108+ Nothing -> go acc (Just { name, clauses: [vb] }) rest

109+ Just c | c.name == name -> go acc (Just { name, clauses: Array.snoc c.clauses vb }) rest

110+ Just c -> go (Array.snoc acc c.clauses) (Just { name, clauses: [vb] }) rest

111+

112+ getName :: ValueBindingFields Void -> String

113+ getName vb = case vb.name of

114+ Name { name: Ident n } -> n

115+

116+ checkGroup :: Int -> Array (ValueBindingFields Void) -> Array LintWarning

117+ checkGroup baseCol clauses

118+ | Array.length clauses < 2 = []

119+ | not (Array.all hasBindersAndUnconditional clauses) = []

120+ | otherwise = case Array.head clauses of

121+ Nothing -> []

122+ Just first ->

123+ let

124+ name = getName first

125+ numArgs = Array.length first.binders

126+ -- Check all clauses have same number of binders

127+ sameBinders = Array.all (\vb -> Array.length vb.binders == numArgs) clauses

128+ in

129+ if not sameBinders || numArgs == 0 then []

130+ else

131+ let

132+ -- Build the replacement

133+ indent = power " " baseCol

134+ wildcards = Array.replicate numArgs "_" # String.joinWith ", "

135+ caseHeader = name <> " = case " <> wildcards <> " of"

136+ caseArms = clauses # Array.mapMaybe formatClause

137+ replacement = caseHeader <> "\n" <> (caseArms # map ((indent <> " ") <> _) # String.joinWith "\n")

138+ -- Range spans from first clause to last

139+ firstRange = rangeOf (LetBindingName first)

140+ lastRange = case Array.last clauses of

141+ Just lst -> rangeOf (LetBindingName lst)

142+ Nothing -> firstRange

143+ fullRange = { start: firstRange.start, end: lastRange.end }

144+ in

145+ [ LintWarning

146+ { ruleId: RuleId "UseCaseOf"

147+ , message: WarningMessage $ "Function '" <> name <> "' has " <> show (Array.length clauses) <> " clauses - consider using case _ of"

148+ , range: fullRange

149+ , severity: Refactor

150+ , suggestion: Just $ Suggestion

151+ { replacement: ReplacementText replacement

152+ , description: SuggestionDescription "Convert to case _ of"

153+ }

154+ }

155+ ]

156+

157+ hasBindersAndUnconditional :: ValueBindingFields Void -> Boolean

158+ hasBindersAndUnconditional vb = case vb.guarded of

159+ Unconditional _ (Where { bindings: Nothing }) -> Array.length vb.binders > 0

160+ _ -> false

161+

162+ formatClause :: ValueBindingFields Void -> Maybe String

163+ formatClause vb = case vb.guarded of

164+ Unconditional _ (Where { expr, bindings: Nothing }) ->

165+ let

166+ binders = vb.binders # map printBinder # String.joinWith ", "

167+ body = printExpr expr

168+ in Just $ binders <> " -> " <> body

169+ _ -> Nothing

lib/purelint/src/Purelint/Rules/UseFoldBool.pursnew file+88

@@ -0,0 +1,88 @@

1+module Purelint.Rules.UseFoldBool where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

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

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 (AppSpine(..), Expr(..), Ident(..), Module, Operator(..), QualifiedName(..))

13+

14+-- | Fold simplification rules:

15+-- | - foldr (&&) true -> and

16+-- | - foldr (||) false -> or

17+-- | - foldl (&&) true -> and

18+-- | - foldl (||) false -> or

19+useFoldBoolRule :: Rule

20+useFoldBoolRule = mkRule (RuleId "UseFoldBool") 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: foldr f z or foldl f z

31+ ExprApp fn args

32+ | isFoldr imports fn || isFoldl imports fn ->

33+ case NEA.toArray args of

34+ [AppTerm opArg, AppTerm initArg] -> checkFoldArgs imports expr fn opArg initArg

35+ [AppTerm opArg, AppTerm initArg, _] -> checkFoldArgs imports expr fn opArg initArg

36+ _ -> []

37+ _ -> []

38+

39+ checkFoldArgs :: ImportInfo -> Expr Void -> Expr Void -> Expr Void -> Expr Void -> Array LintWarning

40+ checkFoldArgs imports fullExpr _fn opArg initArg

41+ -- foldr/foldl (&&) true -> and

42+ | isAndOp opArg && isTrue initArg && hasValue imports "and" =

43+ [ mkWarning fullExpr "foldr/foldl (&&) true" "and" ]

44+ -- foldr/foldl (||) false -> or

45+ | isOrOp opArg && isFalse initArg && hasValue imports "or" =

46+ [ mkWarning fullExpr "foldr/foldl (||) false" "or" ]

47+ | otherwise = []

48+

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

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

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

52+ isFoldr _ _ = false

53+

54+ isFoldl :: ImportInfo -> Expr Void -> Boolean

55+ isFoldl imports (ExprIdent (QualifiedName { name: Ident name })) =

56+ name == "foldl" && hasValue imports "foldl"

57+ isFoldl _ _ = false

58+

59+ isAndOp :: Expr Void -> Boolean

60+ isAndOp (ExprOpName (QualifiedName { name: Operator "&&" })) = true

61+ isAndOp (ExprIdent (QualifiedName { name: Ident "conj" })) = true

62+ isAndOp _ = false

63+

64+ isOrOp :: Expr Void -> Boolean

65+ isOrOp (ExprOpName (QualifiedName { name: Operator "||" })) = true

66+ isOrOp (ExprIdent (QualifiedName { name: Ident "disj" })) = true

67+ isOrOp _ = false

68+

69+ isTrue :: Expr Void -> Boolean

70+ isTrue (ExprBoolean _ b) = b

71+ isTrue _ = false

72+

73+ isFalse :: Expr Void -> Boolean

74+ isFalse (ExprBoolean _ b) = not b

75+ isFalse _ = false

76+

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

78+ mkWarning fullExpr pattern replacement =

79+ LintWarning

80+ { ruleId: RuleId "UseFoldBool"

81+ , message: WarningMessage $ "Use " <> replacement <> " instead of " <> pattern

82+ , range: rangeOf fullExpr

83+ , severity: Hint

84+ , suggestion: Just $ Suggestion

85+ { replacement: ReplacementText replacement

86+ , description: SuggestionDescription $ "Replace with " <> replacement

87+ }

88+ }

lib/purelint/src/Purelint/Rules/UseFoldMap.pursnew file+108

@@ -0,0 +1,108 @@

1+module Purelint.Rules.UseFoldMap 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, snd)

9+import Data.Tuple.Nested ((/\))

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(..), Guarded(..), Ident(..), Module, Name(..), Proper(..), QualifiedName(..), Separated(..), Where(..), Wrapped(..), AppSpine(..))

16+

17+-- | Rule: case mx of Nothing -> mempty; Just x -> f x --> foldMap f mx

18+-- | Also: case mx of Nothing -> ""; Just x -> f x --> foldMap f mx (String is Monoid)

19+useFoldMapRule :: Rule

20+useFoldMapRule = mkRule (RuleId "UseFoldMap") run

21+ where

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

23+ run _ctx = foldMapModule visitor

24+ where

25+ visitor = defaultMonoidalVisitor { onExpr = checkExpr }

26+

27+ checkExpr :: Expr Void -> Array LintWarning

28+ checkExpr expr = case expr of

29+ ExprCase caseOf

30+ | [scrutinee] <- separatedToArray caseOf.head

31+ , [branch1, branch2] <- NEA.toArray caseOf.branches

32+ -> checkMaybeCase expr scrutinee branch1 branch2

33+ <> checkMaybeCase expr scrutinee branch2 branch1

34+ _ -> []

35+

36+ checkMaybeCase expr scrutinee nothingBranch justBranch

37+ | isNothingBranch nothingBranch

38+ , isMemptyResult nothingBranch

39+ , Just { var, body } <- getJustBranch justBranch

40+ = let

41+ -- Check if body is `f ... var` where last arg is our variable

42+ suggestion = case body of

43+ ExprApp fn args

44+ | argsArr <- NEA.toArray args

45+ , Just (AppTerm lastArg) <- Array.last argsArr

46+ , isVar var lastArg

47+ -> let

48+ remainingArgs = Array.dropEnd 1 argsArr

49+ fnPart = if Array.null remainingArgs

50+ then wrapIfNeeded fn

51+ else "(" <> printExpr fn <> " " <> Array.intercalate " " (map printAppSpine remainingArgs) <> ")"

52+ in "foldMap " <> fnPart <> " " <> wrapIfNeeded scrutinee

53+ -- Body uses var in a more complex way, need a lambda

54+ _ -> "foldMap (\\" <> var <> " -> " <> printExpr body <> ") " <> wrapIfNeeded scrutinee

55+ in

56+ [ LintWarning

57+ { ruleId: RuleId "UseFoldMap"

58+ , message: WarningMessage "case of Nothing/Just with mempty can be simplified to foldMap"

59+ , range: rangeOf expr

60+ , severity: Warning

61+ , suggestion: Just $ Suggestion

62+ { replacement: ReplacementText suggestion

63+ , description: SuggestionDescription "Use foldMap instead of case with Nothing -> mempty"

64+ }

65+ }

66+ ]

67+ | otherwise = []

68+

69+ printAppSpine :: AppSpine Expr Void -> String

70+ printAppSpine (AppTerm e) = printExpr e

71+ printAppSpine (AppType _ _) = "@_"

72+

73+ isNothingBranch branch = case branch of

74+ (Separated { head: BinderConstructor (QualifiedName { name: Proper "Nothing" }) [] }) /\ _ -> true

75+ _ -> false

76+

77+ isMemptyResult branch = case branch of

78+ _ /\ Unconditional _ (Where { expr: e, bindings: Nothing }) -> isMempty (unwrapParens e)

79+ _ -> false

80+

81+ isMempty :: Expr Void -> Boolean

82+ isMempty (ExprIdent (QualifiedName { name: Ident "mempty" })) = true

83+ isMempty (ExprString _ "") = true -- "" is mempty for String

84+ isMempty (ExprArray (Wrapped { value: Nothing })) = true -- [] is mempty for Array

85+ isMempty _ = false

86+

87+ getJustBranch branch = case branch of

88+ (Separated { head: BinderConstructor (QualifiedName { name: Proper "Just" }) [BinderVar (Name { name: Ident var })] })

89+ /\ Unconditional _ (Where { expr: body, bindings: Nothing })

90+ -> Just { var, body }

91+ _ -> Nothing

92+

93+ isVar :: String -> Expr Void -> Boolean

94+ isVar name (ExprIdent (QualifiedName { name: Ident n })) = n == name

95+ isVar _ _ = false

96+

97+ unwrapParens :: Expr Void -> Expr Void

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

99+ unwrapParens e = e

100+

101+ wrapIfNeeded :: Expr Void -> String

102+ wrapIfNeeded e = case e of

103+ ExprIdent _ -> printExpr e

104+ ExprParens _ -> printExpr e

105+ _ -> "(" <> printExpr e <> ")"

106+

107+ separatedToArray :: forall a. Separated a -> Array a

108+ separatedToArray (Separated { head, tail }) = Array.cons head (map snd tail)

lib/purelint/src/Purelint/Rules/UsePatternGuards.pursnew file+229

@@ -0,0 +1,229 @@

1+module Purelint.Rules.UsePatternGuards where

3+import Prelude

5+import Data.Array as Array

6+import Data.Array.NonEmpty as NEA

7+import Data.Foldable (foldMap)

8+import Data.Maybe (Maybe(..))

9+import Data.Newtype (unwrap)

10+import Data.String as String

11+import Data.Tuple (Tuple(..))

12+import Data.Void (Void)

13+import PureScript.CST.Print (printSourceToken)

14+import PureScript.CST.Range (rangeOf, tokensOf)

15+import PureScript.CST.Range.TokenList as TokenList

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

17+import PureScript.CST.Types (Binder(..), Expr(..), Guarded(..), GuardedExpr(..), Module, PatternGuard(..), Separated(..), Where(..), Wrapped(..))

18+import Purelint.Print (printBinder, printExpr, printExprMultiline)

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

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

21+

22+-- | Rule: Nested case expressions with single match + fallback can use pattern guards

23+-- |

24+-- | case expr of

25+-- | Pattern1 -> case expr2 of

26+-- | Pattern2 -> result

27+-- | _ -> fallback

28+-- | _ -> fallback

29+-- |

30+-- | becomes:

31+-- |

32+-- | case expr of

33+-- | Pattern1 | Pattern2 <- expr2 -> result

34+-- | _ -> fallback

35+usePatternGuardsRule :: Rule

36+usePatternGuardsRule = mkRule (RuleId "UsePatternGuards") run

37+ where

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

39+ run _ctx = foldMapModule visitor

40+ where

41+ visitor = defaultMonoidalVisitor { onExpr = checkExpr }

42+

43+ checkExpr :: Expr Void -> Array LintWarning

44+ checkExpr expr = case expr of

45+ ExprCase caseOf ->

46+ case caseOf.head of

47+ Separated { head: scrutineeExpr } ->

48+ case NEA.head caseOf.branches of

49+ Tuple (Separated { head: firstBinder }) _ ->

50+ case analyzeNestedPatternCase (printExpr scrutineeExpr) (NEA.toArray caseOf.branches) of

51+ Just result | result.depth >= 2 ->

52+ let

53+ range = rangeOf expr

54+ -- Get indentation from where the first branch actually starts

55+ branchCol = (rangeOf firstBinder).start.column

56+ indent n = String.joinWith "" (Array.replicate n " ")

57+

58+ -- Use the original branch indentation

59+ allGuards = result.existingGuards <> result.guards

60+ guardStr = allGuards # String.joinWith ("\n" <> indent (branchCol + 2) <> ", ")

61+

62+ replacement = "case " <> result.scrutinee <> " of\n"

63+ <> indent branchCol <> result.topPattern <> "\n"

64+ <> indent (branchCol + 2) <> "| " <> guardStr <> " -> " <> String.trim result.body <> "\n"

65+ <> indent branchCol <> "_ -> " <> result.fallback

66+ in

67+ [ LintWarning

68+ { ruleId: RuleId "UsePatternGuards"

69+ , message: WarningMessage "Nested case expressions can be flattened using pattern guards"

70+ , range: range

71+ , severity: Hint

72+ , suggestion: Just $ Suggestion

73+ { replacement: ReplacementText replacement

74+ , description: SuggestionDescription $ "Use pattern guards instead of " <> show result.depth <> " nested case expressions"

75+ }

76+ }

77+ ]

78+ _ -> []

79+ _ -> []

80+

81+ -- Analyze nested case to find pattern guard opportunities

82+ analyzeNestedPatternCase

83+ :: String -- scrutinee

84+ -> Array (Tuple (Separated (Binder Void)) (Guarded Void))

85+ -> Maybe { depth :: Int, scrutinee :: String, topPattern :: String, existingGuards :: Array String, guards :: Array String, body :: String, fallback :: String }

86+ analyzeNestedPatternCase scrutinee branches = do

87+ -- Need exactly 2 branches: one match and one wildcard fallback

88+ case branches of

89+ [ branch1, branch2 ] -> do

90+ let fb1 = getFallbackBody branch1

91+ let fb2 = getFallbackBody branch2

92+ case fb1, fb2 of

93+ -- branch2 is the fallback (wildcard pattern)

94+ Nothing, Just fallback ->

95+ analyzeMatchBranch scrutinee fallback branch1

96+ -- branch1 is the fallback

97+ Just fallback, Nothing ->

98+ analyzeMatchBranch scrutinee fallback branch2

99+ _, _ -> Nothing

100+ _ -> Nothing

101+

102+ -- Check if a branch is a wildcard fallback, return its body

103+ getFallbackBody :: Tuple (Separated (Binder Void)) (Guarded Void) -> Maybe String

104+ getFallbackBody (Tuple (Separated { head: binder, tail: [] }) guarded) =

105+ if isWildcard binder then

106+ case guarded of

107+ Unconditional _ (Where { expr, bindings: Nothing }) -> Just (printExpr expr)

108+ _ -> Nothing

109+ else Nothing

110+ getFallbackBody _ = Nothing

111+

112+ isWildcard :: Binder Void -> Boolean

113+ isWildcard (BinderWildcard _) = true

114+ isWildcard _ = false

115+

116+ -- Analyze a match branch to find nested pattern structure

117+ analyzeMatchBranch

118+ :: String -- scrutinee

119+ -> String -- fallback

120+ -> Tuple (Separated (Binder Void)) (Guarded Void)

121+ -> Maybe { depth :: Int, scrutinee :: String, topPattern :: String, existingGuards :: Array String, guards :: Array String, body :: String, fallback :: String }

122+ analyzeMatchBranch scrutinee fallback (Tuple (Separated { head: pattern1, tail: [] }) guarded) =

123+ let pat1Str = printBinder pattern1

124+ in case guarded of

125+ -- Unconditional: Pattern -> nested case

126+ Unconditional _ (Where { expr, bindings: Nothing }) ->

127+ analyzeNestedExpr scrutinee fallback pat1Str [] expr

128+ -- Guarded: Pattern | guard -> nested case

129+ Guarded guardedExprs ->

130+ case NEA.toArray guardedExprs of

131+ [ GuardedExpr ge ] ->

132+ case ge.where of

133+ Where { expr, bindings: Nothing } ->

134+ let existingGuards = printPatternGuards ge.patterns

135+ in analyzeNestedExpr scrutinee fallback pat1Str existingGuards expr

136+ _ -> Nothing

137+ _ -> Nothing

138+ _ -> Nothing

139+ analyzeMatchBranch _ _ _ = Nothing

140+

141+ -- Print pattern guards back to source

142+ printPatternGuards :: Separated (PatternGuard Void) -> Array String

143+ printPatternGuards (Separated { head, tail }) =

144+ Array.cons (printPatternGuard head) (map (\(Tuple _ pg) -> printPatternGuard pg) tail)

145+

146+ printPatternGuard :: PatternGuard Void -> String

147+ printPatternGuard (PatternGuard pg) =

148+ let exprStr = foldMap printSourceToken (TokenList.toArray (tokensOf pg.expr))

149+ in case pg.binder of

150+ Nothing -> String.trim exprStr

151+ Just (Tuple binder _) -> printBinder binder <> " <- " <> String.trim exprStr

152+

153+ -- Analyze nested expression (case) to build pattern guards

154+ analyzeNestedExpr

155+ :: String -- outer scrutinee

156+ -> String -- fallback

157+ -> String -- top pattern

158+ -> Array String -- existing guards

159+ -> Expr Void -- expression to analyze

160+ -> Maybe { depth :: Int, scrutinee :: String, topPattern :: String, existingGuards :: Array String, guards :: Array String, body :: String, fallback :: String }

161+ analyzeNestedExpr scrutinee fallback pat1Str existingGuards expr = case expr of

162+ ExprCase innerCaseOf ->

163+ case innerCaseOf.head of

164+ Separated { head: innerScrutineeExpr } ->

165+ let innerScrutinee = printExpr innerScrutineeExpr

166+ in case analyzeNestedPatternCase innerScrutinee (NEA.toArray innerCaseOf.branches) of

167+ Just nested | nested.fallback == fallback ->

168+ -- Found nested case with same fallback - extend guards

169+ Just

170+ { depth: nested.depth + 1

171+ , scrutinee

172+ , topPattern: pat1Str

173+ , existingGuards

174+ , guards: Array.cons (nested.topPattern <> " <- " <> nested.scrutinee) (nested.existingGuards <> nested.guards)

175+ , body: nested.body

176+ , fallback

177+ }

178+ _ ->

179+ -- Inner case has different fallback - check if it's a simple nested case we can still use

180+ case NEA.toArray innerCaseOf.branches of

181+ [ innerBranch1, innerBranch2 ] ->

182+ let innerFb1 = getFallbackBody innerBranch1

183+ innerFb2 = getFallbackBody innerBranch2

184+ in case innerFb1, innerFb2 of

185+ Nothing, Just innerFallback | innerFallback == fallback ->

186+ case getMatchPatternAndBody innerBranch1 of

187+ Just { pattern: innerPat, body: innerBody, innerExistingGuards } ->

188+ Just

189+ { depth: 2

190+ , scrutinee

191+ , topPattern: pat1Str

192+ , existingGuards

193+ , guards: Array.cons (innerPat <> " <- " <> innerScrutinee) innerExistingGuards

194+ , body: innerBody

195+ , fallback

196+ }

197+ Nothing -> Nothing

198+ Just innerFallback, Nothing | innerFallback == fallback ->

199+ case getMatchPatternAndBody innerBranch2 of

200+ Just { pattern: innerPat, body: innerBody, innerExistingGuards } ->

201+ Just

202+ { depth: 2

203+ , scrutinee

204+ , topPattern: pat1Str

205+ , existingGuards

206+ , guards: Array.cons (innerPat <> " <- " <> innerScrutinee) innerExistingGuards

207+ , body: innerBody

208+ , fallback

209+ }

210+ Nothing -> Nothing

211+ _, _ -> Nothing

212+ _ -> Nothing

213+ _ -> Nothing

214+

215+ getMatchPatternAndBody :: Tuple (Separated (Binder Void)) (Guarded Void) -> Maybe { pattern :: String, body :: String, innerExistingGuards :: Array String }

216+ getMatchPatternAndBody (Tuple (Separated { head: binder, tail: [] }) guarded) =

217+ case guarded of

218+ Unconditional _ (Where { expr, bindings: Nothing }) ->

219+ Just { pattern: printBinder binder, body: printExprMultiline expr, innerExistingGuards: [] }

220+ Guarded guardedExprs ->

221+ case NEA.toArray guardedExprs of

222+ [ GuardedExpr ge ] ->

223+ case ge.where of

224+ Where { expr, bindings: Nothing } ->

225+ Just { pattern: printBinder binder, body: printExprMultiline expr, innerExistingGuards: printPatternGuards ge.patterns }

226+ _ -> Nothing

227+ _ -> Nothing

228+ _ -> Nothing

229+ getMatchPatternAndBody _ = Nothing

lib/purelint/src/Purelint/Rules/UseTraverse.purs+19−18

@@ -28,14 +28,11 @@ useTraverseRule = mkRule (RuleId "UseTraverse") run

2828

2929 checkExpr :: ImportInfo -> Expr Void -> Array LintWarning

3030 checkExpr imports expr = case expr of

31− -- Match: sequenceA (map f x) or sequenceA (f <$> x) or sequenceA (fmap f x)

32− ExprApp fnExpr args ->

33− case fnExpr of

34− ExprIdent qn | isSequenceA imports qn || isSequence imports qn ->

35− case NEA.head args of

36− AppTerm innerExpr -> checkInnerArg imports expr qn (unwrapParens innerExpr)

37− _ -> []

38− _ -> []

31+ -- Match: sequenceA (map f x) or sequenceA (f <$> x)

32+ ExprApp (ExprIdent qn) args

33+ | isSequenceA imports qn || isSequence imports qn

34+ , AppTerm innerExpr <- NEA.head args ->

35+ checkInnerArg imports expr qn (unwrapParens innerExpr)

3936 _ -> []

4037

4138 -- | Unwrap parentheses to get the inner expression

@@ -47,17 +44,21 @@ useTraverseRule = mkRule (RuleId "UseTraverse") run

4744 checkInnerArg imports fullExpr seqQn innerExpr =

4845 case innerExpr of

4946 -- Match: map f x

50− ExprApp mapFn mapArgs | isMapLikeApp imports mapFn ->

51− case NEA.toArray mapArgs of

52− [AppTerm fExpr, AppTerm xExpr] ->

47+ ExprApp mapFn mapArgs

48+ | isMapLikeApp imports mapFn

49+ , [AppTerm fExpr, AppTerm xExpr] <- NEA.toArray mapArgs ->

5350 mkWarning fullExpr seqQn (printExpr fExpr) (printExpr xExpr)

54− _ -> mkWarningTemplate fullExpr seqQn

51+ ExprApp mapFn _

52+ | isMapLikeApp imports mapFn ->

53+ mkWarningTemplate fullExpr seqQn

5554 -- Match: f <$> x (operator form)

56− ExprOp lhs ops | hasMapOperator imports ops ->

57− case NEA.toArray ops of

58− [Tuple _ rhs] ->

55+ ExprOp lhs ops

56+ | hasMapOperator imports ops

57+ , [Tuple _ rhs] <- NEA.toArray ops ->

5958 mkWarning fullExpr seqQn (printExpr lhs) (printExpr rhs)

60− _ -> mkWarningTemplate fullExpr seqQn

59+ ExprOp _ ops

60+ | hasMapOperator imports ops ->

61+ mkWarningTemplate fullExpr seqQn

6162 _ -> []

6263

6364 mkWarning :: Expr Void -> QualifiedName Ident -> String -> String -> Array LintWarning

@@ -71,7 +72,7 @@ useTraverseRule = mkRule (RuleId "UseTraverse") run

7172 in

7273 [ LintWarning

7374 { ruleId: RuleId "UseTraverse"

74− , message: WarningMessage $ "Use " <> replacement <> replacementSuffix <> " instead of " <> seqName <> " composed with map/fmap/<$>"

75+ , message: WarningMessage $ "Use " <> replacement <> replacementSuffix <> " instead of " <> seqName <> " composed with map / <$>"

7576 , range

7677 , severity: Warning

7778 , suggestion: Just $ Suggestion

@@ -91,7 +92,7 @@ useTraverseRule = mkRule (RuleId "UseTraverse") run

9192 in

9293 [ LintWarning

9394 { ruleId: RuleId "UseTraverse"

94− , message: WarningMessage $ "Use " <> replacement <> replacementSuffix <> " instead of " <> seqName <> " composed with map/fmap/<$>"

95+ , message: WarningMessage $ "Use " <> replacement <> replacementSuffix <> " instead of " <> seqName <> " composed with map / <$>"

9596 , range

9697 , severity: Warning

9798 , suggestion: Nothing -- No auto-fix for complex patterns

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

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

1+module Purelint.Rules.UseUnwrap where

3+import Prelude

5+import Data.Array.NonEmpty as NEA

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

7+import Data.Void (Void)

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 (AppSpine(..), Expr(..), Ident(..), Module, QualifiedName(..))

14+

15+-- | Rule: unwrap x -> un ?Constructor x

16+-- | Suggests replacing unwrap with typed hole to trigger type-directed search

17+useUnwrapRule :: Rule

18+useUnwrapRule = mkRule (RuleId "UseUnwrap") run

19+ where

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

21+ run _ctx = foldMapModule visitor

22+ where

23+ visitor = defaultMonoidalVisitor { onExpr = checkExpr }

24+

25+ checkExpr :: Expr Void -> Array LintWarning

26+ checkExpr expr = case expr of

27+ -- Match: unwrap x

28+ ExprApp fn args

29+ | isUnwrap fn

30+ , [AppTerm arg] <- NEA.toArray args

31+ -> let

32+ argText = printExpr arg

33+ replacement = "un ?Constructor " <> argText

34+ in

35+ [ LintWarning

36+ { ruleId: RuleId "UseUnwrap"

37+ , message: WarningMessage "unwrap can be replaced with un ?Constructor for type-directed search"

38+ , range: rangeOf expr

39+ , severity: Hint

40+ , suggestion: Just $ Suggestion

41+ { replacement: ReplacementText replacement

42+ , description: SuggestionDescription "Use un with typed hole to find the right accessor"

43+ }

44+ }

45+ ]

46+ -- Match: unwrap (partial application)

47+ ExprIdent qn

48+ | isUnwrapIdent qn

49+ -> [ LintWarning

50+ { ruleId: RuleId "UseUnwrap"

51+ , message: WarningMessage "unwrap can be replaced with un ?Constructor for type-directed search"

52+ , range: rangeOf expr

53+ , severity: Hint

54+ , suggestion: Just $ Suggestion

55+ { replacement: ReplacementText "un ?Constructor"

56+ , description: SuggestionDescription "Use un with typed hole to find the right accessor"

57+ }

58+ }

59+ ]

60+ _ -> []

61+

62+ isUnwrap :: Expr Void -> Boolean

63+ isUnwrap (ExprIdent qn) = isUnwrapIdent qn

64+ isUnwrap _ = false

65+

66+ isUnwrapIdent :: QualifiedName Ident -> Boolean

67+ isUnwrapIdent (QualifiedName { name: Ident name }) = name == "unwrap"

lib/purelint/src/Purelint/Runner.purs+24−23

@@ -4,18 +4,18 @@ import Prelude

55import Data.Array as Array

66import Data.Either (Either(..))

7−import Data.Newtype (unwrap)

7+import Data.Newtype (un, unwrap)

8+import PureScript.CST (RecoveredParserResult(..), parseModule)

9+import PureScript.CST.Errors (printParseError)

10+import PureScript.CST.Types (ImportDecl(..), Module(..), ModuleHeader(..), ModuleName(..), Name(..))

811import Purelint.Imports (getImportInfo, ImportInfo)

912import Purelint.Rule (Rule, RuleContext)

1013import Purelint.Types (LintResult(..), SourceCode(..))

11−import PureScript.CST (RecoveredParserResult(..), parseModule)

12−import PureScript.CST.Errors (printParseError)

13−import PureScript.CST.Types (Module, ModuleHeader(..), ModuleName(..), ImportDecl(..), Name(..))

1414import Unsafe.Coerce (unsafeCoerce)

1515

1616-- | Run a set of rules on source code

1717runRules :: Array Rule -> SourceCode -> Either String LintResult

18−runRules rules (SourceCode source) =

18+runRules rules (SourceCode source) =

1919 case parseModule source of

2020 ParseSucceeded m -> Right $ runOnModule rules (toVoidModule m)

2121 ParseSucceededWithErrors m _ -> Right $ runOnModule rules (toVoidModule m)

@@ -23,7 +23,7 @@ runRules rules (SourceCode source) =

2323

2424-- | Get import info from source code (for debugging)

2525getImportsFromSource :: SourceCode -> Either String ImportInfo

26−getImportsFromSource (SourceCode source) =

26+getImportsFromSource (SourceCode source) =

2727 case parseModule source of

2828 ParseSucceeded m -> Right $ getImportInfo (toVoidModule m)

2929 ParseSucceededWithErrors m _ -> Right $ getImportInfo (toVoidModule m)

@@ -31,36 +31,37 @@ getImportsFromSource (SourceCode source) =

3131

3232-- | Get raw module names from imports (for debugging)

3333getModuleNames :: SourceCode -> Either String (Array String)

34−getModuleNames (SourceCode source) =

34+getModuleNames (SourceCode source) =

3535 case parseModule source of

3636 ParseSucceeded m -> Right $ extractModuleNames (toVoidModule m)

3737 ParseSucceededWithErrors m _ -> Right $ extractModuleNames (toVoidModule m)

3838 ParseFailed _ -> Left "Parse error"

3939 where

40− extractModuleNames mod =

41− let (ModuleHeader header) = (unwrap mod).header

42− in map extractName header.imports

43− extractName (ImportDecl imp) =

40+ extractModuleNames (Module mod) = do

41+ let ModuleHeader header = mod.header

42+ header.imports <#> extractName

43+ extractName (ImportDecl imp) =

4444 case imp.module of

4545 Name { name: ModuleName n } -> n

4646

4747-- | Run rules on a successfully parsed module

4848runOnModule :: Array Rule -> Module Void -> LintResult

49−runOnModule rules mod =

50− let

51− imports = getImportInfo mod

52− ctx :: RuleContext

53− ctx = { imports }

54− warnings = Array.concatMap (\rule -> rule.run ctx mod) rules

55− modName = getModuleName mod

56− in

57− LintResult { warnings, moduleName: modName }

49+runOnModule rules mod =

50+ LintResult { warnings, moduleName: modName }

51+ where

52+ imports = getImportInfo mod

53+

54+ ctx :: RuleContext

55+ ctx = { imports }

56+ warnings = rules # Array.concatMap \rule -> rule.run ctx mod

57+ modName = getModuleName mod

5858

5959-- | Get the module name from a parsed module

6060getModuleName :: forall e. Module e -> ModuleName

61−getModuleName mod =

62− let (ModuleHeader header) = (unwrap mod).header

63− in (unwrap header.name).name

61+getModuleName mod =

62+ (header.name # un Name).name

63+ where

64+ ModuleHeader header = (mod # un Module).header

6465

6566-- | Convert a recovered module to a Void module (assuming no errors)

6667-- | This is safe after ParseSucceeded because there are no error nodes

lib/purelint/src/Purelint/Tidy.js+66−3

@@ -1,3 +1,66 @@

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;

1+import { execSync } from "child_process";

3+// Format a full PureScript module using purs-tidy CLI

4+// Returns the formatted module string

5+export const formatModule = (str) => () => {

6+ try {

7+ const result = execSync("purs-tidy format", {

8+ input: str,

9+ encoding: "utf8",

10+ stdio: ["pipe", "pipe", "pipe"],

11+ timeout: 5000,

12+ });

13+ return result;

14+ } catch (_e) {

15+ // If purs-tidy fails or isn't installed, return original

16+ return str;

17+ }

18+};

19+

20+// Format a PureScript expression using purs-tidy CLI

21+// Wraps in a module, formats, and extracts the expression back

22+export const formatExpr = (str) => () => {

23+ try {

24+ // Wrap expression in a minimal module

25+ const moduleCode = `module T where\nx = ${str}\n`;

26+

27+ // Shell out to purs-tidy

28+ const result = execSync("purs-tidy format", {

29+ input: moduleCode,

30+ encoding: "utf8",

31+ stdio: ["pipe", "pipe", "pipe"],

32+ timeout: 5000,

33+ });

34+

35+ // Extract the expression after "x = "

36+ const lines = result.split("\n");

37+ const xLine = lines.findIndex((l) => l.startsWith("x = "));

38+ if (xLine === -1) return str;

39+

40+ // Get everything after "x = " including continuation lines

41+ const exprLines = [];

42+ exprLines.push(lines[xLine].slice(4)); // Remove "x = "

43+

44+ // Collect continuation lines until we hit another top-level declaration

45+ // or end of file. Keep relative indentation intact.

46+ for (let i = xLine + 1; i < lines.length; i++) {

47+ const line = lines[i];

48+ // Empty line or indented = still part of expression

49+ if (line === "" || line.startsWith(" ")) {

50+ exprLines.push(line);

51+ } else {

52+ break;

53+ }

54+ }

55+

56+ // Trim trailing empty lines

57+ while (exprLines.length > 0 && exprLines[exprLines.length - 1] === "") {

58+ exprLines.pop();

59+ }

60+

61+ return exprLines.join("\n");

62+ } catch (_e) {

63+ // If purs-tidy fails or isn't installed, return original

64+ return str;

65+ }

66+};

lib/purelint/src/Purelint/Tidy.purs+4

@@ -4,6 +4,10 @@ import Prelude

55import Effect (Effect)

7+-- | Format a full PureScript module string using purs-tidy

8+-- | Returns the formatted string, or the original if formatting fails

9+foreign import formatModule :: String -> Effect String

10+

711-- | Format a PureScript expression string using purs-tidy

812-- | Returns the formatted string, or the original if formatting fails

913foreign import formatExpr :: String -> Effect String

lib/purelint/src/Purelint/Types.purs+4−1

@@ -15,8 +15,10 @@ derive newtype instance Ord RuleId

1515derive newtype instance Show RuleId

1616

1717-- | Severity of a lint warning

18+-- | Refactor is special: it doesn't show diagnostics, only code actions

1819data Severity

19− = Hint

20+ = Refactor

21+ | Hint

2022 | Warning

2123 | Error

2224

@@ -24,6 +26,7 @@ derive instance Eq Severity

2426derive instance Ord Severity

2527

2628instance Show Severity where

29+ show Refactor = "refactor"

2730 show Hint = "hint"

2831 show Warning = "warning"

2932 show Error = "error"

package.json+3

@@ -16,6 +16,9 @@

1616 "bundle": "npm run bundle:cli && npm run bundle:lsp",

1717 "dist": "npm run build && npm run bundle",

1818 "test": "spago test",

19+ "test:lsp": "node test-lsp/test-lsp.mjs",

20+ "test:vscode": "cd vscode-extension && npm test",

21+ "test:all": "npm test && npm run test:lsp && npm run test:vscode",

1922 "dev:cli": "node bin/purelint.js",

2023 "dev:lsp": "node bin/purelint-lsp.js"

2124 },

purelint-lspnew file+2

@@ -0,0 +1,2 @@

1+#!/bin/bash

2+exec node /Users/mark/Developer/purelint/dist/purelint-lsp.js "$@"

test/LintExamples.purs+10−10

@@ -10,24 +10,24 @@ import Data.Traversable (class Traversable, sequence, traverse)

1010import Data.Tuple (Tuple(..), fst, snd)

1111

1212-- ============================================================================

13−-- FmapId: map identity x -> x

13+-- MapIdentity: map identity x -> x

1414-- ============================================================================

1515

1616-- | map identity x -> x

17−fmapId1 :: Array Int

18−fmapId1 = map identity [ 1, 2, 3 ]

17+mapIdentity1 :: Array Int

18+mapIdentity1 = map identity [ 1, 2, 3 ]

1919

20−-- | fmap identity x -> x (same as map in PureScript)

21−fmapId2 :: Array Int

22−fmapId2 = map identity [ 1, 2, 3 ]

20+-- | map identity x -> x (same as map in PureScript)

21+mapIdentity2 :: Array Int

22+mapIdentity2 = map identity [ 1, 2, 3 ]

2323

2424-- | identity <$> x -> x

25−fmapId3 :: Array Int

26−fmapId3 = identity <$> [ 1, 2, 3 ]

25+mapIdentity3 :: Array Int

26+mapIdentity3 = identity <$> [ 1, 2, 3 ]

2727

2828-- | x <#> identity -> x

29−fmapId4 :: Array Int

30−fmapId4 = [ 1, 2, 3 ] <#> identity

29+mapIdentity4 :: Array Int

30+mapIdentity4 = [ 1, 2, 3 ] <#> identity

3131

3232-- ============================================================================

3333-- MapFusion: map f (map g x) -> map (f <<< g) x

test/Test/Main.purs+495−239

@@ -11,8 +11,8 @@ import Data.Traversable (traverse)

1111import Effect (Effect)

1212import Effect.Class.Console (log)

1313import Purelint.Fix (applyAllFixes)

14−import Purelint.Tidy (formatExpr)

15−import Purelint.Rules.FmapId (fmapIdRule)

14+import Purelint.Tidy (formatExpr, formatModule)

15+import Purelint.Rules.MapIdentity (mapIdentityRule)

1616import Purelint.Rules.MapFusion (mapFusionRule)

1717import Purelint.Rules.UseTraverse (useTraverseRule)

1818import Purelint.Rules.ConcatMap (concatMapRule)

@@ -22,6 +22,7 @@ import Purelint.Rules.EtaReduce (etaReduceRule)

2222import Purelint.Rules.EtaReduceDecl (etaReduceDeclRule)

2323import Purelint.Rules.RedundantBind (redundantBindRule)

2424import Purelint.Rules.LetToWhere (letToWhereRule)

25+import Purelint.Rules.LetToDo (letToDoRule)

2526import Purelint.Rules.RedundantIf (redundantIfRule)

2627import Purelint.Rules.FunctorLaw (functorLawRule)

2728import Purelint.Rules.UseVoid (useVoidRule)

@@ -67,7 +68,9 @@ import Purelint.Rules.EvaluateFst (evaluateFstRule)

6768import Purelint.Rules.EvaluateConst (evaluateConstRule)

6869import Purelint.Rules.UseOr (useOrRule)

6970import Purelint.Rules.UseAnd (useAndRule)

71+import Purelint.Rules.UseFoldMap (useFoldMapRule)

7072import Purelint.Rules.UseFoldMapId (useFoldMapIdRule)

73+import Purelint.Rules.UseApplyFlipped (useApplyFlippedRule)

7174import Purelint.Rules.WhenNot (whenNotRule)

7275import Purelint.Rules.UnlessNot (unlessNotRule)

7376import Purelint.Rules.UseZip (useZipRule)

@@ -79,6 +82,14 @@ import Purelint.Rules.UseHead (useHeadRule)

7982import Purelint.Rules.RedundantId (redundantIdRule)

8083import Purelint.Rules.NothingBind (nothingBindRule)

8184import Purelint.Rules.UseElemIndex (useElemIndexRule)

85+import Purelint.Rules.MonadLaw (monadLawRule)

86+import Purelint.Rules.EvaluateBool (evaluateBoolRule)

87+import Purelint.Rules.UseFoldBool (useFoldBoolRule)

88+import Purelint.Rules.AlternativeLaw (alternativeLawRule)

89+import Purelint.Rules.EvaluateEither (evaluateEitherRule)

90+import Purelint.Rules.UseCaseOf (useCaseOfRule)

91+import Purelint.Rules.FlattenCase (flattenCaseRule)

92+import Purelint.Rules.UsePatternGuards (usePatternGuardsRule)

8293import Purelint.Rule (Rule)

8394import Purelint.Runner (runRules, getImportsFromSource, getModuleNames)

8495import Purelint.Imports (hasValue, isPreludeModule)

@@ -143,12 +154,27 @@ assertFix name rules source expectedFixed =

143154 then runTest name true "OK"

144155 else runTest name false ("Expected:\n" <> expectedFixed <> "\nGot:\n" <> fixed)

145156

157+-- | Assert that applying fixes produces expected output AND result is tidy-formatted

158+assertFixFormatted :: String -> Array Rule -> String -> String -> Effect TestResult

159+assertFixFormatted name rules source expectedFixed =

160+ case runRules rules (SourceCode source) of

161+ Left err -> pure $ runTest name false ("Parse error: " <> err)

162+ Right result -> do

163+ let fixed = applyAllFixes source result

164+ -- Check that the fix output is already tidy-formatted

165+ tidied <- formatModule fixed

166+ if tidied /= fixed

167+ then pure $ runTest name false ("Fix output not tidy-formatted.\nGot:\n" <> fixed <> "\nTidy expects:\n" <> tidied)

168+ else if fixed /= expectedFixed

169+ then pure $ runTest name false ("Expected:\n" <> expectedFixed <> "\nGot:\n" <> fixed)

170+ else pure $ runTest name true "OK"

171+

146172-- | Run all tests and report results

147173main :: Effect Unit

148174main = do

149175 log "Running purelint tests...\n"

150176

151− let results = fmapIdTests

177+ let results = mapIdentityTests

152178 <> mapFusionTests

153179 <> useTraverseTests

154180 <> concatMapTests

@@ -198,6 +224,8 @@ main = do

198224 <> evaluateConstTests

199225 <> useOrTests

200226 <> useAndTests

227+ <> useFoldMapTests

228+ <> useApplyFlippedTests

201229 <> useFoldMapIdTests

202230 <> whenNotTests

203231 <> unlessNotTests

@@ -205,13 +233,24 @@ main = do

205233 <> redundantNegateTests

206234 <> redundantIdTests

207235 <> nothingBindTests

208− <> goldenTests

236+ <> monadLawTests

237+ <> evaluateBoolTests

238+ <> useFoldBoolTests

239+ <> alternativeLawTests

240+ <> evaluateEitherTests

241+ <> useCaseOfTests

242+ <> flattenCaseTests

243+ <> usePatternGuardsTests

209244

210− let passed = Array.length $ Array.filter _.passed results

211− let total = Array.length results

245+ -- Run effectful golden tests (with purs-tidy check)

246+ goldenResults <- goldenTests

247+ let allResults = results <> goldenResults

248+

249+ let passed = Array.length $ Array.filter _.passed allResults

250+ let total = Array.length allResults

212251

213252 -- Report failures

214− let failures = Array.filter (not <<< _.passed) results

253+ let failures = Array.filter (not <<< _.passed) allResults

215254 when (Array.length failures > 0) do

216255 log "FAILURES:"

217256 for_ failures (\r -> log (" ✗ " <> r.name <> ": " <> r.message))

@@ -239,42 +278,40 @@ main = do

239278

240279-- | Helper: wrap code in a module with Prelude import

241280withPrelude :: String -> String

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

281+withPrelude code = "module Test where\n\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\n" <> code

243282

244283-- | Helper: wrap code in module without imports

245284withoutImports :: String -> String

246285withoutImports code = "module Test where\n" <> code

247286

248287-- ============================================================================

249−-- FmapId Tests

288+-- MapIdentity Tests

250289-- ============================================================================

251290

252−fmapIdTests :: Array TestResult

253−fmapIdTests =

291+mapIdentityTests :: Array TestResult

292+mapIdentityTests =

254293 -- Positive cases: should detect

255− [ assertWarningCount "FmapId: map identity x" [fmapIdRule]

294+ [ assertWarningCount "MapIdentity: map identity x" [mapIdentityRule]

256295 (withPrelude "x = map identity [1]") 1

257− , assertRuleId "FmapId: correct rule id" [fmapIdRule]

258− (withPrelude "x = map identity [1]") "FmapId"

259− , assertSuggestion "FmapId: map identity suggestion" [fmapIdRule]

260− (withPrelude "x = map identity [1]") "[1]"

261− , assertWarningCount "FmapId: fmap identity x" [fmapIdRule]

262− (withPrelude "x = fmap identity [1]") 1

263− , assertWarningCount "FmapId: identity <$> x" [fmapIdRule]

296+ , assertRuleId "MapIdentity: correct rule id" [mapIdentityRule]

297+ (withPrelude "x = map identity [1]") "MapIdentity"

298+ , assertSuggestion "MapIdentity: map identity suggestion" [mapIdentityRule]

299+ (withPrelude "x = map identity [1]") "[ 1 ]"

300+ , assertWarningCount "MapIdentity: identity <$> x" [mapIdentityRule]

264301 (withPrelude "x = identity <$> [1]") 1

265− , assertWarningCount "FmapId: x <#> identity" [fmapIdRule]

302+ , assertWarningCount "MapIdentity: x <#> identity" [mapIdentityRule]

266303 (withPrelude "x = [1] <#> identity") 1

267304

268305 -- Negative cases: should NOT detect

269− , assertWarningCount "FmapId: no fire on map show" [fmapIdRule]

306+ , assertWarningCount "MapIdentity: no fire on map show" [mapIdentityRule]

270307 (withPrelude "x = map show [1]") 0

271− , assertWarningCount "FmapId: no fire without import" [fmapIdRule]

308+ , assertWarningCount "MapIdentity: no fire without import" [mapIdentityRule]

272309 (withoutImports "x = map identity [1]") 0

273310

274311 -- Auto-fix test

275− , assertFix "FmapId: fix map identity" [fmapIdRule]

312+ , assertFix "MapIdentity: fix map identity" [mapIdentityRule]

276313 (withPrelude "x = map identity [1]")

277− (withPrelude "x = [1]")

314+ (withPrelude "x = [ 1 ]")

278315 ]

279316

280317-- ============================================================================

@@ -440,7 +477,7 @@ redundantBindTests =

440477 , assertRuleId "RedundantBind: correct rule id" [redundantBindRule]

441478 (withPrelude "x = [1] >>= pure") "RedundantBind"

442479 , assertSuggestion "RedundantBind: x >>= pure suggestion" [redundantBindRule]

443− (withPrelude "x = [1] >>= pure") "[1]"

480+ (withPrelude "x = [1] >>= pure") "[ 1 ]"

444481 , assertWarningCount "RedundantBind: pure x >>= f" [redundantBindRule]

445482 (withPrelude "x = pure 1 >>= show") 1

446483 , assertSuggestion "RedundantBind: pure x >>= f suggestion" [redundantBindRule]

@@ -469,13 +506,16 @@ letToWhereTests =

469506 , assertWarningCount "LetToWhere: multiple bindings" [letToWhereRule]

470507 (withPrelude "x = let a = 1\n b = 2 in a + b") 1

471508

472− -- Suggestion preserves spaces

509+ -- Suggestion preserves spaces based on let column position

473510 , assertSuggestion "LetToWhere: preserves spaces in simple case" [letToWhereRule]

474− (withPrelude "x = let y = 1 in y + 1") "y + 1\n where\n y = 1"

511+ (withPrelude "x = let y = 1 in y + 1") "y + 1\n where\n y = 1"

475512 , assertSuggestion "LetToWhere: preserves spaces in expressions" [letToWhereRule]

476− (withPrelude "f x = let a = x + 1 in a * 2") "a * 2\n where\n a = x + 1"

513+ (withPrelude "f x = let a = x + 1 in a * 2") "a * 2\n where\n a = x + 1"

477514 , assertSuggestion "LetToWhere: preserves spaces with multiple bindings" [letToWhereRule]

478− (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"

515+ (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"

516+ -- Nested let should preserve indentation context

517+ , assertSuggestion "LetToWhere: nested let preserves indentation" [letToWhereRule]

518+ (withPrelude "f x =\n let y = 1 in y + 1") "y + 1\n where\n y = 1"

479519 ]

480520

481521-- ============================================================================

@@ -578,7 +618,7 @@ useAnyTests =

578618 , assertRuleId "UseAny: correct rule id" [useAnyRule]

579619 (withPrelude "x = or (map f [1])") "UseAny"

580620 , assertSuggestion "UseAny: suggests any" [useAnyRule]

581− (withPrelude "x = or (map f [1])") "any f [1]"

621+ (withPrelude "x = or (map f [1])") "any f [ 1 ]"

582622

583623 -- Negative cases

584624 , assertWarningCount "UseAny: no fire on or alone" [useAnyRule]

@@ -599,7 +639,7 @@ useAllTests =

599639 , assertRuleId "UseAll: correct rule id" [useAllRule]

600640 (withPrelude "x = and (map f [1])") "UseAll"

601641 , assertSuggestion "UseAll: suggests all" [useAllRule]

602− (withPrelude "x = and (map f [1])") "all f [1]"

642+ (withPrelude "x = and (map f [1])") "all f [ 1 ]"

603643

604644 -- Negative cases

605645 , assertWarningCount "UseAll: no fire on and alone" [useAllRule]

@@ -689,7 +729,7 @@ useNullTests =

689729 , assertRuleId "UseNull: correct rule id" [useNullRule]

690730 (withPrelude "x = length [1] == 0") "UseNull"

691731 , assertSuggestion "UseNull: suggests null" [useNullRule]

692− (withPrelude "x = length [1] == 0") "null [1]"

732+ (withPrelude "x = length [1] == 0") "null [ 1 ]"

693733 , assertWarningCount "UseNull: 0 == length x" [useNullRule]

694734 (withPrelude "x = 0 == length [1]") 1

695735

@@ -815,7 +855,7 @@ useNotElemTests =

815855 , assertRuleId "UseNotElem: correct rule id" [useNotElemRule]

816856 (withPrelude "x = not (elem 1 [1,2,3])") "UseNotElem"

817857 , assertSuggestion "UseNotElem: suggests notElem" [useNotElemRule]

818− (withPrelude "x = not (elem 1 [1,2,3])") "notElem 1 [1,2,3]"

858+ (withPrelude "x = not (elem 1 [1,2,3])") "notElem 1 [ 1, 2, 3 ]"

819859

820860 -- Negative cases

821861 , assertWarningCount "UseNotElem: no fire on not (foo x)" [useNotElemRule]

@@ -855,7 +895,7 @@ monoidIdentityTests =

855895 , assertRuleId "MonoidIdentity: correct rule id" [monoidIdentityRule]

856896 (withPrelude "x = mempty <> [1,2,3]") "MonoidIdentity"

857897 , assertSuggestion "MonoidIdentity: suggests x" [monoidIdentityRule]

858− (withPrelude "x = mempty <> [1,2,3]") "[1,2,3]"

898+ (withPrelude "x = mempty <> [1,2,3]") "[ 1, 2, 3 ]"

859899 , assertWarningCount "MonoidIdentity: x <> mempty" [monoidIdentityRule]

860900 (withPrelude "x = [1,2,3] <> mempty") 1

861901

@@ -911,7 +951,7 @@ useTraverseSequenceTests =

911951 , assertRuleId "UseTraverseSequence: correct rule id" [useTraverseSequenceRule]

912952 (withPrelude "x = sequence (map show [1,2,3])") "UseTraverseSequence"

913953 , assertSuggestion "UseTraverseSequence: suggests traverse" [useTraverseSequenceRule]

914− (withPrelude "x = sequence (map show [1,2,3])") "traverse show [1,2,3]"

954+ (withPrelude "x = sequence (map show [1,2,3])") "traverse show [ 1, 2, 3 ]"

915955

916956 -- Negative cases

917957 , assertWarningCount "UseTraverseSequence: no fire on sequence xs" [useTraverseSequenceRule]

@@ -969,7 +1009,7 @@ useMapMaybeTests =

9691009 , assertRuleId "UseMapMaybe: correct rule id" [useMapMaybeRule]

9701010 (withPrelude "x = catMaybes (map f [1,2,3])") "UseMapMaybe"

9711011 , assertSuggestion "UseMapMaybe: suggests mapMaybe" [useMapMaybeRule]

972− (withPrelude "x = catMaybes (map f [1,2,3])") "mapMaybe f [1,2,3]"

1012+ (withPrelude "x = catMaybes (map f [1,2,3])") "mapMaybe f [ 1, 2, 3 ]"

9731013 ]

9741014

9751015-- ============================================================================

@@ -1073,7 +1113,7 @@ useFindMapTests =

10731113 , assertRuleId "UseFindMap: correct rule id" [useFindMapRule]

10741114 (withPrelude "x = head (mapMaybe f [1,2,3])") "UseFindMap"

10751115 , assertSuggestion "UseFindMap: suggests findMap" [useFindMapRule]

1076− (withPrelude "x = head (mapMaybe f [1,2,3])") "findMap f [1,2,3]"

1116+ (withPrelude "x = head (mapMaybe f [1,2,3])") "findMap f [ 1, 2, 3 ]"

10771117 ]

10781118

10791119-- ============================================================================

@@ -1087,7 +1127,7 @@ useLastReverseTests =

10871127 , assertRuleId "UseLastReverse: correct rule id" [useLastReverseRule]

10881128 (withPrelude "x = head (reverse [1,2,3])") "UseLastReverse"

10891129 , assertSuggestion "UseLastReverse: suggests last" [useLastReverseRule]

1090− (withPrelude "x = head (reverse [1,2,3])") "last [1,2,3]"

1130+ (withPrelude "x = head (reverse [1,2,3])") "last [ 1, 2, 3 ]"

10911131 ]

10921132

10931133-- ============================================================================

@@ -1115,7 +1155,7 @@ useMinimumSortTests =

11151155 , assertRuleId "UseMinimumSort: correct rule id" [useMinimumSortRule]

11161156 (withPrelude "x = head (sort [1,2,3])") "UseMinimumSort"

11171157 , assertSuggestion "UseMinimumSort: suggests minimum" [useMinimumSortRule]

1118− (withPrelude "x = head (sort [1,2,3])") "minimum [1,2,3]"

1158+ (withPrelude "x = head (sort [1,2,3])") "minimum [ 1, 2, 3 ]"

11191159 ]

11201160

11211161-- ============================================================================

@@ -1175,7 +1215,7 @@ useOrTests =

11751215 , assertRuleId "UseOr: correct rule id" [useOrRule]

11761216 (withPrelude "x = any identity [true, false]") "UseOr"

11771217 , assertSuggestion "UseOr: suggests or" [useOrRule]

1178− (withPrelude "x = any identity [true, false]") "or [true, false]"

1218+ (withPrelude "x = any identity [true, false]") "or [ true, false ]"

11791219 ]

11801220

11811221-- ============================================================================

@@ -1189,7 +1229,39 @@ useAndTests =

11891229 , assertRuleId "UseAnd: correct rule id" [useAndRule]

11901230 (withPrelude "x = all identity [true, false]") "UseAnd"

11911231 , assertSuggestion "UseAnd: suggests and" [useAndRule]

1192− (withPrelude "x = all identity [true, false]") "and [true, false]"

1232+ (withPrelude "x = all identity [true, false]") "and [ true, false ]"

1233+ ]

1234+

1235+-- ============================================================================

1236+-- UseFoldMap Tests

1237+-- ============================================================================

1238+

1239+useFoldMapTests :: Array TestResult

1240+useFoldMapTests =

1241+ [ assertWarningCount "UseFoldMap: case Nothing/Just with empty string" [useFoldMapRule]

1242+ (withPrelude "x mx = case mx of\n Nothing -> \"\"\n Just s -> f s") 1

1243+ , assertRuleId "UseFoldMap: correct rule id" [useFoldMapRule]

1244+ (withPrelude "x mx = case mx of\n Nothing -> \"\"\n Just s -> f s") "UseFoldMap"

1245+ , assertSuggestion "UseFoldMap: suggests foldMap f" [useFoldMapRule]

1246+ (withPrelude "x mx = case mx of\n Nothing -> \"\"\n Just s -> f s") "foldMap f mx"

1247+ , assertSuggestion "UseFoldMap: suggests lambda for complex body" [useFoldMapRule]

1248+ (withPrelude "x mx = case mx of\n Nothing -> \"\"\n Just s -> s <> \"!\"") "foldMap (\\s -> s <> \"!\") mx"

1249+ , assertWarningCount "UseFoldMap: reversed order Just/Nothing" [useFoldMapRule]

1250+ (withPrelude "x mx = case mx of\n Just s -> f s\n Nothing -> \"\"") 1

1251+ ]

1252+

1253+-- ============================================================================

1254+-- UseApplyFlipped Tests

1255+-- ============================================================================

1256+

1257+useApplyFlippedTests :: Array TestResult

1258+useApplyFlippedTests =

1259+ [ assertWarningCount "UseApplyFlipped: f lambda arg" [useApplyFlippedRule]

1260+ (withPrelude "x = foldMap (\\y -> y <> \"!\") xs") 1

1261+ , assertRuleId "UseApplyFlipped: correct rule id" [useApplyFlippedRule]

1262+ (withPrelude "x = foldMap (\\y -> y <> \"!\") xs") "UseApplyFlipped"

1263+ , assertSuggestion "UseApplyFlipped: suggests # form" [useApplyFlippedRule]

1264+ (withPrelude "x = foldMap (\\y -> y <> \"!\") xs") "xs # foldMap \\y -> y <> \"!\""

11931265 ]

11941266

11951267-- ============================================================================

@@ -1245,7 +1317,7 @@ useZipTests =

12451317 , assertRuleId "UseZip: correct rule id" [useZipRule]

12461318 (withPrelude "x = zipWith Tuple [1] [2]") "UseZip"

12471319 , assertSuggestion "UseZip: suggests zip" [useZipRule]

1248− (withPrelude "x = zipWith Tuple [1] [2]") "zip [1] [2]"

1320+ (withPrelude "x = zipWith Tuple [1] [2]") "zip [ 1 ] [ 2 ]"

12491321 ]

12501322

12511323-- ============================================================================

@@ -1291,13 +1363,190 @@ nothingBindTests =

12911363 ]

12921364

12931365-- ============================================================================

1294−-- Golden Tests: LintExamples.purs

1366+-- MonadLaw Tests

1367+-- ============================================================================

1368+

1369+monadLawTests :: Array TestResult

1370+monadLawTests =

1371+ [ assertWarningCount "MonadLaw: f =<< pure a" [monadLawRule]

1372+ (withPrelude "x = show =<< pure 42") 1

1373+ , assertRuleId "MonadLaw: correct rule id" [monadLawRule]

1374+ (withPrelude "x = show =<< pure 42") "MonadLaw"

1375+ , assertSuggestion "MonadLaw: suggests f a" [monadLawRule]

1376+ (withPrelude "x = show =<< pure 42") "show 42"

1377+ , assertWarningCount "MonadLaw: pure =<< m" [monadLawRule]

1378+ (withPrelude "x = pure =<< Just 1") 1

1379+ , assertSuggestion "MonadLaw: pure =<< m suggests m" [monadLawRule]

1380+ (withPrelude "x = pure =<< Just 1") "Just 1"

1381+ ]

1382+

1383+-- ============================================================================

1384+-- EvaluateBool Tests

1385+-- ============================================================================

1386+

1387+evaluateBoolTests :: Array TestResult

1388+evaluateBoolTests =

1389+ [ assertWarningCount "EvaluateBool: true && x" [evaluateBoolRule]

1390+ (withPrelude "x = true && foo") 1

1391+ , assertSuggestion "EvaluateBool: true && x -> x" [evaluateBoolRule]

1392+ (withPrelude "x = true && foo") "foo"

1393+ , assertWarningCount "EvaluateBool: false && x" [evaluateBoolRule]

1394+ (withPrelude "x = false && foo") 1

1395+ , assertSuggestion "EvaluateBool: false && x -> false" [evaluateBoolRule]

1396+ (withPrelude "x = false && foo") "false"

1397+ , assertWarningCount "EvaluateBool: true || x" [evaluateBoolRule]

1398+ (withPrelude "x = true || foo") 1

1399+ , assertSuggestion "EvaluateBool: true || x -> true" [evaluateBoolRule]

1400+ (withPrelude "x = true || foo") "true"

1401+ , assertWarningCount "EvaluateBool: false || x" [evaluateBoolRule]

1402+ (withPrelude "x = false || foo") 1

1403+ , assertSuggestion "EvaluateBool: false || x -> x" [evaluateBoolRule]

1404+ (withPrelude "x = false || foo") "foo"

1405+ , assertWarningCount "EvaluateBool: x && true" [evaluateBoolRule]

1406+ (withPrelude "x = foo && true") 1

1407+ , assertWarningCount "EvaluateBool: x || false" [evaluateBoolRule]

1408+ (withPrelude "x = foo || false") 1

1409+ ]

1410+

1411+-- ============================================================================

1412+-- UseFoldBool Tests

1413+-- ============================================================================

1414+

1415+useFoldBoolTests :: Array TestResult

1416+useFoldBoolTests =

1417+ [ assertWarningCount "UseFoldBool: foldr (&&) true" [useFoldBoolRule]

1418+ (withPrelude "x = foldr (&&) true xs") 1

1419+ , assertSuggestion "UseFoldBool: foldr (&&) true -> and" [useFoldBoolRule]

1420+ (withPrelude "x = foldr (&&) true xs") "and"

1421+ , assertWarningCount "UseFoldBool: foldr (||) false" [useFoldBoolRule]

1422+ (withPrelude "x = foldr (||) false xs") 1

1423+ , assertSuggestion "UseFoldBool: foldr (||) false -> or" [useFoldBoolRule]

1424+ (withPrelude "x = foldr (||) false xs") "or"

1425+ ]

1426+

1427+-- ============================================================================

1428+-- AlternativeLaw Tests

1429+-- ============================================================================

1430+

1431+alternativeLawTests :: Array TestResult

1432+alternativeLawTests =

1433+ [ assertWarningCount "AlternativeLaw: empty <|> x" [alternativeLawRule]

1434+ (withAlt "x = empty <|> foo") 1

1435+ , assertSuggestion "AlternativeLaw: empty <|> x -> x" [alternativeLawRule]

1436+ (withAlt "x = empty <|> foo") "foo"

1437+ , assertWarningCount "AlternativeLaw: x <|> empty" [alternativeLawRule]

1438+ (withAlt "x = foo <|> empty") 1

1439+ , assertSuggestion "AlternativeLaw: x <|> empty -> x" [alternativeLawRule]

1440+ (withAlt "x = foo <|> empty") "foo"

1441+ , assertWarningCount "AlternativeLaw: Nothing <|> x" [alternativeLawRule]

1442+ (withAlt "x = Nothing <|> foo") 1

1443+ ]

1444+

1445+-- ============================================================================

1446+-- EvaluateEither Tests

1447+-- ============================================================================

1448+

1449+evaluateEitherTests :: Array TestResult

1450+evaluateEitherTests =

1451+ [ assertWarningCount "EvaluateEither: either f g (Left x)" [evaluateEitherRule]

1452+ (withPrelude "x = either show identity (Left 42)") 1

1453+ , assertSuggestion "EvaluateEither: either f g (Left x) -> f x" [evaluateEitherRule]

1454+ (withPrelude "x = either show identity (Left 42)") "show 42"

1455+ , assertWarningCount "EvaluateEither: either f g (Right y)" [evaluateEitherRule]

1456+ (withPrelude "x = either show identity (Right \"hi\")") 1

1457+ , assertSuggestion "EvaluateEither: either f g (Right y) -> g y" [evaluateEitherRule]

1458+ (withPrelude "x = either show identity (Right \"hi\")") "identity \"hi\""

1459+ ]

1460+

1461+-- ============================================================================

1462+-- UseCaseOf Tests

12951463-- ============================================================================

12961464

1465+useCaseOfTests :: Array TestResult

1466+useCaseOfTests =

1467+ -- Positive cases: should detect

1468+ [ assertWarningCount "UseCaseOf: two clauses" [useCaseOfRule]

1469+ (withPrelude "foo True = 1\nfoo False = 0") 1

1470+ , assertRuleId "UseCaseOf: correct rule id" [useCaseOfRule]

1471+ (withPrelude "foo True = 1\nfoo False = 0") "UseCaseOf"

1472+ , assertSuggestion "UseCaseOf: suggestion format" [useCaseOfRule]

1473+ (withPrelude "foo True = 1\nfoo False = 0") "foo = case _ of\n True -> 1\n False -> 0"

1474+ , assertWarningCount "UseCaseOf: three clauses" [useCaseOfRule]

1475+ (withPrelude "bar Nothing = 0\nbar (Just 0) = 1\nbar (Just _) = 2") 1

1476+ , assertWarningCount "UseCaseOf: two args" [useCaseOfRule]

1477+ (withPrelude "add True True = 2\nadd True False = 1\nadd False True = 1\nadd False False = 0") 1

1478+ , assertSuggestion "UseCaseOf: two args suggestion" [useCaseOfRule]

1479+ (withPrelude "add True True = 2\nadd True False = 1\nadd False True = 1\nadd False False = 0") "add = case _, _ of\n True, True -> 2\n True, False -> 1\n False, True -> 1\n False, False -> 0"

1480+

1481+ -- Negative cases: should NOT detect

1482+ , assertWarningCount "UseCaseOf: single clause" [useCaseOfRule]

1483+ (withPrelude "foo x = x + 1") 0

1484+ , assertWarningCount "UseCaseOf: no binders" [useCaseOfRule]

1485+ (withPrelude "foo = 42\nbar = 43") 0

1486+ , assertWarningCount "UseCaseOf: guarded" [useCaseOfRule]

1487+ (withPrelude "foo x | x > 0 = 1\nfoo x = 0") 0

1488+ ]

1489+

1490+-- ============================================================================

1491+-- FlattenCase Tests

1492+-- ============================================================================

1493+

1494+flattenCaseTests :: Array TestResult

1495+flattenCaseTests =

1496+ -- Positive cases: should detect

1497+ [ assertWarningCount "FlattenCase: two levels" [flattenCaseRule]

1498+ (withPrelude "foo x y = case x of\n Just a -> case y of\n Just b -> a + b\n _ -> 0\n _ -> 0") 1

1499+ , assertRuleId "FlattenCase: correct rule id" [flattenCaseRule]

1500+ (withPrelude "foo x y = case x of\n Just a -> case y of\n Just b -> a + b\n _ -> 0\n _ -> 0") "FlattenCase"

1501+ , assertSuggestion "FlattenCase: suggestion format" [flattenCaseRule]

1502+ (withPrelude "foo x y = case x of\n Just a -> case y of\n Just b -> a + b\n _ -> 0\n _ -> 0") "case x, y of\n Just a, Just b -> a + b\n _, _ -> 0"

1503+

1504+ -- Negative cases: should NOT detect

1505+ , assertWarningCount "FlattenCase: single level" [flattenCaseRule]

1506+ (withPrelude "foo x = case x of\n Just a -> a\n _ -> 0") 0

1507+ , assertWarningCount "FlattenCase: different fallbacks" [flattenCaseRule]

1508+ (withPrelude "foo x y = case x of\n Just a -> case y of\n Just b -> a + b\n _ -> 1\n _ -> 0") 0

1509+ ]

1510+

1511+-- ============================================================================

1512+-- UsePatternGuards Tests

1513+-- ============================================================================

1514+

1515+usePatternGuardsTests :: Array TestResult

1516+usePatternGuardsTests =

1517+ -- Positive cases: should detect

1518+ [ assertWarningCount "UsePatternGuards: two levels" [usePatternGuardsRule]

1519+ (withPrelude "foo x y = case x of\n Just a -> case y of\n Just b -> a + b\n _ -> 0\n _ -> 0") 1

1520+ , assertRuleId "UsePatternGuards: correct rule id" [usePatternGuardsRule]

1521+ (withPrelude "foo x y = case x of\n Just a -> case y of\n Just b -> a + b\n _ -> 0\n _ -> 0") "UsePatternGuards"

1522+ , assertWarningCount "UsePatternGuards: three levels" [usePatternGuardsRule]

1523+ (withPrelude "foo x y z = case x of\n Just a -> case y of\n Just b -> case z of\n Just c -> a + b + c\n _ -> 0\n _ -> 0\n _ -> 0") 2

1524+

1525+ -- Negative cases: should NOT detect

1526+ , assertWarningCount "UsePatternGuards: single level" [usePatternGuardsRule]

1527+ (withPrelude "foo x = case x of\n Just a -> a\n _ -> 0") 0

1528+ , assertWarningCount "UsePatternGuards: different fallbacks" [usePatternGuardsRule]

1529+ (withPrelude "foo x y = case x of\n Just a -> case y of\n Just b -> a + b\n _ -> 1\n _ -> 0") 0

1530+

1531+ -- Fix test: verifies correct indentation relative to original branch position

1532+ , assertFix "UsePatternGuards: fix with proper indentation" [usePatternGuardsRule]

1533+ (withPrelude "foo x y = case x of\n Just a -> case y of\n Just b -> a + b\n _ -> 0\n _ -> 0")

1534+ (withPrelude "foo x y = case x of\n Just a\n | Just b <- y -> a + b\n _ -> 0")

1535+ ]

1536+

1537+-- | Helper for Alternative imports

1538+withAlt :: String -> String

1539+withAlt code = """

1540+module Test where

1541+import Prelude

1542+import Control.Alternative (empty, (<|>))

1543+import Data.Maybe (Maybe(..), Nothing, Just)

1544+""" <> code

1545+

12971546-- | All rules for golden testing

12981547allRulesForGolden :: Array Rule

12991548allRulesForGolden =

1300− [ fmapIdRule

1549+ [ mapIdentityRule

13011550 , mapFusionRule

13021551 , useTraverseRule

13031552 , concatMapRule

@@ -1343,200 +1592,207 @@ allRulesForGolden =

13431592 , useFindMapRule

13441593 ]

13451594

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"

1595+goldenTests :: Effect (Array TestResult)

1596+goldenTests = traverse identity

1597+ -- MapIdentity: map identity x -> x

1598+ [ assertFixFormatted "Golden: MapIdentity fix" [mapIdentityRule]

1599+ (withPrelude "x = map identity [ 1, 2, 3 ]")

1600+ (withPrelude "x = [ 1, 2, 3 ]")

1601+

1602+ -- MapFusion: map f (map g x) -> map (f <<< g) x

1603+ , assertFixFormatted "Golden: MapFusion fix" [mapFusionRule]

1604+ (withPrelude "x = map show (map (_ + 1) [ 1, 2, 3 ])")

1605+ (withPrelude "x = map (show <<< (_ + 1)) [ 1, 2, 3 ]")

1606+

1607+ -- UseTraverse: sequence (map f x) -> mapM f x

1608+ , assertFixFormatted "Golden: UseTraverse fix" [useTraverseRule]

1609+ (withPrelude "x f xs = sequence (map f xs)")

1610+ (withPrelude "x f xs = mapM f xs")

1611+

1612+ -- ConcatMap: join (map f x) -> (=<<) f x

1613+ , assertFixFormatted "Golden: ConcatMap fix" [concatMapRule]

1614+ (withPrelude "x f xs = join (map f xs)")

1615+ (withPrelude "x f xs = (=<<) f xs")

1616+

1617+ -- NotEqual: not (a == b) -> a /= b

1618+ , assertFixFormatted "Golden: NotEqual fix" [notEqualRule]

1619+ (withPrelude "x a b = not (a == b)")

1620+ (withPrelude "x a b = a /= b")

1621+

1622+ -- EtaReduce: \x -> f x -> f

1623+ , assertFixFormatted "Golden: EtaReduce fix" [etaReduceRule]

1624+ (withPrelude "x = \\y -> show y")

1625+ (withPrelude "x = show")

1626+

1627+ -- RedundantBind: pure x >>= f -> f x

1628+ , assertFixFormatted "Golden: RedundantBind fix" [redundantBindRule]

1629+ (withPrelude "x y f = pure y >>= f")

1630+ (withPrelude "x y f = f y")

1631+

1632+ -- RedundantIf: if a then true else false -> a

1633+ , assertFixFormatted "Golden: RedundantIf fix" [redundantIfRule]

1634+ (withPrelude "x a = if a then true else false")

1635+ (withPrelude "x a = a")

1636+

1637+ -- UseVoid: a *> pure unit -> void a

1638+ , assertFixFormatted "Golden: UseVoid fix" [useVoidRule]

1639+ (withPrelude "x a = a *> pure unit")

1640+ (withPrelude "x a = void a")

1641+

1642+ -- UseJoin: x >>= identity -> join x

1643+ , assertFixFormatted "Golden: UseJoin fix" [useJoinRule]

1644+ (withPrelude "x m = m >>= identity")

1645+ (withPrelude "x m = join m")

1646+

1647+ -- UseAny: or (map f x) -> any f x

1648+ , assertFixFormatted "Golden: UseAny fix" [useAnyRule]

1649+ (withPrelude "x f xs = or (map f xs)")

1650+ (withPrelude "x f xs = any f xs")

1651+

1652+ -- UseAll: and (map f x) -> all f x

1653+ , assertFixFormatted "Golden: UseAll fix" [useAllRule]

1654+ (withPrelude "x f xs = and (map f xs)")

1655+ (withPrelude "x f xs = all f xs")

1656+

1657+ -- BooleanSimplify: x == true -> x

1658+ , assertFixFormatted "Golden: BooleanSimplify fix" [booleanSimplifyRule]

1659+ (withPrelude "x a = a == true")

1660+ (withPrelude "x a = a")

1661+

1662+ -- CollapseLambdas: \x -> \y -> body -> \x y -> body

1663+ , assertFixFormatted "Golden: CollapseLambdas fix" [collapseLambdasRule]

1664+ (withPrelude "x = \\a -> \\b -> a + b")

1665+ (withPrelude "x = \\a b -> a + b")

1666+

1667+ -- UseConst: \x -> y -> const y (where y doesn't mention x)

1668+ , assertFixFormatted "Golden: UseConst fix" [useConstRule]

1669+ (withPrelude "x = \\unused -> 42")

1670+ (withPrelude "x = const 42")

1671+

1672+ -- UseNull: length xs == 0 -> null xs

1673+ , assertFixFormatted "Golden: UseNull fix" [useNullRule]

1674+ (withPrelude "x xs = length xs == 0")

1675+ (withPrelude "x xs = null xs")

1676+

1677+ -- UseFromMaybe: maybe def identity -> fromMaybe def

1678+ , assertFixFormatted "Golden: UseFromMaybe fix" [useFromMaybeRule]

1679+ (withPrelude "x def = maybe def identity")

1680+ (withPrelude "x def = fromMaybe def")

1681+

1682+ -- UseIsJust: maybe false (const true) -> isJust

1683+ , assertFixFormatted "Golden: UseIsJust fix" [useIsJustRule]

1684+ (withPrelude "x = maybe false (const true)")

1685+ (withPrelude "x = isJust")

1686+

1687+ -- UseIsNothing: maybe true (const false) -> isNothing

1688+ , assertFixFormatted "Golden: UseIsNothing fix" [useIsNothingRule]

1689+ (withPrelude "x = maybe true (const false)")

1690+ (withPrelude "x = isNothing")

1691+

1692+ -- UseWhen: if cond then action else pure unit -> when cond action

1693+ , assertFixFormatted "Golden: UseWhen fix" [useWhenRule]

1694+ (withPrelude "x cond action = if cond then action else pure unit")

1695+ (withPrelude "x cond action = when cond action")

1696+

1697+ -- UseUnless: if cond then pure unit else action -> unless cond action

1698+ , assertFixFormatted "Golden: UseUnless fix" [useUnlessRule]

1699+ (withPrelude "x cond action = if cond then pure unit else action")

1700+ (withPrelude "x cond action = unless cond action")

1701+

1702+ -- RedundantFlip: flip (flip f) -> f

1703+ , assertFixFormatted "Golden: RedundantFlip fix" [redundantFlipRule]

1704+ (withPrelude "x f = flip (flip f)")

1705+ (withPrelude "x f = f")

1706+

1707+ -- UseNotElem: not (elem x xs) -> notElem x xs

1708+ , assertFixFormatted "Golden: UseNotElem fix" [useNotElemRule]

1709+ (withPrelude "x a xs = not (elem a xs)")

1710+ (withPrelude "x a xs = notElem a xs")

1711+

1712+ -- UseMinMax: if a > b then a else b -> max a b

1713+ , assertFixFormatted "Golden: UseMinMax fix" [useMinMaxRule]

1714+ (withPrelude "x a b = if a > b then a else b")

1715+ (withPrelude "x a b = max a b")

1716+

1717+ -- MonoidIdentity: mempty <> x -> x

1718+ , assertFixFormatted "Golden: MonoidIdentity fix" [monoidIdentityRule]

1719+ (withPrelude "x xs = mempty <> xs")

1720+ (withPrelude "x xs = xs")

1721+

1722+ -- UseFold: foldMap identity -> fold

1723+ , assertFixFormatted "Golden: UseFold fix" [useFoldRule]

1724+ (withPrelude "x = foldMap identity")

1725+ (withPrelude "x = fold")

1726+

1727+ -- UseSequence: traverse identity -> sequence

1728+ , assertFixFormatted "Golden: UseSequence fix" [useSequenceRule]

1729+ (withPrelude "x = traverse identity")

1730+ (withPrelude "x = sequence")

1731+

1732+ -- RedundantNot: not (not x) -> x

1733+ , assertFixFormatted "Golden: RedundantNot fix" [redundantNotRule]

1734+ (withPrelude "x a = not (not a)")

1735+ (withPrelude "x a = a")

1736+

1737+ -- UseFstSnd: \(Tuple x _) -> x -> fst

1738+ , assertFixFormatted "Golden: UseFstSnd fix" [useFstSndRule]

1739+ (withPrelude "x = \\(Tuple a b) -> a")

1740+ (withPrelude "x = fst")

1741+

1742+ -- UseMapMaybe: catMaybes (map f x) -> mapMaybe f x

1743+ , assertFixFormatted "Golden: UseMapMaybe fix" [useMapMaybeRule]

1744+ (withPrelude "x f xs = catMaybes (map f xs)")

1745+ (withPrelude "x f xs = mapMaybe f xs")

1746+

1747+ -- UseApplicative: pure f <*> x -> f <$> x

1748+ , assertFixFormatted "Golden: UseApplicative fix" [useApplicativeRule]

1749+ (withPrelude "x f y = pure f <*> y")

1750+ (withPrelude "x f y = f <$> y")

1751+

1752+ -- UseBindFlip: join (map f x) -> x >>= f

1753+ , assertFixFormatted "Golden: UseBindFlip fix" [useBindFlipRule]

1754+ (withPrelude "x f y = join (map f y)")

1755+ (withPrelude "x f y = y >>= f")

1756+

1757+ -- UseFor: flip traverse -> for

1758+ , assertFixFormatted "Golden: UseFor fix" [useForRule]

1759+ (withPrelude "x = flip traverse")

1760+ (withPrelude "x = for")

1761+

1762+ -- RedundantGuard: guard true -> pure unit

1763+ , assertFixFormatted "Golden: RedundantGuard fix" [redundantGuardRule]

1764+ (withPrelude "x = guard true")

1765+ (withPrelude "x = pure unit")

1766+

1767+ -- UseComparing: \a b -> compare (f a) (f b) -> comparing f

1768+ , assertFixFormatted "Golden: UseComparing fix" [useComparingRule]

1769+ (withPrelude "x f = \\a b -> compare (f a) (f b)")

1770+ (withPrelude "x f = comparing f")

1771+

1772+ -- UseOn: \a b -> f (g a) (g b) -> on f g

1773+ , assertFixFormatted "Golden: UseOn fix" [useOnRule]

1774+ (withPrelude "x f g = \\a b -> f (g a) (g b)")

1775+ (withPrelude "x f g = on f g")

1776+

1777+ -- UseFindMap: head (mapMaybe f x) -> findMap f x

1778+ , assertFixFormatted "Golden: UseFindMap fix" [useFindMapRule]

1779+ (withPrelude "x f xs = head (mapMaybe f xs)")

1780+ (withPrelude "x f xs = findMap f xs")

1781+

1782+ -- LetToDo: nested let...in -> do notation (do on previous line)

1783+ , pure $ assertFix "Golden: LetToDo nested fix" [letToDoRule]

1784+ (withPrelude "x f =\n case f of\n Just y ->\n let\n z = y + 1\n in z * 2\n Nothing -> 0")

1785+ (withPrelude "x f =\n case f of\n Just y -> do\n let\n z = y + 1\n z * 2\n Nothing -> 0")

1786+

1787+ -- LetToDo: should NOT fire on do-let (no "in" keyword)

1788+ , pure $ assertWarningCount "Golden: LetToDo no fire on do-let" [letToDoRule]

1789+ (withPrelude "x f =\n case f of\n Just y -> do\n let\n z = y + 1\n [ z ]\n Nothing -> []")

1790+ 0

1791+

1792+ -- UsePatternGuards: should preserve do-let body structure

1793+ , pure $ assertFix "Golden: UsePatternGuards preserves do-let" [usePatternGuardsRule]

1794+ (withPrelude "checkExpr expr =\n case expr of\n Just mapArgs ->\n case toArray mapArgs of\n [ x, y ] -> do\n let\n f = show x\n g = show y\n [ f, g ]\n _ -> []\n _ -> []")

1795+ (withPrelude "checkExpr expr =\n case expr of\n Just mapArgs\n | [ x, y ] <- toArray mapArgs -> do\n let\n f = show x\n g = show y\n [ f, g ]\n _ -> [ ]")

15401796 ]

15411797

15421798-- ============================================================================

@@ -1575,7 +1831,7 @@ tidySuggestions =

15751831 , { name: "traverse f xs", suggestion: "traverse f xs" }

15761832 , { name: "collapsed lambda", suggestion: "\\a b -> a + b" }

15771833 , { name: "map fusion", suggestion: "map (f <<< g) x" }

1578− , { name: "fmap fusion", suggestion: "(f <<< g) <$> x" }

1834+ , { name: "map fusion with <$>", suggestion: "(f <<< g) <$> x" }

15791835 , { name: "flipped map fusion", suggestion: "x <#> (g >>> f)" }

15801836 , { name: "where clause", suggestion: "y + 1\n where\n y = 1" }

15811837 ]

vscode-extension/.gitignorenew file+1

@@ -0,0 +1 @@

1+.vscode-test/

vscode-extension/out/extension.jsnew file+77

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

1+"use strict";

2+var __createBinding = (this && this.__createBinding) || (Object.create ? (function(o, m, k, k2) {

3+ if (k2 === undefined) k2 = k;

4+ var desc = Object.getOwnPropertyDescriptor(m, k);

5+ if (!desc || ("get" in desc ? !m.__esModule : desc.writable || desc.configurable)) {

6+ desc = { enumerable: true, get: function() { return m[k]; } };

7+ }

8+ Object.defineProperty(o, k2, desc);

9+}) : (function(o, m, k, k2) {

10+ if (k2 === undefined) k2 = k;

11+ o[k2] = m[k];

12+}));

13+var __setModuleDefault = (this && this.__setModuleDefault) || (Object.create ? (function(o, v) {

14+ Object.defineProperty(o, "default", { enumerable: true, value: v });

15+}) : function(o, v) {

16+ o["default"] = v;

17+});

18+var __importStar = (this && this.__importStar) || (function () {

19+ var ownKeys = function(o) {

20+ ownKeys = Object.getOwnPropertyNames || function (o) {

21+ var ar = [];

22+ for (var k in o) if (Object.prototype.hasOwnProperty.call(o, k)) ar[ar.length] = k;

23+ return ar;

24+ };

25+ return ownKeys(o);

26+ };

27+ return function (mod) {

28+ if (mod && mod.__esModule) return mod;

29+ var result = {};

30+ if (mod != null) for (var k = ownKeys(mod), i = 0; i < k.length; i++) if (k[i] !== "default") __createBinding(result, mod, k[i]);

31+ __setModuleDefault(result, mod);

32+ return result;

33+ };

34+})();

35+Object.defineProperty(exports, "__esModule", { value: true });

36+exports.activate = activate;

37+exports.deactivate = deactivate;

38+const vscode = __importStar(require("vscode"));

39+const node_1 = require("vscode-languageclient/node");

40+let client;

41+function activate(context) {

42+ const config = vscode.workspace.getConfiguration('purelint');

43+ if (!config.get('enable', true)) {

44+ return;

45+ }

46+ // Get server path from config or use default

47+ let serverPath = config.get('serverPath', '');

48+ if (!serverPath) {

49+ // Default to the purelint project location

50+ serverPath = '/Users/mark/Developer/purelint/dist/purelint-lsp.js';

51+ }

52+ const serverOptions = {

53+ run: {

54+ module: serverPath,

55+ transport: node_1.TransportKind.stdio

56+ },

57+ debug: {

58+ module: serverPath,

59+ transport: node_1.TransportKind.stdio

60+ }

61+ };

62+ const clientOptions = {

63+ documentSelector: [{ scheme: 'file', language: 'purescript' }],

64+ synchronize: {

65+ fileEvents: vscode.workspace.createFileSystemWatcher('**/*.purs')

66+ }

67+ };

68+ client = new node_1.LanguageClient('purelint', 'Purelint', serverOptions, clientOptions);

69+ client.start();

70+}

71+function deactivate() {

72+ if (!client) {

73+ return undefined;

74+ }

75+ return client.stop();

76+}

77+//# sourceMappingURL=extension.js.map

vscode-extension/out/extension.js.mapnew file+1

@@ -0,0 +1 @@

1+{"version":3,"file":"extension.js","sourceRoot":"","sources":["../src/extension.ts"],"names":[],"mappings":";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;AAWA,4BAwCC;AAED,gCAKC;AAzDD,+CAAiC;AACjC,qDAKoC;AAEpC,IAAI,MAAkC,CAAC;AAEvC,SAAgB,QAAQ,CAAC,OAAgC;IACvD,MAAM,MAAM,GAAG,MAAM,CAAC,SAAS,CAAC,gBAAgB,CAAC,UAAU,CAAC,CAAC;IAE7D,IAAI,CAAC,MAAM,CAAC,GAAG,CAAU,QAAQ,EAAE,IAAI,CAAC,EAAE,CAAC;QACzC,OAAO;IACT,CAAC;IAED,6CAA6C;IAC7C,IAAI,UAAU,GAAG,MAAM,CAAC,GAAG,CAAS,YAAY,EAAE,EAAE,CAAC,CAAC;IACtD,IAAI,CAAC,UAAU,EAAE,CAAC;QAChB,2CAA2C;QAC3C,UAAU,GAAG,qDAAqD,CAAC;IACrE,CAAC;IAED,MAAM,aAAa,GAAkB;QACnC,GAAG,EAAE;YACH,MAAM,EAAE,UAAU;YAClB,SAAS,EAAE,oBAAa,CAAC,KAAK;SAC/B;QACD,KAAK,EAAE;YACL,MAAM,EAAE,UAAU;YAClB,SAAS,EAAE,oBAAa,CAAC,KAAK;SAC/B;KACF,CAAC;IAEF,MAAM,aAAa,GAA0B;QAC3C,gBAAgB,EAAE,CAAC,EAAE,MAAM,EAAE,MAAM,EAAE,QAAQ,EAAE,YAAY,EAAE,CAAC;QAC9D,WAAW,EAAE;YACX,UAAU,EAAE,MAAM,CAAC,SAAS,CAAC,uBAAuB,CAAC,WAAW,CAAC;SAClE;KACF,CAAC;IAEF,MAAM,GAAG,IAAI,qBAAc,CACzB,UAAU,EACV,UAAU,EACV,aAAa,EACb,aAAa,CACd,CAAC;IAEF,MAAM,CAAC,KAAK,EAAE,CAAC;AACjB,CAAC;AAED,SAAgB,UAAU;IACxB,IAAI,CAAC,MAAM,EAAE,CAAC;QACZ,OAAO,SAAS,CAAC;IACnB,CAAC;IACD,OAAO,MAAM,CAAC,IAAI,EAAE,CAAC;AACvB,CAAC"}

vscode-extension/out/test/runTest.jsnew file+55

@@ -0,0 +1,55 @@

1+"use strict";

2+var __createBinding = (this && this.__createBinding) || (Object.create ? (function(o, m, k, k2) {

3+ if (k2 === undefined) k2 = k;

4+ var desc = Object.getOwnPropertyDescriptor(m, k);

5+ if (!desc || ("get" in desc ? !m.__esModule : desc.writable || desc.configurable)) {

6+ desc = { enumerable: true, get: function() { return m[k]; } };

7+ }

8+ Object.defineProperty(o, k2, desc);

9+}) : (function(o, m, k, k2) {

10+ if (k2 === undefined) k2 = k;

11+ o[k2] = m[k];

12+}));

13+var __setModuleDefault = (this && this.__setModuleDefault) || (Object.create ? (function(o, v) {

14+ Object.defineProperty(o, "default", { enumerable: true, value: v });

15+}) : function(o, v) {

16+ o["default"] = v;

17+});

18+var __importStar = (this && this.__importStar) || (function () {

19+ var ownKeys = function(o) {

20+ ownKeys = Object.getOwnPropertyNames || function (o) {

21+ var ar = [];

22+ for (var k in o) if (Object.prototype.hasOwnProperty.call(o, k)) ar[ar.length] = k;

23+ return ar;

24+ };

25+ return ownKeys(o);

26+ };

27+ return function (mod) {

28+ if (mod && mod.__esModule) return mod;

29+ var result = {};

30+ if (mod != null) for (var k = ownKeys(mod), i = 0; i < k.length; i++) if (k[i] !== "default") __createBinding(result, mod, k[i]);

31+ __setModuleDefault(result, mod);

32+ return result;

33+ };

34+})();

35+Object.defineProperty(exports, "__esModule", { value: true });

36+const path = __importStar(require("path"));

37+const test_electron_1 = require("@vscode/test-electron");

38+async function main() {

39+ try {

40+ const extensionDevelopmentPath = path.resolve(__dirname, '../../');

41+ const extensionTestsPath = path.resolve(__dirname, './suite/index');

42+ const testWorkspace = path.resolve(__dirname, '../../test-workspace');

43+ await (0, test_electron_1.runTests)({

44+ extensionDevelopmentPath,

45+ extensionTestsPath,

46+ launchArgs: [testWorkspace, '--disable-extensions']

47+ });

48+ }

49+ catch (err) {

50+ console.error('Failed to run tests', err);

51+ process.exit(1);

52+ }

53+}

54+main();

55+//# sourceMappingURL=runTest.js.map

vscode-extension/out/test/runTest.js.mapnew file+1

@@ -0,0 +1 @@

1+{"version":3,"file":"runTest.js","sourceRoot":"","sources":["../../src/test/runTest.ts"],"names":[],"mappings":";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;AAAA,2CAA6B;AAC7B,yDAAiD;AAEjD,KAAK,UAAU,IAAI;IACjB,IAAI,CAAC;QACH,MAAM,wBAAwB,GAAG,IAAI,CAAC,OAAO,CAAC,SAAS,EAAE,QAAQ,CAAC,CAAC;QACnE,MAAM,kBAAkB,GAAG,IAAI,CAAC,OAAO,CAAC,SAAS,EAAE,eAAe,CAAC,CAAC;QACpE,MAAM,aAAa,GAAG,IAAI,CAAC,OAAO,CAAC,SAAS,EAAE,sBAAsB,CAAC,CAAC;QAEtE,MAAM,IAAA,wBAAQ,EAAC;YACb,wBAAwB;YACxB,kBAAkB;YAClB,UAAU,EAAE,CAAC,aAAa,EAAE,sBAAsB,CAAC;SACpD,CAAC,CAAC;IACL,CAAC;IAAC,OAAO,GAAG,EAAE,CAAC;QACb,OAAO,CAAC,KAAK,CAAC,qBAAqB,EAAE,GAAG,CAAC,CAAC;QAC1C,OAAO,CAAC,IAAI,CAAC,CAAC,CAAC,CAAC;IAClB,CAAC;AACH,CAAC;AAED,IAAI,EAAE,CAAC"}

vscode-extension/out/test/suite/extension.test.jsnew file+75

@@ -0,0 +1,75 @@

1+"use strict";

2+var __createBinding = (this && this.__createBinding) || (Object.create ? (function(o, m, k, k2) {

3+ if (k2 === undefined) k2 = k;

4+ var desc = Object.getOwnPropertyDescriptor(m, k);

5+ if (!desc || ("get" in desc ? !m.__esModule : desc.writable || desc.configurable)) {

6+ desc = { enumerable: true, get: function() { return m[k]; } };

7+ }

8+ Object.defineProperty(o, k2, desc);

9+}) : (function(o, m, k, k2) {

10+ if (k2 === undefined) k2 = k;

11+ o[k2] = m[k];

12+}));

13+var __setModuleDefault = (this && this.__setModuleDefault) || (Object.create ? (function(o, v) {

14+ Object.defineProperty(o, "default", { enumerable: true, value: v });

15+}) : function(o, v) {

16+ o["default"] = v;

17+});

18+var __importStar = (this && this.__importStar) || (function () {

19+ var ownKeys = function(o) {

20+ ownKeys = Object.getOwnPropertyNames || function (o) {

21+ var ar = [];

22+ for (var k in o) if (Object.prototype.hasOwnProperty.call(o, k)) ar[ar.length] = k;

23+ return ar;

24+ };

25+ return ownKeys(o);

26+ };

27+ return function (mod) {

28+ if (mod && mod.__esModule) return mod;

29+ var result = {};

30+ if (mod != null) for (var k = ownKeys(mod), i = 0; i < k.length; i++) if (k[i] !== "default") __createBinding(result, mod, k[i]);

31+ __setModuleDefault(result, mod);

32+ return result;

33+ };

34+})();

35+Object.defineProperty(exports, "__esModule", { value: true });

36+const assert = __importStar(require("assert"));

37+const vscode = __importStar(require("vscode"));

38+const path = __importStar(require("path"));

39+suite('Purelint Extension Test Suite', () => {

40+ vscode.window.showInformationMessage('Start all tests.');

41+ test('Extension should be present', () => {

42+ assert.ok(vscode.extensions.getExtension('purelint.purelint'));

43+ });

44+ test('Extension should activate on PureScript file', async () => {

45+ const ext = vscode.extensions.getExtension('purelint.purelint');

46+ assert.ok(ext);

47+ // Open a PureScript file to trigger activation

48+ const testFile = path.join(__dirname, '../../../test-workspace/Test.purs');

49+ const uri = vscode.Uri.file(testFile);

50+ const doc = await vscode.workspace.openTextDocument(uri);

51+ await vscode.window.showTextDocument(doc);

52+ // Wait for extension to activate

53+ await ext.activate();

54+ assert.ok(ext.isActive);

55+ });

56+ test('Should provide code actions', async () => {

57+ const ext = vscode.extensions.getExtension('purelint.purelint');

58+ if (!ext?.isActive) {

59+ await ext?.activate();

60+ }

61+ const testFile = path.join(__dirname, '../../../test-workspace/Test.purs');

62+ const uri = vscode.Uri.file(testFile);

63+ const doc = await vscode.workspace.openTextDocument(uri);

64+ await vscode.window.showTextDocument(doc);

65+ // Wait for LSP to start and process document

66+ await new Promise(resolve => setTimeout(resolve, 3000));

67+ // Try to get code actions for the whole document

68+ const range = new vscode.Range(0, 0, doc.lineCount, 0);

69+ const codeActions = await vscode.commands.executeCommand('vscode.executeCodeActionProvider', doc.uri, range);

70+ // Code actions may or may not be present depending on LSP connection

71+ // Just verify the command doesn't throw

72+ assert.ok(Array.isArray(codeActions) || codeActions === undefined, 'Should return array or undefined');

73+ });

74+});

75+//# sourceMappingURL=extension.test.js.map

vscode-extension/out/test/suite/extension.test.js.mapnew file+1

@@ -0,0 +1 @@

1+{"version":3,"file":"extension.test.js","sourceRoot":"","sources":["../../../src/test/suite/extension.test.ts"],"names":[],"mappings":";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;AAAA,+CAAiC;AACjC,+CAAiC;AACjC,2CAA6B;AAE7B,KAAK,CAAC,+BAA+B,EAAE,GAAG,EAAE;IAC1C,MAAM,CAAC,MAAM,CAAC,sBAAsB,CAAC,kBAAkB,CAAC,CAAC;IAEzD,IAAI,CAAC,6BAA6B,EAAE,GAAG,EAAE;QACvC,MAAM,CAAC,EAAE,CAAC,MAAM,CAAC,UAAU,CAAC,YAAY,CAAC,mBAAmB,CAAC,CAAC,CAAC;IACjE,CAAC,CAAC,CAAC;IAEH,IAAI,CAAC,8CAA8C,EAAE,KAAK,IAAI,EAAE;QAC9D,MAAM,GAAG,GAAG,MAAM,CAAC,UAAU,CAAC,YAAY,CAAC,mBAAmB,CAAC,CAAC;QAChE,MAAM,CAAC,EAAE,CAAC,GAAG,CAAC,CAAC;QAEf,+CAA+C;QAC/C,MAAM,QAAQ,GAAG,IAAI,CAAC,IAAI,CAAC,SAAS,EAAE,mCAAmC,CAAC,CAAC;QAC3E,MAAM,GAAG,GAAG,MAAM,CAAC,GAAG,CAAC,IAAI,CAAC,QAAQ,CAAC,CAAC;QACtC,MAAM,GAAG,GAAG,MAAM,MAAM,CAAC,SAAS,CAAC,gBAAgB,CAAC,GAAG,CAAC,CAAC;QACzD,MAAM,MAAM,CAAC,MAAM,CAAC,gBAAgB,CAAC,GAAG,CAAC,CAAC;QAE1C,iCAAiC;QACjC,MAAM,GAAG,CAAC,QAAQ,EAAE,CAAC;QACrB,MAAM,CAAC,EAAE,CAAC,GAAG,CAAC,QAAQ,CAAC,CAAC;IAC1B,CAAC,CAAC,CAAC;IAEH,IAAI,CAAC,6BAA6B,EAAE,KAAK,IAAI,EAAE;QAC7C,MAAM,GAAG,GAAG,MAAM,CAAC,UAAU,CAAC,YAAY,CAAC,mBAAmB,CAAC,CAAC;QAChE,IAAI,CAAC,GAAG,EAAE,QAAQ,EAAE,CAAC;YACnB,MAAM,GAAG,EAAE,QAAQ,EAAE,CAAC;QACxB,CAAC;QAED,MAAM,QAAQ,GAAG,IAAI,CAAC,IAAI,CAAC,SAAS,EAAE,mCAAmC,CAAC,CAAC;QAC3E,MAAM,GAAG,GAAG,MAAM,CAAC,GAAG,CAAC,IAAI,CAAC,QAAQ,CAAC,CAAC;QACtC,MAAM,GAAG,GAAG,MAAM,MAAM,CAAC,SAAS,CAAC,gBAAgB,CAAC,GAAG,CAAC,CAAC;QACzD,MAAM,MAAM,CAAC,MAAM,CAAC,gBAAgB,CAAC,GAAG,CAAC,CAAC;QAE1C,6CAA6C;QAC7C,MAAM,IAAI,OAAO,CAAC,OAAO,CAAC,EAAE,CAAC,UAAU,CAAC,OAAO,EAAE,IAAI,CAAC,CAAC,CAAC;QAExD,iDAAiD;QACjD,MAAM,KAAK,GAAG,IAAI,MAAM,CAAC,KAAK,CAAC,CAAC,EAAE,CAAC,EAAE,GAAG,CAAC,SAAS,EAAE,CAAC,CAAC,CAAC;QAEvD,MAAM,WAAW,GAAG,MAAM,MAAM,CAAC,QAAQ,CAAC,cAAc,CACtD,kCAAkC,EAClC,GAAG,CAAC,GAAG,EACP,KAAK,CACN,CAAC;QAEF,qEAAqE;QACrE,wCAAwC;QACxC,MAAM,CAAC,EAAE,CAAC,KAAK,CAAC,OAAO,CAAC,WAAW,CAAC,IAAI,WAAW,KAAK,SAAS,EAAE,kCAAkC,CAAC,CAAC;IACzG,CAAC,CAAC,CAAC;AACL,CAAC,CAAC,CAAC"}

vscode-extension/out/test/suite/index.jsnew file+63

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

1+"use strict";

2+var __createBinding = (this && this.__createBinding) || (Object.create ? (function(o, m, k, k2) {

3+ if (k2 === undefined) k2 = k;

4+ var desc = Object.getOwnPropertyDescriptor(m, k);

5+ if (!desc || ("get" in desc ? !m.__esModule : desc.writable || desc.configurable)) {

6+ desc = { enumerable: true, get: function() { return m[k]; } };

7+ }

8+ Object.defineProperty(o, k2, desc);

9+}) : (function(o, m, k, k2) {

10+ if (k2 === undefined) k2 = k;

11+ o[k2] = m[k];

12+}));

13+var __setModuleDefault = (this && this.__setModuleDefault) || (Object.create ? (function(o, v) {

14+ Object.defineProperty(o, "default", { enumerable: true, value: v });

15+}) : function(o, v) {

16+ o["default"] = v;

17+});

18+var __importStar = (this && this.__importStar) || (function () {

19+ var ownKeys = function(o) {

20+ ownKeys = Object.getOwnPropertyNames || function (o) {

21+ var ar = [];

22+ for (var k in o) if (Object.prototype.hasOwnProperty.call(o, k)) ar[ar.length] = k;

23+ return ar;

24+ };

25+ return ownKeys(o);

26+ };

27+ return function (mod) {

28+ if (mod && mod.__esModule) return mod;

29+ var result = {};

30+ if (mod != null) for (var k = ownKeys(mod), i = 0; i < k.length; i++) if (k[i] !== "default") __createBinding(result, mod, k[i]);

31+ __setModuleDefault(result, mod);

32+ return result;

33+ };

34+})();

35+var __importDefault = (this && this.__importDefault) || function (mod) {

36+ return (mod && mod.__esModule) ? mod : { "default": mod };

37+};

38+Object.defineProperty(exports, "__esModule", { value: true });

39+exports.run = run;

40+const path = __importStar(require("path"));

41+const mocha_1 = __importDefault(require("mocha"));

42+const glob_1 = require("glob");

43+async function run() {

44+ const mocha = new mocha_1.default({

45+ ui: 'tdd',

46+ color: true,

47+ timeout: 60000

48+ });

49+ const testsRoot = path.resolve(__dirname, '.');

50+ const files = await (0, glob_1.glob)('**/**.test.js', { cwd: testsRoot });

51+ files.forEach(f => mocha.addFile(path.resolve(testsRoot, f)));

52+ return new Promise((resolve, reject) => {

53+ mocha.run(failures => {

54+ if (failures > 0) {

55+ reject(new Error(`${failures} tests failed.`));

56+ }

57+ else {

58+ resolve();

59+ }

60+ });

61+ });

62+}

63+//# sourceMappingURL=index.js.map

vscode-extension/out/test/suite/index.js.mapnew file+1

@@ -0,0 +1 @@

1+{"version":3,"file":"index.js","sourceRoot":"","sources":["../../../src/test/suite/index.ts"],"names":[],"mappings":";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;AAIA,kBAqBC;AAzBD,2CAA6B;AAC7B,kDAA0B;AAC1B,+BAA4B;AAErB,KAAK,UAAU,GAAG;IACvB,MAAM,KAAK,GAAG,IAAI,eAAK,CAAC;QACtB,EAAE,EAAE,KAAK;QACT,KAAK,EAAE,IAAI;QACX,OAAO,EAAE,KAAK;KACf,CAAC,CAAC;IAEH,MAAM,SAAS,GAAG,IAAI,CAAC,OAAO,CAAC,SAAS,EAAE,GAAG,CAAC,CAAC;IAC/C,MAAM,KAAK,GAAG,MAAM,IAAA,WAAI,EAAC,eAAe,EAAE,EAAE,GAAG,EAAE,SAAS,EAAE,CAAC,CAAC;IAE9D,KAAK,CAAC,OAAO,CAAC,CAAC,CAAC,EAAE,CAAC,KAAK,CAAC,OAAO,CAAC,IAAI,CAAC,OAAO,CAAC,SAAS,EAAE,CAAC,CAAC,CAAC,CAAC,CAAC;IAE9D,OAAO,IAAI,OAAO,CAAC,CAAC,OAAO,EAAE,MAAM,EAAE,EAAE;QACrC,KAAK,CAAC,GAAG,CAAC,QAAQ,CAAC,EAAE;YACnB,IAAI,QAAQ,GAAG,CAAC,EAAE,CAAC;gBACjB,MAAM,CAAC,IAAI,KAAK,CAAC,GAAG,QAAQ,gBAAgB,CAAC,CAAC,CAAC;YACjD,CAAC;iBAAM,CAAC;gBACN,OAAO,EAAE,CAAC;YACZ,CAAC;QACH,CAAC,CAAC,CAAC;IACL,CAAC,CAAC,CAAC;AACL,CAAC"}

vscode-extension/package.jsonnew file+54

@@ -0,0 +1,54 @@

1+{

2+ "name": "purelint",

3+ "displayName": "Purelint",

4+ "description": "PureScript linter inspired by hlint",

5+ "version": "0.1.0",

6+ "publisher": "purelint",

7+ "engines": {

8+ "vscode": "^1.85.0"

9+ },

10+ "categories": [

11+ "Linters",

12+ "Programming Languages"

13+ ],

14+ "activationEvents": [

15+ "onLanguage:purescript"

16+ ],

17+ "main": "./out/extension.js",

18+ "contributes": {

19+ "configuration": {

20+ "type": "object",

21+ "title": "Purelint",

22+ "properties": {

23+ "purelint.enable": {

24+ "type": "boolean",

25+ "default": true,

26+ "description": "Enable/disable purelint"

27+ },

28+ "purelint.serverPath": {

29+ "type": "string",

30+ "default": "",

31+ "description": "Path to purelint-lsp executable (uses bundled version if empty)"

32+ }

33+ }

34+ }

35+ },

36+ "scripts": {

37+ "vscode:prepublish": "npm run compile",

38+ "compile": "tsc -p ./",

39+ "watch": "tsc -watch -p ./",

40+ "test": "npm run compile && node ./out/test/runTest.js"

41+ },

42+ "dependencies": {

43+ "vscode-languageclient": "^9.0.1"

44+ },

45+ "devDependencies": {

46+ "@types/vscode": "^1.85.0",

47+ "@types/node": "^20.10.0",

48+ "@types/mocha": "^10.0.6",

49+ "@vscode/test-electron": "^2.3.8",

50+ "typescript": "^5.3.0",

51+ "mocha": "^10.2.0",

52+ "glob": "^10.3.10"

53+ }

54+}

vscode-extension/purelint-0.1.0.vsixnew file

Binary file not shown.

vscode-extension/src/extension.tsnew file+59

@@ -0,0 +1,59 @@

1+import * as path from 'path';

2+import * as vscode from 'vscode';

3+import {

4+ LanguageClient,

5+ LanguageClientOptions,

6+ ServerOptions,

7+ TransportKind

8+} from 'vscode-languageclient/node';

10+let client: LanguageClient | undefined;

11+

12+export function activate(context: vscode.ExtensionContext) {

13+ const config = vscode.workspace.getConfiguration('purelint');

14+

15+ if (!config.get<boolean>('enable', true)) {

16+ return;

17+ }

18+

19+ // Get server path from config or use default

20+ let serverPath = config.get<string>('serverPath', '');

21+ if (!serverPath) {

22+ // Default to the purelint project location

23+ serverPath = '/Users/mark/Developer/purelint/dist/purelint-lsp.js';

24+ }

25+

26+ const serverOptions: ServerOptions = {

27+ run: {

28+ module: serverPath,

29+ transport: TransportKind.stdio

30+ },

31+ debug: {

32+ module: serverPath,

33+ transport: TransportKind.stdio

34+ }

35+ };

36+

37+ const clientOptions: LanguageClientOptions = {

38+ documentSelector: [{ scheme: 'file', language: 'purescript' }],

39+ synchronize: {

40+ fileEvents: vscode.workspace.createFileSystemWatcher('**/*.purs')

41+ }

42+ };

43+

44+ client = new LanguageClient(

45+ 'purelint',

46+ 'Purelint',

47+ serverOptions,

48+ clientOptions

49+ );

50+

51+ client.start();

52+}

53+

54+export function deactivate(): Thenable<void> | undefined {

55+ if (!client) {

56+ return undefined;

57+ }

58+ return client.stop();

59+}

vscode-extension/src/test/runTest.tsnew file+21

@@ -0,0 +1,21 @@

1+import * as path from 'path';

2+import { runTests } from '@vscode/test-electron';

4+async function main() {

5+ try {

6+ const extensionDevelopmentPath = path.resolve(__dirname, '../../');

7+ const extensionTestsPath = path.resolve(__dirname, './suite/index');

8+ const testWorkspace = path.resolve(__dirname, '../../test-workspace');

10+ await runTests({

11+ extensionDevelopmentPath,

12+ extensionTestsPath,

13+ launchArgs: [testWorkspace, '--disable-extensions']

14+ });

15+ } catch (err) {

16+ console.error('Failed to run tests', err);

17+ process.exit(1);

18+ }

19+}

20+

21+main();

vscode-extension/src/test/suite/extension.test.tsnew file+54

@@ -0,0 +1,54 @@

1+import * as assert from 'assert';

2+import * as vscode from 'vscode';

3+import * as path from 'path';

5+suite('Purelint Extension Test Suite', () => {

6+ vscode.window.showInformationMessage('Start all tests.');

8+ test('Extension should be present', () => {

9+ assert.ok(vscode.extensions.getExtension('purelint.purelint'));

10+ });

11+

12+ test('Extension should activate on PureScript file', async () => {

13+ const ext = vscode.extensions.getExtension('purelint.purelint');

14+ assert.ok(ext);

15+

16+ // Open a PureScript file to trigger activation

17+ const testFile = path.join(__dirname, '../../../test-workspace/Test.purs');

18+ const uri = vscode.Uri.file(testFile);

19+ const doc = await vscode.workspace.openTextDocument(uri);

20+ await vscode.window.showTextDocument(doc);

21+

22+ // Wait for extension to activate

23+ await ext.activate();

24+ assert.ok(ext.isActive);

25+ });

26+

27+ test('Should provide code actions', async () => {

28+ const ext = vscode.extensions.getExtension('purelint.purelint');

29+ if (!ext?.isActive) {

30+ await ext?.activate();

31+ }

32+

33+ const testFile = path.join(__dirname, '../../../test-workspace/Test.purs');

34+ const uri = vscode.Uri.file(testFile);

35+ const doc = await vscode.workspace.openTextDocument(uri);

36+ await vscode.window.showTextDocument(doc);

37+

38+ // Wait for LSP to start and process document

39+ await new Promise(resolve => setTimeout(resolve, 3000));

40+

41+ // Try to get code actions for the whole document

42+ const range = new vscode.Range(0, 0, doc.lineCount, 0);

43+

44+ const codeActions = await vscode.commands.executeCommand<vscode.CodeAction[]>(

45+ 'vscode.executeCodeActionProvider',

46+ doc.uri,

47+ range

48+ );

49+

50+ // Code actions may or may not be present depending on LSP connection

51+ // Just verify the command doesn't throw

52+ assert.ok(Array.isArray(codeActions) || codeActions === undefined, 'Should return array or undefined');

53+ });

54+});

vscode-extension/src/test/suite/index.tsnew file+26

@@ -0,0 +1,26 @@

1+import * as path from 'path';

2+import Mocha from 'mocha';

3+import { glob } from 'glob';

5+export async function run(): Promise<void> {

6+ const mocha = new Mocha({

7+ ui: 'tdd',

8+ color: true,

9+ timeout: 60000

10+ });

11+

12+ const testsRoot = path.resolve(__dirname, '.');

13+ const files = await glob('**/**.test.js', { cwd: testsRoot });

14+

15+ files.forEach(f => mocha.addFile(path.resolve(testsRoot, f)));

16+

17+ return new Promise((resolve, reject) => {

18+ mocha.run(failures => {

19+ if (failures > 0) {

20+ reject(new Error(`${failures} tests failed.`));

21+ } else {

22+ resolve();

23+ }

24+ });

25+ });

26+}

vscode-extension/test-workspace/Test.pursnew file+13

@@ -0,0 +1,13 @@

1+module Test where

3+import Prelude

5+-- This should trigger a "map identity" warning

6+x = map identity [1, 2, 3]

8+-- This should trigger a "redundant if" warning

9+y = if true then true else false

10+

11+-- Clean code - no warnings

12+z :: Int

13+z = 42

vscode-extension/tsconfig.jsonnew file+14

@@ -0,0 +1,14 @@

1+{

2+ "compilerOptions": {

3+ "module": "commonjs",

4+ "target": "ES2020",

5+ "outDir": "out",

6+ "lib": ["ES2020"],

7+ "sourceMap": true,

8+ "rootDir": "src",

9+ "strict": true,

10+ "esModuleInterop": true,

11+ "skipLibCheck": true

12+ },

13+ "exclude": ["node_modules", ".vscode-test"]

14+}