From cd61f5e5c8d8102fc14a61306eb8f7ea66e7ed5a Mon Sep 17 00:00:00 2001 From: Cheng Lou Date: Thu, 29 Apr 2021 09:11:25 -0700 Subject: [PATCH 1/2] Revert "No Infix." This reverts commit f36bef27fdd339bffe42390b98d8bf22b16a1915. --- analysis/.depend | 3 ++- analysis/src/BuildSystem.ml | 2 ++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/analysis/.depend b/analysis/.depend index 3b3551ee3..db6906da6 100644 --- a/analysis/.depend +++ b/analysis/.depend @@ -1,4 +1,5 @@ -src/BuildSystem.cmx : src/ModuleResolution.cmx src/Log.cmx src/Files.cmx +src/BuildSystem.cmx : src/ModuleResolution.cmx src/Log.cmx src/Infix.cmx \ + src/Files.cmx src/Cli.cmx : src/Commands.cmx src/Commands.cmx : src/Utils.cmx src/Uri2.cmx src/SharedTypes.cmx \ src/Shared.cmx src/References.cmx src/Protocol.cmx src/ProcessCmt.cmx \ diff --git a/analysis/src/BuildSystem.ml b/analysis/src/BuildSystem.ml index 72434b72d..898717828 100644 --- a/analysis/src/BuildSystem.ml +++ b/analysis/src/BuildSystem.ml @@ -1,6 +1,8 @@ let namespacedName namespace name = match namespace with None -> name | Some namespace -> name ^ "-" ^ namespace +open Infix + let getBsPlatformDir rootPath = let result = ModuleResolution.resolveNodeModulePath ~startPath:rootPath "rescript" From 192d5169fabeae5556f87345cda4b122ff8e3199 Mon Sep 17 00:00:00 2001 From: Cheng Lou Date: Thu, 29 Apr 2021 09:11:25 -0700 Subject: [PATCH 2/2] Revert "Test using normal filename concat without trying to normalize `./foo`." This reverts commit 8b0b7c540cc6a25e14de0c869163f5629f59e0b1. --- analysis/.depend | 6 ++--- analysis/src/BuildSystem.ml | 10 ++++----- analysis/src/Files.ml | 14 ++++++++++++ analysis/src/FindFiles.ml | 38 +++++++++++++++----------------- analysis/src/Infix.ml | 2 ++ analysis/src/ModuleResolution.ml | 4 +++- analysis/src/Packages.ml | 8 +++---- analysis/src/Uri2.ml | 2 +- 8 files changed, 49 insertions(+), 35 deletions(-) diff --git a/analysis/.depend b/analysis/.depend index db6906da6..5da702b83 100644 --- a/analysis/.depend +++ b/analysis/.depend @@ -10,9 +10,9 @@ src/FindFiles.cmx : src/Utils.cmx src/SharedTypes.cmx \ src/Files.cmx src/BuildSystem.cmx src/Hover.cmx : src/Utils.cmx src/SharedTypes.cmx src/Shared.cmx \ src/References.cmx src/ProcessCmt.cmx -src/Infix.cmx : src/Log.cmx +src/Infix.cmx : src/Log.cmx src/Files.cmx src/Log.cmx : -src/ModuleResolution.cmx : src/Files.cmx +src/ModuleResolution.cmx : src/Infix.cmx src/Files.cmx src/NewCompletions.cmx : src/Utils.cmx src/Uri2.cmx src/SharedTypes.cmx \ src/Shared.cmx src/Protocol.cmx src/ProcessCmt.cmx src/PartialParser.cmx \ src/Log.cmx src/Infix.cmx src/Hover.cmx @@ -33,7 +33,7 @@ src/References.cmx : src/Utils.cmx src/Uri2.cmx src/SharedTypes.cmx \ src/Shared.cmx : src/PrintType.cmx src/Files.cmx src/SharedTypes.cmx : src/Utils.cmx src/Uri2.cmx src/Shared.cmx \ src/Infix.cmx -src/Uri2.cmx : +src/Uri2.cmx : src/Files.cmx src/Utils.cmx : src/Protocol.cmx src/vendor/Json.cmx : src/vendor/res_outcome_printer/res_comment.cmx : \ diff --git a/analysis/src/BuildSystem.ml b/analysis/src/BuildSystem.ml index 898717828..b5de86c6a 100644 --- a/analysis/src/BuildSystem.ml +++ b/analysis/src/BuildSystem.ml @@ -1,5 +1,7 @@ let namespacedName namespace name = - match namespace with None -> name | Some namespace -> name ^ "-" ^ namespace + match namespace with + | None -> name + | Some namespace -> name ^ "-" ^ namespace open Infix @@ -19,11 +21,9 @@ let getBsPlatformDir rootPath = Log.log message; Error message -let getCompiledBase root = - Files.ifExists (Filename.concat (Filename.concat root "lib") "bs") +let getCompiledBase root = Files.ifExists (root /+ "lib" /+ "bs") let getStdlib base = match getBsPlatformDir base with | Error e -> Error e - | Ok bsPlatformDir -> - Ok (Filename.concat (Filename.concat bsPlatformDir "lib") "ocaml") + | Ok bsPlatformDir -> Ok (bsPlatformDir /+ "lib" /+ "ocaml") diff --git a/analysis/src/Files.ml b/analysis/src/Files.ml index 03f6bfd6c..3372c4eef 100644 --- a/analysis/src/Files.ml +++ b/analysis/src/Files.ml @@ -97,3 +97,17 @@ let rec collect ?(checkDir = fun _ -> true) path test = |> List.concat else [] | _ -> if test path then [path] else [] + +let fileConcat a b = + if + b <> "" + && b.[0] = '.' + && String.length b >= 2 + && b.[1] = Filename.dir_sep.[0] + then Filename.concat a (String.sub b 2 (String.length b - 2)) + else Filename.concat a b + +let isFullPath b = + b.[0] = '/' || (Sys.win32 && String.length b > 1 && b.[1] = ':') + +let maybeConcat a b = if b <> "" && isFullPath b then b else fileConcat a b diff --git a/analysis/src/FindFiles.ml b/analysis/src/FindFiles.ml index 3b3556190..0d0a3a20c 100644 --- a/analysis/src/FindFiles.ml +++ b/analysis/src/FindFiles.ml @@ -4,15 +4,13 @@ let ifDebug debug name fn v = if debug then Log.log (name ^ ": " ^ fn v); v -let ( ++ ) = Filename.concat - (* Returns a list of paths, relative to the provided `base` *) let getSourceDirectories ~includeDev base config = let rec handleItem current item = match item with | Json.Array contents -> List.map (handleItem current) contents |> List.concat - | Json.String text -> [current ++ text] + | Json.String text -> [current /+ text] | Json.Object _ -> ( let dir = Json.get "dir" item |?> Json.string |? "Must specify directory" @@ -24,13 +22,13 @@ let getSourceDirectories ~includeDev base config = if typ = "dev" then [] else match item |> Json.get "subdirs" with - | None | Some Json.False -> [current ++ dir] + | None | Some Json.False -> [current /+ dir] | Some Json.True -> - Files.collectDirs (base ++ current ++ dir) + Files.collectDirs (base /+ current /+ dir) (* |> ifDebug(true, "Subdirs", String.concat(" - ")) *) |> List.filter (fun name -> name <> Filename.current_dir_name) |> List.map (Files.relpath base) - | Some item -> (current ++ dir) :: handleItem (current ++ dir) item) + | Some item -> (current /+ dir) :: handleItem (current /+ dir) item) | _ -> failwith "Invalid subdirs entry" in match config |> Json.get "sources" with @@ -106,11 +104,11 @@ let collectFiles directory = compileds |> List.map (fun path -> let modName = getName path in - let compiled = directory ++ path in + let compiled = directory /+ path in let source = Utils.find (fun name -> - if getName name = modName then Some (directory ++ name) else None) + if getName name = modName then Some (directory /+ name) else None) sources in (modName, SharedTypes.Impl (compiled, source))) @@ -119,7 +117,7 @@ let collectFiles directory = let findProjectFiles ~debug namespace root sourceDirectories compiledBase = let files = sourceDirectories - |> List.map (Filename.concat root) + |> List.map (Files.fileConcat root) |> ifDebug debug "Source directories" (String.concat " - ") |> List.map (fun name -> Files.collect name isSourceFile) |> List.concat |> Utils.dedup @@ -129,8 +127,8 @@ let findProjectFiles ~debug namespace root sourceDirectories compiledBase = |> Utils.filterMap(path => { let rel = Files.relpath(root, path); ifOneExists([ - compiledBase ++ cmtName(~namespace, rel), - compiledBase ++ cmiName(~namespace, rel), + compiledBase /+ cmtName(~namespace, rel), + compiledBase /+ cmiName(~namespace, rel), ]) |?>> cm => (cm, path) }) |> ifDebug(debug, "With compiled base", (items) => String.concat("\n", List.map(((a, b)) => a ++ " : " ++ b, items))) @@ -163,8 +161,8 @@ let findProjectFiles ~debug namespace root sourceDirectories compiledBase = let base = compiledBaseName ~namespace (Files.relpath root path) in match intf with | Some intf -> - let cmti = (compiledBase ++ base) ^ ".cmti" in - let cmt = (compiledBase ++ base) ^ ".cmt" in + let cmti = (compiledBase /+ base) ^ ".cmti" in + let cmt = (compiledBase /+ base) ^ ".cmt" in if Files.exists cmti then if Files.exists cmt then (* Log.log("Intf and impl " ++ cmti ++ " " ++ cmt) *) @@ -173,15 +171,15 @@ let findProjectFiles ~debug namespace root sourceDirectories compiledBase = else ( (* Log.log("Just intf " ++ cmti) *) Log.log - ("Bad source file (no cmt/cmti/cmi) " ^ (compiledBase ++ base) + ("Bad source file (no cmt/cmti/cmi) " ^ (compiledBase /+ base) ); None) | None -> - let cmt = (compiledBase ++ base) ^ ".cmt" in + let cmt = (compiledBase /+ base) ^ ".cmt" in if Files.exists cmt then Some (mname, Impl (cmt, Some path)) else ( Log.log - ("Bad source file (no cmt/cmi) " ^ (compiledBase ++ base)); + ("Bad source file (no cmt/cmi) " ^ (compiledBase /+ base)); None)) else ( Log.log ("Bad source file (extension) " ^ path); @@ -193,7 +191,7 @@ let findProjectFiles ~debug namespace root sourceDirectories compiledBase = (fun mname intf res -> let base = compiledBaseName ~namespace (Files.relpath root intf) in Log.log ("Extra intf " ^ intf); - let cmti = (compiledBase ++ base) ^ ".cmti" in + let cmti = (compiledBase /+ base) ^ ".cmti" in if Files.exists cmti then (mname, SharedTypes.Intf (cmti, intf)) :: res else res) @@ -207,7 +205,7 @@ let findProjectFiles ~debug namespace root sourceDirectories compiledBase = | None -> result | Some namespace -> let mname = nameSpaceToName namespace in - let cmt = (compiledBase ++ namespace) ^ ".cmt" in + let cmt = (compiledBase /+ namespace) ^ ".cmt" in Log.log ("adding namespace " ^ namespace ^ " : " ^ mname ^ " : " ^ cmt); (mname, Impl (cmt, None)) :: result @@ -236,7 +234,7 @@ let findDependencyFiles ~debug base config = let result = ModuleResolution.resolveNodeModulePath ~startPath:base name |?> fun loc -> - let innerPath = loc ++ "bsconfig.json" in + let innerPath = loc /+ "bsconfig.json" in Log.log ("Dep loc " ^ innerPath); match Files.readFile innerPath with | Some text -> ( @@ -250,7 +248,7 @@ let findDependencyFiles ~debug base config = | Some compiledBase -> if debug then Log.log ("Compiled base: " ^ compiledBase); let compiledDirectories = - directories |> List.map (Filename.concat compiledBase) + directories |> List.map (Files.fileConcat compiledBase) in let compiledDirectories = match namespace with diff --git a/analysis/src/Infix.ml b/analysis/src/Infix.ml index 5ede0d764..610161ff4 100644 --- a/analysis/src/Infix.ml +++ b/analysis/src/Infix.ml @@ -26,3 +26,5 @@ let logIfAbsent message x = Log.log message; None | _ -> x + +let ( /+ ) = Files.fileConcat diff --git a/analysis/src/ModuleResolution.ml b/analysis/src/ModuleResolution.ml index c073aff6c..8ff84d87b 100644 --- a/analysis/src/ModuleResolution.ml +++ b/analysis/src/ModuleResolution.ml @@ -1,5 +1,7 @@ +open Infix + let rec resolveNodeModulePath ~startPath name = - let path = Filename.concat (Filename.concat startPath "node_modules") name in + let path = startPath /+ "node_modules" /+ name in if Files.exists path then Some path else if Filename.dirname startPath = startPath then None else resolveNodeModulePath ~startPath:(Filename.dirname startPath) name diff --git a/analysis/src/Packages.ml b/analysis/src/Packages.ml index 5a00336bc..91c356302 100644 --- a/analysis/src/Packages.ml +++ b/analysis/src/Packages.ml @@ -1,7 +1,5 @@ open Infix -let ( ++ ) = Filename.concat - (* Creates the `pathsForModule` hashtbl, which maps a `moduleName` to it's `paths` (the ml/re, mli/rei, cmt, and cmti files) *) let makePathsForModule (localModules : (string * SharedTypes.paths) list) (dependencyModules : (string * SharedTypes.paths) list) = @@ -15,7 +13,7 @@ let makePathsForModule (localModules : (string * SharedTypes.paths) list) pathsForModule let newBsPackage rootPath = - let path = rootPath ++ "bsconfig.json" in + let path = rootPath /+ "bsconfig.json" in match Files.readFile path with | None -> Error ("Unable to read " ^ path) | Some raw -> ( @@ -65,7 +63,7 @@ let newBsPackage rootPath = match namespace with | None -> [] | Some namespace -> - let cmt = (compiledBase ++ namespace) ^ ".cmt" in + let cmt = (compiledBase /+ namespace) ^ ".cmt" in Log.log ("############ Namespaced as " ^ namespace ^ " at " ^ cmt); Hashtbl.add pathsForModule namespace (Impl (cmt, None)); [FindFiles.nameSpaceToName namespace] @@ -108,7 +106,7 @@ let findRoot ~uri packagesByRoot = let rec loop path = if path = "/" then None else if Hashtbl.mem packagesByRoot path then Some (`Root path) - else if Files.exists (path ++ "bsconfig.json") then Some (`Bs path) + else if Files.exists (path /+ "bsconfig.json") then Some (`Bs path) else let parent = Filename.dirname path in if parent = path then (* reached root *) None else loop parent diff --git a/analysis/src/Uri2.ml b/analysis/src/Uri2.ml index b75a156e8..437632a99 100644 --- a/analysis/src/Uri2.ml +++ b/analysis/src/Uri2.ml @@ -29,7 +29,7 @@ end = struct let fromPath path = {path; uri = pathToUri path} let fromLocalPath localPath = - let path = Filename.concat (Unix.getcwd ()) localPath in + let path = Files.maybeConcat (Unix.getcwd ()) localPath in fromPath path let isInterface {path} = Filename.check_suffix path "i"