%todo extension (rescript-lang#6713)

* PoC for adding a %todo extension that warns with proper locations

* raise instead of emulating Obj.magic

* align

* use Js.Exn.raiseError and include ReScript file name + location of todo code in error thrown at runtime

* update fixtures

* change text

* fixtures

* changelog

Author: zth

CHANGELOG.md

@@ -12,6 +12,10 @@
 
 # 11.1.0-rc.8 (Unreleased)
 
+#### :rocket: New Feature
+
+- Add `%todo` extension for leaving implementation for later. https://github.com/rescript-lang/rescript-compiler/pull/6713
+
 #### :bug: Bug Fix
 
 - Improve error when using '@deriving(accessors)' on a variant with record arguments. https://github.com/rescript-lang/rescript-compiler/pull/6712

jscomp/build_tests/super_errors/expected/todo_with_no_payload.res.expected

@@ -0,0 +1,11 @@
+
+  Warning number 110
+  /.../fixtures/todo_with_no_payload.res:1:38-42
+
+  1 │ let implementMeLater = (): string => %todo
+  2 │ 
+  3 │ let x = implementMeLater()
+
+  Todo found.
+
+  This code is not implemented yet and will crash at runtime. Make sure you implement this before running the code.

jscomp/build_tests/super_errors/expected/todo_with_payload.res.expected

@@ -0,0 +1,12 @@
+
+  Warning number 110
+  /.../fixtures/todo_with_payload.res:1:38-85
+
+  1 │ let implementMeLater = (): string => %todo("This should return a string 
+    │ eventually.")
+  2 │ 
+  3 │ let x = implementMeLater()
+
+  Todo found: This should return a string eventually.
+
+  This code is not implemented yet and will crash at runtime. Make sure you implement this before running the code.

jscomp/build_tests/super_errors/fixtures/todo_with_no_payload.res

@@ -0,0 +1,5 @@
+let implementMeLater = (): string => %todo
+
+let x = implementMeLater()
+
+Js.log(x->Js.String2.includes("x"))

jscomp/build_tests/super_errors/fixtures/todo_with_payload.res

@@ -0,0 +1,5 @@
+let implementMeLater = (): string => %todo("This should return a string eventually.")
+
+let x = implementMeLater()
+
+Js.log(x->Js.String2.includes("x"))

jscomp/ext/warnings.ml

@@ -86,6 +86,7 @@ type t =
   | Bs_integer_literal_overflow (* 107 *)
   | Bs_uninterpreted_delimiters of string (* 108 *)
   | Bs_toplevel_expression_unit of (string * topLevelUnitHelp) option (* 109 *)
+  | Bs_todo of string option (* 110 *)
 
 (* If you remove a warning, leave a hole in the numbering.  NEVER change
    the numbers of existing warnings.
@@ -151,6 +152,7 @@ let number = function
   | Bs_integer_literal_overflow -> 107
   | Bs_uninterpreted_delimiters _ -> 108
   | Bs_toplevel_expression_unit _ -> 109
+  | Bs_todo _ -> 110
 
 let last_warning_number = 110
 
@@ -509,6 +511,11 @@ let message = function
           | Other -> "yourExpression") in
           Printf.sprintf "\n\n  Possible solutions:\n  - Assigning to a value that is then ignored: `let _ = %s`\n  - Piping into the built-in ignore function to ignore the result: `%s->ignore`" helpText helpText
         | _ -> "") 
+    | Bs_todo maybe_text -> (
+      match maybe_text with 
+      | None -> "Todo found." 
+      | Some todo -> "Todo found: " ^ todo
+    ) ^ "\n\n  This code is not implemented yet and will crash at runtime. Make sure you implement this before running the code."
 
 let sub_locs = function
   | Deprecated (_, def, use) ->

jscomp/ext/warnings.mli

@@ -79,6 +79,7 @@ type t =
   | Bs_integer_literal_overflow (* 107 *)
   | Bs_uninterpreted_delimiters of string (* 108 *)
   | Bs_toplevel_expression_unit of (string * topLevelUnitHelp) option (* 109 *)
+  | Bs_todo of string option (* 110 *)
 
 val parse_options : bool -> string -> unit
 

jscomp/frontend/ast_exp_extension.ml

@@ -26,6 +26,35 @@ open Ast_helper
 let handle_extension e (self : Bs_ast_mapper.mapper)
     (({txt; loc}, payload) : Parsetree.extension) =
   match txt with
+  | "todo" ->
+    let todo_message =
+      match Ast_payload.is_single_string payload with
+      | Some (s, _) -> Some s
+      | None -> None
+    in
+    Location.prerr_warning e.Parsetree.pexp_loc (Bs_todo todo_message);
+    let pretext =
+      loc.loc_start.pos_fname ^ ":"
+      ^ string_of_int loc.loc_start.pos_lnum
+      ^ ":"
+      ^ string_of_int loc.loc_start.pos_cnum
+      ^ "-"
+      ^ string_of_int loc.loc_end.pos_cnum
+    in
+
+    Exp.apply ~loc
+      (Exp.ident ~loc {txt = Longident.parse "Js.Exn.raiseError"; loc})
+      [
+        ( Nolabel,
+          Exp.constant ~loc
+            (Pconst_string
+               ( (pretext
+                 ^
+                 match todo_message with
+                 | None -> " - Todo"
+                 | Some msg -> " - Todo: " ^ msg),
+                 None )) );
+      ]
   | "ffi" -> Ast_exp_handle_external.handle_ffi ~loc ~payload
   | "bs.raw" | "raw" ->
     Ast_exp_handle_external.handle_raw ~kind:Raw_exp loc payload