Skip to content

Commit c553676

Browse files
zthzth
committed
implement exhaustive switch completion
1 parent b52e268 commit c553676

9 files changed

+220
-40
lines changed

‎analysis/src/CompletionBackEnd.ml

Lines changed: 70 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -232,6 +232,7 @@ let detail name (kind : Completion.kind) =
232232
|> String.concat ", ")
233233
^ ")")
234234
^ "\n\n" ^ s
235+
| Snippet s -> s
235236

236237
let findAllCompletions ~(env : QueryEnv.t) ~prefix ~exact ~namesUsed
237238
~(completionContext : Completable.completionContext) =
@@ -552,6 +553,7 @@ let mkItem ~name ~kind ~detail ~deprecated ~docstring =
552553
sortText = None;
553554
insertText = None;
554555
insertTextFormat = None;
556+
filterText = None;
555557
}
556558

557559
let completionToItem
@@ -563,14 +565,15 @@ let completionToItem
563565
sortText;
564566
insertText;
565567
insertTextFormat;
568+
filterText;
566569
} =
567570
let item =
568571
mkItem ~name
569572
~kind:(Completion.kindToInt kind)
570573
~deprecated ~detail:(detail name kind) ~docstring
571574
in
572575
if !Cfg.supportsSnippets then
573-
{item with sortText; insertText; insertTextFormat}
576+
{item with sortText; insertText; insertTextFormat; filterText}
574577
else item
575578

576579
let completionsGetTypeEnv = function
@@ -1304,3 +1307,69 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover
13041307
in
13051308
items @ regularCompletions
13061309
| _ -> items)))
1310+
| CexhaustiveSwitch {contextPath; exprLoc} ->
1311+
let range = Utils.rangeOfLoc exprLoc in
1312+
let printFailwithStr num =
1313+
"${" ^ string_of_int num ^ ":failwith(\"todo\")}"
1314+
in
1315+
let withExhaustiveItem ~cases ?(startIndex = 0) (c : Completion.t) =
1316+
(* We don't need to write out `switch` here since we know that's what the
1317+
user has already written. Just complete for the rest. *)
1318+
let newText =
1319+
c.name ^ " {\n"
1320+
^ (cases
1321+
|> List.mapi (fun index caseText ->
1322+
"| " ^ caseText ^ " => "
1323+
^ printFailwithStr (startIndex + index + 1))
1324+
|> String.concat "\n")
1325+
^ "\n}"
1326+
|> Utils.indent range.start.character
1327+
in
1328+
[
1329+
c;
1330+
{
1331+
c with
1332+
name = c.name ^ " (exhaustive switch)";
1333+
filterText = Some c.name;
1334+
insertTextFormat = Some Snippet;
1335+
insertText = Some newText;
1336+
kind = Snippet "insert exhaustive switch for value";
1337+
};
1338+
]
1339+
in
1340+
let completionsForContextPath =
1341+
contextPath
1342+
|> getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
1343+
~exact:forHover ~scope
1344+
in
1345+
completionsForContextPath
1346+
|> List.map (fun (c : Completion.t) ->
1347+
match c.kind with
1348+
| Value typExpr -> (
1349+
match typExpr |> TypeUtils.extractType ~env:c.env ~package with
1350+
| Some (Tvariant v) ->
1351+
withExhaustiveItem c
1352+
~cases:
1353+
(v.constructors
1354+
|> List.map (fun (constructor : Constructor.t) ->
1355+
constructor.cname.txt
1356+
^
1357+
match constructor.args with
1358+
| Args [] -> ""
1359+
| _ -> "(_)"))
1360+
| Some (Tpolyvariant v) ->
1361+
withExhaustiveItem c
1362+
~cases:
1363+
(v.constructors
1364+
|> List.map (fun (constructor : polyVariantConstructor) ->
1365+
"| #" ^ constructor.name
1366+
^
1367+
match constructor.args with
1368+
| [] -> ""
1369+
| _ -> "(_)"))
1370+
| Some (Toption (_env, _typ)) ->
1371+
withExhaustiveItem c ~cases:["Some($1)"; "None"] ~startIndex:1
1372+
| Some (Tbool _) -> withExhaustiveItem c ~cases:["true"; "false"]
1373+
| _ -> [c])
1374+
| _ -> [c])
1375+
|> List.flatten

