Emit %todo istead of failwith when appropriate (#981)

* emit %todo istead of failwith when appropriate

* changelog

Author: zth

CHANGELOG.md

@@ -27,6 +27,8 @@
 - Add support for the rewatch build system for incremental compilation. https://github.com/rescript-lang/rescript-vscode/pull/965
 - Add support for Linux ARM64
 - Statically linked Linux binaries
+- Emit `%todo` instead of `failwith("TODO")` when we can (ReScript >= v11.1). https://github.com/rescript-lang/rescript-vscode/pull/981
+- Complete `%todo`. https://github.com/rescript-lang/rescript-vscode/pull/981
 
 ## 1.50.0
 

Makefile

@@ -2,8 +2,9 @@ SHELL = /bin/bash
 
 build:
 	dune build
-	cp _build/install/default/bin/rescript-editor-analysis rescript-editor-analysis.exe
-	cp _build/install/default/bin/rescript-tools rescript-tools.exe
+	cp -f _build/install/default/bin/rescript-editor-analysis analysis/rescript-editor-analysis.exe
+	cp -f _build/install/default/bin/rescript-editor-analysis rescript-editor-analysis.exe
+	cp -f _build/install/default/bin/rescript-tools rescript-tools.exe
 
 test:
 	make -C analysis test

analysis/src/Commands.ml

@@ -338,6 +338,17 @@ let test ~path =
           | "db-" -> Log.verbose := false
           | "dv+" -> Debug.debugLevel := Verbose
           | "dv-" -> Debug.debugLevel := Off
+          | "ve+" -> (
+            let version = String.sub rest 3 (String.length rest - 3) in
+            let version = String.trim version in
+            if Debug.verbose () then
+              Printf.printf "Setting version: %s\n" version;
+            match String.split_on_char '.' version with
+            | [majorRaw; minorRaw] ->
+              let version = (int_of_string majorRaw, int_of_string minorRaw) in
+              Packages.overrideRescriptVersion := Some version
+            | _ -> ())
+          | "ve-" -> Packages.overrideRescriptVersion := None
           | "def" ->
             print_endline
               ("Definition " ^ path ^ " " ^ string_of_int line ^ ":"

analysis/src/CompletionBackEnd.ml

@@ -2205,8 +2205,11 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable =
         | _ -> items)))
   | CexhaustiveSwitch {contextPath; exprLoc} ->
     let range = Utils.rangeOfLoc exprLoc in
+    let rescriptMajor, rescriptMinor = Packages.getReScriptVersion () in
     let printFailwithStr num =
-      "${" ^ string_of_int num ^ ":failwith(\"todo\")}"
+      if (rescriptMajor = 11 && rescriptMinor >= 1) || rescriptMajor >= 12 then
+        "${" ^ string_of_int num ^ ":%todo}"
+      else "${" ^ string_of_int num ^ ":failwith(\"todo\")}"
     in
     let withExhaustiveItem ~cases ?(startIndex = 0) (c : Completion.t) =
       (* We don't need to write out `switch` here since we know that's what the
@@ -2285,3 +2288,18 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable =
                     | true -> Some "true"
                     | false -> None))
            else None)
+  | CextensionNode prefix ->
+    if Utils.startsWith "todo" prefix then
+      let detail =
+        "`%todo` is used to tell the compiler that some code still needs to be \
+         implemented."
+      in
+      [
+        Completion.create "todo" ~kind:(Label "todo") ~detail ~env
+          ~insertText:"todo";
+        Completion.create "todo (with payload)" ~includesSnippets:true
+          ~kind:(Label "todo")
+          ~detail:(detail ^ " With a payload.")
+          ~env ~insertText:"todo(\"${0:TODO}\")";
+      ]
+    else []

analysis/src/CompletionFrontEnd.ml

@@ -1033,6 +1033,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
       if expr.pexp_loc |> Loc.hasPos ~pos:posNoWhite && !result = None then (
         setFound ();
         match expr.pexp_desc with
+        | Pexp_extension ({txt}, _) -> setResult (CextensionNode txt)
         | Pexp_constant _ -> setResult Cnone
         | Pexp_ident lid ->
           let lidPath = flattenLidCheckDot lid in

analysis/src/Packages.ml

@@ -11,21 +11,26 @@ let makePathsForModule ~projectFilesAndPaths ~dependenciesFilesAndPaths =
          Hashtbl.replace pathsForModule modName paths);
   pathsForModule
 
