From e28084b9d57dc3884e30fe1bd6e0d94437b0e631 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Sat, 14 Jan 2023 18:07:43 +0100 Subject: [PATCH] break up CompletionBackend and CompletionFrontend into modules --- analysis/src/CompletionBackEnd.ml | 1144 +------------------------ analysis/src/CompletionDecorators.ml | 223 +++++ analysis/src/CompletionExpressions.ml | 218 +++++ analysis/src/CompletionFrontEnd.ml | 606 +------------ analysis/src/CompletionJsx.ml | 694 +++++++++++++++ analysis/src/CompletionPatterns.ml | 244 ++++++ analysis/src/CreateInterface.ml | 4 +- analysis/src/LocalTables.ml | 51 ++ analysis/src/SignatureHelp.ml | 4 +- analysis/src/TypeUtils.ml | 250 ++++++ analysis/src/Utils.ml | 9 + 11 files changed, 1742 insertions(+), 1705 deletions(-) create mode 100644 analysis/src/CompletionDecorators.ml create mode 100644 analysis/src/CompletionExpressions.ml create mode 100644 analysis/src/CompletionJsx.ml create mode 100644 analysis/src/CompletionPatterns.ml create mode 100644 analysis/src/LocalTables.ml create mode 100644 analysis/src/TypeUtils.ml diff --git a/analysis/src/CompletionBackEnd.ml b/analysis/src/CompletionBackEnd.ml index d6af1d4fe..fab77ce18 100644 --- a/analysis/src/CompletionBackEnd.ml +++ b/analysis/src/CompletionBackEnd.ml @@ -1,492 +1,5 @@ open SharedTypes -let domLabels = - let bool = "bool" in - let float = "float" in - let int = "int" in - let string = "string" in - [ - ("ariaDetails", string); - ("ariaDisabled", bool); - ("ariaHidden", bool); - ("ariaKeyshortcuts", string); - ("ariaLabel", string); - ("ariaRoledescription", string); - ("ariaExpanded", bool); - ("ariaLevel", int); - ("ariaModal", bool); - ("ariaMultiline", bool); - ("ariaMultiselectable", bool); - ("ariaPlaceholder", string); - ("ariaReadonly", bool); - ("ariaRequired", bool); - ("ariaSelected", bool); - ("ariaSort", string); - ("ariaValuemax", float); - ("ariaValuemin", float); - ("ariaValuenow", float); - ("ariaValuetext", string); - ("ariaAtomic", bool); - ("ariaBusy", bool); - ("ariaRelevant", string); - ("ariaGrabbed", bool); - ("ariaActivedescendant", string); - ("ariaColcount", int); - ("ariaColindex", int); - ("ariaColspan", int); - ("ariaControls", string); - ("ariaDescribedby", string); - ("ariaErrormessage", string); - ("ariaFlowto", string); - ("ariaLabelledby", string); - ("ariaOwns", string); - ("ariaPosinset", int); - ("ariaRowcount", int); - ("ariaRowindex", int); - ("ariaRowspan", int); - ("ariaSetsize", int); - ("defaultChecked", bool); - ("defaultValue", string); - ("accessKey", string); - ("className", string); - ("contentEditable", bool); - ("contextMenu", string); - ("dir", string); - ("draggable", bool); - ("hidden", bool); - ("id", string); - ("lang", string); - ("style", "style"); - ("spellCheck", bool); - ("tabIndex", int); - ("title", string); - ("itemID", string); - ("itemProp", string); - ("itemRef", string); - ("itemScope", bool); - ("itemType", string); - ("accept", string); - ("acceptCharset", string); - ("action", string); - ("allowFullScreen", bool); - ("alt", string); - ("async", bool); - ("autoComplete", string); - ("autoCapitalize", string); - ("autoFocus", bool); - ("autoPlay", bool); - ("challenge", string); - ("charSet", string); - ("checked", bool); - ("cite", string); - ("crossOrigin", string); - ("cols", int); - ("colSpan", int); - ("content", string); - ("controls", bool); - ("coords", string); - ("data", string); - ("dateTime", string); - ("default", bool); - ("defer", bool); - ("disabled", bool); - ("download", string); - ("encType", string); - ("form", string); - ("formAction", string); - ("formTarget", string); - ("formMethod", string); - ("headers", string); - ("height", string); - ("high", int); - ("href", string); - ("hrefLang", string); - ("htmlFor", string); - ("httpEquiv", string); - ("icon", string); - ("inputMode", string); - ("integrity", string); - ("keyType", string); - ("label", string); - ("list", string); - ("loop", bool); - ("low", int); - ("manifest", string); - ("max", string); - ("maxLength", int); - ("media", string); - ("mediaGroup", string); - ("method", string); - ("min", string); - ("minLength", int); - ("multiple", bool); - ("muted", bool); - ("name", string); - ("nonce", string); - ("noValidate", bool); - ("open_", bool); - ("optimum", int); - ("pattern", string); - ("placeholder", string); - ("playsInline", bool); - ("poster", string); - ("preload", string); - ("radioGroup", string); - ("readOnly", bool); - ("rel", string); - ("required", bool); - ("reversed", bool); - ("rows", int); - ("rowSpan", int); - ("sandbox", string); - ("scope", string); - ("scoped", bool); - ("scrolling", string); - ("selected", bool); - ("shape", string); - ("size", int); - ("sizes", string); - ("span", int); - ("src", string); - ("srcDoc", string); - ("srcLang", string); - ("srcSet", string); - ("start", int); - ("step", float); - ("summary", string); - ("target", string); - ("type_", string); - ("useMap", string); - ("value", string); - ("width", string); - ("wrap", string); - ("onCopy", "ReactEvent.Clipboard.t => unit"); - ("onCut", "ReactEvent.Clipboard.t => unit"); - ("onPaste", "ReactEvent.Clipboard.t => unit"); - ("onCompositionEnd", "ReactEvent.Composition.t => unit"); - ("onCompositionStart", "ReactEvent.Composition.t => unit"); - ("onCompositionUpdate", "ReactEvent.Composition.t => unit"); - ("onKeyDown", "ReactEvent.Keyboard.t => unit"); - ("onKeyPress", "ReactEvent.Keyboard.t => unit"); - ("onKeyUp", "ReactEvent.Keyboard.t => unit"); - ("onFocus", "ReactEvent.Focus.t => unit"); - ("onBlur", "ReactEvent.Focus.t => unit"); - ("onChange", "ReactEvent.Form.t => unit"); - ("onInput", "ReactEvent.Form.t => unit"); - ("onSubmit", "ReactEvent.Form.t => unit"); - ("onInvalid", "ReactEvent.Form.t => unit"); - ("onClick", "ReactEvent.Mouse.t => unit"); - ("onContextMenu", "ReactEvent.Mouse.t => unit"); - ("onDoubleClick", "ReactEvent.Mouse.t => unit"); - ("onDrag", "ReactEvent.Mouse.t => unit"); - ("onDragEnd", "ReactEvent.Mouse.t => unit"); - ("onDragEnter", "ReactEvent.Mouse.t => unit"); - ("onDragExit", "ReactEvent.Mouse.t => unit"); - ("onDragLeave", "ReactEvent.Mouse.t => unit"); - ("onDragOver", "ReactEvent.Mouse.t => unit"); - ("onDragStart", "ReactEvent.Mouse.t => unit"); - ("onDrop", "ReactEvent.Mouse.t => unit"); - ("onMouseDown", "ReactEvent.Mouse.t => unit"); - ("onMouseEnter", "ReactEvent.Mouse.t => unit"); - ("onMouseLeave", "ReactEvent.Mouse.t => unit"); - ("onMouseMove", "ReactEvent.Mouse.t => unit"); - ("onMouseOut", "ReactEvent.Mouse.t => unit"); - ("onMouseOver", "ReactEvent.Mouse.t => unit"); - ("onMouseUp", "ReactEvent.Mouse.t => unit"); - ("onSelect", "ReactEvent.Selection.t => unit"); - ("onTouchCancel", "ReactEvent.Touch.t => unit"); - ("onTouchEnd", "ReactEvent.Touch.t => unit"); - ("onTouchMove", "ReactEvent.Touch.t => unit"); - ("onTouchStart", "ReactEvent.Touch.t => unit"); - ("onPointerOver", "ReactEvent.Pointer.t => unit"); - ("onPointerEnter", "ReactEvent.Pointer.t => unit"); - ("onPointerDown", "ReactEvent.Pointer.t => unit"); - ("onPointerMove", "ReactEvent.Pointer.t => unit"); - ("onPointerUp", "ReactEvent.Pointer.t => unit"); - ("onPointerCancel", "ReactEvent.Pointer.t => unit"); - ("onPointerOut", "ReactEvent.Pointer.t => unit"); - ("onPointerLeave", "ReactEvent.Pointer.t => unit"); - ("onGotPointerCapture", "ReactEvent.Pointer.t => unit"); - ("onLostPointerCapture", "ReactEvent.Pointer.t => unit"); - ("onScroll", "ReactEvent.UI.t => unit"); - ("onWheel", "ReactEvent.Wheel.t => unit"); - ("onAbort", "ReactEvent.Media.t => unit"); - ("onCanPlay", "ReactEvent.Media.t => unit"); - ("onCanPlayThrough", "ReactEvent.Media.t => unit"); - ("onDurationChange", "ReactEvent.Media.t => unit"); - ("onEmptied", "ReactEvent.Media.t => unit"); - ("onEncrypetd", "ReactEvent.Media.t => unit"); - ("onEnded", "ReactEvent.Media.t => unit"); - ("onError", "ReactEvent.Media.t => unit"); - ("onLoadedData", "ReactEvent.Media.t => unit"); - ("onLoadedMetadata", "ReactEvent.Media.t => unit"); - ("onLoadStart", "ReactEvent.Media.t => unit"); - ("onPause", "ReactEvent.Media.t => unit"); - ("onPlay", "ReactEvent.Media.t => unit"); - ("onPlaying", "ReactEvent.Media.t => unit"); - ("onProgress", "ReactEvent.Media.t => unit"); - ("onRateChange", "ReactEvent.Media.t => unit"); - ("onSeeked", "ReactEvent.Media.t => unit"); - ("onSeeking", "ReactEvent.Media.t => unit"); - ("onStalled", "ReactEvent.Media.t => unit"); - ("onSuspend", "ReactEvent.Media.t => unit"); - ("onTimeUpdate", "ReactEvent.Media.t => unit"); - ("onVolumeChange", "ReactEvent.Media.t => unit"); - ("onWaiting", "ReactEvent.Media.t => unit"); - ("onAnimationStart", "ReactEvent.Animation.t => unit"); - ("onAnimationEnd", "ReactEvent.Animation.t => unit"); - ("onAnimationIteration", "ReactEvent.Animation.t => unit"); - ("onTransitionEnd", "ReactEvent.Transition.t => unit"); - ("accentHeight", string); - ("accumulate", string); - ("additive", string); - ("alignmentBaseline", string); - ("allowReorder", string); - ("alphabetic", string); - ("amplitude", string); - ("arabicForm", string); - ("ascent", string); - ("attributeName", string); - ("attributeType", string); - ("autoReverse", string); - ("azimuth", string); - ("baseFrequency", string); - ("baseProfile", string); - ("baselineShift", string); - ("bbox", string); - ("bias", string); - ("by", string); - ("calcMode", string); - ("capHeight", string); - ("clip", string); - ("clipPath", string); - ("clipPathUnits", string); - ("clipRule", string); - ("colorInterpolation", string); - ("colorInterpolationFilters", string); - ("colorProfile", string); - ("colorRendering", string); - ("contentScriptType", string); - ("contentStyleType", string); - ("cursor", string); - ("cx", string); - ("cy", string); - ("d", string); - ("decelerate", string); - ("descent", string); - ("diffuseConstant", string); - ("direction", string); - ("display", string); - ("divisor", string); - ("dominantBaseline", string); - ("dur", string); - ("dx", string); - ("dy", string); - ("edgeMode", string); - ("elevation", string); - ("enableBackground", string); - ("exponent", string); - ("externalResourcesRequired", string); - ("fill", string); - ("fillOpacity", string); - ("fillRule", string); - ("filter", string); - ("filterRes", string); - ("filterUnits", string); - ("floodColor", string); - ("floodOpacity", string); - ("focusable", string); - ("fontFamily", string); - ("fontSize", string); - ("fontSizeAdjust", string); - ("fontStretch", string); - ("fontStyle", string); - ("fontVariant", string); - ("fontWeight", string); - ("fomat", string); - ("from", string); - ("fx", string); - ("fy", string); - ("g1", string); - ("g2", string); - ("glyphName", string); - ("glyphOrientationHorizontal", string); - ("glyphOrientationVertical", string); - ("glyphRef", string); - ("gradientTransform", string); - ("gradientUnits", string); - ("hanging", string); - ("horizAdvX", string); - ("horizOriginX", string); - ("ideographic", string); - ("imageRendering", string); - ("in2", string); - ("intercept", string); - ("k", string); - ("k1", string); - ("k2", string); - ("k3", string); - ("k4", string); - ("kernelMatrix", string); - ("kernelUnitLength", string); - ("kerning", string); - ("keyPoints", string); - ("keySplines", string); - ("keyTimes", string); - ("lengthAdjust", string); - ("letterSpacing", string); - ("lightingColor", string); - ("limitingConeAngle", string); - ("local", string); - ("markerEnd", string); - ("markerHeight", string); - ("markerMid", string); - ("markerStart", string); - ("markerUnits", string); - ("markerWidth", string); - ("mask", string); - ("maskContentUnits", string); - ("maskUnits", string); - ("mathematical", string); - ("mode", string); - ("numOctaves", string); - ("offset", string); - ("opacity", string); - ("operator", string); - ("order", string); - ("orient", string); - ("orientation", string); - ("origin", string); - ("overflow", string); - ("overflowX", string); - ("overflowY", string); - ("overlinePosition", string); - ("overlineThickness", string); - ("paintOrder", string); - ("panose1", string); - ("pathLength", string); - ("patternContentUnits", string); - ("patternTransform", string); - ("patternUnits", string); - ("pointerEvents", string); - ("points", string); - ("pointsAtX", string); - ("pointsAtY", string); - ("pointsAtZ", string); - ("preserveAlpha", string); - ("preserveAspectRatio", string); - ("primitiveUnits", string); - ("r", string); - ("radius", string); - ("refX", string); - ("refY", string); - ("renderingIntent", string); - ("repeatCount", string); - ("repeatDur", string); - ("requiredExtensions", string); - ("requiredFeatures", string); - ("restart", string); - ("result", string); - ("rotate", string); - ("rx", string); - ("ry", string); - ("scale", string); - ("seed", string); - ("shapeRendering", string); - ("slope", string); - ("spacing", string); - ("specularConstant", string); - ("specularExponent", string); - ("speed", string); - ("spreadMethod", string); - ("startOffset", string); - ("stdDeviation", string); - ("stemh", string); - ("stemv", string); - ("stitchTiles", string); - ("stopColor", string); - ("stopOpacity", string); - ("strikethroughPosition", string); - ("strikethroughThickness", string); - (string, string); - ("stroke", string); - ("strokeDasharray", string); - ("strokeDashoffset", string); - ("strokeLinecap", string); - ("strokeLinejoin", string); - ("strokeMiterlimit", string); - ("strokeOpacity", string); - ("strokeWidth", string); - ("surfaceScale", string); - ("systemLanguage", string); - ("tableValues", string); - ("targetX", string); - ("targetY", string); - ("textAnchor", string); - ("textDecoration", string); - ("textLength", string); - ("textRendering", string); - ("transform", string); - ("u1", string); - ("u2", string); - ("underlinePosition", string); - ("underlineThickness", string); - ("unicode", string); - ("unicodeBidi", string); - ("unicodeRange", string); - ("unitsPerEm", string); - ("vAlphabetic", string); - ("vHanging", string); - ("vIdeographic", string); - ("vMathematical", string); - ("values", string); - ("vectorEffect", string); - ("version", string); - ("vertAdvX", string); - ("vertAdvY", string); - ("vertOriginX", string); - ("vertOriginY", string); - ("viewBox", string); - ("viewTarget", string); - ("visibility", string); - ("widths", string); - ("wordSpacing", string); - ("writingMode", string); - ("x", string); - ("x1", string); - ("x2", string); - ("xChannelSelector", string); - ("xHeight", string); - ("xlinkActuate", string); - ("xlinkArcrole", string); - ("xlinkHref", string); - ("xlinkRole", string); - ("xlinkShow", string); - ("xlinkTitle", string); - ("xlinkType", string); - ("xmlns", string); - ("xmlnsXlink", string); - ("xmlBase", string); - ("xmlLang", string); - ("xmlSpace", string); - ("y", string); - ("y1", string); - ("y2", string); - ("yChannelSelector", string); - ("z", string); - ("zoomAndPan", string); - ("about", string); - ("datatype", string); - ("inlist", string); - ("prefix", string); - ("property", string); - ("resource", string); - ("typeof", string); - ("vocab", string); - ("dangerouslySetInnerHTML", "{\"__html\": string}"); - ("suppressContentEditableWarning", bool); - ] - let showConstructor {Constructor.cname = {txt}; args; res} = txt ^ (match args with @@ -542,15 +55,12 @@ let resolveOpens ~env opens ~package = (* loop(previous) *) [] opens -let checkName name ~prefix ~exact = - if exact then name = prefix else Utils.startsWith name prefix - let completionForExporteds iterExported getDeclared ~prefix ~exact ~env ~namesUsed transformContents = let res = ref [] in iterExported (fun name stamp -> (* Log.log("checking exported: " ++ name); *) - if checkName name ~prefix ~exact then + if Utils.checkName name ~prefix ~exact then match getDeclared stamp with | Some (declared : _ Declared.t) when not (Hashtbl.mem namesUsed declared.name.txt) -> @@ -591,7 +101,7 @@ let completionsForExportedConstructors ~(env : QueryEnv.t) ~prefix ~exact res := (constructors |> List.filter (fun c -> - checkName c.Constructor.cname.txt ~prefix ~exact) + Utils.checkName c.Constructor.cname.txt ~prefix ~exact) |> Utils.filterMap (fun c -> let name = c.Constructor.cname.txt in if not (Hashtbl.mem namesUsed name) then @@ -613,7 +123,7 @@ let completionForExportedFields ~(env : QueryEnv.t) ~prefix ~exact ~namesUsed = | Some ({item = {kind = Record fields}} as t) -> res := (fields - |> List.filter (fun f -> checkName f.fname.txt ~prefix ~exact) + |> List.filter (fun f -> Utils.checkName f.fname.txt ~prefix ~exact) |> Utils.filterMap (fun f -> let name = f.fname.txt in if not (Hashtbl.mem namesUsed name) then @@ -739,61 +249,9 @@ let findAllCompletions ~(env : QueryEnv.t) ~prefix ~exact ~namesUsed completionForExportedFields ~env ~prefix ~exact ~namesUsed @ completionForExportedModules ~env ~prefix ~exact ~namesUsed -module LocalTables = struct - type 'a table = (string * (int * int), 'a Declared.t) Hashtbl.t - type namesUsed = (string, unit) Hashtbl.t - - type t = { - namesUsed: namesUsed; - mutable resultRev: Completion.t list; - constructorTable: Constructor.t table; - modulesTable: Module.t table; - typesTable: Type.t table; - valueTable: Types.type_expr table; - } - - let create () = - { - namesUsed = Hashtbl.create 1; - resultRev = []; - constructorTable = Hashtbl.create 1; - modulesTable = Hashtbl.create 1; - typesTable = Hashtbl.create 1; - valueTable = Hashtbl.create 1; - } - - let populateValues ~env localTables = - env.QueryEnv.file.stamps - |> Stamps.iterValues (fun _ declared -> - Hashtbl.replace localTables.valueTable - (declared.name.txt, declared.extentLoc |> Loc.start) - declared) - - let populateConstructors ~env localTables = - env.QueryEnv.file.stamps - |> Stamps.iterConstructors (fun _ declared -> - Hashtbl.replace localTables.constructorTable - (declared.name.txt, declared.extentLoc |> Loc.start) - declared) - - let populateTypes ~env localTables = - env.QueryEnv.file.stamps - |> Stamps.iterTypes (fun _ declared -> - Hashtbl.replace localTables.typesTable - (declared.name.txt, declared.name.loc |> Loc.start) - declared) - - let populateModules ~env localTables = - env.QueryEnv.file.stamps - |> Stamps.iterModules (fun _ declared -> - Hashtbl.replace localTables.modulesTable - (declared.name.txt, declared.extentLoc |> Loc.start) - declared) -end - let processLocalValue name loc ~prefix ~exact ~env ~(localTables : LocalTables.t) = - if checkName name ~prefix ~exact then + if Utils.checkName name ~prefix ~exact then match Hashtbl.find_opt localTables.valueTable (name, Loc.start loc) with | Some declared -> if not (Hashtbl.mem localTables.namesUsed name) then ( @@ -821,7 +279,7 @@ let processLocalValue name loc ~prefix ~exact ~env let processLocalConstructor name loc ~prefix ~exact ~env ~(localTables : LocalTables.t) = - if checkName name ~prefix ~exact then + if Utils.checkName name ~prefix ~exact then match Hashtbl.find_opt localTables.constructorTable (name, Loc.start loc) with @@ -848,7 +306,7 @@ let processLocalConstructor name loc ~prefix ~exact ~env let processLocalType name loc ~prefix ~exact ~env ~(localTables : LocalTables.t) = - if checkName name ~prefix ~exact then + if Utils.checkName name ~prefix ~exact then match Hashtbl.find_opt localTables.typesTable (name, Loc.start loc) with | Some declared -> if not (Hashtbl.mem localTables.namesUsed name) then ( @@ -868,7 +326,7 @@ let processLocalType name loc ~prefix ~exact ~env ~(localTables : LocalTables.t) let processLocalModule name loc ~prefix ~exact ~env ~(localTables : LocalTables.t) = - if checkName name ~prefix ~exact then + if Utils.checkName name ~prefix ~exact then match Hashtbl.find_opt localTables.modulesTable (name, Loc.start loc) with | Some declared -> if not (Hashtbl.mem localTables.namesUsed name) then ( @@ -1013,113 +471,6 @@ let findLocalCompletionsWithOpens ~pos ~(env : QueryEnv.t) ~prefix ~exact ~opens (* There's no local completion for fields *) [] -let instantiateType ~typeParams ~typeArgs (t : Types.type_expr) = - if typeParams = [] || typeArgs = [] then t - else - let rec applySub tp ta t = - match (tp, ta) with - | t1 :: tRest1, t2 :: tRest2 -> - if t1 = t then t2 else applySub tRest1 tRest2 t - | [], _ | _, [] -> t - in - let rec loop (t : Types.type_expr) = - match t.desc with - | Tlink t -> loop t - | Tvar _ -> applySub typeParams typeArgs t - | Tunivar _ -> t - | Tconstr (path, args, memo) -> - {t with desc = Tconstr (path, args |> List.map loop, memo)} - | Tsubst t -> loop t - | Tvariant rd -> {t with desc = Tvariant (rowDesc rd)} - | Tnil -> t - | Tarrow (lbl, t1, t2, c) -> - {t with desc = Tarrow (lbl, loop t1, loop t2, c)} - | Ttuple tl -> {t with desc = Ttuple (tl |> List.map loop)} - | Tobject (t, r) -> {t with desc = Tobject (loop t, r)} - | Tfield (n, k, t1, t2) -> {t with desc = Tfield (n, k, loop t1, loop t2)} - | Tpoly (t, []) -> loop t - | Tpoly (t, tl) -> {t with desc = Tpoly (loop t, tl |> List.map loop)} - | Tpackage (p, l, tl) -> - {t with desc = Tpackage (p, l, tl |> List.map loop)} - and rowDesc (rd : Types.row_desc) = - let row_fields = - rd.row_fields |> List.map (fun (l, rf) -> (l, rowField rf)) - in - let row_more = loop rd.row_more in - let row_name = - match rd.row_name with - | None -> None - | Some (p, tl) -> Some (p, tl |> List.map loop) - in - {rd with row_fields; row_more; row_name} - and rowField (rf : Types.row_field) = - match rf with - | Rpresent None -> rf - | Rpresent (Some t) -> Rpresent (Some (loop t)) - | Reither (b1, tl, b2, r) -> Reither (b1, tl |> List.map loop, b2, r) - | Rabsent -> Rabsent - in - loop t - -let rec extractRecordType ~env ~package (t : Types.type_expr) = - match t.desc with - | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractRecordType ~env ~package t1 - | Tconstr (path, typeArgs, _) -> ( - match References.digConstructor ~env ~package path with - | Some (env, ({item = {kind = Record fields}} as typ)) -> - let typeParams = typ.item.decl.type_params in - let fields = - fields - |> List.map (fun field -> - let fieldTyp = - field.typ |> instantiateType ~typeParams ~typeArgs - in - {field with typ = fieldTyp}) - in - Some (env, fields, typ) - | Some - ( env, - {item = {decl = {type_manifest = Some t1; type_params = typeParams}}} - ) -> - let t1 = t1 |> instantiateType ~typeParams ~typeArgs in - extractRecordType ~env ~package t1 - | _ -> None) - | _ -> None - -let rec extractObjectType ~env ~package (t : Types.type_expr) = - match t.desc with - | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractObjectType ~env ~package t1 - | Tobject (tObj, _) -> Some (env, tObj) - | Tconstr (path, typeArgs, _) -> ( - match References.digConstructor ~env ~package path with - | Some - ( env, - {item = {decl = {type_manifest = Some t1; type_params = typeParams}}} - ) -> - let t1 = t1 |> instantiateType ~typeParams ~typeArgs in - extractObjectType ~env ~package t1 - | _ -> None) - | _ -> None - -let extractFunctionType ~env ~package typ = - let rec loop ~env acc (t : Types.type_expr) = - match t.desc with - | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> loop ~env acc t1 - | Tarrow (label, tArg, tRet, _) -> loop ~env ((label, tArg) :: acc) tRet - | Tconstr (path, typeArgs, _) -> ( - match References.digConstructor ~env ~package path with - | Some - ( env, - { - item = {decl = {type_manifest = Some t1; type_params = typeParams}}; - } ) -> - let t1 = t1 |> instantiateType ~typeParams ~typeArgs in - loop ~env acc t1 - | _ -> (List.rev acc, t)) - | _ -> (List.rev acc, t) - in - loop ~env [] typ - let getComplementaryCompletionsForTypedValue ~opens ~allFiles ~scope ~env prefix = let exact = false in @@ -1131,7 +482,7 @@ let getComplementaryCompletionsForTypedValue ~opens ~allFiles ~scope ~env prefix allFiles |> FileSet.elements |> Utils.filterMap (fun name -> if - checkName name ~prefix ~exact + Utils.checkName name ~prefix ~exact && not (* TODO complete the namespaced name too *) (String.contains name '-') @@ -1155,7 +506,7 @@ let getCompletionsForPath ~package ~opens ~allFiles ~pos ~exact ~scope allFiles |> FileSet.elements |> Utils.filterMap (fun name -> if - checkName name ~prefix ~exact + Utils.checkName name ~prefix ~exact && not (* TODO complete the namespaced name too *) (String.contains name '-') @@ -1228,119 +579,6 @@ let completionsGetTypeEnv = function | {Completion.kind = Field ({typ}, _); env} :: _ -> Some (typ, env) | _ -> None -let findReturnTypeOfFunctionAtLoc loc ~(env : QueryEnv.t) ~full ~debug = - match References.getLocItem ~full ~pos:(loc |> Loc.end_) ~debug with - | Some {locType = Typed (_, typExpr, _)} -> ( - match extractFunctionType ~env ~package:full.package typExpr with - | args, tRet when args <> [] -> Some tRet - | _ -> None) - | _ -> None - -let getJsxLabels ~componentPath ~findTypeOfValue ~package = - match componentPath @ ["make"] |> findTypeOfValue with - | Some (typ, make_env) -> - let rec getFieldsV3 (texp : Types.type_expr) = - match texp.desc with - | Tfield (name, _, t1, t2) -> - let fields = t2 |> getFieldsV3 in - if name = "children" then fields else (name, t1, make_env) :: fields - | Tlink te | Tsubst te | Tpoly (te, []) -> te |> getFieldsV3 - | Tvar None -> [] - | _ -> [] - in - let getFieldsV4 ~path ~typeArgs = - match References.digConstructor ~env:make_env ~package path with - | Some - ( env, - { - item = - { - decl = - { - type_kind = Type_record (labelDecls, _repr); - type_params = typeParams; - }; - }; - } ) -> - labelDecls - |> List.map (fun (ld : Types.label_declaration) -> - let name = Ident.name ld.ld_id in - let t = ld.ld_type |> instantiateType ~typeParams ~typeArgs in - (name, t, env)) - | _ -> [] - in - let rec getLabels (t : Types.type_expr) = - match t.desc with - | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> getLabels t1 - | Tarrow - ( Nolabel, - { - desc = - ( Tconstr (* Js.t *) (_, [{desc = Tobject (tObj, _)}], _) - | Tobject (tObj, _) ); - }, - _, - _ ) -> - (* JSX V3 *) - getFieldsV3 tObj - | Tarrow (Nolabel, {desc = Tconstr (path, typeArgs, _)}, _, _) - when Path.last path = "props" -> - (* JSX V4 *) - getFieldsV4 ~path ~typeArgs - | Tconstr - ( clPath, - [ - { - desc = - ( Tconstr (* Js.t *) (_, [{desc = Tobject (tObj, _)}], _) - | Tobject (tObj, _) ); - }; - _; - ], - _ ) - when Path.name clPath = "React.componentLike" -> - (* JSX V3 external or interface *) - getFieldsV3 tObj - | Tconstr (clPath, [{desc = Tconstr (path, typeArgs, _)}; _], _) - when Path.name clPath = "React.componentLike" - && Path.last path = "props" -> - (* JSX V4 external or interface *) - getFieldsV4 ~path ~typeArgs - | _ -> [] - in - typ |> getLabels - | None -> [] - -let getArgs ~env (t : Types.type_expr) ~full = - let rec getArgsLoop ~env (t : Types.type_expr) ~full ~currentArgumentPosition - = - match t.desc with - | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> - getArgsLoop ~full ~env ~currentArgumentPosition t1 - | Tarrow (Labelled l, tArg, tRet, _) -> - (SharedTypes.Completable.Labelled l, tArg) - :: getArgsLoop ~full ~env ~currentArgumentPosition tRet - | Tarrow (Optional l, tArg, tRet, _) -> - (Optional l, tArg) :: getArgsLoop ~full ~env ~currentArgumentPosition tRet - | Tarrow (Nolabel, tArg, tRet, _) -> - (Unlabelled {argumentPosition = currentArgumentPosition}, tArg) - :: getArgsLoop ~full ~env - ~currentArgumentPosition:(currentArgumentPosition + 1) - tRet - | Tconstr (path, typeArgs, _) -> ( - match References.digConstructor ~env ~package:full.package path with - | Some - ( env, - { - item = {decl = {type_manifest = Some t1; type_params = typeParams}}; - } ) -> - let t1 = t1 |> instantiateType ~typeParams ~typeArgs in - getArgsLoop ~full ~env ~currentArgumentPosition t1 - | _ -> []) - | _ -> [] - in - t |> getArgsLoop ~env ~full ~currentArgumentPosition:0 - let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env ~exact ~scope (contextPath : Completable.contextPath) = let package = full.package in @@ -1411,7 +649,7 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env | [], [(Nolabel | Labelled _ | Optional _)] -> (* should not happen, but just ignore extra arguments *) [] in - match extractFunctionType ~env ~package typ with + match TypeUtils.extractFunctionType ~env ~package typ with | args, tRet when args <> [] -> let args = processApply args labels in let retType = reconstructFunctionType args tRet in @@ -1431,11 +669,11 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env |> completionsGetTypeEnv with | Some (typ, env) -> ( - match typ |> extractRecordType ~env ~package with + match typ |> TypeUtils.extractRecordType ~env ~package with | Some (env, fields, typDecl) -> fields |> Utils.filterMap (fun field -> - if checkName field.fname.txt ~prefix:fieldName ~exact then + if Utils.checkName field.fname.txt ~prefix:fieldName ~exact then Some (Completion.create field.fname.txt ~env ~docstring:field.docstring @@ -1455,7 +693,7 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env |> completionsGetTypeEnv with | Some (typ, env) -> ( - match typ |> extractObjectType ~env ~package with + match typ |> TypeUtils.extractObjectType ~env ~package with | Some (env, tObj) -> let rec getFields (texp : Types.type_expr) = match texp.desc with @@ -1468,7 +706,7 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env in tObj |> getFields |> Utils.filterMap (fun (field, typ) -> - if checkName field ~prefix:label ~exact then + if Utils.checkName field ~prefix:label ~exact then Some (Completion.create field ~env ~kind:(Completion.ObjLabel typ)) else None) @@ -1490,7 +728,8 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env match typ with | {Types.desc = Tvar _} -> ( match - findReturnTypeOfFunctionAtLoc lhsLoc ~env ~full ~debug:false + TypeUtils.findReturnTypeOfFunctionAtLoc lhsLoc ~env ~full + ~debug:false with | None -> typ | Some typFromLoc -> typFromLoc) @@ -1620,7 +859,7 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env in match forJsxCompletion with | Some builtinNameToComplete - when checkName builtinNameToComplete ~prefix:funNamePrefix + when Utils.checkName builtinNameToComplete ~prefix:funNamePrefix ~exact:false -> [ Completion.createWithSnippet @@ -1664,7 +903,8 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env |> completionsGetTypeEnv in let targetLabel = - getJsxLabels ~componentPath:pathToComponent ~findTypeOfValue ~package + CompletionJsx.getJsxLabels ~componentPath:pathToComponent ~findTypeOfValue + ~package |> List.find_opt (fun (label, _, _) -> label = propName) in match targetLabel with @@ -1682,7 +922,7 @@ let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env ~env ~exact:true ~scope |> completionsGetTypeEnv with - | Some (typ, env) -> (typ |> getArgs ~full ~env, env) + | Some (typ, env) -> (typ |> TypeUtils.getArgs ~full ~env, env) | None -> ([], env) in let targetLabel = @@ -1736,47 +976,6 @@ let getOpens ~debug ~rawOpens ~package ~env = (* Last open takes priority *) List.rev resolvedOpens -(** Pulls out a type we can complete from a type expr. *) -let rec extractType ~env ~package (t : Types.type_expr) = - match t.desc with - | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractType ~env ~package t1 - | Tconstr (Path.Pident {name = "option"}, [payloadTypeExpr], _) -> - Some (Completable.Toption (env, payloadTypeExpr)) - | Tconstr (Path.Pident {name = "array"}, [payloadTypeExpr], _) -> - Some (Tarray (env, payloadTypeExpr)) - | Tconstr (Path.Pident {name = "bool"}, [], _) -> Some (Tbool env) - | Tconstr (Path.Pident {name = "string"}, [], _) -> Some (Tstring env) - | Tconstr (path, _, _) -> ( - match References.digConstructor ~env ~package path with - | Some (env, {item = {decl = {type_manifest = Some t1}}}) -> - extractType ~env ~package t1 - | Some (env, {name; item = {decl; kind = Type.Variant constructors}}) -> - Some - (Tvariant - {env; constructors; variantName = name.txt; variantDecl = decl}) - | Some (env, {item = {kind = Record fields}}) -> - Some (Trecord {env; fields; typeExpr = t}) - | _ -> None) - | Ttuple expressions -> Some (Tuple (env, expressions, t)) - | Tvariant {row_fields} -> - let constructors = - row_fields - |> List.map (fun (label, field) -> - { - name = label; - args = - (* Multiple arguments are represented as a Ttuple, while a single argument is just the type expression itself. *) - (match field with - | Types.Rpresent (Some typeExpr) -> ( - match typeExpr.desc with - | Ttuple args -> args - | _ -> [typeExpr]) - | _ -> []); - }) - in - Some (Tpolyvariant {env; constructors; typeExpr = t}) - | _ -> None - let filterItems items ~prefix = if prefix = "" then items else @@ -1797,7 +996,7 @@ let rec completeTypedValue (t : SharedTypes.completionType) ~env ~full ~prefix ~completionContext = let extractedType = match t with - | TypeExpr t -> t |> extractType ~env ~package:full.package + | TypeExpr t -> t |> TypeUtils.extractType ~env ~package:full.package | InlineRecord fields -> Some (TinlineRecord {env; fields}) in match extractedType with @@ -1940,69 +1139,6 @@ let rec completeTypedValue (t : SharedTypes.completionType) ~env ~full ~prefix else [] | _ -> [] -(** This moves through a nested path via a set of instructions, trying to resolve the type at the end of the path. *) -let rec resolveNested (typ : completionType) ~env ~package ~nested = - match nested with - | [] -> Some (typ, env, None) - | patternPath :: nested -> ( - let extractedType = - match typ with - | TypeExpr typ -> typ |> extractType ~env ~package - | InlineRecord fields -> Some (TinlineRecord {env; fields}) - in - match (patternPath, extractedType) with - | Completable.NTupleItem {itemNum}, Some (Tuple (env, tupleItems, _)) -> ( - match List.nth_opt tupleItems itemNum with - | None -> None - | Some typ -> TypeExpr typ |> resolveNested ~env ~package ~nested) - | ( NFollowRecordField {fieldName}, - Some (TinlineRecord {env; fields} | Trecord {env; fields}) ) -> ( - match - fields - |> List.find_opt (fun (field : field) -> field.fname.txt = fieldName) - with - | None -> None - | Some {typ; optional} -> - let typ = if optional then Utils.unwrapIfOption typ else typ in - TypeExpr typ |> resolveNested ~env ~package ~nested) - | NRecordBody {seenFields}, Some (Trecord {env; typeExpr}) -> - Some (TypeExpr typeExpr, env, Some (Completable.RecordField {seenFields})) - | NRecordBody {seenFields}, Some (TinlineRecord {env; fields}) -> - Some - (InlineRecord fields, env, Some (Completable.RecordField {seenFields})) - | ( NVariantPayload {constructorName = "Some"; itemNum = 0}, - Some (Toption (env, typ)) ) -> - TypeExpr typ |> resolveNested ~env ~package ~nested - | ( NVariantPayload {constructorName; itemNum}, - Some (Tvariant {env; constructors}) ) -> ( - match - constructors - |> List.find_opt (fun (c : Constructor.t) -> - c.cname.txt = constructorName) - with - | Some {args = Args args} -> ( - match List.nth_opt args itemNum with - | None -> None - | Some (typ, _) -> TypeExpr typ |> resolveNested ~env ~package ~nested) - | Some {args = InlineRecord fields} when itemNum = 0 -> - InlineRecord fields |> resolveNested ~env ~package ~nested - | _ -> None) - | ( NPolyvariantPayload {constructorName; itemNum}, - Some (Tpolyvariant {env; constructors}) ) -> ( - match - constructors - |> List.find_opt (fun (c : polyVariantConstructor) -> - c.name = constructorName) - with - | None -> None - | Some constructor -> ( - match List.nth_opt constructor.args itemNum with - | None -> None - | Some typ -> TypeExpr typ |> resolveNested ~env ~package ~nested)) - | NArray, Some (Tarray (env, typ)) -> - TypeExpr typ |> resolveNested ~env ~package ~nested - | _ -> None) - let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover (completable : Completable.t) = let package = full.package in @@ -2029,14 +1165,16 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover let keyLabels = if Utils.startsWith "key" prefix then [mkLabel ("key", "string")] else [] in - (domLabels + (CompletionJsx.domLabels |> List.filter (fun (name, _t) -> Utils.startsWith name prefix && (forHover || not (List.mem name identsSeen))) |> List.map mkLabel) @ keyLabels | Cjsx (componentPath, prefix, identsSeen) -> - let labels = getJsxLabels ~componentPath ~findTypeOfValue ~package in + let labels = + CompletionJsx.getJsxLabels ~componentPath ~findTypeOfValue ~package + in let mkLabel_ name typString = Completion.create name ~kind:(Label typString) ~env in @@ -2059,228 +1197,7 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover let mkDecorator (name, docstring) = {(Completion.create name ~kind:(Label "") ~env) with docstring} in - [ - ( "as", - [ - {|The `@as` decorator is commonly used on record types to alias record field names to a different JavaScript attribute name. - -This is useful to map to JavaScript attribute names that cannot be expressed in ReScript (such as keywords). - -It is also possible to map a ReScript record to a JavaScript array by passing indices to the `@as` decorator. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#as-decorator).|}; - ] ); - ( "dead", - [ - {|The `@dead` decorator is for reanalyze, a static analysis tool for ReScript that can do dead code analysis. - -`@dead` suppresses reporting on the value/type, but can also be used to force the analysis to consider a value as dead. Typically used to acknowledge cases of dead code you are not planning to address right now, but can be searched easily later. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#dead-decorator). - -> Hint: Did you know you can run an interactive code analysis in your project by running the command `> ReScript: Start Code Analyzer`? Try it!|}; - ] ); - ( "deriving", - [ - {|When the `@deriving` decorator is applied to a record type, it expands the type into a factory function plus a set of getter/setter functions for its fields. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#deriving-decorator).|}; - ] ); - ( "deprecated", - [ - {|The `@deprecated` decorator is used to add deprecation notes to types, values and submodules. The compiler and editor tooling will yield a warning whenever a deprecated entity is being used. - -Alternatively, use the `@@deprecated` decorator to add a deprecation warning to the file level. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#expression-deprecated-decorator).|}; - ] ); - ( "doesNotRaise", - [ - {|The `@doesNotRaise` decorator is for reanalyze, a static analysis tool for ReScript that can perform exception analysis. - -`@doesNotRaise` is uses to override the analysis and state that an expression does not raise any exceptions, -even though the analysis reports otherwise. This can happen for example in the case of array access where -the analysis does not perform range checks but takes a conservative stance that any access -could potentially raise. -[Read more and see examples in the documentation](https://github.com/rescript-association/reanalyze/blob/master/EXCEPTION.md). -> Hint: Did you know you can run an interactive code analysis in your project by running the command `> ReScript: Start Code Analyzer`? Try it!|}; - ] ); - ( "genType", - [ - {|The @genType decorator may be used to export ReScript values and types to JavaScript, and import JavaScript values and types into ReScript. It allows seamless integration of compiled ReScript modules in existing TypeScript, Flow, or plain JavaScript codebases, without loosing type information across different type systems. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#gentype-decorator).|}; - ] ); - ( "genType.as", - [ - {|The @genType decorator may be used to export ReScript values and types to JavaScript, and import JavaScript values and types into ReScript. It allows seamless integration of compiled ReScript modules in existing TypeScript, Flow, or plain JavaScript codebases, without loosing type information across different type systems. - -[Read more and see examples in the documentation](https://rescript-lang.org/docs/gentype/latest/usage).|}; - ] ); - ( "genType.import", - [ - {|The @genType decorator may be used to export ReScript values and types to JavaScript, and import JavaScript values and types into ReScript. It allows seamless integration of compiled ReScript modules in existing TypeScript, Flow, or plain JavaScript codebases, without loosing type information across different type systems. - -[Read more and see examples in the documentation](https://rescript-lang.org/docs/gentype/latest/usage).|}; - ] ); - ( "genType.opaque", - [ - {|The @genType decorator may be used to export ReScript values and types to JavaScript, and import JavaScript values and types into ReScript. It allows seamless integration of compiled ReScript modules in existing TypeScript, Flow, or plain JavaScript codebases, without loosing type information across different type systems. - -[Read more and see examples in the documentation](https://rescript-lang.org/docs/gentype/latest/usage).|}; - ] ); - ( "get", - [ - {|The `@get` decorator is used to bind to a property of an object. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#get-decorator).|}; - ] ); - ( "get_index", - [ - {|The `@get_index` decorator is used to access a dynamic property on an object, or an index of an array. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#get-index-decorator).|}; - ] ); - ( "inline", - [ - {|The `@inline` decorator tells the compiler to inline its value in every place the binding is being used, rather than use a variable. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#inline-decorator).|}; - ] ); - ( "int", - [ - {|The `@int` decorator can be used with polymorphic variants and the @as decorator on externals to modify the compiled JavaScript to use integers for the values instead of strings. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#int-decorator).|}; - ] ); - ( "live", - [ - {|The `@live` decorator is for reanalyze, a static analysis tool for ReScript that can do dead code analysis. - -`@live` tells the dead code analysis that the value should be considered live, even though it might appear to be dead. This is typically used in case of FFI where there are indirect ways to access values. It can be added to everything that could otherwise be considered unused by the dead code analysis - values, functions, arguments, records, individual record fields, and so on. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#live-decorator). - -Hint: Did you know you can run an interactive code analysis in your project by running the command `> ReScript: Start Code Analyzer`? Try it!|}; - ] ); - ( "meth", - [ - {|The `@meth` decorator is used to call a function on a JavaScript object, and avoid issues with currying. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#meth-decorator).|}; - ] ); - ( "module", - [ - {|The `@module` decorator is used to bind to a JavaScript module. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#module-decorator).|}; - ] ); - ( "new", - [ - {| -The `@new` decorator is used whenever you need to bind to a JavaScript class constructor that requires the new keword for instantiation.| - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#new-decorator).|}; - ] ); - ( "obj", - [ - {|The `@obj` decorator is used to create functions that return JavaScript objects with properties that match the function's parameter labels. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#obj-decorator).|}; - ] ); - ( "raises", - [ - {|The `@raises` decorator is for reanalyze, a static analysis tool for ReScript that can perform exception analysis. - -`@raises` acknowledges that a function can raise exceptions that are not caught, and suppresses -a warning in that case. Callers of the functions are then subjected to the same rule. -Example `@raises(Exn)` or `@raises([E1, E2, E3])` for multiple exceptions. -[Read more and see examples in the documentation](https://github.com/rescript-association/reanalyze/blob/master/EXCEPTION.md). -> Hint: Did you know you can run an interactive code analysis in your project by running the command `> ReScript: Start Code Analyzer`? Try it!|}; - ] ); - ( "react.component", - [ - {|The `@react.component` decorator is used to annotate functions that are RescriptReact components. - -You will need this decorator whenever you want to use a ReScript / React component in ReScript JSX expressions. - -Note: The `@react.component` decorator requires the react-jsx config to be set in your `bsconfig.json` to enable the required React transformations. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#react-component-decorator).|}; - ] ); - ( "return", - [ - {|The `@return` decorator is used to control how `null` and `undefined` values are converted to option types in ReScript. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#return-decorator).|}; - ] ); - ( "scope", - [ - {|The `@scope` decorator is used with other decorators such as `@val` and `@module` to declare a parent scope for the binding. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#scope-decorator).|}; - ] ); - ( "send", - [ - {|The `@send` decorator is used to bind to a method on an object or array. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#send-decorator).|}; - ] ); - ( "set", - [ - {|The `@set` decorator is used to set a property of an object. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#set-decorator).|}; - ] ); - ( "set_index", - [ - {|The `@set_index` decorator is used to set a dynamic property on an object, or an index of an array. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#set-index-decorator).|}; - ] ); - ( "string", - [ - {|The `@string` decorator can be used with polymorphic variants and the `@as` decorator on externals to modify the string values used for the variants in the compiled JavaScript. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#string-decorator).|}; - ] ); - ( "this", - [ - {|The `@this` decorator may be used to bind to an external callback function that require access to a this context. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#this-decorator).|}; - ] ); - ( "unboxed", - [ - {|The `@unboxed` decorator provides a way to unwrap variant constructors that have a single argument, or record objects that have a single field. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#unboxed-decorator).|}; - ] ); - ( "uncurry", - [ - {|The `@uncurry` decorator can be used to mark any callback argument within an external function as an uncurried function without the need for any explicit uncurried function syntax (`(.) => { ... }`). - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#uncurry-decorator).|}; - ] ); - ( "unwrap", - [ - {|The `@unwrap` decorator may be used when binding to external functions that accept multiple types for an argument. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#unwrap-decorator).|}; - ] ); - ( "val", - [ - {|The `@val` decorator allows you to bind to JavaScript values that are on the global scope. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#val-decorator).|}; - ] ); - ( "variadic", - [ - {|The `@variadic` decorator is used to model JavaScript functions that take a variable number of arguments, where all arguments are of the same type. - -[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#variadic-decorator).|}; - ] ); - ] + CompletionDecorators.decorators |> List.filter (fun (decorator, _) -> Utils.startsWith decorator prefix) |> List.map (fun (decorator, doc) -> let parts = String.split_on_char '.' prefix in @@ -2305,7 +1222,8 @@ Note: The `@react.component` decorator requires the react-jsx config to be set i Printf.printf "Found type for function %s\n" (typ |> Shared.typeToString); - typ |> getArgs ~full ~env + typ + |> TypeUtils.getArgs ~full ~env |> List.filter_map (fun arg -> match arg with | SharedTypes.Completable.Labelled name, a -> Some (name, a) @@ -2337,7 +1255,8 @@ Note: The `@react.component` decorator requires the react-jsx config to be set i with | Some (typ, env) -> ( match - TypeExpr typ |> resolveNested ~env ~package:full.package ~nested + TypeExpr typ + |> TypeUtils.resolveNested ~env ~package:full.package ~nested with | None -> fallbackOrEmpty () | Some (typ, env, completionContext) -> @@ -2356,7 +1275,8 @@ Note: The `@react.component` decorator requires the react-jsx config to be set i | None -> [] | Some (typ, env) -> ( match - TypeExpr typ |> resolveNested ~env ~package:full.package ~nested + TypeExpr typ + |> TypeUtils.resolveNested ~env ~package:full.package ~nested with | None -> [] | Some (typ, env, completionContext) -> ( diff --git a/analysis/src/CompletionDecorators.ml b/analysis/src/CompletionDecorators.ml new file mode 100644 index 000000000..952434647 --- /dev/null +++ b/analysis/src/CompletionDecorators.ml @@ -0,0 +1,223 @@ +let decorators = + [ + ( "as", + [ + {|The `@as` decorator is commonly used on record types to alias record field names to a different JavaScript attribute name. + +This is useful to map to JavaScript attribute names that cannot be expressed in ReScript (such as keywords). + +It is also possible to map a ReScript record to a JavaScript array by passing indices to the `@as` decorator. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#as-decorator).|}; + ] ); + ( "dead", + [ + {|The `@dead` decorator is for reanalyze, a static analysis tool for ReScript that can do dead code analysis. + +`@dead` suppresses reporting on the value/type, but can also be used to force the analysis to consider a value as dead. Typically used to acknowledge cases of dead code you are not planning to address right now, but can be searched easily later. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#dead-decorator). + +> Hint: Did you know you can run an interactive code analysis in your project by running the command `> ReScript: Start Code Analyzer`? Try it!|}; + ] ); + ( "deriving", + [ + {|When the `@deriving` decorator is applied to a record type, it expands the type into a factory function plus a set of getter/setter functions for its fields. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#deriving-decorator).|}; + ] ); + ( "deprecated", + [ + {|The `@deprecated` decorator is used to add deprecation notes to types, values and submodules. The compiler and editor tooling will yield a warning whenever a deprecated entity is being used. + +Alternatively, use the `@@deprecated` decorator to add a deprecation warning to the file level. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#expression-deprecated-decorator).|}; + ] ); + ( "doesNotRaise", + [ + {|The `@doesNotRaise` decorator is for reanalyze, a static analysis tool for ReScript that can perform exception analysis. + +`@doesNotRaise` is uses to override the analysis and state that an expression does not raise any exceptions, +even though the analysis reports otherwise. This can happen for example in the case of array access where +the analysis does not perform range checks but takes a conservative stance that any access +could potentially raise. +[Read more and see examples in the documentation](https://github.com/rescript-association/reanalyze/blob/master/EXCEPTION.md). +> Hint: Did you know you can run an interactive code analysis in your project by running the command `> ReScript: Start Code Analyzer`? Try it!|}; + ] ); + ( "genType", + [ + {|The @genType decorator may be used to export ReScript values and types to JavaScript, and import JavaScript values and types into ReScript. It allows seamless integration of compiled ReScript modules in existing TypeScript, Flow, or plain JavaScript codebases, without loosing type information across different type systems. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#gentype-decorator).|}; + ] ); + ( "genType.as", + [ + {|The @genType decorator may be used to export ReScript values and types to JavaScript, and import JavaScript values and types into ReScript. It allows seamless integration of compiled ReScript modules in existing TypeScript, Flow, or plain JavaScript codebases, without loosing type information across different type systems. + +[Read more and see examples in the documentation](https://rescript-lang.org/docs/gentype/latest/usage).|}; + ] ); + ( "genType.import", + [ + {|The @genType decorator may be used to export ReScript values and types to JavaScript, and import JavaScript values and types into ReScript. It allows seamless integration of compiled ReScript modules in existing TypeScript, Flow, or plain JavaScript codebases, without loosing type information across different type systems. + +[Read more and see examples in the documentation](https://rescript-lang.org/docs/gentype/latest/usage).|}; + ] ); + ( "genType.opaque", + [ + {|The @genType decorator may be used to export ReScript values and types to JavaScript, and import JavaScript values and types into ReScript. It allows seamless integration of compiled ReScript modules in existing TypeScript, Flow, or plain JavaScript codebases, without loosing type information across different type systems. + +[Read more and see examples in the documentation](https://rescript-lang.org/docs/gentype/latest/usage).|}; + ] ); + ( "get", + [ + {|The `@get` decorator is used to bind to a property of an object. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#get-decorator).|}; + ] ); + ( "get_index", + [ + {|The `@get_index` decorator is used to access a dynamic property on an object, or an index of an array. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#get-index-decorator).|}; + ] ); + ( "inline", + [ + {|The `@inline` decorator tells the compiler to inline its value in every place the binding is being used, rather than use a variable. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#inline-decorator).|}; + ] ); + ( "int", + [ + {|The `@int` decorator can be used with polymorphic variants and the @as decorator on externals to modify the compiled JavaScript to use integers for the values instead of strings. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#int-decorator).|}; + ] ); + ( "live", + [ + {|The `@live` decorator is for reanalyze, a static analysis tool for ReScript that can do dead code analysis. + +`@live` tells the dead code analysis that the value should be considered live, even though it might appear to be dead. This is typically used in case of FFI where there are indirect ways to access values. It can be added to everything that could otherwise be considered unused by the dead code analysis - values, functions, arguments, records, individual record fields, and so on. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#live-decorator). + +Hint: Did you know you can run an interactive code analysis in your project by running the command `> ReScript: Start Code Analyzer`? Try it!|}; + ] ); + ( "meth", + [ + {|The `@meth` decorator is used to call a function on a JavaScript object, and avoid issues with currying. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#meth-decorator).|}; + ] ); + ( "module", + [ + {|The `@module` decorator is used to bind to a JavaScript module. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#module-decorator).|}; + ] ); + ( "new", + [ + {| +The `@new` decorator is used whenever you need to bind to a JavaScript class constructor that requires the new keword for instantiation.| + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#new-decorator).|}; + ] ); + ( "obj", + [ + {|The `@obj` decorator is used to create functions that return JavaScript objects with properties that match the function's parameter labels. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#obj-decorator).|}; + ] ); + ( "raises", + [ + {|The `@raises` decorator is for reanalyze, a static analysis tool for ReScript that can perform exception analysis. + +`@raises` acknowledges that a function can raise exceptions that are not caught, and suppresses +a warning in that case. Callers of the functions are then subjected to the same rule. +Example `@raises(Exn)` or `@raises([E1, E2, E3])` for multiple exceptions. +[Read more and see examples in the documentation](https://github.com/rescript-association/reanalyze/blob/master/EXCEPTION.md). +> Hint: Did you know you can run an interactive code analysis in your project by running the command `> ReScript: Start Code Analyzer`? Try it!|}; + ] ); + ( "react.component", + [ + {|The `@react.component` decorator is used to annotate functions that are RescriptReact components. + +You will need this decorator whenever you want to use a ReScript / React component in ReScript JSX expressions. + +Note: The `@react.component` decorator requires the react-jsx config to be set in your `bsconfig.json` to enable the required React transformations. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#react-component-decorator).|}; + ] ); + ( "return", + [ + {|The `@return` decorator is used to control how `null` and `undefined` values are converted to option types in ReScript. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#return-decorator).|}; + ] ); + ( "scope", + [ + {|The `@scope` decorator is used with other decorators such as `@val` and `@module` to declare a parent scope for the binding. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#scope-decorator).|}; + ] ); + ( "send", + [ + {|The `@send` decorator is used to bind to a method on an object or array. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#send-decorator).|}; + ] ); + ( "set", + [ + {|The `@set` decorator is used to set a property of an object. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#set-decorator).|}; + ] ); + ( "set_index", + [ + {|The `@set_index` decorator is used to set a dynamic property on an object, or an index of an array. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#set-index-decorator).|}; + ] ); + ( "string", + [ + {|The `@string` decorator can be used with polymorphic variants and the `@as` decorator on externals to modify the string values used for the variants in the compiled JavaScript. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#string-decorator).|}; + ] ); + ( "this", + [ + {|The `@this` decorator may be used to bind to an external callback function that require access to a this context. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#this-decorator).|}; + ] ); + ( "unboxed", + [ + {|The `@unboxed` decorator provides a way to unwrap variant constructors that have a single argument, or record objects that have a single field. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#unboxed-decorator).|}; + ] ); + ( "uncurry", + [ + {|The `@uncurry` decorator can be used to mark any callback argument within an external function as an uncurried function without the need for any explicit uncurried function syntax (`(.) => { ... }`). + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#uncurry-decorator).|}; + ] ); + ( "unwrap", + [ + {|The `@unwrap` decorator may be used when binding to external functions that accept multiple types for an argument. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#unwrap-decorator).|}; + ] ); + ( "val", + [ + {|The `@val` decorator allows you to bind to JavaScript values that are on the global scope. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#val-decorator).|}; + ] ); + ( "variadic", + [ + {|The `@variadic` decorator is used to model JavaScript functions that take a variable number of arguments, where all arguments are of the same type. + +[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#variadic-decorator).|}; + ] ); + ] diff --git a/analysis/src/CompletionExpressions.ml b/analysis/src/CompletionExpressions.ml new file mode 100644 index 000000000..1c91dad11 --- /dev/null +++ b/analysis/src/CompletionExpressions.ml @@ -0,0 +1,218 @@ +open SharedTypes + +let isExprHole exp = + match exp.Parsetree.pexp_desc with + | Pexp_extension ({txt = "rescript.exprhole"}, _) -> true + | _ -> false + +let isExprTuple expr = + match expr.Parsetree.pexp_desc with + | Pexp_tuple _ -> true + | _ -> false + +let rec traverseExpr (exp : Parsetree.expression) ~exprPath ~pos + ~firstCharBeforeCursorNoWhite = + let locHasCursor loc = loc |> CursorPosition.locHasCursor ~pos in + let someIfHasCursor v = if locHasCursor exp.pexp_loc then Some v else None in + match exp.pexp_desc with + | Pexp_ident {txt = Lident txt} when Utils.hasBraces exp.pexp_attributes -> + (* An ident with braces attribute corresponds to for example `{n}`. + Looks like a record but is parsed as an ident with braces. *) + someIfHasCursor (txt, [Completable.NRecordBody {seenFields = []}] @ exprPath) + | Pexp_ident {txt = Lident txt} -> someIfHasCursor (txt, exprPath) + | Pexp_construct ({txt = Lident "()"}, _) -> someIfHasCursor ("", exprPath) + | Pexp_construct ({txt = Lident txt}, None) -> someIfHasCursor (txt, exprPath) + | Pexp_variant (label, None) -> someIfHasCursor ("#" ^ label, exprPath) + | Pexp_array arrayPatterns -> ( + let nextExprPath = [Completable.NArray] @ exprPath in + (* No fields but still has cursor = empty completion *) + if List.length arrayPatterns = 0 && locHasCursor exp.pexp_loc then + Some ("", nextExprPath) + else + let arrayItemWithCursor = + arrayPatterns + |> List.find_map (fun e -> + e + |> traverseExpr ~exprPath:nextExprPath + ~firstCharBeforeCursorNoWhite ~pos) + in + + match (arrayItemWithCursor, locHasCursor exp.pexp_loc) with + | Some arrayItemWithCursor, _ -> Some arrayItemWithCursor + | None, true when firstCharBeforeCursorNoWhite = Some ',' -> + (* No item had the cursor, but the entire expr still has the cursor (so + the cursor is in the array somewhere), and the first char before the + cursor is a comma = interpret as compleing for a new value (example: + `[None, , None]`) *) + Some ("", nextExprPath) + | _ -> None) + | Pexp_tuple tupleItems when locHasCursor exp.pexp_loc -> + tupleItems + |> traverseExprTupleItems ~firstCharBeforeCursorNoWhite ~pos + ~nextExprPath:(fun itemNum -> + [Completable.NTupleItem {itemNum}] @ exprPath) + ~resultFromFoundItemNum:(fun itemNum -> + [Completable.NTupleItem {itemNum = itemNum + 1}] @ exprPath) + | Pexp_record ([], _) -> + (* Empty fields means we're in a record body `{}`. Complete for the fields. *) + someIfHasCursor ("", [Completable.NRecordBody {seenFields = []}] @ exprPath) + | Pexp_record (fields, _) -> ( + let fieldWithCursor = ref None in + let fieldWithExprHole = ref None in + fields + |> List.iter (fun (fname, exp) -> + match + ( fname.Location.txt, + exp.Parsetree.pexp_loc |> CursorPosition.classifyLoc ~pos ) + with + | Longident.Lident fname, HasCursor -> + fieldWithCursor := Some (fname, exp) + | Lident fname, _ when isExprHole exp -> + fieldWithExprHole := Some (fname, exp) + | _ -> ()); + let seenFields = + fields + |> List.filter_map (fun (fieldName, _f) -> + match fieldName with + | {Location.txt = Longident.Lident fieldName} -> Some fieldName + | _ -> None) + in + match (!fieldWithCursor, !fieldWithExprHole) with + | Some (fname, f), _ | None, Some (fname, f) -> ( + match f.pexp_desc with + | Pexp_extension ({txt = "rescript.exprhole"}, _) -> + (* An expression hole means for example `{someField: }`. We want to complete for the type of `someField`. *) + someIfHasCursor + ("", [Completable.NFollowRecordField {fieldName = fname}] @ exprPath) + | Pexp_ident {txt = Lident txt} -> + (* A var means `{someField: s}` or similar. Complete for identifiers or values. *) + someIfHasCursor (txt, exprPath) + | _ -> + f + |> traverseExpr ~firstCharBeforeCursorNoWhite ~pos + ~exprPath: + ([Completable.NFollowRecordField {fieldName = fname}] @ exprPath) + ) + | None, None -> ( + (* Figure out if we're completing for a new field. + If the cursor is inside of the record body, but no field has the cursor, + and there's no pattern hole. Check the first char to the left of the cursor, + ignoring white space. If that's a comma, we assume you're completing for a new field. *) + match firstCharBeforeCursorNoWhite with + | Some ',' -> + someIfHasCursor ("", [Completable.NRecordBody {seenFields}] @ exprPath) + | _ -> None)) + | Pexp_construct + ( {txt}, + Some {pexp_loc; pexp_desc = Pexp_construct ({txt = Lident "()"}, _)} ) + when locHasCursor pexp_loc -> + (* Empty payload with cursor, like: Test() *) + Some + ( "", + [ + Completable.NVariantPayload + {constructorName = Utils.getUnqualifiedName txt; itemNum = 0}; + ] + @ exprPath ) + | Pexp_construct ({txt}, Some e) + when pos >= (e.pexp_loc |> Loc.end_) + && firstCharBeforeCursorNoWhite = Some ',' + && isExprTuple e = false -> + (* Empty payload with trailing ',', like: Test(true, ) *) + Some + ( "", + [ + Completable.NVariantPayload + {constructorName = Utils.getUnqualifiedName txt; itemNum = 1}; + ] + @ exprPath ) + | Pexp_construct ({txt}, Some {pexp_loc; pexp_desc = Pexp_tuple tupleItems}) + when locHasCursor pexp_loc -> + tupleItems + |> traverseExprTupleItems ~firstCharBeforeCursorNoWhite ~pos + ~nextExprPath:(fun itemNum -> + [ + Completable.NVariantPayload + {constructorName = Utils.getUnqualifiedName txt; itemNum}; + ] + @ exprPath) + ~resultFromFoundItemNum:(fun itemNum -> + [ + Completable.NVariantPayload + { + constructorName = Utils.getUnqualifiedName txt; + itemNum = itemNum + 1; + }; + ] + @ exprPath) + | Pexp_construct ({txt}, Some p) when locHasCursor exp.pexp_loc -> + p + |> traverseExpr ~firstCharBeforeCursorNoWhite ~pos + ~exprPath: + ([ + Completable.NVariantPayload + {constructorName = Utils.getUnqualifiedName txt; itemNum = 0}; + ] + @ exprPath) + | Pexp_variant + (txt, Some {pexp_loc; pexp_desc = Pexp_construct ({txt = Lident "()"}, _)}) + when locHasCursor pexp_loc -> + (* Empty payload with cursor, like: #test() *) + Some + ( "", + [Completable.NPolyvariantPayload {constructorName = txt; itemNum = 0}] + @ exprPath ) + | Pexp_variant (txt, Some e) + when pos >= (e.pexp_loc |> Loc.end_) + && firstCharBeforeCursorNoWhite = Some ',' + && isExprTuple e = false -> + (* Empty payload with trailing ',', like: #test(true, ) *) + Some + ( "", + [Completable.NPolyvariantPayload {constructorName = txt; itemNum = 1}] + @ exprPath ) + | Pexp_variant (txt, Some {pexp_loc; pexp_desc = Pexp_tuple tupleItems}) + when locHasCursor pexp_loc -> + tupleItems + |> traverseExprTupleItems ~firstCharBeforeCursorNoWhite ~pos + ~nextExprPath:(fun itemNum -> + [Completable.NPolyvariantPayload {constructorName = txt; itemNum}] + @ exprPath) + ~resultFromFoundItemNum:(fun itemNum -> + [ + Completable.NPolyvariantPayload + {constructorName = txt; itemNum = itemNum + 1}; + ] + @ exprPath) + | Pexp_variant (txt, Some p) when locHasCursor exp.pexp_loc -> + p + |> traverseExpr ~firstCharBeforeCursorNoWhite ~pos + ~exprPath: + ([ + Completable.NPolyvariantPayload + {constructorName = txt; itemNum = 0}; + ] + @ exprPath) + | _ -> None + +and traverseExprTupleItems tupleItems ~nextExprPath ~resultFromFoundItemNum ~pos + ~firstCharBeforeCursorNoWhite = + let itemNum = ref (-1) in + let itemWithCursor = + tupleItems + |> List.find_map (fun e -> + itemNum := !itemNum + 1; + e + |> traverseExpr ~exprPath:(nextExprPath !itemNum) + ~firstCharBeforeCursorNoWhite ~pos) + in + match (itemWithCursor, firstCharBeforeCursorNoWhite) with + | None, Some ',' -> + (* No tuple item has the cursor, but there's a comma before the cursor. + Figure out what arg we're trying to complete. Example: (true, , None) *) + let posNum = ref (-1) in + tupleItems + |> List.iteri (fun index e -> + if pos >= Loc.start e.Parsetree.pexp_loc then posNum := index); + if !posNum > -1 then Some ("", resultFromFoundItemNum !posNum) else None + | v, _ -> v diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index 60f67658e..4af54f4a7 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -1,364 +1,5 @@ open SharedTypes -let isExprHole exp = - match exp.Parsetree.pexp_desc with - | Pexp_extension ({txt = "rescript.exprhole"}, _) -> true - | _ -> false - -let isPatternHole pat = - match pat.Parsetree.ppat_desc with - | Ppat_extension ({txt = "rescript.patternhole"}, _) -> true - | _ -> false - -let isPatternTuple pat = - match pat.Parsetree.ppat_desc with - | Ppat_tuple _ -> true - | _ -> false - -let isExprTuple expr = - match expr.Parsetree.pexp_desc with - | Pexp_tuple _ -> true - | _ -> false - -let rec getUnqualifiedName txt = - match txt with - | Longident.Lident fieldName -> fieldName - | Ldot (t, _) -> getUnqualifiedName t - | _ -> "" - -let rec traverseExpr (exp : Parsetree.expression) ~exprPath ~pos - ~firstCharBeforeCursorNoWhite = - let locHasCursor loc = loc |> CursorPosition.locHasCursor ~pos in - let someIfHasCursor v = if locHasCursor exp.pexp_loc then Some v else None in - match exp.pexp_desc with - | Pexp_ident {txt = Lident txt} when Utils.hasBraces exp.pexp_attributes -> - (* An ident with braces attribute corresponds to for example `{n}`. - Looks like a record but is parsed as an ident with braces. *) - someIfHasCursor (txt, [Completable.NRecordBody {seenFields = []}] @ exprPath) - | Pexp_ident {txt = Lident txt} -> someIfHasCursor (txt, exprPath) - | Pexp_construct ({txt = Lident "()"}, _) -> someIfHasCursor ("", exprPath) - | Pexp_construct ({txt = Lident txt}, None) -> someIfHasCursor (txt, exprPath) - | Pexp_variant (label, None) -> someIfHasCursor ("#" ^ label, exprPath) - | Pexp_array arrayPatterns -> ( - let nextExprPath = [Completable.NArray] @ exprPath in - (* No fields but still has cursor = empty completion *) - if List.length arrayPatterns = 0 && locHasCursor exp.pexp_loc then - Some ("", nextExprPath) - else - let arrayItemWithCursor = - arrayPatterns - |> List.find_map (fun e -> - e - |> traverseExpr ~exprPath:nextExprPath - ~firstCharBeforeCursorNoWhite ~pos) - in - - match (arrayItemWithCursor, locHasCursor exp.pexp_loc) with - | Some arrayItemWithCursor, _ -> Some arrayItemWithCursor - | None, true when firstCharBeforeCursorNoWhite = Some ',' -> - (* No item had the cursor, but the entire expr still has the cursor (so - the cursor is in the array somewhere), and the first char before the - cursor is a comma = interpret as compleing for a new value (example: - `[None, , None]`) *) - Some ("", nextExprPath) - | _ -> None) - | Pexp_tuple tupleItems when locHasCursor exp.pexp_loc -> - tupleItems - |> traverseExprTupleItems ~firstCharBeforeCursorNoWhite ~pos - ~nextExprPath:(fun itemNum -> - [Completable.NTupleItem {itemNum}] @ exprPath) - ~resultFromFoundItemNum:(fun itemNum -> - [Completable.NTupleItem {itemNum = itemNum + 1}] @ exprPath) - | Pexp_record ([], _) -> - (* Empty fields means we're in a record body `{}`. Complete for the fields. *) - someIfHasCursor ("", [Completable.NRecordBody {seenFields = []}] @ exprPath) - | Pexp_record (fields, _) -> ( - let fieldWithCursor = ref None in - let fieldWithExprHole = ref None in - fields - |> List.iter (fun (fname, exp) -> - match - ( fname.Location.txt, - exp.Parsetree.pexp_loc |> CursorPosition.classifyLoc ~pos ) - with - | Longident.Lident fname, HasCursor -> - fieldWithCursor := Some (fname, exp) - | Lident fname, _ when isExprHole exp -> - fieldWithExprHole := Some (fname, exp) - | _ -> ()); - let seenFields = - fields - |> List.filter_map (fun (fieldName, _f) -> - match fieldName with - | {Location.txt = Longident.Lident fieldName} -> Some fieldName - | _ -> None) - in - match (!fieldWithCursor, !fieldWithExprHole) with - | Some (fname, f), _ | None, Some (fname, f) -> ( - match f.pexp_desc with - | Pexp_extension ({txt = "rescript.exprhole"}, _) -> - (* An expression hole means for example `{someField: }`. We want to complete for the type of `someField`. *) - someIfHasCursor - ("", [Completable.NFollowRecordField {fieldName = fname}] @ exprPath) - | Pexp_ident {txt = Lident txt} -> - (* A var means `{someField: s}` or similar. Complete for identifiers or values. *) - someIfHasCursor (txt, exprPath) - | _ -> - f - |> traverseExpr ~firstCharBeforeCursorNoWhite ~pos - ~exprPath: - ([Completable.NFollowRecordField {fieldName = fname}] @ exprPath) - ) - | None, None -> ( - (* Figure out if we're completing for a new field. - If the cursor is inside of the record body, but no field has the cursor, - and there's no pattern hole. Check the first char to the left of the cursor, - ignoring white space. If that's a comma, we assume you're completing for a new field. *) - match firstCharBeforeCursorNoWhite with - | Some ',' -> - someIfHasCursor ("", [Completable.NRecordBody {seenFields}] @ exprPath) - | _ -> None)) - | Pexp_construct - ( {txt}, - Some {pexp_loc; pexp_desc = Pexp_construct ({txt = Lident "()"}, _)} ) - when locHasCursor pexp_loc -> - (* Empty payload with cursor, like: Test() *) - Some - ( "", - [ - Completable.NVariantPayload - {constructorName = getUnqualifiedName txt; itemNum = 0}; - ] - @ exprPath ) - | Pexp_construct ({txt}, Some e) - when pos >= (e.pexp_loc |> Loc.end_) - && firstCharBeforeCursorNoWhite = Some ',' - && isExprTuple e = false -> - (* Empty payload with trailing ',', like: Test(true, ) *) - Some - ( "", - [ - Completable.NVariantPayload - {constructorName = getUnqualifiedName txt; itemNum = 1}; - ] - @ exprPath ) - | Pexp_construct ({txt}, Some {pexp_loc; pexp_desc = Pexp_tuple tupleItems}) - when locHasCursor pexp_loc -> - tupleItems - |> traverseExprTupleItems ~firstCharBeforeCursorNoWhite ~pos - ~nextExprPath:(fun itemNum -> - [ - Completable.NVariantPayload - {constructorName = getUnqualifiedName txt; itemNum}; - ] - @ exprPath) - ~resultFromFoundItemNum:(fun itemNum -> - [ - Completable.NVariantPayload - {constructorName = getUnqualifiedName txt; itemNum = itemNum + 1}; - ] - @ exprPath) - | Pexp_construct ({txt}, Some p) when locHasCursor exp.pexp_loc -> - p - |> traverseExpr ~firstCharBeforeCursorNoWhite ~pos - ~exprPath: - ([ - Completable.NVariantPayload - {constructorName = getUnqualifiedName txt; itemNum = 0}; - ] - @ exprPath) - | Pexp_variant - (txt, Some {pexp_loc; pexp_desc = Pexp_construct ({txt = Lident "()"}, _)}) - when locHasCursor pexp_loc -> - (* Empty payload with cursor, like: #test() *) - Some - ( "", - [Completable.NPolyvariantPayload {constructorName = txt; itemNum = 0}] - @ exprPath ) - | Pexp_variant (txt, Some e) - when pos >= (e.pexp_loc |> Loc.end_) - && firstCharBeforeCursorNoWhite = Some ',' - && isExprTuple e = false -> - (* Empty payload with trailing ',', like: #test(true, ) *) - Some - ( "", - [Completable.NPolyvariantPayload {constructorName = txt; itemNum = 1}] - @ exprPath ) - | Pexp_variant (txt, Some {pexp_loc; pexp_desc = Pexp_tuple tupleItems}) - when locHasCursor pexp_loc -> - tupleItems - |> traverseExprTupleItems ~firstCharBeforeCursorNoWhite ~pos - ~nextExprPath:(fun itemNum -> - [Completable.NPolyvariantPayload {constructorName = txt; itemNum}] - @ exprPath) - ~resultFromFoundItemNum:(fun itemNum -> - [ - Completable.NPolyvariantPayload - {constructorName = txt; itemNum = itemNum + 1}; - ] - @ exprPath) - | Pexp_variant (txt, Some p) when locHasCursor exp.pexp_loc -> - p - |> traverseExpr ~firstCharBeforeCursorNoWhite ~pos - ~exprPath: - ([ - Completable.NPolyvariantPayload - {constructorName = txt; itemNum = 0}; - ] - @ exprPath) - | _ -> None - -and traverseExprTupleItems tupleItems ~nextExprPath ~resultFromFoundItemNum ~pos - ~firstCharBeforeCursorNoWhite = - let itemNum = ref (-1) in - let itemWithCursor = - tupleItems - |> List.find_map (fun e -> - itemNum := !itemNum + 1; - e - |> traverseExpr ~exprPath:(nextExprPath !itemNum) - ~firstCharBeforeCursorNoWhite ~pos) - in - match (itemWithCursor, firstCharBeforeCursorNoWhite) with - | None, Some ',' -> - (* No tuple item has the cursor, but there's a comma before the cursor. - Figure out what arg we're trying to complete. Example: (true, , None) *) - let posNum = ref (-1) in - tupleItems - |> List.iteri (fun index e -> - if pos >= Loc.start e.Parsetree.pexp_loc then posNum := index); - if !posNum > -1 then Some ("", resultFromFoundItemNum !posNum) else None - | v, _ -> v - -type prop = { - name: string; - posStart: int * int; - posEnd: int * int; - exp: Parsetree.expression; -} - -type jsxProps = { - compName: Longident.t Location.loc; - props: prop list; - childrenStart: (int * int) option; -} - -let findJsxPropsCompletable ~jsxProps ~endPos ~posBeforeCursor - ~firstCharBeforeCursorNoWhite ~posAfterCompName = - let allLabels = - List.fold_right - (fun prop allLabels -> prop.name :: allLabels) - jsxProps.props [] - in - let rec loop props = - match props with - | prop :: rest -> - if prop.posStart <= posBeforeCursor && posBeforeCursor < prop.posEnd then - (* Cursor on the prop name *) - Some - (Completable.Cjsx - ( Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt, - prop.name, - allLabels )) - else if - prop.posEnd <= posBeforeCursor - && posBeforeCursor < Loc.start prop.exp.pexp_loc - then (* Cursor between the prop name and expr assigned *) - None - else if prop.exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then - (* Cursor on expr assigned *) - match - traverseExpr prop.exp ~exprPath:[] ~pos:posBeforeCursor - ~firstCharBeforeCursorNoWhite - with - | Some (prefix, nested) -> - Some - (Cexpression - { - contextPath = - CJsxPropValue - { - pathToComponent = - Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt; - propName = prop.name; - }; - nested = List.rev nested; - prefix; - }) - | _ -> None - else if prop.exp.pexp_loc |> Loc.end_ = (Location.none |> Loc.end_) then - if isExprHole prop.exp then - Some - (Cexpression - { - contextPath = - CJsxPropValue - { - pathToComponent = - Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt; - propName = prop.name; - }; - prefix = ""; - nested = []; - }) - else None - else loop rest - | [] -> - let beforeChildrenStart = - match jsxProps.childrenStart with - | Some childrenPos -> posBeforeCursor < childrenPos - | None -> posBeforeCursor <= endPos - in - let afterCompName = posBeforeCursor >= posAfterCompName in - if afterCompName && beforeChildrenStart then - Some - (Cjsx - ( Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt, - "", - allLabels )) - else None - in - loop jsxProps.props - -let extractJsxProps ~(compName : Longident.t Location.loc) ~args = - let thisCaseShouldNotHappen = - { - compName = Location.mknoloc (Longident.Lident ""); - props = []; - childrenStart = None; - } - in - let rec processProps ~acc args = - match args with - | (Asttypes.Labelled "children", {Parsetree.pexp_loc}) :: _ -> - { - compName; - props = List.rev acc; - childrenStart = - (if pexp_loc.loc_ghost then None else Some (Loc.start pexp_loc)); - } - | ((Labelled s | Optional s), (eProp : Parsetree.expression)) :: rest -> ( - let namedArgLoc = - eProp.pexp_attributes - |> List.find_opt (fun ({Asttypes.txt}, _) -> txt = "ns.namedArgLoc") - in - match namedArgLoc with - | Some ({loc}, _) -> - processProps - ~acc: - ({ - name = s; - posStart = Loc.start loc; - posEnd = Loc.end_ loc; - exp = eProp; - } - :: acc) - rest - | None -> processProps ~acc rest) - | _ -> thisCaseShouldNotHappen - in - args |> processProps ~acc:[] - let findArgCompletables ~(args : arg list) ~endPos ~posBeforeCursor ~(contextPath : Completable.contextPath) ~posAfterFunExpr ~firstCharBeforeCursorNoWhite ~charBeforeCursor ~isPipedExpr = @@ -384,8 +25,8 @@ let findArgCompletables ~(args : arg list) ~endPos ~posBeforeCursor else if exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then (* Completing in the assignment of labelled argument *) match - traverseExpr exp ~exprPath:[] ~pos:posBeforeCursor - ~firstCharBeforeCursorNoWhite + CompletionExpressions.traverseExpr exp ~exprPath:[] + ~pos:posBeforeCursor ~firstCharBeforeCursorNoWhite with | None -> None | Some (prefix, nested) -> @@ -401,7 +42,7 @@ let findArgCompletables ~(args : arg list) ~endPos ~posBeforeCursor prefix; nested = List.rev nested; }) - else if isExprHole exp then + else if CompletionExpressions.isExprHole exp then Some (Cexpression { @@ -420,8 +61,8 @@ let findArgCompletables ~(args : arg list) ~endPos ~posBeforeCursor else if exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then (* Completing in an unlabelled argument *) match - traverseExpr exp ~pos:posBeforeCursor ~firstCharBeforeCursorNoWhite - ~exprPath:[] + CompletionExpressions.traverseExpr exp ~pos:posBeforeCursor + ~firstCharBeforeCursorNoWhite ~exprPath:[] with | None -> None | Some (prefix, nested) -> @@ -438,7 +79,7 @@ let findArgCompletables ~(args : arg list) ~endPos ~posBeforeCursor prefix; nested = List.rev nested; }) - else if isExprHole exp then + else if CompletionExpressions.isExprHole exp then Some (Cexpression { @@ -656,226 +297,13 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text = let locHasCursor = CursorPosition.locHasCursor ~pos:posBeforeCursor in let locIsEmpty = CursorPosition.locIsEmpty ~pos:posBeforeCursor in - let rec traverseTupleItems tupleItems ~nextPatternPath ~resultFromFoundItemNum - = - let itemNum = ref (-1) in - let itemWithCursor = - tupleItems - |> List.find_map (fun pat -> - itemNum := !itemNum + 1; - pat |> traversePattern ~patternPath:(nextPatternPath !itemNum)) - in - match (itemWithCursor, firstCharBeforeCursorNoWhite) with - | None, Some ',' -> - (* No tuple item has the cursor, but there's a comma before the cursor. - Figure out what arg we're trying to complete. Example: (true, , None) *) - let posNum = ref (-1) in - tupleItems - |> List.iteri (fun index pat -> - if posBeforeCursor >= Loc.start pat.Parsetree.ppat_loc then - posNum := index); - if !posNum > -1 then Some ("", resultFromFoundItemNum !posNum) else None - | v, _ -> v - and traversePattern (pat : Parsetree.pattern) ~patternPath = - let someIfHasCursor v = - if locHasCursor pat.Parsetree.ppat_loc then Some v else None - in - match pat.ppat_desc with - | Ppat_constant _ | Ppat_interval _ -> None - | Ppat_lazy p - | Ppat_constraint (p, _) - | Ppat_alias (p, _) - | Ppat_exception p - | Ppat_open (_, p) -> - p |> traversePattern ~patternPath - | Ppat_or (p1, p2) -> ( - let orPatWithItem = - [p1; p2] |> List.find_map (fun p -> p |> traversePattern ~patternPath) - in - match orPatWithItem with - | None when isPatternHole p1 || isPatternHole p2 -> Some ("", patternPath) - | v -> v) - | 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. *) - someIfHasCursor ("", patternPath) - | Ppat_var {txt} -> someIfHasCursor (txt, patternPath) - | Ppat_construct ({txt = Lident "()"}, None) -> - (* switch s { | () }*) - someIfHasCursor ("", patternPath @ [Completable.NTupleItem {itemNum = 0}]) - | Ppat_construct ({txt = Lident prefix}, None) -> - someIfHasCursor (prefix, patternPath) - | Ppat_variant (prefix, None) -> someIfHasCursor ("#" ^ prefix, patternPath) - | Ppat_array arrayPatterns -> - let nextPatternPath = [Completable.NArray] @ patternPath in - if List.length arrayPatterns = 0 && locHasCursor pat.ppat_loc then - Some ("", nextPatternPath) - else - arrayPatterns - |> List.find_map (fun pat -> - pat |> traversePattern ~patternPath:nextPatternPath) - | Ppat_tuple tupleItems when locHasCursor pat.ppat_loc -> - tupleItems - |> traverseTupleItems - ~nextPatternPath:(fun itemNum -> - [Completable.NTupleItem {itemNum}] @ patternPath) - ~resultFromFoundItemNum:(fun itemNum -> - [Completable.NTupleItem {itemNum = itemNum + 1}] @ patternPath) - | Ppat_record ([], _) -> - (* Empty fields means we're in a record body `{}`. Complete for the fields. *) - someIfHasCursor - ("", [Completable.NRecordBody {seenFields = []}] @ patternPath) - | Ppat_record (fields, _) -> ( - let fieldWithCursor = ref None in - let fieldWithPatHole = ref None in - fields - |> List.iter (fun (fname, f) -> - match - ( fname.Location.txt, - f.Parsetree.ppat_loc - |> CursorPosition.classifyLoc ~pos:posBeforeCursor ) - with - | Longident.Lident fname, HasCursor -> - fieldWithCursor := Some (fname, f) - | Lident fname, _ when isPatternHole f -> - fieldWithPatHole := Some (fname, f) - | _ -> ()); - let seenFields = - fields - |> List.filter_map (fun (fieldName, _f) -> - match fieldName with - | {Location.txt = Longident.Lident fieldName} -> Some fieldName - | _ -> None) - in - match (!fieldWithCursor, !fieldWithPatHole) with - | Some (fname, f), _ | None, Some (fname, f) -> ( - match f.ppat_desc with - | Ppat_extension ({txt = "rescript.patternhole"}, _) -> - (* A pattern hole means for example `{someField: }`. We want to complete for the type of `someField`. *) - someIfHasCursor - ( "", - [Completable.NFollowRecordField {fieldName = fname}] @ patternPath - ) - | Ppat_var {txt} -> - (* A var means `{s}` or similar. Complete for fields. *) - someIfHasCursor - (txt, [Completable.NRecordBody {seenFields}] @ patternPath) - | _ -> - f - |> traversePattern - ~patternPath: - ([Completable.NFollowRecordField {fieldName = fname}] - @ patternPath)) - | None, None -> ( - (* Figure out if we're completing for a new field. - If the cursor is inside of the record body, but no field has the cursor, - and there's no pattern hole. Check the first char to the left of the cursor, - ignoring white space. If that's a comma, we assume you're completing for a new field. *) - match firstCharBeforeCursorNoWhite with - | Some ',' -> - someIfHasCursor - ("", [Completable.NRecordBody {seenFields}] @ patternPath) - | _ -> None)) - | Ppat_construct - ( {txt}, - Some {ppat_loc; ppat_desc = Ppat_construct ({txt = Lident "()"}, _)} - ) - when locHasCursor ppat_loc -> - (* Empty payload with cursor, like: Test() *) - Some - ( "", - [ - Completable.NVariantPayload - {constructorName = getUnqualifiedName txt; itemNum = 0}; - ] - @ patternPath ) - | Ppat_construct ({txt}, Some pat) - when posBeforeCursor >= (pat.ppat_loc |> Loc.end_) - && firstCharBeforeCursorNoWhite = Some ',' - && isPatternTuple pat = false -> - (* Empty payload with trailing ',', like: Test(true, ) *) - Some - ( "", - [ - Completable.NVariantPayload - {constructorName = getUnqualifiedName txt; itemNum = 1}; - ] - @ patternPath ) - | Ppat_construct ({txt}, Some {ppat_loc; ppat_desc = Ppat_tuple tupleItems}) - when locHasCursor ppat_loc -> - tupleItems - |> traverseTupleItems - ~nextPatternPath:(fun itemNum -> - [ - Completable.NVariantPayload - {constructorName = getUnqualifiedName txt; itemNum}; - ] - @ patternPath) - ~resultFromFoundItemNum:(fun itemNum -> - [ - Completable.NVariantPayload - { - constructorName = getUnqualifiedName txt; - itemNum = itemNum + 1; - }; - ] - @ patternPath) - | Ppat_construct ({txt}, Some p) when locHasCursor pat.ppat_loc -> - p - |> traversePattern - ~patternPath: - ([ - Completable.NVariantPayload - {constructorName = getUnqualifiedName txt; itemNum = 0}; - ] - @ patternPath) - | Ppat_variant - ( txt, - Some {ppat_loc; ppat_desc = Ppat_construct ({txt = Lident "()"}, _)} - ) - when locHasCursor ppat_loc -> - (* Empty payload with cursor, like: #test() *) - Some - ( "", - [Completable.NPolyvariantPayload {constructorName = txt; itemNum = 0}] - @ patternPath ) - | Ppat_variant (txt, Some pat) - when posBeforeCursor >= (pat.ppat_loc |> Loc.end_) - && firstCharBeforeCursorNoWhite = Some ',' - && isPatternTuple pat = false -> - (* Empty payload with trailing ',', like: #test(true, ) *) - Some - ( "", - [Completable.NPolyvariantPayload {constructorName = txt; itemNum = 1}] - @ patternPath ) - | Ppat_variant (txt, Some {ppat_loc; ppat_desc = Ppat_tuple tupleItems}) - when locHasCursor ppat_loc -> - tupleItems - |> traverseTupleItems - ~nextPatternPath:(fun itemNum -> - [Completable.NPolyvariantPayload {constructorName = txt; itemNum}] - @ patternPath) - ~resultFromFoundItemNum:(fun itemNum -> - [ - Completable.NPolyvariantPayload - {constructorName = txt; itemNum = itemNum + 1}; - ] - @ patternPath) - | Ppat_variant (txt, Some p) when locHasCursor pat.ppat_loc -> - p - |> traversePattern - ~patternPath: - ([ - Completable.NPolyvariantPayload - {constructorName = txt; itemNum = 0}; - ] - @ patternPath) - | _ -> None - in let completePattern (pat : Parsetree.pattern) = - match (pat |> traversePattern ~patternPath:[], !lookingForPat) with + match + ( pat + |> CompletionPatterns.traversePattern ~patternPath:[] ~locHasCursor + ~firstCharBeforeCursorNoWhite ~posBeforeCursor, + !lookingForPat ) + with | Some (prefix, nestedPattern), Some ctxPath -> setResult (Completable.Cpattern @@ -1226,14 +654,15 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text = | Pexp_apply ({pexp_desc = Pexp_ident compName}, args) when Res_parsetree_viewer.isJsxExpression expr -> inJsxContext := true; - let jsxProps = extractJsxProps ~compName ~args in + let jsxProps = CompletionJsx.extractJsxProps ~compName ~args in let compNamePath = flattenLidCheckDot ~jsx:true compName in if debug then Printf.printf "JSX <%s:%s %s> _children:%s\n" (compNamePath |> String.concat ".") (Loc.toString compName.loc) (jsxProps.props - |> List.map (fun {name; posStart; posEnd; exp} -> + |> List.map + (fun ({name; posStart; posEnd; exp} : CompletionJsx.prop) -> Printf.sprintf "%s[%s->%s]=...%s" name (Pos.toString posStart) (Pos.toString posEnd) (Loc.toString exp.pexp_loc)) @@ -1242,8 +671,9 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text = | None -> "None" | Some childrenPosStart -> Pos.toString childrenPosStart); let jsxCompletable = - findJsxPropsCompletable ~jsxProps ~endPos:(Loc.end_ expr.pexp_loc) - ~posBeforeCursor ~posAfterCompName:(Loc.end_ compName.loc) + CompletionJsx.findJsxPropsCompletable ~jsxProps + ~endPos:(Loc.end_ expr.pexp_loc) ~posBeforeCursor + ~posAfterCompName:(Loc.end_ compName.loc) ~firstCharBeforeCursorNoWhite in if jsxCompletable <> None then setResultOpt jsxCompletable diff --git a/analysis/src/CompletionJsx.ml b/analysis/src/CompletionJsx.ml new file mode 100644 index 000000000..c260a1c6e --- /dev/null +++ b/analysis/src/CompletionJsx.ml @@ -0,0 +1,694 @@ +open SharedTypes + +let domLabels = + let bool = "bool" in + let float = "float" in + let int = "int" in + let string = "string" in + [ + ("ariaDetails", string); + ("ariaDisabled", bool); + ("ariaHidden", bool); + ("ariaKeyshortcuts", string); + ("ariaLabel", string); + ("ariaRoledescription", string); + ("ariaExpanded", bool); + ("ariaLevel", int); + ("ariaModal", bool); + ("ariaMultiline", bool); + ("ariaMultiselectable", bool); + ("ariaPlaceholder", string); + ("ariaReadonly", bool); + ("ariaRequired", bool); + ("ariaSelected", bool); + ("ariaSort", string); + ("ariaValuemax", float); + ("ariaValuemin", float); + ("ariaValuenow", float); + ("ariaValuetext", string); + ("ariaAtomic", bool); + ("ariaBusy", bool); + ("ariaRelevant", string); + ("ariaGrabbed", bool); + ("ariaActivedescendant", string); + ("ariaColcount", int); + ("ariaColindex", int); + ("ariaColspan", int); + ("ariaControls", string); + ("ariaDescribedby", string); + ("ariaErrormessage", string); + ("ariaFlowto", string); + ("ariaLabelledby", string); + ("ariaOwns", string); + ("ariaPosinset", int); + ("ariaRowcount", int); + ("ariaRowindex", int); + ("ariaRowspan", int); + ("ariaSetsize", int); + ("defaultChecked", bool); + ("defaultValue", string); + ("accessKey", string); + ("className", string); + ("contentEditable", bool); + ("contextMenu", string); + ("dir", string); + ("draggable", bool); + ("hidden", bool); + ("id", string); + ("lang", string); + ("style", "style"); + ("spellCheck", bool); + ("tabIndex", int); + ("title", string); + ("itemID", string); + ("itemProp", string); + ("itemRef", string); + ("itemScope", bool); + ("itemType", string); + ("accept", string); + ("acceptCharset", string); + ("action", string); + ("allowFullScreen", bool); + ("alt", string); + ("async", bool); + ("autoComplete", string); + ("autoCapitalize", string); + ("autoFocus", bool); + ("autoPlay", bool); + ("challenge", string); + ("charSet", string); + ("checked", bool); + ("cite", string); + ("crossOrigin", string); + ("cols", int); + ("colSpan", int); + ("content", string); + ("controls", bool); + ("coords", string); + ("data", string); + ("dateTime", string); + ("default", bool); + ("defer", bool); + ("disabled", bool); + ("download", string); + ("encType", string); + ("form", string); + ("formAction", string); + ("formTarget", string); + ("formMethod", string); + ("headers", string); + ("height", string); + ("high", int); + ("href", string); + ("hrefLang", string); + ("htmlFor", string); + ("httpEquiv", string); + ("icon", string); + ("inputMode", string); + ("integrity", string); + ("keyType", string); + ("label", string); + ("list", string); + ("loop", bool); + ("low", int); + ("manifest", string); + ("max", string); + ("maxLength", int); + ("media", string); + ("mediaGroup", string); + ("method", string); + ("min", string); + ("minLength", int); + ("multiple", bool); + ("muted", bool); + ("name", string); + ("nonce", string); + ("noValidate", bool); + ("open_", bool); + ("optimum", int); + ("pattern", string); + ("placeholder", string); + ("playsInline", bool); + ("poster", string); + ("preload", string); + ("radioGroup", string); + ("readOnly", bool); + ("rel", string); + ("required", bool); + ("reversed", bool); + ("rows", int); + ("rowSpan", int); + ("sandbox", string); + ("scope", string); + ("scoped", bool); + ("scrolling", string); + ("selected", bool); + ("shape", string); + ("size", int); + ("sizes", string); + ("span", int); + ("src", string); + ("srcDoc", string); + ("srcLang", string); + ("srcSet", string); + ("start", int); + ("step", float); + ("summary", string); + ("target", string); + ("type_", string); + ("useMap", string); + ("value", string); + ("width", string); + ("wrap", string); + ("onCopy", "ReactEvent.Clipboard.t => unit"); + ("onCut", "ReactEvent.Clipboard.t => unit"); + ("onPaste", "ReactEvent.Clipboard.t => unit"); + ("onCompositionEnd", "ReactEvent.Composition.t => unit"); + ("onCompositionStart", "ReactEvent.Composition.t => unit"); + ("onCompositionUpdate", "ReactEvent.Composition.t => unit"); + ("onKeyDown", "ReactEvent.Keyboard.t => unit"); + ("onKeyPress", "ReactEvent.Keyboard.t => unit"); + ("onKeyUp", "ReactEvent.Keyboard.t => unit"); + ("onFocus", "ReactEvent.Focus.t => unit"); + ("onBlur", "ReactEvent.Focus.t => unit"); + ("onChange", "ReactEvent.Form.t => unit"); + ("onInput", "ReactEvent.Form.t => unit"); + ("onSubmit", "ReactEvent.Form.t => unit"); + ("onInvalid", "ReactEvent.Form.t => unit"); + ("onClick", "ReactEvent.Mouse.t => unit"); + ("onContextMenu", "ReactEvent.Mouse.t => unit"); + ("onDoubleClick", "ReactEvent.Mouse.t => unit"); + ("onDrag", "ReactEvent.Mouse.t => unit"); + ("onDragEnd", "ReactEvent.Mouse.t => unit"); + ("onDragEnter", "ReactEvent.Mouse.t => unit"); + ("onDragExit", "ReactEvent.Mouse.t => unit"); + ("onDragLeave", "ReactEvent.Mouse.t => unit"); + ("onDragOver", "ReactEvent.Mouse.t => unit"); + ("onDragStart", "ReactEvent.Mouse.t => unit"); + ("onDrop", "ReactEvent.Mouse.t => unit"); + ("onMouseDown", "ReactEvent.Mouse.t => unit"); + ("onMouseEnter", "ReactEvent.Mouse.t => unit"); + ("onMouseLeave", "ReactEvent.Mouse.t => unit"); + ("onMouseMove", "ReactEvent.Mouse.t => unit"); + ("onMouseOut", "ReactEvent.Mouse.t => unit"); + ("onMouseOver", "ReactEvent.Mouse.t => unit"); + ("onMouseUp", "ReactEvent.Mouse.t => unit"); + ("onSelect", "ReactEvent.Selection.t => unit"); + ("onTouchCancel", "ReactEvent.Touch.t => unit"); + ("onTouchEnd", "ReactEvent.Touch.t => unit"); + ("onTouchMove", "ReactEvent.Touch.t => unit"); + ("onTouchStart", "ReactEvent.Touch.t => unit"); + ("onPointerOver", "ReactEvent.Pointer.t => unit"); + ("onPointerEnter", "ReactEvent.Pointer.t => unit"); + ("onPointerDown", "ReactEvent.Pointer.t => unit"); + ("onPointerMove", "ReactEvent.Pointer.t => unit"); + ("onPointerUp", "ReactEvent.Pointer.t => unit"); + ("onPointerCancel", "ReactEvent.Pointer.t => unit"); + ("onPointerOut", "ReactEvent.Pointer.t => unit"); + ("onPointerLeave", "ReactEvent.Pointer.t => unit"); + ("onGotPointerCapture", "ReactEvent.Pointer.t => unit"); + ("onLostPointerCapture", "ReactEvent.Pointer.t => unit"); + ("onScroll", "ReactEvent.UI.t => unit"); + ("onWheel", "ReactEvent.Wheel.t => unit"); + ("onAbort", "ReactEvent.Media.t => unit"); + ("onCanPlay", "ReactEvent.Media.t => unit"); + ("onCanPlayThrough", "ReactEvent.Media.t => unit"); + ("onDurationChange", "ReactEvent.Media.t => unit"); + ("onEmptied", "ReactEvent.Media.t => unit"); + ("onEncrypetd", "ReactEvent.Media.t => unit"); + ("onEnded", "ReactEvent.Media.t => unit"); + ("onError", "ReactEvent.Media.t => unit"); + ("onLoadedData", "ReactEvent.Media.t => unit"); + ("onLoadedMetadata", "ReactEvent.Media.t => unit"); + ("onLoadStart", "ReactEvent.Media.t => unit"); + ("onPause", "ReactEvent.Media.t => unit"); + ("onPlay", "ReactEvent.Media.t => unit"); + ("onPlaying", "ReactEvent.Media.t => unit"); + ("onProgress", "ReactEvent.Media.t => unit"); + ("onRateChange", "ReactEvent.Media.t => unit"); + ("onSeeked", "ReactEvent.Media.t => unit"); + ("onSeeking", "ReactEvent.Media.t => unit"); + ("onStalled", "ReactEvent.Media.t => unit"); + ("onSuspend", "ReactEvent.Media.t => unit"); + ("onTimeUpdate", "ReactEvent.Media.t => unit"); + ("onVolumeChange", "ReactEvent.Media.t => unit"); + ("onWaiting", "ReactEvent.Media.t => unit"); + ("onAnimationStart", "ReactEvent.Animation.t => unit"); + ("onAnimationEnd", "ReactEvent.Animation.t => unit"); + ("onAnimationIteration", "ReactEvent.Animation.t => unit"); + ("onTransitionEnd", "ReactEvent.Transition.t => unit"); + ("accentHeight", string); + ("accumulate", string); + ("additive", string); + ("alignmentBaseline", string); + ("allowReorder", string); + ("alphabetic", string); + ("amplitude", string); + ("arabicForm", string); + ("ascent", string); + ("attributeName", string); + ("attributeType", string); + ("autoReverse", string); + ("azimuth", string); + ("baseFrequency", string); + ("baseProfile", string); + ("baselineShift", string); + ("bbox", string); + ("bias", string); + ("by", string); + ("calcMode", string); + ("capHeight", string); + ("clip", string); + ("clipPath", string); + ("clipPathUnits", string); + ("clipRule", string); + ("colorInterpolation", string); + ("colorInterpolationFilters", string); + ("colorProfile", string); + ("colorRendering", string); + ("contentScriptType", string); + ("contentStyleType", string); + ("cursor", string); + ("cx", string); + ("cy", string); + ("d", string); + ("decelerate", string); + ("descent", string); + ("diffuseConstant", string); + ("direction", string); + ("display", string); + ("divisor", string); + ("dominantBaseline", string); + ("dur", string); + ("dx", string); + ("dy", string); + ("edgeMode", string); + ("elevation", string); + ("enableBackground", string); + ("exponent", string); + ("externalResourcesRequired", string); + ("fill", string); + ("fillOpacity", string); + ("fillRule", string); + ("filter", string); + ("filterRes", string); + ("filterUnits", string); + ("floodColor", string); + ("floodOpacity", string); + ("focusable", string); + ("fontFamily", string); + ("fontSize", string); + ("fontSizeAdjust", string); + ("fontStretch", string); + ("fontStyle", string); + ("fontVariant", string); + ("fontWeight", string); + ("fomat", string); + ("from", string); + ("fx", string); + ("fy", string); + ("g1", string); + ("g2", string); + ("glyphName", string); + ("glyphOrientationHorizontal", string); + ("glyphOrientationVertical", string); + ("glyphRef", string); + ("gradientTransform", string); + ("gradientUnits", string); + ("hanging", string); + ("horizAdvX", string); + ("horizOriginX", string); + ("ideographic", string); + ("imageRendering", string); + ("in2", string); + ("intercept", string); + ("k", string); + ("k1", string); + ("k2", string); + ("k3", string); + ("k4", string); + ("kernelMatrix", string); + ("kernelUnitLength", string); + ("kerning", string); + ("keyPoints", string); + ("keySplines", string); + ("keyTimes", string); + ("lengthAdjust", string); + ("letterSpacing", string); + ("lightingColor", string); + ("limitingConeAngle", string); + ("local", string); + ("markerEnd", string); + ("markerHeight", string); + ("markerMid", string); + ("markerStart", string); + ("markerUnits", string); + ("markerWidth", string); + ("mask", string); + ("maskContentUnits", string); + ("maskUnits", string); + ("mathematical", string); + ("mode", string); + ("numOctaves", string); + ("offset", string); + ("opacity", string); + ("operator", string); + ("order", string); + ("orient", string); + ("orientation", string); + ("origin", string); + ("overflow", string); + ("overflowX", string); + ("overflowY", string); + ("overlinePosition", string); + ("overlineThickness", string); + ("paintOrder", string); + ("panose1", string); + ("pathLength", string); + ("patternContentUnits", string); + ("patternTransform", string); + ("patternUnits", string); + ("pointerEvents", string); + ("points", string); + ("pointsAtX", string); + ("pointsAtY", string); + ("pointsAtZ", string); + ("preserveAlpha", string); + ("preserveAspectRatio", string); + ("primitiveUnits", string); + ("r", string); + ("radius", string); + ("refX", string); + ("refY", string); + ("renderingIntent", string); + ("repeatCount", string); + ("repeatDur", string); + ("requiredExtensions", string); + ("requiredFeatures", string); + ("restart", string); + ("result", string); + ("rotate", string); + ("rx", string); + ("ry", string); + ("scale", string); + ("seed", string); + ("shapeRendering", string); + ("slope", string); + ("spacing", string); + ("specularConstant", string); + ("specularExponent", string); + ("speed", string); + ("spreadMethod", string); + ("startOffset", string); + ("stdDeviation", string); + ("stemh", string); + ("stemv", string); + ("stitchTiles", string); + ("stopColor", string); + ("stopOpacity", string); + ("strikethroughPosition", string); + ("strikethroughThickness", string); + (string, string); + ("stroke", string); + ("strokeDasharray", string); + ("strokeDashoffset", string); + ("strokeLinecap", string); + ("strokeLinejoin", string); + ("strokeMiterlimit", string); + ("strokeOpacity", string); + ("strokeWidth", string); + ("surfaceScale", string); + ("systemLanguage", string); + ("tableValues", string); + ("targetX", string); + ("targetY", string); + ("textAnchor", string); + ("textDecoration", string); + ("textLength", string); + ("textRendering", string); + ("transform", string); + ("u1", string); + ("u2", string); + ("underlinePosition", string); + ("underlineThickness", string); + ("unicode", string); + ("unicodeBidi", string); + ("unicodeRange", string); + ("unitsPerEm", string); + ("vAlphabetic", string); + ("vHanging", string); + ("vIdeographic", string); + ("vMathematical", string); + ("values", string); + ("vectorEffect", string); + ("version", string); + ("vertAdvX", string); + ("vertAdvY", string); + ("vertOriginX", string); + ("vertOriginY", string); + ("viewBox", string); + ("viewTarget", string); + ("visibility", string); + ("widths", string); + ("wordSpacing", string); + ("writingMode", string); + ("x", string); + ("x1", string); + ("x2", string); + ("xChannelSelector", string); + ("xHeight", string); + ("xlinkActuate", string); + ("xlinkArcrole", string); + ("xlinkHref", string); + ("xlinkRole", string); + ("xlinkShow", string); + ("xlinkTitle", string); + ("xlinkType", string); + ("xmlns", string); + ("xmlnsXlink", string); + ("xmlBase", string); + ("xmlLang", string); + ("xmlSpace", string); + ("y", string); + ("y1", string); + ("y2", string); + ("yChannelSelector", string); + ("z", string); + ("zoomAndPan", string); + ("about", string); + ("datatype", string); + ("inlist", string); + ("prefix", string); + ("property", string); + ("resource", string); + ("typeof", string); + ("vocab", string); + ("dangerouslySetInnerHTML", "{\"__html\": string}"); + ("suppressContentEditableWarning", bool); + ] + +let getJsxLabels ~componentPath ~findTypeOfValue ~package = + match componentPath @ ["make"] |> findTypeOfValue with + | Some (typ, make_env) -> + let rec getFieldsV3 (texp : Types.type_expr) = + match texp.desc with + | Tfield (name, _, t1, t2) -> + let fields = t2 |> getFieldsV3 in + if name = "children" then fields else (name, t1, make_env) :: fields + | Tlink te | Tsubst te | Tpoly (te, []) -> te |> getFieldsV3 + | Tvar None -> [] + | _ -> [] + in + let getFieldsV4 ~path ~typeArgs = + match References.digConstructor ~env:make_env ~package path with + | Some + ( env, + { + item = + { + decl = + { + type_kind = Type_record (labelDecls, _repr); + type_params = typeParams; + }; + }; + } ) -> + labelDecls + |> List.map (fun (ld : Types.label_declaration) -> + let name = Ident.name ld.ld_id in + let t = + ld.ld_type |> TypeUtils.instantiateType ~typeParams ~typeArgs + in + (name, t, env)) + | _ -> [] + in + let rec getLabels (t : Types.type_expr) = + match t.desc with + | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> getLabels t1 + | Tarrow + ( Nolabel, + { + desc = + ( Tconstr (* Js.t *) (_, [{desc = Tobject (tObj, _)}], _) + | Tobject (tObj, _) ); + }, + _, + _ ) -> + (* JSX V3 *) + getFieldsV3 tObj + | Tarrow (Nolabel, {desc = Tconstr (path, typeArgs, _)}, _, _) + when Path.last path = "props" -> + (* JSX V4 *) + getFieldsV4 ~path ~typeArgs + | Tconstr + ( clPath, + [ + { + desc = + ( Tconstr (* Js.t *) (_, [{desc = Tobject (tObj, _)}], _) + | Tobject (tObj, _) ); + }; + _; + ], + _ ) + when Path.name clPath = "React.componentLike" -> + (* JSX V3 external or interface *) + getFieldsV3 tObj + | Tconstr (clPath, [{desc = Tconstr (path, typeArgs, _)}; _], _) + when Path.name clPath = "React.componentLike" + && Path.last path = "props" -> + (* JSX V4 external or interface *) + getFieldsV4 ~path ~typeArgs + | _ -> [] + in + typ |> getLabels + | None -> [] + +type prop = { + name: string; + posStart: int * int; + posEnd: int * int; + exp: Parsetree.expression; +} + +type jsxProps = { + compName: Longident.t Location.loc; + props: prop list; + childrenStart: (int * int) option; +} + +let findJsxPropsCompletable ~jsxProps ~endPos ~posBeforeCursor + ~firstCharBeforeCursorNoWhite ~posAfterCompName = + let allLabels = + List.fold_right + (fun prop allLabels -> prop.name :: allLabels) + jsxProps.props [] + in + let rec loop props = + match props with + | prop :: rest -> + if prop.posStart <= posBeforeCursor && posBeforeCursor < prop.posEnd then + (* Cursor on the prop name *) + Some + (Completable.Cjsx + ( Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt, + prop.name, + allLabels )) + else if + prop.posEnd <= posBeforeCursor + && posBeforeCursor < Loc.start prop.exp.pexp_loc + then (* Cursor between the prop name and expr assigned *) + None + else if prop.exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then + (* Cursor on expr assigned *) + match + CompletionExpressions.traverseExpr prop.exp ~exprPath:[] + ~pos:posBeforeCursor ~firstCharBeforeCursorNoWhite + with + | Some (prefix, nested) -> + Some + (Cexpression + { + contextPath = + CJsxPropValue + { + pathToComponent = + Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt; + propName = prop.name; + }; + nested = List.rev nested; + prefix; + }) + | _ -> None + else if prop.exp.pexp_loc |> Loc.end_ = (Location.none |> Loc.end_) then + if CompletionExpressions.isExprHole prop.exp then + Some + (Cexpression + { + contextPath = + CJsxPropValue + { + pathToComponent = + Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt; + propName = prop.name; + }; + prefix = ""; + nested = []; + }) + else None + else loop rest + | [] -> + let beforeChildrenStart = + match jsxProps.childrenStart with + | Some childrenPos -> posBeforeCursor < childrenPos + | None -> posBeforeCursor <= endPos + in + let afterCompName = posBeforeCursor >= posAfterCompName in + if afterCompName && beforeChildrenStart then + Some + (Cjsx + ( Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt, + "", + allLabels )) + else None + in + loop jsxProps.props + +let extractJsxProps ~(compName : Longident.t Location.loc) ~args = + let thisCaseShouldNotHappen = + { + compName = Location.mknoloc (Longident.Lident ""); + props = []; + childrenStart = None; + } + in + let rec processProps ~acc args = + match args with + | (Asttypes.Labelled "children", {Parsetree.pexp_loc}) :: _ -> + { + compName; + props = List.rev acc; + childrenStart = + (if pexp_loc.loc_ghost then None else Some (Loc.start pexp_loc)); + } + | ((Labelled s | Optional s), (eProp : Parsetree.expression)) :: rest -> ( + let namedArgLoc = + eProp.pexp_attributes + |> List.find_opt (fun ({Asttypes.txt}, _) -> txt = "ns.namedArgLoc") + in + match namedArgLoc with + | Some ({loc}, _) -> + processProps + ~acc: + ({ + name = s; + posStart = Loc.start loc; + posEnd = Loc.end_ loc; + exp = eProp; + } + :: acc) + rest + | None -> processProps ~acc rest) + | _ -> thisCaseShouldNotHappen + in + args |> processProps ~acc:[] \ No newline at end of file diff --git a/analysis/src/CompletionPatterns.ml b/analysis/src/CompletionPatterns.ml new file mode 100644 index 000000000..074cdd90c --- /dev/null +++ b/analysis/src/CompletionPatterns.ml @@ -0,0 +1,244 @@ +open SharedTypes + +let isPatternHole pat = + match pat.Parsetree.ppat_desc with + | Ppat_extension ({txt = "rescript.patternhole"}, _) -> true + | _ -> false + +let isPatternTuple pat = + match pat.Parsetree.ppat_desc with + | Ppat_tuple _ -> true + | _ -> false + +let rec traverseTupleItems tupleItems ~nextPatternPath ~resultFromFoundItemNum + ~locHasCursor ~firstCharBeforeCursorNoWhite ~posBeforeCursor = + let itemNum = ref (-1) in + let itemWithCursor = + tupleItems + |> List.find_map (fun pat -> + itemNum := !itemNum + 1; + pat + |> traversePattern ~patternPath:(nextPatternPath !itemNum) + ~locHasCursor ~firstCharBeforeCursorNoWhite ~posBeforeCursor) + in + match (itemWithCursor, firstCharBeforeCursorNoWhite) with + | None, Some ',' -> + (* No tuple item has the cursor, but there's a comma before the cursor. + Figure out what arg we're trying to complete. Example: (true, , None) *) + let posNum = ref (-1) in + tupleItems + |> List.iteri (fun index pat -> + if posBeforeCursor >= Loc.start pat.Parsetree.ppat_loc then + posNum := index); + if !posNum > -1 then Some ("", resultFromFoundItemNum !posNum) else None + | v, _ -> v + +and traversePattern (pat : Parsetree.pattern) ~patternPath ~locHasCursor + ~firstCharBeforeCursorNoWhite ~posBeforeCursor = + let someIfHasCursor v = + if locHasCursor pat.Parsetree.ppat_loc then Some v else None + in + match pat.ppat_desc with + | Ppat_constant _ | Ppat_interval _ -> None + | Ppat_lazy p + | Ppat_constraint (p, _) + | Ppat_alias (p, _) + | Ppat_exception p + | Ppat_open (_, p) -> + p + |> traversePattern ~patternPath ~locHasCursor ~firstCharBeforeCursorNoWhite + ~posBeforeCursor + | Ppat_or (p1, p2) -> ( + let orPatWithItem = + [p1; p2] + |> List.find_map (fun p -> + p + |> traversePattern ~patternPath ~locHasCursor + ~firstCharBeforeCursorNoWhite ~posBeforeCursor) + in + match orPatWithItem with + | None when isPatternHole p1 || isPatternHole p2 -> Some ("", patternPath) + | v -> v) + | 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. *) + someIfHasCursor ("", patternPath) + | Ppat_var {txt} -> someIfHasCursor (txt, patternPath) + | Ppat_construct ({txt = Lident "()"}, None) -> + (* switch s { | () }*) + someIfHasCursor ("", patternPath @ [Completable.NTupleItem {itemNum = 0}]) + | Ppat_construct ({txt = Lident prefix}, None) -> + someIfHasCursor (prefix, patternPath) + | Ppat_variant (prefix, None) -> someIfHasCursor ("#" ^ prefix, patternPath) + | Ppat_array arrayPatterns -> + let nextPatternPath = [Completable.NArray] @ patternPath in + if List.length arrayPatterns = 0 && locHasCursor pat.ppat_loc then + Some ("", nextPatternPath) + else + arrayPatterns + |> List.find_map (fun pat -> + pat + |> traversePattern ~patternPath:nextPatternPath ~locHasCursor + ~firstCharBeforeCursorNoWhite ~posBeforeCursor) + | Ppat_tuple tupleItems when locHasCursor pat.ppat_loc -> + tupleItems + |> traverseTupleItems ~firstCharBeforeCursorNoWhite ~posBeforeCursor + ~locHasCursor + ~nextPatternPath:(fun itemNum -> + [Completable.NTupleItem {itemNum}] @ patternPath) + ~resultFromFoundItemNum:(fun itemNum -> + [Completable.NTupleItem {itemNum = itemNum + 1}] @ patternPath) + | Ppat_record ([], _) -> + (* Empty fields means we're in a record body `{}`. Complete for the fields. *) + someIfHasCursor + ("", [Completable.NRecordBody {seenFields = []}] @ patternPath) + | Ppat_record (fields, _) -> ( + let fieldWithCursor = ref None in + let fieldWithPatHole = ref None in + fields + |> List.iter (fun (fname, f) -> + match + ( fname.Location.txt, + f.Parsetree.ppat_loc + |> CursorPosition.classifyLoc ~pos:posBeforeCursor ) + with + | Longident.Lident fname, HasCursor -> + fieldWithCursor := Some (fname, f) + | Lident fname, _ when isPatternHole f -> + fieldWithPatHole := Some (fname, f) + | _ -> ()); + let seenFields = + fields + |> List.filter_map (fun (fieldName, _f) -> + match fieldName with + | {Location.txt = Longident.Lident fieldName} -> Some fieldName + | _ -> None) + in + match (!fieldWithCursor, !fieldWithPatHole) with + | Some (fname, f), _ | None, Some (fname, f) -> ( + match f.ppat_desc with + | Ppat_extension ({txt = "rescript.patternhole"}, _) -> + (* A pattern hole means for example `{someField: }`. We want to complete for the type of `someField`. *) + someIfHasCursor + ( "", + [Completable.NFollowRecordField {fieldName = fname}] @ patternPath + ) + | Ppat_var {txt} -> + (* A var means `{s}` or similar. Complete for fields. *) + someIfHasCursor + (txt, [Completable.NRecordBody {seenFields}] @ patternPath) + | _ -> + f + |> traversePattern + ~patternPath: + ([Completable.NFollowRecordField {fieldName = fname}] + @ patternPath) + ~locHasCursor ~firstCharBeforeCursorNoWhite ~posBeforeCursor) + | None, None -> ( + (* Figure out if we're completing for a new field. + If the cursor is inside of the record body, but no field has the cursor, + and there's no pattern hole. Check the first char to the left of the cursor, + ignoring white space. If that's a comma, we assume you're completing for a new field. *) + match firstCharBeforeCursorNoWhite with + | Some ',' -> + someIfHasCursor + ("", [Completable.NRecordBody {seenFields}] @ patternPath) + | _ -> None)) + | Ppat_construct + ( {txt}, + Some {ppat_loc; ppat_desc = Ppat_construct ({txt = Lident "()"}, _)} ) + when locHasCursor ppat_loc -> + (* Empty payload with cursor, like: Test() *) + Some + ( "", + [ + Completable.NVariantPayload + {constructorName = Utils.getUnqualifiedName txt; itemNum = 0}; + ] + @ patternPath ) + | Ppat_construct ({txt}, Some pat) + when posBeforeCursor >= (pat.ppat_loc |> Loc.end_) + && firstCharBeforeCursorNoWhite = Some ',' + && isPatternTuple pat = false -> + (* Empty payload with trailing ',', like: Test(true, ) *) + Some + ( "", + [ + Completable.NVariantPayload + {constructorName = Utils.getUnqualifiedName txt; itemNum = 1}; + ] + @ patternPath ) + | Ppat_construct ({txt}, Some {ppat_loc; ppat_desc = Ppat_tuple tupleItems}) + when locHasCursor ppat_loc -> + tupleItems + |> traverseTupleItems ~locHasCursor ~firstCharBeforeCursorNoWhite + ~posBeforeCursor + ~nextPatternPath:(fun itemNum -> + [ + Completable.NVariantPayload + {constructorName = Utils.getUnqualifiedName txt; itemNum}; + ] + @ patternPath) + ~resultFromFoundItemNum:(fun itemNum -> + [ + Completable.NVariantPayload + { + constructorName = Utils.getUnqualifiedName txt; + itemNum = itemNum + 1; + }; + ] + @ patternPath) + | Ppat_construct ({txt}, Some p) when locHasCursor pat.ppat_loc -> + p + |> traversePattern ~locHasCursor ~firstCharBeforeCursorNoWhite + ~posBeforeCursor + ~patternPath: + ([ + Completable.NVariantPayload + {constructorName = Utils.getUnqualifiedName txt; itemNum = 0}; + ] + @ patternPath) + | Ppat_variant + (txt, Some {ppat_loc; ppat_desc = Ppat_construct ({txt = Lident "()"}, _)}) + when locHasCursor ppat_loc -> + (* Empty payload with cursor, like: #test() *) + Some + ( "", + [Completable.NPolyvariantPayload {constructorName = txt; itemNum = 0}] + @ patternPath ) + | Ppat_variant (txt, Some pat) + when posBeforeCursor >= (pat.ppat_loc |> Loc.end_) + && firstCharBeforeCursorNoWhite = Some ',' + && isPatternTuple pat = false -> + (* Empty payload with trailing ',', like: #test(true, ) *) + Some + ( "", + [Completable.NPolyvariantPayload {constructorName = txt; itemNum = 1}] + @ patternPath ) + | Ppat_variant (txt, Some {ppat_loc; ppat_desc = Ppat_tuple tupleItems}) + when locHasCursor ppat_loc -> + tupleItems + |> traverseTupleItems ~locHasCursor ~firstCharBeforeCursorNoWhite + ~posBeforeCursor + ~nextPatternPath:(fun itemNum -> + [Completable.NPolyvariantPayload {constructorName = txt; itemNum}] + @ patternPath) + ~resultFromFoundItemNum:(fun itemNum -> + [ + Completable.NPolyvariantPayload + {constructorName = txt; itemNum = itemNum + 1}; + ] + @ patternPath) + | Ppat_variant (txt, Some p) when locHasCursor pat.ppat_loc -> + p + |> traversePattern ~locHasCursor ~firstCharBeforeCursorNoWhite + ~posBeforeCursor + ~patternPath: + ([ + Completable.NPolyvariantPayload + {constructorName = txt; itemNum = 0}; + ] + @ patternPath) + | _ -> None diff --git a/analysis/src/CreateInterface.ml b/analysis/src/CreateInterface.ml index 951d7183e..25048d4e8 100644 --- a/analysis/src/CreateInterface.ml +++ b/analysis/src/CreateInterface.ml @@ -262,8 +262,8 @@ let printSignature ~extractor ~signature = | [] -> retType | labelDecl :: rest -> let propType = - CompletionBackEnd.instantiateType ~typeParams:type_params - ~typeArgs labelDecl.ld_type + TypeUtils.instantiateType ~typeParams:type_params ~typeArgs + labelDecl.ld_type in let lblName = labelDecl.ld_id |> Ident.name in let lbl = diff --git a/analysis/src/LocalTables.ml b/analysis/src/LocalTables.ml new file mode 100644 index 000000000..772d5c815 --- /dev/null +++ b/analysis/src/LocalTables.ml @@ -0,0 +1,51 @@ +open SharedTypes + +type 'a table = (string * (int * int), 'a Declared.t) Hashtbl.t +type namesUsed = (string, unit) Hashtbl.t + +type t = { + namesUsed: namesUsed; + mutable resultRev: Completion.t list; + constructorTable: Constructor.t table; + modulesTable: Module.t table; + typesTable: Type.t table; + valueTable: Types.type_expr table; +} + +let create () = + { + namesUsed = Hashtbl.create 1; + resultRev = []; + constructorTable = Hashtbl.create 1; + modulesTable = Hashtbl.create 1; + typesTable = Hashtbl.create 1; + valueTable = Hashtbl.create 1; + } + +let populateValues ~env localTables = + env.QueryEnv.file.stamps + |> Stamps.iterValues (fun _ declared -> + Hashtbl.replace localTables.valueTable + (declared.name.txt, declared.extentLoc |> Loc.start) + declared) + +let populateConstructors ~env localTables = + env.QueryEnv.file.stamps + |> Stamps.iterConstructors (fun _ declared -> + Hashtbl.replace localTables.constructorTable + (declared.name.txt, declared.extentLoc |> Loc.start) + declared) + +let populateTypes ~env localTables = + env.QueryEnv.file.stamps + |> Stamps.iterTypes (fun _ declared -> + Hashtbl.replace localTables.typesTable + (declared.name.txt, declared.name.loc |> Loc.start) + declared) + +let populateModules ~env localTables = + env.QueryEnv.file.stamps + |> Stamps.iterModules (fun _ declared -> + Hashtbl.replace localTables.modulesTable + (declared.name.txt, declared.extentLoc |> Loc.start) + declared) diff --git a/analysis/src/SignatureHelp.ml b/analysis/src/SignatureHelp.ml index a31140320..9a2a8c1fd 100644 --- a/analysis/src/SignatureHelp.ml +++ b/analysis/src/SignatureHelp.ml @@ -31,9 +31,7 @@ let findFunctionType ~currentFile ~debug ~path ~pos = in match completables with | Some ({kind = Value type_expr; docstring} :: _, env, package, file) -> - let args, _ = - CompletionBackEnd.extractFunctionType type_expr ~env ~package - in + let args, _ = TypeUtils.extractFunctionType type_expr ~env ~package in Some (args, docstring, type_expr, package, env, file) | _ -> None diff --git a/analysis/src/TypeUtils.ml b/analysis/src/TypeUtils.ml new file mode 100644 index 000000000..c94041cfa --- /dev/null +++ b/analysis/src/TypeUtils.ml @@ -0,0 +1,250 @@ +open SharedTypes + +let instantiateType ~typeParams ~typeArgs (t : Types.type_expr) = + if typeParams = [] || typeArgs = [] then t + else + let rec applySub tp ta t = + match (tp, ta) with + | t1 :: tRest1, t2 :: tRest2 -> + if t1 = t then t2 else applySub tRest1 tRest2 t + | [], _ | _, [] -> t + in + let rec loop (t : Types.type_expr) = + match t.desc with + | Tlink t -> loop t + | Tvar _ -> applySub typeParams typeArgs t + | Tunivar _ -> t + | Tconstr (path, args, memo) -> + {t with desc = Tconstr (path, args |> List.map loop, memo)} + | Tsubst t -> loop t + | Tvariant rd -> {t with desc = Tvariant (rowDesc rd)} + | Tnil -> t + | Tarrow (lbl, t1, t2, c) -> + {t with desc = Tarrow (lbl, loop t1, loop t2, c)} + | Ttuple tl -> {t with desc = Ttuple (tl |> List.map loop)} + | Tobject (t, r) -> {t with desc = Tobject (loop t, r)} + | Tfield (n, k, t1, t2) -> {t with desc = Tfield (n, k, loop t1, loop t2)} + | Tpoly (t, []) -> loop t + | Tpoly (t, tl) -> {t with desc = Tpoly (loop t, tl |> List.map loop)} + | Tpackage (p, l, tl) -> + {t with desc = Tpackage (p, l, tl |> List.map loop)} + and rowDesc (rd : Types.row_desc) = + let row_fields = + rd.row_fields |> List.map (fun (l, rf) -> (l, rowField rf)) + in + let row_more = loop rd.row_more in + let row_name = + match rd.row_name with + | None -> None + | Some (p, tl) -> Some (p, tl |> List.map loop) + in + {rd with row_fields; row_more; row_name} + and rowField (rf : Types.row_field) = + match rf with + | Rpresent None -> rf + | Rpresent (Some t) -> Rpresent (Some (loop t)) + | Reither (b1, tl, b2, r) -> Reither (b1, tl |> List.map loop, b2, r) + | Rabsent -> Rabsent + in + loop t + +let rec extractRecordType ~env ~package (t : Types.type_expr) = + match t.desc with + | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractRecordType ~env ~package t1 + | Tconstr (path, typeArgs, _) -> ( + match References.digConstructor ~env ~package path with + | Some (env, ({item = {kind = Record fields}} as typ)) -> + let typeParams = typ.item.decl.type_params in + let fields = + fields + |> List.map (fun field -> + let fieldTyp = + field.typ |> instantiateType ~typeParams ~typeArgs + in + {field with typ = fieldTyp}) + in + Some (env, fields, typ) + | Some + ( env, + {item = {decl = {type_manifest = Some t1; type_params = typeParams}}} + ) -> + let t1 = t1 |> instantiateType ~typeParams ~typeArgs in + extractRecordType ~env ~package t1 + | _ -> None) + | _ -> None + +let rec extractObjectType ~env ~package (t : Types.type_expr) = + match t.desc with + | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractObjectType ~env ~package t1 + | Tobject (tObj, _) -> Some (env, tObj) + | Tconstr (path, typeArgs, _) -> ( + match References.digConstructor ~env ~package path with + | Some + ( env, + {item = {decl = {type_manifest = Some t1; type_params = typeParams}}} + ) -> + let t1 = t1 |> instantiateType ~typeParams ~typeArgs in + extractObjectType ~env ~package t1 + | _ -> None) + | _ -> None + +let extractFunctionType ~env ~package typ = + let rec loop ~env acc (t : Types.type_expr) = + match t.desc with + | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> loop ~env acc t1 + | Tarrow (label, tArg, tRet, _) -> loop ~env ((label, tArg) :: acc) tRet + | Tconstr (path, typeArgs, _) -> ( + match References.digConstructor ~env ~package path with + | Some + ( env, + { + item = {decl = {type_manifest = Some t1; type_params = typeParams}}; + } ) -> + let t1 = t1 |> instantiateType ~typeParams ~typeArgs in + loop ~env acc t1 + | _ -> (List.rev acc, t)) + | _ -> (List.rev acc, t) + in + loop ~env [] typ + +(** Pulls out a type we can complete from a type expr. *) +let rec extractType ~env ~package (t : Types.type_expr) = + match t.desc with + | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractType ~env ~package t1 + | Tconstr (Path.Pident {name = "option"}, [payloadTypeExpr], _) -> + Some (Completable.Toption (env, payloadTypeExpr)) + | Tconstr (Path.Pident {name = "array"}, [payloadTypeExpr], _) -> + Some (Tarray (env, payloadTypeExpr)) + | Tconstr (Path.Pident {name = "bool"}, [], _) -> Some (Tbool env) + | Tconstr (Path.Pident {name = "string"}, [], _) -> Some (Tstring env) + | Tconstr (path, _, _) -> ( + match References.digConstructor ~env ~package path with + | Some (env, {item = {decl = {type_manifest = Some t1}}}) -> + extractType ~env ~package t1 + | Some (env, {name; item = {decl; kind = Type.Variant constructors}}) -> + Some + (Tvariant + {env; constructors; variantName = name.txt; variantDecl = decl}) + | Some (env, {item = {kind = Record fields}}) -> + Some (Trecord {env; fields; typeExpr = t}) + | _ -> None) + | Ttuple expressions -> Some (Tuple (env, expressions, t)) + | Tvariant {row_fields} -> + let constructors = + row_fields + |> List.map (fun (label, field) -> + { + name = label; + args = + (* Multiple arguments are represented as a Ttuple, while a single argument is just the type expression itself. *) + (match field with + | Types.Rpresent (Some typeExpr) -> ( + match typeExpr.desc with + | Ttuple args -> args + | _ -> [typeExpr]) + | _ -> []); + }) + in + Some (Tpolyvariant {env; constructors; typeExpr = t}) + | _ -> None + +(** This moves through a nested path via a set of instructions, trying to resolve the type at the end of the path. *) +let rec resolveNested (typ : completionType) ~env ~package ~nested = + match nested with + | [] -> Some (typ, env, None) + | patternPath :: nested -> ( + let extractedType = + match typ with + | TypeExpr typ -> typ |> extractType ~env ~package + | InlineRecord fields -> Some (TinlineRecord {env; fields}) + in + match (patternPath, extractedType) with + | Completable.NTupleItem {itemNum}, Some (Tuple (env, tupleItems, _)) -> ( + match List.nth_opt tupleItems itemNum with + | None -> None + | Some typ -> TypeExpr typ |> resolveNested ~env ~package ~nested) + | ( NFollowRecordField {fieldName}, + Some (TinlineRecord {env; fields} | Trecord {env; fields}) ) -> ( + match + fields + |> List.find_opt (fun (field : field) -> field.fname.txt = fieldName) + with + | None -> None + | Some {typ; optional} -> + let typ = if optional then Utils.unwrapIfOption typ else typ in + TypeExpr typ |> resolveNested ~env ~package ~nested) + | NRecordBody {seenFields}, Some (Trecord {env; typeExpr}) -> + Some (TypeExpr typeExpr, env, Some (Completable.RecordField {seenFields})) + | NRecordBody {seenFields}, Some (TinlineRecord {env; fields}) -> + Some + (InlineRecord fields, env, Some (Completable.RecordField {seenFields})) + | ( NVariantPayload {constructorName = "Some"; itemNum = 0}, + Some (Toption (env, typ)) ) -> + TypeExpr typ |> resolveNested ~env ~package ~nested + | ( NVariantPayload {constructorName; itemNum}, + Some (Tvariant {env; constructors}) ) -> ( + match + constructors + |> List.find_opt (fun (c : Constructor.t) -> + c.cname.txt = constructorName) + with + | Some {args = Args args} -> ( + match List.nth_opt args itemNum with + | None -> None + | Some (typ, _) -> TypeExpr typ |> resolveNested ~env ~package ~nested) + | Some {args = InlineRecord fields} when itemNum = 0 -> + InlineRecord fields |> resolveNested ~env ~package ~nested + | _ -> None) + | ( NPolyvariantPayload {constructorName; itemNum}, + Some (Tpolyvariant {env; constructors}) ) -> ( + match + constructors + |> List.find_opt (fun (c : polyVariantConstructor) -> + c.name = constructorName) + with + | None -> None + | Some constructor -> ( + match List.nth_opt constructor.args itemNum with + | None -> None + | Some typ -> TypeExpr typ |> resolveNested ~env ~package ~nested)) + | NArray, Some (Tarray (env, typ)) -> + TypeExpr typ |> resolveNested ~env ~package ~nested + | _ -> None) + +let findReturnTypeOfFunctionAtLoc loc ~(env : QueryEnv.t) ~full ~debug = + match References.getLocItem ~full ~pos:(loc |> Loc.end_) ~debug with + | Some {locType = Typed (_, typExpr, _)} -> ( + match extractFunctionType ~env ~package:full.package typExpr with + | args, tRet when args <> [] -> Some tRet + | _ -> None) + | _ -> None + +let getArgs ~env (t : Types.type_expr) ~full = + let rec getArgsLoop ~env (t : Types.type_expr) ~full ~currentArgumentPosition + = + match t.desc with + | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> + getArgsLoop ~full ~env ~currentArgumentPosition t1 + | Tarrow (Labelled l, tArg, tRet, _) -> + (SharedTypes.Completable.Labelled l, tArg) + :: getArgsLoop ~full ~env ~currentArgumentPosition tRet + | Tarrow (Optional l, tArg, tRet, _) -> + (Optional l, tArg) :: getArgsLoop ~full ~env ~currentArgumentPosition tRet + | Tarrow (Nolabel, tArg, tRet, _) -> + (Unlabelled {argumentPosition = currentArgumentPosition}, tArg) + :: getArgsLoop ~full ~env + ~currentArgumentPosition:(currentArgumentPosition + 1) + tRet + | Tconstr (path, typeArgs, _) -> ( + match References.digConstructor ~env ~package:full.package path with + | Some + ( env, + { + item = {decl = {type_manifest = Some t1; type_params = typeParams}}; + } ) -> + let t1 = t1 |> instantiateType ~typeParams ~typeArgs in + getArgsLoop ~full ~env ~currentArgumentPosition t1 + | _ -> []) + | _ -> [] + in + t |> getArgsLoop ~env ~full ~currentArgumentPosition:0 diff --git a/analysis/src/Utils.ml b/analysis/src/Utils.ml index d62334bc7..19f41d93c 100644 --- a/analysis/src/Utils.ml +++ b/analysis/src/Utils.ml @@ -173,3 +173,12 @@ let isReactComponent (vb : Parsetree.value_binding) = |> List.exists (function | {Location.txt = "react.component"}, _payload -> true | _ -> false) + +let checkName name ~prefix ~exact = + if exact then name = prefix else startsWith name prefix + +let rec getUnqualifiedName txt = + match txt with + | Longident.Lident fieldName -> fieldName + | Ldot (t, _) -> getUnqualifiedName t + | _ -> "" \ No newline at end of file