diff --git a/analysis/src/Cmt.ml b/analysis/src/Cmt.ml index a433d12908..4a926567b8 100644 --- a/analysis/src/Cmt.ml +++ b/analysis/src/Cmt.ml @@ -30,7 +30,7 @@ let fullFromUri ~uri = in match incremental with | Some cmtInfo -> - if Debug.verbose () then Printf.printf "[cmt] Found incremental cmt\n"; + Debug.verbose "[cmt] Found incremental cmt"; Some cmtInfo | None -> ( match Hashtbl.find_opt package.pathsForModule moduleName with diff --git a/analysis/src/Commands.ml b/analysis/src/Commands.ml index 464b3fa53d..329de2c7d3 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -25,15 +25,13 @@ let completionResolve ~path ~modulePath = let docstring = match Cmt.loadFullCmtFromPath ~path with | None -> - if Debug.verbose () then - Printf.printf "[completion_resolve] Could not load cmt\n"; + Debug.verbose "[completion_resolve] Could not load cmt"; Protocol.null | Some full -> ( match ProcessCmt.fileForModule ~package:full.package moduleName with | None -> - if Debug.verbose () then - Printf.printf "[completion_resolve] Did not find file for module %s\n" - moduleName; + Debug.verbose "[completion_resolve] Did not find file for module %s" + moduleName; Protocol.null | Some file -> file.structure.docstring |> String.concat "\n\n" @@ -349,8 +347,7 @@ let test ~path = | "ve+" -> ( let version = String.sub rest 3 (String.length rest - 3) in let version = String.trim version in - if Debug.verbose () then - Printf.printf "Setting version: %s\n" version; + Debug.verbose "Setting version: %s" version; match String.split_on_char '.' version with | [majorRaw; minorRaw] -> let version = (int_of_string majorRaw, int_of_string minorRaw) in diff --git a/analysis/src/CompletionBackEnd.ml b/analysis/src/CompletionBackEnd.ml index 3becd1cecf..42168514de 100644 --- a/analysis/src/CompletionBackEnd.ml +++ b/analysis/src/CompletionBackEnd.ml @@ -822,26 +822,25 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact let package = full.package in match contextPath with | CPString -> - if Debug.verbose () then print_endline "[ctx_path]--> CPString"; + Debug.verbose "[ctx_path]--> CPString"; [Completion.create "dummy" ~env ~kind:(Completion.Value Predef.type_string)] | CPBool -> - if Debug.verbose () then print_endline "[ctx_path]--> CPBool"; + Debug.verbose "[ctx_path]--> CPBool"; [Completion.create "dummy" ~env ~kind:(Completion.Value Predef.type_bool)] | CPInt -> - if Debug.verbose () then print_endline "[ctx_path]--> CPInt"; + Debug.verbose "[ctx_path]--> CPInt"; [Completion.create "dummy" ~env ~kind:(Completion.Value Predef.type_int)] | CPFloat -> - if Debug.verbose () then print_endline "[ctx_path]--> CPFloat"; + Debug.verbose "[ctx_path]--> CPFloat"; [Completion.create "dummy" ~env ~kind:(Completion.Value Predef.type_float)] | CPArray None -> - if Debug.verbose () then print_endline "[ctx_path]--> CPArray (no payload)"; + Debug.verbose "[ctx_path]--> CPArray (no payload)"; [ Completion.create "array" ~env ~kind:(Completion.Value (Ctype.newconstr Predef.path_array [])); ] | CPArray (Some cp) -> ( - if Debug.verbose () then - print_endline "[ctx_path]--> CPArray (with payload)"; + Debug.verbose "[ctx_path]--> CPArray (with payload)"; match mode with | Regular -> ( match @@ -865,7 +864,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact ~kind:(Completion.Value (Ctype.newconstr Predef.path_array [])); ]) | CPOption cp -> ( - if Debug.verbose () then print_endline "[ctx_path]--> CPOption"; + Debug.verbose "[ctx_path]--> CPOption"; match cp |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env @@ -880,7 +879,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact (Completion.ExtractedType (Toption (env, ExtractedType typ), `Type)); ]) | CPAwait cp -> ( - if Debug.verbose () then print_endline "[ctx_path]--> CPAwait"; + Debug.verbose "[ctx_path]--> CPAwait"; match cp |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env @@ -891,7 +890,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact [Completion.create "dummy" ~env ~kind:(Completion.Value typ)] | _ -> []) | CPId {path; completionContext; loc} -> - if Debug.verbose () then print_endline "[ctx_path]--> CPId"; + Debug.verbose "[ctx_path]--> CPId"; (* Looks up the type of an identifier. Because of reasons we sometimes don't get enough type @@ -930,7 +929,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact in result | CPApply (cp, labels) -> ( - if Debug.verbose () then print_endline "[ctx_path]--> CPApply"; + Debug.verbose "[ctx_path]--> CPApply"; match cp |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env @@ -974,13 +973,13 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact | _ -> []) | CPField {contextPath = CPId {path; completionContext = Module}; fieldName} -> - if Debug.verbose () then print_endline "[ctx_path]--> CPField: M.field"; + Debug.verbose "[ctx_path]--> CPField: M.field"; (* M.field *) path @ [fieldName] |> getCompletionsForPath ~debug ~opens ~full ~pos ~exact ~completionContext:Field ~env ~scope | CPField {contextPath = cp; fieldName; posOfDot; exprLoc} -> ( - if Debug.verbose () then print_endline "[dot_completion]--> Triggered"; + Debug.verbose "[dot_completion]--> Triggered"; let completionsFromCtxPath = cp |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env @@ -992,9 +991,8 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact in match mainTypeCompletionEnv with | None -> - if Debug.verbose () then - Printf.printf - "[dot_completion] Could not extract main type completion env.\n"; + Debug.verbose + "[dot_completion] Could not extract main type completion env."; [] | Some (typ, env) -> let fieldCompletions = @@ -1028,7 +1026,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact fieldCompletions @ pipeCompletions) | CPObj (cp, label) -> ( (* TODO: Also needs to support ExtractedType *) - if Debug.verbose () then print_endline "[ctx_path]--> CPObj"; + Debug.verbose "[ctx_path]--> CPObj"; match cp |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env @@ -1047,7 +1045,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact | None -> []) | None -> []) | CPPipe {contextPath = cp; id = prefix; lhsLoc; inJsx; synthetic} -> ( - if Debug.verbose () then print_endline "[ctx_path]--> CPPipe"; + Debug.verbose "[ctx_path]--> CPPipe"; match cp |> getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env @@ -1055,8 +1053,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact |> completionsGetTypeEnv2 ~debug ~full ~opens ~rawOpens ~pos with | None -> - if Debug.verbose () then - print_endline "[CPPipe]--> Could not resolve type env"; + Debug.verbose "[CPPipe]--> Could not resolve type env"; [] | Some (typ, env) -> ( let env, typ = @@ -1068,14 +1065,12 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact let typePath = TypeUtils.pathFromTypeExpr typ in match mainTypeId with | None -> - if Debug.verbose () then - Printf.printf - "[pipe_completion] Could not find mainTypeId. Aborting pipe \ - completions.\n"; + Debug.verbose + "[pipe_completion] Could not find mainTypeId. Aborting pipe \ + completions."; [] | Some mainTypeId -> - if Debug.verbose () then - Printf.printf "[pipe_completion] mainTypeId: %s\n" mainTypeId; + Debug.verbose "[pipe_completion] mainTypeId: %s" mainTypeId; let pipeCompletions = (* We now need a completion path from where to look up the module for our dot completion type. This is from where we pull all of the functions we want to complete for the pipe. @@ -1156,7 +1151,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact in jsxCompletions @ pipeCompletions @ extraCompletions)) | CTuple ctxPaths -> - if Debug.verbose () then print_endline "[ctx_path]--> CTuple"; + Debug.verbose "[ctx_path]--> CTuple"; (* Turn a list of context paths into a list of type expressions. *) let typeExrps = ctxPaths @@ -1176,7 +1171,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact ] else [] | CJsxPropValue {pathToComponent; propName; emptyJsxPropNameHint} -> ( - if Debug.verbose () then print_endline "[ctx_path]--> CJsxPropValue"; + Debug.verbose "[ctx_path]--> CJsxPropValue"; let findTypeOfValue path = path |> getCompletionsForPath ~debug ~completionContext:Value ~exact:true @@ -1245,12 +1240,11 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact ~kind:(Completion.Value (Utils.unwrapIfOption typ)); ]) | CArgument {functionContextPath; argumentLabel} -> ( - if Debug.verbose () then print_endline "[ctx_path]--> CArgument"; - if Debug.verbose () then - Printf.printf "--> function argument: %s\n" - (match argumentLabel with - | Labelled n | Optional n -> n - | Unlabelled {argumentPosition} -> "$" ^ string_of_int argumentPosition); + Debug.verbose "[ctx_path]--> CArgument"; + Debug.verbose "--> function argument: %s" + (match argumentLabel with + | Labelled n | Optional n -> n + | Unlabelled {argumentPosition} -> "$" ^ string_of_int argumentPosition); let labels, env = match @@ -1260,11 +1254,10 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact |> completionsGetCompletionType2 ~debug ~full ~opens ~rawOpens ~pos with | Some ((TypeExpr typ | ExtractedType (Tfunction {typ})), env) -> - if Debug.verbose () then print_endline "--> found function type"; + Debug.verbose "--> found function type"; (typ |> TypeUtils.getArgs ~full ~env, env) | _ -> - if Debug.verbose () then - print_endline "--> could not find function type"; + Debug.verbose "--> could not find function type"; ([], env) in let targetLabel = @@ -1286,11 +1279,10 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact in match targetLabel with | None -> - if Debug.verbose () then - print_endline "--> could not look up function argument"; + Debug.verbose "--> could not look up function argument"; [] | Some (_, typ) -> - if Debug.verbose () then print_endline "--> found function argument!"; + Debug.verbose "--> found function argument!"; [ Completion.create "dummy" ~env ~kind: @@ -1298,7 +1290,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact (if expandOption then Utils.unwrapIfOption typ else typ)); ]) | CPatternPath {rootCtxPath; nested} -> ( - if Debug.verbose () then print_endline "[ctx_path]--> CPatternPath"; + Debug.verbose "[ctx_path]--> CPatternPath"; (* TODO(env-stuff) Get rid of innerType etc *) match rootCtxPath @@ -1313,7 +1305,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact | None -> []) | None -> []) | CTypeAtPos loc -> ( - if Debug.verbose () then print_endline "[ctx_path]--> CTypeAtPos"; + Debug.verbose "[ctx_path]--> CTypeAtPos"; match TypeUtils.findTypeViaLoc loc ~full ~debug with | None -> [] | Some typExpr -> [Completion.create "dummy" ~env ~kind:(Value typExpr)]) @@ -1381,8 +1373,7 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens let create = Completion.create ?typeArgContext in match t with | TtypeT {env; path} when mode = Expression -> - if Debug.verbose () then - print_endline "[complete_typed_value]--> TtypeT (Expression)"; + Debug.verbose "[complete_typed_value]--> TtypeT (Expression)"; (* Find all values in the module with type t *) let valueWithTypeT t = match t.Types.desc with @@ -1461,15 +1452,14 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens in completionItems | Tbool env -> - if Debug.verbose () then print_endline "[complete_typed_value]--> Tbool"; + Debug.verbose "[complete_typed_value]--> Tbool"; [ create "true" ~kind:(Label "bool") ~env; create "false" ~kind:(Label "bool") ~env; ] |> filterItems ~prefix | TtypeT {env; path} -> - if Debug.verbose () then - print_endline "[complete_typed_value]--> TtypeT (Pattern)"; + Debug.verbose "[complete_typed_value]--> TtypeT (Pattern)"; (* This is in patterns. Emit an alias/binding with the module name as a value name. *) if prefix <> "" then [] else @@ -1484,7 +1474,7 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens ~includesSnippets:true; ] | Tvariant {env; constructors; variantDecl; variantName} -> - if Debug.verbose () then print_endline "[complete_typed_value]--> Tvariant"; + Debug.verbose "[complete_typed_value]--> Tvariant"; constructors |> List.map (fun (constructor : Constructor.t) -> let numArgs = @@ -1504,8 +1494,7 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens ~env) |> filterItems ~prefix | Tpolyvariant {env; constructors; typeExpr} -> - if Debug.verbose () then - print_endline "[complete_typed_value]--> Tpolyvariant"; + Debug.verbose "[complete_typed_value]--> Tpolyvariant"; constructors |> List.map (fun (constructor : polyVariantConstructor) -> create @@ -1527,7 +1516,7 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens |> filterItems ~prefix:(if Utils.startsWith prefix "#" then prefix else "#" ^ prefix) | Toption (env, t) -> - if Debug.verbose () then print_endline "[complete_typed_value]--> Toption"; + Debug.verbose "[complete_typed_value]--> Toption"; let innerType = match t with | ExtractedType t -> Some (t, None) @@ -1570,7 +1559,7 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens in completions @ expandedCompletions |> filterItems ~prefix | Tresult {env; okType; errorType} -> - if Debug.verbose () then print_endline "[complete_typed_value]--> Tresult"; + Debug.verbose "[complete_typed_value]--> Tresult"; let okInnerType = okType |> TypeUtils.extractType ~env ~package:full.package in @@ -1635,7 +1624,7 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens completions @ expandedOkCompletions @ expandedErrorCompletions |> filterItems ~prefix | Tuple (env, exprs, typ) -> - if Debug.verbose () then print_endline "[complete_typed_value]--> Tuple"; + Debug.verbose "[complete_typed_value]--> Tuple"; let numExprs = List.length exprs in [ create @@ -1645,7 +1634,7 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens ~kind:(Value typ) ~env; ] | Trecord {env; fields} as extractedType -> ( - if Debug.verbose () then print_endline "[complete_typed_value]--> Trecord"; + Debug.verbose "[complete_typed_value]--> Trecord"; (* As we're completing for a record, we'll need a hint (completionContext) here to figure out whether we should complete for a record field, or the record body itself. *) @@ -1687,8 +1676,7 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens ] else []) | TinlineRecord {env; fields} -> ( - if Debug.verbose () then - print_endline "[complete_typed_value]--> TinlineRecord"; + Debug.verbose "[complete_typed_value]--> TinlineRecord"; match completionContext with | Some (Completable.RecordField {seenFields}) -> fields @@ -1706,7 +1694,7 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens ] else []) | Tarray (env, typ) -> - if Debug.verbose () then print_endline "[complete_typed_value]--> Tarray"; + Debug.verbose "[complete_typed_value]--> Tarray"; if prefix = "" then [ create "[]" ~includesSnippets:true ~insertText:"[$0]" ~sortText:"A" @@ -1723,7 +1711,7 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens ] else [] | Tstring env -> - if Debug.verbose () then print_endline "[complete_typed_value]--> Tstring"; + Debug.verbose "[complete_typed_value]--> Tstring"; if prefix = "" then [ create "\"\"" ~includesSnippets:true ~insertText:"\"$0\"" ~sortText:"A" @@ -1732,8 +1720,7 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens else [] | Tfunction {env; typ; args; returnType} when prefix = "" && mode = Expression -> - if Debug.verbose () then - print_endline "[complete_typed_value]--> Tfunction #1"; + Debug.verbose "[complete_typed_value]--> Tfunction #1"; let shouldPrintAsUncurried = false in let mkFnArgs ~asSnippet = match args with @@ -1794,11 +1781,10 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens ~sortText:"A" ~kind:(Value typ) ~env; ] | Tfunction _ -> - if Debug.verbose () then - print_endline "[complete_typed_value]--> Tfunction #other"; + Debug.verbose "[complete_typed_value]--> Tfunction #other"; [] | Texn env -> - if Debug.verbose () then print_endline "[complete_typed_value]--> Texn"; + Debug.verbose "[complete_typed_value]--> Texn"; [ create (full.package.builtInCompletionModules.exnModulePath @ ["Error(error)"] @@ -1813,7 +1799,7 @@ let rec completeTypedValue ?(typeArgContext : typeArgContext option) ~rawOpens ~env; ] | Tpromise _ -> - if Debug.verbose () then print_endline "[complete_typed_value]--> Tpromise"; + Debug.verbose "[complete_typed_value]--> Tpromise"; [] module StringSet = Set.Make (String) @@ -1846,10 +1832,9 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable = if Utils.startsWith "key" prefix then [mkLabel ("key", "string")] else [] in let pathToElementProps = TypeUtils.pathToElementProps package in - if Debug.verbose () then - Printf.printf - "[completing-lowercase-jsx] Attempting to complete from type at %s\n" - (pathToElementProps |> String.concat "."); + Debug.verbose + "[completing-lowercase-jsx] Attempting to complete from type at %s" + (pathToElementProps |> String.concat "."); let fromElementProps = match pathToElementProps @@ -2148,17 +2133,16 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable = | CJsxPropValue _, [NRecordBody _] -> true | _ -> false in - if Debug.verbose () then - (* This happens in this scenario: `}` - Here, we don't know whether `{}` is just wraps for the type of - `someProp`, or if it's a record body where we want to complete - for the fields in the record. We need to look up what the type is - first before deciding what completions to show. So we do that here.*) - if isAmbigiousRecordBodyOrJsxWrap then - print_endline - "[process_completable]--> Cexpression special case: JSX prop value \ - that might be record body or JSX wrap" - else print_endline "[process_completable]--> Cexpression"; + (* This happens in this scenario: `}` + Here, we don't know whether `{}` is just wraps for the type of + `someProp`, or if it's a record body where we want to complete + for the fields in the record. We need to look up what the type is + first before deciding what completions to show. So we do that here.*) + if isAmbigiousRecordBodyOrJsxWrap then + Debug.verbose + "[process_completable]--> Cexpression special case: JSX prop value \ + that might be record body or JSX wrap" + else Debug.verbose "[process_completable]--> Cexpression"; (* Completions for local things like variables in scope, modules in the project, etc. We only add completions when there's a prefix of some sort we can filter on, since we know we're in some sort of context, and @@ -2176,21 +2160,18 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable = |> completionsGetCompletionType ~full with | None -> - if Debug.verbose () then - print_endline - "[process_completable]--> could not get completions for context path"; + Debug.verbose + "[process_completable]--> could not get completions for context path"; regularCompletions | Some (typ, env) -> ( match typ |> TypeUtils.resolveNested ~env ~full ~nested with | None -> - if Debug.verbose () then - print_endline - "[process_completable]--> could not resolve nested expression path"; + Debug.verbose + "[process_completable]--> could not resolve nested expression path"; if isAmbigiousRecordBodyOrJsxWrap then ( - if Debug.verbose () then - print_endline - "[process_completable]--> case is ambigious Jsx prop vs record \ - body case, complete also for the JSX prop value directly"; + Debug.verbose + "[process_completable]--> case is ambigious Jsx prop vs record \ + body case, complete also for the JSX prop value directly"; let itemsForRawJsxPropValue = typ |> completeTypedValue ~rawOpens ~mode:Expression ~full ~prefix @@ -2199,10 +2180,8 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable = itemsForRawJsxPropValue @ regularCompletions) else regularCompletions | Some (typ, _env, completionContext, typeArgContext) -> ( - if Debug.verbose () then - print_endline - "[process_completable]--> found type in nested expression \ - completion"; + Debug.verbose + "[process_completable]--> found type in nested expression completion"; (* Wrap the insert text in braces when we're completing the root of a JSX prop value. *) let wrapInsertTextInBraces = @@ -2255,7 +2234,7 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable = user has already written. Just complete for the rest. *) let newText = c.name ^ " {\n" - ^ (cases + ^ (cases |> List.sort String.compare |> List.mapi (fun index caseText -> "| " ^ caseText ^ " => " ^ printFailwithStr (startIndex + index + 1)) diff --git a/analysis/src/CompletionExpressions.ml b/analysis/src/CompletionExpressions.ml index e5858d1ee6..fa246f96d0 100644 --- a/analysis/src/CompletionExpressions.ml +++ b/analysis/src/CompletionExpressions.ml @@ -98,13 +98,10 @@ let rec traverseExpr (exp : Parsetree.expression) ~exprPath ~pos ([Completable.NFollowRecordField {fieldName = fname}] @ exprPath) ) | None, None -> ( - if Debug.verbose () then ( - Printf.printf "[traverse_expr] No field with cursor and no expr hole.\n"; - - match firstCharBeforeCursorNoWhite with - | None -> () - | Some c -> - Printf.printf "[traverse_expr] firstCharBeforeCursorNoWhite: %c.\n" c); + Debug.verbose "[traverse_expr] No field with cursor and no expr hole."; + firstCharBeforeCursorNoWhite + |> Option.iter + (Debug.verbose "[traverse_expr] firstCharBeforeCursorNoWhite: %c."); (* 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, diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index 4ca35778a8..74cc8b4fdb 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -23,23 +23,20 @@ let findArgCompletables ~(args : arg list) ~endPos ~posBeforeCursor labelled.posStart <= posBeforeCursor && posBeforeCursor < labelled.posEnd then ( - if Debug.verbose () then - print_endline "[findArgCompletables] Completing named arg #2"; + Debug.verbose "[findArgCompletables] Completing named arg #2"; Some (Completable.CnamedArg (contextPath, labelled.name, allNames))) else if exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then ( - if Debug.verbose () then - print_endline - "[findArgCompletables] Completing in the assignment of labelled \ - argument"; + Debug.verbose + "[findArgCompletables] Completing in the assignment of labelled \ + argument"; match CompletionExpressions.traverseExpr exp ~exprPath:[] ~pos:posBeforeCursor ~firstCharBeforeCursorNoWhite with | None -> None | Some (prefix, nested) -> - if Debug.verbose () then - print_endline - "[findArgCompletables] Completing for labelled argument value"; + Debug.verbose + "[findArgCompletables] Completing for labelled argument value"; Some (Cexpression { @@ -53,8 +50,7 @@ let findArgCompletables ~(args : arg list) ~endPos ~posBeforeCursor nested = List.rev nested; })) else if CompletionExpressions.isExprHole exp then ( - if Debug.verbose () then - print_endline "[findArgCompletables] found exprhole"; + Debug.verbose "[findArgCompletables] found exprhole"; Some (Cexpression { @@ -69,9 +65,8 @@ let findArgCompletables ~(args : arg list) ~endPos ~posBeforeCursor })) else loop rest | {label = None; exp} :: rest -> - if Debug.verbose () then - Printf.printf "[findArgCompletable] unlabelled arg expr is: %s \n" - (DumpAst.printExprItem ~pos:posBeforeCursor ~indentation:0 exp); + Debug.verbose "[findArgCompletable] unlabelled arg expr is: %s" + (DumpAst.printExprItem ~pos:posBeforeCursor ~indentation:0 exp); (* Track whether there was an arg with an empty loc (indicates parser error)*) if CursorPosition.locIsEmpty exp.pexp_loc ~pos:posBeforeCursor then @@ -79,22 +74,19 @@ let findArgCompletables ~(args : arg list) ~endPos ~posBeforeCursor if Res_parsetree_viewer.is_template_literal exp then None else if exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then ( - if Debug.verbose () then - print_endline - "[findArgCompletables] Completing in an unlabelled argument"; + Debug.verbose + "[findArgCompletables] Completing in an unlabelled argument"; match CompletionExpressions.traverseExpr exp ~pos:posBeforeCursor ~firstCharBeforeCursorNoWhite ~exprPath:[] with | None -> - if Debug.verbose () then - print_endline - "[findArgCompletables] found nothing when traversing expr"; + Debug.verbose + "[findArgCompletables] found nothing when traversing expr"; None | Some (prefix, nested) -> - if Debug.verbose () then - print_endline - "[findArgCompletables] completing for unlabelled argument #2"; + Debug.verbose + "[findArgCompletables] completing for unlabelled argument #2"; Some (Cexpression { @@ -109,8 +101,7 @@ let findArgCompletables ~(args : arg list) ~endPos ~posBeforeCursor nested = List.rev nested; })) else if CompletionExpressions.isExprHole exp then ( - if Debug.verbose () then - print_endline "[findArgCompletables] found an exprhole #2"; + Debug.verbose "[findArgCompletables] found an exprhole #2"; Some (Cexpression { @@ -130,12 +121,10 @@ let findArgCompletables ~(args : arg list) ~endPos ~posBeforeCursor | [] -> let hadEmptyExpLoc = !someArgHadEmptyExprLoc in if fnHasCursor then ( - if Debug.verbose () then - print_endline "[findArgCompletables] Function has cursor"; + Debug.verbose "[findArgCompletables] Function has cursor"; match charBeforeCursor with | Some '~' -> - if Debug.verbose () then - print_endline "[findArgCompletables] '~' is before cursor"; + Debug.verbose "[findArgCompletables] '~' is before cursor"; Some (Completable.CnamedArg (contextPath, "", allNames)) | _ when hadEmptyExpLoc -> (* Special case: `Console.log(arr->)`, completing on the pipe. @@ -150,22 +139,20 @@ let findArgCompletables ~(args : arg list) ~endPos ~posBeforeCursor This can be handled in a more robust way in a future refactor of the completion engine logic. *) - if Debug.verbose () then - print_endline - "[findArgCompletables] skipping completion in fn call because \ - arg had empty loc"; + Debug.verbose + "[findArgCompletables] skipping completion in fn call because arg \ + had empty loc"; None | _ when firstCharBeforeCursorNoWhite = Some '(' || firstCharBeforeCursorNoWhite = Some ',' -> (* Checks to ensure that completing for empty unlabelled arg makes sense by checking what's left of the cursor. *) - if Debug.verbose () then - Printf.printf - "[findArgCompletables] Completing for unlabelled argument value \ - because nothing matched and is not labelled argument name \ - completion. isPipedExpr: %b\n" - isPipedExpr; + Debug.verbose + "[findArgCompletables] Completing for unlabelled argument value \ + because nothing matched and is not labelled argument name \ + completion. isPipedExpr: %b" + isPipedExpr; Some (Cexpression { @@ -188,8 +175,7 @@ let findArgCompletables ~(args : arg list) ~endPos ~posBeforeCursor {label = None; exp = {pexp_desc = Pexp_construct ({txt = Lident "()"}, _)}}; ] when fnHasCursor -> - if Debug.verbose () then - print_endline "[findArgCompletables] Completing for unit argument"; + Debug.verbose "[findArgCompletables] Completing for unit argument"; Some (Completable.Cexpression { @@ -419,14 +405,12 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor if !result = None then match x with | None -> - if Debug.verbose () then - print_endline - "[set_result] did not set new result because result already was set"; + Debug.verbose + "[set_result] did not set new result because result already was set"; () | Some x -> - if Debug.verbose () then - Printf.printf "[set_result] set new result to %s\n" - (Completable.toString x); + Debug.verbose "[set_result] set new result to %s" + (Completable.toString x); result := Some (x, !scope) in let setResult x = setResultOpt (Some x) in @@ -545,8 +529,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor contextPath ) with | Some (prefix, nestedPattern), Some ctxPath -> - if Debug.verbose () then - Printf.printf "[completePattern] found pattern that can be completed\n"; + Debug.verbose "[completePattern] found pattern that can be completed"; setResult (Completable.Cpattern { @@ -602,16 +585,16 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor let typedCompletionExpr (exp : Parsetree.expression) = let debugTypedCompletionExpr = false in if exp.pexp_loc |> CursorPosition.locHasCursor ~pos:posBeforeCursor then ( - if Debug.verbose () && debugTypedCompletionExpr then - print_endline "[typedCompletionExpr] Has cursor"; + if debugTypedCompletionExpr then + Debug.verbose "[typedCompletionExpr] Has cursor"; match exp.pexp_desc with (* No cases means there's no `|` yet in the switch *) | Pexp_match (({pexp_desc = Pexp_ident _} as expr), []) -> - if Debug.verbose () && debugTypedCompletionExpr then - print_endline "[typedCompletionExpr] No cases, with ident"; + if debugTypedCompletionExpr then + Debug.verbose "[typedCompletionExpr] No cases, with ident"; if locHasCursor expr.pexp_loc then ( - if Debug.verbose () && debugTypedCompletionExpr then - print_endline "[typedCompletionExpr] No cases - has cursor"; + if debugTypedCompletionExpr then + Debug.verbose "[typedCompletionExpr] No cases - has cursor"; (* We can do exhaustive switch completion if this is an ident we can complete from. *) match exprToContextPath expr with @@ -620,16 +603,16 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor setResult (CexhaustiveSwitch {contextPath; exprLoc = exp.pexp_loc})) | Pexp_match (_expr, []) -> (* switch x { } *) - if Debug.verbose () && debugTypedCompletionExpr then - print_endline "[typedCompletionExpr] No cases, rest"; + if debugTypedCompletionExpr then + Debug.verbose "[typedCompletionExpr] No cases, rest"; () | Pexp_match (expr, [{pc_lhs; pc_rhs}]) when locHasCursor expr.pexp_loc && CompletionExpressions.isExprHole pc_rhs && CompletionPatterns.isPatternHole pc_lhs -> (* switch x { | } when we're in the switch expr itself. *) - if Debug.verbose () && debugTypedCompletionExpr then - print_endline + if debugTypedCompletionExpr then + Debug.verbose "[typedCompletionExpr] No cases (expr and pat holes), rest"; () | Pexp_match @@ -657,17 +640,17 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor patternMode = Default; })) | Pexp_match (exp, cases) -> ( - if Debug.verbose () && debugTypedCompletionExpr then - print_endline "[typedCompletionExpr] Has cases"; + if debugTypedCompletionExpr then + Debug.verbose "[typedCompletionExpr] Has cases"; (* If there's more than one case, or the case isn't a pattern hole, figure out if we're completing another broken parser case (`switch x { | true => () | }` for example). *) match exp |> exprToContextPath with | None -> - if Debug.verbose () && debugTypedCompletionExpr then - print_endline "[typedCompletionExpr] Has cases - no ctx path" + if debugTypedCompletionExpr then + Debug.verbose "[typedCompletionExpr] Has cases - no ctx path" | Some ctxPath -> ( - if Debug.verbose () && debugTypedCompletionExpr then - print_endline "[typedCompletionExpr] Has cases - has ctx path"; + if debugTypedCompletionExpr then + Debug.verbose "[typedCompletionExpr] Has cases - has ctx path"; let hasCaseWithCursor = cases |> List.find_opt (fun case -> @@ -680,10 +663,10 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor locIsEmpty case.Parsetree.pc_lhs.ppat_loc) |> Option.is_some in - if Debug.verbose () && debugTypedCompletionExpr then - Printf.printf + if debugTypedCompletionExpr then + Debug.verbose "[typedCompletionExpr] Has cases - has ctx path - \ - hasCaseWithEmptyLoc: %b, hasCaseWithCursor: %b\n" + hasCaseWithEmptyLoc: %b, hasCaseWithCursor: %b" hasCaseWithEmptyLoc hasCaseWithCursor; match (hasCaseWithEmptyLoc, hasCaseWithCursor) with | _, true -> @@ -904,8 +887,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor }; ] when locHasCursor pexp_loc -> - if Debug.verbose () then - print_endline "[decoratorCompletion] Found @module"; + Debug.verbose "[decoratorCompletion] Found @module"; setResult (Completable.CdecoratorPayload (Module s)) | PStr [ @@ -923,10 +905,9 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor when locHasCursor fromExpr.pexp_loc || locIsEmpty fromExpr.pexp_loc && CompletionExpressions.isExprHole fromExpr -> ( - if Debug.verbose () then - print_endline - "[decoratorCompletion] Found @module with import attributes and \ - cursor on \"from\""; + Debug.verbose + "[decoratorCompletion] Found @module with import attributes and \ + cursor on \"from\""; match ( locHasCursor fromExpr.pexp_loc, locIsEmpty fromExpr.pexp_loc, @@ -934,28 +915,24 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor fromExpr ) with | true, _, _, {pexp_desc = Pexp_constant (Pconst_string (s, _))} -> - if Debug.verbose () then - print_endline - "[decoratorCompletion] @module `from` payload was string"; + Debug.verbose + "[decoratorCompletion] @module `from` payload was string"; setResult (Completable.CdecoratorPayload (Module s)) | false, true, true, _ -> - if Debug.verbose () then - print_endline - "[decoratorCompletion] @module `from` payload was expr hole"; + Debug.verbose + "[decoratorCompletion] @module `from` payload was expr hole"; setResult (Completable.CdecoratorPayload (Module "")) | _ -> ()) | PStr [{pstr_desc = Pstr_eval (expr, _)}] -> ( - if Debug.verbose () then - print_endline - "[decoratorCompletion] Found @module with non-string payload"; + Debug.verbose + "[decoratorCompletion] Found @module with non-string payload"; match CompletionExpressions.traverseExpr expr ~exprPath:[] ~pos:posBeforeCursor ~firstCharBeforeCursorNoWhite with | None -> () | Some (prefix, nested) -> - if Debug.verbose () then - print_endline "[decoratorCompletion] Found @module record path"; + Debug.verbose "[decoratorCompletion] Found @module record path"; setResult (Completable.CdecoratorPayload (ModuleWithImportAttributes {nested = List.rev nested; prefix})) @@ -964,16 +941,14 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor else if id.txt = "jsxConfig" then match payload with | PStr [{pstr_desc = Pstr_eval (expr, _)}] -> ( - if Debug.verbose () then - print_endline "[decoratorCompletion] Found @jsxConfig"; + Debug.verbose "[decoratorCompletion] Found @jsxConfig"; match CompletionExpressions.traverseExpr expr ~exprPath:[] ~pos:posBeforeCursor ~firstCharBeforeCursorNoWhite with | None -> () | Some (prefix, nested) -> - if Debug.verbose () then - print_endline "[decoratorCompletion] Found @jsxConfig path!"; + Debug.verbose "[decoratorCompletion] Found @jsxConfig path!"; setResult (Completable.CdecoratorPayload (JsxConfig {nested = List.rev nested; prefix}))) @@ -993,8 +968,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor }; ] when locHasCursor pexp_loc -> - if Debug.verbose () then - print_endline "[decoratorCompletion] Found @editor.completeFrom"; + Debug.verbose "[decoratorCompletion] Found @editor.completeFrom"; setResult (Completable.Cpath (CPId @@ -1099,8 +1073,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor when cases <> [] && locHasCursor expr.pexp_loc = false && Option.is_none findThisExprLoc -> - if Debug.verbose () then - print_endline "[completionFrontend] Checking each case"; + Debug.verbose "[completionFrontend] Checking each case"; let ctxPath = exprToContextPath expr in let oldCtxPath = !currentCtxPath in cases @@ -1302,7 +1275,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ]; } when loc |> Loc.hasPos ~pos:posBeforeCursor -> - if Debug.verbose () then print_endline "[expr_iter] Case foo->id"; + Debug.verbose "[expr_iter] Case foo->id"; setPipeResult ~lhs ~id |> ignore | Pexp_apply { @@ -1310,7 +1283,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor args = [(_, lhs); _]; } when Loc.end_ opLoc = posCursor -> - if Debug.verbose () then print_endline "[expr_iter] Case foo->"; + Debug.verbose "[expr_iter] Case foo->"; setPipeResult ~lhs ~id:"" |> ignore | Pexp_apply { @@ -1324,8 +1297,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor (Loc.end_ expr.pexp_loc = posCursor && charBeforeCursor = Some ')') -> ( (* Complete fn argument values and named args when the fn call is piped. E.g. someVar->someFn(). *) - if Debug.verbose () then - print_endline "[expr_iter] Complete fn arguments (piped)"; + Debug.verbose "[expr_iter] Complete fn arguments (piped)"; let args = extractExpApplyArgs ~args in let funCtxPath = exprToContextPath funExpr in let argCompletable = @@ -1360,8 +1332,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor (Loc.end_ expr.pexp_loc = posCursor && charBeforeCursor = Some ')') -> ( (* Complete fn argument values and named args when the fn call is _not_ piped. E.g. someFn(). *) - if Debug.verbose () then - print_endline "[expr_iter] Complete fn arguments (not piped)"; + Debug.verbose "[expr_iter] Complete fn arguments (not piped)"; let args = extractExpApplyArgs ~args in if debug then Printf.printf "Pexp_apply ...%s (%s)\n" @@ -1439,8 +1410,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor match lbl with | Nolabel -> Some (ctxPath, currentUnlabelledCount + 1) | _ -> Some (ctxPath, currentUnlabelledCount)); - if Debug.verbose () then - print_endline "[expr_iter] Completing for argument value"; + Debug.verbose "[expr_iter] Completing for argument value"; Some (Completable.CArgument { diff --git a/analysis/src/CompletionJsx.ml b/analysis/src/CompletionJsx.ml index 5014a665c8..1d1f08f4eb 100644 --- a/analysis/src/CompletionJsx.ml +++ b/analysis/src/CompletionJsx.ml @@ -328,8 +328,7 @@ let findJsxPropsCompletable ~jsxProps ~endPos ~posBeforeCursor match props with | prop :: rest -> if prop.posStart <= posBeforeCursor && posBeforeCursor < prop.posEnd then ( - if Debug.verbose () then - print_endline "[jsx_props_completable]--> Cursor on the prop name"; + Debug.verbose "[jsx_props_completable]--> Cursor on the prop name"; Some (Completable.Cjsx @@ -340,16 +339,14 @@ let findJsxPropsCompletable ~jsxProps ~endPos ~posBeforeCursor prop.posEnd <= posBeforeCursor && posBeforeCursor < Loc.start prop.exp.pexp_loc then ( - if Debug.verbose () then - print_endline - "[jsx_props_completable]--> Cursor between the prop name and expr \ - assigned"; + Debug.verbose + "[jsx_props_completable]--> Cursor between the prop name and expr \ + assigned"; match (firstCharBeforeCursorNoWhite, prop.exp) with | Some '=', {pexp_desc = Pexp_ident {txt = Lident txt}} -> - if Debug.verbose () then - Printf.printf - "[jsx_props_completable]--> Heuristic for empty JSX prop expr \ - completion.\n"; + Debug.verbose + "[jsx_props_completable]--> Heuristic for empty JSX prop expr \ + completion."; Some (Cexpression { @@ -366,8 +363,7 @@ let findJsxPropsCompletable ~jsxProps ~endPos ~posBeforeCursor }) | _ -> None) else if prop.exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then ( - if Debug.verbose () then - print_endline "[jsx_props_completable]--> Cursor on expr assigned"; + Debug.verbose "[jsx_props_completable]--> Cursor on expr assigned"; match CompletionExpressions.traverseExpr prop.exp ~exprPath:[] ~pos:posBeforeCursor ~firstCharBeforeCursorNoWhite @@ -389,16 +385,14 @@ let findJsxPropsCompletable ~jsxProps ~endPos ~posBeforeCursor }) | _ -> None) else if prop.exp.pexp_loc |> Loc.end_ = (Location.none |> Loc.end_) then ( - if Debug.verbose () then - print_endline "[jsx_props_completable]--> Loc is broken"; + Debug.verbose "[jsx_props_completable]--> Loc is broken"; if CompletionExpressions.isExprHole prop.exp || isRegexpJsxHeuristicExpr prop.exp then ( - if Debug.verbose () then - print_endline - "[jsx_props_completable]--> Expr was expr hole or regexp literal \ - heuristic"; + Debug.verbose + "[jsx_props_completable]--> Expr was expr hole or regexp literal \ + heuristic"; Some (Cexpression { @@ -422,10 +416,8 @@ let findJsxPropsCompletable ~jsxProps ~endPos ~posBeforeCursor The completion comes at the end of the component, after the equals sign, but before any children starts, and '>' marks that it's at the end of the component JSX. This little heuristic makes sure we pick up this special case. *) - if Debug.verbose () then - print_endline - "[jsx_props_completable]--> Special case: last prop, '>' after \ - cursor"; + Debug.verbose + "[jsx_props_completable]--> Special case: last prop, '>' after cursor"; Some (Cexpression { @@ -444,8 +436,7 @@ let findJsxPropsCompletable ~jsxProps ~endPos ~posBeforeCursor | [] -> let afterCompName = posBeforeCursor >= posAfterCompName in if afterCompName && beforeChildrenStart then ( - if Debug.verbose () then - print_endline "[jsx_props_completable]--> Complete for JSX prop name"; + Debug.verbose "[jsx_props_completable]--> Complete for JSX prop name"; Some (Cjsx ( Utils.flattenLongIdent ~jsx:true jsxProps.compName.txt, diff --git a/analysis/src/CompletionPatterns.ml b/analysis/src/CompletionPatterns.ml index c7d4e1646e..bf50e9ace1 100644 --- a/analysis/src/CompletionPatterns.ml +++ b/analysis/src/CompletionPatterns.ml @@ -37,10 +37,8 @@ and traversePattern (pat : Parsetree.pattern) ~patternPath ~locHasCursor ~firstCharBeforeCursorNoWhite ~posBeforeCursor = let someIfHasCursor v debugId = if locHasCursor pat.Parsetree.ppat_loc then ( - if Debug.verbose () then - Printf.printf - "[traversePattern:someIfHasCursor] '%s' has cursor, returning \n" - debugId; + Debug.verbose + "[traversePattern:someIfHasCursor] '%s' has cursor, returning" debugId; Some v) else None in @@ -64,9 +62,7 @@ and traversePattern (pat : Parsetree.pattern) ~patternPath ~locHasCursor in match orPatWithItem with | None when isPatternHole p1 || isPatternHole p2 -> - if Debug.verbose () then - Printf.printf - "[traversePattern] found or-pattern that was pattern hole\n"; + Debug.verbose "[traversePattern] found or-pattern that was pattern hole"; Some ("", patternPath) | v -> v) | Ppat_any -> diff --git a/analysis/src/Debug.ml b/analysis/src/Debug.ml index d19d7dfa5a..df8f6fd0ae 100644 --- a/analysis/src/Debug.ml +++ b/analysis/src/Debug.ml @@ -2,12 +2,23 @@ type debugLevel = Off | Regular | Verbose let debugLevel = ref Off -let log s = - match !debugLevel with - | Regular | Verbose -> print_endline s - | Off -> () - let debugPrintEnv (env : SharedTypes.QueryEnv.t) = env.pathRev @ [env.file.moduleName] |> List.rev |> String.concat "." -let verbose () = !debugLevel = Verbose +(** +Log formatted message to the std_out when the debugLevel is Regular or Verbose. +Automatically appends a trailing newline. +*) +let regular fmt = + match !debugLevel with + | Regular | Verbose -> Format.printf (fmt ^^ "\n") + | Off -> Format.ifprintf Format.std_formatter fmt + +(** +Log formatted message to the std_out when the debugLevel is Verbose. +Automatically appends a trailing newline. +*) +let verbose fmt = + match !debugLevel with + | Off | Regular -> Format.ifprintf Format.std_formatter fmt + | Verbose -> Format.printf (fmt ^^ "\n") diff --git a/analysis/src/DotCompletionUtils.ml b/analysis/src/DotCompletionUtils.ml index fc25742790..dd49277528 100644 --- a/analysis/src/DotCompletionUtils.ml +++ b/analysis/src/DotCompletionUtils.ml @@ -14,8 +14,7 @@ let fieldCompletionsForDotCompletion ?posOfDot typ ~env ~package ~prefix ~exact match asObject with | Some (objEnv, obj) -> (* Handle obj completion via dot *) - if Debug.verbose () then - Printf.printf "[dot_completion]--> Obj type found:\n"; + Debug.verbose "[dot_completion]--> Obj type found:"; obj |> TypeUtils.getObjFields |> Utils.filterMap (fun (field, _typ) -> if Utils.checkName field ~prefix ~exact then diff --git a/analysis/src/SignatureHelp.ml b/analysis/src/SignatureHelp.ml index edc2807de0..8b9df73a09 100644 --- a/analysis/src/SignatureHelp.ml +++ b/analysis/src/SignatureHelp.ml @@ -48,9 +48,8 @@ let findFunctionType ~currentFile ~debug ~path ~pos = | None -> [] | Some (docstring, _) -> docstring in - if Debug.verbose () then - Printf.printf "[sig_help_fn] Found loc item: %s.\n" - (Shared.typeToString typeExpr); + Debug.verbose "[sig_help_fn] Found loc item: %s." + (Shared.typeToString typeExpr); match TypeUtils.extractFunctionType2 ~env ~package:full.package typeExpr with @@ -58,13 +57,10 @@ let findFunctionType ~currentFile ~debug ~path ~pos = Some (args, docstring, typeExpr, package, env, file) | _ -> None) | None -> - if Debug.verbose () then - Printf.printf "[sig_help_fn] Found no loc item.\n"; + Debug.verbose "[sig_help_fn] Found no loc item."; None | Some _ -> - if Debug.verbose () then - Printf.printf - "[sig_help_fn] Found loc item, but not what was expected.\n"; + Debug.verbose "[sig_help_fn] Found loc item, but not what was expected."; None in match fnFromLocItem with @@ -272,25 +268,22 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads = | _ -> ( match !result with | None -> - if Debug.verbose () then - Printf.printf "[sig_help_result] Setting because had none\n"; + Debug.verbose "[sig_help_result] Setting because had none"; result := Some (loc, thing) | Some (currentLoc, currentThing) when Pos.ofLexing loc.Location.loc_start > Pos.ofLexing currentLoc.Location.loc_start -> result := Some (loc, thing); - if Debug.verbose () then - Printf.printf - "[sig_help_result] Setting because loc of %s > then existing \ - of %s\n" - (printThing thing) (printThing currentThing) + Debug.verbose + "[sig_help_result] Setting because loc of %s > then existing of \ + %s" + (printThing thing) (printThing currentThing) | Some (_, currentThing) -> - if Debug.verbose () then - Printf.printf - "[sig_help_result] Doing nothing because loc of %s < then \ - existing of %s\n" - (printThing thing) (printThing currentThing)) + Debug.verbose + "[sig_help_result] Doing nothing because loc of %s < then \ + existing of %s" + (printThing thing) (printThing currentThing)) in let searchForArgWithCursor ~isPipeExpr ~args = let extractedArgs = extractExpApplyArgs ~args in @@ -525,12 +518,10 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads = | _ -> None) | Some (_, ((`ConstructorExpr (lid, _) | `ConstructorPat (lid, _)) as cs)) -> ( - if Debug.verbose () then - Printf.printf "[signature_help] Found constructor!\n"; + Debug.verbose "[signature_help] Found constructor!"; match Cmt.loadFullCmtFromPath ~path with | None -> - if Debug.verbose () then - Printf.printf "[signature_help] Could not load cmt\n"; + Debug.verbose "[signature_help] Could not load cmt"; None | Some full -> ( let {file} = full in @@ -541,9 +532,8 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads = {lid.loc with loc_start = lid.loc.loc_end} with | None -> - if Debug.verbose () then - Printf.printf "[signature_help] Did not find constructor '%s'\n" - constructorName; + Debug.verbose "[signature_help] Did not find constructor '%s'" + constructorName; None | Some constructor -> let argParts = diff --git a/analysis/src/TypeUtils.ml b/analysis/src/TypeUtils.ml index ffeca9ae40..e3528ad07f 100644 --- a/analysis/src/TypeUtils.ml +++ b/analysis/src/TypeUtils.ml @@ -294,9 +294,8 @@ let maybeSetTypeArgCtx ?typeArgContextFromTypeManifest ~typeParams ~typeArgs env (match typeArgContext with | None -> () | Some typeArgContext -> - if Debug.verbose () then - Printf.printf "[#type_arg_ctx]--> setting new type arg ctx: %s" - (debugLogTypeArgContext typeArgContext)); + Debug.verbose "[#type_arg_ctx]--> setting new type arg ctx: %s" + (debugLogTypeArgContext typeArgContext)); typeArgContext (* TODO(env-stuff) Maybe this could be removed entirely if we can guarantee that we don't have to look up functions from in here. *) @@ -325,17 +324,17 @@ let rec extractType ?(printOpeningDebug = true) ?(typeArgContextFromTypeManifest : typeArgContext option) ~env ~package (t : Types.type_expr) = let maybeSetTypeArgCtx = maybeSetTypeArgCtx ?typeArgContextFromTypeManifest in - if Debug.verbose () && printOpeningDebug then - Printf.printf + if printOpeningDebug then + Debug.verbose "[extract_type]--> starting extraction of type: %s, in env: %s. Has type \ - arg ctx: %b\n" + arg ctx: %b" (Shared.typeToString t) (Debug.debugPrintEnv env) (Option.is_some typeArgContext); (match typeArgContext with | None -> () | Some typeArgContext -> - if Debug.verbose () && printOpeningDebug then - Printf.printf "[extract_type]--> %s" + if printOpeningDebug then + Debug.verbose "[extract_type]--> %s" (debugLogTypeArgContext typeArgContext)); let instantiateType = instantiateType2 in match t.desc with @@ -363,15 +362,13 @@ let rec extractType ?(printOpeningDebug = true) typeArgContext ) | _args, _tRet, _typeArgContext -> None) | Tconstr (path, typeArgs, _) -> ( - if Debug.verbose () then - Printf.printf "[extract_type]--> digging for type %s in %s\n" - (Path.name path) (Debug.debugPrintEnv env); + Debug.verbose "[extract_type]--> digging for type %s in %s" (Path.name path) + (Debug.debugPrintEnv env); match References.digConstructor ~env ~package path with | Some ( envFromDeclaration, {item = {decl = {type_manifest = Some t1; type_params}}} ) -> - if Debug.verbose () then - print_endline "[extract_type]--> found type manifest"; + Debug.verbose "[extract_type]--> found type manifest"; (* Type manifests inherit the last type args ctx that wasn't for a type manifest. This is because the manifest itself doesn't have type args and an env that can @@ -384,7 +381,7 @@ let rec extractType ?(printOpeningDebug = true) ~env:envFromDeclaration ~package | Some (envFromItem, {name; item = {decl; kind = Type.Variant constructors}}) -> - if Debug.verbose () then print_endline "[extract_type]--> found variant"; + Debug.verbose "[extract_type]--> found variant"; let typeArgContext = maybeSetTypeArgCtx ~typeParams:decl.type_params ~typeArgs env in @@ -398,7 +395,7 @@ let rec extractType ?(printOpeningDebug = true) }, typeArgContext ) | Some (envFromDeclaration, {item = {kind = Record fields; decl}}) -> - if Debug.verbose () then print_endline "[extract_type]--> found record"; + Debug.verbose "[extract_type]--> found record"; (* Need to create a new type arg context here because we're sending along a type expr that might have type vars. *) let typeArgContext = maybeSetTypeArgCtx ~typeParams:decl.type_params ~typeArgs env @@ -412,12 +409,10 @@ let rec extractType ?(printOpeningDebug = true) in Some (TtypeT {env = envFromDeclaration; path}, typeArgContext) | None -> - if Debug.verbose () then - print_endline "[extract_type]--> found nothing when digging"; + Debug.verbose "[extract_type]--> found nothing when digging"; None | _ -> - if Debug.verbose () then - print_endline "[extract_type]--> found something else when digging"; + Debug.verbose "[extract_type]--> found something else when digging"; None) | Ttuple expressions -> Some (Tuple (env, expressions, t), typeArgContext) | Tvariant {row_fields} -> @@ -439,14 +434,13 @@ let rec extractType ?(printOpeningDebug = true) in Some (Tpolyvariant {env; constructors; typeExpr = t}, typeArgContext) | Tvar (Some varName) -> ( - if Debug.verbose () then - Printf.printf - "[extract_type]--> found type variable: '%s. Trying to instantiate %s" - varName - (match typeArgContext with - | None -> "with no type args ctx\n" - | Some typeArgContext -> - Printf.sprintf "with %s" (debugLogTypeArgContext typeArgContext)); + Debug.verbose + "[extract_type]--> found type variable: '%s. Trying to instantiate %s" + varName + (match typeArgContext with + | None -> "with no type args ctx\n" + | Some typeArgContext -> + Printf.sprintf "with %s" (debugLogTypeArgContext typeArgContext)); let instantiated = t |> instantiateType ?typeArgContext in let rec extractInstantiated t = @@ -456,15 +450,12 @@ let rec extractType ?(printOpeningDebug = true) in match extractInstantiated instantiated with | {desc = Tvar _} -> - if Debug.verbose () then - Printf.printf "[extract_type]--> could not instantiate '%s. Skipping.\n" - varName; + Debug.verbose "[extract_type]--> could not instantiate '%s. Skipping." + varName; None | _ -> - if Debug.verbose () then - Printf.printf - "[extract_type]--> SUCCEEDED instantiation, new type is: %s\n" - (Shared.typeToString instantiated); + Debug.verbose "[extract_type]--> SUCCEEDED instantiation, new type is: %s" + (Shared.typeToString instantiated); (* Use the env from instantiation if we managed to instantiate the type param *) let nextEnv = @@ -474,7 +465,7 @@ let rec extractType ?(printOpeningDebug = true) in instantiated |> extractType ?typeArgContext ~env:nextEnv ~package) | _ -> - if Debug.verbose () then print_endline "[extract_type]--> miss"; + Debug.verbose "[extract_type]--> miss"; None let isFunctionType ~env ~package t = @@ -557,20 +548,16 @@ type ctx = Rfield of string (** A record field of name *) let rec resolveNested ?typeArgContext ~env ~full ~nested ?ctx (typ : completionType) = let extractType = extractType ?typeArgContext in - if Debug.verbose () then - Printf.printf - "[nested]--> running nested in env: %s. Has type arg ctx: %b\n" - (Debug.debugPrintEnv env) - (Option.is_some typeArgContext); + Debug.verbose "[nested]--> running nested in env: %s. Has type arg ctx: %b" + (Debug.debugPrintEnv env) + (Option.is_some typeArgContext); (match typeArgContext with | None -> () | Some typeArgContext -> - if Debug.verbose () then - Printf.printf "[nested]--> %s" (debugLogTypeArgContext typeArgContext)); + Debug.verbose "[nested]--> %s" (debugLogTypeArgContext typeArgContext)); match nested with | [] -> - if Debug.verbose () then - print_endline "[nested]--> reached end of pattern, returning type"; + Debug.verbose "[nested]--> reached end of pattern, returning type"; Some ( typ, env, @@ -582,12 +569,10 @@ let rec resolveNested ?typeArgContext ~env ~full ~nested ?ctx | patternPath :: nested -> ( match (patternPath, typ) with | Completable.NTupleItem {itemNum}, Tuple (env, tupleItems, _) -> ( - if Debug.verbose () then - print_endline "[nested]--> trying to move into tuple"; + Debug.verbose "[nested]--> trying to move into tuple"; match List.nth_opt tupleItems itemNum with | None -> - if Debug.verbose () then - print_endline "[nested]--> tuple element not found"; + Debug.verbose "[nested]--> tuple element not found"; None | Some typ -> typ @@ -596,24 +581,20 @@ let rec resolveNested ?typeArgContext ~env ~full ~nested ?ctx typ |> resolveNested ?typeArgContext ~env ~full ~nested)) | ( NFollowRecordField {fieldName}, (TinlineRecord {env; fields} | Trecord {env; fields}) ) -> ( - if Debug.verbose () then - print_endline "[nested]--> trying to move into record field"; + Debug.verbose "[nested]--> trying to move into record field"; match fields |> List.find_opt (fun (field : field) -> field.fname.txt = fieldName) with | None -> - if Debug.verbose () then - print_endline "[nested]--> did not find record field"; + Debug.verbose "[nested]--> did not find record field"; None | Some {typ; optional} -> - if Debug.verbose () then - print_endline "[nested]--> found record field type"; + Debug.verbose "[nested]--> found record field type"; let typ = if optional then Utils.unwrapIfOption typ else typ in - if Debug.verbose () then - Printf.printf "[nested]--> extracting from type %s in env %s\n" - (Shared.typeToString typ) (Debug.debugPrintEnv env); + Debug.verbose "[nested]--> extracting from type %s in env %s" + (Shared.typeToString typ) (Debug.debugPrintEnv env); typ |> extractType ~env ~package:full.package |> Utils.Option.flatMap (fun (typ, typeArgContext) -> @@ -644,68 +625,59 @@ let rec resolveNested ?typeArgContext ~env ~full ~nested ?ctx typeArgContext ) | ( NVariantPayload {constructorName = "Some"; itemNum = 0}, Toption (env, ExtractedType typ) ) -> - if Debug.verbose () then - print_endline "[nested]--> moving into option Some"; + Debug.verbose "[nested]--> moving into option Some"; typ |> resolveNested ?typeArgContext ~env ~full ~nested | ( NVariantPayload {constructorName = "Some"; itemNum = 0}, Toption (env, TypeExpr typ) ) -> - if Debug.verbose () then - print_endline "[nested]--> moving into option Some"; + Debug.verbose "[nested]--> moving into option Some"; typ |> extractType ~env ~package:full.package |> Utils.Option.flatMap (fun (t, typeArgContext) -> t |> resolveNested ?typeArgContext ~env ~full ~nested) | NVariantPayload {constructorName = "Ok"; itemNum = 0}, Tresult {okType} -> - if Debug.verbose () then print_endline "[nested]--> moving into result Ok"; + Debug.verbose "[nested]--> moving into result Ok"; okType |> extractType ~env ~package:full.package |> Utils.Option.flatMap (fun (t, typeArgContext) -> t |> resolveNested ?typeArgContext ~env ~full ~nested) | ( NVariantPayload {constructorName = "Error"; itemNum = 0}, Tresult {errorType} ) -> - if Debug.verbose () then - print_endline "[nested]--> moving into result Error"; + Debug.verbose "[nested]--> moving into result Error"; errorType |> extractType ~env ~package:full.package |> Utils.Option.flatMap (fun (t, typeArgContext) -> t |> resolveNested ?typeArgContext ~env ~full ~nested) | NVariantPayload {constructorName; itemNum}, Tvariant {env; constructors} -> ( - if Debug.verbose () then - Printf.printf - "[nested]--> trying to move into variant payload $%i of constructor \ - '%s'\n" - itemNum constructorName; + Debug.verbose + "[nested]--> trying to move into variant payload $%i of constructor \ + '%s'" + itemNum constructorName; match constructors |> List.find_opt (fun (c : Constructor.t) -> c.cname.txt = constructorName) with | Some {args = Args args} -> ( - if Debug.verbose () then - print_endline "[nested]--> found constructor (Args type)"; + Debug.verbose "[nested]--> found constructor (Args type)"; match List.nth_opt args itemNum with | None -> - if Debug.verbose () then - print_endline "[nested]--> did not find relevant args num"; + Debug.verbose "[nested]--> did not find relevant args num"; None | Some (typ, _) -> - if Debug.verbose () then - Printf.printf "[nested]--> found arg of type: %s\n" - (Shared.typeToString typ); + Debug.verbose "[nested]--> found arg of type: %s" + (Shared.typeToString typ); typ |> extractType ~env ~package:full.package |> Utils.Option.flatMap (fun (typ, typeArgContext) -> - if Debug.verbose () then - Printf.printf - "[nested]--> extracted %s, continuing descent of %i items\n" - (extractedTypeToString typ) - (List.length nested); + Debug.verbose + "[nested]--> extracted %s, continuing descent of %i items" + (extractedTypeToString typ) + (List.length nested); typ |> resolveNested ?typeArgContext ~env ~full ~nested)) | Some {args = InlineRecord fields} when itemNum = 0 -> - if Debug.verbose () then - print_endline "[nested]--> found constructor (inline record)"; + Debug.verbose "[nested]--> found constructor (inline record)"; TinlineRecord {env; fields} |> resolveNested ?typeArgContext ~env ~full ~nested | _ -> None) @@ -769,7 +741,7 @@ let findTypeOfPolyvariantArg constructors ~constructorName ~payloadNum = | None -> None let rec resolveNestedPatternPath (typ : innerType) ~env ~full ~nested = - if Debug.verbose () then print_endline "[nested_pattern_path]"; + Debug.verbose "[nested_pattern_path]"; let t = match typ with | TypeExpr t -> diff --git a/analysis/src/Xform.ml b/analysis/src/Xform.ml index 837f7df744..d3bd3077c0 100644 --- a/analysis/src/Xform.ml +++ b/analysis/src/Xform.ml @@ -384,9 +384,8 @@ module ExpandCatchAllForVariants = struct match !result with | None -> () | Some (switchExpr, catchAllCase, cases) -> ( - if Debug.verbose () then - print_endline - "[codeAction - ExpandCatchAllForVariants] Found target switch"; + Debug.verbose + "[codeAction - ExpandCatchAllForVariants] Found target switch"; let rec findAllConstructorNames ?(mode : [`option | `default] = `default) ?(constructorNames = []) (p : Parsetree.pattern) = match p.ppat_desc with @@ -463,9 +462,8 @@ module ExpandCatchAllForVariants = struct codeActions := codeAction :: !codeActions else () | Some (Toption (env, innerType)) -> ( - if Debug.verbose () then - print_endline - "[codeAction - ExpandCatchAllForVariants] Found option type"; + Debug.verbose + "[codeAction - ExpandCatchAllForVariants] Found option type"; let innerType = match innerType with | ExtractedType t -> Some t diff --git a/tests/analysis_tests/tests/package-lock.json b/tests/analysis_tests/tests/package-lock.json index 1f0d8fa0ca..5ccadc8aa1 100644 --- a/tests/analysis_tests/tests/package-lock.json +++ b/tests/analysis_tests/tests/package-lock.json @@ -33,8 +33,7 @@ } }, "../../..": { - "name": "rescript", - "version": "12.0.0-alpha.8", + "version": "12.0.0-alpha.9", "hasInstallScript": true, "license": "SEE LICENSE IN LICENSE", "bin": { diff --git a/tests/analysis_tests/tests/src/expected/ExhaustiveSwitch.res.txt b/tests/analysis_tests/tests/src/expected/ExhaustiveSwitch.res.txt index e13b0ada01..8fb11b647f 100644 --- a/tests/analysis_tests/tests/src/expected/ExhaustiveSwitch.res.txt +++ b/tests/analysis_tests/tests/src/expected/ExhaustiveSwitch.res.txt @@ -17,7 +17,7 @@ Path withSomeVarian "detail": "insert exhaustive switch for value", "documentation": null, "filterText": "withSomeVariant", - "insertText": "withSomeVariant {\n | One => ${1:failwith(\"todo\")}\n | Two => ${2:failwith(\"todo\")}\n | Three(_) => ${3:failwith(\"todo\")}\n }", + "insertText": "withSomeVariant {\n | One => ${1:failwith(\"todo\")}\n | Three(_) => ${2:failwith(\"todo\")}\n | Two => ${3:failwith(\"todo\")}\n }", "insertTextFormat": 2 }] @@ -40,7 +40,7 @@ Path withSomePol "detail": "insert exhaustive switch for value", "documentation": null, "filterText": "withSomePoly", - "insertText": "withSomePoly {\n | #\"switch\" => ${1:failwith(\"todo\")}\n | #one => ${2:failwith(\"todo\")}\n | #three(_) => ${3:failwith(\"todo\")}\n | #two => ${4:failwith(\"todo\")}\n | #\"exotic ident\" => ${5:failwith(\"todo\")}\n }", + "insertText": "withSomePoly {\n | #\"exotic ident\" => ${1:failwith(\"todo\")}\n | #\"switch\" => ${2:failwith(\"todo\")}\n | #one => ${3:failwith(\"todo\")}\n | #three(_) => ${4:failwith(\"todo\")}\n | #two => ${5:failwith(\"todo\")}\n }", "insertTextFormat": 2 }] @@ -63,7 +63,7 @@ Path someBoo "detail": "insert exhaustive switch for value", "documentation": null, "filterText": "someBool", - "insertText": "someBool {\n | true => ${1:failwith(\"todo\")}\n | false => ${2:failwith(\"todo\")}\n }", + "insertText": "someBool {\n | false => ${1:failwith(\"todo\")}\n | true => ${2:failwith(\"todo\")}\n }", "insertTextFormat": 2 }] @@ -86,7 +86,7 @@ Path someOp "detail": "insert exhaustive switch for value", "documentation": null, "filterText": "someOpt", - "insertText": "someOpt {\n | Some($1) => ${2:failwith(\"todo\")}\n | None => ${3:failwith(\"todo\")}\n }", + "insertText": "someOpt {\n | None => ${2:failwith(\"todo\")}\n | Some($1) => ${3:failwith(\"todo\")}\n }", "insertTextFormat": 2 }] @@ -164,7 +164,7 @@ Path withSomeVarian "detail": "insert exhaustive switch for value", "documentation": null, "filterText": "withSomeVariant", - "insertText": "withSomeVariant {\n | One => ${1:%todo}\n | Two => ${2:%todo}\n | Three(_) => ${3:%todo}\n }", + "insertText": "withSomeVariant {\n | One => ${1:%todo}\n | Three(_) => ${2:%todo}\n | Two => ${3:%todo}\n }", "insertTextFormat": 2 }] diff --git a/tests/analysis_tests/tests/src/expected/Xform.res.txt b/tests/analysis_tests/tests/src/expected/Xform.res.txt index fec60ff18b..64505845de 100644 --- a/tests/analysis_tests/tests/src/expected/Xform.res.txt +++ b/tests/analysis_tests/tests/src/expected/Xform.res.txt @@ -242,7 +242,7 @@ TextDocumentEdit: Xform.res {"start": {"line": 101, "character": 2}, "end": {"line": 101, "character": 3}} newText: <--here - #second | #"illegal identifier" | #third(_) + #"illegal identifier" | #second | #third(_) Xform src/Xform.res 107:4 posCursor:[105:16] posNoWhite:[105:14] Found expr:[105:9->109:1]