Skip to content

Commit d87e835

Browse files
authored
Improve DisallowedModuleRule and DisallowedFunctionRule (#13)
* Support for qualified identifiers * Better handle of module rule * Update tests * Bump version * Run ocamlformat
1 parent db8f93a commit d87e835

8 files changed

Lines changed: 163 additions & 29 deletions

Changelog.md

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,8 @@
11
# ReScript Linter Changelog
22

3+
### 2026-02-02 - v0.4.1
4+
* Update DisallowModuleRule and DisallowedFunctionRule
5+
36
### 2026-01-27 - v0.4.0
47
* Updated the AST to ReScript v12.1.0
58

dune-project

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22

33
(name rescript_linter)
44

5-
(version 0.4.0)
5+
(version 0.4.1)
66

77
(generate_opam_files true)
88

lib/rules/DisallowModuleRule.ml

Lines changed: 53 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,29 @@ module Make (OPT : Rule.OPTIONS with type options = Options.options) (LinterOpti
2020
; Rule.ruleIdentifier= "DisallowModule" ^ "[" ^ op ^ "]"
2121
; Rule.ruleDescription= description }
2222

23+
(* Helper function to convert Longident to string *)
24+
let rec longident_to_string = function
25+
| Longident.Lident s -> s
26+
| Longident.Ldot (t, s) -> longident_to_string t ^ "." ^ s
27+
| Longident.Lapply (a, b) -> longident_to_string a ^ "(" ^ longident_to_string b ^ ")"
28+
29+
(* Extract the module path from a Longident (everything except the last component) *)
30+
let extract_module_path = function
31+
| Longident.Lident _ -> None
32+
| Longident.Ldot (t, _) -> Some (longident_to_string t)
33+
| Longident.Lapply (_, _) -> None
34+
35+
(* Check if a module path matches the disallowed module
36+
- Exact match: "Belt" matches "Belt"
37+
- Prefix match: "Belt" matches "Belt.List", "Belt.Array", etc.
38+
- But "Belt" should NOT match "BeltExtra"
39+
*)
40+
let matches_disallowed_module module_path =
41+
module_path = op
42+
|| String.length module_path > String.length op
43+
&& String.sub module_path 0 (String.length op) = op
44+
&& String.get module_path (String.length op) = '.'
45+
2346
(* There are three cases that we need to handle when linting for module usage (assume M is the module name)
2447
2548
1. open M
@@ -46,36 +69,50 @@ module Make (OPT : Rule.OPTIONS with type options = Options.options) (LinterOpti
4669
Rule.LintStructureItem
4770
(fun expr ->
4871
match expr with
49-
(* match open M *)
72+
(* match open M or open M.N *)
5073
| { Parsetree.pstr_desc=
51-
Parsetree.Pstr_open
52-
{Parsetree.popen_lid= {txt= Longident.Lident ident}; Parsetree.popen_loc= loc} }
53-
when ident = op ->
74+
Parsetree.Pstr_open {Parsetree.popen_lid= {txt= ident}; Parsetree.popen_loc= loc} }
75+
when matches_disallowed_module (longident_to_string ident) ->
5476
Rule.LintError (meta.ruleDescription, loc)
55-
(* match J = M *)
77+
(* match J = M or J = M.N *)
5678
| { Parsetree.pstr_desc=
5779
Parsetree.Pstr_module
5880
{ Parsetree.pmb_expr=
59-
{ Parsetree.pmod_desc= Parsetree.Pmod_ident {txt= Longident.Lident ident}
60-
; Parsetree.pmod_loc= loc } } }
61-
when ident = op ->
81+
{Parsetree.pmod_desc= Parsetree.Pmod_ident {txt= ident}; Parsetree.pmod_loc= loc} } }
82+
when matches_disallowed_module (longident_to_string ident) ->
6283
Rule.LintError (meta.ruleDescription, loc)
6384
| _ -> Rule.LintOk )
6485

6586
let lintExpression =
6687
Rule.LintExpression
6788
(fun expr ->
6889
match expr with
69-
(* match M.function or M.attribute *)
90+
(* match M.function or M.N.function in function calls *)
7091
| { Parsetree.pexp_desc=
71-
Pexp_apply
72-
{ funct=
73-
{ pexp_desc= Pexp_ident {txt= Longident.Ldot (Longident.Lident ident, _)}
74-
; Parsetree.pexp_loc= loc }
75-
; args= _ } }
76-
when ident = op ->
92+
Pexp_apply {funct= {pexp_desc= Pexp_ident {txt= ident}; Parsetree.pexp_loc= loc}; args= _} }
93+
when match extract_module_path ident with
94+
| Some module_path -> matches_disallowed_module module_path
95+
| None -> false ->
96+
Rule.LintError (meta.ruleDescription, loc)
97+
(* match M.Constructor or M.N.Constructor like Belt.Result.Ok *)
98+
| {Parsetree.pexp_desc= Pexp_construct ({txt= ident; _}, _); Parsetree.pexp_loc= loc}
99+
when match extract_module_path ident with
100+
| Some module_path -> matches_disallowed_module module_path
101+
| None -> false ->
102+
Rule.LintError (meta.ruleDescription, loc)
103+
| _ -> Rule.LintOk )
104+
105+
let lintPattern =
106+
Rule.LintPattern
107+
(fun pat ->
108+
match pat with
109+
(* match M.Constructor or M.N.Constructor in patterns like Belt.Result.Ok(x) *)
110+
| {Parsetree.ppat_desc= Ppat_construct ({txt= ident; _}, _); Parsetree.ppat_loc= loc}
111+
when match extract_module_path ident with
112+
| Some module_path -> matches_disallowed_module module_path
113+
| None -> false ->
77114
Rule.LintError (meta.ruleDescription, loc)
78115
| _ -> Rule.LintOk )
79116

