Code actions for exhaustive switches (#812)

* code actions for inserting exhaustive switches for selected expressions, single identifiers, and switch cases being written

* expand options automatically

* fix

Author: zth

analysis/src/Cli.ml

@@ -120,9 +120,11 @@ let main () =
       ~pos:(int_of_string line_start, int_of_string line_end)
       ~maxLength ~debug:false
   | [_; "codeLens"; path] -> Commands.codeLens ~path ~debug:false
-  | [_; "codeAction"; path; line; col; currentFile] ->
+  | [_; "codeAction"; path; startLine; startCol; endLine; endCol; currentFile]
+    ->
     Commands.codeAction ~path
-      ~pos:(int_of_string line, int_of_string col)
+      ~startPos:(int_of_string startLine, int_of_string startCol)
+      ~endPos:(int_of_string endLine, int_of_string endCol)
       ~currentFile ~debug:false
   | [_; "codemod"; path; line; col; typ; hint] ->
     let typ =

analysis/src/Codemod.ml

@@ -5,11 +5,6 @@ let rec collectPatterns p =
   | Ppat_or (p1, p2) -> collectPatterns p1 @ [p2]
   | _ -> [p]
 
-let mkFailWithExp () =
-  Ast_helper.Exp.apply
-    (Ast_helper.Exp.ident {txt = Lident "failwith"; loc = Location.none})
-    [(Nolabel, Ast_helper.Exp.constant (Pconst_string ("TODO", None)))]
-
 let transform ~path ~pos ~debug ~typ ~hint =
   let structure, printExpr, _ = Xform.parseImplementation ~filename:path in
   match typ with
@@ -24,7 +19,7 @@ let transform ~path ~pos ~debug ~typ ~hint =
       let cases =
         collectPatterns pattern
         |> List.map (fun (p : Parsetree.pattern) ->
-               Ast_helper.Exp.case p (mkFailWithExp ()))
+               Ast_helper.Exp.case p (TypeUtils.Codegen.mkFailWithExp ()))
       in
       let result = ref None in
       let mkIterator ~pos ~result =

analysis/src/Commands.ml

@@ -80,8 +80,8 @@ let signatureHelp ~path ~pos ~currentFile ~debug =
   in
   print_endline (Protocol.stringifySignatureHelp result)
 
-let codeAction ~path ~pos ~currentFile ~debug =
-  Xform.extractCodeActions ~path ~pos ~currentFile ~debug
+let codeAction ~path ~startPos ~endPos ~currentFile ~debug =
+  Xform.extractCodeActions ~path ~startPos ~endPos ~currentFile ~debug
   |> CodeActions.stringifyCodeActions |> print_endline
 
 let definition ~path ~pos ~debug =
@@ -268,7 +268,9 @@ let test ~path =
     let lines = text |> String.split_on_char '\n' in
     let processLine i line =
       let createCurrentFile () =
-        let currentFile, cout = Filename.open_temp_file "def" "txt" in
+        let currentFile, cout =
+          Filename.open_temp_file "def" ("txt." ^ Filename.extension path)
+        in
         let removeLineComment l =
           let len = String.length l in
           let rec loop i =
@@ -372,13 +374,24 @@ let test ~path =
              ^ string_of_int col);
             typeDefinition ~path ~pos:(line, col) ~debug:true
           | "xfm" ->