+let overrideRescriptVersion = ref None
+
 let getReScriptVersion () =
-  (* TODO: Include patch stuff when needed *)
-  let defaultVersion = (11, 0) in
-  try
-    let value = Sys.getenv "RESCRIPT_VERSION" in
-    let version =
-      match value |> String.split_on_char '.' with
-      | major :: minor :: _rest -> (
-        match (int_of_string_opt major, int_of_string_opt minor) with
-        | Some major, Some minor -> (major, minor)
-        | _ -> defaultVersion)
-      | _ -> defaultVersion
-    in
-    version
-  with Not_found -> defaultVersion
+  match !overrideRescriptVersion with
+  | Some overrideRescriptVersion -> overrideRescriptVersion
+  | None -> (
+    (* TODO: Include patch stuff when needed *)
+    let defaultVersion = (11, 0) in
+    try
+      let value = Sys.getenv "RESCRIPT_VERSION" in
+      let version =
+        match value |> String.split_on_char '.' with
+        | major :: minor :: _rest -> (
+          match (int_of_string_opt major, int_of_string_opt minor) with
+          | Some major, Some minor -> (major, minor)
+          | _ -> defaultVersion)
+        | _ -> defaultVersion
+      in
+      version
+    with Not_found -> defaultVersion)
 
 let newBsPackage ~rootPath =
   let rescriptJson = Filename.concat rootPath "rescript.json" in

analysis/src/SharedTypes.ml

@@ -642,6 +642,7 @@ module Completable = struct
   type t =
     | Cdecorator of string  (** e.g. @module *)
     | CdecoratorPayload of decoratorPayload
+    | CextensionNode of string  (** e.g. %todo *)
     | CnamedArg of contextPath * string * string list
         (** e.g. (..., "label", ["l1", "l2"]) for ...(...~l1...~l2...~label...) *)
     | Cnone  (** e.g. don't complete inside strings *)
@@ -723,6 +724,7 @@ module Completable = struct
   let toString = function
     | Cpath cp -> "Cpath " ^ contextPathToString cp
     | Cdecorator s -> "Cdecorator(" ^ str s ^ ")"
+    | CextensionNode s -> "CextensionNode(" ^ str s ^ ")"
     | CdecoratorPayload (Module s) -> "CdecoratorPayload(module=" ^ s ^ ")"
     | CdecoratorPayload (ModuleWithImportAttributes _) ->
       "CdecoratorPayload(moduleWithImportAttributes)"

analysis/tests/src/CompletionAttributes.res

@@ -34,3 +34,6 @@
 // @module({from: }) external doStuff: t = "default"
 //               ^com
 
+// let dd = %t
+//            ^com
+

analysis/tests/src/ExhaustiveSwitch.res

@@ -36,3 +36,8 @@ let vvv = Some(x->getV)
 
 // vvv
 //  ^xfm
+
+// ^ve+ 11.1
+// switch withSomeVarian
+//                      ^com
+// ^ve-

analysis/tests/src/expected/CompletionAttributes.res.txt

@@ -266,3 +266,25 @@ Resolved opens 1 pervasives
     "documentation": null
   }]
 
+Complete src/CompletionAttributes.res 36:14
+posCursor:[36:14] posNoWhite:[36:13] Found expr:[36:12->36:14]
+Completable: CextensionNode(t)
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+[{
+    "label": "todo",
+    "kind": 4,
+    "tags": [],
+    "detail": "`%todo` is used to tell the compiler that some code still needs to be implemented.",
+    "documentation": null,
+    "insertText": "todo"
+  }, {
+    "label": "todo (with payload)",
+    "kind": 4,
+    "tags": [],
+    "detail": "`%todo` is used to tell the compiler that some code still needs to be implemented. With a payload.",
+    "documentation": null,
+    "insertText": "todo(\"${0:TODO}\")",
+    "insertTextFormat": 2
+  }]
+