Skip to content
This repository was archived by the owner on Apr 24, 2021. It is now read-only.

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

Merged
merged 1 commit into from
Apr 9, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
19 changes: 0 additions & 19 deletions src/MerlinFile.ml

This file was deleted.

1 change: 0 additions & 1 deletion src/MerlinFile.mli

This file was deleted.

74 changes: 32 additions & 42 deletions src/Packages.ml
Original file line number Diff line number Diff line change
@@ -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 =
Expand Down Expand Up @@ -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 ->
Expand All @@ -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
Expand All @@ -112,7 +102,7 @@ let newBsPackage rootPath =
opens;
namespace;
interModuleDependencies;
}) ) )
})))

let findRoot ~uri packagesByRoot =
let path = Uri2.toPath uri in
Expand Down Expand Up @@ -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)
10 changes: 0 additions & 10 deletions src/RResult.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
38 changes: 8 additions & 30 deletions src/Utils.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand All @@ -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)
Expand All @@ -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 []

Expand All @@ -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