-            print_endline
-              ("Xform " ^ path ^ " " ^ string_of_int line ^ ":"
-             ^ string_of_int col);
+            let currentFile = createCurrentFile () in
+            (* +2 is to ensure that the character ^ points to is what's considered the end of the selection. *)
+            let endCol = col + try String.index rest '^' + 2 with _ -> 0 in
+            let endPos = (line, endCol) in
+            let startPos = (line, col) in
+            if startPos = endPos then
+              print_endline
+                ("Xform " ^ path ^ " " ^ string_of_int line ^ ":"
+               ^ string_of_int col)
+            else
+              print_endline
+                ("Xform " ^ path ^ " start: " ^ Pos.toString startPos
+               ^ ", end: " ^ Pos.toString endPos);
             let codeActions =
-              Xform.extractCodeActions ~path ~pos:(line, col) ~currentFile:path
+              Xform.extractCodeActions ~path ~startPos ~endPos ~currentFile
                 ~debug:true
             in
+            Sys.remove currentFile;
             codeActions
             |> List.iter (fun {Protocol.title; edit = {documentChanges}} ->
                    Printf.printf "Hit: %s\n" title;

analysis/src/CompletionFrontEnd.ml

@@ -222,7 +222,8 @@ let completePipeChain (exp : Parsetree.expression) =
     exprToContextPath exp |> Option.map (fun ctxPath -> (ctxPath, pexp_loc))
   | _ -> None
 
-let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
+let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
+    ?findThisExprLoc text =
   let offsetNoWhite = Utils.skipWhite text (offset - 1) in
   let posNoWhite =
     let line, col = posCursor in
@@ -777,6 +778,12 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
           (Pos.toString posCursor) (Pos.toString posNoWhite)
           (Loc.toString expr.pexp_loc)
     in
+    (match findThisExprLoc with
+    | Some loc when expr.pexp_loc = loc -> (
+      match exprToContextPath expr with
+      | None -> ()
+      | Some ctxPath -> setResult (Cpath ctxPath))
+    | _ -> ());
     let setPipeResult ~(lhs : Parsetree.expression) ~id =
       match completePipeChain lhs with
       | None -> (
@@ -1228,5 +1235,16 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
 let completionWithParser ~debug ~path ~posCursor ~currentFile ~text =
   match Pos.positionToOffset text posCursor with
   | Some offset ->
-    completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text
+    completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor text
   | None -> None
+
+let findTypeOfExpressionAtLoc ~debug ~path ~posCursor ~currentFile loc =
+  let textOpt = Files.readFile currentFile in
+  match textOpt with
+  | None | Some "" -> None
+  | Some text -> (
+    match Pos.positionToOffset text posCursor with
+    | Some offset ->
+      completionWithParser1 ~findThisExprLoc:loc ~currentFile ~debug ~offset
+        ~path ~posCursor text
+    | None -> None)

analysis/src/Loc.ml

@@ -8,3 +8,7 @@ let toString (loc : t) =
   (if loc.loc_ghost then "__ghost__" else "") ^ (loc |> range |> Range.toString)
 
 let hasPos ~pos loc = start loc <= pos && pos < end_ loc
+
+(** Allows the character after the end to be included. Ie when the cursor is at the 
+    end of the word, like `someIdentifier<cursor>`. Useful in some scenarios. *)
+let hasPosInclusiveEnd ~pos loc = start loc <= pos && pos <= end_ loc

analysis/src/TypeUtils.ml

@@ -606,3 +606,77 @@ let unwrapCompletionTypeIfOption (t : SharedTypes.completionType) =
   match t with
   | Toption (_, ExtractedType unwrapped) -> unwrapped
   | _ -> t
+
+module Codegen = struct
+  let mkFailWithExp () =
+    Ast_helper.Exp.apply
+      (Ast_helper.Exp.ident {txt = Lident "failwith"; loc = Location.none})
+      [(Nolabel, Ast_helper.Exp.constant (Pconst_string ("TODO", None)))]
+
+  let mkConstructPat ?payload name =
+    Ast_helper.Pat.construct
+      {Asttypes.txt = Longident.Lident name; loc = Location.none}
+      payload
+
+  let mkTagPat ?payload name = Ast_helper.Pat.variant name payload
+
+  let any () = Ast_helper.Pat.any ()
+
+  let rec extractedTypeToExhaustivePatterns ~env ~full extractedType =
+    match extractedType with
+    | Tvariant v ->
+      Some
+        (v.constructors
+        |> List.map (fun (c : SharedTypes.Constructor.t) ->
+               mkConstructPat
+                 ?payload:
+                   (match c.args with
+                   | Args [] -> None
+                   | _ -> Some (any ()))
+                 c.cname.txt))
+    | Tpolyvariant v ->
+      Some
+        (v.constructors
+        |> List.map (fun (c : SharedTypes.polyVariantConstructor) ->
+               mkTagPat
+                 ?payload:
+                   (match c.args with
+                   | [] -> None
+                   | _ -> Some (any ()))
+                 c.name))
+    | Toption (_, innerType) ->
+      let extractedType =
+        match innerType with
+        | ExtractedType t -> Some t
+        | TypeExpr t -> extractType t ~env ~package:full.package
+      in
+      let expandedBranches =
+        match extractedType with
+        | None -> []
+        | Some extractedType -> (
+          match extractedTypeToExhaustivePatterns ~env ~full extractedType with
+          | None -> []
+          | Some patterns -> patterns)
+      in
+      Some
+        ([
+           mkConstructPat "None";
+           mkConstructPat ~payload:(Ast_helper.Pat.any ()) "Some";
+         ]
+        @ (expandedBranches
+          |> List.map (fun (pat : Parsetree.pattern) ->
+                 mkConstructPat ~payload:pat "Some")))
+    | Tbool _ -> Some [mkConstructPat "true"; mkConstructPat "false"]
+    | _ -> None
+
+  let extractedTypeToExhaustiveCases ~env ~full extractedType =
+    let patterns = extractedTypeToExhaustivePatterns ~env ~full extractedType in
+
+    match patterns with
+    | None -> None
+    | Some patterns ->
+      Some
+        (patterns
+        |> List.map (fun (pat : Parsetree.pattern) ->
+               Ast_helper.Exp.case pat (mkFailWithExp ())))
+end