‎analysis/src/CompletionFrontEnd.ml

Lines changed: 11 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -353,14 +353,18 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
353353
let unsetLookingForPat () = lookingForPat := None in
354354
(* Identifies expressions where we can do typed pattern or expr completion. *)
355355
let typedCompletionExpr (exp : Parsetree.expression) =
356-
if
357-
exp.pexp_loc
358-
|> CursorPosition.classifyLoc ~pos:posBeforeCursor
359-
= HasCursor
360-
then
356+
if exp.pexp_loc |> CursorPosition.locHasCursor ~pos:posBeforeCursor then
361357
match exp.pexp_desc with
362-
| Pexp_match (_exp, []) ->
363-
(* No cases means there's no `|` yet in the switch *) ()
358+
(* No cases means there's no `|` yet in the switch *)
359+
| Pexp_match (({pexp_desc = Pexp_ident _} as expr), []) -> (
360+
if locHasCursor expr.pexp_loc then
361+
(* We can do exhaustive switch completion if this is an ident we can
362+
complete from. *)
363+
match exprToContextPath expr with
364+
| None -> ()
365+
| Some contextPath ->
366+
setResult (CexhaustiveSwitch {contextPath; exprLoc = exp.pexp_loc}))
367+
| Pexp_match (_expr, []) -> ()
364368
| Pexp_match
365369
( exp,
366370
[

‎analysis/src/Protocol.ml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,7 @@ type completionItem = {
4747
tags: int list;
4848
detail: string;
4949
sortText: string option;
50+
filterText: string option;
5051
insertTextFormat: insertTextFormat option;
5152
insertText: string option;
5253
documentation: markupContent option;
@@ -129,6 +130,7 @@ let stringifyCompletionItem c =
129130
| None -> null
130131
| Some doc -> stringifyMarkupContent doc) );
131132
("sortText", optWrapInQuotes c.sortText);
133+
("filterText", optWrapInQuotes c.filterText);
132134
("insertText", optWrapInQuotes c.insertText);
133135
( "insertTextFormat",
134136
match c.insertTextFormat with

‎analysis/src/SharedTypes.ml

Lines changed: 11 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -305,19 +305,21 @@ module Completion = struct
305305
| PolyvariantConstructor of polyVariantConstructor * string
306306
| Field of field * string
307307
| FileModule of string
308+
| Snippet of string
308309

309310
type t = {
310311
name: string;
311312
sortText: string option;
312313
insertText: string option;
314+
filterText: string option;
313315
insertTextFormat: Protocol.insertTextFormat option;
314316
env: QueryEnv.t;
315317
deprecated: string option;
316318
docstring: string list;
317319
kind: kind;
318320
}
319321

320-
let create ~kind ~env ?(docstring = []) name =
322+
let create ~kind ~env ?(docstring = []) ?filterText name =
321323
{
322324
name;
323325
env;
@@ -327,10 +329,11 @@ module Completion = struct
327329
sortText = None;
328330
insertText = None;
329331
insertTextFormat = None;
332+
filterText;
330333
}
331334

332-
let createWithSnippet ~name ?insertText ~kind ~env ?sortText ?(docstring = [])
333-
() =
335+
let createWithSnippet ~name ?insertText ~kind ~env ?sortText ?filterText
336+
?(docstring = []) () =
334337
{
335338
name;
336339
env;
@@ -340,6 +343,7 @@ module Completion = struct
340343
sortText;
341344
insertText;
342345
insertTextFormat = Some Protocol.Snippet;
346+
filterText;
343347
}
344348

345349
(* https://microsoft.github.io/language-server-protocol/specifications/specification-current/#textDocument_completion *)
@@ -354,6 +358,7 @@ module Completion = struct
354358
| Field (_, _) -> 5
355359
| Type _ -> 22
356360
| Value _ -> 12
361+
| Snippet _ -> 15
357362
end
358363

359364
module Env = struct
@@ -613,6 +618,7 @@ module Completable = struct
613618
prefix: string;
614619
fallback: t option;
615620
}
621+
| CexhaustiveSwitch of {contextPath: contextPath; exprLoc: Location.t}
616622

617623
(** An extracted type from a type expr *)
618624
type extractedType =
@@ -720,6 +726,8 @@ module Completable = struct
720726
^ (nestedPaths
721727
|> List.map (fun nestedPath -> nestedPathToString nestedPath)
722728
|> String.concat ", "))
729+
| CexhaustiveSwitch {contextPath} ->
730+
"CexhaustiveSwitch " ^ contextPathToString contextPath
723731
end
724732

725733
module CursorPosition = struct

‎analysis/src/Utils.ml

Lines changed: 25 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -181,4 +181,28 @@ let rec getUnqualifiedName txt =
181181
match txt with
182182
| Longident.Lident fieldName -> fieldName
183183
| Ldot (t, _) -> getUnqualifiedName t
184-
| _ -> ""
184+
| _ -> ""
185+
186+
let indent n text =
187+
let spaces = String.make n ' ' in
188+
let len = String.length text in
189+
let text =
190+
if len != 0 && text.[len - 1] = '\n' then String.sub text 0 (len - 1)
191+
else text
192+
in
193+
let lines = String.split_on_char '\n' text in
194+
match lines with
195+
| [] -> ""
196+
| [line] -> line
197+
| line :: lines ->
198+
line ^ "\n"
199+
^ (lines |> List.map (fun line -> spaces ^ line) |> String.concat "\n")
200+
201+
let mkPosition (pos : Pos.t) =
202+
let line, character = pos in
203+
{Protocol.line; character}
204+
205+
let rangeOfLoc (loc : Location.t) =
206+
let start = loc |> Loc.start |> mkPosition in
207+
let end_ = loc |> Loc.end_ |> mkPosition in
208+
{Protocol.start; end_}

‎analysis/src/Xform.ml

Lines changed: 2 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -252,21 +252,6 @@ module AddTypeAnnotation = struct
252252
| _ -> ()))
253253
end
254254

255-
let indent n text =
256-
let spaces = String.make n ' ' in
257-
let len = String.length text in
258-
let text =
259-
if len != 0 && text.[len - 1] = '\n' then String.sub text 0 (len - 1)
260-
else text
261-
in
262-
let lines = String.split_on_char '\n' text in
263-
match lines with
264-
| [] -> ""
265-
| [line] -> line
266-
| line :: lines ->
267-
line ^ "\n"
268-
^ (lines |> List.map (fun line -> spaces ^ line) |> String.concat "\n")
269-
270255
let parse ~filename =
271256
let {Res_driver.parsetree = structure; comments} =
272257
Res_driver.parsingEngine.parseImplementation ~forPrinter:false ~filename
@@ -283,15 +268,15 @@ let parse ~filename =
283268
structure
284269
|> Res_printer.printImplementation ~width:!Res_cli.ResClflags.width
285270
~comments:(comments |> filterComments ~loc:expr.pexp_loc)
286-
|> indent range.start.character
271+
|> Utils.indent range.start.character
287272
in
288273
let printStructureItem ~(range : Protocol.range)
289274
(item : Parsetree.structure_item) =
290275
let structure = [item] in
291276
structure
292277
|> Res_printer.printImplementation ~width:!Res_cli.ResClflags.width
293278
~comments:(comments |> filterComments ~loc:item.pstr_loc)
294-
|> indent range.start.character
279+
|> Utils.indent range.start.character
295280
in
296281
(structure, printExpr, printStructureItem)
297282

‎analysis/tests/src/ExhaustiveSwitch.res

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
type someVariant = One | Two | Three(option<bool>)
2+
type somePolyVariant = [#one | #two | #three(option<bool>)]
3+
4+
let withSomeVariant = One
5+
let withSomePoly: somePolyVariant = #one
6+
let someBool = true
7+
let someOpt = Some(true)
8+
9+
// switch withSomeVarian
10+
// ^com
11+
12+
// switch withSomePol
13+
// ^com
14+
15+
// switch someBoo
16+
// ^com
17+
18+
// switch someOp
19+
// ^com

‎analysis/tests/src/expected/ExhaustiveSwitch.res.txt

Lines changed: 80 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,80 @@
1+
Complete src/ExhaustiveSwitch.res 8:24
2+
XXX Not found!
3+
Completable: CexhaustiveSwitch Value[withSomeVarian]
4+
[{
5+
"label": "withSomeVariant",
6+
"kind": 12,
7+
"tags": [],
8+
"detail": "someVariant",
9+
"documentation": null
10+
}, {
11+
"label": "withSomeVariant (exhaustive switch)",
12+
"kind": 15,
13+
"tags": [],
14+
"detail": "insert exhaustive switch for value",
15+
"documentation": null,
16+
"filterText": "withSomeVariant",
17+
"insertText": "withSomeVariant {\n | One => ${1:failwith(\"todo\")}\n | Two => ${2:failwith(\"todo\")}\n | Three(_) => ${3:failwith(\"todo\")}\n }",
18+
"insertTextFormat": 2
19+
}]
20+
21+
Complete src/ExhaustiveSwitch.res 11:21
22+
XXX Not found!
23+
Completable: CexhaustiveSwitch Value[withSomePol]
24+
[{
25+
"label": "withSomePoly",
26+
"kind": 12,
27+
"tags": [],
28+
"detail": "somePolyVariant",
29+
"documentation": null
30+
}, {
31+
"label": "withSomePoly (exhaustive switch)",
32+
"kind": 15,
33+
"tags": [],
34+
"detail": "insert exhaustive switch for value",
35+
"documentation": null,
36+
"filterText": "withSomePoly",
37+
"insertText": "withSomePoly {\n | | #one => ${1:failwith(\"todo\")}\n | | #three(_) => ${2:failwith(\"todo\")}\n | | #two => ${3:failwith(\"todo\")}\n }",
38+
"insertTextFormat": 2
39+
}]
40+
41+
Complete src/ExhaustiveSwitch.res 14:17
42+
XXX Not found!
43+
Completable: CexhaustiveSwitch Value[someBoo]
44+
[{
45+
"label": "someBool",
46+
"kind": 12,
47+
"tags": [],
48+
"detail": "bool",
49+
"documentation": null
50+
}, {
51+
"label": "someBool (exhaustive switch)",
52+
"kind": 15,
53+
"tags": [],
54+
"detail": "insert exhaustive switch for value",
55+
"documentation": null,
56+
"filterText": "someBool",
57+
"insertText": "someBool {\n | true => ${1:failwith(\"todo\")}\n | false => ${2:failwith(\"todo\")}\n }",
58+
"insertTextFormat": 2
59+
}]
60+
61+
Complete src/ExhaustiveSwitch.res 17:16
62+
XXX Not found!
63+
Completable: CexhaustiveSwitch Value[someOp]
64+
[{
65+
"label": "someOpt",
66+
"kind": 12,
67+
"tags": [],
68+
"detail": "option<bool>",
69+
"documentation": null
70+
}, {
71+
"label": "someOpt (exhaustive switch)",
72+
"kind": 15,
73+
"tags": [],
74+
"detail": "insert exhaustive switch for value",
75+
"documentation": null,
76+
"filterText": "someOpt",
77+
"insertText": "someOpt {\n | Some($1) => ${2:failwith(\"todo\")}\n | None => ${3:failwith(\"todo\")}\n }",
78+
"insertTextFormat": 2
79+
}]
80+

0 commit comments

Comments
 (0)