80-
let linters = [lintStructureItem; lintExpression]
117+
let linters = [lintStructureItem; lintExpression; lintPattern]
81118
end

lib/rules/DisallowedFunctionRule.ml

Lines changed: 12 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -19,23 +19,27 @@ module Make (OPT : Rule.OPTIONS with type options = Options.options) (LinterOpti
1919
; Rule.ruleIdentifier= "DisallowFunction" ^ "[" ^ function_name ^ "]"
2020
; Rule.ruleDescription= description }
2121

22+
(* Helper function to convert Longident to string *)
23+
let rec longident_to_string = function
24+
| Longident.Lident s -> s
25+
| Longident.Ldot (t, s) -> longident_to_string t ^ "." ^ s
26+
| Longident.Lapply (a, b) -> longident_to_string a ^ "(" ^ longident_to_string b ^ ")"
27+
2228
let lintExpression =
2329
Rule.LintExpression
2430
(fun expr ->
2531
match expr with
26-
(* matches string_of_int(x) *)
32+
(* matches string_of_int(x) or Js.log(x) *)
2733
| { Parsetree.pexp_desc=
28-
Pexp_apply
29-
{ funct= {pexp_desc= Pexp_ident {txt= Longident.Lident ident}; Parsetree.pexp_loc= loc}
30-
; args= _ } }
31-
when ident = function_name ->
34+
Pexp_apply {funct= {pexp_desc= Pexp_ident {txt= ident}; Parsetree.pexp_loc= loc}; args= _} }
35+
when longident_to_string ident = function_name ->
3236
Rule.LintError (meta.ruleDescription, loc)
33-
(* matches x->string_of_int *)
37+
(* matches x->string_of_int or x->Js.log *)
3438
| {Parsetree.pexp_desc= Pexp_apply {args= xs; _}; Parsetree.pexp_loc= loc} -> (
3539
let f expr =
3640
match expr with
37-
| Asttypes.Nolabel, {Parsetree.pexp_desc= Pexp_ident {txt= Longident.Lident ident}}
38-
when ident = function_name ->
41+
| Asttypes.Nolabel, {Parsetree.pexp_desc= Pexp_ident {txt= ident}}
42+
when longident_to_string ident = function_name ->
3943
true
4044
| _ -> false
4145
in

test/rescript_linter_test.ml

Lines changed: 78 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,17 @@ module DisallowStringOfIntRuleWarning =
3030
end)
3131
(TestingLinterOptionsWarning)
3232

33+
module DisallowJsLogRule =
34+
DisallowedFunctionRule.Make
35+
(struct
36+
type options = DisallowedFunctionRule.Options.options
37+
38+
let options =
39+
{ DisallowedFunctionRule.Options.disallowed_function= "Js.log"
40+
; DisallowedFunctionRule.Options.suggested_function= Some "Console.log" }
41+
end)
42+
(TestingLinterOptions)
43+
3344
module DisallowInOfStringOptRule =
3445
DisallowedFunctionRule.Make
3546
(struct
@@ -74,6 +85,28 @@ module NoCSSModuleRule =
7485
end)
7586
(TestingLinterOptions)
7687

