Revert "Test using normal filename concat without trying to normalize ./foo." (#201)

* Revert "No Infix."

This reverts commit f36bef2.

* Revert "Test using normal filename concat without trying to normalize `./foo`."

This reverts commit 8b0b7c5.

Author: chenglou

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 \
@@ -9,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
@@ -32,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 : \

analysis/src/BuildSystem.ml

@@ -1,5 +1,9 @@
 let namespacedName namespace name =
-  match namespace with None -> name | Some namespace -> name ^ "-" ^ namespace
+  match namespace with
+  | None -> name
+  | Some namespace -> name ^ "-" ^ namespace
+
+open Infix
 
 let getBsPlatformDir rootPath =
   let result =
@@ -17,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")

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

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

analysis/src/Infix.ml

@@ -26,3 +26,5 @@ let logIfAbsent message x =
     Log.log message;
     None
   | _ -> x
+
+let ( /+ ) = Files.fileConcat

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

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

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"