Don't read .merlin file but get opens from bsconfig.

Author: cristianoc

src/MerlinFile.ml

@@ -1,24 +1,16 @@
 open Infix
 open TopTypes
 
-let escapePreprocessingFlags flag =
-  (* ppx escaping not supported on windows yet *)
-  if Sys.os_type = "Win32" then flag
-  else
-    let parts = Utils.split_on_char ' ' flag in
-    match parts with
-    | (("-ppx" | "-pp") as flag) :: rest ->
-      flag ^ " " ^ Utils.maybeQuoteFilename (String.concat " " rest)
-    | _ -> flag
-
 (* 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) =
   let pathsForModule = Hashtbl.create 30 in
   dependencyModules
-  |> List.iter (fun (modName, paths) -> Hashtbl.replace pathsForModule modName paths);
+  |> List.iter (fun (modName, paths) ->
+         Hashtbl.replace pathsForModule modName paths);
   localModules
-  |> List.iter (fun (modName, paths) -> Hashtbl.replace pathsForModule modName paths);
+  |> List.iter (fun (modName, paths) ->
+         Hashtbl.replace pathsForModule modName paths);
   pathsForModule
 
 let newBsPackage rootPath =
@@ -52,25 +44,25 @@ let newBsPackage rootPath =
            let localModules =
              FindFiles.findProjectFiles ~debug:true namespace rootPath
                localSourceDirs compiledBase
-           (*
+             (*
              |> List.map(((name, paths)) => (switch (namespace) {
                | None => name
                | Some(n) => name ++ "-" ++ n }, paths)); *)
            in
            Log.log
-             ( "-- All local modules found: "
-             ^ string_of_int (List.length localModules) );
+             ("-- All local modules found: "
+             ^ string_of_int (List.length localModules));
            localModules
            |> List.iter (fun (name, paths) ->
-                Log.log name;
-                match paths with
-                | SharedTypes.Impl (cmt, _) -> Log.log ("impl " ^ cmt)
-                | Intf (cmi, _) -> Log.log ("intf " ^ cmi)
-                | _ -> Log.log "Both");
+                  Log.log name;
+                  match paths with
+                  | SharedTypes.Impl (cmt, _) -> Log.log ("impl " ^ cmt)
+                  | Intf (cmi, _) -> Log.log ("intf " ^ cmi)
+                  | _ -> Log.log "Both");
            let pathsForModule =
              makePathsForModule localModules dependencyModules
            in
-           let opens =
+           let opens_from_namespace =
              match namespace with
              | None -> []
              | Some namespace ->
@@ -80,27 +72,25 @@ let newBsPackage rootPath =
                [FindFiles.nameSpaceToName namespace]
            in
            Log.log ("Dependency dirs " ^ String.concat " " dependencyDirectories);
-           let opens =
-             let flags =
-               MerlinFile.getFlags rootPath
-               |> RResult.withDefault [""]
-               |> List.map escapePreprocessingFlags
-             in
-             let opens =
+           let opens_from_bsc_flags =
+             match Json.get "bsc-flags" config |?> Json.array with
+             | Some l ->
                List.fold_left
                  (fun opens item ->
-                   let parts = Utils.split_on_char ' ' item in
-                   let rec loop items =
-                     match items with
-                     | "-open" :: name :: rest -> name :: loop rest
-                     | _ :: rest -> loop rest
-                     | [] -> []
-                   in
-                   opens @ loop parts)
-                 opens flags
-             in
-             opens
+                   match item |> Json.string with
+                   | None -> opens
+                   | Some s -> (
+                     let parts = Utils.split_on_char ' ' s in
+                     match parts with
+                     | "-open" :: name :: _ -> name :: opens
+                     | _ -> opens))
+                 [] l
+             | None -> []
+           in
+           let opens =
+             List.rev_append opens_from_bsc_flags opens_from_namespace
            in
+           Log.log ("Opens from bsconfig: " ^ (opens |> String.concat " "));
            let interModuleDependencies =
              Hashtbl.create (List.length localModules)
            in
@@ -112,7 +102,7 @@ let newBsPackage rootPath =
              opens;
              namespace;
              interModuleDependencies;
