From be4eee8531e63c34ca84c095de0db73d49077243 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 25 Aug 2023 10:04:56 +0200 Subject: [PATCH 01/18] wip --- analysis/src/Commands.ml | 8 + analysis/src/CompletionFrontEndNew.ml | 409 ++++++++++++++++++ analysis/src/Completions.ml | 29 ++ analysis/src/Utils.ml | 20 + analysis/tests/src/CompletionNew.res | 37 ++ .../tests/src/expected/CompletionNew.res.txt | 54 +++ 6 files changed, 557 insertions(+) create mode 100644 analysis/src/CompletionFrontEndNew.ml create mode 100644 analysis/tests/src/CompletionNew.res create mode 100644 analysis/tests/src/expected/CompletionNew.res.txt diff --git a/analysis/src/Commands.ml b/analysis/src/Commands.ml index c46225fa0..df1ebbe7c 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -316,6 +316,14 @@ let test ~path = let currentFile = createCurrentFile () in completion ~debug:true ~path ~pos:(line, col) ~currentFile; Sys.remove currentFile + | "co2" -> + print_endline + ("Complete2 " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col); + let currentFile = createCurrentFile () in + Completions.getCompletions2 ~forHover:false ~debug:true ~path + ~pos:(line, col) ~currentFile; + Sys.remove currentFile | "dce" -> print_endline ("DCE " ^ path); Reanalyze.RunConfig.runConfig.suppress <- ["src"]; diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml new file mode 100644 index 000000000..098364d1c --- /dev/null +++ b/analysis/src/CompletionFrontEndNew.ml @@ -0,0 +1,409 @@ +open SharedTypes + +module PositionContext = struct + type t = { + offset: int; (** The offset *) + cursor: Pos.t; (** The actual position of the cursor *) + beforeCursor: Pos.t; (** The position just before the cursor *) + noWhitespace: Pos.t; + (** The position of the cursor, removing any whitespace _before_ it *) + firstCharBeforeNoWhitespace: char option; + (** The first character before the cursor, excluding any whitespace *) + charBeforeCursor: char option; + (** The char before the cursor, not excluding whitespace *) + whitespaceAfterCursor: char option; + (** The type of whitespace after the cursor, if any *) + } + + let make ~offset ~posCursor text = + let offsetNoWhite = Utils.skipWhite text (offset - 1) in + let posNoWhite = + let line, col = posCursor in + (line, max 0 col - offset + offsetNoWhite) + in + let firstCharBeforeCursorNoWhite = + if offsetNoWhite < String.length text && offsetNoWhite >= 0 then + Some text.[offsetNoWhite] + else None + in + let posBeforeCursor = Pos.posBeforeCursor posCursor in + let charBeforeCursor, whitespaceAfterCursor = + match Pos.positionToOffset text posCursor with + | Some offset when offset > 0 -> ( + let charBeforeCursor = text.[offset - 1] in + let charAtCursor = + if offset < String.length text then text.[offset] else '\n' + in + match charAtCursor with + | ' ' | '\t' | '\r' | '\n' -> + (Some charBeforeCursor, Some charBeforeCursor) + | _ -> (Some charBeforeCursor, None)) + | _ -> (None, None) + in + { + offset; + beforeCursor = posBeforeCursor; + noWhitespace = posNoWhite; + firstCharBeforeNoWhitespace = firstCharBeforeCursorNoWhite; + cursor = posCursor; + charBeforeCursor; + whitespaceAfterCursor; + } +end + +type completionCategory = Type | Value | Module | Field + +type ctxPath = + | CId of string list * completionCategory + (** A regular id of an expected category. `let fff = thisIsAnId` and `let fff = SomePath.alsoAnId` *) + | CVariantPayload of {itemNum: int} + (** A variant payload. `Some()` = itemNum 0, `Whatever(true, f)` = itemNum 1*) + | CRecordField of {seenFields: string list; prefix: string} + (** A record field. `let f = {on: true, s}` seenFields = [on], prefix = "s",*) + +let ctxPathToString (ctxPath : ctxPath) = + match ctxPath with + | CId (prefix, typ) -> + Printf.sprintf "CId(%s)=%s" + (match typ with + | Value -> "Value" + | Type -> "Type" + | Module -> "Module" + | Field -> "Field") + (ident prefix) + | CVariantPayload {itemNum} -> Printf.sprintf "CVariantPayload($%i)" itemNum + | CRecordField {prefix} -> Printf.sprintf "CRecordField=%s" prefix + +type currentlyExpecting = Type of Parsetree.core_type + +type completionTypes = + | CId of string list * completionCategory + | CType of { + pathToType: Parsetree.core_type; + prefix: string; (** What is already written, if anything *) + } + | CtxPath of ctxPath list + +type completionContext = { + positionContext: PositionContext.t; + scope: Scope.t; + currentlyExpecting: currentlyExpecting list; + ctxPath: ctxPath list; +} + +type completionResult = (completionTypes * completionContext) option + +let findCurrentlyLookingForInPattern (pat : Parsetree.pattern) = + match pat.ppat_desc with + | Ppat_constraint (_pat, typ) -> Some (Type typ) + | _ -> None + +let mergeCurrentlyLookingFor (currentlyExpecting : currentlyExpecting option) + list = + match currentlyExpecting with + | None -> list + | Some currentlyExpecting -> currentlyExpecting :: list + +let contextWithNewScope scope context = {context with scope} + +let flattenLidCheckDot ?(jsx = true) ~(completionContext : completionContext) + (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 completionContext.positionContext.whitespaceAfterCursor with + | Some '.' -> + if fst completionContext.positionContext.beforeCursor = fst idStart then + Some (snd completionContext.positionContext.beforeCursor - snd idStart) + else None + | _ -> None + in + Utils.flattenLongIdent ~cutAtOffset ~jsx lid.txt + +(** Scopes *) +let rec scopePattern ~scope (pat : Parsetree.pattern) = + match pat.ppat_desc with + | Ppat_any -> scope + | Ppat_var {txt; loc} -> scope |> Scope.addValue ~name:txt ~loc + | Ppat_alias (p, asA) -> + let scope = scopePattern p ~scope in + scope |> Scope.addValue ~name:asA.txt ~loc:asA.loc + | Ppat_constant _ | Ppat_interval _ -> scope + | Ppat_tuple pl -> + pl |> List.map (fun p -> scopePattern p ~scope) |> List.concat + | Ppat_construct (_, None) -> scope + | Ppat_construct (_, Some {ppat_desc = Ppat_tuple pl}) -> + pl |> List.map (fun p -> scopePattern p ~scope) |> List.concat + | Ppat_construct (_, Some p) -> scopePattern ~scope p + | Ppat_variant (_, None) -> scope + | Ppat_variant (_, Some {ppat_desc = Ppat_tuple pl}) -> + pl |> List.map (fun p -> scopePattern p ~scope) |> List.concat + | Ppat_variant (_, Some p) -> scopePattern ~scope p + | Ppat_record (fields, _) -> + fields + |> List.map (fun (fname, p) -> + match fname with + | {Location.txt = Longident.Lident _fname} -> scopePattern ~scope p + | _ -> []) + |> List.concat + | Ppat_array pl -> + pl + |> List.map (fun (p : Parsetree.pattern) -> scopePattern ~scope p) + |> List.concat + | Ppat_or (p1, _) -> scopePattern ~scope p1 + | Ppat_constraint (p, _coreType) -> scopePattern ~scope p + | Ppat_type _ -> scope + | Ppat_lazy p -> scopePattern ~scope p + | Ppat_unpack {txt; loc} -> scope |> Scope.addValue ~name:txt ~loc + | Ppat_exception p -> scopePattern ~scope p + | Ppat_extension _ -> scope + | Ppat_open (_, p) -> scopePattern ~scope p + +let scopeValueBinding ~scope (vb : Parsetree.value_binding) = + scopePattern ~scope vb.pvb_pat + +let scopeTypeKind ~scope (tk : Parsetree.type_kind) = + match tk with + | Ptype_variant constrDecls -> + constrDecls + |> List.map (fun (cd : Parsetree.constructor_declaration) -> + scope |> Scope.addConstructor ~name:cd.pcd_name.txt ~loc:cd.pcd_loc) + |> List.concat + | Ptype_record labelDecls -> + labelDecls + |> List.map (fun (ld : Parsetree.label_declaration) -> + scope |> Scope.addField ~name:ld.pld_name.txt ~loc:ld.pld_loc) + |> List.concat + | _ -> scope + +let scopeTypeDeclaration ~scope (td : Parsetree.type_declaration) = + let scope = + scope |> Scope.addType ~name:td.ptype_name.txt ~loc:td.ptype_name.loc + in + scopeTypeKind ~scope td.ptype_kind + +let scopeModuleBinding ~scope (mb : Parsetree.module_binding) = + scope |> Scope.addModule ~name:mb.pmb_name.txt ~loc:mb.pmb_name.loc + +let scopeModuleDeclaration ~scope (md : Parsetree.module_declaration) = + scope |> Scope.addModule ~name:md.pmd_name.txt ~loc:md.pmd_name.loc + +let rec completeFromStructure ~completionContext + (structure : Parsetree.structure) : completionResult = + (* TODO: Scope? *) + structure + |> Utils.findMap (fun (item : Parsetree.structure_item) -> + completeStructureItem ~completionContext item) + +and completeStructureItem ~completionContext (item : Parsetree.structure_item) : + completionResult = + match item.pstr_desc with + | Pstr_value (recFlag, valueBindings) -> + let scopeFromBindings = + valueBindings + |> List.map (fun (vb : Parsetree.value_binding) -> + scopeValueBinding vb ~scope:completionContext.scope) + |> List.concat + in + if + item.pstr_loc + |> CursorPosition.classifyLoc + ~pos:completionContext.positionContext.beforeCursor + = HasCursor + then + valueBindings + |> Utils.findMap (fun (vb : Parsetree.value_binding) -> + (* TODO: This will create duplicate scope entries for the current binding. Does it matter? *) + completeValueBinding + ~completionContext: + (if recFlag = Recursive then + completionContext |> contextWithNewScope scopeFromBindings + else completionContext) + vb) + else None + | Pstr_eval _ | Pstr_primitive _ | Pstr_type _ | Pstr_typext _ + | Pstr_exception _ | Pstr_module _ | Pstr_recmodule _ | Pstr_modtype _ + | Pstr_open _ | Pstr_include _ | Pstr_attribute _ | Pstr_extension _ -> + None + | Pstr_class _ | Pstr_class_type _ -> + (* These aren't relevant for ReScript *) None + +and completeValueBinding ~completionContext (vb : Parsetree.value_binding) : + completionResult = + let scopeWithPattern = + scopePattern ~scope:completionContext.scope vb.pvb_pat + in + if + vb.pvb_pat.ppat_loc + |> CursorPosition.classifyLoc + ~pos:completionContext.positionContext.beforeCursor + = HasCursor + then ( + print_endline "complete pattern"; + None) + else if + vb.pvb_expr.pexp_loc + |> CursorPosition.classifyLoc + ~pos:completionContext.positionContext.beforeCursor + = HasCursor + then ( + print_endline "completing expression"; + let currentlyExpecting = findCurrentlyLookingForInPattern vb.pvb_pat in + completeExpr + ~completionContext: + { + completionContext with + scope = scopeWithPattern; + currentlyExpecting = + mergeCurrentlyLookingFor currentlyExpecting + completionContext.currentlyExpecting; + } + vb.pvb_expr) + else None + +and completeExpr ~completionContext (expr : Parsetree.expression) : + completionResult = + let locHasPos loc = + loc + |> CursorPosition.locHasCursor + ~pos:completionContext.positionContext.beforeCursor + in + match expr.pexp_desc with + | Pexp_ident lid -> + (* An identifier, like `aaa` *) + let lidPath = flattenLidCheckDot lid ~completionContext in + if lid.loc |> locHasPos then Some (CId (lidPath, Value), completionContext) + else None + | Pexp_construct (_id, Some {pexp_desc = Pexp_tuple args; pexp_loc}) + when pexp_loc |> locHasPos -> + (* A constructor with multiple payloads, like: `Co(true, false)` or `Somepath.Co(false, true)` *) + args + |> Utils.findMapWithIndex (fun itemNum (e : Parsetree.expression) -> + completeExpr + ~completionContext: + { + completionContext with + ctxPath = + CVariantPayload {itemNum} :: completionContext.ctxPath; + } + e) + | Pexp_construct (_id, Some payloadExpr) + when payloadExpr.pexp_loc |> locHasPos -> + (* A constructor with a single payload, like: `Co(true)` or `Somepath.Co(false)` *) + completeExpr + ~completionContext: + { + completionContext with + ctxPath = CVariantPayload {itemNum = 0} :: completionContext.ctxPath; + } + payloadExpr + | Pexp_construct ({txt = Lident txt; loc}, _) when loc |> locHasPos -> ( + (* A constructor, like: `Co` *) + match completionContext.currentlyExpecting with + | _ -> Some (CId ([txt], Module), completionContext)) + | Pexp_construct (id, _) when id.loc |> locHasPos -> + (* A path, like: `Something.Co` *) + let lid = flattenLidCheckDot ~completionContext id in + Some (CId (lid, Module), completionContext) + | Pexp_record ([], _) when expr.pexp_loc |> locHasPos -> + (* No fields means we're in a record body `{}` *) + Some + ( CtxPath + (CRecordField {prefix = ""; seenFields = []} + :: completionContext.ctxPath), + completionContext (* TODO: This isn't correct *) ) + | Pexp_record (fields, _) when expr.pexp_loc |> locHasPos -> + (* A record with fields *) + let seenFields = + fields + |> List.map (fun (fieldName, _f) -> Longident.last fieldName.Location.txt) + in + fields + |> Utils.findMap + (fun + ((fieldName, fieldExpr) : + Longident.t Location.loc * Parsetree.expression) + -> + (* Complete regular idents *) + if locHasPos fieldName.loc then + (* Cursor in field name, complete here *) + match fieldName with + | {txt = Lident prefix} -> + Some + ( CtxPath + (CRecordField {prefix; seenFields} + :: completionContext.ctxPath), + completionContext (* TODO: This isn't correct *) ) + | fieldName -> + Some + ( CId (flattenLidCheckDot ~completionContext fieldName, Value), + completionContext ) + else if locHasPos fieldExpr.pexp_loc then + completeExpr + ~completionContext: + { + completionContext with + ctxPath = + CRecordField + {prefix = fieldName.txt |> Longident.last; seenFields} + :: completionContext.ctxPath; + } + fieldExpr + else None) + | Pexp_match _ | Pexp_unreachable | Pexp_constant _ + | Pexp_let (_, _, _) + | Pexp_function _ + | Pexp_fun (_, _, _, _) + | Pexp_apply (_, _) + | Pexp_try (_, _) + | Pexp_tuple _ + | Pexp_construct (_, _) + | Pexp_variant (_, _) + | Pexp_record (_, _) + | Pexp_field (_, _) + | Pexp_setfield (_, _, _) + | Pexp_array _ + | Pexp_ifthenelse (_, _, _) + | Pexp_sequence (_, _) + | Pexp_while (_, _) + | Pexp_for (_, _, _, _, _) + | Pexp_constraint (_, _) + | Pexp_coerce (_, _, _) + | Pexp_send (_, _) + | Pexp_new _ + | Pexp_setinstvar (_, _) + | Pexp_override _ + | Pexp_letmodule (_, _, _) + | Pexp_letexception (_, _) + | Pexp_assert _ | Pexp_lazy _ + | Pexp_poly (_, _) + | Pexp_object _ + | Pexp_newtype (_, _) + | Pexp_pack _ + | Pexp_open (_, _, _) + | Pexp_extension _ -> + None + +let completion ~currentFile ~path ~debug ~offset ~posCursor text = + let positionContext = PositionContext.make ~offset ~posCursor text in + let completionContext : completionContext = + { + positionContext; + scope = Scope.create (); + currentlyExpecting = []; + ctxPath = []; + } + in + if Filename.check_suffix path ".res" then + let parser = + Res_driver.parsingEngine.parseImplementation ~forPrinter:false + in + let {Res_driver.parsetree = str} = parser ~filename:currentFile in + str |> completeFromStructure ~completionContext + else if Filename.check_suffix path ".resi" then + let parser = Res_driver.parsingEngine.parseInterface ~forPrinter:false in + let {Res_driver.parsetree = signature} = parser ~filename:currentFile in + None + else None diff --git a/analysis/src/Completions.ml b/analysis/src/Completions.ml index 42176bb3b..e54be708e 100644 --- a/analysis/src/Completions.ml +++ b/analysis/src/Completions.ml @@ -20,3 +20,32 @@ let getCompletions ~debug ~path ~pos ~currentFile ~forHover = ~forHover in Some (completables, full, scope))) + +let getCompletions2 ~debug ~path ~pos ~currentFile ~forHover = + let textOpt = Files.readFile currentFile in + match textOpt with + | None | Some "" -> () + | Some text -> ( + match Pos.positionToOffset text pos with + | None -> () + | Some offset -> ( + match + CompletionFrontEndNew.completion ~offset ~debug ~path ~posCursor:pos + ~currentFile text + with + | None -> print_endline "No completions" + | Some (res, ctx) -> + Printf.printf "Result: %s\n" + (match res with + | CId (path, _ctx) -> "CId " ^ SharedTypes.ident path + | CtxPath ctxPath -> + "CtxPath: " + ^ (ctxPath |> List.rev + |> List.map CompletionFrontEndNew.ctxPathToString + |> String.concat "->") + | CType {prefix} -> "CType: =" ^ prefix); + Printf.printf "Scope: %i items\n" (List.length ctx.scope); + Printf.printf "CtxPath: %s\n" + (ctx.ctxPath |> List.rev + |> List.map CompletionFrontEndNew.ctxPathToString + |> String.concat "->"))) diff --git a/analysis/src/Utils.ml b/analysis/src/Utils.ml index e548457f2..5078d8b7d 100644 --- a/analysis/src/Utils.ml +++ b/analysis/src/Utils.ml @@ -216,3 +216,23 @@ let rec lastElements list = let lowercaseFirstChar s = if String.length s = 0 then s else String.mapi (fun i c -> if i = 0 then Char.lowercase_ascii c else c) s + +let findMap f lst = + let rec aux f = function + | [] -> None + | x :: xs -> ( + match f x with + | None -> aux f xs + | Some _ as result -> result) + in + aux f lst + +let findMapWithIndex f lst = + let rec aux f index = function + | [] -> None + | x :: xs -> ( + match f index x with + | None -> aux f (index + 1) xs + | Some _ as result -> result) + in + aux f 0 lst diff --git a/analysis/tests/src/CompletionNew.res b/analysis/tests/src/CompletionNew.res new file mode 100644 index 000000000..b2f49aaf2 --- /dev/null +++ b/analysis/tests/src/CompletionNew.res @@ -0,0 +1,37 @@ +let myVar = true + +// let myFunc = m +// ^co2 + +type rec someVariant = One | Two | Three(bool, option) + +// let myFunc: someVariant = O +// ^co2 + +// let myFunc: someVariant = Three(t) +// ^co2 + +// let myFunc: someVariant = Three(true, S) +// ^co2 + +// let myFunc: someVariant = Three(true, Some(O)) +// ^co2 + +type nestedRecord = { + on: bool, + off?: bool, +} + +type someRecord = {nested: option, variant: someVariant} + +// let myFunc: someRecord = {} +// ^co2 + +// let myFunc: someRecord = {n} +// ^co2 + +// let myFunc: someRecord = {variant: O} +// ^co2 + +// let myFunc: someRecord = {nested: {}} +// ^co2 diff --git a/analysis/tests/src/expected/CompletionNew.res.txt b/analysis/tests/src/expected/CompletionNew.res.txt new file mode 100644 index 000000000..161b59855 --- /dev/null +++ b/analysis/tests/src/expected/CompletionNew.res.txt @@ -0,0 +1,54 @@ +Complete2 src/CompletionNew.res 2:17 +completing expression +Result: CId m +Scope: 1 items +CtxPath: + +Complete2 src/CompletionNew.res 7:30 +completing expression +Result: CId O +Scope: 1 items +CtxPath: + +Complete2 src/CompletionNew.res 10:36 +completing expression +Result: CId t +Scope: 1 items +CtxPath: CVariantPayload($0) + +Complete2 src/CompletionNew.res 13:42 +completing expression +Result: CId S +Scope: 1 items +CtxPath: CVariantPayload($1) + +Complete2 src/CompletionNew.res 16:47 +completing expression +Result: CId O +Scope: 1 items +CtxPath: CVariantPayload($1)->CVariantPayload($0) + +Complete2 src/CompletionNew.res 26:29 +completing expression +Result: CtxPath: CRecordField= +Scope: 1 items +CtxPath: + +Complete2 src/CompletionNew.res 29:30 +completing expression +Result: CId n +Scope: 1 items +CtxPath: + +Complete2 src/CompletionNew.res 32:39 +completing expression +Result: CId O +Scope: 1 items +CtxPath: CRecordField=variant + +Complete2 src/CompletionNew.res 35:38 +completing expression +Result: CtxPath: CRecordField=nested->CRecordField= +Scope: 1 items +CtxPath: CRecordField=nested + From fdaa98fcbe20781183d937439200efe9d3ec7208 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 25 Aug 2023 18:50:17 +0200 Subject: [PATCH 02/18] wip --- analysis/src/CompletionFrontEndNew.ml | 209 ++++++++++++------ analysis/src/Completions.ml | 22 +- analysis/tests/src/CompletionNew.res | 14 +- .../tests/src/expected/CompletionNew.res.txt | 62 ++++-- 4 files changed, 199 insertions(+), 108 deletions(-) diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml index 098364d1c..b155776e4 100644 --- a/analysis/src/CompletionFrontEndNew.ml +++ b/analysis/src/CompletionFrontEndNew.ml @@ -7,7 +7,7 @@ module PositionContext = struct beforeCursor: Pos.t; (** The position just before the cursor *) noWhitespace: Pos.t; (** The position of the cursor, removing any whitespace _before_ it *) - firstCharBeforeNoWhitespace: char option; + charBeforeNoWhitespace: char option; (** The first character before the cursor, excluding any whitespace *) charBeforeCursor: char option; (** The char before the cursor, not excluding whitespace *) @@ -44,7 +44,7 @@ module PositionContext = struct offset; beforeCursor = posBeforeCursor; noWhitespace = posNoWhite; - firstCharBeforeNoWhitespace = firstCharBeforeCursorNoWhite; + charBeforeNoWhitespace = firstCharBeforeCursorNoWhite; cursor = posCursor; charBeforeCursor; whitespaceAfterCursor; @@ -60,8 +60,10 @@ type ctxPath = (** A variant payload. `Some()` = itemNum 0, `Whatever(true, f)` = itemNum 1*) | CRecordField of {seenFields: string list; prefix: string} (** A record field. `let f = {on: true, s}` seenFields = [on], prefix = "s",*) + | COption of ctxPath (** An option with an inner type. *) + | CArray of ctxPath option (** An array with an inner type. *) -let ctxPathToString (ctxPath : ctxPath) = +let rec ctxPathToString (ctxPath : ctxPath) = match ctxPath with | CId (prefix, typ) -> Printf.sprintf "CId(%s)=%s" @@ -73,16 +75,18 @@ let ctxPathToString (ctxPath : ctxPath) = (ident prefix) | CVariantPayload {itemNum} -> Printf.sprintf "CVariantPayload($%i)" itemNum | CRecordField {prefix} -> Printf.sprintf "CRecordField=%s" prefix + | COption ctxPath -> Printf.sprintf "COption<%s>" (ctxPathToString ctxPath) + | CArray ctxPath -> + Printf.sprintf "CArray%s" + (match ctxPath with + | None -> "" + | Some ctxPath -> "[" ^ ctxPathToString ctxPath ^ "]") -type currentlyExpecting = Type of Parsetree.core_type +type currentlyExpecting = Type of ctxPath -type completionTypes = - | CId of string list * completionCategory - | CType of { - pathToType: Parsetree.core_type; - prefix: string; (** What is already written, if anything *) - } - | CtxPath of ctxPath list +let currentlyExpectingToString (c : currentlyExpecting) = + match c with + | Type ctxPath -> Printf.sprintf "Type<%s>" (ctxPathToString ctxPath) type completionContext = { positionContext: PositionContext.t; @@ -91,20 +95,7 @@ type completionContext = { ctxPath: ctxPath list; } -type completionResult = (completionTypes * completionContext) option - -let findCurrentlyLookingForInPattern (pat : Parsetree.pattern) = - match pat.ppat_desc with - | Ppat_constraint (_pat, typ) -> Some (Type typ) - | _ -> None - -let mergeCurrentlyLookingFor (currentlyExpecting : currentlyExpecting option) - list = - match currentlyExpecting with - | None -> list - | Some currentlyExpecting -> currentlyExpecting :: list - -let contextWithNewScope scope context = {context with scope} +type completionResult = (ctxPath list * completionContext) option let flattenLidCheckDot ?(jsx = true) ~(completionContext : completionContext) (lid : Longident.t Location.loc) = @@ -122,6 +113,36 @@ let flattenLidCheckDot ?(jsx = true) ~(completionContext : completionContext) in Utils.flattenLongIdent ~cutAtOffset ~jsx lid.txt +let rec ctxPathFromCoreType ~completionContext (coreType : Parsetree.core_type) + = + match coreType.ptyp_desc with + | Ptyp_constr ({txt = Lident "option"}, [innerTyp]) -> + innerTyp + |> ctxPathFromCoreType ~completionContext + |> Option.map (fun innerTyp -> COption innerTyp) + | Ptyp_constr ({txt = Lident "array"}, [innerTyp]) -> + Some (CArray (innerTyp |> ctxPathFromCoreType ~completionContext)) + | Ptyp_constr (lid, _) -> + Some (CId (lid |> flattenLidCheckDot ~completionContext, Type)) + | _ -> None + +let findCurrentlyLookingForInPattern ~completionContext + (pat : Parsetree.pattern) = + match pat.ppat_desc with + | Ppat_constraint (_pat, typ) -> ( + match ctxPathFromCoreType ~completionContext typ with + | None -> None + | Some ctxPath -> Some (Type ctxPath)) + | _ -> None + +let mergeCurrentlyLookingFor (currentlyExpecting : currentlyExpecting option) + list = + match currentlyExpecting with + | None -> list + | Some currentlyExpecting -> currentlyExpecting :: list + +let contextWithNewScope scope context = {context with scope} + (** Scopes *) let rec scopePattern ~scope (pat : Parsetree.pattern) = match pat.ppat_desc with @@ -250,7 +271,9 @@ and completeValueBinding ~completionContext (vb : Parsetree.value_binding) : = HasCursor then ( print_endline "completing expression"; - let currentlyExpecting = findCurrentlyLookingForInPattern vb.pvb_pat in + let currentlyExpecting = + findCurrentlyLookingForInPattern ~completionContext vb.pvb_pat + in completeExpr ~completionContext: { @@ -271,11 +294,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : ~pos:completionContext.positionContext.beforeCursor in match expr.pexp_desc with - | Pexp_ident lid -> - (* An identifier, like `aaa` *) - let lidPath = flattenLidCheckDot lid ~completionContext in - if lid.loc |> locHasPos then Some (CId (lidPath, Value), completionContext) - else None + (* == VARIANTS == *) | Pexp_construct (_id, Some {pexp_desc = Pexp_tuple args; pexp_loc}) when pexp_loc |> locHasPos -> (* A constructor with multiple payloads, like: `Co(true, false)` or `Somepath.Co(false, true)` *) @@ -302,56 +321,105 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : | Pexp_construct ({txt = Lident txt; loc}, _) when loc |> locHasPos -> ( (* A constructor, like: `Co` *) match completionContext.currentlyExpecting with - | _ -> Some (CId ([txt], Module), completionContext)) + | _ -> + Some (CId ([txt], Module) :: completionContext.ctxPath, completionContext) + ) | Pexp_construct (id, _) when id.loc |> locHasPos -> (* A path, like: `Something.Co` *) let lid = flattenLidCheckDot ~completionContext id in - Some (CId (lid, Module), completionContext) + Some (CId (lid, Module) :: completionContext.ctxPath, completionContext) + (* == RECORDS == *) + | Pexp_ident {txt = Lident prefix} when Utils.hasBraces expr.pexp_attributes + -> + (* An ident with braces attribute corresponds to for example `{n}`. + Looks like a record but is parsed as an ident with braces. *) + let prefix = if prefix = "()" then "" else prefix in + Some + ( CRecordField {prefix; seenFields = []} :: completionContext.ctxPath, + completionContext (* TODO: This isn't correct *) ) | Pexp_record ([], _) when expr.pexp_loc |> locHasPos -> (* No fields means we're in a record body `{}` *) Some - ( CtxPath - (CRecordField {prefix = ""; seenFields = []} - :: completionContext.ctxPath), + ( CRecordField {prefix = ""; seenFields = []} :: completionContext.ctxPath, completionContext (* TODO: This isn't correct *) ) - | Pexp_record (fields, _) when expr.pexp_loc |> locHasPos -> + | Pexp_record (fields, _) when expr.pexp_loc |> locHasPos -> ( (* A record with fields *) let seenFields = fields |> List.map (fun (fieldName, _f) -> Longident.last fieldName.Location.txt) in - fields - |> Utils.findMap - (fun - ((fieldName, fieldExpr) : - Longident.t Location.loc * Parsetree.expression) - -> - (* Complete regular idents *) - if locHasPos fieldName.loc then - (* Cursor in field name, complete here *) - match fieldName with - | {txt = Lident prefix} -> - Some - ( CtxPath - (CRecordField {prefix; seenFields} - :: completionContext.ctxPath), - completionContext (* TODO: This isn't correct *) ) - | fieldName -> - Some - ( CId (flattenLidCheckDot ~completionContext fieldName, Value), - completionContext ) - else if locHasPos fieldExpr.pexp_loc then - completeExpr - ~completionContext: - { - completionContext with - ctxPath = - CRecordField - {prefix = fieldName.txt |> Longident.last; seenFields} - :: completionContext.ctxPath; - } - fieldExpr - else None) + let fieldToComplete = + fields + |> Utils.findMap + (fun + ((fieldName, fieldExpr) : + Longident.t Location.loc * Parsetree.expression) + -> + (* Complete regular idents *) + if locHasPos fieldName.loc then + (* Cursor in field name, complete here *) + match fieldName with + | {txt = Lident prefix} -> + Some + ( CRecordField {prefix; seenFields} + :: completionContext.ctxPath, + completionContext (* TODO: This isn't correct *) ) + | fieldName -> + Some + ( CId (flattenLidCheckDot ~completionContext fieldName, Value) + :: completionContext.ctxPath, + completionContext ) + else if locHasPos fieldExpr.pexp_loc then + completeExpr + ~completionContext: + { + completionContext with + ctxPath = + CRecordField + {prefix = fieldName.txt |> Longident.last; seenFields} + :: completionContext.ctxPath; + } + fieldExpr + else None) + in + match fieldToComplete with + | None -> ( + (* Check if there's a expr hole with an empty cursor for a field. This means completing for an empty field `{someField: }`. *) + let fieldNameWithExprHole = + fields + |> Utils.findMap (fun (fieldName, fieldExpr) -> + if + CompletionExpressions.isExprHole fieldExpr + && CursorPosition.classifyLoc fieldExpr.pexp_loc + ~pos:completionContext.positionContext.beforeCursor + = EmptyLoc + then Some (Longident.last fieldName.Location.txt) + else None) + in + (* We found no field to complete, but we know the cursor is inside this record body. + Check if the char to the left of the cursor is ',', if so, complete for record fields.*) + match + ( fieldNameWithExprHole, + completionContext.positionContext.charBeforeNoWhitespace ) + with + | Some fieldName, _ -> + Some + ( CRecordField {prefix = fieldName; seenFields} + :: completionContext.ctxPath, + completionContext (* TODO: This isn't correct *) ) + | None, Some ',' -> + Some + ( CRecordField {prefix = ""; seenFields} :: completionContext.ctxPath, + completionContext (* TODO: This isn't correct *) ) + | _ -> None) + | fieldToComplete -> fieldToComplete) + (* == IDENTS == *) + | Pexp_ident lid -> + (* An identifier, like `aaa` *) + let lidPath = flattenLidCheckDot lid ~completionContext in + if lid.loc |> locHasPos then + Some (CId (lidPath, Value) :: completionContext.ctxPath, completionContext) + else None | Pexp_match _ | Pexp_unreachable | Pexp_constant _ | Pexp_let (_, _, _) | Pexp_function _ @@ -372,19 +440,18 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : | Pexp_constraint (_, _) | Pexp_coerce (_, _, _) | Pexp_send (_, _) - | Pexp_new _ | Pexp_setinstvar (_, _) | Pexp_override _ | Pexp_letmodule (_, _, _) | Pexp_letexception (_, _) | Pexp_assert _ | Pexp_lazy _ | Pexp_poly (_, _) - | Pexp_object _ | Pexp_newtype (_, _) | Pexp_pack _ | Pexp_open (_, _, _) | Pexp_extension _ -> None + | Pexp_object _ | Pexp_new _ -> (* These are irrelevant to ReScript *) None let completion ~currentFile ~path ~debug ~offset ~posCursor text = let positionContext = PositionContext.make ~offset ~posCursor text in diff --git a/analysis/src/Completions.ml b/analysis/src/Completions.ml index e54be708e..4dd4d9d8f 100644 --- a/analysis/src/Completions.ml +++ b/analysis/src/Completions.ml @@ -34,18 +34,14 @@ let getCompletions2 ~debug ~path ~pos ~currentFile ~forHover = ~currentFile text with | None -> print_endline "No completions" - | Some (res, ctx) -> + | Some (ctxPath, ctx) -> Printf.printf "Result: %s\n" - (match res with - | CId (path, _ctx) -> "CId " ^ SharedTypes.ident path - | CtxPath ctxPath -> - "CtxPath: " - ^ (ctxPath |> List.rev - |> List.map CompletionFrontEndNew.ctxPathToString - |> String.concat "->") - | CType {prefix} -> "CType: =" ^ prefix); - Printf.printf "Scope: %i items\n" (List.length ctx.scope); - Printf.printf "CtxPath: %s\n" - (ctx.ctxPath |> List.rev + (ctxPath |> List.rev |> List.map CompletionFrontEndNew.ctxPathToString - |> String.concat "->"))) + |> String.concat "->"); + Printf.printf "Scope: %i items\n" (List.length ctx.scope); + Printf.printf "Looking for type: %s\n" + (match ctx.currentlyExpecting with + | currentlyExpecting :: _ -> + CompletionFrontEndNew.currentlyExpectingToString currentlyExpecting + | _ -> ""))) diff --git a/analysis/tests/src/CompletionNew.res b/analysis/tests/src/CompletionNew.res index b2f49aaf2..638139415 100644 --- a/analysis/tests/src/CompletionNew.res +++ b/analysis/tests/src/CompletionNew.res @@ -20,6 +20,7 @@ type rec someVariant = One | Two | Three(bool, option) type nestedRecord = { on: bool, off?: bool, + maybeVariant?: someVariant, } type someRecord = {nested: option, variant: someVariant} @@ -33,5 +34,14 @@ type someRecord = {nested: option, variant: someVariant} // let myFunc: someRecord = {variant: O} // ^co2 -// let myFunc: someRecord = {nested: {}} -// ^co2 +// let myFunc: someRecord = {nested: {maybeVariant: Three(false, t)}} +// ^co2 + +// let myFunc: someRecord = {nested: {maybeVariant: One}, variant: } +// ^co2 + +// let myFunc: someRecord = {nested: {maybeVariant: One, }} +// ^co2 + +// let myFunc: someRecord = {nested: {maybeVariant: One}, } +// ^co2 diff --git a/analysis/tests/src/expected/CompletionNew.res.txt b/analysis/tests/src/expected/CompletionNew.res.txt index 161b59855..6c2b5e715 100644 --- a/analysis/tests/src/expected/CompletionNew.res.txt +++ b/analysis/tests/src/expected/CompletionNew.res.txt @@ -1,54 +1,72 @@ Complete2 src/CompletionNew.res 2:17 completing expression -Result: CId m +Result: CId(Value)=m Scope: 1 items -CtxPath: +Looking for type: Complete2 src/CompletionNew.res 7:30 completing expression -Result: CId O +Result: CId(Module)=O Scope: 1 items -CtxPath: +Looking for type: Type Complete2 src/CompletionNew.res 10:36 completing expression -Result: CId t +Result: CVariantPayload($0)->CId(Value)=t Scope: 1 items -CtxPath: CVariantPayload($0) +Looking for type: Type Complete2 src/CompletionNew.res 13:42 completing expression -Result: CId S +Result: CVariantPayload($1)->CId(Module)=S Scope: 1 items -CtxPath: CVariantPayload($1) +Looking for type: Type Complete2 src/CompletionNew.res 16:47 completing expression -Result: CId O +Result: CVariantPayload($1)->CVariantPayload($0)->CId(Module)=O Scope: 1 items -CtxPath: CVariantPayload($1)->CVariantPayload($0) +Looking for type: Type -Complete2 src/CompletionNew.res 26:29 +Complete2 src/CompletionNew.res 27:29 completing expression -Result: CtxPath: CRecordField= +Result: CRecordField= Scope: 1 items -CtxPath: +Looking for type: Type -Complete2 src/CompletionNew.res 29:30 +Complete2 src/CompletionNew.res 30:30 completing expression -Result: CId n +Result: CRecordField=n Scope: 1 items -CtxPath: +Looking for type: Type -Complete2 src/CompletionNew.res 32:39 +Complete2 src/CompletionNew.res 33:39 completing expression -Result: CId O +Result: CRecordField=variant->CId(Module)=O Scope: 1 items -CtxPath: CRecordField=variant +Looking for type: Type -Complete2 src/CompletionNew.res 35:38 +Complete2 src/CompletionNew.res 36:66 completing expression -Result: CtxPath: CRecordField=nested->CRecordField= +Result: CRecordField=nested->CRecordField=maybeVariant->CVariantPayload($1)->CId(Value)=t Scope: 1 items -CtxPath: CRecordField=nested +Looking for type: Type + +Complete2 src/CompletionNew.res 39:66 +completing expression +Result: CRecordField=variant +Scope: 1 items +Looking for type: Type + +Complete2 src/CompletionNew.res 42:56 +completing expression +Result: CRecordField=nested->CRecordField= +Scope: 1 items +Looking for type: Type + +Complete2 src/CompletionNew.res 45:57 +completing expression +Result: CRecordField= +Scope: 1 items +Looking for type: Type From 11c61e8804c0130bd056d0e776776f1148804070 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Sat, 26 Aug 2023 10:49:36 +0200 Subject: [PATCH 03/18] wip --- analysis/src/CompletionFrontEndNew.ml | 213 +++++++++++++++--- analysis/tests/src/CompletionNew.res | 27 +++ .../tests/src/expected/CompletionNew.res.txt | 47 +++- 3 files changed, 242 insertions(+), 45 deletions(-) diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml index b155776e4..8cdafa935 100644 --- a/analysis/src/CompletionFrontEndNew.ml +++ b/analysis/src/CompletionFrontEndNew.ml @@ -54,6 +54,7 @@ end type completionCategory = Type | Value | Module | Field type ctxPath = + | CUnknown (** Something that cannot be resolved right now *) | CId of string list * completionCategory (** A regular id of an expected category. `let fff = thisIsAnId` and `let fff = SomePath.alsoAnId` *) | CVariantPayload of {itemNum: int} @@ -62,9 +63,25 @@ type ctxPath = (** A record field. `let f = {on: true, s}` seenFields = [on], prefix = "s",*) | COption of ctxPath (** An option with an inner type. *) | CArray of ctxPath option (** An array with an inner type. *) + | CTuple of ctxPath list (** A tuple. *) + | CBool + | CString + | CInt + | CFloat + | CFunction of {returnType: ctxPath} (** A function *) let rec ctxPathToString (ctxPath : ctxPath) = match ctxPath with + | CUnknown -> "CUnknown" + | CBool -> "CBool" + | CFloat -> "CFloat" + | CInt -> "CInt" + | CString -> "CString" + | CFunction {returnType} -> + Printf.sprintf "CFunction () -> %s" (ctxPathToString returnType) + | CTuple ctxPaths -> + Printf.sprintf "CTuple(%s)" + (ctxPaths |> List.map ctxPathToString |> String.concat ", ") | CId (prefix, typ) -> Printf.sprintf "CId(%s)=%s" (match typ with @@ -82,22 +99,53 @@ let rec ctxPathToString (ctxPath : ctxPath) = | None -> "" | Some ctxPath -> "[" ^ ctxPathToString ctxPath ^ "]") -type currentlyExpecting = Type of ctxPath +type currentlyExpecting = + | Unit + | Type of ctxPath + | FunctionReturnType of ctxPath let currentlyExpectingToString (c : currentlyExpecting) = match c with + | Unit -> "Unit" | Type ctxPath -> Printf.sprintf "Type<%s>" (ctxPathToString ctxPath) + | FunctionReturnType ctxPath -> + Printf.sprintf "FunctionReturnType<%s>" (ctxPathToString ctxPath) -type completionContext = { - positionContext: PositionContext.t; - scope: Scope.t; - currentlyExpecting: currentlyExpecting list; - ctxPath: ctxPath list; -} +module CompletionContext = struct + type t = { + positionContext: PositionContext.t; + scope: Scope.t; + currentlyExpecting: currentlyExpecting list; + ctxPath: ctxPath list; + } + + let make positionContext = + { + positionContext; + scope = Scope.create (); + currentlyExpecting = []; + ctxPath = []; + } -type completionResult = (ctxPath list * completionContext) option + let withResetCtx completionContext = + {completionContext with currentlyExpecting = []; ctxPath = []} -let flattenLidCheckDot ?(jsx = true) ~(completionContext : completionContext) + let withScope scope completionContext = {completionContext with scope} + + let addCurrentlyExpecting currentlyExpecting completionContext = + { + completionContext with + currentlyExpecting = + currentlyExpecting :: completionContext.currentlyExpecting; + } + + let withResetCurrentlyExpecting completionContext = + {completionContext with currentlyExpecting = [Unit]} +end + +type completionResult = (ctxPath list * CompletionContext.t) option + +let flattenLidCheckDot ?(jsx = true) ~(completionContext : CompletionContext.t) (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. @@ -122,8 +170,31 @@ let rec ctxPathFromCoreType ~completionContext (coreType : Parsetree.core_type) |> Option.map (fun innerTyp -> COption innerTyp) | Ptyp_constr ({txt = Lident "array"}, [innerTyp]) -> Some (CArray (innerTyp |> ctxPathFromCoreType ~completionContext)) - | Ptyp_constr (lid, _) -> + | Ptyp_constr ({txt = Lident "bool"}, []) -> Some CBool + | Ptyp_constr ({txt = Lident "int"}, []) -> Some CInt + | Ptyp_constr ({txt = Lident "float"}, []) -> Some CFloat + | Ptyp_constr ({txt = Lident "string"}, []) -> Some CString + | Ptyp_constr (lid, []) -> Some (CId (lid |> flattenLidCheckDot ~completionContext, Type)) + | Ptyp_tuple types -> + let types = + types + |> List.map (fun (t : Parsetree.core_type) -> + match t |> ctxPathFromCoreType ~completionContext with + | None -> CUnknown + | Some ctxPath -> ctxPath) + in + Some (CTuple types) + | Ptyp_arrow _ -> ( + let rec loopFnTyp (ct : Parsetree.core_type) = + match ct.ptyp_desc with + | Ptyp_arrow (_arg, _argTyp, nextTyp) -> loopFnTyp nextTyp + | _ -> ct + in + let returnType = loopFnTyp coreType in + match ctxPathFromCoreType ~completionContext returnType with + | None -> None + | Some returnType -> Some (CFunction {returnType})) | _ -> None let findCurrentlyLookingForInPattern ~completionContext @@ -141,7 +212,16 @@ let mergeCurrentlyLookingFor (currentlyExpecting : currentlyExpecting option) | None -> list | Some currentlyExpecting -> currentlyExpecting :: list -let contextWithNewScope scope context = {context with scope} +let contextWithNewScope scope (context : CompletionContext.t) = + {context with scope} + +(* An expression with that's an expr hole and that has an empty cursor. TODO Explain *) +let checkIfExprHoleEmptyCursor ~(completionContext : CompletionContext.t) + (exp : Parsetree.expression) = + CompletionExpressions.isExprHole exp + && CursorPosition.classifyLoc exp.pexp_loc + ~pos:completionContext.positionContext.beforeCursor + = EmptyLoc (** Scopes *) let rec scopePattern ~scope (pat : Parsetree.pattern) = @@ -218,8 +298,8 @@ let rec completeFromStructure ~completionContext |> Utils.findMap (fun (item : Parsetree.structure_item) -> completeStructureItem ~completionContext item) -and completeStructureItem ~completionContext (item : Parsetree.structure_item) : - completionResult = +and completeStructureItem ~(completionContext : CompletionContext.t) + (item : Parsetree.structure_item) : completionResult = match item.pstr_desc with | Pstr_value (recFlag, valueBindings) -> let scopeFromBindings = @@ -240,7 +320,9 @@ and completeStructureItem ~completionContext (item : Parsetree.structure_item) : completeValueBinding ~completionContext: (if recFlag = Recursive then - completionContext |> contextWithNewScope scopeFromBindings + completionContext + |> contextWithNewScope scopeFromBindings + |> CompletionContext.withResetCtx else completionContext) vb) else None @@ -269,8 +351,7 @@ and completeValueBinding ~completionContext (vb : Parsetree.value_binding) : |> CursorPosition.classifyLoc ~pos:completionContext.positionContext.beforeCursor = HasCursor - then ( - print_endline "completing expression"; + then let currentlyExpecting = findCurrentlyLookingForInPattern ~completionContext vb.pvb_pat in @@ -283,7 +364,7 @@ and completeValueBinding ~completionContext (vb : Parsetree.value_binding) : mergeCurrentlyLookingFor currentlyExpecting completionContext.currentlyExpecting; } - vb.pvb_expr) + vb.pvb_expr else None and completeExpr ~completionContext (expr : Parsetree.expression) : @@ -384,7 +465,8 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : in match fieldToComplete with | None -> ( - (* Check if there's a expr hole with an empty cursor for a field. This means completing for an empty field `{someField: }`. *) + (* Check if there's a expr hole with an empty cursor for a field. + This means completing for an empty field `{someField: }`. *) let fieldNameWithExprHole = fields |> Utils.findMap (fun (fieldName, fieldExpr) -> @@ -420,11 +502,85 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : if lid.loc |> locHasPos then Some (CId (lidPath, Value) :: completionContext.ctxPath, completionContext) else None - | Pexp_match _ | Pexp_unreachable | Pexp_constant _ - | Pexp_let (_, _, _) - | Pexp_function _ - | Pexp_fun (_, _, _, _) - | Pexp_apply (_, _) + | Pexp_let (_recFlag, _valueBindings, nextExpr) -> + (* A let binding. `let a = b` *) + (* TODO: Handle recflag, scope, and complete in value bindings *) + if locHasPos nextExpr.pexp_loc then completeExpr ~completionContext nextExpr + else None + | Pexp_ifthenelse (condition, then_, maybeElse) -> ( + if locHasPos condition.pexp_loc then + (* TODO: I guess we could set looking for to "bool" here, since it's the if condition *) + completeExpr + ~completionContext:(CompletionContext.withResetCtx completionContext) + condition + else if locHasPos then_.pexp_loc then completeExpr ~completionContext then_ + else + match maybeElse with + | Some else_ -> + if locHasPos else_.pexp_loc then completeExpr ~completionContext else_ + else if checkIfExprHoleEmptyCursor ~completionContext else_ then + Some (CId ([], Value) :: completionContext.ctxPath, completionContext) + else None + | _ -> + (* Check then_ too *) + if checkIfExprHoleEmptyCursor ~completionContext then_ then + Some (CId ([], Value) :: completionContext.ctxPath, completionContext) + else None) + | Pexp_sequence (evalExpr, nextExpr) -> + if locHasPos evalExpr.pexp_loc then + completeExpr + ~completionContext:(CompletionContext.withResetCtx completionContext) + evalExpr + else if locHasPos nextExpr.pexp_loc then + completeExpr ~completionContext nextExpr + else None + | Pexp_apply (fnExpr, _args) -> + if locHasPos fnExpr.pexp_loc then + completeExpr + ~completionContext:(CompletionContext.withResetCtx completionContext) + fnExpr + else (* TODO: Complete args. Pipes *) + None + | Pexp_fun _ -> + (* We've found a function definition, like `let whatever = (someStr: string) => {}` *) + let rec loopFnExprs ~(completionContext : CompletionContext.t) + (expr : Parsetree.expression) = + (* TODO: Handle completing in default expressions and patterns *) + match expr.pexp_desc with + | Pexp_fun (_arg, _defaultExpr, pattern, nextExpr) -> + let scopeFromPattern = + scopePattern ~scope:completionContext.scope pattern + in + loopFnExprs + ~completionContext: + (completionContext |> CompletionContext.withScope scopeFromPattern) + nextExpr + | Pexp_constraint (expr, typ) -> + (expr, completionContext, ctxPathFromCoreType ~completionContext typ) + | _ -> (expr, completionContext, None) + in + let expr, completionContext, fnReturnConstraint = + loopFnExprs ~completionContext expr + in + (* Set the expected type correctly for the expr body *) + let completionContext = + match fnReturnConstraint with + | None -> ( + match completionContext.currentlyExpecting with + | Type ctxPath :: _ -> + (* Having a Type here already means the binding itself had a constraint on it. Since we're now moving into the function body, + we'll need to ensure it's the function return type we use for completion, not the function type itself *) + CompletionContext.addCurrentlyExpecting (FunctionReturnType ctxPath) + completionContext + | _ -> completionContext) + | Some ctxPath -> + CompletionContext.addCurrentlyExpecting (Type ctxPath) completionContext + in + if locHasPos expr.pexp_loc then completeExpr ~completionContext expr + else if checkIfExprHoleEmptyCursor ~completionContext expr then + Some (CId ([], Value) :: completionContext.ctxPath, completionContext) + else None + | Pexp_match _ | Pexp_unreachable | Pexp_constant _ | Pexp_function _ | Pexp_try (_, _) | Pexp_tuple _ | Pexp_construct (_, _) @@ -433,8 +589,6 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : | Pexp_field (_, _) | Pexp_setfield (_, _, _) | Pexp_array _ - | Pexp_ifthenelse (_, _, _) - | Pexp_sequence (_, _) | Pexp_while (_, _) | Pexp_for (_, _, _, _, _) | Pexp_constraint (_, _) @@ -455,14 +609,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : let completion ~currentFile ~path ~debug ~offset ~posCursor text = let positionContext = PositionContext.make ~offset ~posCursor text in - let completionContext : completionContext = - { - positionContext; - scope = Scope.create (); - currentlyExpecting = []; - ctxPath = []; - } - in + let completionContext = CompletionContext.make positionContext in if Filename.check_suffix path ".res" then let parser = Res_driver.parsingEngine.parseImplementation ~forPrinter:false diff --git a/analysis/tests/src/CompletionNew.res b/analysis/tests/src/CompletionNew.res index 638139415..ba956431e 100644 --- a/analysis/tests/src/CompletionNew.res +++ b/analysis/tests/src/CompletionNew.res @@ -45,3 +45,30 @@ type someRecord = {nested: option, variant: someVariant} // let myFunc: someRecord = {nested: {maybeVariant: One}, } // ^co2 + +// This should reset the context, meaning it should just complete for the identifier +// let myFunc: someRecord = {nested: {maybeVariant: {let x = true; if x {}}}, } +// ^co2 + +// This is the last expression +// let myFunc: someRecord = {nested: {maybeVariant: {let x = true; if x {}}}, } +// ^co2 + +// Complete as the last expression (looking for the record field type) +// let myFunc: someRecord = {nested: {maybeVariant: {doStuff(); let x = true; if x {v}}}, } +// ^co2 + +// Complete on the identifier, no context +// let myFunc: someRecord = {nested: {maybeVariant: {doStuff(); let x = true; if x {v}}}, } +// ^co2 + +type fn = (~name: string=?, string) => bool + +// let getBool = (name): bool => +// ^co2 + +// let someFun: fn = (str, ~name) => {} +// ^co2 + +// let someFun: fn = (str, ~name) => {let whatever = true; if whatever {}} +// ^co2 diff --git a/analysis/tests/src/expected/CompletionNew.res.txt b/analysis/tests/src/expected/CompletionNew.res.txt index 6c2b5e715..3ebb7f682 100644 --- a/analysis/tests/src/expected/CompletionNew.res.txt +++ b/analysis/tests/src/expected/CompletionNew.res.txt @@ -1,72 +1,95 @@ Complete2 src/CompletionNew.res 2:17 -completing expression Result: CId(Value)=m Scope: 1 items Looking for type: Complete2 src/CompletionNew.res 7:30 -completing expression Result: CId(Module)=O Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 10:36 -completing expression Result: CVariantPayload($0)->CId(Value)=t Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 13:42 -completing expression Result: CVariantPayload($1)->CId(Module)=S Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 16:47 -completing expression Result: CVariantPayload($1)->CVariantPayload($0)->CId(Module)=O Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 27:29 -completing expression Result: CRecordField= Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 30:30 -completing expression Result: CRecordField=n Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 33:39 -completing expression Result: CRecordField=variant->CId(Module)=O Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 36:66 -completing expression Result: CRecordField=nested->CRecordField=maybeVariant->CVariantPayload($1)->CId(Value)=t Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 39:66 -completing expression Result: CRecordField=variant Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 42:56 -completing expression Result: CRecordField=nested->CRecordField= Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 45:57 -completing expression Result: CRecordField= Scope: 1 items Looking for type: Type +Complete2 src/CompletionNew.res 49:71 +Result: CId(Value)=x +Scope: 1 items +Looking for type: + +Complete2 src/CompletionNew.res 53:73 +Result: CRecordField=nested->CRecordField=maybeVariant->CId(Value)= +Scope: 1 items +Looking for type: Type + +Complete2 src/CompletionNew.res 57:85 +Result: CRecordField=nested->CRecordField=maybeVariant->CId(Value)=v +Scope: 1 items +Looking for type: Type + +Complete2 src/CompletionNew.res 61:58 +Result: CId(Value)=doStuff +Scope: 1 items +Looking for type: + +Complete2 src/CompletionNew.res 66:32 +Result: CId(Value)= +Scope: 2 items +Looking for type: Type + +Complete2 src/CompletionNew.res 69:38 +Result: CRecordField= +Scope: 3 items +Looking for type: FunctionReturnType + +Complete2 src/CompletionNew.res 72:72 +Result: CId(Value)= +Scope: 3 items +Looking for type: FunctionReturnType + From d7910e9270893064d5c7046b7c2c26a11741b57b Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Sat, 26 Aug 2023 11:09:41 +0200 Subject: [PATCH 04/18] refactor --- analysis/src/CompletionFrontEndNew.ml | 104 +++++++++++++++----------- analysis/src/Completions.ml | 10 ++- 2 files changed, 67 insertions(+), 47 deletions(-) diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml index 8cdafa935..6dd4750bd 100644 --- a/analysis/src/CompletionFrontEndNew.ml +++ b/analysis/src/CompletionFrontEndNew.ml @@ -99,6 +99,20 @@ let rec ctxPathToString (ctxPath : ctxPath) = | None -> "" | Some ctxPath -> "[" ^ ctxPathToString ctxPath ^ "]") +module CompletionInstruction = struct + (** This is the completion instruction, that's responsible for resolving something at + context path X *) + type t = CtxPath of ctxPath list + + let ctxPath ctxPath = CtxPath ctxPath + + let toString (c : t) = + match c with + | CtxPath ctxPath -> + Printf.sprintf "CtxPath: %s" + (ctxPath |> List.map ctxPathToString |> String.concat "->") +end + type currentlyExpecting = | Unit | Type of ctxPath @@ -141,9 +155,22 @@ module CompletionContext = struct let withResetCurrentlyExpecting completionContext = {completionContext with currentlyExpecting = [Unit]} + + let addCtxPathItem ctxPath completionContext = + {completionContext with ctxPath = ctxPath :: completionContext.ctxPath} end -type completionResult = (ctxPath list * CompletionContext.t) option +module CompletionResult = struct + type t = (CompletionInstruction.t * CompletionContext.t) option + + let ctxPath (ctxPath : ctxPath) (completionContext : CompletionContext.t) = + let completionContext = + completionContext |> CompletionContext.addCtxPathItem ctxPath + in + Some + ( CompletionInstruction.ctxPath completionContext.ctxPath, + completionContext ) +end let flattenLidCheckDot ?(jsx = true) ~(completionContext : CompletionContext.t) (lid : Longident.t Location.loc) = @@ -292,14 +319,14 @@ let scopeModuleDeclaration ~scope (md : Parsetree.module_declaration) = scope |> Scope.addModule ~name:md.pmd_name.txt ~loc:md.pmd_name.loc let rec completeFromStructure ~completionContext - (structure : Parsetree.structure) : completionResult = + (structure : Parsetree.structure) : CompletionResult.t = (* TODO: Scope? *) structure |> Utils.findMap (fun (item : Parsetree.structure_item) -> completeStructureItem ~completionContext item) and completeStructureItem ~(completionContext : CompletionContext.t) - (item : Parsetree.structure_item) : completionResult = + (item : Parsetree.structure_item) : CompletionResult.t = match item.pstr_desc with | Pstr_value (recFlag, valueBindings) -> let scopeFromBindings = @@ -334,7 +361,7 @@ and completeStructureItem ~(completionContext : CompletionContext.t) (* These aren't relevant for ReScript *) None and completeValueBinding ~completionContext (vb : Parsetree.value_binding) : - completionResult = + CompletionResult.t = let scopeWithPattern = scopePattern ~scope:completionContext.scope vb.pvb_pat in @@ -368,7 +395,7 @@ and completeValueBinding ~completionContext (vb : Parsetree.value_binding) : else None and completeExpr ~completionContext (expr : Parsetree.expression) : - completionResult = + CompletionResult.t = let locHasPos loc = loc |> CursorPosition.locHasCursor @@ -399,30 +426,27 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : ctxPath = CVariantPayload {itemNum = 0} :: completionContext.ctxPath; } payloadExpr - | Pexp_construct ({txt = Lident txt; loc}, _) when loc |> locHasPos -> ( + | Pexp_construct ({txt = Lident txt; loc}, _) when loc |> locHasPos -> (* A constructor, like: `Co` *) - match completionContext.currentlyExpecting with - | _ -> - Some (CId ([txt], Module) :: completionContext.ctxPath, completionContext) - ) + CompletionResult.ctxPath (CId ([txt], Module)) completionContext | Pexp_construct (id, _) when id.loc |> locHasPos -> (* A path, like: `Something.Co` *) let lid = flattenLidCheckDot ~completionContext id in - Some (CId (lid, Module) :: completionContext.ctxPath, completionContext) + CompletionResult.ctxPath (CId (lid, Module)) completionContext (* == RECORDS == *) | Pexp_ident {txt = Lident prefix} when Utils.hasBraces expr.pexp_attributes -> (* An ident with braces attribute corresponds to for example `{n}`. Looks like a record but is parsed as an ident with braces. *) let prefix = if prefix = "()" then "" else prefix in - Some - ( CRecordField {prefix; seenFields = []} :: completionContext.ctxPath, - completionContext (* TODO: This isn't correct *) ) + CompletionResult.ctxPath + (CRecordField {prefix; seenFields = []}) + completionContext | Pexp_record ([], _) when expr.pexp_loc |> locHasPos -> (* No fields means we're in a record body `{}` *) - Some - ( CRecordField {prefix = ""; seenFields = []} :: completionContext.ctxPath, - completionContext (* TODO: This isn't correct *) ) + CompletionResult.ctxPath + (CRecordField {prefix = ""; seenFields = []}) + completionContext | Pexp_record (fields, _) when expr.pexp_loc |> locHasPos -> ( (* A record with fields *) let seenFields = @@ -441,25 +465,20 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : (* Cursor in field name, complete here *) match fieldName with | {txt = Lident prefix} -> - Some - ( CRecordField {prefix; seenFields} - :: completionContext.ctxPath, - completionContext (* TODO: This isn't correct *) ) + CompletionResult.ctxPath + (CRecordField {prefix; seenFields}) + completionContext | fieldName -> - Some - ( CId (flattenLidCheckDot ~completionContext fieldName, Value) - :: completionContext.ctxPath, - completionContext ) + CompletionResult.ctxPath + (CId (flattenLidCheckDot ~completionContext fieldName, Value)) + completionContext else if locHasPos fieldExpr.pexp_loc then completeExpr ~completionContext: - { - completionContext with - ctxPath = - CRecordField - {prefix = fieldName.txt |> Longident.last; seenFields} - :: completionContext.ctxPath; - } + (CompletionContext.addCtxPathItem + (CRecordField + {prefix = fieldName.txt |> Longident.last; seenFields}) + completionContext) fieldExpr else None) in @@ -485,14 +504,13 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : completionContext.positionContext.charBeforeNoWhitespace ) with | Some fieldName, _ -> - Some - ( CRecordField {prefix = fieldName; seenFields} - :: completionContext.ctxPath, - completionContext (* TODO: This isn't correct *) ) + CompletionResult.ctxPath + (CRecordField {prefix = fieldName; seenFields}) + completionContext | None, Some ',' -> - Some - ( CRecordField {prefix = ""; seenFields} :: completionContext.ctxPath, - completionContext (* TODO: This isn't correct *) ) + CompletionResult.ctxPath + (CRecordField {prefix = ""; seenFields}) + completionContext | _ -> None) | fieldToComplete -> fieldToComplete) (* == IDENTS == *) @@ -500,7 +518,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : (* An identifier, like `aaa` *) let lidPath = flattenLidCheckDot lid ~completionContext in if lid.loc |> locHasPos then - Some (CId (lidPath, Value) :: completionContext.ctxPath, completionContext) + CompletionResult.ctxPath (CId (lidPath, Value)) completionContext else None | Pexp_let (_recFlag, _valueBindings, nextExpr) -> (* A let binding. `let a = b` *) @@ -519,12 +537,12 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : | Some else_ -> if locHasPos else_.pexp_loc then completeExpr ~completionContext else_ else if checkIfExprHoleEmptyCursor ~completionContext else_ then - Some (CId ([], Value) :: completionContext.ctxPath, completionContext) + CompletionResult.ctxPath (CId ([], Value)) completionContext else None | _ -> (* Check then_ too *) if checkIfExprHoleEmptyCursor ~completionContext then_ then - Some (CId ([], Value) :: completionContext.ctxPath, completionContext) + CompletionResult.ctxPath (CId ([], Value)) completionContext else None) | Pexp_sequence (evalExpr, nextExpr) -> if locHasPos evalExpr.pexp_loc then @@ -578,7 +596,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : in if locHasPos expr.pexp_loc then completeExpr ~completionContext expr else if checkIfExprHoleEmptyCursor ~completionContext expr then - Some (CId ([], Value) :: completionContext.ctxPath, completionContext) + CompletionResult.ctxPath (CId ([], Value)) completionContext else None | Pexp_match _ | Pexp_unreachable | Pexp_constant _ | Pexp_function _ | Pexp_try (_, _) diff --git a/analysis/src/Completions.ml b/analysis/src/Completions.ml index 4dd4d9d8f..e5af2a6c5 100644 --- a/analysis/src/Completions.ml +++ b/analysis/src/Completions.ml @@ -34,11 +34,13 @@ let getCompletions2 ~debug ~path ~pos ~currentFile ~forHover = ~currentFile text with | None -> print_endline "No completions" - | Some (ctxPath, ctx) -> + | Some (res, ctx) -> Printf.printf "Result: %s\n" - (ctxPath |> List.rev - |> List.map CompletionFrontEndNew.ctxPathToString - |> String.concat "->"); + (match res with + | CtxPath ctxPath -> + ctxPath |> List.rev + |> List.map CompletionFrontEndNew.ctxPathToString + |> String.concat "->"); Printf.printf "Scope: %i items\n" (List.length ctx.scope); Printf.printf "Looking for type: %s\n" (match ctx.currentlyExpecting with From 61b196dd14b8b383041c1a73e490c4d23a675774 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Sat, 26 Aug 2023 11:49:43 +0200 Subject: [PATCH 05/18] moar work --- .vscode/settings.json | 2 +- analysis/src/CompletionFrontEndNew.ml | 165 +++++++++++------- analysis/tests/src/CompletionNew.res | 8 + .../tests/src/expected/CompletionNew.res.txt | 42 +++-- 4 files changed, 139 insertions(+), 78 deletions(-) diff --git a/.vscode/settings.json b/.vscode/settings.json index 11909bf1d..2b65f0986 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -8,6 +8,6 @@ }, "ocaml.sandbox": { "kind": "opam", - "switch": "${workspaceFolder:rescript-vscode}/analysis" + "switch": "4.14.0" } } \ No newline at end of file diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml index 6dd4750bd..82fca7dd2 100644 --- a/analysis/src/CompletionFrontEndNew.ml +++ b/analysis/src/CompletionFrontEndNew.ml @@ -13,6 +13,9 @@ module PositionContext = struct (** The char before the cursor, not excluding whitespace *) whitespaceAfterCursor: char option; (** The type of whitespace after the cursor, if any *) + locHasPos: Location.t -> bool; + (** A helper for checking whether a loc has the cursor (beforeCursor). + This is the most natural position to check when figuring out if the user has the cursor in something. *) } let make ~offset ~posCursor text = @@ -40,6 +43,9 @@ module PositionContext = struct | _ -> (Some charBeforeCursor, None)) | _ -> (None, None) in + let locHasPos loc = + loc |> CursorPosition.locHasCursor ~pos:posBeforeCursor + in { offset; beforeCursor = posBeforeCursor; @@ -48,6 +54,7 @@ module PositionContext = struct cursor = posCursor; charBeforeCursor; whitespaceAfterCursor; + locHasPos; } end @@ -114,14 +121,19 @@ module CompletionInstruction = struct end type currentlyExpecting = - | Unit - | Type of ctxPath + | Unit (** Unit, (). Is what we reset to. *) + | Type of ctxPath (** A type at a context path. *) + | TypeAtLoc of Location.t (** A type at a location. *) | FunctionReturnType of ctxPath + (** An instruction to resolve the return type of the type at the + provided context path, if it's a function (it should always be, + but you know...) *) let currentlyExpectingToString (c : currentlyExpecting) = match c with | Unit -> "Unit" | Type ctxPath -> Printf.sprintf "Type<%s>" (ctxPathToString ctxPath) + | TypeAtLoc loc -> Printf.sprintf "TypeAtLoc: %s" (Loc.toString loc) | FunctionReturnType ctxPath -> Printf.sprintf "FunctionReturnType<%s>" (ctxPathToString ctxPath) @@ -153,6 +165,41 @@ module CompletionContext = struct currentlyExpecting :: completionContext.currentlyExpecting; } + let addCurrentlyExpectingOpt currentlyExpecting completionContext = + match currentlyExpecting with + | None -> completionContext + | Some currentlyExpecting -> + { + completionContext with + currentlyExpecting = + currentlyExpecting :: completionContext.currentlyExpecting; + } + + let currentlyExpectingOrReset currentlyExpecting completionContext = + match currentlyExpecting with + | None -> {completionContext with currentlyExpecting = []} + | Some currentlyExpecting -> + { + completionContext with + currentlyExpecting = + currentlyExpecting :: completionContext.currentlyExpecting; + } + + let currentlyExpectingOrTypeAtLoc ~loc currentlyExpecting completionContext = + match currentlyExpecting with + | None -> + { + completionContext with + currentlyExpecting = + TypeAtLoc loc :: completionContext.currentlyExpecting; + } + | Some currentlyExpecting -> + { + completionContext with + currentlyExpecting = + currentlyExpecting :: completionContext.currentlyExpecting; + } + let withResetCurrentlyExpecting completionContext = {completionContext with currentlyExpecting = [Unit]} @@ -292,6 +339,13 @@ let rec scopePattern ~scope (pat : Parsetree.pattern) = let scopeValueBinding ~scope (vb : Parsetree.value_binding) = scopePattern ~scope vb.pvb_pat +let scopeValueBindings ~scope (valueBindings : Parsetree.value_binding list) = + let newScope = ref scope in + valueBindings + |> List.iter (fun (vb : Parsetree.value_binding) -> + newScope := scopeValueBinding vb ~scope:!newScope); + !newScope + let scopeTypeKind ~scope (tk : Parsetree.type_kind) = match tk with | Ptype_variant constrDecls -> @@ -327,31 +381,11 @@ let rec completeFromStructure ~completionContext and completeStructureItem ~(completionContext : CompletionContext.t) (item : Parsetree.structure_item) : CompletionResult.t = + let locHasPos = completionContext.positionContext.locHasPos in match item.pstr_desc with | Pstr_value (recFlag, valueBindings) -> - let scopeFromBindings = - valueBindings - |> List.map (fun (vb : Parsetree.value_binding) -> - scopeValueBinding vb ~scope:completionContext.scope) - |> List.concat - in - if - item.pstr_loc - |> CursorPosition.classifyLoc - ~pos:completionContext.positionContext.beforeCursor - = HasCursor - then - valueBindings - |> Utils.findMap (fun (vb : Parsetree.value_binding) -> - (* TODO: This will create duplicate scope entries for the current binding. Does it matter? *) - completeValueBinding - ~completionContext: - (if recFlag = Recursive then - completionContext - |> contextWithNewScope scopeFromBindings - |> CompletionContext.withResetCtx - else completionContext) - vb) + if locHasPos item.pstr_loc then + completeValueBindings ~completionContext ~recFlag valueBindings else None | Pstr_eval _ | Pstr_primitive _ | Pstr_type _ | Pstr_typext _ | Pstr_exception _ | Pstr_module _ | Pstr_recmodule _ | Pstr_modtype _ @@ -360,47 +394,44 @@ and completeStructureItem ~(completionContext : CompletionContext.t) | Pstr_class _ | Pstr_class_type _ -> (* These aren't relevant for ReScript *) None -and completeValueBinding ~completionContext (vb : Parsetree.value_binding) : - CompletionResult.t = - let scopeWithPattern = - scopePattern ~scope:completionContext.scope vb.pvb_pat - in - if - vb.pvb_pat.ppat_loc - |> CursorPosition.classifyLoc - ~pos:completionContext.positionContext.beforeCursor - = HasCursor - then ( +and completeValueBinding ~(completionContext : CompletionContext.t) + (vb : Parsetree.value_binding) : CompletionResult.t = + let locHasPos = completionContext.positionContext.locHasPos in + if locHasPos vb.pvb_pat.ppat_loc then ( print_endline "complete pattern"; None) - else if - vb.pvb_expr.pexp_loc - |> CursorPosition.classifyLoc - ~pos:completionContext.positionContext.beforeCursor - = HasCursor - then - let currentlyExpecting = + else if locHasPos vb.pvb_expr.pexp_loc then + let bindingConstraint = findCurrentlyLookingForInPattern ~completionContext vb.pvb_pat in - completeExpr - ~completionContext: - { - completionContext with - scope = scopeWithPattern; - currentlyExpecting = - mergeCurrentlyLookingFor currentlyExpecting - completionContext.currentlyExpecting; - } - vb.pvb_expr + (* A let binding expression either has the constraint of the binding, + or an inferred constraint (if it has been compiled), or no constraint. *) + let completionContext = + completionContext + |> CompletionContext.currentlyExpectingOrTypeAtLoc + ~loc:vb.pvb_pat.ppat_loc bindingConstraint + in + completeExpr ~completionContext vb.pvb_expr else None +and completeValueBindings ~(completionContext : CompletionContext.t) + ~(recFlag : Asttypes.rec_flag) + (valueBindings : Parsetree.value_binding list) : CompletionResult.t = + let completionContext = + if recFlag = Recursive then + let scopeFromBindings = + scopeValueBindings valueBindings ~scope:completionContext.scope + in + CompletionContext.withScope scopeFromBindings completionContext + else completionContext + in + valueBindings + |> Utils.findMap (fun (vb : Parsetree.value_binding) -> + completeValueBinding ~completionContext vb) + and completeExpr ~completionContext (expr : Parsetree.expression) : CompletionResult.t = - let locHasPos loc = - loc - |> CursorPosition.locHasCursor - ~pos:completionContext.positionContext.beforeCursor - in + let locHasPos = completionContext.positionContext.locHasPos in match expr.pexp_desc with (* == VARIANTS == *) | Pexp_construct (_id, Some {pexp_desc = Pexp_tuple args; pexp_loc}) @@ -520,10 +551,22 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : if lid.loc |> locHasPos then CompletionResult.ctxPath (CId (lidPath, Value)) completionContext else None - | Pexp_let (_recFlag, _valueBindings, nextExpr) -> + | Pexp_let (recFlag, valueBindings, nextExpr) -> (* A let binding. `let a = b` *) - (* TODO: Handle recflag, scope, and complete in value bindings *) - if locHasPos nextExpr.pexp_loc then completeExpr ~completionContext nextExpr + let scopeFromBindings = + scopeValueBindings valueBindings ~scope:completionContext.scope + in + let completionContextWithScopeFromBindings = + CompletionContext.withScope scopeFromBindings completionContext + in + (* First check if the next expr is the thing with the cursor *) + if locHasPos nextExpr.pexp_loc then + completeExpr ~completionContext:completionContextWithScopeFromBindings + nextExpr + else if locHasPos expr.pexp_loc then + (* The cursor is in the expression, but not in the next expression. + Check the value bindings.*) + completeValueBindings ~recFlag ~completionContext valueBindings else None | Pexp_ifthenelse (condition, then_, maybeElse) -> ( if locHasPos condition.pexp_loc then diff --git a/analysis/tests/src/CompletionNew.res b/analysis/tests/src/CompletionNew.res index ba956431e..8e1e14160 100644 --- a/analysis/tests/src/CompletionNew.res +++ b/analysis/tests/src/CompletionNew.res @@ -72,3 +72,11 @@ type fn = (~name: string=?, string) => bool // let someFun: fn = (str, ~name) => {let whatever = true; if whatever {}} // ^co2 + +// A let binding with an annotation. Reset to annotated constraint. +// let someFun: fn = (str, ~name) => {let whatever: bool = t} +// ^co2 + +// A let binding without annotation. Point to inferred type if it has compiled. +// let someFun: fn = (str, ~name) => {let whatever = t} +// ^co2 diff --git a/analysis/tests/src/expected/CompletionNew.res.txt b/analysis/tests/src/expected/CompletionNew.res.txt index 3ebb7f682..15902b492 100644 --- a/analysis/tests/src/expected/CompletionNew.res.txt +++ b/analysis/tests/src/expected/CompletionNew.res.txt @@ -1,61 +1,61 @@ Complete2 src/CompletionNew.res 2:17 Result: CId(Value)=m -Scope: 1 items -Looking for type: +Scope: 0 items +Looking for type: TypeAtLoc: [2:7->2:13] Complete2 src/CompletionNew.res 7:30 Result: CId(Module)=O -Scope: 1 items +Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 10:36 Result: CVariantPayload($0)->CId(Value)=t -Scope: 1 items +Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 13:42 Result: CVariantPayload($1)->CId(Module)=S -Scope: 1 items +Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 16:47 Result: CVariantPayload($1)->CVariantPayload($0)->CId(Module)=O -Scope: 1 items +Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 27:29 Result: CRecordField= -Scope: 1 items +Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 30:30 Result: CRecordField=n -Scope: 1 items +Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 33:39 Result: CRecordField=variant->CId(Module)=O -Scope: 1 items +Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 36:66 Result: CRecordField=nested->CRecordField=maybeVariant->CVariantPayload($1)->CId(Value)=t -Scope: 1 items +Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 39:66 Result: CRecordField=variant -Scope: 1 items +Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 42:56 Result: CRecordField=nested->CRecordField= -Scope: 1 items +Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 45:57 Result: CRecordField= -Scope: 1 items +Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 49:71 @@ -75,17 +75,17 @@ Looking for type: Type Complete2 src/CompletionNew.res 61:58 Result: CId(Value)=doStuff -Scope: 1 items +Scope: 0 items Looking for type: Complete2 src/CompletionNew.res 66:32 Result: CId(Value)= -Scope: 2 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 69:38 Result: CRecordField= -Scope: 3 items +Scope: 2 items Looking for type: FunctionReturnType Complete2 src/CompletionNew.res 72:72 @@ -93,3 +93,13 @@ Result: CId(Value)= Scope: 3 items Looking for type: FunctionReturnType +Complete2 src/CompletionNew.res 76:60 +Result: CId(Value)=t +Scope: 2 items +Looking for type: Type + +Complete2 src/CompletionNew.res 80:54 +Result: CId(Value)=t +Scope: 2 items +Looking for type: TypeAtLoc: [80:42->80:50] + From 1e3067dee09b255e35d53f040c1f727bc22b7cdd Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Sat, 26 Aug 2023 18:37:52 +0200 Subject: [PATCH 06/18] more work --- analysis/src/CompletionFrontEndNew.ml | 420 ++++++++++++++++-- analysis/src/Completions.ml | 6 +- analysis/tests/src/CompletionNew.res | 7 + .../tests/src/expected/CompletionNew.res.txt | 56 ++- 4 files changed, 412 insertions(+), 77 deletions(-) diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml index 82fca7dd2..093df4108 100644 --- a/analysis/src/CompletionFrontEndNew.ml +++ b/analysis/src/CompletionFrontEndNew.ml @@ -75,15 +75,37 @@ type ctxPath = | CString | CInt | CFloat + | CAwait of ctxPath (** Awaiting a function call. *) | CFunction of {returnType: ctxPath} (** A function *) + | CField of ctxPath * string + (** Field access. `whateverVariable.fieldName`. The ctxPath points to the value of `whateverVariable`, + and the string is the name of the field we're accessing. *) + | CObj of ctxPath * string + (** Object property access. `whateverVariable["fieldName"]`. The ctxPath points to the value of `whateverVariable`, + and the string is the name of the property we're accessing. *) + | CApply of ctxPath * Asttypes.arg_label list + (** Function application. `someFunction(someVar, ~otherLabel="hello")`. The ctxPath points to the function. *) let rec ctxPathToString (ctxPath : ctxPath) = match ctxPath with | CUnknown -> "CUnknown" - | CBool -> "CBool" - | CFloat -> "CFloat" - | CInt -> "CInt" - | CString -> "CString" + | CBool -> "bool" + | CFloat -> "float" + | CInt -> "int" + | CString -> "string" + | CAwait ctxPath -> Printf.sprintf "await %s" (ctxPathToString ctxPath) + | CApply (ctxPath, args) -> + Printf.sprintf "%s(%s)" (ctxPathToString ctxPath) + (args + |> List.map (function + | Asttypes.Nolabel -> "Nolabel" + | Labelled s -> "~" ^ s + | Optional s -> "?" ^ s) + |> String.concat ", ") + | CField (ctxPath, fieldName) -> + Printf.sprintf "(%s).%s" (ctxPathToString ctxPath) fieldName + | CObj (ctxPath, fieldName) -> + Printf.sprintf "(%s)[\"%s\"]" (ctxPathToString ctxPath) fieldName | CFunction {returnType} -> Printf.sprintf "CFunction () -> %s" (ctxPathToString returnType) | CTuple ctxPaths -> @@ -101,24 +123,10 @@ let rec ctxPathToString (ctxPath : ctxPath) = | CRecordField {prefix} -> Printf.sprintf "CRecordField=%s" prefix | COption ctxPath -> Printf.sprintf "COption<%s>" (ctxPathToString ctxPath) | CArray ctxPath -> - Printf.sprintf "CArray%s" + Printf.sprintf "array%s" (match ctxPath with | None -> "" - | Some ctxPath -> "[" ^ ctxPathToString ctxPath ^ "]") - -module CompletionInstruction = struct - (** This is the completion instruction, that's responsible for resolving something at - context path X *) - type t = CtxPath of ctxPath list - - let ctxPath ctxPath = CtxPath ctxPath - - let toString (c : t) = - match c with - | CtxPath ctxPath -> - Printf.sprintf "CtxPath: %s" - (ctxPath |> List.map ctxPathToString |> String.concat "->") -end + | Some ctxPath -> "<" ^ ctxPathToString ctxPath ^ ">") type currentlyExpecting = | Unit (** Unit, (). Is what we reset to. *) @@ -207,6 +215,77 @@ module CompletionContext = struct {completionContext with ctxPath = ctxPath :: completionContext.ctxPath} end +module CompletionInstruction = struct + (** This is the completion instruction, that's responsible for resolving something at + context path X *) + type t = + | CtxPath of ctxPath list + | Cpattern of { + ctxPath: ctxPath list; + (** This is the context path inside of the pattern itself. + Used to walk up to the type we're looking to complete. *) + rootType: currentlyExpecting; + (** This is the an instruction to find where completion starts + from. If we're completing inside of a record, it should resolve + to the record itself. *) + prefix: string; + } (** Completing inside of a pattern. *) + | Cexpression of { + ctxPath: ctxPath list; + (** This is the context path inside of the expression itself. + Used to walk up to the type we're looking to complete. *) + rootType: currentlyExpecting; + (** This is the an instruction to find where completion starts + from. If we're completing inside of a record, it should resolve + to the record itself. *) + prefix: string; + } (** Completing inside of an expression. *) + + let ctxPath ctxPath = CtxPath ctxPath + + let pattern ~(completionContext : CompletionContext.t) ~prefix = + Cpattern + { + prefix; + rootType = + (match completionContext.currentlyExpecting with + | currentlyExpecting :: _ -> currentlyExpecting + | _ -> Unit); + ctxPath = completionContext.ctxPath; + } + + let expression ~(completionContext : CompletionContext.t) ~prefix = + Cexpression + { + prefix; + rootType = + (match completionContext.currentlyExpecting with + | currentlyExpecting :: _ -> currentlyExpecting + | _ -> Unit); + ctxPath = completionContext.ctxPath; + } + + let toString (c : t) = + match c with + | CtxPath ctxPath -> + Printf.sprintf "CtxPath: %s" + (ctxPath |> List.rev |> List.map ctxPathToString |> String.concat "->") + | Cpattern {ctxPath; prefix; rootType} -> + Printf.sprintf "Cpattern: ctxPath: %s, rootType: %s%s" + (ctxPath |> List.rev |> List.map ctxPathToString |> String.concat "->") + (currentlyExpectingToString rootType) + (match prefix with + | "" -> "" + | prefix -> Printf.sprintf ", prefix: \"%s\"" prefix) + | Cexpression {ctxPath; prefix; rootType} -> + Printf.sprintf "Cexpression: ctxPath: %s, rootType: %s%s" + (ctxPath |> List.rev |> List.map ctxPathToString |> String.concat "->") + (currentlyExpectingToString rootType) + (match prefix with + | "" -> "" + | prefix -> Printf.sprintf ", prefix: \"%s\"" prefix) +end + module CompletionResult = struct type t = (CompletionInstruction.t * CompletionContext.t) option @@ -217,6 +296,16 @@ module CompletionResult = struct Some ( CompletionInstruction.ctxPath completionContext.ctxPath, completionContext ) + + let pattern ~(completionContext : CompletionContext.t) ~prefix = + Some + ( CompletionInstruction.pattern ~completionContext ~prefix, + completionContext ) + + let expression ~(completionContext : CompletionContext.t) ~prefix = + Some + ( CompletionInstruction.expression ~completionContext ~prefix, + completionContext ) end let flattenLidCheckDot ?(jsx = true) ~(completionContext : CompletionContext.t) @@ -235,6 +324,82 @@ let flattenLidCheckDot ?(jsx = true) ~(completionContext : CompletionContext.t) in Utils.flattenLongIdent ~cutAtOffset ~jsx lid.txt +(** This is for when you want a context path for an expression, without necessarily wanting + to do completion in that expression. For instance when completing patterns + `let {} = someRecordVariable`, we want the context path to `someRecordVariable` to + be able to figure out the type we're completing in the pattern. *) +let rec exprToContextPathInner (e : Parsetree.expression) = + match e.pexp_desc with + | Pexp_constant (Pconst_string _) -> Some CString + | Pexp_constant (Pconst_integer _) -> Some CInt + | Pexp_constant (Pconst_float _) -> Some CFloat + | Pexp_construct ({txt = Lident ("true" | "false")}, None) -> Some CBool + | Pexp_array exprs -> + Some + (CArray + (match exprs with + | [] -> None + | exp :: _ -> exprToContextPath exp)) + | Pexp_ident {txt = Lident ("|." | "|.u")} -> None + | Pexp_ident {txt} -> Some (CId (Utils.flattenLongIdent txt, Value)) + | Pexp_field (e1, {txt = Lident name}) -> ( + match exprToContextPath e1 with + | Some contextPath -> Some (CField (contextPath, name)) + | _ -> None) + | Pexp_field (_, {txt = Ldot (lid, name)}) -> + (* Case x.M.field ignore the x part *) + Some (CField (CId (Utils.flattenLongIdent lid, Module), name)) + | Pexp_send (e1, {txt}) -> ( + match exprToContextPath e1 with + | None -> None + | Some contexPath -> Some (CObj (contexPath, txt))) + | Pexp_apply + ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}}, + [ + (_, lhs); + (_, {pexp_desc = Pexp_apply (d, args); pexp_loc; pexp_attributes}); + ] ) -> + (* Transform away pipe with apply call *) + exprToContextPath + { + pexp_desc = Pexp_apply (d, (Nolabel, lhs) :: args); + pexp_loc; + pexp_attributes; + } + | Pexp_apply + ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}}, + [(_, lhs); (_, {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes})] + ) -> + (* Transform away pipe with identifier *) + exprToContextPath + { + pexp_desc = + Pexp_apply + ( {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes}, + [(Nolabel, lhs)] ); + pexp_loc; + pexp_attributes; + } + | Pexp_apply (e1, args) -> ( + match exprToContextPath e1 with + | None -> None + | Some contexPath -> Some (CApply (contexPath, args |> List.map fst))) + | Pexp_tuple exprs -> + let exprsAsContextPaths = exprs |> List.filter_map exprToContextPath in + if List.length exprs = List.length exprsAsContextPaths then + Some (CTuple exprsAsContextPaths) + else None + | _ -> None + +and exprToContextPath (e : Parsetree.expression) = + match + ( Res_parsetree_viewer.hasAwaitAttribute e.pexp_attributes, + exprToContextPathInner e ) + with + | true, Some ctxPath -> Some (CAwait ctxPath) + | false, Some ctxPath -> Some ctxPath + | _, None -> None + let rec ctxPathFromCoreType ~completionContext (coreType : Parsetree.core_type) = match coreType.ptyp_desc with @@ -297,6 +462,13 @@ let checkIfExprHoleEmptyCursor ~(completionContext : CompletionContext.t) ~pos:completionContext.positionContext.beforeCursor = EmptyLoc +let checkIfPatternHoleEmptyCursor ~(completionContext : CompletionContext.t) + (pat : Parsetree.pattern) = + CompletionPatterns.isPatternHole pat + && CursorPosition.classifyLoc pat.ppat_loc + ~pos:completionContext.positionContext.beforeCursor + = EmptyLoc + (** Scopes *) let rec scopePattern ~scope (pat : Parsetree.pattern) = match pat.ppat_desc with @@ -397,13 +569,24 @@ and completeStructureItem ~(completionContext : CompletionContext.t) and completeValueBinding ~(completionContext : CompletionContext.t) (vb : Parsetree.value_binding) : CompletionResult.t = let locHasPos = completionContext.positionContext.locHasPos in - if locHasPos vb.pvb_pat.ppat_loc then ( - print_endline "complete pattern"; - None) - else if locHasPos vb.pvb_expr.pexp_loc then - let bindingConstraint = - findCurrentlyLookingForInPattern ~completionContext vb.pvb_pat + let bindingConstraint = + findCurrentlyLookingForInPattern ~completionContext vb.pvb_pat + in + (* Always reset the context when completing value bindings, + since they create their own context. *) + let completionContext = CompletionContext.withResetCtx completionContext in + if locHasPos vb.pvb_pat.ppat_loc then + (* Completing the pattern of the binding. `let {} = someRecordVariable`. + Ensure the context carries the root type of `someRecordVariable`. *) + let completionContext = + CompletionContext.currentlyExpectingOrTypeAtLoc ~loc:vb.pvb_expr.pexp_loc + (match exprToContextPath vb.pvb_expr with + | None -> None + | Some ctxPath -> Some (Type ctxPath)) + completionContext in + completePattern ~completionContext vb.pvb_pat + else if locHasPos vb.pvb_expr.pexp_loc then (* A let binding expression either has the constraint of the binding, or an inferred constraint (if it has been compiled), or no constraint. *) let completionContext = @@ -412,6 +595,31 @@ and completeValueBinding ~(completionContext : CompletionContext.t) ~loc:vb.pvb_pat.ppat_loc bindingConstraint in completeExpr ~completionContext vb.pvb_expr + else if locHasPos vb.pvb_loc then + (* In the binding but not in the pattern or expression means parser error recovery. + We can still complete the pattern or expression if we have enough information. *) + let exprHole = checkIfExprHoleEmptyCursor ~completionContext vb.pvb_expr in + let patHole = checkIfPatternHoleEmptyCursor ~completionContext vb.pvb_pat in + let exprCtxPath = exprToContextPath vb.pvb_expr in + (* Try the expression. Example: `let someVar: someType = *) + if exprHole then + let completionContext = + completionContext + |> CompletionContext.currentlyExpectingOrTypeAtLoc + ~loc:vb.pvb_pat.ppat_loc bindingConstraint + in + CompletionResult.ctxPath (CId ([], Value)) completionContext + else if patHole then + let completionContext = + CompletionContext.currentlyExpectingOrTypeAtLoc + ~loc:vb.pvb_expr.pexp_loc + (match exprCtxPath with + | None -> None + | Some ctxPath -> Some (Type ctxPath)) + completionContext + in + CompletionResult.pattern ~prefix:"" ~completionContext + else None else None and completeValueBindings ~(completionContext : CompletionContext.t) @@ -459,7 +667,11 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : payloadExpr | Pexp_construct ({txt = Lident txt; loc}, _) when loc |> locHasPos -> (* A constructor, like: `Co` *) - CompletionResult.ctxPath (CId ([txt], Module)) completionContext + let completionContext = + completionContext + |> CompletionContext.addCtxPathItem (CId ([txt], Module)) + in + CompletionResult.expression ~completionContext ~prefix:txt | Pexp_construct (id, _) when id.loc |> locHasPos -> (* A path, like: `Something.Co` *) let lid = flattenLidCheckDot ~completionContext id in @@ -470,14 +682,20 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : (* An ident with braces attribute corresponds to for example `{n}`. Looks like a record but is parsed as an ident with braces. *) let prefix = if prefix = "()" then "" else prefix in - CompletionResult.ctxPath - (CRecordField {prefix; seenFields = []}) + let completionContext = completionContext + |> CompletionContext.addCtxPathItem + (CRecordField {prefix; seenFields = []}) + in + CompletionResult.expression ~completionContext ~prefix | Pexp_record ([], _) when expr.pexp_loc |> locHasPos -> (* No fields means we're in a record body `{}` *) - CompletionResult.ctxPath - (CRecordField {prefix = ""; seenFields = []}) + let completionContext = completionContext + |> CompletionContext.addCtxPathItem + (CRecordField {prefix = ""; seenFields = []}) + in + CompletionResult.expression ~completionContext ~prefix:"" | Pexp_record (fields, _) when expr.pexp_loc |> locHasPos -> ( (* A record with fields *) let seenFields = @@ -520,12 +738,8 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : let fieldNameWithExprHole = fields |> Utils.findMap (fun (fieldName, fieldExpr) -> - if - CompletionExpressions.isExprHole fieldExpr - && CursorPosition.classifyLoc fieldExpr.pexp_loc - ~pos:completionContext.positionContext.beforeCursor - = EmptyLoc - then Some (Longident.last fieldName.Location.txt) + if checkIfExprHoleEmptyCursor ~completionContext fieldExpr then + Some (Longident.last fieldName.Location.txt) else None) in (* We found no field to complete, but we know the cursor is inside this record body. @@ -535,13 +749,19 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : completionContext.positionContext.charBeforeNoWhitespace ) with | Some fieldName, _ -> - CompletionResult.ctxPath - (CRecordField {prefix = fieldName; seenFields}) + let completionContext = completionContext + |> CompletionContext.addCtxPathItem + (CRecordField {prefix = fieldName; seenFields}) + in + CompletionResult.expression ~completionContext ~prefix:"" | None, Some ',' -> - CompletionResult.ctxPath - (CRecordField {prefix = ""; seenFields}) + let completionContext = completionContext + |> CompletionContext.addCtxPathItem + (CRecordField {prefix = ""; seenFields}) + in + CompletionResult.expression ~completionContext ~prefix:"" | _ -> None) | fieldToComplete -> fieldToComplete) (* == IDENTS == *) @@ -549,7 +769,11 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : (* An identifier, like `aaa` *) let lidPath = flattenLidCheckDot lid ~completionContext in if lid.loc |> locHasPos then - CompletionResult.ctxPath (CId (lidPath, Value)) completionContext + let completionContext = + completionContext + |> CompletionContext.addCtxPathItem (CId (lidPath, Value)) + in + CompletionResult.expression ~completionContext ~prefix:"" else None | Pexp_let (recFlag, valueBindings, nextExpr) -> (* A let binding. `let a = b` *) @@ -557,7 +781,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : scopeValueBindings valueBindings ~scope:completionContext.scope in let completionContextWithScopeFromBindings = - CompletionContext.withScope scopeFromBindings completionContext + completionContext |> CompletionContext.withScope scopeFromBindings in (* First check if the next expr is the thing with the cursor *) if locHasPos nextExpr.pexp_loc then @@ -580,12 +804,20 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : | Some else_ -> if locHasPos else_.pexp_loc then completeExpr ~completionContext else_ else if checkIfExprHoleEmptyCursor ~completionContext else_ then - CompletionResult.ctxPath (CId ([], Value)) completionContext + let completionContext = + completionContext + |> CompletionContext.addCtxPathItem (CId ([], Value)) + in + CompletionResult.expression ~completionContext ~prefix:"" else None | _ -> (* Check then_ too *) if checkIfExprHoleEmptyCursor ~completionContext then_ then - CompletionResult.ctxPath (CId ([], Value)) completionContext + let completionContext = + completionContext + |> CompletionContext.addCtxPathItem (CId ([], Value)) + in + CompletionResult.expression ~completionContext ~prefix:"" else None) | Pexp_sequence (evalExpr, nextExpr) -> if locHasPos evalExpr.pexp_loc then @@ -631,15 +863,20 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : | Type ctxPath :: _ -> (* Having a Type here already means the binding itself had a constraint on it. Since we're now moving into the function body, we'll need to ensure it's the function return type we use for completion, not the function type itself *) - CompletionContext.addCurrentlyExpecting (FunctionReturnType ctxPath) - completionContext + completionContext + |> CompletionContext.addCurrentlyExpecting + (FunctionReturnType ctxPath) | _ -> completionContext) | Some ctxPath -> - CompletionContext.addCurrentlyExpecting (Type ctxPath) completionContext + completionContext + |> CompletionContext.addCurrentlyExpecting (Type ctxPath) in if locHasPos expr.pexp_loc then completeExpr ~completionContext expr else if checkIfExprHoleEmptyCursor ~completionContext expr then - CompletionResult.ctxPath (CId ([], Value)) completionContext + let completionContext = + completionContext |> CompletionContext.addCtxPathItem (CId ([], Value)) + in + CompletionResult.expression ~completionContext ~prefix:"" else None | Pexp_match _ | Pexp_unreachable | Pexp_constant _ | Pexp_function _ | Pexp_try (_, _) @@ -668,6 +905,91 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : None | Pexp_object _ | Pexp_new _ -> (* These are irrelevant to ReScript *) None +and completePattern ~(completionContext : CompletionContext.t) + (pat : Parsetree.pattern) : CompletionResult.t = + let locHasPos = completionContext.positionContext.locHasPos in + match pat.ppat_desc with + | Ppat_lazy p + | Ppat_constraint (p, _) + | Ppat_alias (p, _) + | Ppat_exception p + | Ppat_open (_, p) -> + (* Can just continue into these patterns. *) + if locHasPos pat.ppat_loc then p |> completePattern ~completionContext + else None + | Ppat_var {txt; loc} -> + (* A variable, like `{ someThing: someV}*) + if locHasPos loc then + CompletionResult.pattern ~completionContext ~prefix:txt + else None + | Ppat_record ([], _) -> + (* Empty fields means we're in a record body `{}`. Complete for the fields. *) + if locHasPos pat.ppat_loc then + let completionContext = + CompletionContext.addCtxPathItem + (CRecordField {seenFields = []; prefix = ""}) + completionContext + in + CompletionResult.pattern ~completionContext ~prefix:"" + else None + | Ppat_record (fields, _) when locHasPos pat.ppat_loc -> ( + (* Record body with fields, where we know the cursor is inside of the record body somewhere. *) + let seenFields = + fields + |> List.filter_map (fun (fieldName, _f) -> + match fieldName with + | {Location.txt = Longident.Lident fieldName} -> Some fieldName + | _ -> None) + in + let fieldNameWithCursor = + fields + |> List.find_map + (fun ((fieldName : Longident.t Location.loc), _fieldPattern) -> + if locHasPos fieldName.Location.loc then Some fieldName else None) + in + let fieldPatternWithCursor = + fields + |> List.find_map (fun (fieldName, fieldPattern) -> + if locHasPos fieldPattern.Parsetree.ppat_loc then + Some (fieldName, fieldPattern) + else None) + in + match (fieldNameWithCursor, fieldPatternWithCursor) with + | Some fieldName, _ -> + (* {someFieldName: someValue} *) + let prefix = Longident.last fieldName.txt in + CompletionResult.pattern ~prefix + ~completionContext: + (CompletionContext.addCtxPathItem + (CRecordField {seenFields; prefix}) + completionContext) + | None, Some (fieldName, fieldPattern) -> + (* {someFieldName: someOtherPattern} *) + let prefix = Longident.last fieldName.txt in + let completionContext = + CompletionContext.addCtxPathItem + (CRecordField {seenFields; prefix}) + completionContext + in + completePattern ~completionContext fieldPattern + | None, None -> + (* We know the cursor is here, but it's not in a field name nor a field pattern. + Check empty field patterns. *) + None) + | Ppat_any | Ppat_tuple _ + | Ppat_construct ({loc = {loc_start = _; loc_end = _; _}; _}, _) + | Ppat_variant (_, _) + | Ppat_record (_, _) + | Ppat_array _ + | Ppat_or + ( {ppat_loc = {loc_start = _; loc_end = _; _}; _}, + {ppat_loc = {loc_start = _; loc_end = _; _}; _} ) + | Ppat_type {loc = {loc_start = _; loc_end = _; _}; _} + | Ppat_unpack {loc = {loc_start = _; loc_end = _; _}; _} + | Ppat_extension ({loc = {loc_start = _; loc_end = _; _}; _}, _) -> + None + | Ppat_constant _ | Ppat_interval _ -> None + let completion ~currentFile ~path ~debug ~offset ~posCursor text = let positionContext = PositionContext.make ~offset ~posCursor text in let completionContext = CompletionContext.make positionContext in diff --git a/analysis/src/Completions.ml b/analysis/src/Completions.ml index e5af2a6c5..9e91d9ed7 100644 --- a/analysis/src/Completions.ml +++ b/analysis/src/Completions.ml @@ -36,11 +36,7 @@ let getCompletions2 ~debug ~path ~pos ~currentFile ~forHover = | None -> print_endline "No completions" | Some (res, ctx) -> Printf.printf "Result: %s\n" - (match res with - | CtxPath ctxPath -> - ctxPath |> List.rev - |> List.map CompletionFrontEndNew.ctxPathToString - |> String.concat "->"); + (CompletionFrontEndNew.CompletionInstruction.toString res); Printf.printf "Scope: %i items\n" (List.length ctx.scope); Printf.printf "Looking for type: %s\n" (match ctx.currentlyExpecting with diff --git a/analysis/tests/src/CompletionNew.res b/analysis/tests/src/CompletionNew.res index 8e1e14160..c6bf9d7ca 100644 --- a/analysis/tests/src/CompletionNew.res +++ b/analysis/tests/src/CompletionNew.res @@ -80,3 +80,10 @@ type fn = (~name: string=?, string) => bool // A let binding without annotation. Point to inferred type if it has compiled. // let someFun: fn = (str, ~name) => {let whatever = t} // ^co2 + +// Let binding patterns +// let someVar: bool = +// ^co2 + +// let {someField: s } = someRecordVar +// ^co2 diff --git a/analysis/tests/src/expected/CompletionNew.res.txt b/analysis/tests/src/expected/CompletionNew.res.txt index 15902b492..93e01eb56 100644 --- a/analysis/tests/src/expected/CompletionNew.res.txt +++ b/analysis/tests/src/expected/CompletionNew.res.txt @@ -1,105 +1,115 @@ Complete2 src/CompletionNew.res 2:17 -Result: CId(Value)=m +Result: Cexpression: ctxPath: CId(Value)=m, rootType: TypeAtLoc: [2:7->2:13] Scope: 0 items Looking for type: TypeAtLoc: [2:7->2:13] Complete2 src/CompletionNew.res 7:30 -Result: CId(Module)=O +Result: Cexpression: ctxPath: CId(Module)=O, rootType: Type, prefix: "O" Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 10:36 -Result: CVariantPayload($0)->CId(Value)=t +Result: Cexpression: ctxPath: CVariantPayload($0)->CId(Value)=t, rootType: Type Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 13:42 -Result: CVariantPayload($1)->CId(Module)=S +Result: Cexpression: ctxPath: CVariantPayload($1)->CId(Module)=S, rootType: Type, prefix: "S" Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 16:47 -Result: CVariantPayload($1)->CVariantPayload($0)->CId(Module)=O +Result: Cexpression: ctxPath: CVariantPayload($1)->CVariantPayload($0)->CId(Module)=O, rootType: Type, prefix: "O" Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 27:29 -Result: CRecordField= +Result: Cexpression: ctxPath: CRecordField=, rootType: Type Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 30:30 -Result: CRecordField=n +Result: Cexpression: ctxPath: CRecordField=n, rootType: Type, prefix: "n" Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 33:39 -Result: CRecordField=variant->CId(Module)=O +Result: Cexpression: ctxPath: CRecordField=variant->CId(Module)=O, rootType: Type, prefix: "O" Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 36:66 -Result: CRecordField=nested->CRecordField=maybeVariant->CVariantPayload($1)->CId(Value)=t +Result: Cexpression: ctxPath: CRecordField=nested->CRecordField=maybeVariant->CVariantPayload($1)->CId(Value)=t, rootType: Type Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 39:66 -Result: CRecordField=variant +Result: Cexpression: ctxPath: CRecordField=variant, rootType: Type Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 42:56 -Result: CRecordField=nested->CRecordField= +Result: Cexpression: ctxPath: CRecordField=nested->CRecordField=, rootType: Type Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 45:57 -Result: CRecordField= +Result: Cexpression: ctxPath: CRecordField=, rootType: Type Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 49:71 -Result: CId(Value)=x +Result: Cexpression: ctxPath: CId(Value)=x, rootType: Unit Scope: 1 items Looking for type: Complete2 src/CompletionNew.res 53:73 -Result: CRecordField=nested->CRecordField=maybeVariant->CId(Value)= +Result: Cexpression: ctxPath: CRecordField=nested->CRecordField=maybeVariant->CId(Value)=, rootType: Type Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 57:85 -Result: CRecordField=nested->CRecordField=maybeVariant->CId(Value)=v +Result: Cexpression: ctxPath: CRecordField=nested->CRecordField=maybeVariant->CId(Value)=v, rootType: Type Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 61:58 -Result: CId(Value)=doStuff +Result: Cexpression: ctxPath: CId(Value)=doStuff, rootType: Unit Scope: 0 items Looking for type: Complete2 src/CompletionNew.res 66:32 -Result: CId(Value)= +Result: Cexpression: ctxPath: CId(Value)=, rootType: Type Scope: 1 items -Looking for type: Type +Looking for type: Type Complete2 src/CompletionNew.res 69:38 -Result: CRecordField= +Result: Cexpression: ctxPath: CRecordField=, rootType: FunctionReturnType Scope: 2 items Looking for type: FunctionReturnType Complete2 src/CompletionNew.res 72:72 -Result: CId(Value)= +Result: Cexpression: ctxPath: CId(Value)=, rootType: FunctionReturnType Scope: 3 items Looking for type: FunctionReturnType Complete2 src/CompletionNew.res 76:60 -Result: CId(Value)=t +Result: Cexpression: ctxPath: CId(Value)=t, rootType: Type Scope: 2 items -Looking for type: Type +Looking for type: Type Complete2 src/CompletionNew.res 80:54 -Result: CId(Value)=t +Result: Cexpression: ctxPath: CId(Value)=t, rootType: TypeAtLoc: [80:42->80:50] Scope: 2 items Looking for type: TypeAtLoc: [80:42->80:50] +Complete2 src/CompletionNew.res 84:22 +Result: CtxPath: CId(Value)= +Scope: 0 items +Looking for type: Type + +Complete2 src/CompletionNew.res 87:20 +Result: Cpattern: ctxPath: CRecordField=someField, rootType: Type, prefix: "s" +Scope: 0 items +Looking for type: Type + From 0df59dcbde6acba588a76b4b3f7d4fd495816383 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Sat, 26 Aug 2023 18:41:06 +0200 Subject: [PATCH 07/18] refactor --- analysis/src/CompletionFrontEndNew.ml | 65 +++++-------------- analysis/src/Completions.ml | 6 +- .../tests/src/expected/CompletionNew.res.txt | 4 +- 3 files changed, 19 insertions(+), 56 deletions(-) diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml index 093df4108..613343e9e 100644 --- a/analysis/src/CompletionFrontEndNew.ml +++ b/analysis/src/CompletionFrontEndNew.ml @@ -149,7 +149,7 @@ module CompletionContext = struct type t = { positionContext: PositionContext.t; scope: Scope.t; - currentlyExpecting: currentlyExpecting list; + currentlyExpecting: currentlyExpecting; ctxPath: ctxPath list; } @@ -157,59 +157,30 @@ module CompletionContext = struct { positionContext; scope = Scope.create (); - currentlyExpecting = []; + currentlyExpecting = Unit; ctxPath = []; } let withResetCtx completionContext = - {completionContext with currentlyExpecting = []; ctxPath = []} + {completionContext with currentlyExpecting = Unit; ctxPath = []} let withScope scope completionContext = {completionContext with scope} - let addCurrentlyExpecting currentlyExpecting completionContext = - { - completionContext with - currentlyExpecting = - currentlyExpecting :: completionContext.currentlyExpecting; - } - - let addCurrentlyExpectingOpt currentlyExpecting completionContext = - match currentlyExpecting with - | None -> completionContext - | Some currentlyExpecting -> - { - completionContext with - currentlyExpecting = - currentlyExpecting :: completionContext.currentlyExpecting; - } + let setCurrentlyExpecting currentlyExpecting completionContext = + {completionContext with currentlyExpecting} let currentlyExpectingOrReset currentlyExpecting completionContext = match currentlyExpecting with - | None -> {completionContext with currentlyExpecting = []} - | Some currentlyExpecting -> - { - completionContext with - currentlyExpecting = - currentlyExpecting :: completionContext.currentlyExpecting; - } + | None -> {completionContext with currentlyExpecting = Unit} + | Some currentlyExpecting -> {completionContext with currentlyExpecting} let currentlyExpectingOrTypeAtLoc ~loc currentlyExpecting completionContext = match currentlyExpecting with - | None -> - { - completionContext with - currentlyExpecting = - TypeAtLoc loc :: completionContext.currentlyExpecting; - } - | Some currentlyExpecting -> - { - completionContext with - currentlyExpecting = - currentlyExpecting :: completionContext.currentlyExpecting; - } + | None -> {completionContext with currentlyExpecting = TypeAtLoc loc} + | Some currentlyExpecting -> {completionContext with currentlyExpecting} let withResetCurrentlyExpecting completionContext = - {completionContext with currentlyExpecting = [Unit]} + {completionContext with currentlyExpecting = Unit} let addCtxPathItem ctxPath completionContext = {completionContext with ctxPath = ctxPath :: completionContext.ctxPath} @@ -247,10 +218,7 @@ module CompletionInstruction = struct Cpattern { prefix; - rootType = - (match completionContext.currentlyExpecting with - | currentlyExpecting :: _ -> currentlyExpecting - | _ -> Unit); + rootType = completionContext.currentlyExpecting; ctxPath = completionContext.ctxPath; } @@ -258,10 +226,7 @@ module CompletionInstruction = struct Cexpression { prefix; - rootType = - (match completionContext.currentlyExpecting with - | currentlyExpecting :: _ -> currentlyExpecting - | _ -> Unit); + rootType = completionContext.currentlyExpecting; ctxPath = completionContext.ctxPath; } @@ -860,16 +825,16 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : match fnReturnConstraint with | None -> ( match completionContext.currentlyExpecting with - | Type ctxPath :: _ -> + | Type ctxPath -> (* Having a Type here already means the binding itself had a constraint on it. Since we're now moving into the function body, we'll need to ensure it's the function return type we use for completion, not the function type itself *) completionContext - |> CompletionContext.addCurrentlyExpecting + |> CompletionContext.setCurrentlyExpecting (FunctionReturnType ctxPath) | _ -> completionContext) | Some ctxPath -> completionContext - |> CompletionContext.addCurrentlyExpecting (Type ctxPath) + |> CompletionContext.setCurrentlyExpecting (Type ctxPath) in if locHasPos expr.pexp_loc then completeExpr ~completionContext expr else if checkIfExprHoleEmptyCursor ~completionContext expr then diff --git a/analysis/src/Completions.ml b/analysis/src/Completions.ml index 9e91d9ed7..3d8d86a6e 100644 --- a/analysis/src/Completions.ml +++ b/analysis/src/Completions.ml @@ -39,7 +39,5 @@ let getCompletions2 ~debug ~path ~pos ~currentFile ~forHover = (CompletionFrontEndNew.CompletionInstruction.toString res); Printf.printf "Scope: %i items\n" (List.length ctx.scope); Printf.printf "Looking for type: %s\n" - (match ctx.currentlyExpecting with - | currentlyExpecting :: _ -> - CompletionFrontEndNew.currentlyExpectingToString currentlyExpecting - | _ -> ""))) + (ctx.currentlyExpecting + |> CompletionFrontEndNew.currentlyExpectingToString))) diff --git a/analysis/tests/src/expected/CompletionNew.res.txt b/analysis/tests/src/expected/CompletionNew.res.txt index 93e01eb56..0fb342802 100644 --- a/analysis/tests/src/expected/CompletionNew.res.txt +++ b/analysis/tests/src/expected/CompletionNew.res.txt @@ -61,7 +61,7 @@ Looking for type: Type Complete2 src/CompletionNew.res 49:71 Result: Cexpression: ctxPath: CId(Value)=x, rootType: Unit Scope: 1 items -Looking for type: +Looking for type: Unit Complete2 src/CompletionNew.res 53:73 Result: Cexpression: ctxPath: CRecordField=nested->CRecordField=maybeVariant->CId(Value)=, rootType: Type @@ -76,7 +76,7 @@ Looking for type: Type Complete2 src/CompletionNew.res 61:58 Result: Cexpression: ctxPath: CId(Value)=doStuff, rootType: Unit Scope: 0 items -Looking for type: +Looking for type: Unit Complete2 src/CompletionNew.res 66:32 Result: Cexpression: ctxPath: CId(Value)=, rootType: Type From 3bc47b4842347df1c7d43aa7eb98b82c5968a1b1 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Sat, 26 Aug 2023 19:50:53 +0200 Subject: [PATCH 08/18] work --- analysis/src/CompletionFrontEndNew.ml | 135 +++++++++++++++--- analysis/tests/src/CompletionNew.res | 19 ++- .../tests/src/expected/CompletionNew.res.txt | 25 ++++ 3 files changed, 162 insertions(+), 17 deletions(-) diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml index 613343e9e..99d8a8d76 100644 --- a/analysis/src/CompletionFrontEndNew.ml +++ b/analysis/src/CompletionFrontEndNew.ml @@ -65,7 +65,9 @@ type ctxPath = | CId of string list * completionCategory (** A regular id of an expected category. `let fff = thisIsAnId` and `let fff = SomePath.alsoAnId` *) | CVariantPayload of {itemNum: int} - (** A variant payload. `Some()` = itemNum 0, `Whatever(true, f)` = itemNum 1*) + (** A variant payload. `Some()` = itemNum 0, `Whatever(true, f)` = itemNum 1 *) + | CTupleItem of {itemNum: int} + (** A tuple item. `(true, false, )` = itemNum 2 *) | CRecordField of {seenFields: string list; prefix: string} (** A record field. `let f = {on: true, s}` seenFields = [on], prefix = "s",*) | COption of ctxPath (** An option with an inner type. *) @@ -120,6 +122,7 @@ let rec ctxPathToString (ctxPath : ctxPath) = | Field -> "Field") (ident prefix) | CVariantPayload {itemNum} -> Printf.sprintf "CVariantPayload($%i)" itemNum + | CTupleItem {itemNum} -> Printf.sprintf "CTupleItem($%i)" itemNum | CRecordField {prefix} -> Printf.sprintf "CRecordField=%s" prefix | COption ctxPath -> Printf.sprintf "COption<%s>" (ctxPathToString ctxPath) | CArray ctxPath -> @@ -882,6 +885,22 @@ and completePattern ~(completionContext : CompletionContext.t) (* Can just continue into these patterns. *) if locHasPos pat.ppat_loc then p |> completePattern ~completionContext else None + | Ppat_or (p1, p2) -> ( + (* Try to complete each `or` pattern *) + let orPatCompleted = + [p1; p2] + |> List.find_map (fun p -> + if locHasPos p.Parsetree.ppat_loc then + completePattern ~completionContext p + else None) + in + match orPatCompleted with + | None + when CompletionPatterns.isPatternHole p1 + || CompletionPatterns.isPatternHole p2 -> + (* TODO(1) explain this *) + CompletionResult.pattern ~completionContext ~prefix:"" + | res -> res) | Ppat_var {txt; loc} -> (* A variable, like `{ someThing: someV}*) if locHasPos loc then @@ -897,7 +916,7 @@ and completePattern ~(completionContext : CompletionContext.t) in CompletionResult.pattern ~completionContext ~prefix:"" else None - | Ppat_record (fields, _) when locHasPos pat.ppat_loc -> ( + | Ppat_record (fields, _) -> ( (* Record body with fields, where we know the cursor is inside of the record body somewhere. *) let seenFields = fields @@ -938,22 +957,106 @@ and completePattern ~(completionContext : CompletionContext.t) in completePattern ~completionContext fieldPattern | None, None -> - (* We know the cursor is here, but it's not in a field name nor a field pattern. - Check empty field patterns. *) - None) - | Ppat_any | Ppat_tuple _ - | Ppat_construct ({loc = {loc_start = _; loc_end = _; _}; _}, _) + if locHasPos pat.ppat_loc then + (* We know the cursor is here, but it's not in a field name nor a field pattern. + Check empty field patterns. TODO(1) *) + None + else None) + | Ppat_tuple tupleItems -> ( + let tupleItemWithCursor = + tupleItems + |> Utils.findMapWithIndex (fun index (tupleItem : Parsetree.pattern) -> + if locHasPos tupleItem.ppat_loc then Some (index, tupleItem) + else None) + in + match tupleItemWithCursor with + | Some (itemNum, tupleItem) -> + let completionContext = + completionContext + |> CompletionContext.addCtxPathItem (CTupleItem {itemNum}) + in + completePattern ~completionContext tupleItem + | None -> + if locHasPos pat.ppat_loc then + (* We found no tuple item with the cursor, but we know the cursor is in the + pattern. Check if the user is trying to complete an empty tuple item *) + match completionContext.positionContext.charBeforeNoWhitespace with + | Some ',' -> + (* `(true, false, )` itemNum = 2, or `(true, , false)` itemNum = 1 *) + (* Figure out which tuple item is active. *) + let itemNum = ref (-1) in + tupleItems + |> List.iteri (fun index (pat : Parsetree.pattern) -> + if + completionContext.positionContext.beforeCursor + >= Loc.start pat.ppat_loc + then itemNum := index); + if !itemNum > -1 then + let completionContext = + completionContext + |> CompletionContext.addCtxPathItem + (CTupleItem {itemNum = !itemNum + 1}) + in + CompletionResult.pattern ~completionContext ~prefix:"" + else None + | Some '(' -> + (* TODO: This should work (start of tuple), but the parser is broken for this case: + let ( , true) = someRecordVar. If we fix that completing in the first position + could work too. *) + let completionContext = + completionContext + |> CompletionContext.addCtxPathItem (CTupleItem {itemNum = 0}) + in + CompletionResult.pattern ~completionContext ~prefix:"" + | _ -> None + else None) + | Ppat_array items -> + if locHasPos pat.ppat_loc then + if List.length items = 0 then + (* {someArr: []} *) + let completionContext = + completionContext |> CompletionContext.addCtxPathItem (CArray None) + in + CompletionResult.pattern ~completionContext ~prefix:"" + else + let arrayItemWithCursor = + items + |> List.find_opt (fun (item : Parsetree.pattern) -> + locHasPos item.ppat_loc) + in + match + ( arrayItemWithCursor, + completionContext.positionContext.charBeforeNoWhitespace ) + with + | Some item, _ -> + (* Found an array item with the cursor. *) + let completionContext = + completionContext |> CompletionContext.addCtxPathItem (CArray None) + in + completePattern ~completionContext item + | None, Some ',' -> + (* No array item with the cursor, but we know the cursor is in the pattern. + Check for "," which would signify the user is looking to add another + array item to the pattern. *) + let completionContext = + completionContext |> CompletionContext.addCtxPathItem (CArray None) + in + CompletionResult.pattern ~completionContext ~prefix:"" + | _ -> None + else None + | Ppat_any -> + (* We treat any `_` as an empty completion. This is mainly because we're + inserting `_` in snippets and automatically put the cursor there. So + letting it trigger an empty completion improves the ergonomics by a + lot. *) + if locHasPos pat.ppat_loc then + CompletionResult.pattern ~completionContext ~prefix:"" + else None + | Ppat_construct (_, _) | Ppat_variant (_, _) - | Ppat_record (_, _) - | Ppat_array _ - | Ppat_or - ( {ppat_loc = {loc_start = _; loc_end = _; _}; _}, - {ppat_loc = {loc_start = _; loc_end = _; _}; _} ) - | Ppat_type {loc = {loc_start = _; loc_end = _; _}; _} - | Ppat_unpack {loc = {loc_start = _; loc_end = _; _}; _} - | Ppat_extension ({loc = {loc_start = _; loc_end = _; _}; _}, _) -> + | Ppat_type _ | Ppat_unpack _ | Ppat_extension _ | Ppat_constant _ + | Ppat_interval _ -> None - | Ppat_constant _ | Ppat_interval _ -> None let completion ~currentFile ~path ~debug ~offset ~posCursor text = let positionContext = PositionContext.make ~offset ~posCursor text in diff --git a/analysis/tests/src/CompletionNew.res b/analysis/tests/src/CompletionNew.res index c6bf9d7ca..9fa93eca7 100644 --- a/analysis/tests/src/CompletionNew.res +++ b/analysis/tests/src/CompletionNew.res @@ -81,9 +81,26 @@ type fn = (~name: string=?, string) => bool // let someFun: fn = (str, ~name) => {let whatever = t} // ^co2 -// Let binding patterns +// == Let binding patterns == // let someVar: bool = // ^co2 // let {someField: s } = someRecordVar // ^co2 + +// == Tuple patterns == +// let (true, ) = someRecordVar +// ^co2 + +// let (true, true, , false) = someRecordVar +// ^co2 + +// == Arrays == +// let [ ] = someArr +// ^co2 + +// let [(true, [false, ])] = someArr +// ^co2 + +// let [(true, [false, f])] = someArr +// ^co2 diff --git a/analysis/tests/src/expected/CompletionNew.res.txt b/analysis/tests/src/expected/CompletionNew.res.txt index 0fb342802..2c9e959ec 100644 --- a/analysis/tests/src/expected/CompletionNew.res.txt +++ b/analysis/tests/src/expected/CompletionNew.res.txt @@ -113,3 +113,28 @@ Result: Cpattern: ctxPath: CRecordField=someField, rootType: Type +Complete2 src/CompletionNew.res 91:13 +Result: Cpattern: ctxPath: CTupleItem($1), rootType: Type +Scope: 0 items +Looking for type: Type + +Complete2 src/CompletionNew.res 94:20 +Result: Cpattern: ctxPath: CTupleItem($2), rootType: Type +Scope: 0 items +Looking for type: Type + +Complete2 src/CompletionNew.res 98:9 +Result: Cpattern: ctxPath: array, rootType: Type +Scope: 0 items +Looking for type: Type + +Complete2 src/CompletionNew.res 101:22 +Result: Cpattern: ctxPath: array->CTupleItem($1)->array, rootType: Type +Scope: 0 items +Looking for type: Type + +Complete2 src/CompletionNew.res 104:24 +Result: Cpattern: ctxPath: array->CTupleItem($1)->array, rootType: Type, prefix: "f" +Scope: 0 items +Looking for type: Type + From 971e7082cf3d0c5fe95449388259b2acf0aaef3f Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Sun, 27 Aug 2023 12:08:33 +0200 Subject: [PATCH 09/18] pipe completion --- analysis/src/CompletionFrontEndNew.ml | 214 +++++++++++++++--- analysis/src/new-completions-todo.md | 3 + analysis/tests/src/CompletionNew.res | 20 ++ .../tests/src/expected/CompletionNew.res.txt | 28 +++ 4 files changed, 233 insertions(+), 32 deletions(-) create mode 100644 analysis/src/new-completions-todo.md diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml index 99d8a8d76..cbfa6228d 100644 --- a/analysis/src/CompletionFrontEndNew.ml +++ b/analysis/src/CompletionFrontEndNew.ml @@ -60,6 +60,11 @@ end type completionCategory = Type | Value | Module | Field +type argumentLabel = + | Unlabelled of {argumentPosition: int} + | Labelled of string + | Optional of string + type ctxPath = | CUnknown (** Something that cannot be resolved right now *) | CId of string list * completionCategory @@ -87,6 +92,15 @@ type ctxPath = and the string is the name of the property we're accessing. *) | CApply of ctxPath * Asttypes.arg_label list (** Function application. `someFunction(someVar, ~otherLabel="hello")`. The ctxPath points to the function. *) + | CFunctionArgument of { + functionContextPath: ctxPath; + argumentLabel: argumentLabel; + } (** A function argument, either labelled or unlabelled.*) + | CPipe of { + ctxPath: ctxPath; (** Context path to the function being called. *) + id: string; + lhsLoc: Location.t; (** Location of the left hand side. *) + } (** Piped call. `foo->someFn`. *) let rec ctxPathToString (ctxPath : ctxPath) = match ctxPath with @@ -130,6 +144,16 @@ let rec ctxPathToString (ctxPath : ctxPath) = (match ctxPath with | None -> "" | Some ctxPath -> "<" ^ ctxPathToString ctxPath ^ ">") + | CFunctionArgument {functionContextPath; argumentLabel} -> + "CFunctionArgument " + ^ (functionContextPath |> ctxPathToString) + ^ "(" + ^ (match argumentLabel with + | Unlabelled {argumentPosition} -> "$" ^ string_of_int argumentPosition + | Labelled name -> "~" ^ name + | Optional name -> "~" ^ name ^ "=?") + ^ ")" + | CPipe {ctxPath; id} -> "(" ^ ctxPathToString ctxPath ^ ")->" ^ id type currentlyExpecting = | Unit (** Unit, (). Is what we reset to. *) @@ -437,6 +461,37 @@ let checkIfPatternHoleEmptyCursor ~(completionContext : CompletionContext.t) ~pos:completionContext.positionContext.beforeCursor = EmptyLoc +let completePipeChain (exp : Parsetree.expression) = + (* Complete the end of pipe chains by reconstructing the pipe chain as a single pipe, + so it can be completed. + Example: + someArray->Js.Array2.filter(v => v > 10)->Js.Array2.map(v => v + 2)-> + will complete as: + Js.Array2.map(someArray->Js.Array2.filter(v => v > 10), v => v + 2)-> + *) + match exp.pexp_desc with + (* When the left side of the pipe we're completing is a function application. + Example: someArray->Js.Array2.map(v => v + 2)-> *) + | Pexp_apply + ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}}, + [_; (_, {pexp_desc = Pexp_apply (d, _)})] ) -> + exprToContextPath exp |> Option.map (fun ctxPath -> (ctxPath, d.pexp_loc)) + (* When the left side of the pipe we're completing is an identifier application. + Example: someArray->filterAllTheGoodStuff-> *) + | Pexp_apply + ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}}, + [_; (_, {pexp_desc = Pexp_ident _; pexp_loc})] ) -> + exprToContextPath exp |> Option.map (fun ctxPath -> (ctxPath, pexp_loc)) + | _ -> None + +let completePipe ~id (lhs : Parsetree.expression) = + match completePipeChain lhs with + | Some (pipe, lhsLoc) -> Some (CPipe {ctxPath = pipe; id; lhsLoc}) + | None -> ( + match exprToContextPath lhs with + | Some pipe -> Some (CPipe {ctxPath = pipe; id; lhsLoc = lhs.pexp_loc}) + | None -> None) + (** Scopes *) let rec scopePattern ~scope (pat : Parsetree.pattern) = match pat.ppat_desc with @@ -554,40 +609,52 @@ and completeValueBinding ~(completionContext : CompletionContext.t) completionContext in completePattern ~completionContext vb.pvb_pat - else if locHasPos vb.pvb_expr.pexp_loc then + else if locHasPos vb.pvb_loc then + (* First try completing the expression. *) (* A let binding expression either has the constraint of the binding, or an inferred constraint (if it has been compiled), or no constraint. *) - let completionContext = + let completionContextForExprCompletion = completionContext |> CompletionContext.currentlyExpectingOrTypeAtLoc ~loc:vb.pvb_pat.ppat_loc bindingConstraint in - completeExpr ~completionContext vb.pvb_expr - else if locHasPos vb.pvb_loc then - (* In the binding but not in the pattern or expression means parser error recovery. - We can still complete the pattern or expression if we have enough information. *) - let exprHole = checkIfExprHoleEmptyCursor ~completionContext vb.pvb_expr in - let patHole = checkIfPatternHoleEmptyCursor ~completionContext vb.pvb_pat in - let exprCtxPath = exprToContextPath vb.pvb_expr in - (* Try the expression. Example: `let someVar: someType = *) - if exprHole then - let completionContext = - completionContext - |> CompletionContext.currentlyExpectingOrTypeAtLoc - ~loc:vb.pvb_pat.ppat_loc bindingConstraint + let completedExpression = + completeExpr ~completionContext:completionContextForExprCompletion + vb.pvb_expr + in + match completedExpression with + | Some res -> Some res + | None -> + (* In the binding but not in the pattern or expression means parser error recovery. + We can still complete the pattern or expression if we have enough information. *) + let exprHole = + checkIfExprHoleEmptyCursor + ~completionContext:completionContextForExprCompletion vb.pvb_expr in - CompletionResult.ctxPath (CId ([], Value)) completionContext - else if patHole then - let completionContext = - CompletionContext.currentlyExpectingOrTypeAtLoc - ~loc:vb.pvb_expr.pexp_loc - (match exprCtxPath with - | None -> None - | Some ctxPath -> Some (Type ctxPath)) - completionContext + let patHole = + checkIfPatternHoleEmptyCursor + ~completionContext:completionContextForExprCompletion vb.pvb_pat in - CompletionResult.pattern ~prefix:"" ~completionContext - else None + let exprCtxPath = exprToContextPath vb.pvb_expr in + (* Try the expression. Example: `let someVar: someType = *) + if exprHole then + let completionContext = + completionContextForExprCompletion + |> CompletionContext.currentlyExpectingOrTypeAtLoc + ~loc:vb.pvb_pat.ppat_loc bindingConstraint + in + CompletionResult.ctxPath (CId ([], Value)) completionContext + else if patHole then + let completionContext = + CompletionContext.currentlyExpectingOrTypeAtLoc + ~loc:vb.pvb_expr.pexp_loc + (match exprCtxPath with + | None -> None + | Some ctxPath -> Some (Type ctxPath)) + completionContextForExprCompletion + in + CompletionResult.pattern ~prefix:"" ~completionContext + else None else None and completeValueBindings ~(completionContext : CompletionContext.t) @@ -605,6 +672,7 @@ and completeValueBindings ~(completionContext : CompletionContext.t) |> Utils.findMap (fun (vb : Parsetree.value_binding) -> completeValueBinding ~completionContext vb) +(** Completes an expression. Designed to run without pre-checking if the cursor is in the expression. *) and completeExpr ~completionContext (expr : Parsetree.expression) : CompletionResult.t = let locHasPos = completionContext.positionContext.locHasPos in @@ -689,15 +757,14 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : CompletionResult.ctxPath (CId (flattenLidCheckDot ~completionContext fieldName, Value)) completionContext - else if locHasPos fieldExpr.pexp_loc then + else completeExpr ~completionContext: (CompletionContext.addCtxPathItem (CRecordField {prefix = fieldName.txt |> Longident.last; seenFields}) completionContext) - fieldExpr - else None) + fieldExpr) in match fieldToComplete with | None -> ( @@ -795,13 +862,96 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : else if locHasPos nextExpr.pexp_loc then completeExpr ~completionContext nextExpr else None - | Pexp_apply (fnExpr, _args) -> + (* == Pipes == *) + | Pexp_apply + ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u"); loc = opLoc}}, + [ + (_, lhs); + (_, {pexp_desc = Pexp_extension _; pexp_loc = {loc_ghost = true}}); + ] ) + when locHasPos opLoc -> ( + (* Case foo-> when the parser adds a ghost expression to the rhs + so the apply expression does not include the cursor *) + match completePipe lhs ~id:"" with + | None -> None + | Some cpipe -> + completionContext |> CompletionContext.withResetCtx + |> CompletionResult.ctxPath cpipe) + | Pexp_apply + ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}}, + [ + (_, lhs); + (_, {pexp_desc = Pexp_ident {txt = Longident.Lident id; loc}}); + ] ) + when locHasPos loc -> ( + (* foo->id *) + match completePipe lhs ~id with + | None -> None + | Some cpipe -> + completionContext |> CompletionContext.withResetCtx + |> CompletionResult.ctxPath cpipe) + | Pexp_apply + ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u"); loc = opLoc}}, + [(_, lhs); _] ) + when Loc.end_ opLoc = completionContext.positionContext.cursor -> ( + match completePipe lhs ~id:"" with + | None -> None + | Some cpipe -> + completionContext |> CompletionContext.withResetCtx + |> CompletionResult.ctxPath cpipe) + | Pexp_apply ({pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}}, [_; _]) + -> + (* Ignore any other pipe. *) + None + | Pexp_apply (fnExpr, args) -> ( if locHasPos fnExpr.pexp_loc then + (* someFn(). Cursor in the function expression itself. *) completeExpr ~completionContext:(CompletionContext.withResetCtx completionContext) fnExpr - else (* TODO: Complete args. Pipes *) - None + else + (* Check if the args has the cursor. *) + (* Keep track of the positions of unlabelled arguments. *) + let unlabelledArgPos = ref (-1) in + let fnContextPath = exprToContextPath fnExpr in + let argWithCursorInExpr = + args + |> List.find_opt + (fun ((arg, argExpr) : Asttypes.arg_label * Parsetree.expression) + -> + if arg = Nolabel then unlabelledArgPos := !unlabelledArgPos + 1; + locHasPos argExpr.pexp_loc) + in + (* TODO: Complete labelled argument names, pipes *) + let makeCompletionContextWithArgumentLabel argumentLabel + ~functionContextPath = + completionContext |> CompletionContext.withResetCtx + |> CompletionContext.currentlyExpectingOrReset + (Some + (Type (CFunctionArgument {functionContextPath; argumentLabel}))) + in + match (argWithCursorInExpr, fnContextPath) with + | None, _ -> None + | Some (Nolabel, argExpr), Some functionContextPath -> + let completionContext = + makeCompletionContextWithArgumentLabel + (Unlabelled {argumentPosition = !unlabelledArgPos}) + ~functionContextPath + in + completeExpr ~completionContext argExpr + | Some (Labelled label, argExpr), Some functionContextPath -> + let completionContext = + makeCompletionContextWithArgumentLabel (Labelled label) + ~functionContextPath + in + completeExpr ~completionContext argExpr + | Some (Optional label, argExpr), Some functionContextPath -> + let completionContext = + makeCompletionContextWithArgumentLabel (Optional label) + ~functionContextPath + in + completeExpr ~completionContext argExpr + | _ -> None) | Pexp_fun _ -> (* We've found a function definition, like `let whatever = (someStr: string) => {}` *) let rec loopFnExprs ~(completionContext : CompletionContext.t) diff --git a/analysis/src/new-completions-todo.md b/analysis/src/new-completions-todo.md new file mode 100644 index 000000000..b8531fcce --- /dev/null +++ b/analysis/src/new-completions-todo.md @@ -0,0 +1,3 @@ +## Questions + +- Figure out location for completeExpr - when do we need to check locs, and when not? diff --git a/analysis/tests/src/CompletionNew.res b/analysis/tests/src/CompletionNew.res index 9fa93eca7..9a26a7de0 100644 --- a/analysis/tests/src/CompletionNew.res +++ b/analysis/tests/src/CompletionNew.res @@ -104,3 +104,23 @@ type fn = (~name: string=?, string) => bool // let [(true, [false, f])] = someArr // ^co2 + +// == Apply == +// let x = if true && f {None} +// ^co2 + +// let x = someFunc(() => {let x = true; f}) +// ^co2 + +// let x = someFunc(~labelledArg=f) +// ^co2 + +// let x = someFunc(~labelledArg=) +// ^co2 + +// == Pipes == +// let x = foo->id +// ^co2 + +// let x = foo-> +// ^co2 diff --git a/analysis/tests/src/expected/CompletionNew.res.txt b/analysis/tests/src/expected/CompletionNew.res.txt index 2c9e959ec..d533884d7 100644 --- a/analysis/tests/src/expected/CompletionNew.res.txt +++ b/analysis/tests/src/expected/CompletionNew.res.txt @@ -138,3 +138,31 @@ Result: Cpattern: ctxPath: array->CTupleItem($1)->array, rootType: Type +Complete2 src/CompletionNew.res 108:23 +Result: Cexpression: ctxPath: CId(Value)=f, rootType: Type +Scope: 0 items +Looking for type: Type + +Complete2 src/CompletionNew.res 111:42 +Result: Cexpression: ctxPath: CId(Value)=f, rootType: FunctionReturnType +Scope: 1 items +Looking for type: FunctionReturnType + +Complete2 src/CompletionNew.res 114:34 +Result: Cexpression: ctxPath: CId(Value)=f, rootType: Type +Scope: 0 items +Looking for type: Type + +Complete2 src/CompletionNew.res 117:33 +No completions + +Complete2 src/CompletionNew.res 121:17 +Result: CtxPath: (CId(Value)=foo)->id +Scope: 0 items +Looking for type: Unit + +Complete2 src/CompletionNew.res 124:16 +Result: CtxPath: (CId(Value)=foo)-> +Scope: 0 items +Looking for type: Unit + From 4200241d809f357754b9a9e956400ccc0f7664ab Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Sun, 27 Aug 2023 19:04:23 +0200 Subject: [PATCH 10/18] more piping --- analysis/src/CompletionFrontEndNew.ml | 31 +++++++++++-------- analysis/src/new-completions-todo.md | 1 + analysis/tests/src/CompletionNew.res | 3 ++ .../tests/src/expected/CompletionNew.res.txt | 5 +++ 4 files changed, 27 insertions(+), 13 deletions(-) diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml index cbfa6228d..e15ec25a6 100644 --- a/analysis/src/CompletionFrontEndNew.ml +++ b/analysis/src/CompletionFrontEndNew.ml @@ -188,7 +188,7 @@ module CompletionContext = struct ctxPath = []; } - let withResetCtx completionContext = + let resetCtx completionContext = {completionContext with currentlyExpecting = Unit; ctxPath = []} let withScope scope completionContext = {completionContext with scope} @@ -597,7 +597,7 @@ and completeValueBinding ~(completionContext : CompletionContext.t) in (* Always reset the context when completing value bindings, since they create their own context. *) - let completionContext = CompletionContext.withResetCtx completionContext in + let completionContext = CompletionContext.resetCtx completionContext in if locHasPos vb.pvb_pat.ppat_loc then (* Completing the pattern of the binding. `let {} = someRecordVariable`. Ensure the context carries the root type of `someRecordVariable`. *) @@ -831,7 +831,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : if locHasPos condition.pexp_loc then (* TODO: I guess we could set looking for to "bool" here, since it's the if condition *) completeExpr - ~completionContext:(CompletionContext.withResetCtx completionContext) + ~completionContext:(CompletionContext.resetCtx completionContext) condition else if locHasPos then_.pexp_loc then completeExpr ~completionContext then_ else @@ -857,7 +857,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : | Pexp_sequence (evalExpr, nextExpr) -> if locHasPos evalExpr.pexp_loc then completeExpr - ~completionContext:(CompletionContext.withResetCtx completionContext) + ~completionContext:(CompletionContext.resetCtx completionContext) evalExpr else if locHasPos nextExpr.pexp_loc then completeExpr ~completionContext nextExpr @@ -875,7 +875,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : match completePipe lhs ~id:"" with | None -> None | Some cpipe -> - completionContext |> CompletionContext.withResetCtx + completionContext |> CompletionContext.resetCtx |> CompletionResult.ctxPath cpipe) | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}}, @@ -888,7 +888,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : match completePipe lhs ~id with | None -> None | Some cpipe -> - completionContext |> CompletionContext.withResetCtx + completionContext |> CompletionContext.resetCtx |> CompletionResult.ctxPath cpipe) | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u"); loc = opLoc}}, @@ -897,17 +897,22 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : match completePipe lhs ~id:"" with | None -> None | Some cpipe -> - completionContext |> CompletionContext.withResetCtx + completionContext |> CompletionContext.resetCtx |> CompletionResult.ctxPath cpipe) - | Pexp_apply ({pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}}, [_; _]) - -> - (* Ignore any other pipe. *) - None + | Pexp_apply + ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}}, + [(_, lhs); (_, rhs)] ) -> + (* Descend into pipe parts if none of the special cases above works + but the cursor is somewhere here. *) + let completionContext = completionContext |> CompletionContext.resetCtx in + if locHasPos lhs.pexp_loc then completeExpr ~completionContext lhs + else if locHasPos rhs.pexp_loc then completeExpr ~completionContext rhs + else None | Pexp_apply (fnExpr, args) -> ( if locHasPos fnExpr.pexp_loc then (* someFn(). Cursor in the function expression itself. *) completeExpr - ~completionContext:(CompletionContext.withResetCtx completionContext) + ~completionContext:(CompletionContext.resetCtx completionContext) fnExpr else (* Check if the args has the cursor. *) @@ -925,7 +930,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : (* TODO: Complete labelled argument names, pipes *) let makeCompletionContextWithArgumentLabel argumentLabel ~functionContextPath = - completionContext |> CompletionContext.withResetCtx + completionContext |> CompletionContext.resetCtx |> CompletionContext.currentlyExpectingOrReset (Some (Type (CFunctionArgument {functionContextPath; argumentLabel}))) diff --git a/analysis/src/new-completions-todo.md b/analysis/src/new-completions-todo.md index b8531fcce..75e7e1238 100644 --- a/analysis/src/new-completions-todo.md +++ b/analysis/src/new-completions-todo.md @@ -1,3 +1,4 @@ ## Questions - Figure out location for completeExpr - when do we need to check locs, and when not? +- Pipe PPX transform, should we run it ourselves in the editor tooling? diff --git a/analysis/tests/src/CompletionNew.res b/analysis/tests/src/CompletionNew.res index 9a26a7de0..1bc32d451 100644 --- a/analysis/tests/src/CompletionNew.res +++ b/analysis/tests/src/CompletionNew.res @@ -124,3 +124,6 @@ type fn = (~name: string=?, string) => bool // let x = foo-> // ^co2 + +// let x = foo->M +// ^co2 diff --git a/analysis/tests/src/expected/CompletionNew.res.txt b/analysis/tests/src/expected/CompletionNew.res.txt index d533884d7..fbea62e3f 100644 --- a/analysis/tests/src/expected/CompletionNew.res.txt +++ b/analysis/tests/src/expected/CompletionNew.res.txt @@ -166,3 +166,8 @@ Result: CtxPath: (CId(Value)=foo)-> Scope: 0 items Looking for type: Unit +Complete2 src/CompletionNew.res 127:17 +Result: Cexpression: ctxPath: CId(Module)=M, rootType: Unit, prefix: "M" +Scope: 0 items +Looking for type: Unit + From 7e69428ebcde570646e09ed76dcddde6cc634c14 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Sun, 27 Aug 2023 21:50:24 +0200 Subject: [PATCH 11/18] functions and labels --- analysis/src/CompletionFrontEndNew.ml | 163 ++++++++++++++---- analysis/src/new-completions-todo.md | 1 + analysis/tests/src/CompletionNew.res | 14 +- .../tests/src/expected/CompletionNew.res.txt | 14 +- 4 files changed, 154 insertions(+), 38 deletions(-) diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml index e15ec25a6..986e21032 100644 --- a/analysis/src/CompletionFrontEndNew.ml +++ b/analysis/src/CompletionFrontEndNew.ml @@ -238,6 +238,13 @@ module CompletionInstruction = struct to the record itself. *) prefix: string; } (** Completing inside of an expression. *) + | CnamedArg of { + ctxPath: ctxPath; + (** Context path to the function with the argument. *) + seenLabels: string list; + (** All the already seen labels in the function call. *) + prefix: string; (** The text the user has written so far.*) + } let ctxPath ctxPath = CtxPath ctxPath @@ -257,6 +264,9 @@ module CompletionInstruction = struct ctxPath = completionContext.ctxPath; } + let namedArg ~prefix ~functionContextPath ~seenLabels = + CnamedArg {prefix; ctxPath = functionContextPath; seenLabels} + let toString (c : t) = match c with | CtxPath ctxPath -> @@ -276,6 +286,10 @@ module CompletionInstruction = struct (match prefix with | "" -> "" | prefix -> Printf.sprintf ", prefix: \"%s\"" prefix) + | CnamedArg {prefix; ctxPath; seenLabels} -> + "CnamedArg(" + ^ (ctxPath |> ctxPathToString) + ^ ", " ^ str prefix ^ ", " ^ (seenLabels |> list) ^ ")" end module CompletionResult = struct @@ -298,6 +312,12 @@ module CompletionResult = struct Some ( CompletionInstruction.expression ~completionContext ~prefix, completionContext ) + + let namedArg ~(completionContext : CompletionContext.t) ~prefix ~seenLabels + ~functionContextPath = + Some + ( CompletionInstruction.namedArg ~functionContextPath ~prefix ~seenLabels, + completionContext ) end let flattenLidCheckDot ?(jsx = true) ~(completionContext : CompletionContext.t) @@ -908,26 +928,35 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : if locHasPos lhs.pexp_loc then completeExpr ~completionContext lhs else if locHasPos rhs.pexp_loc then completeExpr ~completionContext rhs else None + | Pexp_apply (fnExpr, _args) when locHasPos fnExpr.pexp_loc -> + (* Handle when the cursor is in the function expression itself. *) + fnExpr + |> completeExpr + ~completionContext:(completionContext |> CompletionContext.resetCtx) | Pexp_apply (fnExpr, args) -> ( - if locHasPos fnExpr.pexp_loc then - (* someFn(). Cursor in the function expression itself. *) - completeExpr - ~completionContext:(CompletionContext.resetCtx completionContext) - fnExpr - else - (* Check if the args has the cursor. *) - (* Keep track of the positions of unlabelled arguments. *) - let unlabelledArgPos = ref (-1) in - let fnContextPath = exprToContextPath fnExpr in - let argWithCursorInExpr = - args - |> List.find_opt - (fun ((arg, argExpr) : Asttypes.arg_label * Parsetree.expression) - -> - if arg = Nolabel then unlabelledArgPos := !unlabelledArgPos + 1; - locHasPos argExpr.pexp_loc) + (* Handle when the cursor isn't in the function expression. Possibly in an argument. *) + (* TODO: Are we moving into all expressions we need here? The fn expression itself? *) + let fnContextPath = exprToContextPath fnExpr in + match fnContextPath with + | None -> None + | Some functionContextPath -> ( + let beforeCursor = completionContext.positionContext.beforeCursor in + let isPipedExpr = false (* TODO: Implement *) in + let args = extractExpApplyArgs ~args in + let endPos = Loc.end_ expr.pexp_loc in + let posAfterFnExpr = Loc.end_ fnExpr.pexp_loc in + let fnHasCursor = + posAfterFnExpr <= beforeCursor && beforeCursor < endPos + in + (* All of the labels already written in the application. *) + let seenLabels = + List.fold_right + (fun arg seenLabels -> + match arg with + | {label = Some labelled} -> labelled.name :: seenLabels + | {label = None} -> seenLabels) + args [] in - (* TODO: Complete labelled argument names, pipes *) let makeCompletionContextWithArgumentLabel argumentLabel ~functionContextPath = completionContext |> CompletionContext.resetCtx @@ -935,28 +964,90 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : (Some (Type (CFunctionArgument {functionContextPath; argumentLabel}))) in - match (argWithCursorInExpr, fnContextPath) with - | None, _ -> None - | Some (Nolabel, argExpr), Some functionContextPath -> + (* Piped expressions always have an initial unlabelled argument. *) + let unlabelledCount = ref (if isPipedExpr then 1 else 0) in + let rec loop args = + match args with + | {label = Some labelled; exp} :: rest -> + if labelled.posStart <= beforeCursor && beforeCursor < labelled.posEnd + then + (* Complete for a label: `someFn(~labelNam)` *) + CompletionResult.namedArg ~completionContext ~prefix:labelled.name + ~seenLabels ~functionContextPath + else if locHasPos exp.pexp_loc then + (* Completing in the assignment of labelled argument, with a value. + `someFn(~someLabel=someIden)` *) + let completionContext = + makeCompletionContextWithArgumentLabel (Labelled labelled.name) + ~functionContextPath + in + completeExpr ~completionContext exp + else if CompletionExpressions.isExprHole exp then + (* Completing in the assignment of labelled argument, with no value yet. + The parser inserts an expr hole. `someFn(~someLabel=)` *) + let completionContext = + makeCompletionContextWithArgumentLabel (Labelled labelled.name) + ~functionContextPath + in + CompletionResult.expression ~completionContext ~prefix:"" + else loop rest + | {label = None; exp} :: rest -> + if Res_parsetree_viewer.isTemplateLiteral exp then + (* Ignore template literals, or we mess up completion inside of them. *) + None + else if locHasPos exp.pexp_loc then + (* Completing in an unlabelled argument with a value. `someFn(someV) *) + let completionContext = + makeCompletionContextWithArgumentLabel + (Unlabelled {argumentPosition = !unlabelledCount}) + ~functionContextPath + in + completeExpr ~completionContext exp + else if CompletionExpressions.isExprHole exp then + (* Completing in an unlabelled argument without a value. `someFn(true, ) *) + let completionContext = + makeCompletionContextWithArgumentLabel + (Unlabelled {argumentPosition = !unlabelledCount}) + ~functionContextPath + in + CompletionResult.expression ~completionContext ~prefix:"" + else ( + unlabelledCount := !unlabelledCount + 1; + loop rest) + | [] -> + if fnHasCursor then + (* No matches, but we know we have the cursor. Check the first char + behind the cursor. '~' means label completion. *) + match completionContext.positionContext.charBeforeCursor with + | Some '~' -> + CompletionResult.namedArg ~completionContext ~prefix:"" + ~seenLabels ~functionContextPath + | _ -> + (* No '~'. Assume we want to complete for the next unlabelled argument. *) + let completionContext = + makeCompletionContextWithArgumentLabel + (Unlabelled {argumentPosition = !unlabelledCount}) + ~functionContextPath + in + CompletionResult.expression ~completionContext ~prefix:"" + else None + in + match args with + (* Special handling for empty fn calls, e.g. `let _ = someFn()` *) + | [ + { + label = None; + exp = {pexp_desc = Pexp_construct ({txt = Lident "()"}, _)}; + }; + ] + when fnHasCursor -> let completionContext = makeCompletionContextWithArgumentLabel - (Unlabelled {argumentPosition = !unlabelledArgPos}) - ~functionContextPath - in - completeExpr ~completionContext argExpr - | Some (Labelled label, argExpr), Some functionContextPath -> - let completionContext = - makeCompletionContextWithArgumentLabel (Labelled label) + (Unlabelled {argumentPosition = 0}) ~functionContextPath in - completeExpr ~completionContext argExpr - | Some (Optional label, argExpr), Some functionContextPath -> - let completionContext = - makeCompletionContextWithArgumentLabel (Optional label) - ~functionContextPath - in - completeExpr ~completionContext argExpr - | _ -> None) + CompletionResult.expression ~completionContext ~prefix:"" + | _ -> loop args)) | Pexp_fun _ -> (* We've found a function definition, like `let whatever = (someStr: string) => {}` *) let rec loopFnExprs ~(completionContext : CompletionContext.t) diff --git a/analysis/src/new-completions-todo.md b/analysis/src/new-completions-todo.md index 75e7e1238..adced1784 100644 --- a/analysis/src/new-completions-todo.md +++ b/analysis/src/new-completions-todo.md @@ -2,3 +2,4 @@ - Figure out location for completeExpr - when do we need to check locs, and when not? - Pipe PPX transform, should we run it ourselves in the editor tooling? +- Is there a practical difference btween Cexpression and Cpath? diff --git a/analysis/tests/src/CompletionNew.res b/analysis/tests/src/CompletionNew.res index 1bc32d451..b6e82a89d 100644 --- a/analysis/tests/src/CompletionNew.res +++ b/analysis/tests/src/CompletionNew.res @@ -23,7 +23,7 @@ type nestedRecord = { maybeVariant?: someVariant, } -type someRecord = {nested: option, variant: someVariant} +type someRecord = {nested: option, variant: someVariant, someString: string} // let myFunc: someRecord = {} // ^co2 @@ -127,3 +127,15 @@ type fn = (~name: string=?, string) => bool // let x = foo->M // ^co2 + +// == Function arguments == + +let someFun = (~firstLabel, ~secondLabel=?, r: someRecord) => { + firstLabel ++ secondLabel->Belt.Option.getWithDefault("") ++ r.someString +} + +// let ff = someFun(~secondLabel, ~f) +// ^co2 + +// let ff = someFun(~secondLabel, ~f) +// ^co2 diff --git a/analysis/tests/src/expected/CompletionNew.res.txt b/analysis/tests/src/expected/CompletionNew.res.txt index fbea62e3f..5c01c1e2a 100644 --- a/analysis/tests/src/expected/CompletionNew.res.txt +++ b/analysis/tests/src/expected/CompletionNew.res.txt @@ -154,7 +154,9 @@ Scope: 0 items Looking for type: Type Complete2 src/CompletionNew.res 117:33 -No completions +Result: Cexpression: ctxPath: , rootType: Type +Scope: 0 items +Looking for type: Type Complete2 src/CompletionNew.res 121:17 Result: CtxPath: (CId(Value)=foo)->id @@ -171,3 +173,13 @@ Result: Cexpression: ctxPath: CId(Module)=M, rootType: Unit, prefix: "M" Scope: 0 items Looking for type: Unit +Complete2 src/CompletionNew.res 136:36 +Result: CnamedArg(CId(Value)=someFun, f, [secondLabel, f]) +Scope: 0 items +Looking for type: TypeAtLoc: [136:7->136:9] + +Complete2 src/CompletionNew.res 139:37 +Result: Cexpression: ctxPath: , rootType: Type +Scope: 0 items +Looking for type: Type + From cc8efb4d4f113e03242046c687fbf2c6f7b71e95 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Sun, 27 Aug 2023 21:58:13 +0200 Subject: [PATCH 12/18] fix scope --- analysis/src/CompletionFrontEndNew.ml | 16 +++- .../tests/src/expected/CompletionNew.res.txt | 74 +++++++++---------- 2 files changed, 50 insertions(+), 40 deletions(-) diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml index 986e21032..bba3a2ed5 100644 --- a/analysis/src/CompletionFrontEndNew.ml +++ b/analysis/src/CompletionFrontEndNew.ml @@ -587,12 +587,22 @@ let scopeModuleBinding ~scope (mb : Parsetree.module_binding) = let scopeModuleDeclaration ~scope (md : Parsetree.module_declaration) = scope |> Scope.addModule ~name:md.pmd_name.txt ~loc:md.pmd_name.loc -let rec completeFromStructure ~completionContext +let rec completeFromStructure ~(completionContext : CompletionContext.t) (structure : Parsetree.structure) : CompletionResult.t = - (* TODO: Scope? *) + let scope = ref completionContext.scope in structure |> Utils.findMap (fun (item : Parsetree.structure_item) -> - completeStructureItem ~completionContext item) + let res = + completeStructureItem + ~completionContext: + (CompletionContext.withScope !scope completionContext) + item + in + (match item.pstr_desc with + | Pstr_value (_, valueBindings) -> + scope := scopeValueBindings ~scope:!scope valueBindings + | _ -> ()); + res) and completeStructureItem ~(completionContext : CompletionContext.t) (item : Parsetree.structure_item) : CompletionResult.t = diff --git a/analysis/tests/src/expected/CompletionNew.res.txt b/analysis/tests/src/expected/CompletionNew.res.txt index 5c01c1e2a..f2a5741c3 100644 --- a/analysis/tests/src/expected/CompletionNew.res.txt +++ b/analysis/tests/src/expected/CompletionNew.res.txt @@ -1,185 +1,185 @@ Complete2 src/CompletionNew.res 2:17 Result: Cexpression: ctxPath: CId(Value)=m, rootType: TypeAtLoc: [2:7->2:13] -Scope: 0 items +Scope: 1 items Looking for type: TypeAtLoc: [2:7->2:13] Complete2 src/CompletionNew.res 7:30 Result: Cexpression: ctxPath: CId(Module)=O, rootType: Type, prefix: "O" -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 10:36 Result: Cexpression: ctxPath: CVariantPayload($0)->CId(Value)=t, rootType: Type -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 13:42 Result: Cexpression: ctxPath: CVariantPayload($1)->CId(Module)=S, rootType: Type, prefix: "S" -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 16:47 Result: Cexpression: ctxPath: CVariantPayload($1)->CVariantPayload($0)->CId(Module)=O, rootType: Type, prefix: "O" -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 27:29 Result: Cexpression: ctxPath: CRecordField=, rootType: Type -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 30:30 Result: Cexpression: ctxPath: CRecordField=n, rootType: Type, prefix: "n" -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 33:39 Result: Cexpression: ctxPath: CRecordField=variant->CId(Module)=O, rootType: Type, prefix: "O" -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 36:66 Result: Cexpression: ctxPath: CRecordField=nested->CRecordField=maybeVariant->CVariantPayload($1)->CId(Value)=t, rootType: Type -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 39:66 Result: Cexpression: ctxPath: CRecordField=variant, rootType: Type -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 42:56 Result: Cexpression: ctxPath: CRecordField=nested->CRecordField=, rootType: Type -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 45:57 Result: Cexpression: ctxPath: CRecordField=, rootType: Type -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 49:71 Result: Cexpression: ctxPath: CId(Value)=x, rootType: Unit -Scope: 1 items +Scope: 2 items Looking for type: Unit Complete2 src/CompletionNew.res 53:73 Result: Cexpression: ctxPath: CRecordField=nested->CRecordField=maybeVariant->CId(Value)=, rootType: Type -Scope: 1 items +Scope: 2 items Looking for type: Type Complete2 src/CompletionNew.res 57:85 Result: Cexpression: ctxPath: CRecordField=nested->CRecordField=maybeVariant->CId(Value)=v, rootType: Type -Scope: 1 items +Scope: 2 items Looking for type: Type Complete2 src/CompletionNew.res 61:58 Result: Cexpression: ctxPath: CId(Value)=doStuff, rootType: Unit -Scope: 0 items +Scope: 1 items Looking for type: Unit Complete2 src/CompletionNew.res 66:32 Result: Cexpression: ctxPath: CId(Value)=, rootType: Type -Scope: 1 items +Scope: 2 items Looking for type: Type Complete2 src/CompletionNew.res 69:38 Result: Cexpression: ctxPath: CRecordField=, rootType: FunctionReturnType -Scope: 2 items +Scope: 3 items Looking for type: FunctionReturnType Complete2 src/CompletionNew.res 72:72 Result: Cexpression: ctxPath: CId(Value)=, rootType: FunctionReturnType -Scope: 3 items +Scope: 4 items Looking for type: FunctionReturnType Complete2 src/CompletionNew.res 76:60 Result: Cexpression: ctxPath: CId(Value)=t, rootType: Type -Scope: 2 items +Scope: 3 items Looking for type: Type Complete2 src/CompletionNew.res 80:54 Result: Cexpression: ctxPath: CId(Value)=t, rootType: TypeAtLoc: [80:42->80:50] -Scope: 2 items +Scope: 3 items Looking for type: TypeAtLoc: [80:42->80:50] Complete2 src/CompletionNew.res 84:22 Result: CtxPath: CId(Value)= -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 87:20 Result: Cpattern: ctxPath: CRecordField=someField, rootType: Type, prefix: "s" -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 91:13 Result: Cpattern: ctxPath: CTupleItem($1), rootType: Type -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 94:20 Result: Cpattern: ctxPath: CTupleItem($2), rootType: Type -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 98:9 Result: Cpattern: ctxPath: array, rootType: Type -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 101:22 Result: Cpattern: ctxPath: array->CTupleItem($1)->array, rootType: Type -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 104:24 Result: Cpattern: ctxPath: array->CTupleItem($1)->array, rootType: Type, prefix: "f" -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 108:23 Result: Cexpression: ctxPath: CId(Value)=f, rootType: Type -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 111:42 Result: Cexpression: ctxPath: CId(Value)=f, rootType: FunctionReturnType -Scope: 1 items +Scope: 2 items Looking for type: FunctionReturnType Complete2 src/CompletionNew.res 114:34 Result: Cexpression: ctxPath: CId(Value)=f, rootType: Type -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 117:33 Result: Cexpression: ctxPath: , rootType: Type -Scope: 0 items +Scope: 1 items Looking for type: Type Complete2 src/CompletionNew.res 121:17 Result: CtxPath: (CId(Value)=foo)->id -Scope: 0 items +Scope: 1 items Looking for type: Unit Complete2 src/CompletionNew.res 124:16 Result: CtxPath: (CId(Value)=foo)-> -Scope: 0 items +Scope: 1 items Looking for type: Unit Complete2 src/CompletionNew.res 127:17 Result: Cexpression: ctxPath: CId(Module)=M, rootType: Unit, prefix: "M" -Scope: 0 items +Scope: 1 items Looking for type: Unit Complete2 src/CompletionNew.res 136:36 Result: CnamedArg(CId(Value)=someFun, f, [secondLabel, f]) -Scope: 0 items +Scope: 2 items Looking for type: TypeAtLoc: [136:7->136:9] Complete2 src/CompletionNew.res 139:37 Result: Cexpression: ctxPath: , rootType: Type -Scope: 0 items +Scope: 2 items Looking for type: Type From 4bbea105c6db23e75c35c63157674afb458403c5 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Mon, 28 Aug 2023 09:56:17 +0200 Subject: [PATCH 13/18] jsx --- analysis/src/CompletionFrontEndNew.ml | 151 ++++++++++++++++-- analysis/src/new-completions-todo.md | 5 + analysis/tests/src/CompletionNew.res | 22 +++ .../tests/src/expected/CompletionNew.res.txt | 35 ++++ 4 files changed, 201 insertions(+), 12 deletions(-) diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml index bba3a2ed5..e25235d60 100644 --- a/analysis/src/CompletionFrontEndNew.ml +++ b/analysis/src/CompletionFrontEndNew.ml @@ -101,6 +101,11 @@ type ctxPath = id: string; lhsLoc: Location.t; (** Location of the left hand side. *) } (** Piped call. `foo->someFn`. *) + | CJsxPropValue of { + pathToComponent: string list; + (** The path to the component this property is from. *) + propName: string; (** The prop name we're going through. *) + } (** A JSX property. *) let rec ctxPathToString (ctxPath : ctxPath) = match ctxPath with @@ -109,6 +114,8 @@ let rec ctxPathToString (ctxPath : ctxPath) = | CFloat -> "float" | CInt -> "int" | CString -> "string" + | CJsxPropValue {pathToComponent; propName} -> + "CJsxPropValue " ^ (pathToComponent |> list) ^ " " ^ propName | CAwait ctxPath -> Printf.sprintf "await %s" (ctxPathToString ctxPath) | CApply (ctxPath, args) -> Printf.sprintf "%s(%s)" (ctxPathToString ctxPath) @@ -245,6 +252,15 @@ module CompletionInstruction = struct (** All the already seen labels in the function call. *) prefix: string; (** The text the user has written so far.*) } + | Cjsx of { + pathToComponent: string list; + (** The path to the component: `["M", "Comp"]`. *) + prefix: string; (** What the user has already written. `"id"`. *) + seenProps: string list; + (** A list of all of the props that has already been entered.*) + } + | ChtmlElement of {prefix: string (** What the user has written so far. *)} + (** Completing for a regular HTML element. *) let ctxPath ctxPath = CtxPath ctxPath @@ -267,6 +283,11 @@ module CompletionInstruction = struct let namedArg ~prefix ~functionContextPath ~seenLabels = CnamedArg {prefix; ctxPath = functionContextPath; seenLabels} + let jsx ~prefix ~pathToComponent ~seenProps = + Cjsx {prefix; pathToComponent; seenProps} + + let htmlElement ~prefix = ChtmlElement {prefix} + let toString (c : t) = match c with | CtxPath ctxPath -> @@ -290,34 +311,51 @@ module CompletionInstruction = struct "CnamedArg(" ^ (ctxPath |> ctxPathToString) ^ ", " ^ str prefix ^ ", " ^ (seenLabels |> list) ^ ")" + | Cjsx {prefix; pathToComponent; seenProps} -> + "Cjsx(" ^ (pathToComponent |> ident) ^ ", " ^ str prefix ^ ", " + ^ (seenProps |> list) ^ ")" + | ChtmlElement {prefix} -> "ChtmlElement <" ^ prefix ^ " />" end module CompletionResult = struct type t = (CompletionInstruction.t * CompletionContext.t) option + let make (instruction : CompletionInstruction.t) + (context : CompletionContext.t) = + Some (instruction, context) + let ctxPath (ctxPath : ctxPath) (completionContext : CompletionContext.t) = let completionContext = completionContext |> CompletionContext.addCtxPathItem ctxPath in - Some - ( CompletionInstruction.ctxPath completionContext.ctxPath, - completionContext ) + make + (CompletionInstruction.ctxPath completionContext.ctxPath) + completionContext let pattern ~(completionContext : CompletionContext.t) ~prefix = - Some - ( CompletionInstruction.pattern ~completionContext ~prefix, - completionContext ) + make + (CompletionInstruction.pattern ~completionContext ~prefix) + completionContext let expression ~(completionContext : CompletionContext.t) ~prefix = - Some - ( CompletionInstruction.expression ~completionContext ~prefix, - completionContext ) + make + (CompletionInstruction.expression ~completionContext ~prefix) + completionContext let namedArg ~(completionContext : CompletionContext.t) ~prefix ~seenLabels ~functionContextPath = - Some - ( CompletionInstruction.namedArg ~functionContextPath ~prefix ~seenLabels, - completionContext ) + make + (CompletionInstruction.namedArg ~functionContextPath ~prefix ~seenLabels) + completionContext + + let jsx ~(completionContext : CompletionContext.t) ~prefix ~pathToComponent + ~seenProps = + make + (CompletionInstruction.jsx ~prefix ~pathToComponent ~seenProps) + completionContext + + let htmlElement ~(completionContext : CompletionContext.t) ~prefix = + make (CompletionInstruction.htmlElement ~prefix) completionContext end let flattenLidCheckDot ?(jsx = true) ~(completionContext : CompletionContext.t) @@ -938,6 +976,95 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : if locHasPos lhs.pexp_loc then completeExpr ~completionContext lhs else if locHasPos rhs.pexp_loc then completeExpr ~completionContext rhs else None + | Pexp_apply ({pexp_desc = Pexp_ident compName}, args) + when Res_parsetree_viewer.isJsxExpression expr -> ( + (* == JSX == *) + let jsxProps = CompletionJsx.extractJsxProps ~compName ~args in + let compNamePath = + flattenLidCheckDot ~completionContext ~jsx:true compName + in + let beforeCursor = completionContext.positionContext.beforeCursor in + let endPos = Loc.end_ expr.pexp_loc in + let posAfterCompName = Loc.end_ compName.loc in + let allLabels = + List.fold_right + (fun (prop : CompletionJsx.prop) allLabels -> prop.name :: allLabels) + jsxProps.props [] + in + let rec loop (props : CompletionJsx.prop list) = + match props with + | prop :: rest -> + if prop.posStart <= beforeCursor && beforeCursor < prop.posEnd then + (* Cursor on the prop name *) + CompletionResult.jsx ~completionContext ~prefix:prop.name + ~pathToComponent: + (Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt) + ~seenProps:allLabels + else if + prop.posEnd <= beforeCursor + && beforeCursor < Loc.start prop.exp.pexp_loc + then (* Cursor between the prop name and expr assigned *) + None + else if locHasPos prop.exp.pexp_loc then + (* Cursor in the expr assigned. Move into the expr and set that we're + expecting the return type of the prop. *) + let completionContext = + completionContext + |> CompletionContext.setCurrentlyExpecting + (Type + (CJsxPropValue + { + propName = prop.name; + pathToComponent = + Utils.flattenLongIdent ~jsx:true + jsxProps.compName.txt; + })) + in + completeExpr ~completionContext prop.exp + else if prop.exp.pexp_loc |> Loc.end_ = (Location.none |> Loc.end_) then + if CompletionExpressions.isExprHole prop.exp then + let completionContext = + completionContext + |> CompletionContext.addCtxPathItem + (CJsxPropValue + { + propName = prop.name; + pathToComponent = + Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt; + }) + in + CompletionResult.expression ~completionContext ~prefix:"" + else None + else loop rest + | [] -> + let beforeChildrenStart = + match jsxProps.childrenStart with + | Some childrenPos -> beforeCursor < childrenPos + | None -> beforeCursor <= endPos + in + let afterCompName = beforeCursor >= posAfterCompName in + if afterCompName && beforeChildrenStart then + CompletionResult.jsx ~completionContext ~prefix:"" + ~pathToComponent: + (Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt) + ~seenProps:allLabels + else None + in + let jsxCompletable = loop jsxProps.props in + match jsxCompletable with + | Some jsxCompletable -> Some jsxCompletable + | None -> + if locHasPos compName.loc then + (* The component name has the cursor. + Check if this is a HTML element (lowercase initial char) or a component (uppercase initial char). *) + match compNamePath with + | [prefix] when Char.lowercase_ascii prefix.[0] = prefix.[0] -> + CompletionResult.htmlElement ~completionContext ~prefix + | _ -> + CompletionResult.ctxPath + (CId (compNamePath, Module)) + (completionContext |> CompletionContext.resetCtx) + else None) | Pexp_apply (fnExpr, _args) when locHasPos fnExpr.pexp_loc -> (* Handle when the cursor is in the function expression itself. *) fnExpr diff --git a/analysis/src/new-completions-todo.md b/analysis/src/new-completions-todo.md index adced1784..bd4122a7c 100644 --- a/analysis/src/new-completions-todo.md +++ b/analysis/src/new-completions-todo.md @@ -3,3 +3,8 @@ - Figure out location for completeExpr - when do we need to check locs, and when not? - Pipe PPX transform, should we run it ourselves in the editor tooling? - Is there a practical difference btween Cexpression and Cpath? + +### Ideas + +- Scope JSX completions to things we know are components? +- Extra context: Now in a React component function, etc diff --git a/analysis/tests/src/CompletionNew.res b/analysis/tests/src/CompletionNew.res index b6e82a89d..58dc608ee 100644 --- a/analysis/tests/src/CompletionNew.res +++ b/analysis/tests/src/CompletionNew.res @@ -139,3 +139,25 @@ let someFun = (~firstLabel, ~secondLabel=?, r: someRecord) => { // let ff = someFun(~secondLabel, ~f) // ^co2 + +// == JSX == +// let jsx = +// ^co2 + +// let jsx = +// ^co2 + +// let jsx = +// ^co2 + +// let jsx = +// ^co2 + +// let jsx = +// ^co2 diff --git a/analysis/tests/src/expected/CompletionNew.res.txt b/analysis/tests/src/expected/CompletionNew.res.txt index f2a5741c3..063ba0274 100644 --- a/analysis/tests/src/expected/CompletionNew.res.txt +++ b/analysis/tests/src/expected/CompletionNew.res.txt @@ -183,3 +183,38 @@ Result: Cexpression: ctxPath: , rootType: Type +Complete2 src/CompletionNew.res 143:21 +Result: CtxPath: CId(Module)=SomeCom +Scope: 2 items +Looking for type: Unit + +Complete2 src/CompletionNew.res 146:26 +Result: CtxPath: CId(Module)=SomeModule.S +Scope: 2 items +Looking for type: Unit + +Complete2 src/CompletionNew.res 149:24 +Result: Cjsx(Component, "", []) +Scope: 2 items +Looking for type: TypeAtLoc: [149:7->149:10] + +Complete2 src/CompletionNew.res 152:25 +Result: Cjsx(Component, a, [a]) +Scope: 2 items +Looking for type: TypeAtLoc: [152:7->152:10] + +Complete2 src/CompletionNew.res 155:30 +Result: Cexpression: ctxPath: CJsxPropValue [Component] aProp, rootType: TypeAtLoc: [155:7->155:10] +Scope: 2 items +Looking for type: TypeAtLoc: [155:7->155:10] + +Complete2 src/CompletionNew.res 158:40 +Result: Cexpression: ctxPath: CId(Value)=, rootType: Type +Scope: 2 items +Looking for type: Type + +Complete2 src/CompletionNew.res 161:35 +Result: Cexpression: ctxPath: CId(Module)=Stuff, rootType: Type, prefix: "Stuff" +Scope: 2 items +Looking for type: Type + From c823f68f38670c12b840a9ea502210f8e9a59971 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Mon, 28 Aug 2023 10:15:35 +0200 Subject: [PATCH 14/18] jsx --- analysis/src/CompletionFrontEndNew.ml | 46 +++++++++++-------- analysis/src/new-completions-todo.md | 4 ++ analysis/tests/src/CompletionNew.res | 10 ++-- .../tests/src/expected/CompletionNew.res.txt | 8 ++-- 4 files changed, 38 insertions(+), 30 deletions(-) diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml index e25235d60..1dc176d5e 100644 --- a/analysis/src/CompletionFrontEndNew.ml +++ b/analysis/src/CompletionFrontEndNew.ml @@ -986,24 +986,26 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : let beforeCursor = completionContext.positionContext.beforeCursor in let endPos = Loc.end_ expr.pexp_loc in let posAfterCompName = Loc.end_ compName.loc in - let allLabels = + let seenProps = List.fold_right - (fun (prop : CompletionJsx.prop) allLabels -> prop.name :: allLabels) + (fun (prop : CompletionJsx.prop) seenProps -> prop.name :: seenProps) jsxProps.props [] in + (* Go through all of the props, looking for completions *) let rec loop (props : CompletionJsx.prop list) = match props with | prop :: rest -> if prop.posStart <= beforeCursor && beforeCursor < prop.posEnd then - (* Cursor on the prop name *) + (* Cursor on the prop name. *) CompletionResult.jsx ~completionContext ~prefix:prop.name ~pathToComponent: (Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt) - ~seenProps:allLabels + ~seenProps else if prop.posEnd <= beforeCursor && beforeCursor < Loc.start prop.exp.pexp_loc - then (* Cursor between the prop name and expr assigned *) + then + (* Cursor between the prop name and expr assigned. value *) None else if locHasPos prop.exp.pexp_loc then (* Cursor in the expr assigned. Move into the expr and set that we're @@ -1021,20 +1023,24 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : })) in completeExpr ~completionContext prop.exp - else if prop.exp.pexp_loc |> Loc.end_ = (Location.none |> Loc.end_) then - if CompletionExpressions.isExprHole prop.exp then - let completionContext = - completionContext - |> CompletionContext.addCtxPathItem - (CJsxPropValue - { - propName = prop.name; - pathToComponent = - Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt; - }) - in - CompletionResult.expression ~completionContext ~prefix:"" - else None + else if + locHasPos expr.pexp_loc + && checkIfExprHoleEmptyCursor ~completionContext prop.exp + then + (* Cursor is in the expression, but on an empty assignment. *) + let completionContext = + completionContext + |> CompletionContext.setCurrentlyExpecting + (Type + (CJsxPropValue + { + propName = prop.name; + pathToComponent = + Utils.flattenLongIdent ~jsx:true + jsxProps.compName.txt; + })) + in + CompletionResult.expression ~completionContext ~prefix:"" else loop rest | [] -> let beforeChildrenStart = @@ -1047,7 +1053,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : CompletionResult.jsx ~completionContext ~prefix:"" ~pathToComponent: (Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt) - ~seenProps:allLabels + ~seenProps else None in let jsxCompletable = loop jsxProps.props in diff --git a/analysis/src/new-completions-todo.md b/analysis/src/new-completions-todo.md index bd4122a7c..78b6f72f6 100644 --- a/analysis/src/new-completions-todo.md +++ b/analysis/src/new-completions-todo.md @@ -8,3 +8,7 @@ - Scope JSX completions to things we know are components? - Extra context: Now in a React component function, etc + +### Bugs + +- Empty JSX prop completion not triggering diff --git a/analysis/tests/src/CompletionNew.res b/analysis/tests/src/CompletionNew.res index 58dc608ee..1bde41446 100644 --- a/analysis/tests/src/CompletionNew.res +++ b/analysis/tests/src/CompletionNew.res @@ -147,17 +147,17 @@ let someFun = (~firstLabel, ~secondLabel=?, r: someRecord) => { // let jsx = +// let jsx = +// let jsx = +// let jsx = +// let jsx = +// let jsx = 149:10] +No completions Complete2 src/CompletionNew.res 152:25 Result: Cjsx(Component, a, [a]) @@ -204,9 +202,9 @@ Scope: 2 items Looking for type: TypeAtLoc: [152:7->152:10] Complete2 src/CompletionNew.res 155:30 -Result: Cexpression: ctxPath: CJsxPropValue [Component] aProp, rootType: TypeAtLoc: [155:7->155:10] +Result: Cexpression: ctxPath: , rootType: Type Scope: 2 items -Looking for type: TypeAtLoc: [155:7->155:10] +Looking for type: Type Complete2 src/CompletionNew.res 158:40 Result: Cexpression: ctxPath: CId(Value)=, rootType: Type From 6ec8a2ac28afd3b318e4efc94a83818949942874 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Thu, 31 Aug 2023 18:03:36 +0200 Subject: [PATCH 15/18] everything is now a context path --- analysis/src/CompletionBackendNew.ml | 536 +++++++++++++++++ analysis/src/CompletionFrontEndNew.ml | 566 +++++------------- analysis/src/CompletionNewTypes.ml | 368 ++++++++++++ analysis/src/Completions.ml | 5 +- .../tests/src/expected/CompletionNew.res.txt | 158 ++--- 5 files changed, 1121 insertions(+), 512 deletions(-) create mode 100644 analysis/src/CompletionBackendNew.ml create mode 100644 analysis/src/CompletionNewTypes.ml diff --git a/analysis/src/CompletionBackendNew.ml b/analysis/src/CompletionBackendNew.ml new file mode 100644 index 000000000..c34b6ea96 --- /dev/null +++ b/analysis/src/CompletionBackendNew.ml @@ -0,0 +1,536 @@ +open SharedTypes +open CompletionNewTypes + +let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos + ~(env : QueryEnv.t) ~exact ~(scope : Scope.t) (contextPath : ctxPath) = + if debug then Printf.printf "ContextPath %s\n" (ctxPathToString contextPath); + let package = full.package in + match contextPath with + | CString -> + [ + Completion.create "dummy" ~env + ~kind: + (Completion.Value + (Ctype.newconstr (Path.Pident (Ident.create "string")) [])); + ] + | CBool -> + [ + Completion.create "dummy" ~env + ~kind: + (Completion.Value + (Ctype.newconstr (Path.Pident (Ident.create "bool")) [])); + ] + | CInt -> + [ + Completion.create "dummy" ~env + ~kind: + (Completion.Value + (Ctype.newconstr (Path.Pident (Ident.create "int")) [])); + ] + | CFloat -> + [ + Completion.create "dummy" ~env + ~kind: + (Completion.Value + (Ctype.newconstr (Path.Pident (Ident.create "float")) [])); + ] + | CArray None -> + [ + Completion.create "array" ~env + ~kind: + (Completion.Value + (Ctype.newconstr (Path.Pident (Ident.create "array")) [])); + ] + | CArray (Some cp) -> ( + match + cp + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + |> CompletionBackEnd.completionsGetCompletionType ~full + with + | None -> [] + | Some (typ, env) -> + [ + Completion.create "dummy" ~env + ~kind: + (Completion.ExtractedType (Tarray (env, ExtractedType typ), `Type)); + ]) + | COption cp -> ( + match + cp + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + |> CompletionBackEnd.completionsGetCompletionType ~full + with + | None -> [] + | Some (typ, env) -> + [ + Completion.create "dummy" ~env + ~kind: + (Completion.ExtractedType (Toption (env, ExtractedType typ), `Type)); + ]) + | CAwait cp -> ( + match + cp + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + |> CompletionBackEnd.completionsGetCompletionType ~full + with + | Some (Tpromise (env, typ), _env) -> + [Completion.create "dummy" ~env ~kind:(Completion.Value typ)] + | _ -> []) + | CId (path, completionContext) -> + path + |> CompletionBackEnd.getCompletionsForPath ~debug ~package ~opens ~full ~pos + ~exact + ~completionContext: + (match completionContext with + | Value -> Value + | Module -> Module + | Field -> Field + | Type -> Type) + ~env ~scope + | CApply (cp, labels) -> ( + match + cp + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + |> CompletionBackEnd.completionsGetCompletionType2 ~debug ~full ~opens + ~rawOpens ~pos ~scope + with + | Some ((TypeExpr typ | ExtractedType (Tfunction {typ})), env) -> ( + let rec reconstructFunctionType args tRet = + match args with + | [] -> tRet + | (label, tArg) :: rest -> + let restType = reconstructFunctionType rest tRet in + {typ with desc = Tarrow (label, tArg, restType, Cok)} + in + let rec processApply args labels = + match (args, labels) with + | _, [] -> args + | _, label :: (_ :: _ as nextLabels) -> + (* compute the application of the first label, then the next ones *) + let args = processApply args [label] in + processApply args nextLabels + | (Asttypes.Nolabel, _) :: nextArgs, [Asttypes.Nolabel] -> nextArgs + | ((Labelled _, _) as arg) :: nextArgs, [Nolabel] -> + arg :: processApply nextArgs labels + | (Optional _, _) :: nextArgs, [Nolabel] -> processApply nextArgs labels + | ( (((Labelled s1 | Optional s1), _) as arg) :: nextArgs, + [(Labelled s2 | Optional s2)] ) -> + if s1 = s2 then nextArgs else arg :: processApply nextArgs labels + | ((Nolabel, _) as arg) :: nextArgs, [(Labelled _ | Optional _)] -> + arg :: processApply nextArgs labels + | [], [(Nolabel | Labelled _ | Optional _)] -> + (* should not happen, but just ignore extra arguments *) [] + in + match TypeUtils.extractFunctionType ~env ~package typ with + | args, tRet when args <> [] -> + let args = processApply args labels in + let retType = reconstructFunctionType args tRet in + [Completion.create "dummy" ~env ~kind:(Completion.Value retType)] + | _ -> []) + | _ -> []) + | CField (CId (path, Module), fieldName) -> + (* M.field *) + path @ [fieldName] + |> CompletionBackEnd.getCompletionsForPath ~debug ~package ~opens ~full ~pos + ~exact ~completionContext:Field ~env ~scope + | CField (cp, fieldName) -> ( + let completionsForCtxPath = + cp + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + in + let extracted = + match + completionsForCtxPath + |> CompletionBackEnd.completionsGetCompletionType2 ~debug ~full ~opens + ~rawOpens ~pos ~scope + with + | Some (TypeExpr typ, env) -> ( + match typ |> TypeUtils.extractRecordType ~env ~package with + | Some (env, fields, typDecl) -> + Some + ( env, + fields, + typDecl.item.decl |> Shared.declToString typDecl.name.txt ) + | None -> None) + | Some (ExtractedType typ, env) -> ( + match typ with + | Trecord {fields} -> + Some (env, fields, typ |> TypeUtils.extractedTypeToString) + | _ -> None) + | None -> None + in + match extracted with + | None -> [] + | Some (env, fields, recordAsString) -> + fields + |> Utils.filterMap (fun field -> + if Utils.checkName field.fname.txt ~prefix:fieldName ~exact then + Some + (Completion.create field.fname.txt ~env + ?deprecated:field.deprecated ~docstring:field.docstring + ~kind:(Completion.Field (field, recordAsString))) + else None)) + | CObj (cp, label) -> ( + (* TODO: Also needs to support ExtractedType *) + match + cp + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + |> CompletionBackEnd.completionsGetTypeEnv2 ~debug ~full ~opens ~rawOpens + ~pos ~scope + with + | Some (typ, env) -> ( + match typ |> TypeUtils.extractObjectType ~env ~package with + | Some (env, tObj) -> + let rec getFields (texp : Types.type_expr) = + match texp.desc with + | Tfield (name, _, t1, t2) -> + let fields = t2 |> getFields in + (name, t1) :: fields + | Tlink te | Tsubst te | Tpoly (te, []) -> te |> getFields + | Tvar None -> [] + | _ -> [] + in + tObj |> getFields + |> Utils.filterMap (fun (field, typ) -> + if Utils.checkName field ~prefix:label ~exact then + Some + (Completion.create field ~env ~kind:(Completion.ObjLabel typ)) + else None) + | None -> []) + | None -> []) + | CPipe {ctxPath = cp; id = funNamePrefix; lhsLoc} -> ( + match + cp + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + |> CompletionBackEnd.completionsGetTypeEnv2 ~debug ~full ~opens ~rawOpens + ~pos ~scope + with + | None -> [] + | Some (typ, envFromCompletionItem) -> ( + let env, typ = + typ + |> TypeUtils.resolveTypeForPipeCompletion ~env ~package ~full ~lhsLoc + in + if debug then + if env <> envFromCompletionItem then + Printf.printf "CPPipe env:%s envFromCompletionItem:%s\n" + (QueryEnv.toString env) + (QueryEnv.toString envFromCompletionItem) + else Printf.printf "CPPipe env:%s\n" (QueryEnv.toString env); + let completionPath = + match typ with + | Builtin (builtin, _) -> + let { + arrayModulePath; + optionModulePath; + stringModulePath; + intModulePath; + floatModulePath; + promiseModulePath; + listModulePath; + resultModulePath; + } = + package.builtInCompletionModules + in + Some + (match builtin with + | Array -> arrayModulePath + | Option -> optionModulePath + | String -> stringModulePath + | Int -> intModulePath + | Float -> floatModulePath + | Promise -> promiseModulePath + | List -> listModulePath + | Result -> resultModulePath + | Lazy -> ["Lazy"] + | Char -> ["Char"]) + | TypExpr t -> ( + match t.Types.desc with + | Tconstr (path, _typeArgs, _) + | Tlink {desc = Tconstr (path, _typeArgs, _)} + | Tsubst {desc = Tconstr (path, _typeArgs, _)} + | Tpoly ({desc = Tconstr (path, _typeArgs, _)}, []) -> ( + if debug then Printf.printf "CPPipe type path:%s\n" (Path.name path); + match Utils.expandPath path with + | _ :: pathRev -> + (* type path is relative to the completion environment + express it from the root of the file *) + let found, pathFromEnv = + QueryEnv.pathFromEnv envFromCompletionItem (List.rev pathRev) + in + if debug then + Printf.printf "CPPipe pathFromEnv:%s found:%b\n" + (pathFromEnv |> String.concat ".") + found; + if pathFromEnv = [] then None + else if + env.file.moduleName <> envFromCompletionItem.file.moduleName + && found + (* If the module names are different, then one needs to qualify the path. + But only if the path belongs to the env from completion *) + then Some (envFromCompletionItem.file.moduleName :: pathFromEnv) + else Some pathFromEnv + | _ -> None) + | _ -> None) + in + match completionPath with + | Some completionPath -> ( + let rec removeRawOpen rawOpen modulePath = + match (rawOpen, modulePath) with + | [_], _ -> Some modulePath + | s :: inner, first :: restPath when s = first -> + removeRawOpen inner restPath + | _ -> None + in + let rec removeRawOpens rawOpens modulePath = + match rawOpens with + | rawOpen :: restOpens -> ( + let newModulePath = removeRawOpens restOpens modulePath in + match removeRawOpen rawOpen newModulePath with + | None -> newModulePath + | Some mp -> mp) + | [] -> modulePath + in + let completionPathMinusOpens = + completionPath + |> removeRawOpens package.opens + |> removeRawOpens rawOpens |> String.concat "." + in + let completionName name = + if completionPathMinusOpens = "" then name + else completionPathMinusOpens ^ "." ^ name + in + let completions = + completionPath @ [funNamePrefix] + |> CompletionBackEnd.getCompletionsForPath ~debug + ~completionContext:Value ~exact:false ~package ~opens ~full ~pos + ~env ~scope + in + let completions = + completions + |> List.map (fun (completion : Completion.t) -> + { + completion with + name = completionName completion.name; + env + (* Restore original env for the completion after x->foo()... *); + }) + in + (* We add React element functions to the completion if we're in a JSX context *) + let inJsx = false in + (* TODO(1) *) + let forJsxCompletion = + if inJsx then + match typ with + | Builtin (Int, t) -> Some ("int", t) + | Builtin (Float, t) -> Some ("float", t) + | Builtin (String, t) -> Some ("string", t) + | Builtin (Array, t) -> Some ("array", t) + | _ -> None + else None + in + match forJsxCompletion with + | Some (builtinNameToComplete, typ) + when Utils.checkName builtinNameToComplete ~prefix:funNamePrefix + ~exact:false -> + [ + Completion.createWithSnippet + ~name:("React." ^ builtinNameToComplete) + ~kind:(Value typ) ~env ~sortText:"A" + ~docstring: + [ + "Turns `" ^ builtinNameToComplete + ^ "` into `React.element` so it can be used inside of JSX."; + ] + (); + ] + @ completions + | _ -> completions) + | None -> [])) + | CTuple ctxPaths -> + (* Turn a list of context paths into a list of type expressions. *) + let typeExrps = + ctxPaths + |> List.map (fun contextPath -> + contextPath + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos + ~env ~exact:true ~scope) + |> List.filter_map (fun completionItems -> + match completionItems with + | {Completion.kind = Value typ} :: _ -> Some typ + | _ -> None) + in + if List.length ctxPaths = List.length typeExrps then + [ + Completion.create "dummy" ~env + ~kind:(Completion.Value (Ctype.newty (Ttuple typeExrps))); + ] + else [] + | CJsxPropValue {pathToComponent; propName} -> ( + let findTypeOfValue path = + path + |> CompletionBackEnd.getCompletionsForPath ~debug ~completionContext:Value + ~exact:true ~package ~opens ~full ~pos ~env ~scope + |> CompletionBackEnd.completionsGetTypeEnv2 ~debug ~full ~opens ~rawOpens + ~pos ~scope + in + let lowercaseComponent = + match pathToComponent with + | [elName] when Char.lowercase_ascii elName.[0] = elName.[0] -> true + | _ -> false + in + let targetLabel = + if lowercaseComponent then + let rec digToTypeForCompletion path = + match + path + |> CompletionBackEnd.getCompletionsForPath ~debug + ~completionContext:Type ~exact:true ~package ~opens ~full ~pos + ~env ~scope + with + | {kind = Type {kind = Abstract (Some (p, _))}} :: _ -> + (* This case happens when what we're looking for is a type alias. + This is the case in newer rescript-react versions where + ReactDOM.domProps is an alias for JsxEvent.t. *) + let pathRev = p |> Utils.expandPath in + pathRev |> List.rev |> digToTypeForCompletion + | {kind = Type {kind = Record fields}} :: _ -> ( + match fields |> List.find_opt (fun f -> f.fname.txt = propName) with + | None -> None + | Some f -> Some (f.fname.txt, f.typ, env)) + | _ -> None + in + ["ReactDOM"; "domProps"] |> digToTypeForCompletion + else + CompletionJsx.getJsxLabels ~componentPath:pathToComponent + ~findTypeOfValue ~package + |> List.find_opt (fun (label, _, _) -> label = propName) + in + match targetLabel with + | None -> [] + | Some (_, typ, env) -> + [ + Completion.create "dummy" ~env + ~kind:(Completion.Value (Utils.unwrapIfOption typ)); + ]) + | CFunctionArgument {functionContextPath; argumentLabel} -> ( + let labels, env = + match + functionContextPath + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + |> CompletionBackEnd.completionsGetCompletionType2 ~debug ~full ~opens + ~rawOpens ~pos ~scope + with + | Some ((TypeExpr typ | ExtractedType (Tfunction {typ})), env) -> + (typ |> TypeUtils.getArgs ~full ~env, env) + | _ -> ([], env) + in + let targetLabel = + labels + |> List.find_opt (fun (label, _) -> + match (argumentLabel, label) with + | ( Unlabelled {argumentPosition = pos1}, + Completable.Unlabelled {argumentPosition = pos2} ) -> + pos1 = pos2 + | ( (Labelled name1 | Optional name1), + (Labelled name2 | Optional name2) ) -> + name1 = name2 + | _ -> false) + in + let expandOption = + match targetLabel with + | None | Some ((Unlabelled _ | Labelled _), _) -> false + | Some (Optional _, _) -> true + in + match targetLabel with + | None -> [] + | Some (_, typ) -> + [ + Completion.create "dummy" ~env + ~kind: + (Completion.Value + (if expandOption then Utils.unwrapIfOption typ else typ)); + ]) + | CUnknown -> [] + | CVariantPayload {ctxPath; itemNum} -> ( + match + ctxPath + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + |> CompletionBackEnd.completionsGetCompletionType2 ~debug ~full ~opens + ~rawOpens ~pos ~scope + with + | Some (typ, env) -> ( + let typ = + match typ with + | ExtractedType inner -> Some inner + | TypeExpr t -> t |> TypeUtils.extractType ~env ~package:full.package + in + match typ with + | Some (Tvariant {constructors}) -> ( + let targetType = + constructors + |> Utils.findMap (fun (c : Constructor.t) -> + match c.args with + | Args args -> ( + match List.nth_opt args itemNum with + | None -> None + | Some (typ, _) -> Some typ) + | _ -> None) + in + match targetType with + | None -> [] + | Some t -> [Completion.create "dummy" ~env ~kind:(Completion.Value t)]) + | _ -> []) + | _ -> []) + | CTupleItem _ -> [] + | CRecordField {ctxPath; prefix; seenFields} -> ( + let completionsForCtxPath = + ctxPath + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + in + let extracted = + match + completionsForCtxPath + |> CompletionBackEnd.completionsGetCompletionType2 ~debug ~full ~opens + ~rawOpens ~pos ~scope + with + | Some (TypeExpr typ, env) -> ( + match typ |> TypeUtils.extractRecordType ~env ~package with + | Some (env, fields, typDecl) -> + Some + ( env, + fields, + typDecl.item.decl |> Shared.declToString typDecl.name.txt ) + | None -> None) + | Some (ExtractedType typ, env) -> ( + match typ with + | Trecord {fields} -> + Some (env, fields, typ |> TypeUtils.extractedTypeToString) + | _ -> None) + | None -> None + in + match extracted with + | None -> [] + | Some (env, fields, recordAsString) -> + let field = + fields + |> Utils.filterMap (fun field -> + if Utils.checkName field.fname.txt ~prefix ~exact then + Some + (Completion.create field.fname.txt ~env + ?deprecated:field.deprecated ~docstring:field.docstring + ~kind:(Completion.Field (field, recordAsString))) + else None) + in + field) + | CFunction _ -> [] diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml index 1dc176d5e..656d8cd97 100644 --- a/analysis/src/CompletionFrontEndNew.ml +++ b/analysis/src/CompletionFrontEndNew.ml @@ -1,362 +1,5 @@ open SharedTypes - -module PositionContext = struct - type t = { - offset: int; (** The offset *) - cursor: Pos.t; (** The actual position of the cursor *) - beforeCursor: Pos.t; (** The position just before the cursor *) - noWhitespace: Pos.t; - (** The position of the cursor, removing any whitespace _before_ it *) - charBeforeNoWhitespace: char option; - (** The first character before the cursor, excluding any whitespace *) - charBeforeCursor: char option; - (** The char before the cursor, not excluding whitespace *) - whitespaceAfterCursor: char option; - (** The type of whitespace after the cursor, if any *) - locHasPos: Location.t -> bool; - (** A helper for checking whether a loc has the cursor (beforeCursor). - This is the most natural position to check when figuring out if the user has the cursor in something. *) - } - - let make ~offset ~posCursor text = - let offsetNoWhite = Utils.skipWhite text (offset - 1) in - let posNoWhite = - let line, col = posCursor in - (line, max 0 col - offset + offsetNoWhite) - in - let firstCharBeforeCursorNoWhite = - if offsetNoWhite < String.length text && offsetNoWhite >= 0 then - Some text.[offsetNoWhite] - else None - in - let posBeforeCursor = Pos.posBeforeCursor posCursor in - let charBeforeCursor, whitespaceAfterCursor = - match Pos.positionToOffset text posCursor with - | Some offset when offset > 0 -> ( - let charBeforeCursor = text.[offset - 1] in - let charAtCursor = - if offset < String.length text then text.[offset] else '\n' - in - match charAtCursor with - | ' ' | '\t' | '\r' | '\n' -> - (Some charBeforeCursor, Some charBeforeCursor) - | _ -> (Some charBeforeCursor, None)) - | _ -> (None, None) - in - let locHasPos loc = - loc |> CursorPosition.locHasCursor ~pos:posBeforeCursor - in - { - offset; - beforeCursor = posBeforeCursor; - noWhitespace = posNoWhite; - charBeforeNoWhitespace = firstCharBeforeCursorNoWhite; - cursor = posCursor; - charBeforeCursor; - whitespaceAfterCursor; - locHasPos; - } -end - -type completionCategory = Type | Value | Module | Field - -type argumentLabel = - | Unlabelled of {argumentPosition: int} - | Labelled of string - | Optional of string - -type ctxPath = - | CUnknown (** Something that cannot be resolved right now *) - | CId of string list * completionCategory - (** A regular id of an expected category. `let fff = thisIsAnId` and `let fff = SomePath.alsoAnId` *) - | CVariantPayload of {itemNum: int} - (** A variant payload. `Some()` = itemNum 0, `Whatever(true, f)` = itemNum 1 *) - | CTupleItem of {itemNum: int} - (** A tuple item. `(true, false, )` = itemNum 2 *) - | CRecordField of {seenFields: string list; prefix: string} - (** A record field. `let f = {on: true, s}` seenFields = [on], prefix = "s",*) - | COption of ctxPath (** An option with an inner type. *) - | CArray of ctxPath option (** An array with an inner type. *) - | CTuple of ctxPath list (** A tuple. *) - | CBool - | CString - | CInt - | CFloat - | CAwait of ctxPath (** Awaiting a function call. *) - | CFunction of {returnType: ctxPath} (** A function *) - | CField of ctxPath * string - (** Field access. `whateverVariable.fieldName`. The ctxPath points to the value of `whateverVariable`, - and the string is the name of the field we're accessing. *) - | CObj of ctxPath * string - (** Object property access. `whateverVariable["fieldName"]`. The ctxPath points to the value of `whateverVariable`, - and the string is the name of the property we're accessing. *) - | CApply of ctxPath * Asttypes.arg_label list - (** Function application. `someFunction(someVar, ~otherLabel="hello")`. The ctxPath points to the function. *) - | CFunctionArgument of { - functionContextPath: ctxPath; - argumentLabel: argumentLabel; - } (** A function argument, either labelled or unlabelled.*) - | CPipe of { - ctxPath: ctxPath; (** Context path to the function being called. *) - id: string; - lhsLoc: Location.t; (** Location of the left hand side. *) - } (** Piped call. `foo->someFn`. *) - | CJsxPropValue of { - pathToComponent: string list; - (** The path to the component this property is from. *) - propName: string; (** The prop name we're going through. *) - } (** A JSX property. *) - -let rec ctxPathToString (ctxPath : ctxPath) = - match ctxPath with - | CUnknown -> "CUnknown" - | CBool -> "bool" - | CFloat -> "float" - | CInt -> "int" - | CString -> "string" - | CJsxPropValue {pathToComponent; propName} -> - "CJsxPropValue " ^ (pathToComponent |> list) ^ " " ^ propName - | CAwait ctxPath -> Printf.sprintf "await %s" (ctxPathToString ctxPath) - | CApply (ctxPath, args) -> - Printf.sprintf "%s(%s)" (ctxPathToString ctxPath) - (args - |> List.map (function - | Asttypes.Nolabel -> "Nolabel" - | Labelled s -> "~" ^ s - | Optional s -> "?" ^ s) - |> String.concat ", ") - | CField (ctxPath, fieldName) -> - Printf.sprintf "(%s).%s" (ctxPathToString ctxPath) fieldName - | CObj (ctxPath, fieldName) -> - Printf.sprintf "(%s)[\"%s\"]" (ctxPathToString ctxPath) fieldName - | CFunction {returnType} -> - Printf.sprintf "CFunction () -> %s" (ctxPathToString returnType) - | CTuple ctxPaths -> - Printf.sprintf "CTuple(%s)" - (ctxPaths |> List.map ctxPathToString |> String.concat ", ") - | CId (prefix, typ) -> - Printf.sprintf "CId(%s)=%s" - (match typ with - | Value -> "Value" - | Type -> "Type" - | Module -> "Module" - | Field -> "Field") - (ident prefix) - | CVariantPayload {itemNum} -> Printf.sprintf "CVariantPayload($%i)" itemNum - | CTupleItem {itemNum} -> Printf.sprintf "CTupleItem($%i)" itemNum - | CRecordField {prefix} -> Printf.sprintf "CRecordField=%s" prefix - | COption ctxPath -> Printf.sprintf "COption<%s>" (ctxPathToString ctxPath) - | CArray ctxPath -> - Printf.sprintf "array%s" - (match ctxPath with - | None -> "" - | Some ctxPath -> "<" ^ ctxPathToString ctxPath ^ ">") - | CFunctionArgument {functionContextPath; argumentLabel} -> - "CFunctionArgument " - ^ (functionContextPath |> ctxPathToString) - ^ "(" - ^ (match argumentLabel with - | Unlabelled {argumentPosition} -> "$" ^ string_of_int argumentPosition - | Labelled name -> "~" ^ name - | Optional name -> "~" ^ name ^ "=?") - ^ ")" - | CPipe {ctxPath; id} -> "(" ^ ctxPathToString ctxPath ^ ")->" ^ id - -type currentlyExpecting = - | Unit (** Unit, (). Is what we reset to. *) - | Type of ctxPath (** A type at a context path. *) - | TypeAtLoc of Location.t (** A type at a location. *) - | FunctionReturnType of ctxPath - (** An instruction to resolve the return type of the type at the - provided context path, if it's a function (it should always be, - but you know...) *) - -let currentlyExpectingToString (c : currentlyExpecting) = - match c with - | Unit -> "Unit" - | Type ctxPath -> Printf.sprintf "Type<%s>" (ctxPathToString ctxPath) - | TypeAtLoc loc -> Printf.sprintf "TypeAtLoc: %s" (Loc.toString loc) - | FunctionReturnType ctxPath -> - Printf.sprintf "FunctionReturnType<%s>" (ctxPathToString ctxPath) - -module CompletionContext = struct - type t = { - positionContext: PositionContext.t; - scope: Scope.t; - currentlyExpecting: currentlyExpecting; - ctxPath: ctxPath list; - } - - let make positionContext = - { - positionContext; - scope = Scope.create (); - currentlyExpecting = Unit; - ctxPath = []; - } - - let resetCtx completionContext = - {completionContext with currentlyExpecting = Unit; ctxPath = []} - - let withScope scope completionContext = {completionContext with scope} - - let setCurrentlyExpecting currentlyExpecting completionContext = - {completionContext with currentlyExpecting} - - let currentlyExpectingOrReset currentlyExpecting completionContext = - match currentlyExpecting with - | None -> {completionContext with currentlyExpecting = Unit} - | Some currentlyExpecting -> {completionContext with currentlyExpecting} - - let currentlyExpectingOrTypeAtLoc ~loc currentlyExpecting completionContext = - match currentlyExpecting with - | None -> {completionContext with currentlyExpecting = TypeAtLoc loc} - | Some currentlyExpecting -> {completionContext with currentlyExpecting} - - let withResetCurrentlyExpecting completionContext = - {completionContext with currentlyExpecting = Unit} - - let addCtxPathItem ctxPath completionContext = - {completionContext with ctxPath = ctxPath :: completionContext.ctxPath} -end - -module CompletionInstruction = struct - (** This is the completion instruction, that's responsible for resolving something at - context path X *) - type t = - | CtxPath of ctxPath list - | Cpattern of { - ctxPath: ctxPath list; - (** This is the context path inside of the pattern itself. - Used to walk up to the type we're looking to complete. *) - rootType: currentlyExpecting; - (** This is the an instruction to find where completion starts - from. If we're completing inside of a record, it should resolve - to the record itself. *) - prefix: string; - } (** Completing inside of a pattern. *) - | Cexpression of { - ctxPath: ctxPath list; - (** This is the context path inside of the expression itself. - Used to walk up to the type we're looking to complete. *) - rootType: currentlyExpecting; - (** This is the an instruction to find where completion starts - from. If we're completing inside of a record, it should resolve - to the record itself. *) - prefix: string; - } (** Completing inside of an expression. *) - | CnamedArg of { - ctxPath: ctxPath; - (** Context path to the function with the argument. *) - seenLabels: string list; - (** All the already seen labels in the function call. *) - prefix: string; (** The text the user has written so far.*) - } - | Cjsx of { - pathToComponent: string list; - (** The path to the component: `["M", "Comp"]`. *) - prefix: string; (** What the user has already written. `"id"`. *) - seenProps: string list; - (** A list of all of the props that has already been entered.*) - } - | ChtmlElement of {prefix: string (** What the user has written so far. *)} - (** Completing for a regular HTML element. *) - - let ctxPath ctxPath = CtxPath ctxPath - - let pattern ~(completionContext : CompletionContext.t) ~prefix = - Cpattern - { - prefix; - rootType = completionContext.currentlyExpecting; - ctxPath = completionContext.ctxPath; - } - - let expression ~(completionContext : CompletionContext.t) ~prefix = - Cexpression - { - prefix; - rootType = completionContext.currentlyExpecting; - ctxPath = completionContext.ctxPath; - } - - let namedArg ~prefix ~functionContextPath ~seenLabels = - CnamedArg {prefix; ctxPath = functionContextPath; seenLabels} - - let jsx ~prefix ~pathToComponent ~seenProps = - Cjsx {prefix; pathToComponent; seenProps} - - let htmlElement ~prefix = ChtmlElement {prefix} - - let toString (c : t) = - match c with - | CtxPath ctxPath -> - Printf.sprintf "CtxPath: %s" - (ctxPath |> List.rev |> List.map ctxPathToString |> String.concat "->") - | Cpattern {ctxPath; prefix; rootType} -> - Printf.sprintf "Cpattern: ctxPath: %s, rootType: %s%s" - (ctxPath |> List.rev |> List.map ctxPathToString |> String.concat "->") - (currentlyExpectingToString rootType) - (match prefix with - | "" -> "" - | prefix -> Printf.sprintf ", prefix: \"%s\"" prefix) - | Cexpression {ctxPath; prefix; rootType} -> - Printf.sprintf "Cexpression: ctxPath: %s, rootType: %s%s" - (ctxPath |> List.rev |> List.map ctxPathToString |> String.concat "->") - (currentlyExpectingToString rootType) - (match prefix with - | "" -> "" - | prefix -> Printf.sprintf ", prefix: \"%s\"" prefix) - | CnamedArg {prefix; ctxPath; seenLabels} -> - "CnamedArg(" - ^ (ctxPath |> ctxPathToString) - ^ ", " ^ str prefix ^ ", " ^ (seenLabels |> list) ^ ")" - | Cjsx {prefix; pathToComponent; seenProps} -> - "Cjsx(" ^ (pathToComponent |> ident) ^ ", " ^ str prefix ^ ", " - ^ (seenProps |> list) ^ ")" - | ChtmlElement {prefix} -> "ChtmlElement <" ^ prefix ^ " />" -end - -module CompletionResult = struct - type t = (CompletionInstruction.t * CompletionContext.t) option - - let make (instruction : CompletionInstruction.t) - (context : CompletionContext.t) = - Some (instruction, context) - - let ctxPath (ctxPath : ctxPath) (completionContext : CompletionContext.t) = - let completionContext = - completionContext |> CompletionContext.addCtxPathItem ctxPath - in - make - (CompletionInstruction.ctxPath completionContext.ctxPath) - completionContext - - let pattern ~(completionContext : CompletionContext.t) ~prefix = - make - (CompletionInstruction.pattern ~completionContext ~prefix) - completionContext - - let expression ~(completionContext : CompletionContext.t) ~prefix = - make - (CompletionInstruction.expression ~completionContext ~prefix) - completionContext - - let namedArg ~(completionContext : CompletionContext.t) ~prefix ~seenLabels - ~functionContextPath = - make - (CompletionInstruction.namedArg ~functionContextPath ~prefix ~seenLabels) - completionContext - - let jsx ~(completionContext : CompletionContext.t) ~prefix ~pathToComponent - ~seenProps = - make - (CompletionInstruction.jsx ~prefix ~pathToComponent ~seenProps) - completionContext - - let htmlElement ~(completionContext : CompletionContext.t) ~prefix = - make (CompletionInstruction.htmlElement ~prefix) completionContext -end +open CompletionNewTypes let flattenLidCheckDot ?(jsx = true) ~(completionContext : CompletionContext.t) (lid : Longident.t Location.loc) = @@ -374,6 +17,9 @@ let flattenLidCheckDot ?(jsx = true) ~(completionContext : CompletionContext.t) in Utils.flattenLongIdent ~cutAtOffset ~jsx lid.txt +let ctxPathFromCompletionContext (completionContext : CompletionContext.t) = + completionContext.ctxPath + (** This is for when you want a context path for an expression, without necessarily wanting to do completion in that expression. For instance when completing patterns `let {} = someRecordVariable`, we want the context path to `someRecordVariable` to @@ -394,15 +40,22 @@ let rec exprToContextPathInner (e : Parsetree.expression) = | Pexp_ident {txt} -> Some (CId (Utils.flattenLongIdent txt, Value)) | Pexp_field (e1, {txt = Lident name}) -> ( match exprToContextPath e1 with - | Some contextPath -> Some (CField (contextPath, name)) + | Some contextPath -> + Some (CRecordFieldAccess {recordCtxPath = contextPath; fieldName = name}) | _ -> None) | Pexp_field (_, {txt = Ldot (lid, name)}) -> (* Case x.M.field ignore the x part *) - Some (CField (CId (Utils.flattenLongIdent lid, Module), name)) + Some + (CRecordFieldAccess + { + recordCtxPath = CId (Utils.flattenLongIdent lid, Module); + fieldName = name; + }) | Pexp_send (e1, {txt}) -> ( match exprToContextPath e1 with | None -> None - | Some contexPath -> Some (CObj (contexPath, txt))) + | Some contexPath -> + Some (CObj {objectCtxPath = contexPath; propertyName = txt})) | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}}, [ @@ -433,7 +86,8 @@ let rec exprToContextPathInner (e : Parsetree.expression) = | Pexp_apply (e1, args) -> ( match exprToContextPath e1 with | None -> None - | Some contexPath -> Some (CApply (contexPath, args |> List.map fst))) + | Some contexPath -> + Some (CApply {functionCtxPath = contexPath; args = args |> List.map fst})) | Pexp_tuple exprs -> let exprsAsContextPaths = exprs |> List.filter_map exprToContextPath in if List.length exprs = List.length exprsAsContextPaths then @@ -489,21 +143,9 @@ let rec ctxPathFromCoreType ~completionContext (coreType : Parsetree.core_type) let findCurrentlyLookingForInPattern ~completionContext (pat : Parsetree.pattern) = match pat.ppat_desc with - | Ppat_constraint (_pat, typ) -> ( - match ctxPathFromCoreType ~completionContext typ with - | None -> None - | Some ctxPath -> Some (Type ctxPath)) + | Ppat_constraint (_pat, typ) -> ctxPathFromCoreType ~completionContext typ | _ -> None -let mergeCurrentlyLookingFor (currentlyExpecting : currentlyExpecting option) - list = - match currentlyExpecting with - | None -> list - | Some currentlyExpecting -> currentlyExpecting :: list - -let contextWithNewScope scope (context : CompletionContext.t) = - {context with scope} - (* An expression with that's an expr hole and that has an empty cursor. TODO Explain *) let checkIfExprHoleEmptyCursor ~(completionContext : CompletionContext.t) (exp : Parsetree.expression) = @@ -544,10 +186,11 @@ let completePipeChain (exp : Parsetree.expression) = let completePipe ~id (lhs : Parsetree.expression) = match completePipeChain lhs with - | Some (pipe, lhsLoc) -> Some (CPipe {ctxPath = pipe; id; lhsLoc}) + | Some (pipe, lhsLoc) -> Some (CPipe {functionCtxPath = pipe; id; lhsLoc}) | None -> ( match exprToContextPath lhs with - | Some pipe -> Some (CPipe {ctxPath = pipe; id; lhsLoc = lhs.pexp_loc}) + | Some pipe -> + Some (CPipe {functionCtxPath = pipe; id; lhsLoc = lhs.pexp_loc}) | None -> None) (** Scopes *) @@ -671,9 +314,7 @@ and completeValueBinding ~(completionContext : CompletionContext.t) Ensure the context carries the root type of `someRecordVariable`. *) let completionContext = CompletionContext.currentlyExpectingOrTypeAtLoc ~loc:vb.pvb_expr.pexp_loc - (match exprToContextPath vb.pvb_expr with - | None -> None - | Some ctxPath -> Some (Type ctxPath)) + (exprToContextPath vb.pvb_expr) completionContext in completePattern ~completionContext vb.pvb_pat @@ -715,10 +356,7 @@ and completeValueBinding ~(completionContext : CompletionContext.t) else if patHole then let completionContext = CompletionContext.currentlyExpectingOrTypeAtLoc - ~loc:vb.pvb_expr.pexp_loc - (match exprCtxPath with - | None -> None - | Some ctxPath -> Some (Type ctxPath)) + ~loc:vb.pvb_expr.pexp_loc exprCtxPath completionContextForExprCompletion in CompletionResult.pattern ~prefix:"" ~completionContext @@ -746,7 +384,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : let locHasPos = completionContext.positionContext.locHasPos in match expr.pexp_desc with (* == VARIANTS == *) - | Pexp_construct (_id, Some {pexp_desc = Pexp_tuple args; pexp_loc}) + | Pexp_construct (id, Some {pexp_desc = Pexp_tuple args; pexp_loc}) when pexp_loc |> locHasPos -> (* A constructor with multiple payloads, like: `Co(true, false)` or `Somepath.Co(false, true)` *) args @@ -756,17 +394,29 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : { completionContext with ctxPath = - CVariantPayload {itemNum} :: completionContext.ctxPath; + CVariantPayload + { + itemNum; + variantCtxPath = + ctxPathFromCompletionContext completionContext; + constructorName = Longident.last id.txt; + }; } e) - | Pexp_construct (_id, Some payloadExpr) - when payloadExpr.pexp_loc |> locHasPos -> + | Pexp_construct (id, Some payloadExpr) when payloadExpr.pexp_loc |> locHasPos + -> (* A constructor with a single payload, like: `Co(true)` or `Somepath.Co(false)` *) completeExpr ~completionContext: { completionContext with - ctxPath = CVariantPayload {itemNum = 0} :: completionContext.ctxPath; + ctxPath = + CVariantPayload + { + itemNum = 0; + variantCtxPath = ctxPathFromCompletionContext completionContext; + constructorName = Longident.last id.txt; + }; } payloadExpr | Pexp_construct ({txt = Lident txt; loc}, _) when loc |> locHasPos -> @@ -789,7 +439,12 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : let completionContext = completionContext |> CompletionContext.addCtxPathItem - (CRecordField {prefix; seenFields = []}) + (CRecordField + { + prefix; + seenFields = []; + recordCtxPath = ctxPathFromCompletionContext completionContext; + }) in CompletionResult.expression ~completionContext ~prefix | Pexp_record ([], _) when expr.pexp_loc |> locHasPos -> @@ -797,7 +452,12 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : let completionContext = completionContext |> CompletionContext.addCtxPathItem - (CRecordField {prefix = ""; seenFields = []}) + (CRecordField + { + prefix = ""; + seenFields = []; + recordCtxPath = ctxPathFromCompletionContext completionContext; + }) in CompletionResult.expression ~completionContext ~prefix:"" | Pexp_record (fields, _) when expr.pexp_loc |> locHasPos -> ( @@ -819,7 +479,13 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : match fieldName with | {txt = Lident prefix} -> CompletionResult.ctxPath - (CRecordField {prefix; seenFields}) + (CRecordField + { + prefix; + seenFields; + recordCtxPath = + ctxPathFromCompletionContext completionContext; + }) completionContext | fieldName -> CompletionResult.ctxPath @@ -830,7 +496,12 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : ~completionContext: (CompletionContext.addCtxPathItem (CRecordField - {prefix = fieldName.txt |> Longident.last; seenFields}) + { + prefix = fieldName.txt |> Longident.last; + seenFields; + recordCtxPath = + ctxPathFromCompletionContext completionContext; + }) completionContext) fieldExpr) in @@ -855,14 +526,26 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : let completionContext = completionContext |> CompletionContext.addCtxPathItem - (CRecordField {prefix = fieldName; seenFields}) + (CRecordField + { + prefix = fieldName; + seenFields; + recordCtxPath = + ctxPathFromCompletionContext completionContext; + }) in CompletionResult.expression ~completionContext ~prefix:"" | None, Some ',' -> let completionContext = completionContext |> CompletionContext.addCtxPathItem - (CRecordField {prefix = ""; seenFields}) + (CRecordField + { + prefix = ""; + seenFields; + recordCtxPath = + ctxPathFromCompletionContext completionContext; + }) in CompletionResult.expression ~completionContext ~prefix:"" | _ -> None) @@ -1013,14 +696,12 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : let completionContext = completionContext |> CompletionContext.setCurrentlyExpecting - (Type - (CJsxPropValue - { - propName = prop.name; - pathToComponent = - Utils.flattenLongIdent ~jsx:true - jsxProps.compName.txt; - })) + (CJsxPropValue + { + propName = prop.name; + pathToComponent = + Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt; + }) in completeExpr ~completionContext prop.exp else if @@ -1031,14 +712,12 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : let completionContext = completionContext |> CompletionContext.setCurrentlyExpecting - (Type - (CJsxPropValue - { - propName = prop.name; - pathToComponent = - Utils.flattenLongIdent ~jsx:true - jsxProps.compName.txt; - })) + (CJsxPropValue + { + propName = prop.name; + pathToComponent = + Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt; + }) in CompletionResult.expression ~completionContext ~prefix:"" else loop rest @@ -1104,8 +783,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : ~functionContextPath = completionContext |> CompletionContext.resetCtx |> CompletionContext.currentlyExpectingOrReset - (Some - (Type (CFunctionArgument {functionContextPath; argumentLabel}))) + (Some (CFunctionArgument {functionContextPath; argumentLabel})) in (* Piped expressions always have an initial unlabelled argument. *) let unlabelledCount = ref (if isPipedExpr then 1 else 0) in @@ -1215,18 +893,15 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : (* Set the expected type correctly for the expr body *) let completionContext = match fnReturnConstraint with - | None -> ( - match completionContext.currentlyExpecting with - | Type ctxPath -> - (* Having a Type here already means the binding itself had a constraint on it. Since we're now moving into the function body, - we'll need to ensure it's the function return type we use for completion, not the function type itself *) - completionContext - |> CompletionContext.setCurrentlyExpecting - (FunctionReturnType ctxPath) - | _ -> completionContext) - | Some ctxPath -> + | None -> + (* Having a Type here already means the binding itself had a constraint on it. Since we're now moving into the function body, + we'll need to ensure it's the function return type we use for completion, not the function type itself *) completionContext - |> CompletionContext.setCurrentlyExpecting (Type ctxPath) + |> CompletionContext.setCurrentlyExpecting + (CFunctionReturnType + {functionCtxPath = completionContext.currentlyExpecting}) + | Some ctxPath -> + completionContext |> CompletionContext.setCurrentlyExpecting ctxPath in if locHasPos expr.pexp_loc then completeExpr ~completionContext expr else if checkIfExprHoleEmptyCursor ~completionContext expr then @@ -1300,7 +975,12 @@ and completePattern ~(completionContext : CompletionContext.t) if locHasPos pat.ppat_loc then let completionContext = CompletionContext.addCtxPathItem - (CRecordField {seenFields = []; prefix = ""}) + (CRecordField + { + seenFields = []; + prefix = ""; + recordCtxPath = ctxPathFromCompletionContext completionContext; + }) completionContext in CompletionResult.pattern ~completionContext ~prefix:"" @@ -1334,14 +1014,24 @@ and completePattern ~(completionContext : CompletionContext.t) CompletionResult.pattern ~prefix ~completionContext: (CompletionContext.addCtxPathItem - (CRecordField {seenFields; prefix}) + (CRecordField + { + seenFields; + prefix; + recordCtxPath = ctxPathFromCompletionContext completionContext; + }) completionContext) | None, Some (fieldName, fieldPattern) -> (* {someFieldName: someOtherPattern} *) let prefix = Longident.last fieldName.txt in let completionContext = CompletionContext.addCtxPathItem - (CRecordField {seenFields; prefix}) + (CRecordField + { + seenFields; + prefix; + recordCtxPath = ctxPathFromCompletionContext completionContext; + }) completionContext in completePattern ~completionContext fieldPattern @@ -1362,7 +1052,12 @@ and completePattern ~(completionContext : CompletionContext.t) | Some (itemNum, tupleItem) -> let completionContext = completionContext - |> CompletionContext.addCtxPathItem (CTupleItem {itemNum}) + |> CompletionContext.addCtxPathItem + (CTupleItem + { + itemNum; + tupleCtxPath = ctxPathFromCompletionContext completionContext; + }) in completePattern ~completionContext tupleItem | None -> @@ -1384,7 +1079,12 @@ and completePattern ~(completionContext : CompletionContext.t) let completionContext = completionContext |> CompletionContext.addCtxPathItem - (CTupleItem {itemNum = !itemNum + 1}) + (CTupleItem + { + itemNum = !itemNum + 1; + tupleCtxPath = + ctxPathFromCompletionContext completionContext; + }) in CompletionResult.pattern ~completionContext ~prefix:"" else None @@ -1394,7 +1094,13 @@ and completePattern ~(completionContext : CompletionContext.t) could work too. *) let completionContext = completionContext - |> CompletionContext.addCtxPathItem (CTupleItem {itemNum = 0}) + |> CompletionContext.addCtxPathItem + (CTupleItem + { + itemNum = 0; + tupleCtxPath = + ctxPathFromCompletionContext completionContext; + }) in CompletionResult.pattern ~completionContext ~prefix:"" | _ -> None diff --git a/analysis/src/CompletionNewTypes.ml b/analysis/src/CompletionNewTypes.ml new file mode 100644 index 000000000..a26675800 --- /dev/null +++ b/analysis/src/CompletionNewTypes.ml @@ -0,0 +1,368 @@ +open SharedTypes + +module PositionContext = struct + type t = { + offset: int; (** The offset *) + cursor: Pos.t; (** The actual position of the cursor *) + beforeCursor: Pos.t; (** The position just before the cursor *) + noWhitespace: Pos.t; + (** The position of the cursor, removing any whitespace _before_ it *) + charBeforeNoWhitespace: char option; + (** The first character before the cursor, excluding any whitespace *) + charBeforeCursor: char option; + (** The char before the cursor, not excluding whitespace *) + whitespaceAfterCursor: char option; + (** The type of whitespace after the cursor, if any *) + locHasPos: Location.t -> bool; + (** A helper for checking whether a loc has the cursor (beforeCursor). + This is the most natural position to check when figuring out if the user has the cursor in something. *) + } + + let make ~offset ~posCursor text = + let offsetNoWhite = Utils.skipWhite text (offset - 1) in + let posNoWhite = + let line, col = posCursor in + (line, max 0 col - offset + offsetNoWhite) + in + let firstCharBeforeCursorNoWhite = + if offsetNoWhite < String.length text && offsetNoWhite >= 0 then + Some text.[offsetNoWhite] + else None + in + let posBeforeCursor = Pos.posBeforeCursor posCursor in + let charBeforeCursor, whitespaceAfterCursor = + match Pos.positionToOffset text posCursor with + | Some offset when offset > 0 -> ( + let charBeforeCursor = text.[offset - 1] in + let charAtCursor = + if offset < String.length text then text.[offset] else '\n' + in + match charAtCursor with + | ' ' | '\t' | '\r' | '\n' -> + (Some charBeforeCursor, Some charBeforeCursor) + | _ -> (Some charBeforeCursor, None)) + | _ -> (None, None) + in + let locHasPos loc = + loc |> CursorPosition.locHasCursor ~pos:posBeforeCursor + in + { + offset; + beforeCursor = posBeforeCursor; + noWhitespace = posNoWhite; + charBeforeNoWhitespace = firstCharBeforeCursorNoWhite; + cursor = posCursor; + charBeforeCursor; + whitespaceAfterCursor; + locHasPos; + } +end + +type completionCategory = Type | Value | Module | Field + +type argumentLabel = + | Unlabelled of {argumentPosition: int} + | Labelled of string + | Optional of string + +type ctxPath = + | CNone (** Nothing. *) + | CUnknown (** Something that cannot be resolved right now *) + | CId of string list * completionCategory + (** A regular id of an expected category. `let fff = thisIsAnId` and `let fff = SomePath.alsoAnId` *) + | CVariantPayload of { + variantCtxPath: ctxPath; + itemNum: int; + constructorName: string; + } + (** A variant payload. `Some()` = itemNum 0, `Whatever(true, f)` = itemNum 1 *) + | CTupleItem of {tupleCtxPath: ctxPath; itemNum: int} + (** A tuple item. `(true, false, )` = itemNum 2 *) + | CRecordField of { + recordCtxPath: ctxPath; + seenFields: string list; + prefix: string; + } + (** A record field. `let f = {on: true, s}` seenFields = [on], prefix = "s",*) + (* TODO: Can we merge with CRecordFieldAccess?*) + | CRecordFieldFollow of {recordCtxPath: ctxPath; fieldName: string} + (** Follow this record field. {}*) + | COption of ctxPath (** An option with an inner type. *) + | CArray of ctxPath option (** An array with an inner type. *) + | CTuple of ctxPath list (** A tuple. *) + | CBool + | CString + | CInt + | CFloat + | CAwait of ctxPath (** Awaiting a function call. *) + | CFunction of {returnType: ctxPath} (** A function *) + | CRecordFieldAccess of {recordCtxPath: ctxPath; fieldName: string} + (** Field access. `whateverVariable.fieldName`. The ctxPath points to the value of `whateverVariable`, + and the string is the name of the field we're accessing. *) + | CObj of {objectCtxPath: ctxPath; propertyName: string} + (** Object property access. `whateverVariable["fieldName"]`. The ctxPath points to the value of `whateverVariable`, + and the string is the name of the property we're accessing. *) + | CApply of {functionCtxPath: ctxPath; args: Asttypes.arg_label list} + (** Function application. `someFunction(someVar, ~otherLabel="hello")`. The ctxPath points to the function. *) + | CFunctionArgument of { + functionContextPath: ctxPath; + argumentLabel: argumentLabel; + } (** A function argument, either labelled or unlabelled.*) + | CPipe of { + functionCtxPath: ctxPath; + (** Context path to the function being called. *) + id: string; + lhsLoc: Location.t; (** Location of the left hand side. *) + } (** Piped call. `foo->someFn`. *) + | CJsxPropValue of { + pathToComponent: string list; + (** The path to the component this property is from. *) + propName: string; (** The prop name we're going through. *) + } (** A JSX property. *) + | CTypeAtLoc of Location.t (** A type at a location. *) + | CFunctionReturnType of {functionCtxPath: ctxPath} + (** An instruction to resolve the return type of the type at the + provided context path, if it's a function (it should always be, + but you know...) *) + +let rec ctxPathToString (ctxPath : ctxPath) = + match ctxPath with + | CUnknown -> "CUnknown" + | CNone -> "CUnknown" + | CBool -> "bool" + | CFloat -> "float" + | CInt -> "int" + | CString -> "string" + | CJsxPropValue {pathToComponent; propName} -> + "CJsxPropValue " ^ (pathToComponent |> list) ^ " " ^ propName + | CAwait ctxPath -> Printf.sprintf "await %s" (ctxPathToString ctxPath) + | CApply {functionCtxPath; args} -> + Printf.sprintf "%s(%s)" + (ctxPathToString functionCtxPath) + (args + |> List.map (function + | Asttypes.Nolabel -> "Nolabel" + | Labelled s -> "~" ^ s + | Optional s -> "?" ^ s) + |> String.concat ", ") + | CRecordFieldAccess {recordCtxPath; fieldName} -> + Printf.sprintf "(%s).%s" (ctxPathToString recordCtxPath) fieldName + | CObj {objectCtxPath; propertyName} -> + Printf.sprintf "(%s)[\"%s\"]" (ctxPathToString objectCtxPath) propertyName + | CFunction {returnType} -> + Printf.sprintf "CFunction () -> %s" (ctxPathToString returnType) + | CTuple ctxPaths -> + Printf.sprintf "CTuple(%s)" + (ctxPaths |> List.map ctxPathToString |> String.concat ", ") + | CId (prefix, typ) -> + Printf.sprintf "CId(%s)=%s" + (match typ with + | Value -> "Value" + | Type -> "Type" + | Module -> "Module" + | Field -> "Field") + (ident prefix) + | CVariantPayload {variantCtxPath; itemNum; constructorName} -> + Printf.sprintf "CVariantPayload %s => %s($%i)" + (ctxPathToString variantCtxPath) + constructorName itemNum + | CTupleItem {tupleCtxPath; itemNum} -> + Printf.sprintf "CTupleItem %s ($%i)" (ctxPathToString tupleCtxPath) itemNum + | CRecordField {recordCtxPath; prefix} -> + Printf.sprintf "CRecordField (%s)=%s" (ctxPathToString recordCtxPath) prefix + | COption ctxPath -> Printf.sprintf "COption<%s>" (ctxPathToString ctxPath) + | CArray ctxPath -> + Printf.sprintf "array%s" + (match ctxPath with + | None -> "" + | Some ctxPath -> "<" ^ ctxPathToString ctxPath ^ ">") + | CFunctionArgument {functionContextPath; argumentLabel} -> + "CFunctionArgument " + ^ (functionContextPath |> ctxPathToString) + ^ "(" + ^ (match argumentLabel with + | Unlabelled {argumentPosition} -> "$" ^ string_of_int argumentPosition + | Labelled name -> "~" ^ name + | Optional name -> "~" ^ name ^ "=?") + ^ ")" + | CPipe {functionCtxPath; id} -> + "(" ^ ctxPathToString functionCtxPath ^ ")->" ^ id + | CRecordFieldFollow {fieldName} -> "CRecordFieldFollow {" ^ fieldName ^ "}" + | CTypeAtLoc loc -> Printf.sprintf "CTypeAtLoc: %s" (Loc.toString loc) + | CFunctionReturnType {functionCtxPath} -> + Printf.sprintf "CFunctionReturnType %s" (ctxPathToString functionCtxPath) + +module CompletionContext = struct + type t = { + positionContext: PositionContext.t; + scope: Scope.t; + currentlyExpecting: ctxPath; + ctxPath: ctxPath; + } + + let make positionContext = + { + positionContext; + scope = Scope.create (); + currentlyExpecting = CNone; + ctxPath = CNone; + } + + let resetCtx completionContext = + {completionContext with currentlyExpecting = CNone; ctxPath = CNone} + + let withScope scope completionContext = {completionContext with scope} + + let setCurrentlyExpecting currentlyExpecting completionContext = + {completionContext with currentlyExpecting} + + let currentlyExpectingOrReset currentlyExpecting completionContext = + match currentlyExpecting with + | None -> {completionContext with currentlyExpecting = CNone} + | Some currentlyExpecting -> {completionContext with currentlyExpecting} + + let currentlyExpectingOrTypeAtLoc ~loc currentlyExpecting completionContext = + match currentlyExpecting with + | None -> {completionContext with currentlyExpecting = CTypeAtLoc loc} + | Some currentlyExpecting -> {completionContext with currentlyExpecting} + + let withResetCurrentlyExpecting completionContext = + {completionContext with currentlyExpecting = CNone} + + let addCtxPathItem ctxPath completionContext = + {completionContext with ctxPath} +end + +module CompletionInstruction = struct + (** This is the completion instruction, that's responsible for resolving something at + context path X *) + type t = + | CtxPath of ctxPath + | Cpattern of { + ctxPath: ctxPath; + (** This is the context path inside of the pattern itself. + Used to walk up to the type we're looking to complete. *) + rootType: ctxPath; + (** This is the an instruction to find where completion starts + from. If we're completing inside of a record, it should resolve + to the record itself. *) + prefix: string; + } (** Completing inside of a pattern. *) + | Cexpression of { + ctxPath: ctxPath; + (** This is the context path inside of the expression itself. + Used to walk up to the type we're looking to complete. *) + rootType: ctxPath; + (** This is the an instruction to find where completion starts + from. If we're completing inside of a record, it should resolve + to the record itself. *) + prefix: string; + } (** Completing inside of an expression. *) + | CnamedArg of { + ctxPath: ctxPath; + (** Context path to the function with the argument. *) + seenLabels: string list; + (** All the already seen labels in the function call. *) + prefix: string; (** The text the user has written so far.*) + } + | Cjsx of { + pathToComponent: string list; + (** The path to the component: `["M", "Comp"]`. *) + prefix: string; (** What the user has already written. `"id"`. *) + seenProps: string list; + (** A list of all of the props that has already been entered.*) + } + | ChtmlElement of {prefix: string (** What the user has written so far. *)} + (** Completing for a regular HTML element. *) + + let ctxPath ctxPath = CtxPath ctxPath + + let pattern ~(completionContext : CompletionContext.t) ~prefix = + Cpattern + { + prefix; + rootType = completionContext.currentlyExpecting; + ctxPath = completionContext.ctxPath; + } + + let expression ~(completionContext : CompletionContext.t) ~prefix = + Cexpression + { + prefix; + rootType = completionContext.currentlyExpecting; + ctxPath = completionContext.ctxPath; + } + + let namedArg ~prefix ~functionContextPath ~seenLabels = + CnamedArg {prefix; ctxPath = functionContextPath; seenLabels} + + let jsx ~prefix ~pathToComponent ~seenProps = + Cjsx {prefix; pathToComponent; seenProps} + + let htmlElement ~prefix = ChtmlElement {prefix} + + let toString (c : t) = + match c with + | CtxPath ctxPath -> Printf.sprintf "CtxPath: %s" (ctxPathToString ctxPath) + | Cpattern {ctxPath; prefix; rootType} -> + Printf.sprintf "Cpattern: ctxPath: %s, rootType: %s%s" + (ctxPathToString ctxPath) (ctxPathToString rootType) + (match prefix with + | "" -> "" + | prefix -> Printf.sprintf ", prefix: \"%s\"" prefix) + | Cexpression {ctxPath; prefix; rootType} -> + Printf.sprintf "Cexpression: ctxPath: %s, rootType: %s%s" + (ctxPathToString ctxPath) (ctxPathToString rootType) + (match prefix with + | "" -> "" + | prefix -> Printf.sprintf ", prefix: \"%s\"" prefix) + | CnamedArg {prefix; ctxPath; seenLabels} -> + "CnamedArg(" + ^ (ctxPath |> ctxPathToString) + ^ ", " ^ str prefix ^ ", " ^ (seenLabels |> list) ^ ")" + | Cjsx {prefix; pathToComponent; seenProps} -> + "Cjsx(" ^ (pathToComponent |> ident) ^ ", " ^ str prefix ^ ", " + ^ (seenProps |> list) ^ ")" + | ChtmlElement {prefix} -> "ChtmlElement <" ^ prefix ^ " />" +end + +module CompletionResult = struct + type t = (CompletionInstruction.t * CompletionContext.t) option + + let make (instruction : CompletionInstruction.t) + (context : CompletionContext.t) = + Some (instruction, context) + + let ctxPath (ctxPath : ctxPath) (completionContext : CompletionContext.t) = + let completionContext = + completionContext |> CompletionContext.addCtxPathItem ctxPath + in + make + (CompletionInstruction.ctxPath completionContext.ctxPath) + completionContext + + let pattern ~(completionContext : CompletionContext.t) ~prefix = + make + (CompletionInstruction.pattern ~completionContext ~prefix) + completionContext + + let expression ~(completionContext : CompletionContext.t) ~prefix = + make + (CompletionInstruction.expression ~completionContext ~prefix) + completionContext + + let namedArg ~(completionContext : CompletionContext.t) ~prefix ~seenLabels + ~functionContextPath = + make + (CompletionInstruction.namedArg ~functionContextPath ~prefix ~seenLabels) + completionContext + + let jsx ~(completionContext : CompletionContext.t) ~prefix ~pathToComponent + ~seenProps = + make + (CompletionInstruction.jsx ~prefix ~pathToComponent ~seenProps) + completionContext + + let htmlElement ~(completionContext : CompletionContext.t) ~prefix = + make (CompletionInstruction.htmlElement ~prefix) completionContext +end diff --git a/analysis/src/Completions.ml b/analysis/src/Completions.ml index 3d8d86a6e..7b0154824 100644 --- a/analysis/src/Completions.ml +++ b/analysis/src/Completions.ml @@ -36,8 +36,7 @@ let getCompletions2 ~debug ~path ~pos ~currentFile ~forHover = | None -> print_endline "No completions" | Some (res, ctx) -> Printf.printf "Result: %s\n" - (CompletionFrontEndNew.CompletionInstruction.toString res); + (CompletionNewTypes.CompletionInstruction.toString res); Printf.printf "Scope: %i items\n" (List.length ctx.scope); Printf.printf "Looking for type: %s\n" - (ctx.currentlyExpecting - |> CompletionFrontEndNew.currentlyExpectingToString))) + (ctx.currentlyExpecting |> CompletionNewTypes.ctxPathToString))) diff --git a/analysis/tests/src/expected/CompletionNew.res.txt b/analysis/tests/src/expected/CompletionNew.res.txt index 2e87e8fd7..1a863fcd3 100644 --- a/analysis/tests/src/expected/CompletionNew.res.txt +++ b/analysis/tests/src/expected/CompletionNew.res.txt @@ -1,197 +1,197 @@ Complete2 src/CompletionNew.res 2:17 -Result: Cexpression: ctxPath: CId(Value)=m, rootType: TypeAtLoc: [2:7->2:13] +Result: Cexpression: ctxPath: CId(Value)=m, rootType: CTypeAtLoc: [2:7->2:13] Scope: 1 items -Looking for type: TypeAtLoc: [2:7->2:13] +Looking for type: CTypeAtLoc: [2:7->2:13] Complete2 src/CompletionNew.res 7:30 -Result: Cexpression: ctxPath: CId(Module)=O, rootType: Type, prefix: "O" +Result: Cexpression: ctxPath: CId(Module)=O, rootType: CId(Type)=someVariant, prefix: "O" Scope: 1 items -Looking for type: Type +Looking for type: CId(Type)=someVariant Complete2 src/CompletionNew.res 10:36 -Result: Cexpression: ctxPath: CVariantPayload($0)->CId(Value)=t, rootType: Type +Result: Cexpression: ctxPath: CId(Value)=t, rootType: CId(Type)=someVariant Scope: 1 items -Looking for type: Type +Looking for type: CId(Type)=someVariant Complete2 src/CompletionNew.res 13:42 -Result: Cexpression: ctxPath: CVariantPayload($1)->CId(Module)=S, rootType: Type, prefix: "S" +Result: Cexpression: ctxPath: CId(Module)=S, rootType: CId(Type)=someVariant, prefix: "S" Scope: 1 items -Looking for type: Type +Looking for type: CId(Type)=someVariant Complete2 src/CompletionNew.res 16:47 -Result: Cexpression: ctxPath: CVariantPayload($1)->CVariantPayload($0)->CId(Module)=O, rootType: Type, prefix: "O" +Result: Cexpression: ctxPath: CId(Module)=O, rootType: CId(Type)=someVariant, prefix: "O" Scope: 1 items -Looking for type: Type +Looking for type: CId(Type)=someVariant Complete2 src/CompletionNew.res 27:29 -Result: Cexpression: ctxPath: CRecordField=, rootType: Type +Result: Cexpression: ctxPath: CRecordField (CUnknown)=, rootType: CId(Type)=someRecord Scope: 1 items -Looking for type: Type +Looking for type: CId(Type)=someRecord Complete2 src/CompletionNew.res 30:30 -Result: Cexpression: ctxPath: CRecordField=n, rootType: Type, prefix: "n" +Result: Cexpression: ctxPath: CRecordField (CUnknown)=n, rootType: CId(Type)=someRecord, prefix: "n" Scope: 1 items -Looking for type: Type +Looking for type: CId(Type)=someRecord Complete2 src/CompletionNew.res 33:39 -Result: Cexpression: ctxPath: CRecordField=variant->CId(Module)=O, rootType: Type, prefix: "O" +Result: Cexpression: ctxPath: CId(Module)=O, rootType: CId(Type)=someRecord, prefix: "O" Scope: 1 items -Looking for type: Type +Looking for type: CId(Type)=someRecord Complete2 src/CompletionNew.res 36:66 -Result: Cexpression: ctxPath: CRecordField=nested->CRecordField=maybeVariant->CVariantPayload($1)->CId(Value)=t, rootType: Type +Result: Cexpression: ctxPath: CId(Value)=t, rootType: CId(Type)=someRecord Scope: 1 items -Looking for type: Type +Looking for type: CId(Type)=someRecord Complete2 src/CompletionNew.res 39:66 -Result: Cexpression: ctxPath: CRecordField=variant, rootType: Type +Result: Cexpression: ctxPath: CRecordField (CUnknown)=variant, rootType: CId(Type)=someRecord Scope: 1 items -Looking for type: Type +Looking for type: CId(Type)=someRecord Complete2 src/CompletionNew.res 42:56 -Result: Cexpression: ctxPath: CRecordField=nested->CRecordField=, rootType: Type +Result: Cexpression: ctxPath: CRecordField (CRecordField (CUnknown)=nested)=, rootType: CId(Type)=someRecord Scope: 1 items -Looking for type: Type +Looking for type: CId(Type)=someRecord Complete2 src/CompletionNew.res 45:57 -Result: Cexpression: ctxPath: CRecordField=, rootType: Type +Result: Cexpression: ctxPath: CRecordField (CUnknown)=, rootType: CId(Type)=someRecord Scope: 1 items -Looking for type: Type +Looking for type: CId(Type)=someRecord Complete2 src/CompletionNew.res 49:71 -Result: Cexpression: ctxPath: CId(Value)=x, rootType: Unit +Result: Cexpression: ctxPath: CId(Value)=x, rootType: CUnknown Scope: 2 items -Looking for type: Unit +Looking for type: CUnknown Complete2 src/CompletionNew.res 53:73 -Result: Cexpression: ctxPath: CRecordField=nested->CRecordField=maybeVariant->CId(Value)=, rootType: Type +Result: Cexpression: ctxPath: CId(Value)=, rootType: CId(Type)=someRecord Scope: 2 items -Looking for type: Type +Looking for type: CId(Type)=someRecord Complete2 src/CompletionNew.res 57:85 -Result: Cexpression: ctxPath: CRecordField=nested->CRecordField=maybeVariant->CId(Value)=v, rootType: Type +Result: Cexpression: ctxPath: CId(Value)=v, rootType: CId(Type)=someRecord Scope: 2 items -Looking for type: Type +Looking for type: CId(Type)=someRecord Complete2 src/CompletionNew.res 61:58 -Result: Cexpression: ctxPath: CId(Value)=doStuff, rootType: Unit +Result: Cexpression: ctxPath: CId(Value)=doStuff, rootType: CUnknown Scope: 1 items -Looking for type: Unit +Looking for type: CUnknown Complete2 src/CompletionNew.res 66:32 -Result: Cexpression: ctxPath: CId(Value)=, rootType: Type +Result: Cexpression: ctxPath: CId(Value)=, rootType: bool Scope: 2 items -Looking for type: Type +Looking for type: bool Complete2 src/CompletionNew.res 69:38 -Result: Cexpression: ctxPath: CRecordField=, rootType: FunctionReturnType +Result: Cexpression: ctxPath: CRecordField (CUnknown)=, rootType: CFunctionReturnType CId(Type)=fn Scope: 3 items -Looking for type: FunctionReturnType +Looking for type: CFunctionReturnType CId(Type)=fn Complete2 src/CompletionNew.res 72:72 -Result: Cexpression: ctxPath: CId(Value)=, rootType: FunctionReturnType +Result: Cexpression: ctxPath: CId(Value)=, rootType: CFunctionReturnType CId(Type)=fn Scope: 4 items -Looking for type: FunctionReturnType +Looking for type: CFunctionReturnType CId(Type)=fn Complete2 src/CompletionNew.res 76:60 -Result: Cexpression: ctxPath: CId(Value)=t, rootType: Type +Result: Cexpression: ctxPath: CId(Value)=t, rootType: bool Scope: 3 items -Looking for type: Type +Looking for type: bool Complete2 src/CompletionNew.res 80:54 -Result: Cexpression: ctxPath: CId(Value)=t, rootType: TypeAtLoc: [80:42->80:50] +Result: Cexpression: ctxPath: CId(Value)=t, rootType: CTypeAtLoc: [80:42->80:50] Scope: 3 items -Looking for type: TypeAtLoc: [80:42->80:50] +Looking for type: CTypeAtLoc: [80:42->80:50] Complete2 src/CompletionNew.res 84:22 Result: CtxPath: CId(Value)= Scope: 1 items -Looking for type: Type +Looking for type: bool Complete2 src/CompletionNew.res 87:20 -Result: Cpattern: ctxPath: CRecordField=someField, rootType: Type, prefix: "s" +Result: Cpattern: ctxPath: CRecordField (CUnknown)=someField, rootType: CId(Value)=someRecordVar, prefix: "s" Scope: 1 items -Looking for type: Type +Looking for type: CId(Value)=someRecordVar Complete2 src/CompletionNew.res 91:13 -Result: Cpattern: ctxPath: CTupleItem($1), rootType: Type +Result: Cpattern: ctxPath: CTupleItem CUnknown ($1), rootType: CId(Value)=someRecordVar Scope: 1 items -Looking for type: Type +Looking for type: CId(Value)=someRecordVar Complete2 src/CompletionNew.res 94:20 -Result: Cpattern: ctxPath: CTupleItem($2), rootType: Type +Result: Cpattern: ctxPath: CTupleItem CUnknown ($2), rootType: CId(Value)=someRecordVar Scope: 1 items -Looking for type: Type +Looking for type: CId(Value)=someRecordVar Complete2 src/CompletionNew.res 98:9 -Result: Cpattern: ctxPath: array, rootType: Type +Result: Cpattern: ctxPath: array, rootType: CId(Value)=someArr Scope: 1 items -Looking for type: Type +Looking for type: CId(Value)=someArr Complete2 src/CompletionNew.res 101:22 -Result: Cpattern: ctxPath: array->CTupleItem($1)->array, rootType: Type +Result: Cpattern: ctxPath: array, rootType: CId(Value)=someArr Scope: 1 items -Looking for type: Type +Looking for type: CId(Value)=someArr Complete2 src/CompletionNew.res 104:24 -Result: Cpattern: ctxPath: array->CTupleItem($1)->array, rootType: Type, prefix: "f" +Result: Cpattern: ctxPath: array, rootType: CId(Value)=someArr, prefix: "f" Scope: 1 items -Looking for type: Type +Looking for type: CId(Value)=someArr Complete2 src/CompletionNew.res 108:23 -Result: Cexpression: ctxPath: CId(Value)=f, rootType: Type +Result: Cexpression: ctxPath: CId(Value)=f, rootType: CFunctionArgument CId(Value)=&&($1) Scope: 1 items -Looking for type: Type +Looking for type: CFunctionArgument CId(Value)=&&($1) Complete2 src/CompletionNew.res 111:42 -Result: Cexpression: ctxPath: CId(Value)=f, rootType: FunctionReturnType +Result: Cexpression: ctxPath: CId(Value)=f, rootType: CFunctionReturnType CFunctionArgument CId(Value)=someFunc($0) Scope: 2 items -Looking for type: FunctionReturnType +Looking for type: CFunctionReturnType CFunctionArgument CId(Value)=someFunc($0) Complete2 src/CompletionNew.res 114:34 -Result: Cexpression: ctxPath: CId(Value)=f, rootType: Type +Result: Cexpression: ctxPath: CId(Value)=f, rootType: CFunctionArgument CId(Value)=someFunc(~labelledArg) Scope: 1 items -Looking for type: Type +Looking for type: CFunctionArgument CId(Value)=someFunc(~labelledArg) Complete2 src/CompletionNew.res 117:33 -Result: Cexpression: ctxPath: , rootType: Type +Result: Cexpression: ctxPath: CUnknown, rootType: CFunctionArgument CId(Value)=someFunc(~labelledArg) Scope: 1 items -Looking for type: Type +Looking for type: CFunctionArgument CId(Value)=someFunc(~labelledArg) Complete2 src/CompletionNew.res 121:17 Result: CtxPath: (CId(Value)=foo)->id Scope: 1 items -Looking for type: Unit +Looking for type: CUnknown Complete2 src/CompletionNew.res 124:16 Result: CtxPath: (CId(Value)=foo)-> Scope: 1 items -Looking for type: Unit +Looking for type: CUnknown Complete2 src/CompletionNew.res 127:17 -Result: Cexpression: ctxPath: CId(Module)=M, rootType: Unit, prefix: "M" +Result: Cexpression: ctxPath: CId(Module)=M, rootType: CUnknown, prefix: "M" Scope: 1 items -Looking for type: Unit +Looking for type: CUnknown Complete2 src/CompletionNew.res 136:36 Result: CnamedArg(CId(Value)=someFun, f, [secondLabel, f]) Scope: 2 items -Looking for type: TypeAtLoc: [136:7->136:9] +Looking for type: CTypeAtLoc: [136:7->136:9] Complete2 src/CompletionNew.res 139:37 -Result: Cexpression: ctxPath: , rootType: Type +Result: Cexpression: ctxPath: CUnknown, rootType: CFunctionArgument CId(Value)=someFun($0) Scope: 2 items -Looking for type: Type +Looking for type: CFunctionArgument CId(Value)=someFun($0) Complete2 src/CompletionNew.res 143:21 Result: CtxPath: CId(Module)=SomeCom Scope: 2 items -Looking for type: Unit +Looking for type: CUnknown Complete2 src/CompletionNew.res 146:26 Result: CtxPath: CId(Module)=SomeModule.S Scope: 2 items -Looking for type: Unit +Looking for type: CUnknown Complete2 src/CompletionNew.res 149:24 No completions @@ -199,20 +199,20 @@ No completions Complete2 src/CompletionNew.res 152:25 Result: Cjsx(Component, a, [a]) Scope: 2 items -Looking for type: TypeAtLoc: [152:7->152:10] +Looking for type: CTypeAtLoc: [152:7->152:10] Complete2 src/CompletionNew.res 155:30 -Result: Cexpression: ctxPath: , rootType: Type +Result: Cexpression: ctxPath: CUnknown, rootType: CJsxPropValue [Component] aProp Scope: 2 items -Looking for type: Type +Looking for type: CJsxPropValue [Component] aProp Complete2 src/CompletionNew.res 158:40 -Result: Cexpression: ctxPath: CId(Value)=, rootType: Type +Result: Cexpression: ctxPath: CId(Value)=, rootType: CJsxPropValue [Component] aProp Scope: 2 items -Looking for type: Type +Looking for type: CJsxPropValue [Component] aProp Complete2 src/CompletionNew.res 161:35 -Result: Cexpression: ctxPath: CId(Module)=Stuff, rootType: Type, prefix: "Stuff" +Result: Cexpression: ctxPath: CId(Module)=Stuff, rootType: CJsxPropValue [Component] aProp, prefix: "Stuff" Scope: 2 items -Looking for type: Type +Looking for type: CJsxPropValue [Component] aProp From 7dcf626e62924e952c94af614d5c6a337a63e5f6 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 8 Sep 2023 19:26:15 +0200 Subject: [PATCH 16/18] wip --- analysis/src/Commands.ml | 17 +- analysis/src/CompletionBackEnd.ml | 9 +- analysis/src/CompletionBackendNew.ml | 862 ++++++++++++++++-- analysis/src/CompletionFrontEnd.ml | 10 +- analysis/src/CompletionFrontEndNew.ml | 54 +- analysis/src/CompletionNewTypes.ml | 155 +--- analysis/src/Completions.ml | 24 +- analysis/src/CompletionsNewTypesCtxPath.ml | 147 +++ analysis/src/Scope.ml | 14 +- analysis/src/SharedTypes.ml | 5 +- analysis/src/TypeUtils.ml | 9 +- analysis/tests/src/CompletionNew.res | 6 +- .../tests/src/expected/CompletionNew.res.txt | 609 ++++++++++--- 13 files changed, 1546 insertions(+), 375 deletions(-) create mode 100644 analysis/src/CompletionsNewTypesCtxPath.ml diff --git a/analysis/src/Commands.ml b/analysis/src/Commands.ml index df1ebbe7c..d59bb710f 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -12,6 +12,20 @@ let completion ~debug ~path ~pos ~currentFile = |> List.map Protocol.stringifyCompletionItem |> Protocol.array) +let completionNew ~debug ~path ~pos ~currentFile = + let completions = + match + Completions.getCompletions2 ~debug ~path ~pos ~currentFile ~forHover:false + with + | None -> [] + | Some (completions, _, _) -> completions + in + print_endline + (completions + |> List.map CompletionBackEnd.completionToItem + |> List.map Protocol.stringifyCompletionItem + |> Protocol.array) + let inlayhint ~path ~pos ~maxLength ~debug = let result = match Hint.inlay ~path ~pos ~maxLength ~debug with @@ -321,8 +335,7 @@ let test ~path = ("Complete2 " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col); let currentFile = createCurrentFile () in - Completions.getCompletions2 ~forHover:false ~debug:true ~path - ~pos:(line, col) ~currentFile; + completionNew ~debug:true ~path ~pos:(line, col) ~currentFile; Sys.remove currentFile | "dce" -> print_endline ("DCE " ^ path); diff --git a/analysis/src/CompletionBackEnd.ml b/analysis/src/CompletionBackEnd.ml index 15db181c1..74b4674fe 100644 --- a/analysis/src/CompletionBackEnd.ml +++ b/analysis/src/CompletionBackEnd.ml @@ -286,7 +286,10 @@ let processLocalValue name loc contextPath ~prefix ~exact ~env Completion.create name ~env ~kind: (match contextPath with - | Some contextPath -> FollowContextPath contextPath + | Some (Scope.Completable contextPath) -> + FollowContextPath (`Completable contextPath) + | Some (Scope.New contextPath) -> + FollowContextPath (`New contextPath) | None -> Value (Ctype.newconstr @@ -628,7 +631,7 @@ let rec completionsGetCompletionType2 ~debug ~full ~opens ~rawOpens ~pos ~scope | {Completion.kind = ObjLabel typ; env} :: _ | {Completion.kind = Field ({typ}, _); env} :: _ -> Some (TypeExpr typ, env) - | {Completion.kind = FollowContextPath ctxPath; env} :: _ -> + | {Completion.kind = FollowContextPath (`Completable ctxPath); env} :: _ -> ctxPath |> getCompletionsForContextPath ~debug ~full ~env ~exact:true ~opens ~rawOpens ~pos ~scope @@ -647,7 +650,7 @@ and completionsGetTypeEnv2 ~debug (completions : Completion.t list) ~full ~opens | {Completion.kind = Value typ; env} :: _ -> Some (typ, env) | {Completion.kind = ObjLabel typ; env} :: _ -> Some (typ, env) | {Completion.kind = Field ({typ}, _); env} :: _ -> Some (typ, env) - | {Completion.kind = FollowContextPath ctxPath; env} :: _ -> + | {Completion.kind = FollowContextPath (`Completable ctxPath); env} :: _ -> ctxPath |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact:true ~scope diff --git a/analysis/src/CompletionBackendNew.ml b/analysis/src/CompletionBackendNew.ml index c34b6ea96..510aa5fda 100644 --- a/analysis/src/CompletionBackendNew.ml +++ b/analysis/src/CompletionBackendNew.ml @@ -1,9 +1,76 @@ open SharedTypes open CompletionNewTypes +open CompletionsNewTypesCtxPath -let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos +(* TODO: Unify and clean these up once we have tests *) + +let getCompletionsForPath = CompletionBackEnd.getCompletionsForPath +let getOpens = CompletionBackEnd.getOpens +let getComplementaryCompletionsForTypedValue = + CompletionBackEnd.getComplementaryCompletionsForTypedValue + +let rec completionsGetCompletionType ~full = function + | {Completion.kind = Value typ; env} :: _ + | {Completion.kind = ObjLabel typ; env} :: _ + | {Completion.kind = Field ({typ}, _); env} :: _ -> + typ + |> TypeUtils.extractType ~env ~package:full.package + |> Option.map (fun typ -> (typ, env)) + | {Completion.kind = Type typ; env} :: _ -> ( + match TypeUtils.extractTypeFromResolvedType typ ~env ~full with + | None -> None + | Some extractedType -> Some (extractedType, env)) + | {Completion.kind = ExtractedType (typ, _); env} :: _ -> Some (typ, env) + | _ -> None + +and completionsGetCompletionTypeX ~full = function + | {Completion.kind = Value typ; env} :: _ + | {Completion.kind = ObjLabel typ; env} :: _ + | {Completion.kind = Field ({typ}, _); env} :: _ -> + typ + |> TypeUtils.extractType ~env ~package:full.package + |> Option.map (fun typ -> (typ, env)) + | {Completion.kind = Type typ; env} :: _ -> ( + match TypeUtils.extractTypeFromResolvedType typ ~env ~full with + | None -> None + | Some extractedType -> Some (extractedType, env)) + | {Completion.kind = ExtractedType (typ, _); env} :: _ -> Some (typ, env) + | _ -> None + +and completionsGetCompletionType2 ~debug ~full ~opens ~rawOpens ~pos ~scope = + function + | {Completion.kind = Value typ; env} :: _ + | {Completion.kind = ObjLabel typ; env} :: _ + | {Completion.kind = Field ({typ}, _); env} :: _ -> + Some (TypeExpr typ, env) + | {Completion.kind = FollowContextPath (`New ctxPath); env} :: _ -> + ctxPath + |> getCompletionsForContextPath ~debug ~full ~env ~exact:true ~opens + ~rawOpens ~pos ~scope + |> completionsGetCompletionType2 ~debug ~full ~opens ~rawOpens ~pos ~scope + | {Completion.kind = Type typ; env} :: _ -> ( + match TypeUtils.extractTypeFromResolvedType typ ~env ~full with + | None -> None + | Some extractedType -> Some (ExtractedType extractedType, env)) + | {Completion.kind = ExtractedType (typ, _); env} :: _ -> + Some (ExtractedType typ, env) + | _ -> None + +and completionsGetTypeEnv ~debug (completions : Completion.t list) ~full ~opens + ~rawOpens ~pos ~scope = + match completions with + | {Completion.kind = Value typ; env} :: _ -> Some (typ, env) + | {Completion.kind = ObjLabel typ; env} :: _ -> Some (typ, env) + | {Completion.kind = Field ({typ}, _); env} :: _ -> Some (typ, env) + | {Completion.kind = FollowContextPath (`New ctxPath); env} :: _ -> + ctxPath + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + |> completionsGetTypeEnv ~debug ~full ~opens ~rawOpens ~pos ~scope + | _ -> None + +and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~(env : QueryEnv.t) ~exact ~(scope : Scope.t) (contextPath : ctxPath) = - if debug then Printf.printf "ContextPath %s\n" (ctxPathToString contextPath); let package = full.package in match contextPath with | CString -> @@ -46,7 +113,7 @@ let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos cp |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact:true ~scope - |> CompletionBackEnd.completionsGetCompletionType ~full + |> completionsGetCompletionType ~full with | None -> [] | Some (typ, env) -> @@ -60,7 +127,7 @@ let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos cp |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact:true ~scope - |> CompletionBackEnd.completionsGetCompletionType ~full + |> completionsGetCompletionType ~full with | None -> [] | Some (typ, env) -> @@ -74,15 +141,14 @@ let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos cp |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact:true ~scope - |> CompletionBackEnd.completionsGetCompletionType ~full + |> completionsGetCompletionType ~full with | Some (Tpromise (env, typ), _env) -> [Completion.create "dummy" ~env ~kind:(Completion.Value typ)] | _ -> []) | CId (path, completionContext) -> path - |> CompletionBackEnd.getCompletionsForPath ~debug ~package ~opens ~full ~pos - ~exact + |> getCompletionsForPath ~debug ~package ~opens ~full ~pos ~exact ~completionContext: (match completionContext with | Value -> Value @@ -90,13 +156,12 @@ let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos | Field -> Field | Type -> Type) ~env ~scope - | CApply (cp, labels) -> ( + | CApply {functionCtxPath; args = labels} -> ( match - cp + functionCtxPath |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact:true ~scope - |> CompletionBackEnd.completionsGetCompletionType2 ~debug ~full ~opens - ~rawOpens ~pos ~scope + |> completionsGetCompletionType2 ~debug ~full ~opens ~rawOpens ~pos ~scope with | Some ((TypeExpr typ | ExtractedType (Tfunction {typ})), env) -> ( let rec reconstructFunctionType args tRet = @@ -132,22 +197,22 @@ let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos [Completion.create "dummy" ~env ~kind:(Completion.Value retType)] | _ -> []) | _ -> []) - | CField (CId (path, Module), fieldName) -> + | CRecordFieldAccess {recordCtxPath = CId (path, Module); fieldName} -> (* M.field *) path @ [fieldName] - |> CompletionBackEnd.getCompletionsForPath ~debug ~package ~opens ~full ~pos - ~exact ~completionContext:Field ~env ~scope - | CField (cp, fieldName) -> ( + |> getCompletionsForPath ~debug ~package ~opens ~full ~pos ~exact + ~completionContext:Field ~env ~scope + | CRecordFieldAccess {recordCtxPath; fieldName} -> ( let completionsForCtxPath = - cp + recordCtxPath |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact:true ~scope in let extracted = match completionsForCtxPath - |> CompletionBackEnd.completionsGetCompletionType2 ~debug ~full ~opens - ~rawOpens ~pos ~scope + |> completionsGetCompletionType2 ~debug ~full ~opens ~rawOpens ~pos + ~scope with | Some (TypeExpr typ, env) -> ( match typ |> TypeUtils.extractRecordType ~env ~package with @@ -175,14 +240,13 @@ let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ?deprecated:field.deprecated ~docstring:field.docstring ~kind:(Completion.Field (field, recordAsString))) else None)) - | CObj (cp, label) -> ( + | CObj {objectCtxPath; propertyName} -> ( (* TODO: Also needs to support ExtractedType *) match - cp + objectCtxPath |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact:true ~scope - |> CompletionBackEnd.completionsGetTypeEnv2 ~debug ~full ~opens ~rawOpens - ~pos ~scope + |> completionsGetTypeEnv ~debug ~full ~opens ~rawOpens ~pos ~scope with | Some (typ, env) -> ( match typ |> TypeUtils.extractObjectType ~env ~package with @@ -198,19 +262,18 @@ let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos in tObj |> getFields |> Utils.filterMap (fun (field, typ) -> - if Utils.checkName field ~prefix:label ~exact then + if Utils.checkName field ~prefix:propertyName ~exact then Some (Completion.create field ~env ~kind:(Completion.ObjLabel typ)) else None) | None -> []) | None -> []) - | CPipe {ctxPath = cp; id = funNamePrefix; lhsLoc} -> ( + | CPipe {functionCtxPath = cp; id = funNamePrefix; lhsLoc} -> ( match cp |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact:true ~scope - |> CompletionBackEnd.completionsGetTypeEnv2 ~debug ~full ~opens ~rawOpens - ~pos ~scope + |> completionsGetTypeEnv ~debug ~full ~opens ~rawOpens ~pos ~scope with | None -> [] | Some (typ, envFromCompletionItem) -> ( @@ -309,9 +372,8 @@ let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos in let completions = completionPath @ [funNamePrefix] - |> CompletionBackEnd.getCompletionsForPath ~debug - ~completionContext:Value ~exact:false ~package ~opens ~full ~pos - ~env ~scope + |> getCompletionsForPath ~debug ~completionContext:Value ~exact:false + ~package ~opens ~full ~pos ~env ~scope in let completions = completions @@ -376,10 +438,9 @@ let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos | CJsxPropValue {pathToComponent; propName} -> ( let findTypeOfValue path = path - |> CompletionBackEnd.getCompletionsForPath ~debug ~completionContext:Value - ~exact:true ~package ~opens ~full ~pos ~env ~scope - |> CompletionBackEnd.completionsGetTypeEnv2 ~debug ~full ~opens ~rawOpens - ~pos ~scope + |> getCompletionsForPath ~debug ~completionContext:Value ~exact:true + ~package ~opens ~full ~pos ~env ~scope + |> completionsGetTypeEnv ~debug ~full ~opens ~rawOpens ~pos ~scope in let lowercaseComponent = match pathToComponent with @@ -391,9 +452,8 @@ let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos let rec digToTypeForCompletion path = match path - |> CompletionBackEnd.getCompletionsForPath ~debug - ~completionContext:Type ~exact:true ~package ~opens ~full ~pos - ~env ~scope + |> getCompletionsForPath ~debug ~completionContext:Type ~exact:true + ~package ~opens ~full ~pos ~env ~scope with | {kind = Type {kind = Abstract (Some (p, _))}} :: _ -> (* This case happens when what we're looking for is a type alias. @@ -426,8 +486,8 @@ let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos functionContextPath |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact:true ~scope - |> CompletionBackEnd.completionsGetCompletionType2 ~debug ~full ~opens - ~rawOpens ~pos ~scope + |> completionsGetCompletionType2 ~debug ~full ~opens ~rawOpens ~pos + ~scope with | Some ((TypeExpr typ | ExtractedType (Tfunction {typ})), env) -> (typ |> TypeUtils.getArgs ~full ~env, env) @@ -460,13 +520,12 @@ let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos (if expandOption then Utils.unwrapIfOption typ else typ)); ]) | CUnknown -> [] - | CVariantPayload {ctxPath; itemNum} -> ( + | CVariantPayload {variantCtxPath; itemNum; constructorName} -> ( match - ctxPath + variantCtxPath |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact:true ~scope - |> CompletionBackEnd.completionsGetCompletionType2 ~debug ~full ~opens - ~rawOpens ~pos ~scope + |> completionsGetCompletionType2 ~debug ~full ~opens ~rawOpens ~pos ~scope with | Some (typ, env) -> ( let typ = @@ -475,34 +534,86 @@ let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos | TypeExpr t -> t |> TypeUtils.extractType ~env ~package:full.package in match typ with + | Some (Toption (env, innerType)) + when constructorName = "Some" && itemNum = 0 -> + (* Special handling for option which is represented as itself even though it's technically a variant. *) + [ + Completion.create "dummy" ~env + ~kind: + (match innerType with + | ExtractedType innerType -> ExtractedType (innerType, `Type) + | TypeExpr t -> Value t); + ] | Some (Tvariant {constructors}) -> ( let targetType = constructors |> Utils.findMap (fun (c : Constructor.t) -> - match c.args with - | Args args -> ( - match List.nth_opt args itemNum with - | None -> None - | Some (typ, _) -> Some typ) - | _ -> None) + if c.cname.txt = constructorName then + match c.args with + | Args args -> ( + match List.nth_opt args itemNum with + | None -> None + | Some (typ, _) -> Some typ) + | _ -> None + else None) in match targetType with | None -> [] | Some t -> [Completion.create "dummy" ~env ~kind:(Completion.Value t)]) | _ -> []) | _ -> []) - | CTupleItem _ -> [] - | CRecordField {ctxPath; prefix; seenFields} -> ( + | CTupleItem {tupleCtxPath; itemNum} -> ( + match + tupleCtxPath + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + |> completionsGetCompletionType2 ~debug ~full ~opens ~rawOpens ~pos ~scope + with + | Some (typ, env) -> ( + let typ = + match typ with + | ExtractedType t -> Some t + | TypeExpr t -> TypeUtils.extractType ~env ~package t + in + match typ with + | Some (Tuple (env, items, _)) -> ( + match List.nth_opt items itemNum with + | None -> [] + | Some tupleItemType -> + [Completion.create "dummy" ~env ~kind:(Value tupleItemType)]) + | _ -> []) + | _ -> []) + | CRecordField {recordCtxPath; prefix} when true -> ( let completionsForCtxPath = - ctxPath + recordCtxPath + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + in + let extracted = + match + completionsForCtxPath + |> completionsGetCompletionType2 ~debug ~full ~opens ~rawOpens ~pos + ~scope + with + | Some (TypeExpr typ, env) -> typ |> TypeUtils.extractType ~env ~package + | Some (ExtractedType typ, _env) -> Some typ + | None -> None + in + match extracted with + | Some (Trecord _ as typ) -> + [Completion.create "dummy" ~env ~kind:(ExtractedType (typ, `Value))] + | _ -> []) + | CRecordField {recordCtxPath; prefix; seenFields} -> ( + let completionsForCtxPath = + recordCtxPath |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact:true ~scope in let extracted = match completionsForCtxPath - |> CompletionBackEnd.completionsGetCompletionType2 ~debug ~full ~opens - ~rawOpens ~pos ~scope + |> completionsGetCompletionType2 ~debug ~full ~opens ~rawOpens ~pos + ~scope with | Some (TypeExpr typ, env) -> ( match typ |> TypeUtils.extractRecordType ~env ~package with @@ -515,6 +626,8 @@ let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos | Some (ExtractedType typ, env) -> ( match typ with | Trecord {fields} -> + Printf.printf "fields: %s" + (fields |> List.map (fun (f : field) -> f.fname.txt) |> list); Some (env, fields, typ |> TypeUtils.extractedTypeToString) | _ -> None) | None -> None @@ -522,15 +635,650 @@ let rec getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos match extracted with | None -> [] | Some (env, fields, recordAsString) -> - let field = + let fields = fields |> Utils.filterMap (fun field -> - if Utils.checkName field.fname.txt ~prefix ~exact then + if + List.mem field.fname.txt seenFields = false + && Utils.checkName field.fname.txt ~prefix ~exact:false + then Some (Completion.create field.fname.txt ~env ?deprecated:field.deprecated ~docstring:field.docstring ~kind:(Completion.Field (field, recordAsString))) else None) in - field) - | CFunction _ -> [] + Printf.printf "len: %i" (List.length fields); + fields) + | CRecordBody {recordCtxPath; seenFields} -> ( + let completionsForCtxPath = + recordCtxPath + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + in + let extracted = + match + completionsForCtxPath + |> completionsGetCompletionType2 ~debug ~full ~opens ~rawOpens ~pos + ~scope + with + | Some (TypeExpr typ, env) -> ( + match typ |> TypeUtils.extractRecordType ~env ~package with + | Some (env, fields, typDecl) -> + Some + ( env, + fields, + typDecl.item.decl |> Shared.declToString typDecl.name.txt ) + | None -> None) + | Some (ExtractedType typ, env) -> ( + match typ with + | Trecord {fields} -> + Some (env, fields, typ |> TypeUtils.extractedTypeToString) + | _ -> None) + | None -> None + in + match extracted with + | None -> [] + | Some (env, fields, recordAsString) -> + let fields = + fields + |> Utils.filterMap (fun field -> + if List.mem field.fname.txt seenFields = false then + Some + (Completion.create field.fname.txt ~env + ?deprecated:field.deprecated ~docstring:field.docstring + ~kind:(Completion.Field (field, recordAsString))) + else None) + in + fields) + | CFunction _ -> + (* TODO: Support more function stuff? Going from this to Tfunction *) [] + | CNone -> [] + | CRecordFieldFollow {recordCtxPath; fieldName} -> ( + match + recordCtxPath + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + |> completionsGetCompletionType2 ~debug ~full ~opens ~rawOpens ~pos ~scope + with + | Some (typ, env) -> ( + let typ = + match typ with + | ExtractedType t -> Some t + | TypeExpr t -> TypeUtils.extractType ~env ~package t + in + match typ with + | Some (Trecord {fields}) -> ( + match + fields + |> Utils.findMap (fun (field : field) -> + if field.fname.txt = fieldName then Some field.typ else None) + with + | None -> [] + | Some fieldType -> + [Completion.create "dummy" ~env ~kind:(Value fieldType)]) + | _ -> []) + | _ -> []) + | CTypeAtLoc loc -> ( + match + References.getLocItem ~full ~pos:(Pos.ofLexing loc.loc_start) ~debug + with + | None -> [] + | Some {locType = Typed (_, typExpr, _)} -> + [Completion.create "dummy" ~env ~kind:(Value typExpr)] + | _ -> []) + | CFunctionReturnType {functionCtxPath} -> ( + match functionCtxPath with + | CFunction {returnType} -> + returnType + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + | _ -> ( + match + functionCtxPath + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + |> completionsGetCompletionType2 ~debug ~full ~opens ~rawOpens ~pos + ~scope + with + | Some (ExtractedType (Tfunction {returnType}), env) -> + [Completion.create "dummy" ~env ~kind:(Completion.Value returnType)] + | _ -> [])) + +type completionMode = Pattern of Completable.patternMode | Expression + +let rec completeTypedValue ~full ~prefix ~completionContext ~mode + (t : SharedTypes.completionType) = + match t with + | Tbool env -> + [ + Completion.create "true" ~kind:(Label "bool") ~env; + Completion.create "false" ~kind:(Label "bool") ~env; + ] + |> CompletionBackEnd.filterItems ~prefix + | Tvariant {env; constructors; variantDecl; variantName} -> + constructors + |> List.map (fun (constructor : Constructor.t) -> + let numArgs = + match constructor.args with + | InlineRecord _ -> 1 + | Args args -> List.length args + in + Completion.createWithSnippet ?deprecated:constructor.deprecated + ~name: + (constructor.cname.txt + ^ CompletionBackEnd.printConstructorArgs numArgs ~asSnippet:false + ) + ~insertText: + (constructor.cname.txt + ^ CompletionBackEnd.printConstructorArgs numArgs ~asSnippet:true + ) + ~kind: + (Constructor + (constructor, variantDecl |> Shared.declToString variantName)) + ~env ()) + |> CompletionBackEnd.filterItems ~prefix + | Tpolyvariant {env; constructors; typeExpr} -> + constructors + |> List.map (fun (constructor : polyVariantConstructor) -> + Completion.createWithSnippet + ~name: + ("#" ^ constructor.name + ^ CompletionBackEnd.printConstructorArgs + (List.length constructor.args) + ~asSnippet:false) + ~insertText: + ((if Utils.startsWith prefix "#" then "" else "#") + ^ constructor.name + ^ CompletionBackEnd.printConstructorArgs + (List.length constructor.args) + ~asSnippet:true) + ~kind: + (PolyvariantConstructor + (constructor, typeExpr |> Shared.typeToString)) + ~env ()) + |> CompletionBackEnd.filterItems ~prefix + | Toption (env, t) -> + let innerType = + match t with + | ExtractedType t -> Some t + | TypeExpr t -> t |> TypeUtils.extractType ~env ~package:full.package + in + let expandedCompletions = + match innerType with + | None -> [] + | Some innerType -> + innerType + |> completeTypedValue ~full ~prefix ~completionContext ~mode + |> List.map (fun (c : Completion.t) -> + { + c with + name = "Some(" ^ c.name ^ ")"; + sortText = None; + insertText = + (match c.insertText with + | None -> None + | Some insertText -> Some ("Some(" ^ insertText ^ ")")); + }) + in + let noneCase = Completion.create "None" ~kind:(kindFromInnerType t) ~env in + let someAnyCase = + Completion.createWithSnippet ~name:"Some(_)" ~kind:(kindFromInnerType t) + ~env ~insertText:"Some(${1:_})" () + in + let completions = + match completionContext with + | Some (Completable.CameFromRecordField fieldName) -> + [ + Completion.createWithSnippet + ~name:("Some(" ^ fieldName ^ ")") + ~kind:(kindFromInnerType t) ~env + ~insertText:("Some(${1:" ^ fieldName ^ "})") + (); + someAnyCase; + noneCase; + ] + | _ -> [noneCase; someAnyCase] + in + completions @ expandedCompletions |> CompletionBackEnd.filterItems ~prefix + | Tuple (env, exprs, typ) -> + let numExprs = List.length exprs in + [ + Completion.createWithSnippet + ~name:(CompletionBackEnd.printConstructorArgs numExprs ~asSnippet:false) + ~insertText: + (CompletionBackEnd.printConstructorArgs numExprs ~asSnippet:true) + ~kind:(Value typ) ~env (); + ] + | Trecord {env; fields} as extractedType -> ( + (* As we're completing for a record, we'll need a hint (completionContext) + here to figure out whether we should complete for a record field, or + the record body itself. *) + match completionContext with + | Some (Completable.RecordField {seenFields}) -> + fields + |> List.filter (fun (field : field) -> + List.mem field.fname.txt seenFields = false) + |> List.map (fun (field : field) -> + match (field.optional, mode) with + | true, Pattern Destructuring -> + Completion.create ("?" ^ field.fname.txt) + ?deprecated:field.deprecated + ~docstring: + [ + field.fname.txt + ^ " is an optional field, and needs to be destructured \ + using '?'."; + ] + ~kind: + (Field (field, TypeUtils.extractedTypeToString extractedType)) + ~env + | _ -> + Completion.create field.fname.txt ?deprecated:field.deprecated + ~kind: + (Field (field, TypeUtils.extractedTypeToString extractedType)) + ~env) + |> CompletionBackEnd.filterItems ~prefix + | _ -> + if prefix = "" then + [ + Completion.createWithSnippet ~name:"{}" + ~insertText:(if !Cfg.supportsSnippets then "{$0}" else "{}") + ~sortText:"A" + ~kind: + (ExtractedType + ( extractedType, + match mode with + | Pattern _ -> `Type + | Expression -> `Value )) + ~env (); + ] + else []) + | TinlineRecord {env; fields} -> ( + match completionContext with + | Some (Completable.RecordField {seenFields}) -> + fields + |> List.filter (fun (field : field) -> + List.mem field.fname.txt seenFields = false) + |> List.map (fun (field : field) -> + Completion.create field.fname.txt ~kind:(Label "Inline record") + ?deprecated:field.deprecated ~env) + |> CompletionBackEnd.filterItems ~prefix + | _ -> + if prefix = "" then + [ + Completion.createWithSnippet ~name:"{}" + ~insertText:(if !Cfg.supportsSnippets then "{$0}" else "{}") + ~sortText:"A" ~kind:(Label "Inline record") ~env (); + ] + else []) + | Tarray (env, typ) -> + if prefix = "" then + [ + Completion.createWithSnippet ~name:"[]" + ~insertText:(if !Cfg.supportsSnippets then "[$0]" else "[]") + ~sortText:"A" + ~kind: + (match typ with + | ExtractedType typ -> + ExtractedType + ( typ, + match mode with + | Pattern _ -> `Type + | Expression -> `Value ) + | TypeExpr typ -> Value typ) + ~env (); + ] + else [] + | Tstring env -> + if prefix = "" then + [ + Completion.createWithSnippet ~name:"\"\"" + ~insertText:(if !Cfg.supportsSnippets then "\"$0\"" else "\"\"") + ~sortText:"A" + ~kind: + (Value (Ctype.newconstr (Path.Pident (Ident.create "string")) [])) + ~env (); + ] + else [] + | Tfunction {env; typ; args; uncurried} when prefix = "" && mode = Expression + -> + let shouldPrintAsUncurried = uncurried && !Config.uncurried <> Uncurried in + let mkFnArgs ~asSnippet = + match args with + | [(Nolabel, argTyp)] when TypeUtils.typeIsUnit argTyp -> + if shouldPrintAsUncurried then "(. )" else "()" + | [(Nolabel, argTyp)] -> + let varName = + CompletionExpressions.prettyPrintFnTemplateArgName ~env ~full argTyp + in + let argsText = if asSnippet then "${1:" ^ varName ^ "}" else varName in + if shouldPrintAsUncurried then "(. " ^ argsText ^ ")" else argsText + | _ -> + let currentUnlabelledIndex = ref 0 in + let argsText = + args + |> List.map (fun ((label, typ) : typedFnArg) -> + match label with + | Optional name -> "~" ^ name ^ "=?" + | Labelled name -> "~" ^ name + | Nolabel -> + if TypeUtils.typeIsUnit typ then "()" + else ( + currentUnlabelledIndex := !currentUnlabelledIndex + 1; + let num = !currentUnlabelledIndex in + let varName = + CompletionExpressions.prettyPrintFnTemplateArgName + ~currentIndex:num ~env ~full typ + in + if asSnippet then + "${" ^ string_of_int num ^ ":" ^ varName ^ "}" + else varName)) + |> String.concat ", " + in + "(" ^ if shouldPrintAsUncurried then ". " else "" ^ argsText ^ ")" + in + [ + Completion.createWithSnippet + ~name:(mkFnArgs ~asSnippet:false ^ " => {}") + ~insertText: + (mkFnArgs ~asSnippet:!Cfg.supportsSnippets + ^ " => " + ^ if !Cfg.supportsSnippets then "{$0}" else "{}") + ~sortText:"A" ~kind:(Value typ) ~env (); + ] + | Tfunction _ -> [] + | Texn env -> + [ + Completion.create + (full.package.builtInCompletionModules.exnModulePath @ ["Error(error)"] + |> ident) + ~kind:(Label "Catches errors from JavaScript errors.") + ~docstring: + [ + "Matches on a JavaScript error. Read more in the [documentation on \ + catching JS \ + exceptions](https://rescript-lang.org/docs/manual/latest/exception#catching-js-exceptions)."; + ] + ~env; + ] + | Tpromise _ -> [] + +let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable = + if debug then + Printf.printf "Completable: %s\n" + (CompletionInstruction.toString completable); + let package = full.package in + let rawOpens = Scope.getRawOpens scope in + let opens = getOpens ~debug ~rawOpens ~package ~env in + let allFiles = allFilesInPackage package in + let findTypeOfValue path = + path + |> getCompletionsForPath ~debug ~completionContext:Value ~exact:true + ~package ~opens ~full ~pos ~env ~scope + |> completionsGetTypeEnv ~debug ~full ~opens ~rawOpens ~pos ~scope + in + match completable with + | Cnone -> [] + | CtxPath contextPath -> + contextPath + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:forHover ~scope + | Cjsx {pathToComponent = [id]; prefix; seenProps = identsSeen} + when String.uncapitalize_ascii id = id -> + (* Lowercase JSX tag means builtin *) + let mkLabel (name, typString) = + Completion.create name ~kind:(Label typString) ~env + in + let keyLabels = + if Utils.startsWith "key" prefix then [mkLabel ("key", "string")] else [] + in + (CompletionJsx.domLabels + |> List.filter (fun (name, _t) -> + Utils.startsWith name prefix + && (forHover || not (List.mem name identsSeen))) + |> List.map mkLabel) + @ keyLabels + | Cjsx {pathToComponent = componentPath; prefix; seenProps = identsSeen} -> + let labels = + CompletionJsx.getJsxLabels ~componentPath ~findTypeOfValue ~package + in + let mkLabel_ name typString = + Completion.create name ~kind:(Label typString) ~env + in + let mkLabel (name, typ, _env) = + mkLabel_ name (typ |> Shared.typeToString) + in + let keyLabels = + if Utils.startsWith "key" prefix then [mkLabel_ "key" "string"] else [] + in + if labels = [] then [] + else + (labels + |> List.filter (fun (name, _t, _env) -> + Utils.startsWith name prefix + && name <> "key" + && (forHover || not (List.mem name identsSeen))) + |> List.map mkLabel) + @ keyLabels + (* | Cdecorator prefix -> + let mkDecorator (name, docstring) = + {(Completion.create name ~kind:(Label "") ~env) 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, 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)) + |> List.map mkDecorator*) + | CnamedArg {ctxPath; prefix; seenLabels} -> + let labels = + match + ctxPath + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + |> completionsGetTypeEnv ~debug ~full ~opens ~rawOpens ~pos ~scope + with + | Some (typ, _env) -> + if debug then + Printf.printf "Found type for function %s\n" + (typ |> Shared.typeToString); + + typ + |> TypeUtils.getArgs ~full ~env + |> List.filter_map (fun arg -> + match arg with + | SharedTypes.Completable.Labelled name, a -> Some (name, a) + | Optional name, a -> Some (name, a) + | _ -> None) + | None -> [] + in + let mkLabel (name, typ) = + Completion.create name ~kind:(Label (typ |> Shared.typeToString)) ~env + in + labels + |> List.filter (fun (name, _t) -> + Utils.startsWith name prefix + && (forHover || not (List.mem name seenLabels))) + |> List.map mkLabel + | Cpattern {ctxPath; prefix} -> ( + match + ctxPath + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + |> completionsGetCompletionType2 ~debug ~full ~opens ~rawOpens ~pos ~scope + with + | Some (typ, env) -> ( + let typ = + match typ with + | ExtractedType inner -> Some inner + | TypeExpr t -> t |> TypeUtils.extractType ~env ~package:full.package + in + match typ with + | None -> [] + | Some typ -> + let items = + typ + |> completeTypedValue ~mode:(Pattern Default) ~full ~prefix + ~completionContext:None + in + items) + | None -> []) + | Cexpression {ctxPath; prefix} -> ( + (* Completions for local things like variables in scope, modules in the + project, etc. We only add completions when there's a prefix of some sort + we can filter on, since we know we're in some sort of context, and + therefore don't want to overwhelm the user with completion items. *) + let regularCompletions = + if prefix = "" then [] + else + prefix + |> getComplementaryCompletionsForTypedValue ~opens ~allFiles ~env ~scope + in + + match + ctxPath + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:true ~scope + |> completionsGetCompletionType ~full + with + | None -> regularCompletions + | Some (typ, _env) -> ( + (* TODO: We can get rid of the completion context and only use the ctx path *) + let completionContext = + match ctxPath with + | CRecordBody {seenFields} | CRecordField {seenFields} -> + Some (Completable.RecordField {seenFields}) + | CRecordFieldFollow {fieldName} -> Some (CameFromRecordField fieldName) + | _ -> None + in + let wrapInsertTextInBraces = + if List.length [] > 0 then false + else + match ctxPath with + | CJsxPropValue _ -> true + | _ -> false + in + let items = + typ + |> completeTypedValue ~mode:Expression ~full ~prefix ~completionContext + |> List.map (fun (c : Completion.t) -> + if wrapInsertTextInBraces then + { + c with + insertText = + (match c.insertText with + | None -> None + | Some text -> Some ("{" ^ text ^ "}")); + } + else c) + in + match (prefix, completionContext) with + | "", _ -> items + | _, None -> + let items = + if List.length regularCompletions > 0 then + (* The client will occasionally sort the list of completions alphabetically, disregarding the order + in which we send it. This fixes that by providing a sort text making the typed completions + guaranteed to end up on top. *) + items + |> List.map (fun (c : Completion.t) -> + {c with sortText = Some ("A" ^ " " ^ c.name)}) + else items + in + items @ regularCompletions + | _ -> items)) + (*| CexhaustiveSwitch {contextPath; exprLoc} -> + let range = Utils.rangeOfLoc exprLoc in + let printFailwithStr num = + "${" ^ string_of_int num ^ ":failwith(\"todo\")}" + in + let withExhaustiveItem ~cases ?(startIndex = 0) (c : Completion.t) = + (* We don't need to write out `switch` here since we know that's what the + user has already written. Just complete for the rest. *) + let newText = + c.name ^ " {\n" + ^ (cases + |> List.mapi (fun index caseText -> + "| " ^ caseText ^ " => " + ^ printFailwithStr (startIndex + index + 1)) + |> String.concat "\n") + ^ "\n}" + |> Utils.indent range.start.character + in + [ + c; + { + c with + name = c.name ^ " (exhaustive switch)"; + filterText = Some c.name; + insertTextFormat = Some Snippet; + insertText = Some newText; + kind = Snippet "insert exhaustive switch for value"; + }; + ] + in + let completionsForContextPath = + contextPath + |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env + ~exact:forHover ~scope + in + completionsForContextPath + |> List.map (fun (c : Completion.t) -> + match c.kind with + | Value typExpr -> ( + match typExpr |> TypeUtils.extractType ~env:c.env ~package with + | Some (Tvariant v) -> + withExhaustiveItem c + ~cases: + (v.constructors + |> List.map (fun (constructor : Constructor.t) -> + constructor.cname.txt + ^ + match constructor.args with + | Args [] -> "" + | _ -> "(_)")) + | Some (Tpolyvariant v) -> + withExhaustiveItem c + ~cases: + (v.constructors + |> List.map (fun (constructor : polyVariantConstructor) -> + "#" ^ constructor.name + ^ + match constructor.args with + | [] -> "" + | _ -> "(_)")) + | Some (Toption (_env, _typ)) -> + withExhaustiveItem c ~cases:["Some($1)"; "None"] ~startIndex:1 + | Some (Tbool _) -> withExhaustiveItem c ~cases:["true"; "false"] + | _ -> [c]) + | _ -> [c]) + |> List.flatten*) + | ChtmlElement {prefix} -> + CompletionJsx.htmlElements + |> List.filter_map (fun (elementName, description, deprecated) -> + if Utils.startsWith elementName prefix then + let name = "<" ^ elementName ^ ">" in + Some + (Completion.create name ~kind:(Label name) ~detail:description + ~env ~docstring:[description] ~insertText:elementName + ?deprecated: + (match deprecated with + | true -> Some "true" + | false -> None)) + else None) diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index 3c0cd091e..39103fe11 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -316,11 +316,13 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor (pat : Parsetree.pattern) = let contextPathToSave = match (contextPath, patternPath) with - | maybeContextPath, [] -> maybeContextPath + | Some ctxPath, [] -> Some (Scope.Completable ctxPath) + | None, [] -> None | Some contextPath, patternPath -> Some - (Completable.CPatternPath - {rootCtxPath = contextPath; nested = List.rev patternPath}) + (Completable + (Completable.CPatternPath + {rootCtxPath = contextPath; nested = List.rev patternPath})) | _ -> None in match pat.ppat_desc with @@ -334,7 +336,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor if contextPathToSave = None then match p with | {ppat_desc = Ppat_var {txt}} -> - Some (Completable.CPId ([txt], Value)) + Some (Scope.Completable (Completable.CPId ([txt], Value))) | _ -> None else None in diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml index 656d8cd97..a340ed159 100644 --- a/analysis/src/CompletionFrontEndNew.ml +++ b/analysis/src/CompletionFrontEndNew.ml @@ -1,5 +1,6 @@ open SharedTypes open CompletionNewTypes +open CompletionsNewTypesCtxPath let flattenLidCheckDot ?(jsx = true) ~(completionContext : CompletionContext.t) (lid : Longident.t Location.loc) = @@ -262,12 +263,32 @@ let scopeTypeDeclaration ~scope (td : Parsetree.type_declaration) = in scopeTypeKind ~scope td.ptype_kind +let scopeTypeDeclarations ~scope + (typeDeclarations : Parsetree.type_declaration list) = + let newScope = ref scope in + typeDeclarations + |> List.iter (fun (td : Parsetree.type_declaration) -> + newScope := scopeTypeDeclaration td ~scope:!newScope); + !newScope + let scopeModuleBinding ~scope (mb : Parsetree.module_binding) = scope |> Scope.addModule ~name:mb.pmb_name.txt ~loc:mb.pmb_name.loc let scopeModuleDeclaration ~scope (md : Parsetree.module_declaration) = scope |> Scope.addModule ~name:md.pmd_name.txt ~loc:md.pmd_name.loc +let scopeValueDescription ~scope (vd : Parsetree.value_description) = + scope |> Scope.addValue ~name:vd.pval_name.txt ~loc:vd.pval_name.loc + +let scopeStructureItem ~scope (item : Parsetree.structure_item) = + match item.pstr_desc with + | Pstr_value (_, valueBindings) -> scopeValueBindings ~scope valueBindings + | Pstr_type (_, typeDeclarations) -> + scopeTypeDeclarations ~scope typeDeclarations + | Pstr_open {popen_lid} -> scope |> Scope.addOpen ~lid:popen_lid.txt + | Pstr_primitive vd -> scopeValueDescription ~scope vd + | _ -> scope + let rec completeFromStructure ~(completionContext : CompletionContext.t) (structure : Parsetree.structure) : CompletionResult.t = let scope = ref completionContext.scope in @@ -279,10 +300,7 @@ let rec completeFromStructure ~(completionContext : CompletionContext.t) (CompletionContext.withScope !scope completionContext) item in - (match item.pstr_desc with - | Pstr_value (_, valueBindings) -> - scope := scopeValueBindings ~scope:!scope valueBindings - | _ -> ()); + scope := scopeStructureItem ~scope:!scope item; res) and completeStructureItem ~(completionContext : CompletionContext.t) @@ -324,7 +342,7 @@ and completeValueBinding ~(completionContext : CompletionContext.t) or an inferred constraint (if it has been compiled), or no constraint. *) let completionContextForExprCompletion = completionContext - |> CompletionContext.currentlyExpectingOrTypeAtLoc + |> CompletionContext.currentlyExpectingOrTypeAtLoc2 ~loc:vb.pvb_pat.ppat_loc bindingConstraint in let completedExpression = @@ -421,10 +439,6 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : payloadExpr | Pexp_construct ({txt = Lident txt; loc}, _) when loc |> locHasPos -> (* A constructor, like: `Co` *) - let completionContext = - completionContext - |> CompletionContext.addCtxPathItem (CId ([txt], Module)) - in CompletionResult.expression ~completionContext ~prefix:txt | Pexp_construct (id, _) when id.loc |> locHasPos -> (* A path, like: `Something.Co` *) @@ -495,10 +509,9 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : completeExpr ~completionContext: (CompletionContext.addCtxPathItem - (CRecordField + (CRecordFieldFollow { - prefix = fieldName.txt |> Longident.last; - seenFields; + fieldName = fieldName.txt |> Longident.last; recordCtxPath = ctxPathFromCompletionContext completionContext; }) @@ -526,10 +539,9 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : let completionContext = completionContext |> CompletionContext.addCtxPathItem - (CRecordField + (CRecordFieldFollow { - prefix = fieldName; - seenFields; + fieldName; recordCtxPath = ctxPathFromCompletionContext completionContext; }) @@ -553,13 +565,15 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : (* == IDENTS == *) | Pexp_ident lid -> (* An identifier, like `aaa` *) + (* TODO(1) idents vs modules, etc *) let lidPath = flattenLidCheckDot lid ~completionContext in + let last = Longident.last lid.txt in if lid.loc |> locHasPos then - let completionContext = - completionContext - |> CompletionContext.addCtxPathItem (CId (lidPath, Value)) - in - CompletionResult.expression ~completionContext ~prefix:"" + (*let completionContext = + completionContext + |> CompletionContext.addCtxPathItem (CId (lidPath, Value)) + in*) + CompletionResult.expression ~completionContext ~prefix:last else None | Pexp_let (recFlag, valueBindings, nextExpr) -> (* A let binding. `let a = b` *) diff --git a/analysis/src/CompletionNewTypes.ml b/analysis/src/CompletionNewTypes.ml index a26675800..47864be86 100644 --- a/analysis/src/CompletionNewTypes.ml +++ b/analysis/src/CompletionNewTypes.ml @@ -1,4 +1,5 @@ open SharedTypes +open CompletionsNewTypesCtxPath module PositionContext = struct type t = { @@ -58,140 +59,6 @@ module PositionContext = struct } end -type completionCategory = Type | Value | Module | Field - -type argumentLabel = - | Unlabelled of {argumentPosition: int} - | Labelled of string - | Optional of string - -type ctxPath = - | CNone (** Nothing. *) - | CUnknown (** Something that cannot be resolved right now *) - | CId of string list * completionCategory - (** A regular id of an expected category. `let fff = thisIsAnId` and `let fff = SomePath.alsoAnId` *) - | CVariantPayload of { - variantCtxPath: ctxPath; - itemNum: int; - constructorName: string; - } - (** A variant payload. `Some()` = itemNum 0, `Whatever(true, f)` = itemNum 1 *) - | CTupleItem of {tupleCtxPath: ctxPath; itemNum: int} - (** A tuple item. `(true, false, )` = itemNum 2 *) - | CRecordField of { - recordCtxPath: ctxPath; - seenFields: string list; - prefix: string; - } - (** A record field. `let f = {on: true, s}` seenFields = [on], prefix = "s",*) - (* TODO: Can we merge with CRecordFieldAccess?*) - | CRecordFieldFollow of {recordCtxPath: ctxPath; fieldName: string} - (** Follow this record field. {}*) - | COption of ctxPath (** An option with an inner type. *) - | CArray of ctxPath option (** An array with an inner type. *) - | CTuple of ctxPath list (** A tuple. *) - | CBool - | CString - | CInt - | CFloat - | CAwait of ctxPath (** Awaiting a function call. *) - | CFunction of {returnType: ctxPath} (** A function *) - | CRecordFieldAccess of {recordCtxPath: ctxPath; fieldName: string} - (** Field access. `whateverVariable.fieldName`. The ctxPath points to the value of `whateverVariable`, - and the string is the name of the field we're accessing. *) - | CObj of {objectCtxPath: ctxPath; propertyName: string} - (** Object property access. `whateverVariable["fieldName"]`. The ctxPath points to the value of `whateverVariable`, - and the string is the name of the property we're accessing. *) - | CApply of {functionCtxPath: ctxPath; args: Asttypes.arg_label list} - (** Function application. `someFunction(someVar, ~otherLabel="hello")`. The ctxPath points to the function. *) - | CFunctionArgument of { - functionContextPath: ctxPath; - argumentLabel: argumentLabel; - } (** A function argument, either labelled or unlabelled.*) - | CPipe of { - functionCtxPath: ctxPath; - (** Context path to the function being called. *) - id: string; - lhsLoc: Location.t; (** Location of the left hand side. *) - } (** Piped call. `foo->someFn`. *) - | CJsxPropValue of { - pathToComponent: string list; - (** The path to the component this property is from. *) - propName: string; (** The prop name we're going through. *) - } (** A JSX property. *) - | CTypeAtLoc of Location.t (** A type at a location. *) - | CFunctionReturnType of {functionCtxPath: ctxPath} - (** An instruction to resolve the return type of the type at the - provided context path, if it's a function (it should always be, - but you know...) *) - -let rec ctxPathToString (ctxPath : ctxPath) = - match ctxPath with - | CUnknown -> "CUnknown" - | CNone -> "CUnknown" - | CBool -> "bool" - | CFloat -> "float" - | CInt -> "int" - | CString -> "string" - | CJsxPropValue {pathToComponent; propName} -> - "CJsxPropValue " ^ (pathToComponent |> list) ^ " " ^ propName - | CAwait ctxPath -> Printf.sprintf "await %s" (ctxPathToString ctxPath) - | CApply {functionCtxPath; args} -> - Printf.sprintf "%s(%s)" - (ctxPathToString functionCtxPath) - (args - |> List.map (function - | Asttypes.Nolabel -> "Nolabel" - | Labelled s -> "~" ^ s - | Optional s -> "?" ^ s) - |> String.concat ", ") - | CRecordFieldAccess {recordCtxPath; fieldName} -> - Printf.sprintf "(%s).%s" (ctxPathToString recordCtxPath) fieldName - | CObj {objectCtxPath; propertyName} -> - Printf.sprintf "(%s)[\"%s\"]" (ctxPathToString objectCtxPath) propertyName - | CFunction {returnType} -> - Printf.sprintf "CFunction () -> %s" (ctxPathToString returnType) - | CTuple ctxPaths -> - Printf.sprintf "CTuple(%s)" - (ctxPaths |> List.map ctxPathToString |> String.concat ", ") - | CId (prefix, typ) -> - Printf.sprintf "CId(%s)=%s" - (match typ with - | Value -> "Value" - | Type -> "Type" - | Module -> "Module" - | Field -> "Field") - (ident prefix) - | CVariantPayload {variantCtxPath; itemNum; constructorName} -> - Printf.sprintf "CVariantPayload %s => %s($%i)" - (ctxPathToString variantCtxPath) - constructorName itemNum - | CTupleItem {tupleCtxPath; itemNum} -> - Printf.sprintf "CTupleItem %s ($%i)" (ctxPathToString tupleCtxPath) itemNum - | CRecordField {recordCtxPath; prefix} -> - Printf.sprintf "CRecordField (%s)=%s" (ctxPathToString recordCtxPath) prefix - | COption ctxPath -> Printf.sprintf "COption<%s>" (ctxPathToString ctxPath) - | CArray ctxPath -> - Printf.sprintf "array%s" - (match ctxPath with - | None -> "" - | Some ctxPath -> "<" ^ ctxPathToString ctxPath ^ ">") - | CFunctionArgument {functionContextPath; argumentLabel} -> - "CFunctionArgument " - ^ (functionContextPath |> ctxPathToString) - ^ "(" - ^ (match argumentLabel with - | Unlabelled {argumentPosition} -> "$" ^ string_of_int argumentPosition - | Labelled name -> "~" ^ name - | Optional name -> "~" ^ name ^ "=?") - ^ ")" - | CPipe {functionCtxPath; id} -> - "(" ^ ctxPathToString functionCtxPath ^ ")->" ^ id - | CRecordFieldFollow {fieldName} -> "CRecordFieldFollow {" ^ fieldName ^ "}" - | CTypeAtLoc loc -> Printf.sprintf "CTypeAtLoc: %s" (Loc.toString loc) - | CFunctionReturnType {functionCtxPath} -> - Printf.sprintf "CFunctionReturnType %s" (ctxPathToString functionCtxPath) - module CompletionContext = struct type t = { positionContext: PositionContext.t; @@ -226,6 +93,14 @@ module CompletionContext = struct | None -> {completionContext with currentlyExpecting = CTypeAtLoc loc} | Some currentlyExpecting -> {completionContext with currentlyExpecting} + let currentlyExpectingOrTypeAtLoc2 ~loc currentlyExpecting completionContext = + let currentlyExpecting = + match currentlyExpecting with + | None -> CTypeAtLoc loc + | Some currentlyExpecting -> currentlyExpecting + in + {completionContext with currentlyExpecting; ctxPath = currentlyExpecting} + let withResetCurrentlyExpecting completionContext = {completionContext with currentlyExpecting = CNone} @@ -237,6 +112,7 @@ module CompletionInstruction = struct (** This is the completion instruction, that's responsible for resolving something at context path X *) type t = + | Cnone | CtxPath of ctxPath | Cpattern of { ctxPath: ctxPath; @@ -303,16 +179,15 @@ module CompletionInstruction = struct let toString (c : t) = match c with + | Cnone -> "Cnone" | CtxPath ctxPath -> Printf.sprintf "CtxPath: %s" (ctxPathToString ctxPath) - | Cpattern {ctxPath; prefix; rootType} -> - Printf.sprintf "Cpattern: ctxPath: %s, rootType: %s%s" - (ctxPathToString ctxPath) (ctxPathToString rootType) + | Cpattern {ctxPath; prefix} -> + Printf.sprintf "Cpattern: ctxPath: %s, %s" (ctxPathToString ctxPath) (match prefix with | "" -> "" | prefix -> Printf.sprintf ", prefix: \"%s\"" prefix) - | Cexpression {ctxPath; prefix; rootType} -> - Printf.sprintf "Cexpression: ctxPath: %s, rootType: %s%s" - (ctxPathToString ctxPath) (ctxPathToString rootType) + | Cexpression {ctxPath; prefix} -> + Printf.sprintf "Cexpression: ctxPath: %s %s" (ctxPathToString ctxPath) (match prefix with | "" -> "" | prefix -> Printf.sprintf ", prefix: \"%s\"" prefix) diff --git a/analysis/src/Completions.ml b/analysis/src/Completions.ml index 7b0154824..a419f4507 100644 --- a/analysis/src/Completions.ml +++ b/analysis/src/Completions.ml @@ -24,19 +24,27 @@ let getCompletions ~debug ~path ~pos ~currentFile ~forHover = let getCompletions2 ~debug ~path ~pos ~currentFile ~forHover = let textOpt = Files.readFile currentFile in match textOpt with - | None | Some "" -> () + | None | Some "" -> None | Some text -> ( match Pos.positionToOffset text pos with - | None -> () + | None -> None | Some offset -> ( match CompletionFrontEndNew.completion ~offset ~debug ~path ~posCursor:pos ~currentFile text with - | None -> print_endline "No completions" - | Some (res, ctx) -> - Printf.printf "Result: %s\n" - (CompletionNewTypes.CompletionInstruction.toString res); + | None -> + print_endline "No completions"; + None + | Some (res, ctx) -> ( Printf.printf "Scope: %i items\n" (List.length ctx.scope); - Printf.printf "Looking for type: %s\n" - (ctx.currentlyExpecting |> CompletionNewTypes.ctxPathToString))) + match Cmt.loadFullCmtFromPath ~path with + | None -> None + | Some full -> + let env = SharedTypes.QueryEnv.fromFile full.file in + let completables = + res + |> CompletionBackendNew.processCompletable ~debug ~full ~pos + ~scope:ctx.scope ~env ~forHover + in + Some (completables, full, ctx.scope)))) diff --git a/analysis/src/CompletionsNewTypesCtxPath.ml b/analysis/src/CompletionsNewTypesCtxPath.ml new file mode 100644 index 000000000..a4f514db9 --- /dev/null +++ b/analysis/src/CompletionsNewTypesCtxPath.ml @@ -0,0 +1,147 @@ +type completionCategory = Type | Value | Module | Field + +type argumentLabel = + | Unlabelled of {argumentPosition: int} + | Labelled of string + | Optional of string + +type ctxPath = + | CNone (** Nothing. *) + | CUnknown (** Something that cannot be resolved right now *) + | CId of string list * completionCategory + (** A regular id of an expected category. `let fff = thisIsAnId` and `let fff = SomePath.alsoAnId` *) + | CVariantPayload of { + variantCtxPath: ctxPath; + itemNum: int; + constructorName: string; + } + (** A variant payload. `Some()` = itemNum 0, `Whatever(true, f)` = itemNum 1 *) + | CTupleItem of {tupleCtxPath: ctxPath; itemNum: int} + (** A tuple item. `(true, false, )` = itemNum 2 *) + | CRecordField of { + recordCtxPath: ctxPath; + seenFields: string list; + prefix: string; + } + (** A record field. `let f = {on: true, s}` seenFields = [on], prefix = "s",*) + (* TODO: Can we merge with CRecordFieldAccess?*) + | CRecordFieldFollow of {recordCtxPath: ctxPath; fieldName: string} + (** Follow this record field. {}*) + | COption of ctxPath (** An option with an inner type. *) + | CArray of ctxPath option (** An array with an inner type. *) + | CTuple of ctxPath list (** A tuple. *) + | CBool + | CString + | CInt + | CFloat + | CRecordBody of {recordCtxPath: ctxPath; seenFields: string list} + | CAwait of ctxPath (** Awaiting a function call. *) + | CFunction of {returnType: ctxPath} (** A function *) + | CRecordFieldAccess of {recordCtxPath: ctxPath; fieldName: string} + (** Field access. `whateverVariable.fieldName`. The ctxPath points to the value of `whateverVariable`, + and the string is the name of the field we're accessing. *) + | CObj of {objectCtxPath: ctxPath; propertyName: string} + (** Object property access. `whateverVariable["fieldName"]`. The ctxPath points to the value of `whateverVariable`, + and the string is the name of the property we're accessing. *) + | CApply of {functionCtxPath: ctxPath; args: Asttypes.arg_label list} + (** Function application. `someFunction(someVar, ~otherLabel="hello")`. The ctxPath points to the function. *) + | CFunctionArgument of { + functionContextPath: ctxPath; + argumentLabel: argumentLabel; + } (** A function argument, either labelled or unlabelled.*) + | CPipe of { + functionCtxPath: ctxPath; + (** Context path to the function being called. *) + id: string; + lhsLoc: Location.t; (** Location of the left hand side. *) + } (** Piped call. `foo->someFn`. *) + | CJsxPropValue of { + pathToComponent: string list; + (** The path to the component this property is from. *) + propName: string; (** The prop name we're going through. *) + } (** A JSX property. *) + | CTypeAtLoc of Location.t (** A type at a location. *) + | CFunctionReturnType of {functionCtxPath: ctxPath} + (** An instruction to resolve the return type of the type at the + provided context path, if it's a function (it should always be, + but you know...) *) + +let str s = if s = "" then "\"\"" else s +let list l = "[" ^ (l |> List.map str |> String.concat ", ") ^ "]" +let ident l = l |> List.map str |> String.concat "." + +let rec ctxPathToString (ctxPath : ctxPath) = + match ctxPath with + | CUnknown -> "CUnknown" + | CNone -> "CUnknown" + | CBool -> "bool" + | CFloat -> "float" + | CInt -> "int" + | CString -> "string" + | CJsxPropValue {pathToComponent; propName} -> + "<" ^ (pathToComponent |> list) ^ " =" ^ propName ^ "/>" + | CAwait ctxPath -> Printf.sprintf "await (%s)" (ctxPathToString ctxPath) + | CApply {functionCtxPath; args} -> + Printf.sprintf "%s(%s)" + (ctxPathToString functionCtxPath) + (args + |> List.map (function + | Asttypes.Nolabel -> "Nolabel" + | Labelled s -> "~" ^ s + | Optional s -> "?" ^ s) + |> String.concat ", ") + | CRecordFieldAccess {recordCtxPath; fieldName} -> + Printf.sprintf "(%s).%s" (ctxPathToString recordCtxPath) fieldName + | CObj {objectCtxPath; propertyName} -> + Printf.sprintf "(%s)[\"%s\"]" (ctxPathToString objectCtxPath) propertyName + | CFunction {returnType} -> + Printf.sprintf "() => %s" (ctxPathToString returnType) + | CTuple ctxPaths -> + Printf.sprintf "tuple(%s)" + (ctxPaths |> List.map ctxPathToString |> String.concat ", ") + | CId (prefix, typ) -> + Printf.sprintf "%s(prefix=%s)" + (match typ with + | Value -> "Value" + | Type -> "Type" + | Module -> "Module" + | Field -> "Field") + (ident prefix) + | CVariantPayload {variantCtxPath; itemNum; constructorName} -> + Printf.sprintf "(%s)->variantPayload(%s<$%i>)" + (ctxPathToString variantCtxPath) + constructorName itemNum + | CTupleItem {tupleCtxPath; itemNum} -> + Printf.sprintf "%s->tupleItem($%i)" (ctxPathToString tupleCtxPath) itemNum + | CRecordField {recordCtxPath; prefix; seenFields} -> + Printf.sprintf "%s->recordField(\"%s\", %s)" + (ctxPathToString recordCtxPath) + prefix (seenFields |> list) + | CRecordBody {recordCtxPath; seenFields} -> + Printf.sprintf "%s->recordBody(%s)" + (ctxPathToString recordCtxPath) + (seenFields |> list) + | COption ctxPath -> Printf.sprintf "option<%s>" (ctxPathToString ctxPath) + | CArray ctxPath -> + Printf.sprintf "array%s" + (match ctxPath with + | None -> "" + | Some ctxPath -> "<" ^ ctxPathToString ctxPath ^ ">") + | CFunctionArgument {functionContextPath; argumentLabel} -> + "functionArgument(" + ^ (functionContextPath |> ctxPathToString) + ^ ")(" + ^ (match argumentLabel with + | Unlabelled {argumentPosition} -> "$" ^ string_of_int argumentPosition + | Labelled name -> "~" ^ name + | Optional name -> "~" ^ name ^ "=?") + ^ ")" + | CPipe {functionCtxPath; id} -> + "pipe(" ^ ctxPathToString functionCtxPath ^ ")->" ^ id + | CRecordFieldFollow {fieldName; recordCtxPath} -> + Printf.sprintf "(%s)->followRecordField{%s}" + (ctxPathToString recordCtxPath) + fieldName + | CTypeAtLoc loc -> Printf.sprintf "CTypeAtLoc: %s" (Loc.toString loc) + | CFunctionReturnType {functionCtxPath} -> + Printf.sprintf "returnTypeOf(%s)" (ctxPathToString functionCtxPath) diff --git a/analysis/src/Scope.ml b/analysis/src/Scope.ml index 5251486f8..aa0257f91 100644 --- a/analysis/src/Scope.ml +++ b/analysis/src/Scope.ml @@ -1,10 +1,14 @@ +type ctxPathType = + | Completable of SharedTypes.Completable.contextPath + | New of CompletionsNewTypesCtxPath.ctxPath + type item = | Constructor of string * Location.t | Field of string * Location.t | Module of string * Location.t | Open of string list | Type of string * Location.t - | Value of string * Location.t * SharedTypes.Completable.contextPath option + | Value of string * Location.t * ctxPathType option type t = item list @@ -30,10 +34,14 @@ let addValue ~name ~loc ?contextPath x = (if showDebug then match contextPath with | None -> Printf.printf "adding value '%s', no ctxPath\n" name - | Some contextPath -> + | Some (Completable contextPath) -> + if showDebug then + Printf.printf "adding value '%s' with ctxPath: %s\n" name + (SharedTypes.Completable.contextPathToString contextPath) + | Some (New contextPath) -> if showDebug then Printf.printf "adding value '%s' with ctxPath: %s\n" name - (SharedTypes.Completable.contextPathToString contextPath)); + (CompletionsNewTypesCtxPath.ctxPathToString contextPath)); Value (name, loc, contextPath) :: x let addType ~name ~loc x = Type (name, loc) :: x diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index aee6e046b..bfe9dd913 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -342,6 +342,7 @@ and completionType = env: QueryEnv.t; args: typedFnArg list; typ: Types.type_expr; + returnType: Types.type_expr; uncurried: bool; } @@ -732,7 +733,9 @@ module Completion = struct | FileModule of string | Snippet of string | ExtractedType of completionType * [`Value | `Type] - | FollowContextPath of Completable.contextPath + | FollowContextPath of + [ `Completable of Completable.contextPath + | `New of CompletionsNewTypesCtxPath.ctxPath ] type t = { name: string; diff --git a/analysis/src/TypeUtils.ml b/analysis/src/TypeUtils.ml index d8da5bc8f..34f4c3ce3 100644 --- a/analysis/src/TypeUtils.ml +++ b/analysis/src/TypeUtils.ml @@ -125,8 +125,8 @@ let rec extractType ~env ~package (t : Types.type_expr) = | Tconstr (Pident {name = "function$"}, [t; _], _) -> ( (* Uncurried functions. *) match extractFunctionType t ~env ~package with - | args, _tRet when args <> [] -> - Some (Tfunction {env; args; typ = t; uncurried = true}) + | args, tRet when args <> [] -> + Some (Tfunction {env; args; typ = t; returnType = tRet; uncurried = true}) | _args, _tRet -> None) | Tconstr (path, typeArgs, _) -> ( match References.digConstructor ~env ~package path with @@ -168,8 +168,9 @@ let rec extractType ~env ~package (t : Types.type_expr) = Some (Tpolyvariant {env; constructors; typeExpr = t}) | Tarrow _ -> ( match extractFunctionType t ~env ~package with - | args, _tRet when args <> [] -> - Some (Tfunction {env; args; typ = t; uncurried = false}) + | args, tRet when args <> [] -> + Some + (Tfunction {env; args; typ = t; uncurried = false; returnType = tRet}) | _args, _tRet -> None) | _ -> None diff --git a/analysis/tests/src/CompletionNew.res b/analysis/tests/src/CompletionNew.res index 1bde41446..24f8e980e 100644 --- a/analysis/tests/src/CompletionNew.res +++ b/analysis/tests/src/CompletionNew.res @@ -11,8 +11,8 @@ type rec someVariant = One | Two | Three(bool, option) // let myFunc: someVariant = Three(t) // ^co2 -// let myFunc: someVariant = Three(true, S) -// ^co2 +// let myFunc: someVariant = Three(true, So) +// ^co2 // let myFunc: someVariant = Three(true, Some(O)) // ^co2 @@ -34,7 +34,7 @@ type someRecord = {nested: option, variant: someVariant, someStrin // let myFunc: someRecord = {variant: O} // ^co2 -// let myFunc: someRecord = {nested: {maybeVariant: Three(false, t)}} +// let myFunc: someRecord = {nested: {maybeVariant: Three(false, S)}} // ^co2 // let myFunc: someRecord = {nested: {maybeVariant: One}, variant: } diff --git a/analysis/tests/src/expected/CompletionNew.res.txt b/analysis/tests/src/expected/CompletionNew.res.txt index 1a863fcd3..b539a0cd2 100644 --- a/analysis/tests/src/expected/CompletionNew.res.txt +++ b/analysis/tests/src/expected/CompletionNew.res.txt @@ -1,218 +1,567 @@ Complete2 src/CompletionNew.res 2:17 -Result: Cexpression: ctxPath: CId(Value)=m, rootType: CTypeAtLoc: [2:7->2:13] Scope: 1 items -Looking for type: CTypeAtLoc: [2:7->2:13] +Completable: Cexpression: ctxPath: CTypeAtLoc: [2:7->2:13] , prefix: "m" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[{ + "label": "myVar", + "kind": 12, + "tags": [], + "detail": "bool", + "documentation": null + }] Complete2 src/CompletionNew.res 7:30 -Result: Cexpression: ctxPath: CId(Module)=O, rootType: CId(Type)=someVariant, prefix: "O" -Scope: 1 items -Looking for type: CId(Type)=someVariant +Scope: 9 items +Completable: Cexpression: ctxPath: Type(prefix=someVariant) , prefix: "O" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path someVariant +[{ + "label": "One", + "kind": 4, + "tags": [], + "detail": "One\n\ntype someVariant =\n | One\n | Two\n | Three(bool, option)", + "documentation": null, + "sortText": "A One", + "insertText": "One", + "insertTextFormat": 2 + }, { + "label": "Obj", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }, { + "label": "Objects", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }] Complete2 src/CompletionNew.res 10:36 -Result: Cexpression: ctxPath: CId(Value)=t, rootType: CId(Type)=someVariant -Scope: 1 items -Looking for type: CId(Type)=someVariant - -Complete2 src/CompletionNew.res 13:42 -Result: Cexpression: ctxPath: CId(Module)=S, rootType: CId(Type)=someVariant, prefix: "S" -Scope: 1 items -Looking for type: CId(Type)=someVariant +Scope: 9 items +Completable: Cexpression: ctxPath: (Type(prefix=someVariant))->variantPayload(Three<$0>) , prefix: "t" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path someVariant +[{ + "label": "true", + "kind": 4, + "tags": [], + "detail": "bool", + "documentation": null + }] + +Complete2 src/CompletionNew.res 13:43 +Scope: 9 items +Completable: Cexpression: ctxPath: (Type(prefix=someVariant))->variantPayload(Three<$1>) , prefix: "So" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path someVariant +[{ + "label": "Some(_)", + "kind": 12, + "tags": [], + "detail": "someVariant", + "documentation": null, + "sortText": "A Some(_)", + "insertText": "Some(${1:_})", + "insertTextFormat": 2 + }, { + "label": "Sort", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }] Complete2 src/CompletionNew.res 16:47 -Result: Cexpression: ctxPath: CId(Module)=O, rootType: CId(Type)=someVariant, prefix: "O" -Scope: 1 items -Looking for type: CId(Type)=someVariant +Scope: 9 items +Completable: Cexpression: ctxPath: ((Type(prefix=someVariant))->variantPayload(Three<$1>))->variantPayload(Some<$0>) , prefix: "O" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path someVariant +[{ + "label": "One", + "kind": 4, + "tags": [], + "detail": "One\n\ntype someVariant =\n | One\n | Two\n | Three(bool, option)", + "documentation": null, + "sortText": "A One", + "insertText": "One", + "insertTextFormat": 2 + }, { + "label": "Obj", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }, { + "label": "Objects", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }] Complete2 src/CompletionNew.res 27:29 -Result: Cexpression: ctxPath: CRecordField (CUnknown)=, rootType: CId(Type)=someRecord -Scope: 1 items -Looking for type: CId(Type)=someRecord +Scope: 105 items +Completable: Cexpression: ctxPath: Type(prefix=someRecord)->recordField("", []) +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path someRecord +[{ + "label": "nested", + "kind": 5, + "tags": [], + "detail": "nested: option\n\ntype someRecord = {nested: option, variant: someVariant, someString: string}", + "documentation": null + }, { + "label": "variant", + "kind": 5, + "tags": [], + "detail": "variant: someVariant\n\ntype someRecord = {nested: option, variant: someVariant, someString: string}", + "documentation": null + }, { + "label": "someString", + "kind": 5, + "tags": [], + "detail": "someString: string\n\ntype someRecord = {nested: option, variant: someVariant, someString: string}", + "documentation": null + }] Complete2 src/CompletionNew.res 30:30 -Result: Cexpression: ctxPath: CRecordField (CUnknown)=n, rootType: CId(Type)=someRecord, prefix: "n" -Scope: 1 items -Looking for type: CId(Type)=someRecord +Scope: 105 items +Completable: Cexpression: ctxPath: Type(prefix=someRecord)->recordField("n", []) , prefix: "n" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path someRecord +[{ + "label": "nested", + "kind": 5, + "tags": [], + "detail": "nested: option\n\ntype someRecord = {nested: option, variant: someVariant, someString: string}", + "documentation": null + }] Complete2 src/CompletionNew.res 33:39 -Result: Cexpression: ctxPath: CId(Module)=O, rootType: CId(Type)=someRecord, prefix: "O" -Scope: 1 items -Looking for type: CId(Type)=someRecord +Scope: 105 items +Completable: Cexpression: ctxPath: (Type(prefix=someRecord))->followRecordField{variant} , prefix: "O" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path someRecord +[{ + "label": "One", + "kind": 4, + "tags": [], + "detail": "One\n\ntype someVariant =\n | One\n | Two\n | Three(bool, option)", + "documentation": null, + "insertText": "One", + "insertTextFormat": 2 + }] Complete2 src/CompletionNew.res 36:66 -Result: Cexpression: ctxPath: CId(Value)=t, rootType: CId(Type)=someRecord -Scope: 1 items -Looking for type: CId(Type)=someRecord +Scope: 105 items +Completable: Cexpression: ctxPath: (((Type(prefix=someRecord))->followRecordField{nested})->followRecordField{maybeVariant})->variantPayload(Three<$1>) , prefix: "S" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path someRecord +[{ + "label": "Set", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }, { + "label": "SetLabels", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }, { + "label": "SignatureHelp", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }, { + "label": "Sort", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }, { + "label": "Stack", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }, { + "label": "StdLabels", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }, { + "label": "Stream", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }, { + "label": "String", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }, { + "label": "StringLabels", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }, { + "label": "Sys", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }] Complete2 src/CompletionNew.res 39:66 -Result: Cexpression: ctxPath: CRecordField (CUnknown)=variant, rootType: CId(Type)=someRecord -Scope: 1 items -Looking for type: CId(Type)=someRecord +Scope: 105 items +Completable: Cexpression: ctxPath: (Type(prefix=someRecord))->followRecordField{variant} +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path someRecord +[{ + "label": "One", + "kind": 4, + "tags": [], + "detail": "One\n\ntype someVariant =\n | One\n | Two\n | Three(bool, option)", + "documentation": null, + "insertText": "One", + "insertTextFormat": 2 + }, { + "label": "Two", + "kind": 4, + "tags": [], + "detail": "Two\n\ntype someVariant =\n | One\n | Two\n | Three(bool, option)", + "documentation": null, + "insertText": "Two", + "insertTextFormat": 2 + }, { + "label": "Three(_, _)", + "kind": 4, + "tags": [], + "detail": "Three(bool, option)\n\ntype someVariant =\n | One\n | Two\n | Three(bool, option)", + "documentation": null, + "insertText": "Three(${1:_}, ${2:_})", + "insertTextFormat": 2 + }] Complete2 src/CompletionNew.res 42:56 -Result: Cexpression: ctxPath: CRecordField (CRecordField (CUnknown)=nested)=, rootType: CId(Type)=someRecord -Scope: 1 items -Looking for type: CId(Type)=someRecord +Scope: 105 items +Completable: Cexpression: ctxPath: (Type(prefix=someRecord))->followRecordField{nested}->recordField("", [maybeVariant]) +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path someRecord +[] Complete2 src/CompletionNew.res 45:57 -Result: Cexpression: ctxPath: CRecordField (CUnknown)=, rootType: CId(Type)=someRecord -Scope: 1 items -Looking for type: CId(Type)=someRecord +Scope: 105 items +Completable: Cexpression: ctxPath: Type(prefix=someRecord)->recordField("", [nested]) +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path someRecord +[{ + "label": "variant", + "kind": 5, + "tags": [], + "detail": "variant: someVariant\n\ntype someRecord = {nested: option, variant: someVariant, someString: string}", + "documentation": null + }, { + "label": "someString", + "kind": 5, + "tags": [], + "detail": "someString: string\n\ntype someRecord = {nested: option, variant: someVariant, someString: string}", + "documentation": null + }] Complete2 src/CompletionNew.res 49:71 -Result: Cexpression: ctxPath: CId(Value)=x, rootType: CUnknown -Scope: 2 items -Looking for type: CUnknown +Scope: 106 items +Completable: Cexpression: ctxPath: CUnknown , prefix: "x" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[{ + "label": "x", + "kind": 12, + "tags": [], + "detail": "\\\"Type Not Known\"", + "documentation": null + }] Complete2 src/CompletionNew.res 53:73 -Result: Cexpression: ctxPath: CId(Value)=, rootType: CId(Type)=someRecord -Scope: 2 items -Looking for type: CId(Type)=someRecord +Scope: 106 items +Completable: Cexpression: ctxPath: Value(prefix=) +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path +[] Complete2 src/CompletionNew.res 57:85 -Result: Cexpression: ctxPath: CId(Value)=v, rootType: CId(Type)=someRecord -Scope: 2 items -Looking for type: CId(Type)=someRecord +Scope: 106 items +Completable: Cexpression: ctxPath: ((Type(prefix=someRecord))->followRecordField{nested})->followRecordField{maybeVariant} , prefix: "v" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path someRecord +[] Complete2 src/CompletionNew.res 61:58 -Result: Cexpression: ctxPath: CId(Value)=doStuff, rootType: CUnknown -Scope: 1 items -Looking for type: CUnknown +Scope: 105 items +Completable: Cexpression: ctxPath: CUnknown , prefix: "doStuff" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[] Complete2 src/CompletionNew.res 66:32 -Result: Cexpression: ctxPath: CId(Value)=, rootType: bool -Scope: 2 items -Looking for type: bool +Scope: 107 items +Completable: Cexpression: ctxPath: Value(prefix=) +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path +[] Complete2 src/CompletionNew.res 69:38 -Result: Cexpression: ctxPath: CRecordField (CUnknown)=, rootType: CFunctionReturnType CId(Type)=fn -Scope: 3 items -Looking for type: CFunctionReturnType CId(Type)=fn +Scope: 108 items +Completable: Cexpression: ctxPath: Type(prefix=fn)->recordField("", []) +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path fn +[] Complete2 src/CompletionNew.res 72:72 -Result: Cexpression: ctxPath: CId(Value)=, rootType: CFunctionReturnType CId(Type)=fn -Scope: 4 items -Looking for type: CFunctionReturnType CId(Type)=fn +Scope: 109 items +Completable: Cexpression: ctxPath: Value(prefix=) +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path +[] Complete2 src/CompletionNew.res 76:60 -Result: Cexpression: ctxPath: CId(Value)=t, rootType: bool -Scope: 3 items -Looking for type: bool +Scope: 108 items +Completable: Cexpression: ctxPath: bool , prefix: "t" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[{ + "label": "true", + "kind": 4, + "tags": [], + "detail": "bool", + "documentation": null + }] Complete2 src/CompletionNew.res 80:54 -Result: Cexpression: ctxPath: CId(Value)=t, rootType: CTypeAtLoc: [80:42->80:50] -Scope: 3 items -Looking for type: CTypeAtLoc: [80:42->80:50] +Scope: 108 items +Completable: Cexpression: ctxPath: CTypeAtLoc: [80:42->80:50] , prefix: "t" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[] Complete2 src/CompletionNew.res 84:22 -Result: CtxPath: CId(Value)= -Scope: 1 items -Looking for type: bool +Scope: 106 items +Completable: CtxPath: Value(prefix=) +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path +[] Complete2 src/CompletionNew.res 87:20 -Result: Cpattern: ctxPath: CRecordField (CUnknown)=someField, rootType: CId(Value)=someRecordVar, prefix: "s" -Scope: 1 items -Looking for type: CId(Value)=someRecordVar +Scope: 106 items +Completable: Cpattern: ctxPath: CUnknown->recordField("someField", [someField]), , prefix: "s" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[] Complete2 src/CompletionNew.res 91:13 -Result: Cpattern: ctxPath: CTupleItem CUnknown ($1), rootType: CId(Value)=someRecordVar -Scope: 1 items -Looking for type: CId(Value)=someRecordVar +Scope: 106 items +Completable: Cpattern: ctxPath: CUnknown->tupleItem($1), +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[] Complete2 src/CompletionNew.res 94:20 -Result: Cpattern: ctxPath: CTupleItem CUnknown ($2), rootType: CId(Value)=someRecordVar -Scope: 1 items -Looking for type: CId(Value)=someRecordVar +Scope: 106 items +Completable: Cpattern: ctxPath: CUnknown->tupleItem($2), +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[] Complete2 src/CompletionNew.res 98:9 -Result: Cpattern: ctxPath: array, rootType: CId(Value)=someArr -Scope: 1 items -Looking for type: CId(Value)=someArr +Scope: 106 items +Completable: Cpattern: ctxPath: array, +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[] Complete2 src/CompletionNew.res 101:22 -Result: Cpattern: ctxPath: array, rootType: CId(Value)=someArr -Scope: 1 items -Looking for type: CId(Value)=someArr +Scope: 106 items +Completable: Cpattern: ctxPath: array, +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[] Complete2 src/CompletionNew.res 104:24 -Result: Cpattern: ctxPath: array, rootType: CId(Value)=someArr, prefix: "f" -Scope: 1 items -Looking for type: CId(Value)=someArr +Scope: 106 items +Completable: Cpattern: ctxPath: array, , prefix: "f" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[] Complete2 src/CompletionNew.res 108:23 -Result: Cexpression: ctxPath: CId(Value)=f, rootType: CFunctionArgument CId(Value)=&&($1) -Scope: 1 items -Looking for type: CFunctionArgument CId(Value)=&&($1) +Scope: 106 items +Completable: Cexpression: ctxPath: CUnknown , prefix: "f" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[] Complete2 src/CompletionNew.res 111:42 -Result: Cexpression: ctxPath: CId(Value)=f, rootType: CFunctionReturnType CFunctionArgument CId(Value)=someFunc($0) -Scope: 2 items -Looking for type: CFunctionReturnType CFunctionArgument CId(Value)=someFunc($0) +Scope: 107 items +Completable: Cexpression: ctxPath: CUnknown , prefix: "f" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[] Complete2 src/CompletionNew.res 114:34 -Result: Cexpression: ctxPath: CId(Value)=f, rootType: CFunctionArgument CId(Value)=someFunc(~labelledArg) -Scope: 1 items -Looking for type: CFunctionArgument CId(Value)=someFunc(~labelledArg) +Scope: 106 items +Completable: Cexpression: ctxPath: CUnknown , prefix: "f" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[] Complete2 src/CompletionNew.res 117:33 -Result: Cexpression: ctxPath: CUnknown, rootType: CFunctionArgument CId(Value)=someFunc(~labelledArg) -Scope: 1 items -Looking for type: CFunctionArgument CId(Value)=someFunc(~labelledArg) +Scope: 106 items +Completable: Cexpression: ctxPath: CUnknown +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[] Complete2 src/CompletionNew.res 121:17 -Result: CtxPath: (CId(Value)=foo)->id -Scope: 1 items -Looking for type: CUnknown +Scope: 106 items +Completable: CtxPath: pipe(Value(prefix=foo))->id +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path foo +[] Complete2 src/CompletionNew.res 124:16 -Result: CtxPath: (CId(Value)=foo)-> -Scope: 1 items -Looking for type: CUnknown +Scope: 106 items +Completable: CtxPath: pipe(Value(prefix=foo))-> +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path foo +[] Complete2 src/CompletionNew.res 127:17 -Result: Cexpression: ctxPath: CId(Module)=M, rootType: CUnknown, prefix: "M" -Scope: 1 items -Looking for type: CUnknown +Scope: 106 items +Completable: Cexpression: ctxPath: CUnknown , prefix: "M" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[{ + "label": "Map", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }, { + "label": "MapLabels", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }, { + "label": "MoreLabels", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }] Complete2 src/CompletionNew.res 136:36 -Result: CnamedArg(CId(Value)=someFun, f, [secondLabel, f]) -Scope: 2 items -Looking for type: CTypeAtLoc: [136:7->136:9] +Scope: 107 items +Completable: CnamedArg(Value(prefix=someFun), f, [secondLabel, f]) +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path someFun +Found type for function ( + ~firstLabel: string, + ~secondLabel: string=?, + someRecord, +) => string +[{ + "label": "firstLabel", + "kind": 4, + "tags": [], + "detail": "string", + "documentation": null + }] Complete2 src/CompletionNew.res 139:37 -Result: Cexpression: ctxPath: CUnknown, rootType: CFunctionArgument CId(Value)=someFun($0) -Scope: 2 items -Looking for type: CFunctionArgument CId(Value)=someFun($0) +Scope: 107 items +Completable: Cexpression: ctxPath: CUnknown +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[] Complete2 src/CompletionNew.res 143:21 -Result: CtxPath: CId(Module)=SomeCom -Scope: 2 items -Looking for type: CUnknown +Scope: 107 items +Completable: CtxPath: Module(prefix=SomeCom) +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path SomeCom +[] Complete2 src/CompletionNew.res 146:26 -Result: CtxPath: CId(Module)=SomeModule.S -Scope: 2 items -Looking for type: CUnknown +Scope: 107 items +Completable: CtxPath: Module(prefix=SomeModule.S) +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path SomeModule.S +[] Complete2 src/CompletionNew.res 149:24 No completions +[] Complete2 src/CompletionNew.res 152:25 -Result: Cjsx(Component, a, [a]) -Scope: 2 items -Looking for type: CTypeAtLoc: [152:7->152:10] +Scope: 107 items +Completable: Cjsx(Component, a, [a]) +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path Component.make +[] Complete2 src/CompletionNew.res 155:30 -Result: Cexpression: ctxPath: CUnknown, rootType: CJsxPropValue [Component] aProp -Scope: 2 items -Looking for type: CJsxPropValue [Component] aProp +Scope: 107 items +Completable: Cexpression: ctxPath: CTypeAtLoc: [155:7->155:10] +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[] Complete2 src/CompletionNew.res 158:40 -Result: Cexpression: ctxPath: CId(Value)=, rootType: CJsxPropValue [Component] aProp -Scope: 2 items -Looking for type: CJsxPropValue [Component] aProp +Scope: 107 items +Completable: Cexpression: ctxPath: Value(prefix=) +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +Path +[] Complete2 src/CompletionNew.res 161:35 -Result: Cexpression: ctxPath: CId(Module)=Stuff, rootType: CJsxPropValue [Component] aProp, prefix: "Stuff" -Scope: 2 items -Looking for type: CJsxPropValue [Component] aProp +Scope: 107 items +Completable: Cexpression: ctxPath: CTypeAtLoc: [161:7->161:10] , prefix: "Stuff" +Package opens Pervasives.JsxModules.place holder +Resolved opens 1 pervasives +[] From 0ed7b7f845d41d2a9669afaa955980a7d9a9593c Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 8 Sep 2023 20:48:57 +0200 Subject: [PATCH 17/18] debug tools --- analysis/src/CompletionBackendNew.ml | 362 ++++++++++++++---- analysis/tests/src/CompletionNew.res | 16 +- .../tests/src/expected/CompletionNew.res.txt | 114 +++--- 3 files changed, 350 insertions(+), 142 deletions(-) diff --git a/analysis/src/CompletionBackendNew.ml b/analysis/src/CompletionBackendNew.ml index 510aa5fda..772078724 100644 --- a/analysis/src/CompletionBackendNew.ml +++ b/analysis/src/CompletionBackendNew.ml @@ -4,6 +4,8 @@ open CompletionsNewTypesCtxPath (* TODO: Unify and clean these up once we have tests *) +let debugTypeLookups = true + let getCompletionsForPath = CompletionBackEnd.getCompletionsForPath let getOpens = CompletionBackEnd.getOpens let getComplementaryCompletionsForTypedValue = @@ -74,6 +76,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos let package = full.package in match contextPath with | CString -> + if debugTypeLookups then Printf.printf "CString: returning string\n"; [ Completion.create "dummy" ~env ~kind: @@ -81,6 +84,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos (Ctype.newconstr (Path.Pident (Ident.create "string")) [])); ] | CBool -> + if debugTypeLookups then Printf.printf "CBool: returning bool\n"; [ Completion.create "dummy" ~env ~kind: @@ -88,6 +92,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos (Ctype.newconstr (Path.Pident (Ident.create "bool")) [])); ] | CInt -> + if debugTypeLookups then Printf.printf "CInt: returning int\n"; [ Completion.create "dummy" ~env ~kind: @@ -95,6 +100,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos (Ctype.newconstr (Path.Pident (Ident.create "int")) [])); ] | CFloat -> + if debugTypeLookups then Printf.printf "CFloat: returning float\n"; [ Completion.create "dummy" ~env ~kind: @@ -102,6 +108,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos (Ctype.newconstr (Path.Pident (Ident.create "float")) [])); ] | CArray None -> + if debugTypeLookups then Printf.printf "CArray: array with no payload\n"; [ Completion.create "array" ~env ~kind: @@ -115,8 +122,14 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~exact:true ~scope |> completionsGetCompletionType ~full with - | None -> [] + | None -> + if debugTypeLookups then + Printf.printf "CArray (with payload): could not look up payload\n"; + [] | Some (typ, env) -> + if debugTypeLookups then + Printf.printf "CArray (with payload): returning array with payload %s\n" + (TypeUtils.extractedTypeToString typ); [ Completion.create "dummy" ~env ~kind: @@ -129,8 +142,14 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~exact:true ~scope |> completionsGetCompletionType ~full with - | None -> [] + | None -> + if debugTypeLookups then + Printf.printf "COption: could not look up payload\n"; + [] | Some (typ, env) -> + if debugTypeLookups then + Printf.printf "COption: returning option with payload %s\n" + (TypeUtils.extractedTypeToString typ); [ Completion.create "dummy" ~env ~kind: @@ -144,8 +163,20 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos |> completionsGetCompletionType ~full with | Some (Tpromise (env, typ), _env) -> + if debugTypeLookups then + Printf.printf "CAwait: found type to unwrap in promise: %s\n" + (Shared.typeToString typ); [Completion.create "dummy" ~env ~kind:(Completion.Value typ)] - | _ -> []) + | Some (typ, _) -> + if debugTypeLookups then + Printf.printf + "CAwait: found something other than a promise at await ctx path: %s\n" + (TypeUtils.extractedTypeToString typ); + [] + | None -> + if debugTypeLookups then + Printf.printf "CAwait: found no type at await ctx path\n"; + []) | CId (path, completionContext) -> path |> getCompletionsForPath ~debug ~package ~opens ~full ~pos ~exact @@ -194,9 +225,19 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos | args, tRet when args <> [] -> let args = processApply args labels in let retType = reconstructFunctionType args tRet in + if debugTypeLookups then + Printf.printf "CApply: returning apply return type %s\n" + (Shared.typeToString typ); [Completion.create "dummy" ~env ~kind:(Completion.Value retType)] - | _ -> []) - | _ -> []) + | _ -> + if debugTypeLookups then + Printf.printf "CApply: could not extract function type from %s\n" + (Shared.typeToString typ); + []) + | _ -> + if debugTypeLookups then + Printf.printf "CApply: looked for a function but found something else\n"; + []) | CRecordFieldAccess {recordCtxPath = CId (path, Module); fieldName} -> (* M.field *) path @ [fieldName] @@ -230,8 +271,14 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos | None -> None in match extracted with - | None -> [] + | None -> + if debugTypeLookups then + Printf.printf "CRecordFieldAccess: found type is not a record\n"; + [] | Some (env, fields, recordAsString) -> + if debugTypeLookups then + Printf.printf + "CRecordFieldAccess: found record and now filtering fields\n"; fields |> Utils.filterMap (fun field -> if Utils.checkName field.fname.txt ~prefix:fieldName ~exact then @@ -266,8 +313,16 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos Some (Completion.create field ~env ~kind:(Completion.ObjLabel typ)) else None) - | None -> []) - | None -> []) + | None -> + if debugTypeLookups then + Printf.printf + "CObj: looked for an object but found something else: %s\n" + (Shared.typeToString typ); + []) + | None -> + if debugTypeLookups then + Printf.printf "CObj: could not look up type at ctx path\n"; + []) | CPipe {functionCtxPath = cp; id = funNamePrefix; lhsLoc} -> ( match cp @@ -275,7 +330,10 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~exact:true ~scope |> completionsGetTypeEnv ~debug ~full ~opens ~rawOpens ~pos ~scope with - | None -> [] + | None -> + if debugTypeLookups then + Printf.printf "CPipe: could not look up type at pipe fn ctx path\n"; + [] | Some (typ, envFromCompletionItem) -> ( let env, typ = typ @@ -429,12 +487,18 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos | {Completion.kind = Value typ} :: _ -> Some typ | _ -> None) in - if List.length ctxPaths = List.length typeExrps then + if List.length ctxPaths = List.length typeExrps then ( + if debugTypeLookups then + Printf.printf "CTuple: found tuple, returning it\n"; [ Completion.create "dummy" ~env ~kind:(Completion.Value (Ctype.newty (Ttuple typeExrps))); - ] - else [] + ]) + else ( + if debugTypeLookups then + Printf.printf + "CTuple: extracted tuple and target tuple length does not match\n"; + []) | CJsxPropValue {pathToComponent; propName} -> ( let findTypeOfValue path = path @@ -474,8 +538,14 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos |> List.find_opt (fun (label, _, _) -> label = propName) in match targetLabel with - | None -> [] + | None -> + if debugTypeLookups then + Printf.printf "CJsxPropValue: did not find target label\n"; + [] | Some (_, typ, env) -> + if debugTypeLookups then + Printf.printf "CJsxPropValue: found type: %s\n" + (Shared.typeToString typ); [ Completion.create "dummy" ~env ~kind:(Completion.Value (Utils.unwrapIfOption typ)); @@ -491,7 +561,12 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos with | Some ((TypeExpr typ | ExtractedType (Tfunction {typ})), env) -> (typ |> TypeUtils.getArgs ~full ~env, env) - | _ -> ([], env) + | _ -> + if debugTypeLookups then + Printf.printf + "CFunctionArgument: did not find fn type, or found type was \ + something other than a function\n"; + ([], env) in let targetLabel = labels @@ -511,8 +586,14 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos | Some (Optional _, _) -> true in match targetLabel with - | None -> [] + | None -> + if debugTypeLookups then + Printf.printf "CFunctionArgument: did not find target label\n"; + [] | Some (_, typ) -> + if debugTypeLookups then + Printf.printf "CFunctionArgument: found type: %s\n" + (Shared.typeToString typ); [ Completion.create "dummy" ~env ~kind: @@ -558,10 +639,33 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos else None) in match targetType with - | None -> [] - | Some t -> [Completion.create "dummy" ~env ~kind:(Completion.Value t)]) - | _ -> []) - | _ -> []) + | None -> + if debugTypeLookups then + Printf.printf + "CVariantPayload: could not find target payload type in variant \ + type\n"; + [] + | Some t -> + if debugTypeLookups then + Printf.printf "CVariantPayload: found payload type: %s\n" + (Shared.typeToString t); + [Completion.create "dummy" ~env ~kind:(Completion.Value t)]) + | Some t -> + if debugTypeLookups then + Printf.printf + "CVariantPayload(constructorName: %s, itemNum: %i): some other \ + type than a variant found at variant ctx path: %s\n" + constructorName itemNum + (TypeUtils.extractedTypeToString t); + [] + | None -> + if debugTypeLookups then + Printf.printf "CVariantPayload: no type found at variant ctx path\n"; + []) + | None -> + if debugTypeLookups then + Printf.printf "CVariantPayload: did not find type at variant ctx path\n"; + []) | CTupleItem {tupleCtxPath; itemNum} -> ( match tupleCtxPath @@ -578,12 +682,30 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos match typ with | Some (Tuple (env, items, _)) -> ( match List.nth_opt items itemNum with - | None -> [] + | None -> + if debugTypeLookups then + Printf.printf + "CTupleItem: found tuple, but not the target item num\n"; + [] | Some tupleItemType -> + if debugTypeLookups then + Printf.printf "CTupleItem: found tuple and item: %s\n" + (Shared.typeToString tupleItemType); [Completion.create "dummy" ~env ~kind:(Value tupleItemType)]) - | _ -> []) - | _ -> []) - | CRecordField {recordCtxPath; prefix} when true -> ( + | Some t -> + if debugTypeLookups then + Printf.printf "CTupleItem: type, but it's not a tuple: %s\n" + (TypeUtils.extractedTypeToString t); + [] + | None -> + if debugTypeLookups then + Printf.printf "CTupleItem: no type extracted at tuple ctx path\n"; + []) + | None -> + if debugTypeLookups then + Printf.printf "CTupleItem: no type found at tuple ctx path\n"; + []) + | CRecordField {recordCtxPath} when true -> ( let completionsForCtxPath = recordCtxPath |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env @@ -601,8 +723,21 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos in match extracted with | Some (Trecord _ as typ) -> + if debugTypeLookups then + Printf.printf "CRecordField: found record: %s\n" + (TypeUtils.extractedTypeToString typ); [Completion.create "dummy" ~env ~kind:(ExtractedType (typ, `Value))] - | _ -> []) + | Some t -> + if debugTypeLookups then + Printf.printf + "CRecordField: found something that's not a record at the record ctx \ + path: %s\n" + (TypeUtils.extractedTypeToString t); + [] + | None -> + if debugTypeLookups then + Printf.printf "CRecordField: found no type at record ctx path\n"; + []) | CRecordField {recordCtxPath; prefix; seenFields} -> ( let completionsForCtxPath = recordCtxPath @@ -669,17 +804,32 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ( env, fields, typDecl.item.decl |> Shared.declToString typDecl.name.txt ) - | None -> None) + | None -> + if debugTypeLookups then + Printf.printf + "CRecordBody: found type at ctx path, but it's not a record: %s\n" + (Shared.typeToString typ); + None) | Some (ExtractedType typ, env) -> ( match typ with | Trecord {fields} -> Some (env, fields, typ |> TypeUtils.extractedTypeToString) - | _ -> None) - | None -> None + | t -> + if debugTypeLookups then + Printf.printf + "CRecordBody: found something that's not a record at ctx path: %s\n" + (TypeUtils.extractedTypeToString t); + None) + | None -> + if debugTypeLookups then + Printf.printf "CRecordBody: found no type at record ctx path\n"; + None in match extracted with | None -> [] | Some (env, fields, recordAsString) -> + if debugTypeLookups then + Printf.printf "CRecordBody: found record type, now returning fields\n"; let fields = fields |> Utils.filterMap (fun field -> @@ -712,21 +862,57 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos match fields |> Utils.findMap (fun (field : field) -> - if field.fname.txt = fieldName then Some field.typ else None) + if field.fname.txt = fieldName then + Some + (if field.optional then Utils.unwrapIfOption field.typ + else field.typ) + else None) with - | None -> [] + | None -> + if debugTypeLookups then + Printf.printf + "CRecordFieldFollow: could not find the field to follow\n"; + [] | Some fieldType -> + if debugTypeLookups then + Printf.printf + "CRecordFieldFollow: type of field (\"%s\") to follow: %s\n" + fieldName + (Shared.typeToString fieldType); [Completion.create "dummy" ~env ~kind:(Value fieldType)]) - | _ -> []) - | _ -> []) + | Some t -> + if debugTypeLookups then + Printf.printf + "CRecordFieldFollow: found type at record ctx path, but it's not a \ + record: %s\n" + (TypeUtils.extractedTypeToString t); + [] + | None -> + if debugTypeLookups then + Printf.printf "CRecordFieldFollow: found no type at record ctx path\n"; + []) + | None -> + if debugTypeLookups then + Printf.printf "CRecordFieldFollow: found no type at record ctx path\n"; + []) | CTypeAtLoc loc -> ( match References.getLocItem ~full ~pos:(Pos.ofLexing loc.loc_start) ~debug with - | None -> [] + | None -> + if debugTypeLookups then + Printf.printf "CTypeAtLoc: found no type at loc\n"; + [] | Some {locType = Typed (_, typExpr, _)} -> + if debugTypeLookups then + Printf.printf "CTypeAtLoc: found type at loc: %s\n" + (Shared.typeToString typExpr); [Completion.create "dummy" ~env ~kind:(Value typExpr)] - | _ -> []) + | Some _ -> + if debugTypeLookups then + Printf.printf + "CTypeAtLoc: found type at loc, but it's not something we can extract\n"; + []) | CFunctionReturnType {functionCtxPath} -> ( match functionCtxPath with | CFunction {returnType} -> @@ -743,7 +929,23 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos with | Some (ExtractedType (Tfunction {returnType}), env) -> [Completion.create "dummy" ~env ~kind:(Completion.Value returnType)] - | _ -> [])) + | Some (TypeExpr t, _) -> + if debugTypeLookups then + Printf.printf + "CFunctionReturnType: found type at fn ctx path, but it's not a \ + function: %s\n" + (Shared.typeToString t); + [] + | Some (ExtractedType t, _) -> + if debugTypeLookups then + Printf.printf + "CFunctionReturnType: found type at fn ctx path, but it's not a \ + function: %s\n" + (TypeUtils.extractedTypeToString t); + [] + | None -> + Printf.printf "CFunctionReturnType: found no type at fn ctx path\n"; + [])) type completionMode = Pattern of Completable.patternMode | Expression @@ -1155,54 +1357,64 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable = ctxPath |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact:true ~scope - |> completionsGetCompletionType ~full + |> completionsGetCompletionType2 ~full ~debug ~opens ~rawOpens ~pos ~scope with | None -> regularCompletions | Some (typ, _env) -> ( - (* TODO: We can get rid of the completion context and only use the ctx path *) - let completionContext = - match ctxPath with - | CRecordBody {seenFields} | CRecordField {seenFields} -> - Some (Completable.RecordField {seenFields}) - | CRecordFieldFollow {fieldName} -> Some (CameFromRecordField fieldName) - | _ -> None + let extractedType = + match typ with + | ExtractedType t -> Some t + | TypeExpr t -> TypeUtils.extractType t ~env ~package:full.package in - let wrapInsertTextInBraces = - if List.length [] > 0 then false - else + match extractedType with + | None -> regularCompletions + | Some typ -> ( + (* TODO: We can get rid of the completion context and only use the ctx path *) + let completionContext = match ctxPath with - | CJsxPropValue _ -> true - | _ -> false - in - let items = - typ - |> completeTypedValue ~mode:Expression ~full ~prefix ~completionContext - |> List.map (fun (c : Completion.t) -> - if wrapInsertTextInBraces then - { - c with - insertText = - (match c.insertText with - | None -> None - | Some text -> Some ("{" ^ text ^ "}")); - } - else c) - in - match (prefix, completionContext) with - | "", _ -> items - | _, None -> + | CRecordBody {seenFields} | CRecordField {seenFields} -> + Some (Completable.RecordField {seenFields}) + | CRecordFieldFollow {fieldName} -> + Some (CameFromRecordField fieldName) + | _ -> None + in + let wrapInsertTextInBraces = + if List.length [] > 0 then false + else + match ctxPath with + | CJsxPropValue _ -> true + | _ -> false + in let items = - if List.length regularCompletions > 0 then - (* The client will occasionally sort the list of completions alphabetically, disregarding the order - in which we send it. This fixes that by providing a sort text making the typed completions - guaranteed to end up on top. *) - items - |> List.map (fun (c : Completion.t) -> - {c with sortText = Some ("A" ^ " " ^ c.name)}) - else items + typ + |> completeTypedValue ~mode:Expression ~full ~prefix + ~completionContext + |> List.map (fun (c : Completion.t) -> + if wrapInsertTextInBraces then + { + c with + insertText = + (match c.insertText with + | None -> None + | Some text -> Some ("{" ^ text ^ "}")); + } + else c) in - items @ regularCompletions - | _ -> items)) + match (prefix, completionContext) with + | "", _ -> items + | _, None -> + let items = + if List.length regularCompletions > 0 then + (* The client will occasionally sort the list of completions alphabetically, disregarding the order + in which we send it. This fixes that by providing a sort text making the typed completions + guaranteed to end up on top. *) + items + |> List.map (fun (c : Completion.t) -> + {c with sortText = Some ("A" ^ " " ^ c.name)}) + else items + in + items @ regularCompletions + | _ -> items))) (*| CexhaustiveSwitch {contextPath; exprLoc} -> let range = Utils.rangeOfLoc exprLoc in let printFailwithStr num = diff --git a/analysis/tests/src/CompletionNew.res b/analysis/tests/src/CompletionNew.res index 24f8e980e..a154c4754 100644 --- a/analysis/tests/src/CompletionNew.res +++ b/analysis/tests/src/CompletionNew.res @@ -34,17 +34,17 @@ type someRecord = {nested: option, variant: someVariant, someStrin // let myFunc: someRecord = {variant: O} // ^co2 -// let myFunc: someRecord = {nested: {maybeVariant: Three(false, S)}} -// ^co2 +// let myFunc: someRecord = {nested: Some({maybeVariant: Three(false, So)})} +// ^co2 -// let myFunc: someRecord = {nested: {maybeVariant: One}, variant: } -// ^co2 +// let myFunc: someRecord = {nested: Some({maybeVariant: One}), variant: } +// ^co2 -// let myFunc: someRecord = {nested: {maybeVariant: One, }} -// ^co2 +// let myFunc: someRecord = {nested: Some({maybeVariant: One, })} +// ^co2 -// let myFunc: someRecord = {nested: {maybeVariant: One}, } -// ^co2 +// let myFunc: someRecord = {nested: Some({maybeVariant: One}), } +// ^co2 // This should reset the context, meaning it should just complete for the identifier // let myFunc: someRecord = {nested: {maybeVariant: {let x = true; if x {}}}, } diff --git a/analysis/tests/src/expected/CompletionNew.res.txt b/analysis/tests/src/expected/CompletionNew.res.txt index b539a0cd2..1d86fd0fe 100644 --- a/analysis/tests/src/expected/CompletionNew.res.txt +++ b/analysis/tests/src/expected/CompletionNew.res.txt @@ -3,6 +3,7 @@ Scope: 1 items Completable: Cexpression: ctxPath: CTypeAtLoc: [2:7->2:13] , prefix: "m" Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives +CTypeAtLoc: found no type at loc [{ "label": "myVar", "kind": 12, @@ -46,6 +47,7 @@ Completable: Cexpression: ctxPath: (Type(prefix=someVariant))->variantPayload(Th Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives Path someVariant +CVariantPayload: found payload type: bool [{ "label": "true", "kind": 4, @@ -60,6 +62,7 @@ Completable: Cexpression: ctxPath: (Type(prefix=someVariant))->variantPayload(Th Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives Path someVariant +CVariantPayload: found payload type: option [{ "label": "Some(_)", "kind": 12, @@ -83,6 +86,7 @@ Completable: Cexpression: ctxPath: ((Type(prefix=someVariant))->variantPayload(T Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives Path someVariant +CVariantPayload: found payload type: option [{ "label": "One", "kind": 4, @@ -112,6 +116,7 @@ Completable: Cexpression: ctxPath: Type(prefix=someRecord)->recordField("", []) Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives Path someRecord +CRecordField: found record: type someRecord = {nested: option, variant: someVariant, someString: string} [{ "label": "nested", "kind": 5, @@ -138,6 +143,7 @@ Completable: Cexpression: ctxPath: Type(prefix=someRecord)->recordField("n", []) Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives Path someRecord +CRecordField: found record: type someRecord = {nested: option, variant: someVariant, someString: string} [{ "label": "nested", "kind": 5, @@ -152,6 +158,7 @@ Completable: Cexpression: ctxPath: (Type(prefix=someRecord))->followRecordField{ Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives Path someRecord +CRecordFieldFollow: type of field ("variant") to follow: someVariant [{ "label": "One", "kind": 4, @@ -162,80 +169,39 @@ Path someRecord "insertTextFormat": 2 }] -Complete2 src/CompletionNew.res 36:66 +Complete2 src/CompletionNew.res 36:72 Scope: 105 items -Completable: Cexpression: ctxPath: (((Type(prefix=someRecord))->followRecordField{nested})->followRecordField{maybeVariant})->variantPayload(Three<$1>) , prefix: "S" +Completable: Cexpression: ctxPath: ((((Type(prefix=someRecord))->followRecordField{nested})->variantPayload(Some<$0>))->followRecordField{maybeVariant})->variantPayload(Three<$1>) , prefix: "So" Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives Path someRecord +CRecordFieldFollow: type of field ("nested") to follow: option +CRecordFieldFollow: type of field ("maybeVariant") to follow: someVariant +CVariantPayload: found payload type: option [{ - "label": "Set", - "kind": 9, - "tags": [], - "detail": "file module", - "documentation": null - }, { - "label": "SetLabels", - "kind": 9, - "tags": [], - "detail": "file module", - "documentation": null - }, { - "label": "SignatureHelp", - "kind": 9, + "label": "Some(_)", + "kind": 12, "tags": [], - "detail": "file module", - "documentation": null + "detail": "someVariant", + "documentation": null, + "sortText": "A Some(_)", + "insertText": "Some(${1:_})", + "insertTextFormat": 2 }, { "label": "Sort", "kind": 9, "tags": [], "detail": "file module", "documentation": null - }, { - "label": "Stack", - "kind": 9, - "tags": [], - "detail": "file module", - "documentation": null - }, { - "label": "StdLabels", - "kind": 9, - "tags": [], - "detail": "file module", - "documentation": null - }, { - "label": "Stream", - "kind": 9, - "tags": [], - "detail": "file module", - "documentation": null - }, { - "label": "String", - "kind": 9, - "tags": [], - "detail": "file module", - "documentation": null - }, { - "label": "StringLabels", - "kind": 9, - "tags": [], - "detail": "file module", - "documentation": null - }, { - "label": "Sys", - "kind": 9, - "tags": [], - "detail": "file module", - "documentation": null }] -Complete2 src/CompletionNew.res 39:66 +Complete2 src/CompletionNew.res 39:72 Scope: 105 items Completable: Cexpression: ctxPath: (Type(prefix=someRecord))->followRecordField{variant} Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives Path someRecord +CRecordFieldFollow: type of field ("variant") to follow: someVariant [{ "label": "One", "kind": 4, @@ -262,20 +228,35 @@ Path someRecord "insertTextFormat": 2 }] -Complete2 src/CompletionNew.res 42:56 +Complete2 src/CompletionNew.res 42:61 Scope: 105 items -Completable: Cexpression: ctxPath: (Type(prefix=someRecord))->followRecordField{nested}->recordField("", [maybeVariant]) +Completable: Cexpression: ctxPath: ((Type(prefix=someRecord))->followRecordField{nested})->variantPayload(Some<$0>)->recordField("", [maybeVariant]) Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives Path someRecord -[] +CRecordFieldFollow: type of field ("nested") to follow: option +CRecordField: found record: nestedRecord +[{ + "label": "on", + "kind": 5, + "tags": [], + "detail": "on: bool\n\nnestedRecord", + "documentation": null + }, { + "label": "off", + "kind": 5, + "tags": [], + "detail": "off?: bool\n\nnestedRecord", + "documentation": null + }] -Complete2 src/CompletionNew.res 45:57 +Complete2 src/CompletionNew.res 45:63 Scope: 105 items Completable: Cexpression: ctxPath: Type(prefix=someRecord)->recordField("", [nested]) Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives Path someRecord +CRecordField: found record: type someRecord = {nested: option, variant: someVariant, someString: string} [{ "label": "variant", "kind": 5, @@ -317,6 +298,8 @@ Completable: Cexpression: ctxPath: ((Type(prefix=someRecord))->followRecordField Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives Path someRecord +CRecordFieldFollow: type of field ("nested") to follow: option +CRecordFieldFollow: found type at record ctx path, but it's not a record: option [] Complete2 src/CompletionNew.res 61:58 @@ -340,6 +323,7 @@ Completable: Cexpression: ctxPath: Type(prefix=fn)->recordField("", []) Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives Path fn +CRecordField: found something that's not a record at the record ctx path: (~name: string=?, string) => bool [] Complete2 src/CompletionNew.res 72:72 @@ -355,6 +339,7 @@ Scope: 108 items Completable: Cexpression: ctxPath: bool , prefix: "t" Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives +CBool: returning bool [{ "label": "true", "kind": 4, @@ -368,6 +353,7 @@ Scope: 108 items Completable: Cexpression: ctxPath: CTypeAtLoc: [80:42->80:50] , prefix: "t" Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives +CTypeAtLoc: found no type at loc [] Complete2 src/CompletionNew.res 84:22 @@ -383,6 +369,7 @@ Scope: 106 items Completable: Cpattern: ctxPath: CUnknown->recordField("someField", [someField]), , prefix: "s" Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives +CRecordField: found no type at record ctx path [] Complete2 src/CompletionNew.res 91:13 @@ -390,6 +377,7 @@ Scope: 106 items Completable: Cpattern: ctxPath: CUnknown->tupleItem($1), Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives +CTupleItem: no type found at tuple ctx path [] Complete2 src/CompletionNew.res 94:20 @@ -397,6 +385,7 @@ Scope: 106 items Completable: Cpattern: ctxPath: CUnknown->tupleItem($2), Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives +CTupleItem: no type found at tuple ctx path [] Complete2 src/CompletionNew.res 98:9 @@ -404,6 +393,7 @@ Scope: 106 items Completable: Cpattern: ctxPath: array, Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives +CArray: array with no payload [] Complete2 src/CompletionNew.res 101:22 @@ -411,6 +401,7 @@ Scope: 106 items Completable: Cpattern: ctxPath: array, Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives +CArray: array with no payload [] Complete2 src/CompletionNew.res 104:24 @@ -418,6 +409,7 @@ Scope: 106 items Completable: Cpattern: ctxPath: array, , prefix: "f" Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives +CArray: array with no payload [] Complete2 src/CompletionNew.res 108:23 @@ -454,6 +446,7 @@ Completable: CtxPath: pipe(Value(prefix=foo))->id Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives Path foo +CPipe: could not look up type at pipe fn ctx path [] Complete2 src/CompletionNew.res 124:16 @@ -462,6 +455,7 @@ Completable: CtxPath: pipe(Value(prefix=foo))-> Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives Path foo +CPipe: could not look up type at pipe fn ctx path [] Complete2 src/CompletionNew.res 127:17 @@ -548,6 +542,7 @@ Scope: 107 items Completable: Cexpression: ctxPath: CTypeAtLoc: [155:7->155:10] Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives +CTypeAtLoc: found no type at loc [] Complete2 src/CompletionNew.res 158:40 @@ -563,5 +558,6 @@ Scope: 107 items Completable: Cexpression: ctxPath: CTypeAtLoc: [161:7->161:10] , prefix: "Stuff" Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives +CTypeAtLoc: found no type at loc [] From aebde4a2526eb0da776745274ea314c9e5d0e917 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Mon, 11 Sep 2023 12:53:45 +0200 Subject: [PATCH 18/18] wip --- analysis/src/CompletionFrontEndNew.ml | 22 +++++------ analysis/tests/src/CompletionNew.res | 8 ++-- .../tests/src/expected/CompletionNew.res.txt | 37 ++++++++++++++----- 3 files changed, 40 insertions(+), 27 deletions(-) diff --git a/analysis/src/CompletionFrontEndNew.ml b/analysis/src/CompletionFrontEndNew.ml index a340ed159..6114316b8 100644 --- a/analysis/src/CompletionFrontEndNew.ml +++ b/analysis/src/CompletionFrontEndNew.ml @@ -506,17 +506,8 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : (CId (flattenLidCheckDot ~completionContext fieldName, Value)) completionContext else - completeExpr - ~completionContext: - (CompletionContext.addCtxPathItem - (CRecordFieldFollow - { - fieldName = fieldName.txt |> Longident.last; - recordCtxPath = - ctxPathFromCompletionContext completionContext; - }) - completionContext) - fieldExpr) + (* TODO: Only follow if we can follow, otherwise set context appropriately. *) + completeExpr ~completionContext fieldExpr) in match fieldToComplete with | None -> ( @@ -598,7 +589,12 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : completeExpr ~completionContext:(CompletionContext.resetCtx completionContext) condition - else if locHasPos then_.pexp_loc then completeExpr ~completionContext then_ + else if locHasPos then_.pexp_loc then + completeExpr + ~completionContext: + (completionContext + |> CompletionContext.setCurrentlyExpecting completionContext.ctxPath) + then_ else match maybeElse with | Some else_ -> @@ -615,7 +611,7 @@ and completeExpr ~completionContext (expr : Parsetree.expression) : if checkIfExprHoleEmptyCursor ~completionContext then_ then let completionContext = completionContext - |> CompletionContext.addCtxPathItem (CId ([], Value)) + |> CompletionContext.setCurrentlyExpecting completionContext.ctxPath in CompletionResult.expression ~completionContext ~prefix:"" else None) diff --git a/analysis/tests/src/CompletionNew.res b/analysis/tests/src/CompletionNew.res index a154c4754..fda377a14 100644 --- a/analysis/tests/src/CompletionNew.res +++ b/analysis/tests/src/CompletionNew.res @@ -50,13 +50,13 @@ type someRecord = {nested: option, variant: someVariant, someStrin // let myFunc: someRecord = {nested: {maybeVariant: {let x = true; if x {}}}, } // ^co2 -// This is the last expression +// This is the last expression - NOTE: This should work but it's doing a follow // let myFunc: someRecord = {nested: {maybeVariant: {let x = true; if x {}}}, } // ^co2 -// Complete as the last expression (looking for the record field type) -// let myFunc: someRecord = {nested: {maybeVariant: {doStuff(); let x = true; if x {v}}}, } -// ^co2 +// Complete as the last expression (looking for the record field type) - NOTE: This should work but it's doing a follow +// let myFunc: someRecord = {nested: {maybeVariant: {doStuff(); let x = true; if x {So}}}, } +// ^co2 // Complete on the identifier, no context // let myFunc: someRecord = {nested: {maybeVariant: {doStuff(); let x = true; if x {v}}}, } diff --git a/analysis/tests/src/expected/CompletionNew.res.txt b/analysis/tests/src/expected/CompletionNew.res.txt index 1d86fd0fe..17fa16fcf 100644 --- a/analysis/tests/src/expected/CompletionNew.res.txt +++ b/analysis/tests/src/expected/CompletionNew.res.txt @@ -286,21 +286,29 @@ Resolved opens 1 pervasives Complete2 src/CompletionNew.res 53:73 Scope: 106 items -Completable: Cexpression: ctxPath: Value(prefix=) +Completable: Cexpression: ctxPath: ((Type(prefix=someRecord))->followRecordField{nested})->followRecordField{maybeVariant} Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives -Path +Path someRecord +CRecordFieldFollow: type of field ("nested") to follow: option +CRecordFieldFollow: found type at record ctx path, but it's not a record: option [] -Complete2 src/CompletionNew.res 57:85 +Complete2 src/CompletionNew.res 57:86 Scope: 106 items -Completable: Cexpression: ctxPath: ((Type(prefix=someRecord))->followRecordField{nested})->followRecordField{maybeVariant} , prefix: "v" +Completable: Cexpression: ctxPath: ((Type(prefix=someRecord))->followRecordField{nested})->followRecordField{maybeVariant} , prefix: "So" Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives Path someRecord CRecordFieldFollow: type of field ("nested") to follow: option CRecordFieldFollow: found type at record ctx path, but it's not a record: option -[] +[{ + "label": "Sort", + "kind": 9, + "tags": [], + "detail": "file module", + "documentation": null + }] Complete2 src/CompletionNew.res 61:58 Scope: 105 items @@ -328,11 +336,20 @@ CRecordField: found something that's not a record at the record ctx path: (~name Complete2 src/CompletionNew.res 72:72 Scope: 109 items -Completable: Cexpression: ctxPath: Value(prefix=) +Completable: Cexpression: ctxPath: Type(prefix=fn) Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives -Path -[] +Path fn +[{ + "label": "(~name=?, v1) => {}", + "kind": 12, + "tags": [], + "detail": "(~name: string=?, string) => bool", + "documentation": null, + "sortText": "A", + "insertText": "(~name=?, ${1:v1}) => {$0}", + "insertTextFormat": 2 + }] Complete2 src/CompletionNew.res 76:60 Scope: 108 items @@ -547,10 +564,10 @@ CTypeAtLoc: found no type at loc Complete2 src/CompletionNew.res 158:40 Scope: 107 items -Completable: Cexpression: ctxPath: Value(prefix=) +Completable: Cexpression: ctxPath: CTypeAtLoc: [158:7->158:10] Package opens Pervasives.JsxModules.place holder Resolved opens 1 pervasives -Path +CTypeAtLoc: found no type at loc [] Complete2 src/CompletionNew.res 161:35