Various uncurried fixes (#810)

* various uncurried fixes

* remove explicit signature help uncurried test file

* try changing printer uncurried config

* don't log constructor path for uncurried function

* read config so uncurried mode is propagated when creating interface files

* turn off uncurried again for the tests

* changelog

* revert compiler upgrade

* revert to unchanged test content

* remove accidentally committed file

* gah

Author: zth

CHANGELOG.md

@@ -30,6 +30,7 @@
 - Fix accidental output of extra `|` when producing exhaustive switch code for polyvariants. https://github.com/rescript-lang/rescript-vscode/pull/805
 - Fix JS syntax highlighting in single-line FFI extension points. https://github.com/rescript-lang/rescript-vscode/pull/807
 - Fix signature help in uncurried mode. https://github.com/rescript-lang/rescript-vscode/pull/809
+- Fix various issues in uncurried mode. https://github.com/rescript-lang/rescript-vscode/pull/810
 
 ## 1.18.0
 

analysis/src/CompletionBackEnd.ml

@@ -1133,7 +1133,14 @@ let getOpens ~debug ~rawOpens ~package ~env =
   if debug && packageOpens <> [] then
     Printf.printf "%s\n"
       ("Package opens "
-      ^ String.concat " " (packageOpens |> List.map pathToString));
+      ^ String.concat " "
+          (packageOpens
+          |> List.map (fun p ->
+                 p
+                 |> List.map (fun name ->
+                        (* Unify formatting between curried and uncurried *)
+                        if name = "PervasivesU" then "Pervasives" else name)
+                 |> pathToString)));
   let resolvedOpens =
     resolveOpens ~env (List.rev (packageOpens @ rawOpens)) ~package
   in
@@ -1147,8 +1154,11 @@ let getOpens ~debug ~rawOpens ~package ~env =
           |> List.map (fun (e : QueryEnv.t) ->
                  let name = Uri.toString e.file.uri in
 
-                 if Utils.startsWith name "pervasives." then
-                   Filename.chop_extension name
+                 (* Unify formatting between curried and uncurried *)
+                 if
+                   name = "pervasives.res" || name = "pervasives.resi"
+                   || name = "pervasivesU.res" || name = "pervasivesU.resi"
+                 then "pervasives"
                  else name)));
   (* Last open takes priority *)
   List.rev resolvedOpens

analysis/src/CompletionFrontEnd.ml

@@ -148,7 +148,7 @@ let rec exprToContextPath (e : Parsetree.expression) =
          (match exprs with
          | [] -> None
          | exp :: _ -> exprToContextPath exp))
-  | Pexp_ident {txt = Lident "|."} -> None
+  | Pexp_ident {txt = Lident ("|." | "|.u")} -> None
   | Pexp_ident {txt} -> Some (CPId (Utils.flattenLongIdent txt, Value))
   | Pexp_field (e1, {txt = Lident name}) -> (
     match exprToContextPath e1 with
@@ -162,7 +162,7 @@ let rec exprToContextPath (e : Parsetree.expression) =
     | None -> None
     | Some contexPath -> Some (CPObj (contexPath, txt)))
   | Pexp_apply
-      ( {pexp_desc = Pexp_ident {txt = Lident "|."}},
+      ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
         [
           (_, lhs);
           (_, {pexp_desc = Pexp_apply (d, args); pexp_loc; pexp_attributes});
@@ -175,7 +175,7 @@ let rec exprToContextPath (e : Parsetree.expression) =
         pexp_attributes;
       }
   | Pexp_apply
-      ( {pexp_desc = Pexp_ident {txt = Lident "|."}},
+      ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
         [(_, lhs); (_, {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes})]
       ) ->
     (* Transform away pipe with identifier *)
@@ -211,13 +211,13 @@ let completePipeChain (exp : Parsetree.expression) =
   (* When the left side of the pipe we're completing is a function application.
      Example: someArray->Js.Array2.map(v => v + 2)-> *)
   | Pexp_apply
-      ( {pexp_desc = Pexp_ident {txt = Lident "|."}},
+      ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
         [_; (_, {pexp_desc = Pexp_apply (d, _)})] ) ->
     exprToContextPath exp |> Option.map (fun ctxPath -> (ctxPath, d.pexp_loc))
     (* When the left side of the pipe we're completing is an identifier application.
        Example: someArray->filterAllTheGoodStuff-> *)
   | Pexp_apply
-      ( {pexp_desc = Pexp_ident {txt = Lident "|."}},
+      ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
         [_; (_, {pexp_desc = Pexp_ident _; pexp_loc})] ) ->
     exprToContextPath exp |> Option.map (fun ctxPath -> (ctxPath, pexp_loc))
   | _ -> None
@@ -813,7 +813,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
              scope := oldScope);
       resetCurrentCtxPath oldCtxPath
     | Pexp_apply
