diff --git a/src/MerlinFile.ml b/src/MerlinFile.ml deleted file mode 100644 index deb6106e..00000000 --- a/src/MerlinFile.ml +++ /dev/null @@ -1,19 +0,0 @@ -let parseMerlin text = - let lines = Str.split (Str.regexp_string "\n") text in - List.fold_left - (fun (source, build, flags) line -> - if Utils.startsWith line "FLG " then - (source, build, Utils.chopPrefix line "FLG " :: flags) - else if Utils.startsWith line "S " then - (Utils.chopPrefix line "S " :: source, build, flags) - else if Utils.startsWith line "B " then - (source, Utils.chopPrefix line "B " :: build, flags) - else (source, build, flags)) - ([], [], []) lines - -let getFlags base = - let open RResult.InfixResult in - Files.readFile (base ^ "/.merlin") - |> RResult.orError "no .merlin file" - |?>> parseMerlin - |?>> fun (_, _, flags) -> flags |> List.rev diff --git a/src/MerlinFile.mli b/src/MerlinFile.mli deleted file mode 100644 index 22027988..00000000 --- a/src/MerlinFile.mli +++ /dev/null @@ -1 +0,0 @@ -val getFlags : string -> (string list, string) result diff --git a/src/Packages.ml b/src/Packages.ml index 2e477875..9bc14654 100644 --- a/src/Packages.ml +++ b/src/Packages.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) diff --git a/src/RResult.ml b/src/RResult.ml index 27a5d2de..7d33d071 100644 --- a/src/RResult.ml +++ b/src/RResult.ml @@ -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 diff --git a/src/Utils.ml b/src/Utils.ml index e65529de..282f9390 100644 --- a/src/Utils.ml +++ b/src/Utils.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