88+
module DisallowBeltResultRule =
89+
DisallowModuleRule.Make
90+
(struct
91+
type options = DisallowModuleRule.Options.options
92+
93+
let options =
94+
{ DisallowModuleRule.Options.disallowed_module= "Belt.Result"
95+
; DisallowModuleRule.Options.suggested_module= Some "Result" }
96+
end)
97+
(TestingLinterOptions)
98+
99+
module DisallowBeltRule =
100+
DisallowModuleRule.Make
101+
(struct
102+
type options = DisallowModuleRule.Options.options
103+
104+
let options =
105+
{ DisallowModuleRule.Options.disallowed_module= "Belt"
106+
; DisallowModuleRule.Options.suggested_module= Some "Core" }
107+
end)
108+
(TestingLinterOptions)
109+
77110
module DisallowedEmbeddedRegexLiteralRule =
78111
DisallowedEmbeddedRegexLiteralRule.Make
79112
(struct
@@ -139,10 +172,10 @@ module Tests = struct
139172
in
140173
match (errors, warnings) with
141174
| [], [(msg, _); _] ->
142-
Alcotest.(check string) "Same error message" DisallowStringOfIntRule.meta.ruleDescription msg
175+
Alcotest.(check string) "Same error message" DisallowStringOfIntRuleWarning.meta.ruleDescription msg
143176
| errors, warnings ->
144177
Alcotest.fail
145-
( "Should only have two lint warnings, there were "
178+
( "Should only have two lint warnings for string_of_int, there were "
146179
^ string_of_int (List.length errors)
147180
^ " errors found and "
148181
^ string_of_int (List.length warnings)
@@ -246,6 +279,44 @@ module Tests = struct
246279
| [_; _] -> Alcotest.(check pass) "Same error message" [] []
247280
| _ -> Alcotest.fail "Should only have two lint error"
248281

282+
let disallow_qualified_function_test () =
283+
let parseResult = parseAst "testData/disallowed_function_rule_test_1.res" in
284+
let errors, _warnings =
285+
Linter.lint [(module DisallowJsLogRule : Rule.HASRULE)] parseResult.ast parseResult.comments
286+
in
287+
match errors with
288+
| [_] -> Alcotest.(check pass) "Same error message" [] []
289+
| errors ->
290+
Alcotest.fail
291+
("Should only have one lint error, but got " ^ string_of_int (List.length errors) ^ " errors")
292+
293+
let disallow_module_test_4 () =
294+
let parseResult = parseAst "testData/disallow_module_test_4.res" in
295+
let errors, _warnings =
296+
Linter.lint [(module DisallowBeltResultRule : Rule.HASRULE)] parseResult.ast parseResult.comments
297+
in
298+
match errors with
299+
| [_; _; _; _; _] -> Alcotest.(check pass) "Same error message" [] []
300+
| errors ->
301+
Alcotest.fail
302+
( "Should have five lint errors (2 Ok + 2 Error in expressions/patterns, plus map function), but \
303+
got "
304+
^ string_of_int (List.length errors)
305+
^ " errors" )
306+
307+
let disallow_module_test_5 () =
308+
let parseResult = parseAst "testData/disallow_module_test_5.res" in
309+
let errors, _warnings =
310+
Linter.lint [(module DisallowBeltRule : Rule.HASRULE)] parseResult.ast parseResult.comments
311+
in
312+
match errors with
313+
| [_; _; _] -> Alcotest.(check pass) "Same error message" [] []
314+
| errors ->
315+
Alcotest.fail
316+
( "Should have three lint errors (Belt.List, Belt.Array, Belt.Option), but got "
317+
^ string_of_int (List.length errors)
318+
^ " errors" )
319+
249320
let disallowed_embedded_regex_literal_test () =
250321
let parseResult = parseAst "testData/disallowed_embedded_regex_literal_test.res" in
251322
let errors, _warnings =
@@ -316,7 +387,8 @@ let () =
316387
run "ReScript Linter"
317388
[ ( "Disallow Function Rule"
318389
, [ test_case "Lint only functions" `Quick Tests.disallow_test_1
319-
; test_case "Does not lint variable with the same function name" `Quick Tests.disallow_test_2 ] )
390+
; test_case "Does not lint variable with the same function name" `Quick Tests.disallow_test_2
391+
; test_case "Lint qualified functions (Js.log)" `Quick Tests.disallow_qualified_function_test ] )
320392
; ( "Warning Lint Rule"
321393
, [test_case "Lint only functions (as warning)" `Quick Tests.disallow_test_1_warning] )
322394
; ( "Disable lint test"
@@ -330,7 +402,9 @@ let () =
330402
; ( "Disallow module"
331403
, [ test_case "open module" `Quick Tests.disallow_module_test_1
332404
; test_case "alias module" `Quick Tests.disallow_module_test_2
333-
; test_case "direct access module" `Quick Tests.disallow_module_test_3 ] )
405+
; test_case "direct access module" `Quick Tests.disallow_module_test_3
406+
; test_case "qualified module with constructors (Belt.Result)" `Quick Tests.disallow_module_test_4
407+
; test_case "module prefix matching (Belt.*)" `Quick Tests.disallow_module_test_5 ] )
334408
; ( "Disallowed embedded regex literal"
335409
, [test_case "Disallowed embedded regex literal" `Quick Tests.disallowed_embedded_regex_literal_test] )
336410
; ("Disallowed dead code", [test_case "Disallowed dead code" `Quick Tests.disallowed_dead_code_test]) ]
Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
// Test qualified module paths with Belt.Result
2+
let x = Belt.Result.Ok(42)
3+
let y = Belt.Result.Error("failed")
4+
5+
let z = switch x {
6+
| Belt.Result.Ok(value) => value
7+
| Belt.Result.Error(_) => 0
8+
}
9+
10+
let a = Belt.Result.map(x, v => v + 1)
Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
// Test for disallowing Belt module (should catch Belt.List and Belt.Array)
2+
let x = Belt.List.toArray([1, 2, 3])
3+
let y = Belt.Array.map([1, 2, 3], x => x + 1)
4+
let z = Belt.Option.getWithDefault(None, 0)

test/testData/disallowed_function_rule_test_1.res

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,4 +8,6 @@ let z2 = Some(`hello ${string_of_int(x)}`)
88

99
let string_of_int = ignore
1010

11+
Js.log("hello")
12+
1113
let word = j`hello world`

0 commit comments

Comments
 (0)