-        ( {pexp_desc = Pexp_ident {txt = Lident "|."; loc = opLoc}},
+        ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u"); loc = opLoc}},
           [
             (_, lhs);
             (_, {pexp_desc = Pexp_extension _; pexp_loc = {loc_ghost = true}});
@@ -837,7 +837,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
             setResult (Cpath (CPId (lidPath, Value)))
         | Pexp_construct (lid, eOpt) ->
           let lidPath = flattenLidCheckDot lid in
-          if debug then
+          if debug && lid.txt <> Lident "Function$" then
             Printf.printf "Pexp_construct %s:%s %s\n"
               (lidPath |> String.concat "\n")
               (Loc.toString lid.loc)
@@ -911,7 +911,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
               | _ -> Cpath (CPId (compNamePath, Module)))
           else iterateJsxProps ~iterator jsxProps
         | Pexp_apply
-            ( {pexp_desc = Pexp_ident {txt = Lident "|."}},
+            ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
               [
                 (_, lhs);
                 (_, {pexp_desc = Pexp_ident {txt = Longident.Lident id; loc}});
@@ -920,13 +920,13 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
           (* Case foo->id *)
           setPipeResult ~lhs ~id |> ignore
         | Pexp_apply
-            ( {pexp_desc = Pexp_ident {txt = Lident "|."; loc = opLoc}},
+            ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u"); loc = opLoc}},
               [(_, lhs); _] )
           when Loc.end_ opLoc = posCursor ->
           (* Case foo-> *)
           setPipeResult ~lhs ~id:"" |> ignore
         | Pexp_apply
-            ( {pexp_desc = Pexp_ident {txt = Lident "|."}},
+            ( {pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}},
               [_; (_, {pexp_desc = Pexp_apply (funExpr, args)})] )
           when (* Normally named arg completion fires when the cursor is right after the expression.
                   E.g in foo(~<---there
@@ -957,7 +957,8 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
               argCompletable |> iterateFnArguments ~isPipe:true ~args ~iterator;
               resetCurrentCtxPath oldCtxPath)
           | Some argCompletable -> setResult argCompletable)
-        | Pexp_apply ({pexp_desc = Pexp_ident {txt = Lident "|."}}, [_; _]) ->
+        | Pexp_apply
+            ({pexp_desc = Pexp_ident {txt = Lident ("|." | "|.u")}}, [_; _]) ->
           (* Ignore any other pipe. *)
           ()
         | Pexp_apply (funExpr, args)

analysis/src/CompletionJsx.ml

@@ -731,7 +731,11 @@ let getJsxLabels ~componentPath ~findTypeOfValue ~package =
     in
     let rec getLabels (t : Types.type_expr) =
       match t.desc with
-      | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> getLabels t1
+      | Tlink t1
+      | Tsubst t1
+      | Tpoly (t1, [])
+      | Tconstr (Pident {name = "function$"}, [t1; _], _) ->
+        getLabels t1
       | Tarrow
           ( Nolabel,
             {

analysis/src/CreateInterface.ml

@@ -164,11 +164,13 @@ let printSignature ~extractor ~signature =
 
   let buf = Buffer.create 10 in
 
-  let getComponentTypeV3 (typ : Types.type_expr) =
+  let rec getComponentTypeV3 (typ : Types.type_expr) =
     let reactElement =
       Ctype.newconstr (Pdot (Pident (Ident.create "React"), "element", 0)) []
     in
     match typ.desc with
+    | Tconstr (Pident {name = "function$"}, [typ; _], _) ->
+      getComponentTypeV3 typ
     | Tarrow (_, {desc = Tobject (tObj, _)}, retType, _) -> Some (tObj, retType)
     | Tconstr
         ( Pdot (Pident {name = "React"}, "component", _),
@@ -183,11 +185,13 @@ let printSignature ~extractor ~signature =
     | _ -> None
   in
 
-  let getComponentTypeV4 (typ : Types.type_expr) =
+  let rec getComponentTypeV4 (typ : Types.type_expr) =
     let reactElement =
       Ctype.newconstr (Pdot (Pident (Ident.create "React"), "element", 0)) []
     in
     match typ.desc with
+    | Tconstr (Pident {name = "function$"}, [typ; _], _) ->
+      getComponentTypeV4 typ
     | Tarrow (_, {desc = Tconstr (Path.Pident propsId, typeArgs, _)}, retType, _)
       when Ident.name propsId = "props" ->
       Some (typeArgs, retType)
@@ -410,6 +414,8 @@ let printSignature ~extractor ~signature =
 let command ~path ~cmiFile =
   match Shared.tryReadCmi cmiFile with
   | Some cmi_info ->
+    (* For reading the config *)
+    let _ = Cmt.loadFullCmtFromPath ~path in
     let extractor = SourceFileExtractor.create ~path in
     printSignature ~extractor ~signature:cmi_info.cmi_sign
   | None -> ""

analysis/src/Packages.ml

@@ -82,7 +82,11 @@ let newBsPackage ~rootPath =
                | None -> []
              in
              let opens =
-               ["Pervasives"; "JsxModules"] :: opens_from_namespace
+               [
+                 (if uncurried then "PervasivesU" else "Pervasives");
+                 "JsxModules";
+               ]
+               :: opens_from_namespace
                |> List.rev_append opens_from_bsc_flags
                |> List.map (fun path -> path @ ["place holder"])
              in

analysis/src/TypeUtils.ml

@@ -198,12 +198,14 @@ let getBuiltinFromTypePath path =
   | Path.Pident id when Ident.name id = "result" -> Some Result
   | Path.Pident id when Ident.name id = "lazy_t" -> Some Lazy
   | Path.Pident id when Ident.name id = "char" -> Some Char
-  | Pdot (Pident id, "result", _) when Ident.name id = "Pervasives" ->
+  | Pdot (Pident id, "result", _)
+    when Ident.name id = "Pervasives" || Ident.name id = "PervasivesU" ->
     Some Result
   | _ -> None
 
-let pathFromTypeExpr (t : Types.type_expr) =
+let rec pathFromTypeExpr (t : Types.type_expr) =
   match t.desc with
+  | Tconstr (Pident {name = "function$"}, [t; _], _) -> pathFromTypeExpr t
   | Tconstr (path, _typeArgs, _)
   | Tlink {desc = Tconstr (path, _typeArgs, _)}
   | Tsubst {desc = Tconstr (path, _typeArgs, _)}
@@ -513,7 +515,10 @@ 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, []) ->
+    | Tlink t1
+    | Tsubst t1
+    | Tpoly (t1, [])
+    | Tconstr (Pident {name = "function$"}, [t1; _], _) ->
       getArgsLoop ~full ~env ~currentArgumentPosition t1
     | Tarrow (Labelled l, tArg, tRet, _) ->
       (SharedTypes.Completable.Labelled l, tArg)

analysis/src/Xform.ml

@@ -195,7 +195,10 @@ module AddTypeAnnotation = struct
     in
     let rec processFunction ~argNum (e : Parsetree.expression) =
       match e.pexp_desc with
-      | Pexp_fun (argLabel, _, pat, e) ->
+      | Pexp_fun (argLabel, _, pat, e)
+      | Pexp_construct
+          ( {txt = Lident "Function$"},
+            Some {pexp_desc = Pexp_fun (argLabel, _, pat, e)} ) ->
         let isUnlabeledOnlyArg =
           argNum = 1 && argLabel = Nolabel
           &&

analysis/tests/package-lock.json

@@ -8,6 +8,6 @@
     "@rescript/react": "^0.11.0-rc.3"
   },
   "dependencies": {
-    "rescript": "^11.0.0-alpha.1"
+    "rescript": "11.0.0-alpha.1"
   }
 }