-           }) ) )
+           })))
 
 let findRoot ~uri packagesByRoot =
   let path = Uri2.toPath uri in
@@ -147,7 +137,7 @@ let getPackage ~uri state =
           | Ok package ->
             Hashtbl.replace state.rootForUri uri package.rootPath;
             Hashtbl.replace state.packagesByRoot package.rootPath package;
-            Ok package )
+            Ok package)
       with
       | Error e -> Error e
-      | Ok package -> Ok package )
+      | Ok package -> Ok package)

src/MerlinFile.mli

@@ -8,13 +8,3 @@ let toOptionAndLog err =
     Log.log e;
     None
   | Ok v -> Some v
-
-module InfixResult = struct
-  let ( |?>> ) a fn = match a with Ok a -> Ok (fn a) | Error e -> Error e
-
-  let ( |? ) a default = match a with Ok a -> a | Error _ -> default
-end
-
-open InfixResult
-
-let withDefault d v = v |? d

src/Packages.ml

@@ -9,7 +9,7 @@ let split_on_char sep s =
   for i = length s - 1 downto 0 do
     if unsafe_get s i = sep then (
       r := sub s (i + 1) (!j - i - 1) :: !r;
-      j := i )
+      j := i)
   done;
   sub s 0 !j :: !r
 
@@ -41,10 +41,6 @@ let endsWith s suffix =
 
 let cmtLocFromVscode (line, col) = (line + 1, col)
 
-let sliceToEnd s start =
-  let l = String.length s in
-  match start <= l with true -> String.sub s start (l - start) | false -> ""
-
 let locWithinLoc inner outer =
   let open Location in
   inner.loc_start.pos_cnum >= outer.loc_start.pos_cnum
@@ -64,23 +60,21 @@ let chopLocationEnd loc length =
     loc_end = {loc.loc_end with pos_cnum = loc.loc_end.pos_cnum - length};
   }
 
-let chopPrefix s prefix = sliceToEnd s (String.length prefix)
-
 (** An optional List.find *)
 let rec find fn items =
   match items with
   | [] -> None
   | one :: rest -> (
-    match fn one with None -> find fn rest | Some x -> Some x )
+    match fn one with None -> find fn rest | Some x -> Some x)
 
 let dedup items =
   let m = Hashtbl.create (List.length items) in
   items
   |> List.filter (fun a ->
-      if Hashtbl.mem m a then false
-      else (
-        Hashtbl.add m a ();
-        true ))
+         if Hashtbl.mem m a then false
+         else (
+           Hashtbl.add m a ();
+           true))
 
 let tupleOfLexing {Lexing.pos_lnum; pos_cnum; pos_bol} =
   (pos_lnum - 1, pos_cnum - pos_bol)
@@ -92,27 +86,11 @@ let tupleOfLexing {Lexing.pos_lnum; pos_cnum; pos_bol} =
 let locationContainsFuzzy {Location.loc_start; loc_end} (l, c) =
   tupleOfLexing loc_start <= (l, c) && tupleOfLexing loc_end >= (l - 5, c)
 
-(*
- * Quotes filename when not quoted
- * Example:
- * myFile.exe -> 'myFile.exe'
- * 'myFile.exe' -> 'myFile.exe'
- *)
-let maybeQuoteFilename filename =
-  let len = String.length filename in
-  if len < 1 then ""
-  else
-    let firstChar = filename.[0] in
-    let lastChar = filename.[len - 1] in
-    match (firstChar, lastChar) with
-    | '\'', '\'' | '"', '"' -> filename
-    | _ -> Filename.quote filename
-
 let filterMap f =
   let rec aux accu = function
     | [] -> List.rev accu
     | x :: l -> (
-      match f x with None -> aux accu l | Some v -> aux (v :: accu) l )
+      match f x with None -> aux accu l | Some v -> aux (v :: accu) l)
   in
   aux []
 
@@ -122,6 +100,6 @@ let filterMapIndex f =
     | x :: l -> (
       match f i x with
       | None -> aux accu i l
-      | Some v -> aux (v :: accu) (i + 1) l )
+      | Some v -> aux (v :: accu) (i + 1) l)
   in
   aux [] 0