diff --git a/analysis/bin/main.ml b/analysis/bin/main.ml index 259b1a3004..e00c014dc4 100644 --- a/analysis/bin/main.ml +++ b/analysis/bin/main.ml @@ -129,9 +129,18 @@ let main () = | _ -> print_endline "\"ERR: Did not find root \"") | [_; "completion"; path; line; col; currentFile] -> printHeaderInfo path line col; - Commands.completion ~debug ~path - ~pos:(int_of_string line, int_of_string col) - ~currentFile + if !Cfg.useRevampedCompletion then + match + Commands.completionRevamped ~debug ~path + ~pos:(int_of_string line, int_of_string col) + ~currentFile + with + | None -> () + | Some (_, completablesText) -> print_endline completablesText + else + Commands.completion ~debug:true ~path + ~pos:(int_of_string line, int_of_string col) + ~currentFile | [_; "completionResolve"; path; modulePath] -> Commands.completionResolve ~path ~modulePath | [_; "definition"; path; line; col] -> @@ -208,8 +217,16 @@ let main () = (Json.escape (CreateInterface.command ~path ~cmiFile)) | [_; "format"; path] -> Printf.printf "\"%s\"" (Json.escape (Commands.format ~path)) - | [_; "test"; path] -> Commands.test ~path + | [_; "test"; path] -> Commands.test ~path ~debug + | [_; "test_revamped"; path; config_file_path] -> + Packages.overrideConfigFilePath := Some config_file_path; + Cfg.useRevampedCompletion := true; + Commands.test ~path ~debug | args when List.mem "-h" args || List.mem "--help" args -> prerr_endline help + | [_; "cmt"; path] -> CmtViewer.dump path + | [_; "cmt"; line; col; path] -> + let cursor = (int_of_string line, int_of_string col) in + CmtViewer.dump ~filter:(Cursor cursor) path | _ -> prerr_endline help; exit 1 diff --git a/analysis/reanalyze/src/Arnold.ml b/analysis/reanalyze/src/Arnold.ml index 9b31743603..e806bc59bb 100644 --- a/analysis/reanalyze/src/Arnold.ml +++ b/analysis/reanalyze/src/Arnold.ml @@ -582,9 +582,9 @@ module ExtendFunctionTable = struct Texp_apply {funct = {exp_desc = Texp_ident (path, {loc}, _)}; args}; } when kindOpt <> None -> - let checkArg ((argLabel : Asttypes.Noloc.arg_label), _argOpt) = + let checkArg ((argLabel : Asttypes.arg_label), _argOpt) = match (argLabel, kindOpt) with - | (Labelled l | Optional l), Some kind -> + | (Labelled {txt = l} | Optional {txt = l}), Some kind -> kind |> List.for_all (fun {Kind.label} -> label <> l) | _ -> true in @@ -624,9 +624,9 @@ module ExtendFunctionTable = struct when callee |> FunctionTable.isInFunctionInTable ~functionTable -> let functionName = Path.name callee in args - |> List.iter (fun ((argLabel : Asttypes.Noloc.arg_label), argOpt) -> + |> List.iter (fun ((argLabel : Asttypes.arg_label), argOpt) -> match (argLabel, argOpt |> extractLabelledArgument) with - | Labelled label, Some (path, loc) + | Labelled {txt = label}, Some (path, loc) when path |> FunctionTable.isInFunctionInTable ~functionTable -> functionTable @@ -672,11 +672,11 @@ module CheckExpressionWellFormed = struct -> let functionName = Path.name functionPath in args - |> List.iter (fun ((argLabel : Asttypes.Noloc.arg_label), argOpt) -> + |> List.iter (fun ((argLabel : Asttypes.arg_label), argOpt) -> match argOpt |> ExtendFunctionTable.extractLabelledArgument with | Some (path, loc) -> ( match argLabel with - | Labelled label -> ( + | Labelled {txt = label} -> ( if functionTable |> FunctionTable.functionGetKindOfLabel ~functionName @@ -761,7 +761,7 @@ module Compile = struct let argsFromKind = innerFunctionDefinition.kind |> List.map (fun (entry : Kind.entry) -> - ( Asttypes.Noloc.Labelled entry.label, + ( Asttypes.Labelled (Location.mknoloc entry.label), Some { expr with @@ -785,7 +785,7 @@ module Compile = struct args |> List.find_opt (fun arg -> match arg with - | Asttypes.Noloc.Labelled s, Some _ -> s = label + | Asttypes.Labelled {txt = s}, Some _ -> s = label | _ -> false) in let argOpt = diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index 57ddeccd26..df8b6aa0e2 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -104,7 +104,7 @@ let processOptionalArgs ~expType ~(locFrom : Location.t) ~locTo ~path args = | None -> Some false in match lbl with - | Asttypes.Noloc.Optional s when not locFrom.loc_ghost -> + | Asttypes.Optional {txt = s} when not locFrom.loc_ghost -> if argIsSupplied <> Some false then supplied := s :: !supplied; if argIsSupplied = None then suppliedMaybe := s :: !suppliedMaybe | _ -> ()); diff --git a/analysis/src/Cfg.ml b/analysis/src/Cfg.ml index bd4166d5ab..01d89980b2 100644 --- a/analysis/src/Cfg.ml +++ b/analysis/src/Cfg.ml @@ -17,3 +17,8 @@ let readProjectConfigCache = | "true" -> true | _ -> false with _ -> false) + +let useRevampedCompletion = + ref (Sys.getenv_opt "RESCRIPT_NEW_ANALYSIS_ENGINE" |> Option.is_some) + +let isTestWorkmode = ref false diff --git a/analysis/src/Cmt.ml b/analysis/src/Cmt.ml index a433d12908..e3c9d09aa1 100644 --- a/analysis/src/Cmt.ml +++ b/analysis/src/Cmt.ml @@ -29,9 +29,7 @@ let fullFromUri ~uri = else None in match incremental with - | Some cmtInfo -> - if Debug.verbose () then Printf.printf "[cmt] Found incremental cmt\n"; - Some cmtInfo + | Some cmtInfo -> Some cmtInfo | None -> ( match Hashtbl.find_opt package.pathsForModule moduleName with | Some paths -> diff --git a/analysis/src/CmtViewer.ml b/analysis/src/CmtViewer.ml new file mode 100644 index 0000000000..155f8c5dda --- /dev/null +++ b/analysis/src/CmtViewer.ml @@ -0,0 +1,93 @@ +let loc_to_string (loc : Warnings.loc) : string = + Format.sprintf "(%03d,%03d--%03d,%03d)" loc.loc_start.pos_lnum + (loc.loc_start.pos_cnum - loc.loc_start.pos_bol) + loc.loc_end.pos_lnum + (loc.loc_end.pos_cnum - loc.loc_end.pos_bol) + +let filter_by_cursor cursor (loc : Warnings.loc) : bool = + match cursor with + | None -> true + | Some (line, col) -> + let start = loc.loc_start and end_ = loc.loc_end in + let line_in = start.pos_lnum <= line && line <= end_.pos_lnum in + let col_in = + if start.pos_lnum = end_.pos_lnum then + start.pos_cnum - start.pos_bol <= col + && col <= end_.pos_cnum - end_.pos_bol + else if line = start.pos_lnum then col >= start.pos_cnum - start.pos_bol + else if line = end_.pos_lnum then col <= end_.pos_cnum - end_.pos_bol + else true + in + line_in && col_in + +type filter = Cursor of (int * int) | Loc of Loc.t + +let dump ?filter path = + match Cmt.loadFullCmtFromPath ~path with + | None -> failwith (Format.sprintf "Could not load cmt for %s" path) + | Some full -> + let open SharedTypes in + let open SharedTypes.Stamps in + let applyFilter = + match filter with + | None -> fun _ -> true + | Some (Cursor cursor) -> Loc.hasPos ~pos:cursor + | Some (Loc loc) -> Loc.isInside loc + in + (match filter with + | None -> () + | Some (Cursor (line, col)) -> + Printf.printf "Filtering by cursor %d,%d\n" line col + | Some (Loc loc) -> Printf.printf "Filtering by loc %s\n" (Loc.toString loc)); + let stamps = + full.file.stamps |> getEntries + |> List.filter (fun (_, stamp) -> applyFilter (locOfKind stamp)) + in + + let total_stamps = List.length stamps in + Printf.printf "Found %d stamps:\n%s" total_stamps + (if total_stamps > 0 then "\n" else ""); + + stamps + |> List.sort (fun (_, a) (_, b) -> + let aLoc = locOfKind a in + let bLoc = locOfKind b in + match compare aLoc.loc_start.pos_lnum bLoc.loc_start.pos_lnum with + | 0 -> compare aLoc.loc_start.pos_cnum bLoc.loc_start.pos_cnum + | c -> c) + |> List.iter (fun (stamp, kind) -> + match kind with + | KType t -> + Printf.printf "%d ktype %s\n" stamp + (loc_to_string t.extentLoc) + | KValue t -> + Printf.printf "%d kvalue %s\n" stamp + (loc_to_string t.extentLoc) + | KModule t -> + Printf.printf "%d kmodule %s\n" stamp + (loc_to_string t.extentLoc) + | KConstructor t -> + Printf.printf "%d kconstructor %s\n" stamp + (loc_to_string t.extentLoc)); + + (* Dump all locItems (typed nodes) *) + let locItems = + match full.extra with + | {locItems} -> + locItems |> List.filter (fun locItem -> applyFilter locItem.loc) + in + + Printf.printf "\nFound %d locItems (typed nodes):\n\n" + (List.length locItems); + + locItems + |> List.sort (fun a b -> + let aLoc = a.loc.Location.loc_start in + let bLoc = b.loc.Location.loc_start in + match compare aLoc.pos_lnum bLoc.pos_lnum with + | 0 -> compare aLoc.pos_cnum bLoc.pos_cnum + | c -> c) + |> List.iter (fun {loc; locType} -> + let locStr = loc_to_string loc in + let kindStr = SharedTypes.locTypeToString locType in + Printf.printf "%s %s\n" locStr kindStr) diff --git a/analysis/src/CodeFence.ml b/analysis/src/CodeFence.ml new file mode 100644 index 0000000000..8586421aa7 --- /dev/null +++ b/analysis/src/CodeFence.ml @@ -0,0 +1,125 @@ +(* Define a type for a range with start and finish indices *) +type range = {start: int; finish: int} + +(* --- Helper function to find the 0-based line index containing a given 0-based character index --- *) +let get_line_index_from_char_index code char_index = + let lines = String.split_on_char '\n' code in + let rec find_line_idx current_char_idx current_line_num remaining_lines = + match remaining_lines with + | [] -> + max 0 (current_line_num - 1) + (* If char_index is beyond the end, return last line index *) + | line :: tl -> + let line_length = String.length line in + (* Check if char_index is within the current line (including the newline char) *) + if + char_index >= current_char_idx + && char_index <= current_char_idx + line_length + then current_line_num + else + (* Move to the next line, account for the newline character (+1) *) + find_line_idx + (current_char_idx + line_length + 1) + (current_line_num + 1) tl + in + find_line_idx 0 0 lines + +(* --- Helper function to calculate the 0-based character index of the start of a given 0-based line index --- *) +let get_char_index_from_line_index code target_line_index = + let lines = String.split_on_char '\n' code in + let rec calculate_start_index_impl current_char_idx current_line_num + lines_to_process = + if current_line_num >= target_line_index then current_char_idx + else + match lines_to_process with + | [] -> current_char_idx (* Target line index is out of bounds *) + | line :: tl -> + (* Move past the current line and its newline character *) + calculate_start_index_impl + (current_char_idx + String.length line + 1) + (current_line_num + 1) tl + in + calculate_start_index_impl 0 0 lines + +(* --- Main formatting function --- *) +let format_code_snippet_cropped code (underline_range : range option) + lines_around_annotation = + let lines = String.split_on_char '\n' code in + let total_lines = List.length lines in + let formatted_output = Buffer.create (String.length code) in + (* Initial capacity *) + + (* Determine the central line index for cropping *) + let target_line_index = + match underline_range with + | Some {start; finish = _} -> get_line_index_from_char_index code start + | None -> 0 (* Default to first line if no annotations *) + in + + (* Determine the cropping window (0-based line indices) *) + let start_line_index = max 0 (target_line_index - lines_around_annotation) in + let end_line_index = + min (total_lines - 1) (target_line_index + lines_around_annotation) + in + + (* Keep track of the global character index corresponding to the start of the *current* line being iterated over *) + let current_char_index = ref 0 in + + (* Iterate through all original lines to correctly track current_char_index *) + List.iteri + (fun original_line_idx line -> + let line_length = String.length line in + (* Check if the current original line is within our cropping window *) + if + original_line_idx >= start_line_index + && original_line_idx <= end_line_index + then ( + let original_line_number = original_line_idx + 1 in + (* 1-based for display *) + let line_number_prefix = Printf.sprintf "%d + " original_line_number in + let prefix_length = String.length line_number_prefix in + + (* Add the code line *) + Buffer.add_string formatted_output line_number_prefix; + Buffer.add_string formatted_output line; + Buffer.add_char formatted_output '\n'; + + (* Prepare the annotation line buffer *) + let annotation_line_buffer = + Buffer.create (prefix_length + line_length) + in + Buffer.add_string annotation_line_buffer (String.make prefix_length ' '); + + (* Initial padding *) + let has_annotation_on_this_line = ref false in + + (* Check each character position within this line for annotations *) + for i = 0 to line_length - 1 do + let global_char_index = !current_char_index + i in + let annotation_char = ref ' ' in + (* Default to space *) + + (* Check for underline using Option.iter *) + Option.iter + (fun {start; finish} -> + if global_char_index >= start && global_char_index < finish then ( + annotation_char := '-' (* '¯' *); + (* Macron symbol *) + has_annotation_on_this_line := true)) + underline_range; + + Buffer.add_char annotation_line_buffer !annotation_char + done; + + (* Add the annotation line to the main output if needed *) + if !has_annotation_on_this_line then ( + Buffer.add_buffer formatted_output annotation_line_buffer; + Buffer.add_char formatted_output '\n')); + + (* Update the global character index to the start of the next line *) + (* This happens regardless of whether the line was in the cropped window *) + current_char_index := !current_char_index + line_length + 1 + (* +1 for the newline *)) + lines; + + Buffer.contents formatted_output diff --git a/analysis/src/Commands.ml b/analysis/src/Commands.ml index 464b3fa53d..5a5824cf99 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -1,7 +1,7 @@ -let completion ~debug ~path ~pos ~currentFile = +let completion ~(debug : bool) ~path ~pos ~currentFile = let completions = match - Completions.getCompletions ~debug ~path ~pos ~currentFile ~forHover:false + Completions.getCompletions debug ~path ~pos ~currentFile ~forHover:false with | None -> [] | Some (completions, full, _) -> @@ -11,6 +11,17 @@ let completion ~debug ~path ~pos ~currentFile = in completions |> Protocol.array |> print_endline +let completionRevamped ~debug ~path ~pos ~currentFile = + match Completions.getCompletionsRevamped ~debug ~pos ~currentFile ~path with + | None -> None + | Some (completable, completions, full, _) -> + Some + ( completable, + completions + |> List.map (CompletionBackEnd.completionToItem ~full) + |> List.map Protocol.stringifyCompletionItem + |> Protocol.array ) + let completionResolve ~path ~modulePath = (* We ignore the internal module path as of now because there's currently no use case for it. But, if we wanted to move resolving documentation @@ -63,6 +74,7 @@ let hover ~path ~pos ~currentFile ~debug ~supportsMarkdownLinks = | None -> Protocol.null | Some full -> ( match References.getLocItem ~full ~pos ~debug with + | None when !Cfg.useRevampedCompletion -> Protocol.null | None -> ( if debug then Printf.printf @@ -77,7 +89,9 @@ let hover ~path ~pos ~currentFile ~debug ~supportsMarkdownLinks = let isModule = match locItem.locType with | LModule _ | TopLevelModule _ -> true - | TypeDefinition _ | Typed _ | Constant _ -> false + | TypeDefinition _ | Typed _ | Constant _ | OtherExpression _ + | OtherPattern _ -> + false in let uriLocOpt = References.definitionForLocItem ~full locItem in let skipZero = @@ -135,7 +149,9 @@ let definition ~path ~pos ~debug = let isModule = match locItem.locType with | LModule _ | TopLevelModule _ -> true - | TypeDefinition _ | Typed _ | Constant _ -> false + | TypeDefinition _ | Typed _ | Constant _ | OtherExpression _ + | OtherPattern _ -> + false in let skipLoc = (not isModule) && (not isInterface) && posIsZero loc.loc_start @@ -298,7 +314,7 @@ let format ~path = let diagnosticSyntax ~path = print_endline (Diagnostics.document_syntax ~path |> Protocol.array) -let test ~path = +let test ~path ~debug = Uri.stripPath := true; match Files.readFile path with | None -> assert false @@ -343,6 +359,9 @@ let test ~path = | "db+" -> Log.verbose := true | "db-" -> Log.verbose := false | "dv+" -> Debug.debugLevel := Verbose + | "wrk" -> + Cfg.isTestWorkmode := true; + Debug.debugLevel := Verbose | "dv-" -> Debug.debugLevel := Off | "in+" -> Cfg.inIncrementalTypecheckingMode := true | "in-" -> Cfg.inIncrementalTypecheckingMode := false @@ -363,11 +382,43 @@ let test ~path = ^ string_of_int col); definition ~path ~pos:(line, col) ~debug:true | "com" -> - print_endline - ("Complete " ^ path ^ " " ^ string_of_int line ^ ":" - ^ string_of_int col); let currentFile = createCurrentFile () in - completion ~debug:true ~path ~pos:(line, col) ~currentFile; + if !Cfg.useRevampedCompletion then ( + Code_frame.setup (Some Misc.Color.Never); + if !Cfg.isTestWorkmode then ( + print_endline "===== CMT CONTENT ====="; + CmtViewer.dump path + (*print_endline "\n===== CMT FILTERED BY CURSOR ====="; + CmtViewer.dump path ~filter:(Cursor (line, col))*)); + let source = Files.readFile currentFile in + let completions = + completionRevamped ~debug ~path ~pos:(line, col) ~currentFile + in + (match (completions, source) with + | None, _ -> + print_endline "Completion Frontend did not return completable" + | Some (completable, completionsText), Some text -> ( + match SharedTypes.CompletableRevamped.try_loc completable with + | Some loc -> + Printf.printf "Found Completable: %s at type loc: %s\n\n" + (SharedTypes.CompletableRevamped.toString completable) + (Loc.toString loc); + if !Cfg.isTestWorkmode then ( + print_endline "\n===== CMT FILTERED BY TYPE LOC ====="; + CmtViewer.dump path ~filter:(Loc loc); + print_endline "\n\n"); + Code_frame.print ~is_warning:true ~draw_underline:true + ~src:text ~start_pos:loc.loc_start ~end_pos:loc.loc_end + |> print_endline; + print_endline completionsText + | None -> print_endline "No location found for completable") + | _ -> print_endline "ERR: Unexpected completion result"); + ()) + else ( + print_endline + ("Complete " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col); + completion ~debug:true ~path ~pos:(line, col) ~currentFile); Sys.remove currentFile | "cre" -> let modulePath = String.sub rest 3 (String.length rest - 3) in diff --git a/analysis/src/CompletionBackEndRevamped.ml b/analysis/src/CompletionBackEndRevamped.ml new file mode 100644 index 0000000000..824dbe6821 --- /dev/null +++ b/analysis/src/CompletionBackEndRevamped.ml @@ -0,0 +1,123 @@ +open SharedTypes + +let resolveOpens = CompletionBackEnd.resolveOpens +let getOpens = CompletionBackEnd.getOpens + +let findFields ~env ~package ~hint ?(seenFields = []) typ = + match TypeUtils.extractRecordType ~env ~package typ with + | None -> [] + | Some (_recordEnv, fields, decl) -> + fields + |> DotCompletionUtils.filterRecordFields ~env ~prefix:hint ~seenFields + ~exact:false + ~recordAsString:(decl.item.decl |> Shared.declToString decl.name.txt) + +let findRecordField ~env ~package ~fieldName typ = + match TypeUtils.extractRecordType ~env ~package typ with + | None -> None + | Some (_recordEnv, fields, _decl) -> + fields |> List.find_opt (fun (field : field) -> field.fname.txt = fieldName) + +type patternOrExpr = Pattern | Expr +let completeEmpty ~(mode : patternOrExpr) ~env ~package typ = + ignore mode; + match TypeUtils.extractType ~env ~package typ with + | None -> + if Debug.verbose () then + print_endline "⚠️ Could not extract completable type"; + [] + | Some (completionType, typeArgContext) -> ( + (* Fill this out with the different completions *) + match completionType with + | Trecord _ -> + [ + Completion.create ?typeArgContext "{}" ~includesSnippets:true + ~insertText:"{$0}" ~sortText:"A" ~kind:(Value typ) ~env; + ] + | Tarray _ -> + [ + Completion.create ?typeArgContext "[]" ~includesSnippets:true + ~insertText:"[$0]" ~sortText:"A" ~kind:(Value typ) ~env; + ] + | Tbool _ -> + [ + Completion.create ?typeArgContext "true" ~includesSnippets:true + ~insertText:"true" ~sortText:"A" ~kind:(Value typ) ~env; + Completion.create ?typeArgContext "false" ~includesSnippets:true + ~insertText:"false" ~sortText:"A" ~kind:(Value typ) ~env; + ] + | Tstring _ -> + [ + Completion.create ?typeArgContext "\"\"" ~includesSnippets:true + ~insertText:"\"$0\"" ~sortText:"A" ~kind:(Value typ) ~env; + ] + | _ -> []) + +let processCompletable ~debug ~full ~scope ~env ~pos + (completable : CompletableRevamped.t) = + let package = full.package in + let rawOpens = Scope.getRawOpens scope in + let opens = getOpens ~debug ~rawOpens ~package ~env in + let allFiles = allFilesInPackage package in + + ignore pos; + ignore opens; + ignore allFiles; + + match completable with + | Cexpression {kind; typeLoc} -> ( + match TypeUtils.findTypeViaLoc typeLoc ~full ~debug with + | None -> + if Debug.verbose () then print_endline "⚠️ No type found for loc"; + [] + | Some typ -> ( + if Debug.verbose () then + print_endline ("✅ Found type at loc:" ^ Shared.typeToString typ); + match kind with + | Empty -> completeEmpty ~mode:Expr ~env ~package typ + | Field {hint} -> findFields ~env ~package ~hint typ)) + | Cpattern {kind; typeLoc} -> ( + match TypeUtils.findTypeViaLoc typeLoc ~full ~debug with + | None -> [] + | Some typ -> ( + match kind with + | Empty -> completeEmpty ~mode:Pattern ~env ~package typ + | Field {hint; seenFields} -> + findFields ~env ~package ~hint ~seenFields typ + | FieldValue {fieldName} -> ( + match findRecordField ~env ~package ~fieldName typ with + | None -> [] + | Some field -> completeEmpty ~mode:Pattern ~env ~package field.typ))) + | Cnone -> [] + | CextensionNode _ -> [] + | Cdecorator prefix -> + let mkDecorator (name, docstring, maybeInsertText) = + { + (Completion.create name ~synthetic:true ~includesSnippets:true + ~kind:(Label "") ~env ?insertText:maybeInsertText) + with + docstring; + } + in + let isTopLevel = String.starts_with ~prefix:"@" prefix in + let prefix = + if isTopLevel then String.sub prefix 1 (String.length prefix - 1) + else prefix + in + let decorators = + if isTopLevel then CompletionDecorators.toplevel + else CompletionDecorators.local + in + decorators + |> List.filter (fun (decorator, _, _) -> Utils.startsWith decorator prefix) + |> List.map (fun (decorator, maybeInsertText, doc) -> + let parts = String.split_on_char '.' prefix in + let len = String.length prefix in + let dec2 = + if List.length parts > 1 then + String.sub decorator len (String.length decorator - len) + else decorator + in + (dec2, doc, maybeInsertText)) + |> List.map mkDecorator + | CdecoratorPayload _ -> [] diff --git a/analysis/src/CompletionFrontEndRevamped.ml b/analysis/src/CompletionFrontEndRevamped.ml new file mode 100644 index 0000000000..9a710e864c --- /dev/null +++ b/analysis/src/CompletionFrontEndRevamped.ml @@ -0,0 +1,836 @@ +open SharedTypes + +let completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text = + let offsetNoWhite = Utils.skipWhite text (offset - 1) in + let posNoWhite = + let line, col = posCursor in + (line, max 0 col - offset + offsetNoWhite) + in + (* Identifies the first character before the cursor that's not white space. + Should be used very sparingly, but can be used to drive completion triggering + in scenarios where the parser eats things we'd need to complete. + Example: let {whatever, }, char is ','. *) + let firstCharBeforeCursorNoWhite = + if offsetNoWhite < String.length text && offsetNoWhite >= 0 then + Some text.[offsetNoWhite] + else None + in + let posOfDot = Pos.posOfDot text ~pos:posCursor ~offset in + let charAtCursor = + if offset < String.length text then text.[offset] else '\n' + in + let posBeforeCursor = Pos.posBeforeCursor posCursor in + let _charBeforeCursor, blankAfterCursor = + match Pos.positionToOffset text posCursor with + | Some offset when offset > 0 -> ( + let charBeforeCursor = text.[offset - 1] in + match charAtCursor with + | ' ' | '\t' | '\r' | '\n' -> + (Some charBeforeCursor, Some charBeforeCursor) + | _ -> (Some charBeforeCursor, None)) + | _ -> (None, None) + in + let flattenLidCheckDot ?(jsx = true) (lid : Longident.t Location.loc) = + (* Flatten an identifier keeping track of whether the current cursor + is after a "." in the id followed by a blank character. + In that case, cut the path after ".". *) + let cutAtOffset = + let idStart = Loc.start lid.loc in + match blankAfterCursor with + | Some '.' -> + if fst posBeforeCursor = fst idStart then + Some (snd posBeforeCursor - snd idStart) + else None + | _ -> None + in + Utils.flattenLongIdent ~cutAtOffset ~jsx lid.txt + in + + let found = ref false in + let result = ref None in + let currentTypeLoc = ref None in + let scope = ref (Scope.create ()) in + let setResultOpt x = + if !result = None then + match x with + | None -> + if Debug.verbose () then + print_endline + "[set_result] did not set new result because result already was set"; + () + | Some x -> result := Some (x, !scope) + in + + let setResult (x : CompletableRevamped.t) = setResultOpt (Some x) in + let scopeValueDescription (vd : Parsetree.value_description) = + scope := + !scope |> Scope.addValue ~name:vd.pval_name.txt ~loc:vd.pval_name.loc + in + let rec scopePattern (pat : Parsetree.pattern) = + match pat.ppat_desc with + | Ppat_any -> () + | Ppat_var {txt; loc} -> scope := !scope |> Scope.addValue ~name:txt ~loc + | Ppat_alias (p, asA) -> + scopePattern p; + scope := !scope |> Scope.addValue ~name:asA.txt ~loc:asA.loc + | Ppat_constant _ | Ppat_interval _ -> () + | Ppat_tuple pl -> pl |> List.iter (fun p -> scopePattern p) + | Ppat_construct (_, None) -> () + | Ppat_construct (_, Some {ppat_desc = Ppat_tuple pl}) -> + pl |> List.iter (fun p -> scopePattern p) + | Ppat_construct (_, Some p) -> scopePattern p + | Ppat_variant (_, None) -> () + | Ppat_variant (_, Some {ppat_desc = Ppat_tuple pl}) -> + pl |> List.iter (fun p -> scopePattern p) + | Ppat_variant (_, Some p) -> scopePattern p + | Ppat_record (fields, _) -> + fields |> List.iter (fun (_fname, p, _) -> scopePattern p) + | Ppat_array pl -> pl |> List.iter scopePattern + | Ppat_or (p1, _) -> scopePattern p1 + | Ppat_constraint (p, _coreType) -> scopePattern p + | Ppat_type _ -> () + | Ppat_lazy p -> scopePattern p + | Ppat_unpack {txt; loc} -> scope := !scope |> Scope.addValue ~name:txt ~loc + | Ppat_exception p -> scopePattern p + | Ppat_extension _ -> () + | Ppat_open (_, p) -> scopePattern p + in + let locHasCursor = CursorPosition.locHasCursor ~pos:posBeforeCursor in + let locIsEmpty = CursorPosition.locIsEmpty ~pos:posBeforeCursor in + let scopeValueBinding (vb : Parsetree.value_binding) = + scopePattern vb.pvb_pat + in + let scopeTypeKind (tk : Parsetree.type_kind) = + match tk with + | Ptype_variant constrDecls -> + constrDecls + |> List.iter (fun (cd : Parsetree.constructor_declaration) -> + scope := + !scope + |> Scope.addConstructor ~name:cd.pcd_name.txt ~loc:cd.pcd_loc) + | Ptype_record labelDecls -> + labelDecls + |> List.iter (fun (ld : Parsetree.label_declaration) -> + scope := + !scope |> Scope.addField ~name:ld.pld_name.txt ~loc:ld.pld_loc) + | _ -> () + in + let scopeTypeDeclaration (td : Parsetree.type_declaration) = + scope := + !scope |> Scope.addType ~name:td.ptype_name.txt ~loc:td.ptype_name.loc; + scopeTypeKind td.ptype_kind + in + let scopeModuleBinding (mb : Parsetree.module_binding) = + scope := + !scope |> Scope.addModule ~name:mb.pmb_name.txt ~loc:mb.pmb_name.loc + in + let scopeModuleDeclaration (md : Parsetree.module_declaration) = + scope := + !scope |> Scope.addModule ~name:md.pmd_name.txt ~loc:md.pmd_name.loc + in + let structure (iterator : Ast_iterator.iterator) + (structure : Parsetree.structure) = + let oldScope = !scope in + Ast_iterator.default_iterator.structure iterator structure; + scope := oldScope + in + let structure_item (iterator : Ast_iterator.iterator) + (item : Parsetree.structure_item) = + let processed = ref false in + (match item.pstr_desc with + | Pstr_open {popen_lid} -> + scope := !scope |> Scope.addOpen ~lid:popen_lid.txt + | Pstr_primitive vd -> scopeValueDescription vd + | Pstr_value (recFlag, bindings) -> + if recFlag = Recursive then bindings |> List.iter scopeValueBinding; + bindings |> List.iter (fun vb -> iterator.value_binding iterator vb); + if recFlag = Nonrecursive then bindings |> List.iter scopeValueBinding; + processed := true + | Pstr_type (recFlag, decls) -> + if recFlag = Recursive then decls |> List.iter scopeTypeDeclaration; + decls |> List.iter (fun td -> iterator.type_declaration iterator td); + if recFlag = Nonrecursive then decls |> List.iter scopeTypeDeclaration; + processed := true + | Pstr_module mb -> + iterator.module_binding iterator mb; + scopeModuleBinding mb; + processed := true + | Pstr_recmodule mbs -> + mbs |> List.iter scopeModuleBinding; + mbs |> List.iter (fun b -> iterator.module_binding iterator b); + processed := true + | _ -> ()); + if not !processed then + Ast_iterator.default_iterator.structure_item iterator item + in + let value_binding (iterator : Ast_iterator.iterator) + (value_binding : Parsetree.value_binding) = + (match value_binding with + | {pvb_pat = {ppat_desc = Ppat_constraint (p, _)}; pvb_expr; pvb_loc} + when CompletionExpressions.isExprHole pvb_expr + && locHasCursor pvb_loc + && not (locHasCursor p.ppat_loc) -> + (* let x: constraint = *) + setResult (Cexpression {kind = Empty; typeLoc = p.ppat_loc; posOfDot}) + | {pvb_pat; pvb_expr; pvb_loc} + when CompletionExpressions.isExprHole pvb_expr + && locHasCursor pvb_loc + && not (locHasCursor pvb_pat.ppat_loc) -> + (* let x= *) + (* Unclear if this happens and if we need to care about it. *) + setResult + (Cexpression {kind = Empty; typeLoc = pvb_pat.ppat_loc; posOfDot}) + | _ -> ()); + Ast_iterator.default_iterator.value_binding iterator value_binding + in + let signature (iterator : Ast_iterator.iterator) + (signature : Parsetree.signature) = + let oldScope = !scope in + Ast_iterator.default_iterator.signature iterator signature; + scope := oldScope + in + let signature_item (iterator : Ast_iterator.iterator) + (item : Parsetree.signature_item) = + let processed = ref false in + (match item.psig_desc with + | Psig_open {popen_lid} -> + scope := !scope |> Scope.addOpen ~lid:popen_lid.txt + | Psig_value vd -> scopeValueDescription vd + | Psig_type (recFlag, decls) -> + if recFlag = Recursive then decls |> List.iter scopeTypeDeclaration; + decls |> List.iter (fun td -> iterator.type_declaration iterator td); + if recFlag = Nonrecursive then decls |> List.iter scopeTypeDeclaration; + processed := true + | Psig_module md -> + iterator.module_declaration iterator md; + scopeModuleDeclaration md; + processed := true + | Psig_recmodule mds -> + mds |> List.iter scopeModuleDeclaration; + mds |> List.iter (fun d -> iterator.module_declaration iterator d); + processed := true + | _ -> ()); + if not !processed then + Ast_iterator.default_iterator.signature_item iterator item + in + let attribute (iterator : Ast_iterator.iterator) + ((id, payload) : Parsetree.attribute) = + (if String.length id.txt >= 4 && String.sub id.txt 0 4 = "res." then + (* skip: internal parser attribute *) () + else if id.loc.loc_ghost then () + else if id.loc |> Loc.hasPos ~pos:posBeforeCursor then + let posStart, posEnd = Loc.range id.loc in + match + (Pos.positionToOffset text posStart, Pos.positionToOffset text posEnd) + with + | Some offsetStart, Some offsetEnd -> + (* Can't trust the parser's location + E.g. @foo. let x... gives as label @foo.let *) + let label = + let rawLabel = + String.sub text offsetStart (offsetEnd - offsetStart) + in + let ( ++ ) x y = + match (x, y) with + | Some i1, Some i2 -> Some (min i1 i2) + | Some _, None -> x + | None, _ -> y + in + let label = + match + String.index_opt rawLabel ' ' + ++ String.index_opt rawLabel '\t' + ++ String.index_opt rawLabel '\r' + ++ String.index_opt rawLabel '\n' + with + | None -> rawLabel + | Some i -> String.sub rawLabel 0 i + in + if label <> "" && label.[0] = '@' then + String.sub label 1 (String.length label - 1) + else label + in + found := true; + if debug then + Printf.printf "Attribute id:%s:%s label:%s\n" id.txt + (Loc.toString id.loc) label; + setResult (Cdecorator label) + | _ -> () + else if id.txt = "module" then + match payload with + | PStr + [ + { + pstr_desc = + Pstr_eval + ( {pexp_loc; pexp_desc = Pexp_constant (Pconst_string (s, _))}, + _ ); + }; + ] + when locHasCursor pexp_loc -> + if Debug.verbose () then + print_endline "[decoratorCompletion] Found @module"; + setResult (CdecoratorPayload (Module s)) + | PStr + [ + { + pstr_desc = + Pstr_eval + ( { + pexp_desc = + Pexp_record + (({txt = Lident "from"}, fromExpr, _) :: _, _); + }, + _ ); + }; + ] + when locHasCursor fromExpr.pexp_loc + || locIsEmpty fromExpr.pexp_loc + && CompletionExpressions.isExprHole fromExpr -> ( + if Debug.verbose () then + print_endline + "[decoratorCompletion] Found @module with import attributes and \ + cursor on \"from\""; + match + ( locHasCursor fromExpr.pexp_loc, + locIsEmpty fromExpr.pexp_loc, + CompletionExpressions.isExprHole fromExpr, + fromExpr ) + with + | true, _, _, {pexp_desc = Pexp_constant (Pconst_string (s, _))} -> + if Debug.verbose () then + print_endline + "[decoratorCompletion] @module `from` payload was string"; + setResult (CdecoratorPayload (Module s)) + | false, true, true, _ -> + if Debug.verbose () then + print_endline + "[decoratorCompletion] @module `from` payload was expr hole"; + setResult (CdecoratorPayload (Module "")) + | _ -> ()) + | PStr [{pstr_desc = Pstr_eval (_expr, _)}] -> + if Debug.verbose () then + print_endline + "[decoratorCompletion] Found @module with non-string payload"; + (* TODO(revamp) Complete *) + () + | _ -> () + else if id.txt = "jsxConfig" then + match payload with + | PStr [{pstr_desc = Pstr_eval (_expr, _)}] -> + if Debug.verbose () then + print_endline "[decoratorCompletion] Found @jsxConfig"; + (* TODO(revamp) Complete *) + () + | _ -> () + else if id.txt = "editor.completeFrom" then + match payload with + | PStr + [ + { + pstr_desc = + Pstr_eval + ( { + pexp_loc; + pexp_desc = Pexp_construct ({txt = _path; loc = _}, None); + }, + _ ); + }; + ] + when locHasCursor pexp_loc -> + if Debug.verbose () then + print_endline "[decoratorCompletion] Found @editor.completeFrom"; + (* TODO(revamp) Complete for module identifier *) + (*setResult + (Completable.Cpath + (CPId + { + path = Utils.flattenLongIdent path; + completionContext = Module; + loc; + }))*) + () + | _ -> ()); + Ast_iterator.default_iterator.attribute iterator (id, payload) + in + let expr (iterator : Ast_iterator.iterator) (expr : Parsetree.expression) = + let processed = ref false in + let setFound () = + found := true; + if debug then + Printf.printf "posCursor:[%s] posNoWhite:[%s] Found expr:%s\n" + (Pos.toString posCursor) (Pos.toString posNoWhite) + (Loc.toString expr.pexp_loc) + in + match expr.pexp_desc with + | Pexp_apply + { + funct = {pexp_desc = Pexp_ident {txt = Lident "->"; loc = opLoc}}; + args = + [ + (_, _lhs); + (_, {pexp_desc = Pexp_extension _; pexp_loc = {loc_ghost = true}}); + ]; + } + when opLoc |> Loc.hasPos ~pos:posBeforeCursor -> + (* Case foo-> when the parser adds a ghost expression to the rhs + so the apply expression does not include the cursor *) + (* TODO(revamp) Complete pipe *) + () + (* + A dot completion for a tagged templated application with an expr hole. + Example: + sh`echo "meh"`. + *) + | Pexp_apply + { + funct = {pexp_desc = Pexp_ident {txt = Lident "."; loc = _}}; + args = + [ + (* sh`echo "meh"` *) + (_, ({pexp_desc = Pexp_apply _} as innerExpr)); + (* recovery inserted node *) + (_, {pexp_desc = Pexp_extension ({txt = "rescript.exprhole"}, _)}); + ]; + } + when Res_parsetree_viewer.is_tagged_template_literal innerExpr -> + (* TODO(revamp) Complete *) + () + (* + A dot completion for a tagged templated application with an ident. + Example: + sh`echo "meh"`.foo + *) + | Pexp_apply + { + funct = {pexp_desc = Pexp_ident {txt = Lident "."; loc = _}}; + args = + [ + (* sh`echo "meh"` *) + (_, ({pexp_desc = Pexp_apply _} as innerExpr)); + (* foo *) + (_, {pexp_desc = Pexp_ident {txt = Lident _fieldName}}); + ]; + } + when Res_parsetree_viewer.is_tagged_template_literal innerExpr + && expr.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor -> + (* TODO(revamp) Complete *) + () + | _ -> + if expr.pexp_loc |> Loc.hasPos ~pos:posNoWhite && !result = None then ( + setFound (); + match expr.pexp_desc with + | Pexp_match (switchExpr, [{pc_lhs = lhsPat}]) + when CompletionPatterns.isPatternHole lhsPat + && locHasCursor switchExpr.pexp_loc = false -> + setResult (Cpattern {kind = Empty; typeLoc = switchExpr.pexp_loc}) + | Pexp_match (switchExpr, cases) -> + let oldTypeLoc = !currentTypeLoc in + currentTypeLoc := Some switchExpr.pexp_loc; + cases + |> List.iter (fun case -> + Ast_iterator.default_iterator.case iterator case); + currentTypeLoc := oldTypeLoc; + processed := true + | Pexp_extension ({txt = "obj"}, PStr [str_item]) -> + Ast_iterator.default_iterator.structure_item iterator str_item + | Pexp_record ([], _) -> + (* Empty fields means we're in a record body `{}`. Complete for the fields. *) + setResult + (Cexpression + {kind = Field {hint = ""}; typeLoc = expr.pexp_loc; posOfDot}) + | Pexp_extension ({txt}, _) -> setResult (CextensionNode txt) + | Pexp_constant _ -> setResult Cnone + | Pexp_ident lid -> + let lidPath = flattenLidCheckDot lid in + if lid.loc |> Loc.hasPos ~pos:posBeforeCursor then + let _isLikelyModulePath = + match lidPath with + | head :: _ + when String.length head > 0 + && head.[0] == Char.uppercase_ascii head.[0] -> + true + | _ -> false + in + () + (* TODO(revamp) Complete for module identifier *) + (*setResult + (Cpath + (CPId + { + loc = lid.loc; + path = lidPath; + completionContext = + (if + isLikelyModulePath + && expr |> Res_parsetree_viewer.is_braced_expr + then ValueOrField + else Value); + }))*) + | Pexp_construct ({txt = Lident ("::" | "()")}, _) -> + (* Ignore list expressions, used in JSX, unit, and more *) () + | Pexp_construct (lid, eOpt) -> ( + let lidPath = flattenLidCheckDot lid in + if debug then + Printf.printf "Pexp_construct %s:%s %s\n" + (lidPath |> String.concat "\n") + (Loc.toString lid.loc) + (match eOpt with + | None -> "None" + | Some e -> Loc.toString e.pexp_loc); + if + eOpt = None && (not lid.loc.loc_ghost) + && lid.loc |> Loc.hasPos ~pos:posBeforeCursor + then () + (* TODO(revamp) Complete *) + (* + setResult + (Cpath + (CPId + {loc = lid.loc; path = lidPath; completionContext = Value}))*) + else + match eOpt with + | Some e when locHasCursor e.pexp_loc -> ( + match + CompletionExpressions.completeConstructorPayload + ~posBeforeCursor ~firstCharBeforeCursorNoWhite lid e + with + | Some _result -> + (* Check if anything else more important completes before setting this completion. *) + Ast_iterator.default_iterator.expr iterator e + (* TODO(revamp) Complete *) + (*setResult result*) + | None -> ()) + | _ -> ()) + | Pexp_field (e, fieldName) -> + if locHasCursor fieldName.loc then + match fieldName.txt with + | Lident name -> + setResult + (Cexpression + {kind = Field {hint = name}; typeLoc = e.pexp_loc; posOfDot}) + | Ldot (_id, _name) -> + (* Case x.M.field ignore the x part *) + (*let contextPath = + Completable.CPField + { + contextPath = + CPId + { + loc = fieldName.loc; + path = Utils.flattenLongIdent id; + completionContext = Module; + }; + fieldName = + (if blankAfterCursor = Some '.' then + (* x.M. field ---> M. *) "" + else if name = "_" then "" + else name); + posOfDot; + exprLoc = e.pexp_loc; + inJsx = !inJsxContext; + } + in*) + (* TODO(revamp) Complete ID *) + () + | Lapply _ -> () + else if Loc.end_ e.pexp_loc = posBeforeCursor then + setResult + (Cexpression + {kind = Field {hint = ""}; typeLoc = e.pexp_loc; posOfDot}) + (* TODO(revamp) Insert back JSX stuff *) + | Pexp_apply + { + funct = {pexp_desc = Pexp_ident {txt = Lident "->"}}; + args = + [ + (_, _lhs); + (_, {pexp_desc = Pexp_ident {txt = Longident.Lident _id; loc}}); + ]; + } + when loc |> Loc.hasPos ~pos:posBeforeCursor -> + if Debug.verbose () then print_endline "[expr_iter] Case foo->id"; + (* TODO(revamp) Complete pipe (id) *) + () + | Pexp_apply + { + funct = {pexp_desc = Pexp_ident {txt = Lident "->"; loc = opLoc}}; + args = [(_, _lhs); _]; + } + when Loc.end_ opLoc = posCursor -> + if Debug.verbose () then print_endline "[expr_iter] Case foo->"; + (* TODO(revamp) Complete pipe (empty) *) + () + | Pexp_send (lhs, {txt; loc}) -> + (* e["txt"] + If the string for txt is not closed, it could go over several lines. + Only take the first like to represent the label *) + let txtLines = txt |> String.split_on_char '\n' in + let label = List.hd txtLines in + let label = + if label <> "" && label.[String.length label - 1] = '\r' then + String.sub label 0 (String.length label - 1) + else label + in + let labelRange = + let l, c = Loc.start loc in + ((l, c + 1), (l, c + 1 + String.length label)) + in + if debug then + Printf.printf "Pexp_send %s%s e:%s\n" label + (Range.toString labelRange) + (Loc.toString lhs.pexp_loc); + if + labelRange |> Range.hasPos ~pos:posBeforeCursor + || (label = "" && posCursor = fst labelRange) + then + (* TODO(revamp) Complete obj *) + () + | Pexp_fun + {arg_label = _lbl; default = _defaultExpOpt; lhs = pat; rhs = e} -> + let oldScope = !scope in + scopePattern pat; + iterator.pat iterator pat; + iterator.expr iterator e; + scope := oldScope; + processed := true + | Pexp_let (recFlag, bindings, e) -> + let oldScope = !scope in + if recFlag = Recursive then bindings |> List.iter scopeValueBinding; + bindings |> List.iter (fun vb -> iterator.value_binding iterator vb); + if recFlag = Nonrecursive then bindings |> List.iter scopeValueBinding; + iterator.expr iterator e; + scope := oldScope; + processed := true + | Pexp_letmodule (name, modExpr, modBody) -> + let oldScope = !scope in + iterator.location iterator name.loc; + iterator.module_expr iterator modExpr; + scope := !scope |> Scope.addModule ~name:name.txt ~loc:name.loc; + iterator.expr iterator modBody; + scope := oldScope; + processed := true + | Pexp_open (_, lid, e) -> + let oldScope = !scope in + iterator.location iterator lid.loc; + scope := !scope |> Scope.addOpen ~lid:lid.txt; + iterator.expr iterator e; + scope := oldScope; + processed := true + | _ -> ()); + if not !processed then Ast_iterator.default_iterator.expr iterator expr + in + let typ (iterator : Ast_iterator.iterator) (core_type : Parsetree.core_type) = + if core_type.ptyp_loc |> Loc.hasPos ~pos:posNoWhite then ( + found := true; + if debug then + Printf.printf "posCursor:[%s] posNoWhite:[%s] Found type:%s\n" + (Pos.toString posCursor) (Pos.toString posNoWhite) + (Loc.toString core_type.ptyp_loc); + match core_type.ptyp_desc with + | Ptyp_constr (lid, _args) -> + let lidPath = flattenLidCheckDot lid in + if debug then + Printf.printf "Ptyp_constr %s:%s\n" + (lidPath |> String.concat ".") + (Loc.toString lid.loc); + if lid.loc |> Loc.hasPos ~pos:posBeforeCursor then + (* TODO(revamp) Complete type *) + () + | _ -> ()); + Ast_iterator.default_iterator.typ iterator core_type + in + let pat (iterator : Ast_iterator.iterator) (pat : Parsetree.pattern) = + if pat.ppat_loc |> Loc.hasPos ~pos:posNoWhite then ( + found := true; + if debug then + Printf.printf "posCursor:[%s] posNoWhite:[%s] Found pattern:%s\n" + (Pos.toString posCursor) (Pos.toString posNoWhite) + (Loc.toString pat.ppat_loc); + (match pat.ppat_desc with + | Ppat_record ([], _) -> + (* No fields means empty record body.*) + setResult + (Cpattern + {kind = Field {hint = ""; seenFields = []}; typeLoc = pat.ppat_loc}) + | Ppat_record (fields, _) -> ( + let fieldWithCursor = ref None in + let fieldWithPatHole = ref None in + fields + |> List.iter (fun (fname, f, _) -> + match + ( fname.Location.txt, + f.Parsetree.ppat_loc + |> CursorPosition.classifyLoc ~pos:posBeforeCursor ) + with + | Longident.Lident fname, HasCursor -> + fieldWithCursor := Some (fname, f) + | Lident fname, _ when CompletionPatterns.isPatternHole f -> + fieldWithPatHole := Some (fname, f) + | _ -> ()); + let seenFields = + fields + |> List.filter_map (fun (fieldName, _f, _) -> + match fieldName with + | {Location.txt = Longident.Lident fieldName} -> Some fieldName + | _ -> None) + in + match (!fieldWithCursor, !fieldWithPatHole) with + | Some (fname, f), _ | None, Some (fname, f) -> ( + match f.ppat_desc with + | Ppat_extension ({txt = "rescript.patternhole"}, _) -> + (* A pattern hole means for example `{someField: }`. We want to complete for the type of `someField`. *) + setResult + (Cpattern + {kind = FieldValue {fieldName = fname}; typeLoc = pat.ppat_loc}) + | Ppat_var {txt} -> + (* A var means `{s}` or similar. Complete for fields. *) + setResult + (Cpattern + {kind = Field {hint = txt; seenFields}; typeLoc = pat.ppat_loc}) + | _ -> ()) + | None, None -> ( + (* Figure out if we're completing for a new field. + If the cursor is inside of the record body, but no field has the cursor, + and there's no pattern hole. Check the first char to the left of the cursor, + ignoring white space. If that's a comma, we assume you're completing for a new field. *) + match firstCharBeforeCursorNoWhite with + | Some ',' -> + setResult + (Cpattern + {kind = Field {hint = ""; seenFields}; typeLoc = pat.ppat_loc}) + | _ -> ())) + | Ppat_construct (lid, _) -> + let lidPath = flattenLidCheckDot lid in + if debug then + Printf.printf "Ppat_construct %s:%s\n" + (lidPath |> String.concat ".") + (Loc.toString lid.loc); + let _completion = + Completable.Cpath + (CPId {loc = lid.loc; path = lidPath; completionContext = Value}) + in + (* TODO(revamp) Complete *) + () + | _ -> ()); + Ast_iterator.default_iterator.pat iterator pat) + in + let module_expr (iterator : Ast_iterator.iterator) + (me : Parsetree.module_expr) = + (match me.pmod_desc with + | Pmod_ident lid when lid.loc |> Loc.hasPos ~pos:posBeforeCursor -> + let lidPath = flattenLidCheckDot lid in + if debug then + Printf.printf "Pmod_ident %s:%s\n" + (lidPath |> String.concat ".") + (Loc.toString lid.loc); + found := true + (* TODO(revamp) Complete module ID *) + (* + setResult + (Cpath + (CPId {loc = lid.loc; path = lidPath; completionContext = Module}))*) + | _ -> ()); + Ast_iterator.default_iterator.module_expr iterator me + in + let module_type (iterator : Ast_iterator.iterator) + (mt : Parsetree.module_type) = + (match mt.pmty_desc with + | Pmty_ident lid when lid.loc |> Loc.hasPos ~pos:posBeforeCursor -> + let lidPath = flattenLidCheckDot lid in + if debug then + Printf.printf "Pmty_ident %s:%s\n" + (lidPath |> String.concat ".") + (Loc.toString lid.loc); + found := true + (* TODO(revamp) Complete module ID *) + (* + setResult + (Cpath + (CPId {loc = lid.loc; path = lidPath; completionContext = Module}))*) + | _ -> ()); + Ast_iterator.default_iterator.module_type iterator mt + in + let type_kind (iterator : Ast_iterator.iterator) + (type_kind : Parsetree.type_kind) = + (match type_kind with + | Ptype_variant [decl] + when decl.pcd_name.loc |> Loc.hasPos ~pos:posNoWhite + && decl.pcd_args = Pcstr_tuple [] -> + (* "type t = Pre" could signal the intent to complete variant "Prelude", + or the beginning of "Prefix.t" *) + if debug then + Printf.printf "Ptype_variant unary %s:%s\n" decl.pcd_name.txt + (Loc.toString decl.pcd_name.loc); + found := true + (* TODO(revamp) Complete *) + (*setResult + (Cpath + (CPId + { + loc = decl.pcd_name.loc; + path = [decl.pcd_name.txt]; + completionContext = Value; + }))*) + | _ -> ()); + Ast_iterator.default_iterator.type_kind iterator type_kind + in + + let lastScopeBeforeCursor = ref (Scope.create ()) in + let location (_iterator : Ast_iterator.iterator) (loc : Location.t) = + if Loc.end_ loc <= posCursor then lastScopeBeforeCursor := !scope + in + + let iterator = + { + Ast_iterator.default_iterator with + attribute; + expr; + location; + module_expr; + module_type; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_kind; + value_binding; + } + in + + if Filename.check_suffix path ".res" then ( + let parser = + Res_driver.parsing_engine.parse_implementation ~for_printer:false + in + let {Res_driver.parsetree = str} = parser ~filename:currentFile in + iterator.structure iterator str |> ignore; + if blankAfterCursor = Some ' ' || blankAfterCursor = Some '\n' then + scope := !lastScopeBeforeCursor + (* TODO(revamp) Complete any value *) + (*setResult + (Cpath + (CPId {loc = Location.none; path = [""]; completionContext = Value}))*); + if !found = false then if debug then Printf.printf "XXX Not found!\n"; + !result) + else if Filename.check_suffix path ".resi" then ( + let parser = Res_driver.parsing_engine.parse_interface ~for_printer:false in + let {Res_driver.parsetree = signature} = parser ~filename:currentFile in + iterator.signature iterator signature |> ignore; + if blankAfterCursor = Some ' ' || blankAfterCursor = Some '\n' then + scope := !lastScopeBeforeCursor + (* TODO(revamp) Complete any type *) + (*setResult + setResult + (Cpath + (CPId {loc = Location.none; path = [""]; completionContext = Type}))*); + if !found = false then if debug then Printf.printf "XXX Not found!\n"; + !result) + else None + +let completionWithParser ~debug ~path ~posCursor ~currentFile ~text = + match Pos.positionToOffset text posCursor with + | Some offset -> + completionWithParser ~currentFile ~debug ~offset ~path ~posCursor text + | None -> None diff --git a/analysis/src/Completions.ml b/analysis/src/Completions.ml index 42176bb3b0..16aebf71d1 100644 --- a/analysis/src/Completions.ml +++ b/analysis/src/Completions.ml @@ -1,4 +1,4 @@ -let getCompletions ~debug ~path ~pos ~currentFile ~forHover = +let getCompletions (debug : bool) ~path ~pos ~currentFile ~forHover = let textOpt = Files.readFile currentFile in match textOpt with | None | Some "" -> None @@ -20,3 +20,26 @@ let getCompletions ~debug ~path ~pos ~currentFile ~forHover = ~forHover in Some (completables, full, scope))) + +let getCompletionsRevamped ~debug ~pos ~currentFile ~path = + let textOpt = Files.readFile currentFile in + match textOpt with + | None | Some "" -> None + | Some text -> ( + match + CompletionFrontEndRevamped.completionWithParser ~debug ~path + ~posCursor:pos ~currentFile ~text + with + | None -> None + | Some (completable, scope) -> ( + (* Only perform expensive ast operations if there are completables *) + match Cmt.loadFullCmtFromPath ~path with + | None -> None + | Some full -> + let env = SharedTypes.QueryEnv.fromFile full.file in + let completables = + completable + |> CompletionBackEndRevamped.processCompletable ~debug ~full ~pos + ~scope ~env + in + Some (completable, completables, full, scope))) diff --git a/analysis/src/DotCompletionUtils.ml b/analysis/src/DotCompletionUtils.ml index fc25742790..88f432d946 100644 --- a/analysis/src/DotCompletionUtils.ml +++ b/analysis/src/DotCompletionUtils.ml @@ -1,7 +1,9 @@ -let filterRecordFields ~env ~recordAsString ~prefix ~exact fields = +let filterRecordFields ~env ~recordAsString ~prefix ~exact ?(seenFields = []) + fields = fields |> Utils.filterMap (fun (field : SharedTypes.field) -> - if Utils.checkName field.fname.txt ~prefix ~exact then + if List.mem field.fname.txt seenFields then None + else if Utils.checkName field.fname.txt ~prefix ~exact then Some (SharedTypes.Completion.create field.fname.txt ~env ?deprecated:field.deprecated ~docstring:field.docstring diff --git a/analysis/src/Hover.ml b/analysis/src/Hover.ml index f0979d695c..adc4eae6d1 100644 --- a/analysis/src/Hover.ml +++ b/analysis/src/Hover.ml @@ -150,7 +150,7 @@ let hoverWithExpandedTypes ~file ~package ~supportsMarkdownLinks typ = makes it (most often) work with unsaved content. *) let getHoverViaCompletions ~debug ~path ~pos ~currentFile ~forHover ~supportsMarkdownLinks = - match Completions.getCompletions ~debug ~path ~pos ~currentFile ~forHover with + match Completions.getCompletions debug ~path ~pos ~currentFile ~forHover with | None -> None | Some (completions, ({file; package} as full), scope) -> ( let rawOpens = Scope.getRawOpens scope in @@ -244,6 +244,11 @@ let newHover ~full:{file; package} ~supportsMarkdownLinks locItem = showModule ~docstring:file.structure.docstring ~name:file.moduleName ~file ~package None) | Typed (_, _, Definition (_, (Field _ | Constructor _))) -> None + | OtherExpression t | OtherPattern t -> + (* TODO: Just for debugging. *) + if !Cfg.useRevampedCompletion then + Some (Markdown.codeBlock (Shared.typeToString t)) + else None | Constant t -> Some (Markdown.codeBlock diff --git a/analysis/src/Loc.ml b/analysis/src/Loc.ml index 2ab1d8fbd2..635b787128 100644 --- a/analysis/src/Loc.ml +++ b/analysis/src/Loc.ml @@ -21,3 +21,9 @@ let rangeOfLoc (loc : t) = let start = loc |> start |> mkPosition in let end_ = loc |> end_ |> mkPosition in {Protocol.start; end_} + +let isInside (x : t) (y : t) = + x.loc_start.pos_cnum >= y.loc_start.pos_cnum + && x.loc_end.pos_cnum <= y.loc_end.pos_cnum + && x.loc_start.pos_lnum >= y.loc_start.pos_lnum + && x.loc_end.pos_lnum <= y.loc_end.pos_lnum diff --git a/analysis/src/Packages.ml b/analysis/src/Packages.ml index 34b9945a7b..6deb8d7f9f 100644 --- a/analysis/src/Packages.ml +++ b/analysis/src/Packages.ml @@ -12,6 +12,7 @@ let makePathsForModule ~projectFilesAndPaths ~dependenciesFilesAndPaths = pathsForModule let overrideRescriptVersion = ref None +let overrideConfigFilePath = ref None let getReScriptVersion () = match !overrideRescriptVersion with @@ -185,15 +186,21 @@ let newBsPackage ~rootPath = | None -> None in - match Files.readFile rescriptJson with - | Some raw -> parseRaw raw + match !overrideConfigFilePath with + | Some configFilePath -> ( + match Files.readFile configFilePath with + | Some raw -> parseRaw raw + | None -> failwith "Unable to read passed config file") | None -> ( - Log.log ("Unable to read " ^ rescriptJson); - match Files.readFile bsconfigJson with + match Files.readFile rescriptJson with | Some raw -> parseRaw raw - | None -> - Log.log ("Unable to read " ^ bsconfigJson); - None) + | None -> ( + Log.log ("Unable to read " ^ rescriptJson); + match Files.readFile bsconfigJson with + | Some raw -> parseRaw raw + | None -> + Log.log ("Unable to read " ^ bsconfigJson); + None)) let findRoot ~uri packagesByRoot = let path = Uri.toPath uri in diff --git a/analysis/src/ProcessExtra.ml b/analysis/src/ProcessExtra.ml index 1710d5fd32..c7802bc104 100644 --- a/analysis/src/ProcessExtra.ml +++ b/analysis/src/ProcessExtra.ml @@ -373,7 +373,9 @@ let pat ~(file : File.t) ~env ~extra (iter : Tast_iterator.iterator) (* Log.log("Entering pattern " ++ Utils.showLocation(pat_loc)); *) (match pattern.pat_desc with | Tpat_record (items, _) -> - addForRecord ~env ~extra ~recordType:pattern.pat_type items + addForRecord ~env ~extra ~recordType:pattern.pat_type items; + if !Cfg.useRevampedCompletion then + addLocItem extra pattern.pat_loc (OtherPattern pattern.pat_type) | Tpat_construct (lident, constructor, _) -> addForConstructor ~env ~extra pattern.pat_type lident constructor | Tpat_alias (_inner, ident, name) -> @@ -383,7 +385,9 @@ let pat ~(file : File.t) ~env ~extra (iter : Tast_iterator.iterator) (* Log.log("Pattern " ++ name.txt); *) let stamp = Ident.binding_time ident in addForPattern stamp name - | _ -> ()); + | _ -> + if !Cfg.useRevampedCompletion then + addLocItem extra pattern.pat_loc (OtherPattern pattern.pat_type)); Tast_iterator.default_iterator.pat iter pattern let expr ~env ~(extra : extra) (iter : Tast_iterator.iterator) @@ -397,7 +401,9 @@ let expr ~env ~(extra : extra) (iter : Tast_iterator.iterator) |> Utils.filterMap (fun (desc, item, opt) -> match item with | Typedtree.Overridden (loc, _) -> Some (loc, desc, (), opt) - | _ -> None)) + | _ -> None)); + if !Cfg.useRevampedCompletion then + addLocItem extra expression.exp_loc (OtherExpression expression.exp_type) | Texp_constant constant -> addLocItem extra expression.exp_loc (Constant constant) (* Skip unit and list literals *) @@ -409,7 +415,25 @@ let expr ~env ~(extra : extra) (iter : Tast_iterator.iterator) | Texp_field (inner, lident, _label_description) -> addForField ~env ~extra ~recordType:inner.exp_type ~fieldType:expression.exp_type lident - | _ -> ()); + | Texp_apply {funct; args} when !Cfg.useRevampedCompletion -> + args + |> List.iter (fun (label, _) -> + match label with + | Asttypes.Labelled {txt; loc} | Optional {txt; loc} -> ( + let rec findArgType (t : Types.type_expr) = + match t.desc with + | Tarrow ((Labelled lbl | Optional lbl), argType, _, _, _) + when lbl = txt -> + Some argType + | Tarrow (_, _, next, _, _) -> findArgType next + | _ -> None + in + match findArgType funct.exp_type with + | None -> () + | Some argType -> addLocItem extra loc (OtherExpression argType)) + | _ -> ()) + | _ -> + addLocItem extra expression.exp_loc (OtherExpression expression.exp_type)); Tast_iterator.default_iterator.expr iter expression let getExtra ~file ~infos = diff --git a/analysis/src/References.ml b/analysis/src/References.ml index e047a2ba18..086cbd0175 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -358,7 +358,7 @@ let definitionForLocItem ~full:{file; package} locItem = | Typed (_, _, NotFound) | LModule (NotFound | Definition (_, _)) | TypeDefinition (_, _, _) - | Constant _ -> + | Constant _ | OtherExpression _ | OtherPattern _ -> None | TopLevelModule name -> ( maybeLog ("Toplevel " ^ name); @@ -405,7 +405,9 @@ let digConstructor ~env ~package path = let typeDefinitionForLocItem ~full:{file; package} locItem = match locItem.locType with - | Constant _ | TopLevelModule _ | LModule _ -> None + | Constant _ | TopLevelModule _ | LModule _ | OtherExpression _ + | OtherPattern _ -> + None | TypeDefinition _ -> Some (file.uri, locItem.loc) | Typed (_, typ, _) -> ( let env = QueryEnv.fromFile file in @@ -546,7 +548,10 @@ let allReferencesForLocItem ~full:({file; package} as full) locItem = getSrc paths |> List.map moduleSrcToRef in List.append targetModuleReferences otherModulesReferences - | Typed (_, _, NotFound) | LModule NotFound | Constant _ -> [] + | Typed (_, _, NotFound) + | LModule NotFound + | Constant _ | OtherExpression _ | OtherPattern _ -> + [] | TypeDefinition (_, _, stamp) -> forLocalStamp ~full stamp Type | Typed (_, _, (LocalReference (stamp, tip) | Definition (stamp, tip))) | LModule (LocalReference (stamp, tip) | Definition (stamp, tip)) -> diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index 13692e26a6..2a8d6b6bf2 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -155,6 +155,14 @@ module Declared = struct end module Stamps : sig + type kind = + | KType of Type.t Declared.t + | KValue of Types.type_expr Declared.t + | KModule of Module.t Declared.t + | KConstructor of Constructor.t Declared.t + + val locOfKind : kind -> Warnings.loc + type t val addConstructor : t -> int -> Constructor.t Declared.t -> unit @@ -169,6 +177,7 @@ module Stamps : sig val iterModules : (int -> Module.t Declared.t -> unit) -> t -> unit val iterTypes : (int -> Type.t Declared.t -> unit) -> t -> unit val iterValues : (int -> Types.type_expr Declared.t -> unit) -> t -> unit + val getEntries : t -> (int * kind) list end = struct type 't stampMap = (int, 't Declared.t) Hashtbl.t @@ -178,6 +187,12 @@ end = struct | KModule of Module.t Declared.t | KConstructor of Constructor.t Declared.t + let locOfKind = function + | KType declared -> declared.extentLoc + | KValue declared -> declared.extentLoc + | KModule declared -> declared.extentLoc + | KConstructor declared -> declared.extentLoc + type t = (int, kind) Hashtbl.t let init () = Hashtbl.create 10 @@ -239,6 +254,8 @@ end = struct | KConstructor d -> f stamp d | _ -> ()) stamps + + let getEntries t = t |> Hashtbl.to_seq |> List.of_seq end module File = struct @@ -460,6 +477,9 @@ type locType = | LModule of locKind | TopLevelModule of string | TypeDefinition of string * Types.type_declaration * int + (* For all other expressions and patterns that are not tracked by the above. Needed to produce hovers, completions, and what not. *) + | OtherExpression of Types.type_expr + | OtherPattern of Types.type_expr type locItem = {loc: Location.t; locType: locType} @@ -530,14 +550,25 @@ let locKindToString = function | NotFound -> "NotFound" | Definition (_, tip) -> "(Definition " ^ Tip.toString tip ^ ")" +let constantToString = function + | Asttypes.Const_int _ -> "Const_int" + | Asttypes.Const_char _ -> "Const_char" + | Asttypes.Const_string _ -> "Const_string" + | Asttypes.Const_float _ -> "Const_float" + | Asttypes.Const_int32 _ -> "Const_int32" + | Asttypes.Const_int64 _ -> "Const_int64" + | Asttypes.Const_bigint _ -> "Const_bigint" + let locTypeToString = function | Typed (name, e, locKind) -> - "Typed " ^ name ^ " " ^ Shared.typeToString e ^ " " - ^ locKindToString locKind - | Constant _ -> "Constant" + Format.sprintf "Typed(%s) %s: %s" (locKindToString locKind) name + (Shared.typeToString e) + | Constant c -> "Constant " ^ constantToString c + | OtherExpression e -> "OtherExpression " ^ Shared.typeToString e + | OtherPattern e -> "OtherPattern " ^ Shared.typeToString e | LModule locKind -> "LModule " ^ locKindToString locKind - | TopLevelModule _ -> "TopLevelModule" - | TypeDefinition _ -> "TypeDefinition" + | TopLevelModule name -> "TopLevelModule " ^ name + | TypeDefinition (name, _, _) -> "TypeDefinition " ^ name let locItemToString {loc = {Location.loc_start; loc_end}; locType} = let pos1 = Utils.cmtPosToPosition loc_start in @@ -765,6 +796,47 @@ module Completable = struct | ChtmlElement {prefix} -> "ChtmlElement <" ^ prefix end +module CompletableRevamped = struct + type decoratorPayload = + | Module of string + | ModuleWithImportAttributes of {prefix: string} + | JsxConfig of {prefix: string} + + type completionExprKind = Empty | Field of {hint: string} + + type completionPatternKind = + | Empty + | Field of {hint: string; seenFields: string list} + | FieldValue of {fieldName: string} + + type t = + | Cexpression of { + kind: completionExprKind; + typeLoc: Location.t; + posOfDot: Pos.t option; + } + | Cpattern of {kind: completionPatternKind; typeLoc: Location.t} + | Cnone + | CextensionNode of string + | Cdecorator of string + | CdecoratorPayload of decoratorPayload + + let toString (t : t) = + match t with + | Cexpression _ -> "Cexpression" + | Cpattern _ -> "Cpattern" + | Cnone -> "Cnone" + | CextensionNode _ -> "CextensionNode" + | Cdecorator _ -> "Cdecorator" + | CdecoratorPayload _ -> "CdecoratorPayload" + + let try_loc (t : t) = + match t with + | Cexpression {typeLoc; _} -> Some typeLoc + | Cpattern {typeLoc; _} -> Some typeLoc + | _ -> None +end + module ScopeTypes = struct type item = | Constructor of string * Location.t diff --git a/analysis/src/TypeUtils.ml b/analysis/src/TypeUtils.ml index c9b1acd011..5507600c88 100644 --- a/analysis/src/TypeUtils.ml +++ b/analysis/src/TypeUtils.ml @@ -37,7 +37,12 @@ let rec hasTvar (ty : Types.type_expr) : bool = let findTypeViaLoc ~full ~debug (loc : Location.t) = match References.getLocItem ~full ~pos:(Pos.ofLexing loc.loc_end) ~debug with - | Some {locType = Typed (_, typExpr, _)} -> Some typExpr + | Some + { + locType = + Typed (_, typExpr, _) | OtherExpression typExpr | OtherPattern typExpr; + } -> + Some typExpr | _ -> None let pathFromTypeExpr (t : Types.type_expr) = @@ -341,19 +346,19 @@ let rec extractType ?(printOpeningDebug = true) match t.desc with | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractType ?typeArgContext ~printOpeningDebug:false ~env ~package t1 - | Tconstr (Path.Pident {name = "option"}, [payloadTypeExpr], _) -> + | Tconstr (p, [payloadTypeExpr], _) when Path.same p Predef.path_option -> Some (Toption (env, TypeExpr payloadTypeExpr), typeArgContext) - | Tconstr (Path.Pident {name = "promise"}, [payloadTypeExpr], _) -> + | Tconstr (p, [payloadTypeExpr], _) when Path.same p Predef.path_promise -> Some (Tpromise (env, payloadTypeExpr), typeArgContext) - | Tconstr (Path.Pident {name = "array"}, [payloadTypeExpr], _) -> + | Tconstr (p, [payloadTypeExpr], _) when Path.same p Predef.path_array -> Some (Tarray (env, TypeExpr payloadTypeExpr), typeArgContext) - | Tconstr (Path.Pident {name = "result"}, [okType; errorType], _) -> + | Tconstr (p, [okType; errorType], _) when Path.same p Predef.path_result -> Some (Tresult {env; okType; errorType}, typeArgContext) - | Tconstr (Path.Pident {name = "bool"}, [], _) -> + | Tconstr (p, [], _) when Path.same p Predef.path_bool -> Some (Tbool env, typeArgContext) - | Tconstr (Path.Pident {name = "string"}, [], _) -> + | Tconstr (p, [], _) when Path.same p Predef.path_string -> Some (Tstring env, typeArgContext) - | Tconstr (Path.Pident {name = "exn"}, [], _) -> + | Tconstr (p, [], _) when Path.same p Predef.path_exn -> Some (Texn env, typeArgContext) | Tarrow _ -> ( match extractFunctionType2 ?typeArgContext t ~env ~package with diff --git a/compiler/bsc/rescript_compiler_main.ml b/compiler/bsc/rescript_compiler_main.ml index 84c0a3f898..6fc0107caf 100644 --- a/compiler/bsc/rescript_compiler_main.ml +++ b/compiler/bsc/rescript_compiler_main.ml @@ -369,6 +369,9 @@ let buckle_script_flags : (string * Bsc_args.spec * string) array = ( "-ignore-parse-errors", set Clflags.ignore_parse_errors, "*internal* continue after parse errors" ); + ( "-editor-mode", + set Clflags.editor_mode, + "*internal* editor mode. Adapts compilation for editors." ); ( "-where", unit_call print_standard_library, "*internal* Print location of standard library and exit" ); @@ -453,6 +456,9 @@ let _ : unit = | Bsc_args.Bad msg -> Format.eprintf "%s@." msg; exit 2 + | Typecore.Errors exns -> + exns |> List.rev |> List.iter (Location.report_exception ppf); + exit 2 | x -> Location.report_exception ppf x; exit 2 diff --git a/compiler/core/js_implementation.ml b/compiler/core/js_implementation.ml index 5f4e4e6c76..001a3eb763 100644 --- a/compiler/core/js_implementation.ml +++ b/compiler/core/js_implementation.ml @@ -138,6 +138,7 @@ let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) = ?check_exists:(if !Js_config.force_cmi then None else Some ()) !Location.input_name outputprefix modulename env ast in + if !Clflags.editor_mode then Typecore.raise_delayed_error_if_exists (); let typedtree_coercion = (typedtree, coercion) in print_if ppf Clflags.dump_typedtree Printtyped.implementation_with_coercion typedtree_coercion; diff --git a/compiler/ml/clflags.ml b/compiler/ml/clflags.ml index 2b663ba24e..fdbd89c306 100644 --- a/compiler/ml/clflags.ml +++ b/compiler/ml/clflags.ml @@ -42,6 +42,10 @@ and only_parse = ref false (* -only-parse *) and ignore_parse_errors = ref false (* -ignore-parse-errors *) +and editor_mode = ref false +(* -editor-mode *) +(* true for easy testing *) + let dont_write_files = ref false (* set to true under ocamldoc *) let reset_dump_state () = diff --git a/compiler/ml/clflags.mli b/compiler/ml/clflags.mli index c861614928..0cb5f1ea3e 100644 --- a/compiler/ml/clflags.mli +++ b/compiler/ml/clflags.mli @@ -25,6 +25,7 @@ val dont_write_files : bool ref val keep_locs : bool ref val only_parse : bool ref val ignore_parse_errors : bool ref +val editor_mode : bool ref val parse_color_setting : string -> Misc.Color.setting option val color : Misc.Color.setting option ref diff --git a/compiler/ml/code_frame.ml b/compiler/ml/code_frame.ml index 25c00d9512..79b5861cbf 100644 --- a/compiler/ml/code_frame.ml +++ b/compiler/ml/code_frame.ml @@ -104,7 +104,7 @@ end let setup = Color.setup -type gutter = Number of int | Elided +type gutter = Number of int | Elided | UnderlinedRow type highlighted_string = {s: string; start: int; end_: int} type line = {gutter: gutter; content: highlighted_string list} @@ -116,7 +116,7 @@ type line = {gutter: gutter; content: highlighted_string list} - center snippet when it's heavily indented - ellide intermediate lines when the reported range is huge *) -let print ~is_warning ~src ~(start_pos : Lexing.position) +let print ~is_warning ~draw_underline ~src ~(start_pos : Lexing.position) ~(end_pos : Lexing.position) = let indent = 2 in let highlight_line_start_line = start_pos.pos_lnum in @@ -175,7 +175,8 @@ let print ~is_warning ~src ~(start_pos : Lexing.position) |> break_long_line line_width |> List.mapi (fun i line -> match gutter with - | Elided -> {s = line; start = 0; end_ = 0} + | Elided | UnderlinedRow -> + {s = line; start = 0; end_ = 0} | Number line_number -> let highlight_line_start_offset = start_pos.pos_cnum - start_pos.pos_bol @@ -207,7 +208,41 @@ let print ~is_warning ~src ~(start_pos : Lexing.position) in {s = line; start; end_}) in - {gutter; content = new_content}) + if draw_underline then + let has_highlight = + List.exists (fun {start; end_} -> start < end_) new_content + in + if has_highlight then + let underline_content = + List.map + (fun {start; end_} -> + if start < end_ then + let overline_char = "‾" in + let underline_length = end_ - start in + let underline = + String.concat "" + (List.init underline_length (fun _ -> overline_char)) + in + [ + { + s = String.make start ' ' ^ underline; + start = 0; + end_ = 0; + }; + ] + else [{s = ""; start = 0; end_ = 0}]) + new_content + in + [ + {gutter; content = new_content}; + { + gutter = UnderlinedRow; + content = List.flatten underline_content; + }; + ] + else [{gutter; content = new_content}] + else [{gutter; content = new_content}]) + |> List.flatten in let buf = Buffer.create 100 in let open Color in @@ -275,5 +310,11 @@ let print ~is_warning ~src ~(start_pos : Lexing.position) else NoColor in add_ch c ch); + add_ch NoColor '\n') + | UnderlinedRow -> + content + |> List.iter (fun line -> + draw_gutter NoColor ""; + line.s |> String.iter (fun ch -> add_ch NoColor ch); add_ch NoColor '\n')); Buffer.contents buf diff --git a/compiler/ml/location.ml b/compiler/ml/location.ml index 87592822e8..96b00dd54f 100644 --- a/compiler/ml/location.ml +++ b/compiler/ml/location.ml @@ -140,8 +140,9 @@ let print ?(src = None) ~message_kind intro ppf (loc : t) = branch might not be reached (aka no inline file content display) so we don't wanna end up with two line breaks in the the consequent *) fprintf ppf "@,%s" - (Code_frame.print ~is_warning:(message_kind = `warning) ~src - ~start_pos:loc.loc_start ~end_pos:loc.loc_end) + (Code_frame.print ~draw_underline:false + ~is_warning:(message_kind = `warning) ~src ~start_pos:loc.loc_start + ~end_pos:loc.loc_end) with (* this might happen if the file is e.g. "", "_none_" or any of the fake file name placeholders. we've already printed the location above, so nothing more to do here. *) diff --git a/compiler/ml/predef.ml b/compiler/ml/predef.ml index 6deed6ffa3..1ddb300531 100644 --- a/compiler/ml/predef.ml +++ b/compiler/ml/predef.ml @@ -65,6 +65,8 @@ and ident_promise = ident_create "promise" and ident_uncurried = ident_create "function$" +and ident_tainted = ident_create "tainted$" + type test = For_sure_yes | For_sure_no | NA let type_is_builtin_path_but_option (p : Path.t) : test = @@ -112,6 +114,8 @@ and path_promise = Pident ident_promise and path_uncurried = Pident ident_uncurried +and path_tainted = Pident ident_tainted + let type_int = newgenty (Tconstr (path_int, [], ref Mnil)) and type_char = newgenty (Tconstr (path_char, [], ref Mnil)) diff --git a/compiler/ml/predef.mli b/compiler/ml/predef.mli index 7919b802ee..eccec6d138 100644 --- a/compiler/ml/predef.mli +++ b/compiler/ml/predef.mli @@ -52,6 +52,7 @@ val path_lazy_t : Path.t val path_extension_constructor : Path.t val path_promise : Path.t val path_uncurried : Path.t +val path_tainted : Path.t val path_match_failure : Path.t val path_assert_failure : Path.t diff --git a/compiler/ml/printtyped.ml b/compiler/ml/printtyped.ml index 6bdd794d97..f8d615de5d 100644 --- a/compiler/ml/printtyped.ml +++ b/compiler/ml/printtyped.ml @@ -125,6 +125,11 @@ let arg_label i ppf = function | Optional s -> line i ppf "Optional \"%s\"\n" s | Labelled s -> line i ppf "Labelled \"%s\"\n" s +let arg_label_loc i ppf = function + | Nolabel -> line i ppf "Nolabel\n" + | Optional {txt = s} -> line i ppf "Optional \"%s\"\n" s + | Labelled {txt = s} -> line i ppf "Labelled \"%s\"\n" s + let record_representation i ppf = let open Types in function @@ -658,7 +663,7 @@ and record_field i ppf = function and label_x_expression i ppf (l, e) = line i ppf "\n"; - arg_label (i + 1) ppf l; + arg_label_loc (i + 1) ppf l; match e with | None -> () | Some e -> expression (i + 1) ppf e diff --git a/compiler/ml/translcore.ml b/compiler/ml/translcore.ml index 4cdeb34aa5..1009209bab 100644 --- a/compiler/ml/translcore.ml +++ b/compiler/ml/translcore.ml @@ -1020,7 +1020,7 @@ and transl_apply ?(inlined = Default_inline) | _ -> (build_apply lam [] (List.map - (fun (l, x) -> (may_map transl_exp x, Btype.is_optional l)) + (fun (l, x) -> (may_map transl_exp x, Btype.is_optional_loc l)) sargs) : Lambda.lambda) diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index d1e593607f..6f668b5908 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -80,10 +80,24 @@ type error = | Type_params_not_supported of Longident.t | Field_access_on_dict_type exception Error of Location.t * Env.t * error +exception Errors of exn list exception Error_forward of Location.error (* Forward declaration, to be filled in by Typemod.type_module *) +let delayed_typechecking_errors = ref [] + +let add_delayed_error e = + delayed_typechecking_errors := e :: !delayed_typechecking_errors + +let raise_delayed_error_if_exists () = + (* Might have duplicate errors, so remove those. *) + let errors = List.sort_uniq compare !delayed_typechecking_errors in + if errors <> [] then raise (Errors errors) + +let raise_or_continue exn = + if !Clflags.editor_mode then add_delayed_error exn else raise exn + let type_module = ref (fun _env _md -> assert false @@ -264,6 +278,31 @@ let option_none ty loc = let cnone = Env.lookup_constructor lid env in mkexp (Texp_construct (mknoloc lid, cnone, [])) ty loc env +let tainted_expr () = + let lid = Longident.Lident "None" and env = Env.initial_safe_string in + let cnone = Env.lookup_constructor lid env in + { + exp_desc = Texp_construct (mknoloc lid, cnone, []); + exp_type = newconstr Predef.path_tainted []; + exp_loc = Location.none; + exp_env = env; + exp_extra = []; + exp_attributes = [(Location.mknoloc "tainted", PStr [])]; + } + +let tainted_pat expected_type = + let env = Env.initial_safe_string in + { + pat_desc = Tpat_var (Ident.create "tainted$", Location.mknoloc "tainted$"); + pat_type = expected_type; + pat_loc = Location.none; + pat_env = env; + pat_extra = []; + pat_attributes = [(Location.mknoloc "tainted", PStr [])]; + } + +let _ = ignore tainted_pat + let option_some texp = let lid = Longident.Lident "Some" in let csome = Env.lookup_constructor lid Env.initial_safe_string in @@ -302,15 +341,18 @@ let check_optional_attr env ld optional loc = (* unification inside type_pat*) let unify_pat_types loc env ty ty' = try unify env ty ty' with - | Unify trace -> raise (Error (loc, env, Pattern_type_clash trace)) + | Unify trace -> + raise_or_continue (Error (loc, env, Pattern_type_clash trace)) | Tags (l1, l2) -> - raise (Typetexp.Error (loc, env, Typetexp.Variant_tags (l1, l2))) + raise_or_continue + (Typetexp.Error (loc, env, Typetexp.Variant_tags (l1, l2))) (* unification inside type_exp and type_expect *) let unify_exp_types ?type_clash_context loc env ty expected_ty = try unify env ty expected_ty with | Unify trace -> - raise (Error (loc, env, Expr_type_clash (trace, type_clash_context))) + raise_or_continue + (Error (loc, env, Expr_type_clash (trace, type_clash_context))) | Tags (l1, l2) -> raise (Typetexp.Error (loc, env, Typetexp.Variant_tags (l1, l2))) @@ -328,11 +370,13 @@ let unify_pat_types_gadt loc env ty ty' = | Some x -> x in try unify_gadt ~newtype_level env ty ty' with - | Unify trace -> raise (Error (loc, !env, Pattern_type_clash trace)) + | Unify trace -> + raise_or_continue (Error (loc, !env, Pattern_type_clash trace)) | Tags (l1, l2) -> - raise (Typetexp.Error (loc, !env, Typetexp.Variant_tags (l1, l2))) + raise_or_continue + (Typetexp.Error (loc, !env, Typetexp.Variant_tags (l1, l2))) | Unification_recursive_abbrev trace -> - raise (Error (loc, !env, Recursive_local_constraint trace)) + raise_or_continue (Error (loc, !env, Recursive_local_constraint trace)) (* Creating new conjunctive types is not allowed when typing patterns *) @@ -440,7 +484,8 @@ let enter_orpat_variables loc env p1_vs p2_vs = else ( (try unify env t1 t2 with Unify trace -> - raise (Error (loc, env, Or_pattern_type_clash (x1, trace)))); + raise_or_continue + (Error (loc, env, Or_pattern_type_clash (x1, trace)))); (x2, x1) :: unify_vars rem1 rem2) | [], [] -> [] | (x, _, _, _, _) :: _, [] -> raise (Error (loc, env, Orpat_vars (x, []))) @@ -1497,21 +1542,27 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp if vars = [] then end_def (); (try unify_pat_types loc !env ty_res record_ty with Unify trace -> - raise + raise_or_continue (Error (label_lid.loc, !env, Label_mismatch (label_lid.txt, trace)))); - type_pat sarg ty_arg (fun arg -> - if vars <> [] then ( - end_def (); - generalize ty_arg; - List.iter generalize vars; - let instantiated tv = - let tv = expand_head !env tv in - (not (is_Tvar tv)) || tv.level <> generic_level - in - if List.exists instantiated vars then - raise - (Error (label_lid.loc, !env, Polymorphic_label label_lid.txt))); - k (label_lid, label, arg, opt)) + try + type_pat sarg ty_arg (fun arg -> + if vars <> [] then ( + end_def (); + generalize ty_arg; + List.iter generalize vars; + let instantiated tv = + let tv = expand_head !env tv in + (not (is_Tvar tv)) || tv.level <> generic_level + in + if List.exists instantiated vars then + raise_or_continue + (Error (label_lid.loc, !env, Polymorphic_label label_lid.txt))); + k (label_lid, label, arg, opt)) + with err -> + if !Clflags.editor_mode then ( + add_delayed_error err; + k (label_lid, label, tainted_pat ty_arg, opt)) + else raise err in let k' k lbl_pat_list = check_recordpat_labels ~get_jsx_component_error_info loc lbl_pat_list @@ -1914,7 +1965,8 @@ let rec type_approx env sexp = let ty1 = approx_type env sty in (try unify env ty ty1 with Unify trace -> - raise (Error (sexp.pexp_loc, env, Expr_type_clash (trace, None)))); + raise_or_continue + (Error (sexp.pexp_loc, env, Expr_type_clash (trace, None)))); ty1 | Pexp_coerce (e, (), sty2) -> let approx_ty_opt = function @@ -1926,7 +1978,8 @@ let rec type_approx env sexp = and ty2 = approx_type env sty2 in (try unify env ty ty1 with Unify trace -> - raise (Error (sexp.pexp_loc, env, Expr_type_clash (trace, None)))); + raise_or_continue + (Error (sexp.pexp_loc, env, Expr_type_clash (trace, None)))); ty2 | _ -> newvar () @@ -2227,9 +2280,9 @@ let not_function env ty = ls = [] && not tvar type lazy_args = - (Asttypes.Noloc.arg_label * (unit -> Typedtree.expression) option) list + (Asttypes.arg_label * (unit -> Typedtree.expression) option) list -type targs = (Asttypes.Noloc.arg_label * Typedtree.expression option) list +type targs = (Asttypes.arg_label * Typedtree.expression option) list let rec type_exp ?recarg env sexp = (* We now delegate everything to type_expect *) type_expect ?recarg env sexp (newvar ()) @@ -2925,7 +2978,7 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp let gen = generalizable tv.level arg.exp_type in (try unify_var env tv arg.exp_type with Unify trace -> - raise + raise_or_continue (Error (arg.exp_loc, env, Expr_type_clash (trace, type_clash_context)))); gen) @@ -3323,8 +3376,11 @@ and type_label_exp ?type_clash_context create env loc ty_expected (* Generalize information merged from ty_expected *) generalize_structure ty_arg); if label.lbl_private = Private then - if create then raise (Error (loc, env, Private_type ty_expected)) - else raise (Error (lid.loc, env, Private_label (lid.txt, ty_expected))); + if create then + raise_or_continue (Error (loc, env, Private_type ty_expected)) + else + raise_or_continue + (Error (lid.loc, env, Private_label (lid.txt, ty_expected))); let arg = let snap = if vars = [] then None else Some (Btype.snapshot ()) in let arg = @@ -3389,7 +3445,7 @@ and translate_unified_ops (env : Env.t) (funct : Typedtree.expression) unify env lhs_type (instance_def Predef.type_int); instance_def Predef.type_int in - let targs = [(to_noloc lhs_label, Some lhs)] in + let targs = [(lhs_label, Some lhs)] in Some (targs, result_type) | ( Some {form = Binary; specialization}, [(lhs_label, lhs_expr); (rhs_label, rhs_expr)] ) -> @@ -3447,9 +3503,7 @@ and translate_unified_ops (env : Env.t) (funct : Typedtree.expression) let rhs = type_expect env rhs_expr Predef.type_int in (lhs, rhs, instance_def Predef.type_int)) in - let targs = - [(to_noloc lhs_label, Some lhs); (to_noloc rhs_label, Some rhs)] - in + let targs = [(lhs_label, Some lhs); (rhs_label, Some rhs)] in Some (targs, result_type) | _ -> None) | _ -> None @@ -3534,7 +3588,12 @@ and type_application ?type_clash_context total_app env funct (sargs : sargs) : ( List.map (function | l, None -> (l, None) - | l, Some f -> (l, Some (f ()))) + | l, Some f -> + ( l, + Some + (if !Clflags.editor_mode then + try f () with _ -> tainted_expr () + else f ()) )) (List.rev args), instance env (result_type omitted ty_fun) ) in @@ -3543,7 +3602,7 @@ and type_application ?type_clash_context total_app env funct (sargs : sargs) : | Tarrow (Optional l, t1, t2, _, _) -> ignored := (Noloc.Optional l, t1, ty_fun.level) :: !ignored; let arg = - ( Noloc.Optional l, + ( to_arg_label (Optional l), Some (fun () -> option_none (instance env t1) Location.none) ) in type_unknown_args max_arity ~args:(arg :: args) ~top_arity:None @@ -3603,7 +3662,8 @@ and type_application ?type_clash_context total_app env funct (sargs : sargs) : if optional then unify_exp env arg1 (type_option (newvar ())); arg1 in - type_unknown_args max_arity ~args:((l1, Some arg1) :: args) + type_unknown_args max_arity + ~args:((to_arg_label l1, Some arg1) :: args) ~top_arity:None omitted ty2 sargl in let rec type_args ?type_clash_context max_arity args omitted ~ty_fun ty_fun0 @@ -3642,8 +3702,9 @@ and type_application ?type_clash_context total_app env funct (sargs : sargs) : (extract_option_type env ty) (extract_option_type env ty0))) ) in - type_args ?type_clash_context max_arity ((l, arg) :: args) omitted ~ty_fun - ty_fun0 ~sargs ~top_arity + type_args ?type_clash_context max_arity + ((to_arg_label l, arg) :: args) + omitted ~ty_fun ty_fun0 ~sargs ~top_arity | _ -> type_unknown_args max_arity ~args ~top_arity omitted ty_fun0 sargs (* This is the hot path for non-labeled function*) diff --git a/compiler/ml/typecore.mli b/compiler/ml/typecore.mli index 3aa23756d4..831fbdd51f 100644 --- a/compiler/ml/typecore.mli +++ b/compiler/ml/typecore.mli @@ -19,6 +19,8 @@ open Asttypes open Types open Format +val raise_delayed_error_if_exists : unit -> unit + val is_nonexpansive : Typedtree.expression -> bool val type_binding : @@ -105,6 +107,7 @@ type error = | Type_params_not_supported of Longident.t | Field_access_on_dict_type exception Error of Location.t * Env.t * error +exception Errors of exn list exception Error_forward of Location.error val report_error : Env.t -> formatter -> error -> unit diff --git a/compiler/ml/typedtree.ml b/compiler/ml/typedtree.ml index 626950caec..08d3d8b27b 100644 --- a/compiler/ml/typedtree.ml +++ b/compiler/ml/typedtree.ml @@ -85,7 +85,7 @@ and expression_desc = } | Texp_apply of { funct: expression; - args: (Noloc.arg_label * expression option) list; + args: (arg_label * expression option) list; partial: bool; } | Texp_match of expression * case list * case list * partial diff --git a/compiler/ml/typedtree.mli b/compiler/ml/typedtree.mli index 96da873af0..fd26be62ed 100644 --- a/compiler/ml/typedtree.mli +++ b/compiler/ml/typedtree.mli @@ -148,7 +148,7 @@ and expression_desc = *) | Texp_apply of { funct: expression; - args: (Noloc.arg_label * expression option) list; + args: (arg_label * expression option) list; partial: bool; } (** E0 ~l1:E1 ... ~ln:En diff --git a/package.json b/package.json index 70fc33473e..827e73511d 100644 --- a/package.json +++ b/package.json @@ -90,6 +90,7 @@ "packages/*", "tests/dependencies/**", "tests/analysis_tests/**", + "tests/analysis_new_tests/**", "tests/gentype_tests/**", "tests/tools_tests" ], diff --git a/tests/analysis_new_tests/README.md b/tests/analysis_new_tests/README.md new file mode 100644 index 0000000000..9993913ff4 --- /dev/null +++ b/tests/analysis_new_tests/README.md @@ -0,0 +1,64 @@ +# Analysis tests + +These tests test the analysis functionality for the editor tooling. + +## TLDR; Contributing + +To make a new completion feature easy to review, follow these steps: + +1. Add a new (or extend an existing) test file in `test_files` with a non-working test. Make sure you use good, clear naming. Commit the (non functional) test snapshot +2. Implement your changes +3. Update snapshots to show things now work. Ensure no other test results have changed unexpectedly +4. PR! + +## Test Structure + +Test files are located in the `test_files` directory and follow a specific format: + +1. Each test file can contain multiple test blocks, separated by `// == TEST:` markers +2. Each test block consists of: + - A description line immediately following the marker + - The actual test code + - Any `^xxx` marker indicating what test to run, and where. Several `^xxx` tests can run per test block + +Example: + +```rescript +// == TEST: Record field completion in nested record +let x = TestTypeDefs.nestedTestRecord. +// ^com +``` + +## Directory Structure + +### `support_files` + +The `support_files` directory contains reusable code that can be shared across multiple tests. These files: + +- Are compiled as part of the normal ReScript build process +- Should be valid ReScript code that compiles without errors +- Can contain type definitions, modules, and other code needed by multiple tests + +### `test_files` + +The `test_files` directory contains all the test files. These files: + +- Are compiled incrementally for testing purposes only +- Are not part of the main ReScript build +- Can (should!) contain invalid/incomplete code since they're only used as tests +- Each file can contain multiple test blocks as described above + +## Test Execution + +The test runner: + +1. Extracts all test blocks from all test files +2. Compiles each test block and sets each block up for incremental type checking +3. Runs the editor analysis tool on each test block +4. Compares the output against snapshots + +This setup allows testing all editor tooling analysis features, in a flexible manner. + +## Configuration Files + +The test runner uses a special `rescript.test.json` configuration file when running the analysis tests. This is separate from the normal `rescript.json` configuration and is only used when calling the analysis binary for testing purposes. This separation ensures that test configurations don't interfere with the main project configuration, since the test files will not actually compile. diff --git a/tests/analysis_new_tests/tests/.gitignore b/tests/analysis_new_tests/tests/.gitignore new file mode 100644 index 0000000000..1509dc3eef --- /dev/null +++ b/tests/analysis_new_tests/tests/.gitignore @@ -0,0 +1 @@ +*.res.js \ No newline at end of file diff --git a/tests/analysis_new_tests/tests/package.json b/tests/analysis_new_tests/tests/package.json new file mode 100644 index 0000000000..dddf56d4b1 --- /dev/null +++ b/tests/analysis_new_tests/tests/package.json @@ -0,0 +1,18 @@ +{ + "name": "@tests/analysis_new", + "private": true, + "type": "module", + "scripts": { + "build": "rescript", + "clean": "rescript clean -with-deps", + "test": "yarn build && vitest run test.js", + "test:update": "rm test_files/__snapshots__/*.snap && vitest run -u test.js" + }, + "dependencies": { + "@rescript/react": "link:../../dependencies/rescript-react", + "rescript": "workspace:^" + }, + "devDependencies": { + "vitest": "3.1.2" + } +} diff --git a/tests/analysis_new_tests/tests/rescript.json b/tests/analysis_new_tests/tests/rescript.json new file mode 100644 index 0000000000..f8d938a28f --- /dev/null +++ b/tests/analysis_new_tests/tests/rescript.json @@ -0,0 +1,17 @@ +{ + "name": "test", + "sources": [ + { + "dir": "support_files" + } + ], + "bsc-flags": ["-w -33-44-8"], + "bs-dependencies": ["@rescript/react"], + "suffix": ".res.js", + "package-specs": [ + { + "module": "esmodule", + "in-source": true + } + ] +} diff --git a/tests/analysis_new_tests/tests/rescript.test.json b/tests/analysis_new_tests/tests/rescript.test.json new file mode 100644 index 0000000000..bf100dbe49 --- /dev/null +++ b/tests/analysis_new_tests/tests/rescript.test.json @@ -0,0 +1,20 @@ +{ + "name": "test", + "sources": [ + { + "dir": "support_files" + }, + { + "dir": "test_files/.build" + } + ], + "bsc-flags": ["-w -33-44-8"], + "bs-dependencies": ["@rescript/react"], + "suffix": ".res.js", + "package-specs": [ + { + "module": "esmodule", + "in-source": true + } + ] +} diff --git a/tests/analysis_new_tests/tests/snapshots.test.js b/tests/analysis_new_tests/tests/snapshots.test.js new file mode 100644 index 0000000000..b11899b99f --- /dev/null +++ b/tests/analysis_new_tests/tests/snapshots.test.js @@ -0,0 +1,182 @@ +import { test, expect } from "vitest"; +import fs from "node:fs/promises"; +import path from "node:path"; +import { glob } from "glob"; +import { spawn, spawnSync } from "node:child_process"; + +// Get the current ReScript version +const rescriptVersion = spawnSync("./node_modules/.bin/bsc", ["-v"]) + .stdout.toString() + .trim() + .replace("ReScript ", ""); + +const testFilesDir = path.join(import.meta.dirname, "./test_files"); +const buildDir = path.join(import.meta.dirname, "./test_files/.build"); +const incrementalDir = path.join( + import.meta.dirname, + "./lib/bs/___incremental" +); +const snapshotDir = path.join(testFilesDir, "__snapshots__"); + +// Recreate directories needed +async function ensureSnapshotDir() { + await fs.mkdir(snapshotDir, { recursive: true }); // Ensure snapshot dir exists +} + +async function ensureIncrementalDir() { + try { + await fs.access(incrementalDir); + await fs.rm(incrementalDir, { recursive: true }); + } catch (_) {} + await fs.mkdir(incrementalDir, { recursive: true }); +} + +async function ensureBuildDir() { + try { + await fs.access(buildDir); + await fs.rm(buildDir, { recursive: true }); + } catch (_) {} + await fs.mkdir(buildDir, { recursive: true }); +} + +const resFilesPromise = glob("**/*.res", { + cwd: testFilesDir, + absolute: true, +}).then((files) => + files.map((file) => ({ + absolutePath: file, + relativePath: path.relative(testFilesDir, file), + })) +); + +const [resFiles] = await Promise.all([ + resFilesPromise, + ensureSnapshotDir(), + ensureIncrementalDir(), + ensureBuildDir(), +]); + +// Function to split test file contents into blocks +const splitTestBlocks = (contents) => { + const testBlocks = contents.split(/\/\/ == TEST:/); + // Skip the first empty block if it exists + return testBlocks.slice(1).map((block) => { + const [description, ...rest] = block.split("\n"); + return { + description: description.trim(), + content: rest.join("\n").trim(), + }; + }); +}; + +const testBlocksPerFile = new Map(); + +const baseCommand = `./node_modules/.bin/bsc -I lib/bs/support_files -I node_modules/@rescript/react/lib/ocaml -editor-mode -ignore-parse-errors -color never`; + +// Compile all files and move incremental cmt's +await Promise.all( + resFiles.map(async (file) => { + const contents = await fs.readFile(file.absolutePath, "utf-8"); + const testBlocks = splitTestBlocks(contents); + + let blockIndex = 1; + const blockData = []; + + for (const block of testBlocks) { + const { description, content } = block; + const filePath = path.join( + buildDir, + `${file.relativePath.slice(0, -4)}_${blockIndex}.res` + ); + + const fileContent = `// ${description}\n${content}`; + + await fs.writeFile(filePath, fileContent); + + const command = `${baseCommand} ${filePath}`; + const [cmd, ...args] = command.split(" "); + + const _debugData = await new Promise((resolve) => { + const child = spawn(cmd, args); + + let stdout = ""; + let stderr = ""; + + child.stdout.on("data", (chunk) => { + stdout += chunk; + }); + + child.stderr.on("data", (chunk) => { + stderr += chunk; + }); + + child.on("close", () => { + resolve({ stdout, stderr }); + }); + }); + + // Move .cmt file to incremental directory + const cmtPath = filePath.replace(".res", ".cmt"); + const cmtFileName = path.basename(cmtPath); + const targetPath = path.join(incrementalDir, cmtFileName); + await fs.rename(cmtPath, targetPath); + + blockData.push({ filePath, description, fileContent }); + blockIndex++; + } + + testBlocksPerFile.set(file.relativePath, blockData); + }) +); + +resFiles.forEach((file) => { + const blockData = testBlocksPerFile.get(file.relativePath); + for (const block of blockData) { + test(`${file.relativePath} - ${block.description}`, async () => { + // Run rescript-editor-analysis and capture output + const analysisOutput = await new Promise((resolve, reject) => { + const analysisCmd = spawn( + "../../../_build/install/default/bin/rescript-editor-analysis", + ["test_revamped", block.filePath, "rescript.test.json"], + { + stdio: "pipe", + env: { + RESCRIPT_INCREMENTAL_TYPECHECKING: "true", + RESCRIPT_PROJECT_CONFIG_CACHE: "true", + RESCRIPT_VERSION: rescriptVersion, + }, + } + ); + + let stdout = ""; + let stderr = ""; + + analysisCmd.stdout.on("data", (data) => { + stdout += data.toString(); + }); + + analysisCmd.stderr.on("data", (data) => { + stderr += data.toString(); + }); + + analysisCmd.on("close", (code) => { + if (code === 0) { + resolve({ stdout, stderr }); + } else { + reject(new Error(`Analysis command failed with code ${code}`)); + console.error(stderr); + } + }); + }); + + // Construct snapshot path + const snapshotFileName = `${ + file.relativePath + }_${block.description.replace(/[^a-zA-Z0-9]+/g, "_")}.snap`; + const snapshotPath = path.join(snapshotDir, snapshotFileName); + + // Use Vitest's expect().toMatchFileSnapshot() + await expect(analysisOutput.stdout).toMatchFileSnapshot(snapshotPath); + }); + } +}); diff --git a/tests/analysis_new_tests/tests/support_files/TestTypeDefs.res b/tests/analysis_new_tests/tests/support_files/TestTypeDefs.res new file mode 100644 index 0000000000..2beee32ed7 --- /dev/null +++ b/tests/analysis_new_tests/tests/support_files/TestTypeDefs.res @@ -0,0 +1,17 @@ +type nestedTestRecord = { + test: bool, + nested: { + name: string, + oneMoreLevel: {here: bool}, + }, +} + +let nestedTestRecord = { + test: true, + nested: { + name: "test", + oneMoreLevel: { + here: true, + }, + }, +} diff --git a/tests/analysis_new_tests/tests/test_files/.gitignore b/tests/analysis_new_tests/tests/test_files/.gitignore new file mode 100644 index 0000000000..b7f13992f4 --- /dev/null +++ b/tests/analysis_new_tests/tests/test_files/.gitignore @@ -0,0 +1 @@ +.build \ No newline at end of file diff --git a/tests/analysis_new_tests/tests/test_files/EmptyExpressions.res b/tests/analysis_new_tests/tests/test_files/EmptyExpressions.res new file mode 100644 index 0000000000..3f71e589f6 --- /dev/null +++ b/tests/analysis_new_tests/tests/test_files/EmptyExpressions.res @@ -0,0 +1,7 @@ +// == TEST: Empty let assignment expression, array +let x: array = +// ^com + +// == TEST: Empty let assignment expression, record +let x: TestTypeDefs.nestedTestRecord = +// ^com diff --git a/tests/analysis_new_tests/tests/test_files/RecordFieldCompletions.res b/tests/analysis_new_tests/tests/test_files/RecordFieldCompletions.res new file mode 100644 index 0000000000..6868b39fe9 --- /dev/null +++ b/tests/analysis_new_tests/tests/test_files/RecordFieldCompletions.res @@ -0,0 +1,7 @@ +// == TEST: Record field completion in nested record +let x = TestTypeDefs.nestedTestRecord. +// ^com + +// == TEST: Record field completion in nested record, another level +let x = TestTypeDefs.nestedTestRecord.nested. +// ^com \ No newline at end of file diff --git a/tests/analysis_new_tests/tests/test_files/SwitchCaseCompletions.res b/tests/analysis_new_tests/tests/test_files/SwitchCaseCompletions.res new file mode 100644 index 0000000000..8bc725f57a --- /dev/null +++ b/tests/analysis_new_tests/tests/test_files/SwitchCaseCompletions.res @@ -0,0 +1,26 @@ +// == TEST: Empty case, array +let someStringArr = ["hello"] + +let x = switch someStringArr { + | +// ^com +} + +// == TEST: Empty case, record +let x = switch TestTypeDefs.nestedTestRecord { + | +// ^com +} + +// == TEST: Empty case, bool +let x = switch true { + | +// ^com +} + +// == TEST: Empty case, string +let str = "hello" +let x = switch str { + | +// ^com +} diff --git a/tests/analysis_new_tests/tests/test_files/__snapshots__/.gitkeep b/tests/analysis_new_tests/tests/test_files/__snapshots__/.gitkeep new file mode 100644 index 0000000000..e69de29bb2 diff --git a/tests/analysis_new_tests/tests/test_files/__snapshots__/EmptyExpressions.res_Empty_let_assignment_expression_array.snap b/tests/analysis_new_tests/tests/test_files/__snapshots__/EmptyExpressions.res_Empty_let_assignment_expression_array.snap new file mode 100644 index 0000000000..b07f3198cc --- /dev/null +++ b/tests/analysis_new_tests/tests/test_files/__snapshots__/EmptyExpressions.res_Empty_let_assignment_expression_array.snap @@ -0,0 +1,19 @@ +Found Completable: Cexpression at type loc: [1:4->1:5] + + 1 │ // Empty let assignment expression, array + 2 │ let x: array = + │ ‾ + 3 │ // ^com + 4 │ + +[{ + "label": "[]", + "kind": 12, + "tags": [], + "detail": "array", + "documentation": null, + "sortText": "A", + "insertText": "[$0]", + "insertTextFormat": 2 + }] + diff --git a/tests/analysis_new_tests/tests/test_files/__snapshots__/EmptyExpressions.res_Empty_let_assignment_expression_record.snap b/tests/analysis_new_tests/tests/test_files/__snapshots__/EmptyExpressions.res_Empty_let_assignment_expression_record.snap new file mode 100644 index 0000000000..36dd9627e3 --- /dev/null +++ b/tests/analysis_new_tests/tests/test_files/__snapshots__/EmptyExpressions.res_Empty_let_assignment_expression_record.snap @@ -0,0 +1,19 @@ +Found Completable: Cexpression at type loc: [1:4->1:5] + + 1 │ // Empty let assignment expression, record + 2 │ let x: TestTypeDefs.nestedTestRecord = + │ ‾ + 3 │ // ^com + 4 │ + +[{ + "label": "{}", + "kind": 12, + "tags": [], + "detail": "TestTypeDefs.nestedTestRecord", + "documentation": {"kind": "markdown", "value": "```rescript\ntype nestedTestRecord = {\n test: bool,\n nested: {name: string, oneMoreLevel: {here: bool}},\n}\n```"}, + "sortText": "A", + "insertText": "{$0}", + "insertTextFormat": 2 + }] + diff --git a/tests/analysis_new_tests/tests/test_files/__snapshots__/RecordFieldCompletions.res_Record_field_completion_in_nested_record.snap b/tests/analysis_new_tests/tests/test_files/__snapshots__/RecordFieldCompletions.res_Record_field_completion_in_nested_record.snap new file mode 100644 index 0000000000..2517b07970 --- /dev/null +++ b/tests/analysis_new_tests/tests/test_files/__snapshots__/RecordFieldCompletions.res_Record_field_completion_in_nested_record.snap @@ -0,0 +1,22 @@ +Found Completable: Cexpression at type loc: [1:8->1:37] + + 1 │ // Record field completion in nested record + 2 │ let x = TestTypeDefs.nestedTestRecord. + │ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾ + 3 │ // ^com + 4 │ + +[{ + "label": "test", + "kind": 5, + "tags": [], + "detail": "bool", + "documentation": {"kind": "markdown", "value": "```rescript\ntest: bool\n```\n\n```rescript\ntype nestedTestRecord = {\n test: bool,\n nested: {name: string, oneMoreLevel: {here: bool}},\n}\n```"} + }, { + "label": "nested", + "kind": 5, + "tags": [], + "detail": "\\\"nestedTestRecord.nested\"", + "documentation": {"kind": "markdown", "value": "```rescript\nnested: \\\"nestedTestRecord.nested\"\n```\n\n```rescript\ntype nestedTestRecord = {\n test: bool,\n nested: {name: string, oneMoreLevel: {here: bool}},\n}\n```"} + }] + diff --git a/tests/analysis_new_tests/tests/test_files/__snapshots__/RecordFieldCompletions.res_Record_field_completion_in_nested_record_another_level.snap b/tests/analysis_new_tests/tests/test_files/__snapshots__/RecordFieldCompletions.res_Record_field_completion_in_nested_record_another_level.snap new file mode 100644 index 0000000000..9e77c93d3d --- /dev/null +++ b/tests/analysis_new_tests/tests/test_files/__snapshots__/RecordFieldCompletions.res_Record_field_completion_in_nested_record_another_level.snap @@ -0,0 +1,22 @@ +Found Completable: Cexpression at type loc: [1:8->1:44] + + 1 │ // Record field completion in nested record, another level + 2 │ let x = TestTypeDefs.nestedTestRecord.nested. + │ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾ + 3 │ // ^com + 4 │ + +[{ + "label": "name", + "kind": 5, + "tags": [], + "detail": "string", + "documentation": {"kind": "markdown", "value": "```rescript\nname: string\n```\n\n```rescript\ntype \\\"nestedTestRecord.nested\" = {\n name: string,\n oneMoreLevel: {here: bool},\n}\n```"} + }, { + "label": "oneMoreLevel", + "kind": 5, + "tags": [], + "detail": "\\\"nestedTestRecord.nested.oneMoreLevel\"", + "documentation": {"kind": "markdown", "value": "```rescript\noneMoreLevel: \\\"nestedTestRecord.nested.oneMoreLevel\"\n```\n\n```rescript\ntype \\\"nestedTestRecord.nested\" = {\n name: string,\n oneMoreLevel: {here: bool},\n}\n```"} + }] + diff --git a/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_array.snap b/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_array.snap new file mode 100644 index 0000000000..e76e288750 --- /dev/null +++ b/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_array.snap @@ -0,0 +1,20 @@ +Found Completable: Cpattern at type loc: [3:15->3:28] + + 2 │ let someStringArr = ["hello"] + 3 │ + 4 │ let x = switch someStringArr { + │ ‾‾‾‾‾‾‾‾‾‾‾‾‾ + 5 │ | + 6 │ // ^com + +[{ + "label": "[]", + "kind": 12, + "tags": [], + "detail": "array", + "documentation": null, + "sortText": "A", + "insertText": "[$0]", + "insertTextFormat": 2 + }] + diff --git a/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_bool.snap b/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_bool.snap new file mode 100644 index 0000000000..0426088d9e --- /dev/null +++ b/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_bool.snap @@ -0,0 +1,28 @@ +Found Completable: Cpattern at type loc: [1:15->1:19] + + 1 │ // Empty case, bool + 2 │ let x = switch true { + │ ‾‾‾‾ + 3 │ | + 4 │ // ^com + +[{ + "label": "true", + "kind": 12, + "tags": [], + "detail": "bool", + "documentation": null, + "sortText": "A", + "insertText": "true", + "insertTextFormat": 2 + }, { + "label": "false", + "kind": 12, + "tags": [], + "detail": "bool", + "documentation": null, + "sortText": "A", + "insertText": "false", + "insertTextFormat": 2 + }] + diff --git a/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_record.snap b/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_record.snap new file mode 100644 index 0000000000..2cc62fd712 --- /dev/null +++ b/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_record.snap @@ -0,0 +1,19 @@ +Found Completable: Cpattern at type loc: [1:15->1:44] + + 1 │ // Empty case, record + 2 │ let x = switch TestTypeDefs.nestedTestRecord { + │ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾ + 3 │ | + 4 │ // ^com + +[{ + "label": "{}", + "kind": 12, + "tags": [], + "detail": "TestTypeDefs.nestedTestRecord", + "documentation": {"kind": "markdown", "value": "```rescript\ntype nestedTestRecord = {\n test: bool,\n nested: {name: string, oneMoreLevel: {here: bool}},\n}\n```"}, + "sortText": "A", + "insertText": "{$0}", + "insertTextFormat": 2 + }] + diff --git a/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_string.snap b/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_string.snap new file mode 100644 index 0000000000..3a248ce44c --- /dev/null +++ b/tests/analysis_new_tests/tests/test_files/__snapshots__/SwitchCaseCompletions.res_Empty_case_string.snap @@ -0,0 +1,20 @@ +Found Completable: Cpattern at type loc: [2:15->2:18] + + 1 │ // Empty case, string + 2 │ let str = "hello" + 3 │ let x = switch str { + │ ‾‾‾ + 4 │ | + 5 │ // ^com + +[{ + "label": "\"\"", + "kind": 12, + "tags": [], + "detail": "string", + "documentation": null, + "sortText": "A", + "insertText": "\"$0\"", + "insertTextFormat": 2 + }] + diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt index 121a796eb4..99902b72a5 100644 --- a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt +++ b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt @@ -417,7 +417,7 @@ addValueDeclaration +make Hooks.res:63:6 path:+Hooks.RenderPropRequiresConversion addRecordLabelDeclaration name Hooks.res:1:16 path:+Hooks.vehicle addRecordLabelDeclaration vehicle Hooks.res:4:12 path:+Hooks.props - addValueReference Hooks.res:5:26 --> React.res:134:0 + addValueReference Hooks.res:5:26 --> React.res:145:0 addTypeReference Hooks.res:10:29 --> Hooks.res:1:16 addValueReference Hooks.res:10:29 --> Hooks.res:4:12 addValueReference Hooks.res:10:75 --> Hooks.res:5:7 @@ -1805,7 +1805,7 @@ File References DeadExn.resi -->> DeadRT.res -->> DeadRT.resi -->> - DeadTest.res -->> DeadValueTest.resi, DynamicallyLoadedComponent.res, ImmutableArray.resi, React.res + DeadTest.res -->> React.res, DeadValueTest.resi, DynamicallyLoadedComponent.res, ImmutableArray.resi DeadTestBlacklist.res -->> DeadTestWithInterface.res -->> DeadTypeTest.res -->> @@ -1821,7 +1821,7 @@ File References FirstClassModules.res -->> FirstClassModulesInterface.res -->> FirstClassModulesInterface.resi -->> FirstClassModulesInterface.res - Hooks.res -->> ImportHookDefault.res, ImportHooks.res, React.res + Hooks.res -->> React.res, ImportHookDefault.res, ImportHooks.res IgnoreInterface.res -->> IgnoreInterface.resi -->> ImmutableArray.res -->> diff --git a/yarn.lock b/yarn.lock index 5cbbbe4462..ee63a978f2 100644 --- a/yarn.lock +++ b/yarn.lock @@ -274,6 +274,181 @@ __metadata: languageName: node linkType: hard +"@esbuild/aix-ppc64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/aix-ppc64@npm:0.25.3" + conditions: os=aix & cpu=ppc64 + languageName: node + linkType: hard + +"@esbuild/android-arm64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/android-arm64@npm:0.25.3" + conditions: os=android & cpu=arm64 + languageName: node + linkType: hard + +"@esbuild/android-arm@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/android-arm@npm:0.25.3" + conditions: os=android & cpu=arm + languageName: node + linkType: hard + +"@esbuild/android-x64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/android-x64@npm:0.25.3" + conditions: os=android & cpu=x64 + languageName: node + linkType: hard + +"@esbuild/darwin-arm64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/darwin-arm64@npm:0.25.3" + conditions: os=darwin & cpu=arm64 + languageName: node + linkType: hard + +"@esbuild/darwin-x64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/darwin-x64@npm:0.25.3" + conditions: os=darwin & cpu=x64 + languageName: node + linkType: hard + +"@esbuild/freebsd-arm64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/freebsd-arm64@npm:0.25.3" + conditions: os=freebsd & cpu=arm64 + languageName: node + linkType: hard + +"@esbuild/freebsd-x64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/freebsd-x64@npm:0.25.3" + conditions: os=freebsd & cpu=x64 + languageName: node + linkType: hard + +"@esbuild/linux-arm64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/linux-arm64@npm:0.25.3" + conditions: os=linux & cpu=arm64 + languageName: node + linkType: hard + +"@esbuild/linux-arm@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/linux-arm@npm:0.25.3" + conditions: os=linux & cpu=arm + languageName: node + linkType: hard + +"@esbuild/linux-ia32@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/linux-ia32@npm:0.25.3" + conditions: os=linux & cpu=ia32 + languageName: node + linkType: hard + +"@esbuild/linux-loong64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/linux-loong64@npm:0.25.3" + conditions: os=linux & cpu=loong64 + languageName: node + linkType: hard + +"@esbuild/linux-mips64el@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/linux-mips64el@npm:0.25.3" + conditions: os=linux & cpu=mips64el + languageName: node + linkType: hard + +"@esbuild/linux-ppc64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/linux-ppc64@npm:0.25.3" + conditions: os=linux & cpu=ppc64 + languageName: node + linkType: hard + +"@esbuild/linux-riscv64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/linux-riscv64@npm:0.25.3" + conditions: os=linux & cpu=riscv64 + languageName: node + linkType: hard + +"@esbuild/linux-s390x@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/linux-s390x@npm:0.25.3" + conditions: os=linux & cpu=s390x + languageName: node + linkType: hard + +"@esbuild/linux-x64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/linux-x64@npm:0.25.3" + conditions: os=linux & cpu=x64 + languageName: node + linkType: hard + +"@esbuild/netbsd-arm64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/netbsd-arm64@npm:0.25.3" + conditions: os=netbsd & cpu=arm64 + languageName: node + linkType: hard + +"@esbuild/netbsd-x64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/netbsd-x64@npm:0.25.3" + conditions: os=netbsd & cpu=x64 + languageName: node + linkType: hard + +"@esbuild/openbsd-arm64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/openbsd-arm64@npm:0.25.3" + conditions: os=openbsd & cpu=arm64 + languageName: node + linkType: hard + +"@esbuild/openbsd-x64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/openbsd-x64@npm:0.25.3" + conditions: os=openbsd & cpu=x64 + languageName: node + linkType: hard + +"@esbuild/sunos-x64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/sunos-x64@npm:0.25.3" + conditions: os=sunos & cpu=x64 + languageName: node + linkType: hard + +"@esbuild/win32-arm64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/win32-arm64@npm:0.25.3" + conditions: os=win32 & cpu=arm64 + languageName: node + linkType: hard + +"@esbuild/win32-ia32@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/win32-ia32@npm:0.25.3" + conditions: os=win32 & cpu=ia32 + languageName: node + linkType: hard + +"@esbuild/win32-x64@npm:0.25.3": + version: 0.25.3 + resolution: "@esbuild/win32-x64@npm:0.25.3" + conditions: os=win32 & cpu=x64 + languageName: node + linkType: hard + "@isaacs/cliui@npm:^8.0.2": version: 8.0.2 resolution: "@isaacs/cliui@npm:8.0.2" @@ -342,7 +517,7 @@ __metadata: languageName: node linkType: hard -"@jridgewell/sourcemap-codec@npm:^1.4.10, @jridgewell/sourcemap-codec@npm:^1.4.14": +"@jridgewell/sourcemap-codec@npm:^1.4.10, @jridgewell/sourcemap-codec@npm:^1.4.14, @jridgewell/sourcemap-codec@npm:^1.5.0": version: 1.5.0 resolution: "@jridgewell/sourcemap-codec@npm:1.5.0" checksum: 10c0/2eb864f276eb1096c3c11da3e9bb518f6d9fc0023c78344cdc037abadc725172c70314bdb360f2d4b7bffec7f5d657ce006816bc5d4ecb35e61b66132db00c18 @@ -400,6 +575,12 @@ __metadata: languageName: node linkType: soft +"@rescript/react@link:../../dependencies/rescript-react::locator=%40tests%2Fanalysis_new%40workspace%3Atests%2Fanalysis_new_tests%2Ftests": + version: 0.0.0-use.local + resolution: "@rescript/react@link:../../dependencies/rescript-react::locator=%40tests%2Fanalysis_new%40workspace%3Atests%2Fanalysis_new_tests%2Ftests" + languageName: node + linkType: soft + "@rescript/react@link:../dependencies/rescript-react::locator=%40tests%2Ftools%40workspace%3Atests%2Ftools_tests": version: 0.0.0-use.local resolution: "@rescript/react@link:../dependencies/rescript-react::locator=%40tests%2Ftools%40workspace%3Atests%2Ftools_tests" @@ -469,6 +650,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-android-arm-eabi@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-android-arm-eabi@npm:4.40.0" + conditions: os=android & cpu=arm + languageName: node + linkType: hard + "@rollup/rollup-android-arm64@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-android-arm64@npm:4.39.0" @@ -476,6 +664,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-android-arm64@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-android-arm64@npm:4.40.0" + conditions: os=android & cpu=arm64 + languageName: node + linkType: hard + "@rollup/rollup-darwin-arm64@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-darwin-arm64@npm:4.39.0" @@ -483,6 +678,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-darwin-arm64@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-darwin-arm64@npm:4.40.0" + conditions: os=darwin & cpu=arm64 + languageName: node + linkType: hard + "@rollup/rollup-darwin-x64@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-darwin-x64@npm:4.39.0" @@ -490,6 +692,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-darwin-x64@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-darwin-x64@npm:4.40.0" + conditions: os=darwin & cpu=x64 + languageName: node + linkType: hard + "@rollup/rollup-freebsd-arm64@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-freebsd-arm64@npm:4.39.0" @@ -497,6 +706,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-freebsd-arm64@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-freebsd-arm64@npm:4.40.0" + conditions: os=freebsd & cpu=arm64 + languageName: node + linkType: hard + "@rollup/rollup-freebsd-x64@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-freebsd-x64@npm:4.39.0" @@ -504,6 +720,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-freebsd-x64@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-freebsd-x64@npm:4.40.0" + conditions: os=freebsd & cpu=x64 + languageName: node + linkType: hard + "@rollup/rollup-linux-arm-gnueabihf@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-linux-arm-gnueabihf@npm:4.39.0" @@ -511,6 +734,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-linux-arm-gnueabihf@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-linux-arm-gnueabihf@npm:4.40.0" + conditions: os=linux & cpu=arm & libc=glibc + languageName: node + linkType: hard + "@rollup/rollup-linux-arm-musleabihf@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-linux-arm-musleabihf@npm:4.39.0" @@ -518,6 +748,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-linux-arm-musleabihf@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-linux-arm-musleabihf@npm:4.40.0" + conditions: os=linux & cpu=arm & libc=musl + languageName: node + linkType: hard + "@rollup/rollup-linux-arm64-gnu@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-linux-arm64-gnu@npm:4.39.0" @@ -525,6 +762,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-linux-arm64-gnu@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-linux-arm64-gnu@npm:4.40.0" + conditions: os=linux & cpu=arm64 & libc=glibc + languageName: node + linkType: hard + "@rollup/rollup-linux-arm64-musl@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-linux-arm64-musl@npm:4.39.0" @@ -532,6 +776,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-linux-arm64-musl@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-linux-arm64-musl@npm:4.40.0" + conditions: os=linux & cpu=arm64 & libc=musl + languageName: node + linkType: hard + "@rollup/rollup-linux-loongarch64-gnu@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-linux-loongarch64-gnu@npm:4.39.0" @@ -539,6 +790,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-linux-loongarch64-gnu@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-linux-loongarch64-gnu@npm:4.40.0" + conditions: os=linux & cpu=loong64 & libc=glibc + languageName: node + linkType: hard + "@rollup/rollup-linux-powerpc64le-gnu@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-linux-powerpc64le-gnu@npm:4.39.0" @@ -546,6 +804,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-linux-powerpc64le-gnu@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-linux-powerpc64le-gnu@npm:4.40.0" + conditions: os=linux & cpu=ppc64 & libc=glibc + languageName: node + linkType: hard + "@rollup/rollup-linux-riscv64-gnu@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-linux-riscv64-gnu@npm:4.39.0" @@ -553,6 +818,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-linux-riscv64-gnu@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-linux-riscv64-gnu@npm:4.40.0" + conditions: os=linux & cpu=riscv64 & libc=glibc + languageName: node + linkType: hard + "@rollup/rollup-linux-riscv64-musl@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-linux-riscv64-musl@npm:4.39.0" @@ -560,6 +832,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-linux-riscv64-musl@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-linux-riscv64-musl@npm:4.40.0" + conditions: os=linux & cpu=riscv64 & libc=musl + languageName: node + linkType: hard + "@rollup/rollup-linux-s390x-gnu@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-linux-s390x-gnu@npm:4.39.0" @@ -567,6 +846,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-linux-s390x-gnu@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-linux-s390x-gnu@npm:4.40.0" + conditions: os=linux & cpu=s390x & libc=glibc + languageName: node + linkType: hard + "@rollup/rollup-linux-x64-gnu@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-linux-x64-gnu@npm:4.39.0" @@ -574,6 +860,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-linux-x64-gnu@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-linux-x64-gnu@npm:4.40.0" + conditions: os=linux & cpu=x64 & libc=glibc + languageName: node + linkType: hard + "@rollup/rollup-linux-x64-musl@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-linux-x64-musl@npm:4.39.0" @@ -581,6 +874,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-linux-x64-musl@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-linux-x64-musl@npm:4.40.0" + conditions: os=linux & cpu=x64 & libc=musl + languageName: node + linkType: hard + "@rollup/rollup-win32-arm64-msvc@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-win32-arm64-msvc@npm:4.39.0" @@ -588,6 +888,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-win32-arm64-msvc@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-win32-arm64-msvc@npm:4.40.0" + conditions: os=win32 & cpu=arm64 + languageName: node + linkType: hard + "@rollup/rollup-win32-ia32-msvc@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-win32-ia32-msvc@npm:4.39.0" @@ -595,6 +902,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-win32-ia32-msvc@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-win32-ia32-msvc@npm:4.40.0" + conditions: os=win32 & cpu=ia32 + languageName: node + linkType: hard + "@rollup/rollup-win32-x64-msvc@npm:4.39.0": version: 4.39.0 resolution: "@rollup/rollup-win32-x64-msvc@npm:4.39.0" @@ -602,6 +916,13 @@ __metadata: languageName: node linkType: hard +"@rollup/rollup-win32-x64-msvc@npm:4.40.0": + version: 4.40.0 + resolution: "@rollup/rollup-win32-x64-msvc@npm:4.40.0" + conditions: os=win32 & cpu=x64 + languageName: node + linkType: hard + "@tests/analysis@workspace:tests/analysis_tests/tests": version: 0.0.0-use.local resolution: "@tests/analysis@workspace:tests/analysis_tests/tests" @@ -611,6 +932,16 @@ __metadata: languageName: unknown linkType: soft +"@tests/analysis_new@workspace:tests/analysis_new_tests/tests": + version: 0.0.0-use.local + resolution: "@tests/analysis_new@workspace:tests/analysis_new_tests/tests" + dependencies: + "@rescript/react": "link:../../dependencies/rescript-react" + rescript: "workspace:^" + vitest: "npm:3.1.2" + languageName: unknown + linkType: soft + "@tests/generic-jsx-transform@workspace:tests/analysis_tests/tests-generic-jsx-transform": version: 0.0.0-use.local resolution: "@tests/generic-jsx-transform@workspace:tests/analysis_tests/tests-generic-jsx-transform" @@ -724,6 +1055,87 @@ __metadata: languageName: node linkType: hard +"@vitest/expect@npm:3.1.2": + version: 3.1.2 + resolution: "@vitest/expect@npm:3.1.2" + dependencies: + "@vitest/spy": "npm:3.1.2" + "@vitest/utils": "npm:3.1.2" + chai: "npm:^5.2.0" + tinyrainbow: "npm:^2.0.0" + checksum: 10c0/63507f77b225196d79f5aabedbb10f93974808a2b507661b66def95e803e6f7f958049e9b985d2d5fee83317f157f8018fea6e1240c64a5fec8e9753235ad081 + languageName: node + linkType: hard + +"@vitest/mocker@npm:3.1.2": + version: 3.1.2 + resolution: "@vitest/mocker@npm:3.1.2" + dependencies: + "@vitest/spy": "npm:3.1.2" + estree-walker: "npm:^3.0.3" + magic-string: "npm:^0.30.17" + peerDependencies: + msw: ^2.4.9 + vite: ^5.0.0 || ^6.0.0 + peerDependenciesMeta: + msw: + optional: true + vite: + optional: true + checksum: 10c0/4447962d7e160d774cf5b1eef03067230b5e36131e3441d3dd791ad38b6c06e16940f21fa20c311c58b635ba376ffb45d003b6f04d0d4cc0d7c4be854df4b8e4 + languageName: node + linkType: hard + +"@vitest/pretty-format@npm:3.1.2, @vitest/pretty-format@npm:^3.1.2": + version: 3.1.2 + resolution: "@vitest/pretty-format@npm:3.1.2" + dependencies: + tinyrainbow: "npm:^2.0.0" + checksum: 10c0/f4a79be6d5a1a0b3215ba66b3cc62b2e0fc3a81b4eee07b2644600450b796a8630ee86180691391a5597c9a792f3d213d54f2043f4a0809a9386473bfcca85fb + languageName: node + linkType: hard + +"@vitest/runner@npm:3.1.2": + version: 3.1.2 + resolution: "@vitest/runner@npm:3.1.2" + dependencies: + "@vitest/utils": "npm:3.1.2" + pathe: "npm:^2.0.3" + checksum: 10c0/7312013c87a6869d07380506e808f686ab04cb989f8ae6d3c7ea16a4990fce715801c8c4d5836612706a9e8a2e5ed01629d728360fba035d8f2570a90b0050cd + languageName: node + linkType: hard + +"@vitest/snapshot@npm:3.1.2": + version: 3.1.2 + resolution: "@vitest/snapshot@npm:3.1.2" + dependencies: + "@vitest/pretty-format": "npm:3.1.2" + magic-string: "npm:^0.30.17" + pathe: "npm:^2.0.3" + checksum: 10c0/f3e451ec41eb54ace4c08f3dc3dbd3c283ff73b4c8eab899bb6bcd6589bf864bcaa33afb611751a76c87c5ca31fb3420511633fb7fb06af2692a70e6c8578db2 + languageName: node + linkType: hard + +"@vitest/spy@npm:3.1.2": + version: 3.1.2 + resolution: "@vitest/spy@npm:3.1.2" + dependencies: + tinyspy: "npm:^3.0.2" + checksum: 10c0/0f827970c34e256f3af964df5a5133c181ef1475b73a15b47565ad3187e4b2627e949e632c21e34a694e16b98ceb1e670f5e7dc99baeb53cb029578147d4ccee + languageName: node + linkType: hard + +"@vitest/utils@npm:3.1.2": + version: 3.1.2 + resolution: "@vitest/utils@npm:3.1.2" + dependencies: + "@vitest/pretty-format": "npm:3.1.2" + loupe: "npm:^3.1.3" + tinyrainbow: "npm:^2.0.0" + checksum: 10c0/9e778ab7cf483396d650ddd079e702af6b9f087443a99045707865bf433cfa3c4f468d94d17a44173e6adcc5cce218a1b0073d1b94bbd84a03262033e427336d + languageName: node + linkType: hard + "abbrev@npm:^3.0.0": version: 3.0.0 resolution: "abbrev@npm:3.0.0" @@ -827,6 +1239,13 @@ __metadata: languageName: node linkType: hard +"assertion-error@npm:^2.0.1": + version: 2.0.1 + resolution: "assertion-error@npm:2.0.1" + checksum: 10c0/bbbcb117ac6480138f8c93cf7f535614282dea9dc828f540cdece85e3c665e8f78958b96afac52f29ff883c72638e6a87d469ecc9fe5bc902df03ed24a55dba8 + languageName: node + linkType: hard + "balanced-match@npm:^1.0.0": version: 1.0.2 resolution: "balanced-match@npm:1.0.2" @@ -890,6 +1309,13 @@ __metadata: languageName: node linkType: hard +"cac@npm:^6.7.14": + version: 6.7.14 + resolution: "cac@npm:6.7.14" + checksum: 10c0/4ee06aaa7bab8981f0d54e5f5f9d4adcd64058e9697563ce336d8a3878ed018ee18ebe5359b2430eceae87e0758e62ea2019c3f52ae6e211b1bd2e133856cd10 + languageName: node + linkType: hard + "cacache@npm:^19.0.1": version: 19.0.1 resolution: "cacache@npm:19.0.1" @@ -943,6 +1369,19 @@ __metadata: languageName: node linkType: hard +"chai@npm:^5.2.0": + version: 5.2.0 + resolution: "chai@npm:5.2.0" + dependencies: + assertion-error: "npm:^2.0.1" + check-error: "npm:^2.1.1" + deep-eql: "npm:^5.0.1" + loupe: "npm:^3.1.0" + pathval: "npm:^2.0.0" + checksum: 10c0/dfd1cb719c7cebb051b727672d382a35338af1470065cb12adb01f4ee451bbf528e0e0f9ab2016af5fc1eea4df6e7f4504dc8443f8f00bd8fb87ad32dc516f7d + languageName: node + linkType: hard + "chalk@npm:^4.1.0": version: 4.1.2 resolution: "chalk@npm:4.1.2" @@ -953,6 +1392,13 @@ __metadata: languageName: node linkType: hard +"check-error@npm:^2.1.1": + version: 2.1.1 + resolution: "check-error@npm:2.1.1" + checksum: 10c0/979f13eccab306cf1785fa10941a590b4e7ea9916ea2a4f8c87f0316fc3eab07eabefb6e587424ef0f88cbcd3805791f172ea739863ca3d7ce2afc54641c7f0e + languageName: node + linkType: hard + "chokidar@npm:^3.5.3": version: 3.6.0 resolution: "chokidar@npm:3.6.0" @@ -1070,7 +1516,7 @@ __metadata: languageName: node linkType: hard -"debug@npm:4, debug@npm:^4.1.0, debug@npm:^4.1.1, debug@npm:^4.3.1, debug@npm:^4.3.4, debug@npm:^4.3.5": +"debug@npm:4, debug@npm:^4.1.0, debug@npm:^4.1.1, debug@npm:^4.3.1, debug@npm:^4.3.4, debug@npm:^4.3.5, debug@npm:^4.4.0": version: 4.4.0 resolution: "debug@npm:4.4.0" dependencies: @@ -1096,6 +1542,13 @@ __metadata: languageName: node linkType: hard +"deep-eql@npm:^5.0.1": + version: 5.0.2 + resolution: "deep-eql@npm:5.0.2" + checksum: 10c0/7102cf3b7bb719c6b9c0db2e19bf0aa9318d141581befe8c7ce8ccd39af9eaa4346e5e05adef7f9bd7015da0f13a3a25dcfe306ef79dc8668aedbecb658dd247 + languageName: node + linkType: hard + "deepmerge@npm:^4.2.2": version: 4.3.1 resolution: "deepmerge@npm:4.3.1" @@ -1170,6 +1623,13 @@ __metadata: languageName: node linkType: hard +"es-module-lexer@npm:^1.6.0": + version: 1.7.0 + resolution: "es-module-lexer@npm:1.7.0" + checksum: 10c0/4c935affcbfeba7fb4533e1da10fa8568043df1e3574b869385980de9e2d475ddc36769891936dbb07036edb3c3786a8b78ccf44964cd130dedc1f2c984b6c7b + languageName: node + linkType: hard + "es6-error@npm:^4.0.1": version: 4.1.1 resolution: "es6-error@npm:4.1.1" @@ -1177,6 +1637,92 @@ __metadata: languageName: node linkType: hard +"esbuild@npm:^0.25.0": + version: 0.25.3 + resolution: "esbuild@npm:0.25.3" + dependencies: + "@esbuild/aix-ppc64": "npm:0.25.3" + "@esbuild/android-arm": "npm:0.25.3" + "@esbuild/android-arm64": "npm:0.25.3" + "@esbuild/android-x64": "npm:0.25.3" + "@esbuild/darwin-arm64": "npm:0.25.3" + "@esbuild/darwin-x64": "npm:0.25.3" + "@esbuild/freebsd-arm64": "npm:0.25.3" + "@esbuild/freebsd-x64": "npm:0.25.3" + "@esbuild/linux-arm": "npm:0.25.3" + "@esbuild/linux-arm64": "npm:0.25.3" + "@esbuild/linux-ia32": "npm:0.25.3" + "@esbuild/linux-loong64": "npm:0.25.3" + "@esbuild/linux-mips64el": "npm:0.25.3" + "@esbuild/linux-ppc64": "npm:0.25.3" + "@esbuild/linux-riscv64": "npm:0.25.3" + "@esbuild/linux-s390x": "npm:0.25.3" + "@esbuild/linux-x64": "npm:0.25.3" + "@esbuild/netbsd-arm64": "npm:0.25.3" + "@esbuild/netbsd-x64": "npm:0.25.3" + "@esbuild/openbsd-arm64": "npm:0.25.3" + "@esbuild/openbsd-x64": "npm:0.25.3" + "@esbuild/sunos-x64": "npm:0.25.3" + "@esbuild/win32-arm64": "npm:0.25.3" + "@esbuild/win32-ia32": "npm:0.25.3" + "@esbuild/win32-x64": "npm:0.25.3" + dependenciesMeta: + "@esbuild/aix-ppc64": + optional: true + "@esbuild/android-arm": + optional: true + "@esbuild/android-arm64": + optional: true + "@esbuild/android-x64": + optional: true + "@esbuild/darwin-arm64": + optional: true + "@esbuild/darwin-x64": + optional: true + "@esbuild/freebsd-arm64": + optional: true + "@esbuild/freebsd-x64": + optional: true + "@esbuild/linux-arm": + optional: true + "@esbuild/linux-arm64": + optional: true + "@esbuild/linux-ia32": + optional: true + "@esbuild/linux-loong64": + optional: true + "@esbuild/linux-mips64el": + optional: true + "@esbuild/linux-ppc64": + optional: true + "@esbuild/linux-riscv64": + optional: true + "@esbuild/linux-s390x": + optional: true + "@esbuild/linux-x64": + optional: true + "@esbuild/netbsd-arm64": + optional: true + "@esbuild/netbsd-x64": + optional: true + "@esbuild/openbsd-arm64": + optional: true + "@esbuild/openbsd-x64": + optional: true + "@esbuild/sunos-x64": + optional: true + "@esbuild/win32-arm64": + optional: true + "@esbuild/win32-ia32": + optional: true + "@esbuild/win32-x64": + optional: true + bin: + esbuild: bin/esbuild + checksum: 10c0/127aff654310ede4e2eb232a7b1d8823f5b5d69222caf17aa7f172574a5b6b75f71ce78c6d8a40030421d7c75b784dc640de0fb1b87b7ea77ab2a1c832fa8df8 + languageName: node + linkType: hard + "escalade@npm:^3.1.1, escalade@npm:^3.2.0": version: 3.2.0 resolution: "escalade@npm:3.2.0" @@ -1208,6 +1754,22 @@ __metadata: languageName: node linkType: hard +"estree-walker@npm:^3.0.3": + version: 3.0.3 + resolution: "estree-walker@npm:3.0.3" + dependencies: + "@types/estree": "npm:^1.0.0" + checksum: 10c0/c12e3c2b2642d2bcae7d5aa495c60fa2f299160946535763969a1c83fc74518ffa9c2cd3a8b69ac56aea547df6a8aac25f729a342992ef0bbac5f1c73e78995d + languageName: node + linkType: hard + +"expect-type@npm:^1.2.1": + version: 1.2.1 + resolution: "expect-type@npm:1.2.1" + checksum: 10c0/b775c9adab3c190dd0d398c722531726cdd6022849b4adba19dceab58dda7e000a7c6c872408cd73d665baa20d381eca36af4f7b393a4ba60dd10232d1fb8898 + languageName: node + linkType: hard + "exponential-backoff@npm:^3.1.1": version: 3.1.2 resolution: "exponential-backoff@npm:3.1.2" @@ -1215,6 +1777,18 @@ __metadata: languageName: node linkType: hard +"fdir@npm:^6.4.4": + version: 6.4.4 + resolution: "fdir@npm:6.4.4" + peerDependencies: + picomatch: ^3 || ^4 + peerDependenciesMeta: + picomatch: + optional: true + checksum: 10c0/6ccc33be16945ee7bc841e1b4178c0b4cf18d3804894cb482aa514651c962a162f96da7ffc6ebfaf0df311689fb70091b04dd6caffe28d56b9ebdc0e7ccadfdd + languageName: node + linkType: hard + "fill-range@npm:^7.1.1": version: 7.1.1 resolution: "fill-range@npm:7.1.1" @@ -1307,7 +1881,7 @@ __metadata: languageName: node linkType: hard -"fsevents@npm:~2.3.2": +"fsevents@npm:~2.3.2, fsevents@npm:~2.3.3": version: 2.3.3 resolution: "fsevents@npm:2.3.3" dependencies: @@ -1317,7 +1891,7 @@ __metadata: languageName: node linkType: hard -"fsevents@patch:fsevents@npm%3A~2.3.2#optional!builtin": +"fsevents@patch:fsevents@npm%3A~2.3.2#optional!builtin, fsevents@patch:fsevents@npm%3A~2.3.3#optional!builtin": version: 2.3.3 resolution: "fsevents@patch:fsevents@npm%3A2.3.3#optional!builtin::version=2.3.3&hash=df0bf1" dependencies: @@ -1856,6 +2430,13 @@ __metadata: languageName: node linkType: hard +"loupe@npm:^3.1.0, loupe@npm:^3.1.3": + version: 3.1.3 + resolution: "loupe@npm:3.1.3" + checksum: 10c0/f5dab4144254677de83a35285be1b8aba58b3861439ce4ba65875d0d5f3445a4a496daef63100ccf02b2dbc25bf58c6db84c9cb0b96d6435331e9d0a33b48541 + languageName: node + linkType: hard + "lru-cache@npm:^10.0.1, lru-cache@npm:^10.2.0": version: 10.4.3 resolution: "lru-cache@npm:10.4.3" @@ -1879,6 +2460,15 @@ __metadata: languageName: node linkType: hard +"magic-string@npm:^0.30.17": + version: 0.30.17 + resolution: "magic-string@npm:0.30.17" + dependencies: + "@jridgewell/sourcemap-codec": "npm:^1.5.0" + checksum: 10c0/16826e415d04b88378f200fe022b53e638e3838b9e496edda6c0e086d7753a44a6ed187adc72d19f3623810589bf139af1a315541cd6a26ae0771a0193eaf7b8 + languageName: node + linkType: hard + "make-dir@npm:^3.0.0, make-dir@npm:^3.0.2": version: 3.1.0 resolution: "make-dir@npm:3.1.0" @@ -2076,6 +2666,15 @@ __metadata: languageName: node linkType: hard +"nanoid@npm:^3.3.8": + version: 3.3.11 + resolution: "nanoid@npm:3.3.11" + bin: + nanoid: bin/nanoid.cjs + checksum: 10c0/40e7f70b3d15f725ca072dfc4f74e81fcf1fbb02e491cf58ac0c79093adc9b0a73b152bcde57df4b79cd097e13023d7504acb38404a4da7bc1cd8e887b82fe0b + languageName: node + linkType: hard + "negotiator@npm:^1.0.0": version: 1.0.0 resolution: "negotiator@npm:1.0.0" @@ -2310,6 +2909,20 @@ __metadata: languageName: node linkType: hard +"pathe@npm:^2.0.3": + version: 2.0.3 + resolution: "pathe@npm:2.0.3" + checksum: 10c0/c118dc5a8b5c4166011b2b70608762e260085180bb9e33e80a50dcdb1e78c010b1624f4280c492c92b05fc276715a4c357d1f9edc570f8f1b3d90b6839ebaca1 + languageName: node + linkType: hard + +"pathval@npm:^2.0.0": + version: 2.0.0 + resolution: "pathval@npm:2.0.0" + checksum: 10c0/602e4ee347fba8a599115af2ccd8179836a63c925c23e04bd056d0674a64b39e3a081b643cc7bc0b84390517df2d800a46fcc5598d42c155fe4977095c2f77c5 + languageName: node + linkType: hard + "picocolors@npm:^1.0.0, picocolors@npm:^1.1.1": version: 1.1.1 resolution: "picocolors@npm:1.1.1" @@ -2352,6 +2965,17 @@ __metadata: languageName: unknown linkType: soft +"postcss@npm:^8.5.3": + version: 8.5.3 + resolution: "postcss@npm:8.5.3" + dependencies: + nanoid: "npm:^3.3.8" + picocolors: "npm:^1.1.1" + source-map-js: "npm:^1.2.1" + checksum: 10c0/b75510d7b28c3ab728c8733dd01538314a18c52af426f199a3c9177e63eb08602a3938bfb66b62dc01350b9aed62087eabbf229af97a1659eb8d3513cec823b3 + languageName: node + linkType: hard + "proc-log@npm:^5.0.0": version: 5.0.0 resolution: "proc-log@npm:5.0.0" @@ -2597,6 +3221,81 @@ __metadata: languageName: node linkType: hard +"rollup@npm:^4.34.9": + version: 4.40.0 + resolution: "rollup@npm:4.40.0" + dependencies: + "@rollup/rollup-android-arm-eabi": "npm:4.40.0" + "@rollup/rollup-android-arm64": "npm:4.40.0" + "@rollup/rollup-darwin-arm64": "npm:4.40.0" + "@rollup/rollup-darwin-x64": "npm:4.40.0" + "@rollup/rollup-freebsd-arm64": "npm:4.40.0" + "@rollup/rollup-freebsd-x64": "npm:4.40.0" + "@rollup/rollup-linux-arm-gnueabihf": "npm:4.40.0" + "@rollup/rollup-linux-arm-musleabihf": "npm:4.40.0" + "@rollup/rollup-linux-arm64-gnu": "npm:4.40.0" + "@rollup/rollup-linux-arm64-musl": "npm:4.40.0" + "@rollup/rollup-linux-loongarch64-gnu": "npm:4.40.0" + "@rollup/rollup-linux-powerpc64le-gnu": "npm:4.40.0" + "@rollup/rollup-linux-riscv64-gnu": "npm:4.40.0" + "@rollup/rollup-linux-riscv64-musl": "npm:4.40.0" + "@rollup/rollup-linux-s390x-gnu": "npm:4.40.0" + "@rollup/rollup-linux-x64-gnu": "npm:4.40.0" + "@rollup/rollup-linux-x64-musl": "npm:4.40.0" + "@rollup/rollup-win32-arm64-msvc": "npm:4.40.0" + "@rollup/rollup-win32-ia32-msvc": "npm:4.40.0" + "@rollup/rollup-win32-x64-msvc": "npm:4.40.0" + "@types/estree": "npm:1.0.7" + fsevents: "npm:~2.3.2" + dependenciesMeta: + "@rollup/rollup-android-arm-eabi": + optional: true + "@rollup/rollup-android-arm64": + optional: true + "@rollup/rollup-darwin-arm64": + optional: true + "@rollup/rollup-darwin-x64": + optional: true + "@rollup/rollup-freebsd-arm64": + optional: true + "@rollup/rollup-freebsd-x64": + optional: true + "@rollup/rollup-linux-arm-gnueabihf": + optional: true + "@rollup/rollup-linux-arm-musleabihf": + optional: true + "@rollup/rollup-linux-arm64-gnu": + optional: true + "@rollup/rollup-linux-arm64-musl": + optional: true + "@rollup/rollup-linux-loongarch64-gnu": + optional: true + "@rollup/rollup-linux-powerpc64le-gnu": + optional: true + "@rollup/rollup-linux-riscv64-gnu": + optional: true + "@rollup/rollup-linux-riscv64-musl": + optional: true + "@rollup/rollup-linux-s390x-gnu": + optional: true + "@rollup/rollup-linux-x64-gnu": + optional: true + "@rollup/rollup-linux-x64-musl": + optional: true + "@rollup/rollup-win32-arm64-msvc": + optional: true + "@rollup/rollup-win32-ia32-msvc": + optional: true + "@rollup/rollup-win32-x64-msvc": + optional: true + fsevents: + optional: true + bin: + rollup: dist/bin/rollup + checksum: 10c0/90aa57487d4a9a7de1a47bf42a6091f83f1cb7fe1814650dfec278ab8ddae5736b86535d4c766493517720f334dfd4aa0635405ca8f4f36ed8d3c0f875f2a801 + languageName: node + linkType: hard + "safe-buffer@npm:^5.1.0": version: 5.2.1 resolution: "safe-buffer@npm:5.2.1" @@ -2679,6 +3378,13 @@ __metadata: languageName: node linkType: hard +"siginfo@npm:^2.0.0": + version: 2.0.0 + resolution: "siginfo@npm:2.0.0" + checksum: 10c0/3def8f8e516fbb34cb6ae415b07ccc5d9c018d85b4b8611e3dc6f8be6d1899f693a4382913c9ed51a06babb5201639d76453ab297d1c54a456544acf5c892e34 + languageName: node + linkType: hard + "signal-exit@npm:^3.0.2": version: 3.0.7 resolution: "signal-exit@npm:3.0.7" @@ -2721,6 +3427,13 @@ __metadata: languageName: node linkType: hard +"source-map-js@npm:^1.2.1": + version: 1.2.1 + resolution: "source-map-js@npm:1.2.1" + checksum: 10c0/7bda1fc4c197e3c6ff17de1b8b2c20e60af81b63a52cb32ec5a5d67a20a7d42651e2cb34ebe93833c5a2a084377e17455854fee3e21e7925c64a51b6a52b0faf + languageName: node + linkType: hard + "source-map@npm:^0.6.1": version: 0.6.1 resolution: "source-map@npm:0.6.1" @@ -2765,6 +3478,20 @@ __metadata: languageName: node linkType: hard +"stackback@npm:0.0.2": + version: 0.0.2 + resolution: "stackback@npm:0.0.2" + checksum: 10c0/89a1416668f950236dd5ac9f9a6b2588e1b9b62b1b6ad8dff1bfc5d1a15dbf0aafc9b52d2226d00c28dffff212da464eaeebfc6b7578b9d180cef3e3782c5983 + languageName: node + linkType: hard + +"std-env@npm:^3.9.0": + version: 3.9.0 + resolution: "std-env@npm:3.9.0" + checksum: 10c0/4a6f9218aef3f41046c3c7ecf1f98df00b30a07f4f35c6d47b28329bc2531eef820828951c7d7b39a1c5eb19ad8a46e3ddfc7deb28f0a2f3ceebee11bab7ba50 + languageName: node + linkType: hard + "string-width-cjs@npm:string-width@^4.2.0, string-width@npm:^4.1.0, string-width@npm:^4.2.0": version: 4.2.3 resolution: "string-width@npm:4.2.3" @@ -2869,6 +3596,51 @@ __metadata: languageName: node linkType: hard +"tinybench@npm:^2.9.0": + version: 2.9.0 + resolution: "tinybench@npm:2.9.0" + checksum: 10c0/c3500b0f60d2eb8db65250afe750b66d51623057ee88720b7f064894a6cb7eb93360ca824a60a31ab16dab30c7b1f06efe0795b352e37914a9d4bad86386a20c + languageName: node + linkType: hard + +"tinyexec@npm:^0.3.2": + version: 0.3.2 + resolution: "tinyexec@npm:0.3.2" + checksum: 10c0/3efbf791a911be0bf0821eab37a3445c2ba07acc1522b1fa84ae1e55f10425076f1290f680286345ed919549ad67527d07281f1c19d584df3b74326909eb1f90 + languageName: node + linkType: hard + +"tinyglobby@npm:^0.2.13": + version: 0.2.13 + resolution: "tinyglobby@npm:0.2.13" + dependencies: + fdir: "npm:^6.4.4" + picomatch: "npm:^4.0.2" + checksum: 10c0/ef07dfaa7b26936601d3f6d999f7928a4d1c6234c5eb36896bb88681947c0d459b7ebe797022400e555fe4b894db06e922b95d0ce60cb05fd827a0a66326b18c + languageName: node + linkType: hard + +"tinypool@npm:^1.0.2": + version: 1.0.2 + resolution: "tinypool@npm:1.0.2" + checksum: 10c0/31ac184c0ff1cf9a074741254fe9ea6de95026749eb2b8ec6fd2b9d8ca94abdccda731f8e102e7f32e72ed3b36d32c6975fd5f5523df3f1b6de6c3d8dfd95e63 + languageName: node + linkType: hard + +"tinyrainbow@npm:^2.0.0": + version: 2.0.0 + resolution: "tinyrainbow@npm:2.0.0" + checksum: 10c0/c83c52bef4e0ae7fb8ec6a722f70b5b6fa8d8be1c85792e829f56c0e1be94ab70b293c032dc5048d4d37cfe678f1f5babb04bdc65fd123098800148ca989184f + languageName: node + linkType: hard + +"tinyspy@npm:^3.0.2": + version: 3.0.2 + resolution: "tinyspy@npm:3.0.2" + checksum: 10c0/55ffad24e346622b59292e097c2ee30a63919d5acb7ceca87fc0d1c223090089890587b426e20054733f97a58f20af2c349fb7cc193697203868ab7ba00bcea0 + languageName: node + linkType: hard + "to-regex-range@npm:^5.0.1": version: 5.0.1 resolution: "to-regex-range@npm:5.0.1" @@ -2971,6 +3743,130 @@ __metadata: languageName: node linkType: hard +"vite-node@npm:3.1.2": + version: 3.1.2 + resolution: "vite-node@npm:3.1.2" + dependencies: + cac: "npm:^6.7.14" + debug: "npm:^4.4.0" + es-module-lexer: "npm:^1.6.0" + pathe: "npm:^2.0.3" + vite: "npm:^5.0.0 || ^6.0.0" + bin: + vite-node: vite-node.mjs + checksum: 10c0/eb0788b43a241c69ca23ba6cf5ab5226157947938dc4e02247b2008e1fd425e45a347d3caac7d53e0b804beb4c9e97395908fd87c1f23bda1590e1b011c63edb + languageName: node + linkType: hard + +"vite@npm:^5.0.0 || ^6.0.0": + version: 6.3.3 + resolution: "vite@npm:6.3.3" + dependencies: + esbuild: "npm:^0.25.0" + fdir: "npm:^6.4.4" + fsevents: "npm:~2.3.3" + picomatch: "npm:^4.0.2" + postcss: "npm:^8.5.3" + rollup: "npm:^4.34.9" + tinyglobby: "npm:^0.2.13" + peerDependencies: + "@types/node": ^18.0.0 || ^20.0.0 || >=22.0.0 + jiti: ">=1.21.0" + less: "*" + lightningcss: ^1.21.0 + sass: "*" + sass-embedded: "*" + stylus: "*" + sugarss: "*" + terser: ^5.16.0 + tsx: ^4.8.1 + yaml: ^2.4.2 + dependenciesMeta: + fsevents: + optional: true + peerDependenciesMeta: + "@types/node": + optional: true + jiti: + optional: true + less: + optional: true + lightningcss: + optional: true + sass: + optional: true + sass-embedded: + optional: true + stylus: + optional: true + sugarss: + optional: true + terser: + optional: true + tsx: + optional: true + yaml: + optional: true + bin: + vite: bin/vite.js + checksum: 10c0/7ea27d2c80a9e0b7ccf6cbd6c251455501286568160e8b632984e5332440f21a6d05f9236408212ba7653f7d2d4790f848956d8a620bbf4dd2ecb792a2fe1ab1 + languageName: node + linkType: hard + +"vitest@npm:3.1.2": + version: 3.1.2 + resolution: "vitest@npm:3.1.2" + dependencies: + "@vitest/expect": "npm:3.1.2" + "@vitest/mocker": "npm:3.1.2" + "@vitest/pretty-format": "npm:^3.1.2" + "@vitest/runner": "npm:3.1.2" + "@vitest/snapshot": "npm:3.1.2" + "@vitest/spy": "npm:3.1.2" + "@vitest/utils": "npm:3.1.2" + chai: "npm:^5.2.0" + debug: "npm:^4.4.0" + expect-type: "npm:^1.2.1" + magic-string: "npm:^0.30.17" + pathe: "npm:^2.0.3" + std-env: "npm:^3.9.0" + tinybench: "npm:^2.9.0" + tinyexec: "npm:^0.3.2" + tinyglobby: "npm:^0.2.13" + tinypool: "npm:^1.0.2" + tinyrainbow: "npm:^2.0.0" + vite: "npm:^5.0.0 || ^6.0.0" + vite-node: "npm:3.1.2" + why-is-node-running: "npm:^2.3.0" + peerDependencies: + "@edge-runtime/vm": "*" + "@types/debug": ^4.1.12 + "@types/node": ^18.0.0 || ^20.0.0 || >=22.0.0 + "@vitest/browser": 3.1.2 + "@vitest/ui": 3.1.2 + happy-dom: "*" + jsdom: "*" + peerDependenciesMeta: + "@edge-runtime/vm": + optional: true + "@types/debug": + optional: true + "@types/node": + optional: true + "@vitest/browser": + optional: true + "@vitest/ui": + optional: true + happy-dom: + optional: true + jsdom: + optional: true + bin: + vitest: vitest.mjs + checksum: 10c0/14b9c99812282d88b6e1dafde8cca22b07dcefa0a00d240145cf5cb95b082c287807bd884f417a046992bc74246aaf64662fd07179e60547c9277fbc8986439b + languageName: node + linkType: hard + "which-module@npm:^2.0.0": version: 2.0.1 resolution: "which-module@npm:2.0.1" @@ -3000,6 +3896,18 @@ __metadata: languageName: node linkType: hard +"why-is-node-running@npm:^2.3.0": + version: 2.3.0 + resolution: "why-is-node-running@npm:2.3.0" + dependencies: + siginfo: "npm:^2.0.0" + stackback: "npm:0.0.2" + bin: + why-is-node-running: cli.js + checksum: 10c0/1cde0b01b827d2cf4cb11db962f3958b9175d5d9e7ac7361d1a7b0e2dc6069a263e69118bd974c4f6d0a890ef4eedfe34cf3d5167ec14203dbc9a18620537054 + languageName: node + linkType: hard + "workerpool@npm:^6.5.1": version: 6.5.1 resolution: "workerpool@npm:6.5.1"