Skip to content

Small cleanup #145

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Apr 26, 2021
Merged

Small cleanup #145

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
efe8138
Small cleanup
chenglou Apr 26, 2021
8e72d4d
Format
chenglou Apr 26, 2021
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
2 changes: 1 addition & 1 deletion analysis/.depend
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ src/NewCompletions.cmx : src/Utils.cmx src/Uri2.cmx src/TopTypes.cmx \
src/Packages.cmx : src/Uri2.cmx src/TopTypes.cmx src/SharedTypes.cmx \
src/Log.cmx src/vendor/Json.cmx src/Infix.cmx src/FindFiles.cmx \
src/Files.cmx src/BuildSystem.cmx
src/PartialParser.cmx : src/SharedTypes.cmx src/Infix.cmx
src/PartialParser.cmx : src/SharedTypes.cmx
src/PrepareUtils.cmx :
src/PrintType.cmx : src/vendor/res_outcome_printer/res_outcome_printer.cmx \
src/vendor/res_outcome_printer/res_doc.cmx
Expand Down
13 changes: 5 additions & 8 deletions analysis/src/Files.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,9 +6,8 @@ let removeExtraDots path =

(* Win32 & MacOS are case-insensitive *)
let pathEq =
match Sys.os_type = "Linux" with
| true -> fun a b -> a = b
| false -> fun a b -> String.lowercase_ascii a = String.lowercase_ascii b
if Sys.os_type = "Linux" then fun a b -> a = b
else fun a b -> String.lowercase_ascii a = String.lowercase_ascii b

let pathStartsWith text prefix =
String.length prefix <= String.length text
Expand Down Expand Up @@ -38,9 +37,7 @@ let relpath base path =
loop (split Filename.dir_sep base) (split Filename.dir_sep path)
in
String.concat Filename.dir_sep
((match base = [] with
| true -> ["."]
| false -> List.map (fun _ -> "..") base)
((match base with [] -> ["."] | _ -> List.map (fun _ -> "..") base)
@ path)
|> removeExtraDots

Expand All @@ -61,7 +58,7 @@ let readFile ~filename =

let exists path = match maybeStat path with None -> false | Some _ -> true

let ifExists path = match exists path with true -> Some path | false -> None
let ifExists path = if exists path then Some path else None

let readDirectory dir =
match Unix.opendir dir with
Expand Down Expand Up @@ -99,7 +96,7 @@ let rec collect ?(checkDir = fun _ -> true) path test =
collect ~checkDir (Filename.concat path name) test)
|> List.concat
else []
| _ -> ( match test path with true -> [path] | false -> [])
| _ -> if test path then [path] else []

let fileConcat a b =
if
Expand Down
180 changes: 88 additions & 92 deletions analysis/src/FindFiles.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -16,9 +16,8 @@ let getSourceDirectories ~includeDev base config =
Json.get "dir" item |?> Json.string |? "Must specify directory"
in
let typ =
match includeDev with
| true -> "lib"
| false -> item |> Json.get "type" |?> Json.string |? "lib"
if includeDev then "lib"
else item |> Json.get "type" |?> Json.string |? "lib"
in
if typ = "dev" then []
else
Expand All @@ -29,10 +28,12 @@ let getSourceDirectories ~includeDev base config =
(* |> 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
config |> Json.get "sources" |?>> handleItem "" |? []
match config |> Json.get "sources" with
| None -> []
| Some item -> handleItem "" item

let isCompiledFile name =
Filename.check_suffix name ".cmt" || Filename.check_suffix name ".cmti"
Expand Down Expand Up @@ -73,10 +74,10 @@ let filterDuplicates cmts =
cmts
|> List.filter (fun path ->
not
( ( Filename.check_suffix path ".re"
|| Filename.check_suffix path ".ml"
|| Filename.check_suffix path ".cmt" )
&& Hashtbl.mem intfs (getName path) ))
((Filename.check_suffix path ".re"
|| Filename.check_suffix path ".ml"
|| Filename.check_suffix path ".cmt")
&& Hashtbl.mem intfs (getName path)))

let nameSpaceToName n =
n
Expand All @@ -89,13 +90,12 @@ let getNamespace config =
let isNamespaced =
ns |?> Json.bool |? (ns |?> Json.string |?> (fun _ -> Some true) |? false)
in
match isNamespaced with
| true ->
if isNamespaced then
ns |?> Json.string
|?? (Json.get "name" config |?> Json.string)
|! "name is required if namespace is true" |> nameSpaceToName
|> fun s -> Some s
| false -> None
else None

let collectFiles directory =
let allFiles = Files.readDirectory directory in
Expand All @@ -108,9 +108,7 @@ let collectFiles directory =
let source =
Utils.find
(fun name ->
match getName name = modName with
| true -> Some (directory /+ name)
| false -> None)
if getName name = modName then Some (directory /+ name) else None)
sources
in
(modName, SharedTypes.Impl (compiled, source)))
Expand Down Expand Up @@ -148,45 +146,44 @@ let findProjectFiles ~debug namespace root sourceDirectories compiledBase =
|| Filename.check_suffix path ".mli"
then (
Log.log ("Adding intf " ^ path);
Hashtbl.replace interfaces (getName path) path ));
Hashtbl.replace interfaces (getName path) path));
let normals =
files
|> Utils.filterMap (fun path ->
if
Filename.check_suffix path ".re"
|| Filename.check_suffix path ".res"
|| Filename.check_suffix path ".ml"
then (
let mname = getName path in
let intf = Hashtbl.find_opt interfaces mname in
Hashtbl.remove interfaces mname;
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
if Files.exists cmti then
if Files.exists cmt then
(* Log.log("Intf and impl " ++ cmti ++ " " ++ cmt) *)
Some (mname, SharedTypes.IntfAndImpl (cmti, intf, cmt, path))
else Some (mname, Intf (cmti, intf))
else (
(* Log.log("Just intf " ++ cmti) *)
Log.log ("Bad source file (no cmt/cmti/cmi) " ^ (compiledBase /+ base));
None
)
| None ->
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));
None
)
) else (
Log.log ("Bad source file (extension) " ^ path);
None
)
)
if
Filename.check_suffix path ".re"
|| Filename.check_suffix path ".res"
|| Filename.check_suffix path ".ml"
then (
let mname = getName path in
let intf = Hashtbl.find_opt interfaces mname in
Hashtbl.remove interfaces mname;
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
if Files.exists cmti then
if Files.exists cmt then
(* Log.log("Intf and impl " ++ cmti ++ " " ++ cmt) *)
Some (mname, SharedTypes.IntfAndImpl (cmti, intf, cmt, path))
else Some (mname, Intf (cmti, intf))
else (
(* Log.log("Just intf " ++ cmti) *)
Log.log
("Bad source file (no cmt/cmti/cmi) " ^ (compiledBase /+ base)
);
None)
| None ->
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));
None))
else (
Log.log ("Bad source file (extension) " ^ path);
None))
in
let result =
List.append normals
Expand All @@ -200,9 +197,9 @@ let findProjectFiles ~debug namespace root sourceDirectories compiledBase =
else res)
interfaces [])
|> List.map (fun (name, paths) ->
match namespace with
| None -> (name, paths)
| Some namespace -> (name ^ "-" ^ namespace, paths))
match namespace with
| None -> (name, paths)
| Some namespace -> (name ^ "-" ^ namespace, paths))
in
match namespace with
| None -> result
Expand Down Expand Up @@ -234,35 +231,35 @@ let findDependencyFiles ~debug base config =
let depFiles =
deps
|> List.map (fun name ->
let result =
ModuleResolution.resolveNodeModulePath ~startPath:base name
|?> fun loc ->
let innerPath = loc /+ "bsconfig.json" in
Log.log ("Dep loc " ^ innerPath);
match Files.readFile innerPath with
| Some text -> (
let inner = Json.parse text in
let namespace = getNamespace inner in
let directories =
getSourceDirectories ~includeDev:false loc inner
in
match BuildSystem.getCompiledBase loc with
| None -> None
| Some compiledBase ->
if debug then Log.log ("Compiled base: " ^ compiledBase);
let compiledDirectories =
directories |> List.map (Files.fileConcat compiledBase)
in
let compiledDirectories =
match namespace = None with
| true -> compiledDirectories
| false -> compiledBase :: compiledDirectories
in
let files =
findProjectFiles ~debug namespace loc directories
compiledBase
in
(*
let result =
ModuleResolution.resolveNodeModulePath ~startPath:base name
|?> fun loc ->
let innerPath = loc /+ "bsconfig.json" in
Log.log ("Dep loc " ^ innerPath);
match Files.readFile innerPath with
| Some text -> (
let inner = Json.parse text in
let namespace = getNamespace inner in
let directories =
getSourceDirectories ~includeDev:false loc inner
in
match BuildSystem.getCompiledBase loc with
| None -> None
| Some compiledBase ->
if debug then Log.log ("Compiled base: " ^ compiledBase);
let compiledDirectories =
directories |> List.map (Files.fileConcat compiledBase)
in
let compiledDirectories =
match namespace with
| None -> compiledDirectories
| Some _ -> compiledBase :: compiledDirectories
in
let files =
findProjectFiles ~debug namespace loc directories
compiledBase
in
(*
let files = switch (namespace) {
| None =>
files
Expand All @@ -273,15 +270,14 @@ let findDependencyFiles ~debug base config =
)
};
*)
Some (compiledDirectories, files) )
| None -> None
in
match result with
| Some dependency -> dependency
| None ->
Log.log ("Skipping nonexistent dependency: " ^ name);
([], [])
)
Some (compiledDirectories, files))
| None -> None
in
match result with
| Some dependency -> dependency
| None ->
Log.log ("Skipping nonexistent dependency: " ^ name);
([], []))
in
let directories, files = List.split depFiles in
let files = List.concat files in
Expand Down
10 changes: 3 additions & 7 deletions analysis/src/ModuleResolution.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,10 +2,6 @@ open Infix

let rec resolveNodeModulePath ~startPath name =
let path = startPath /+ "node_modules" /+ name in
match startPath with
| "/" -> ( match Files.exists path with true -> Some path | false -> None )
| _ -> (
match Files.exists path with
| true -> Some path
| false ->
resolveNodeModulePath ~startPath:(Filename.dirname startPath) name )
if Files.exists path then Some path
else if startPath = "/" then None
else resolveNodeModulePath ~startPath:(Filename.dirname startPath) name
23 changes: 11 additions & 12 deletions analysis/src/NewCompletions.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,16 +1,16 @@
open SharedTypes

let showConstructor {cname = {txt}; args; res} =
let open Infix in
txt
^ (match args = [] with
| true -> ""
| false ->
^ (match args with
| [] -> ""
| _ ->
"("
^ String.concat ", "
(args |> List.map (fun (typ, _) -> typ |> Shared.typeToString))
^ (args
|> List.map (fun (typ, _) -> typ |> Shared.typeToString)
|> String.concat ", ")
^ ")")
^ (res |?>> (fun typ -> "\n" ^ (typ |> Shared.typeToString)) |? "")
^ match res with None -> "" | Some typ -> "\n" ^ (typ |> Shared.typeToString)

(* TODO: local opens *)
let resolveOpens ~env ~previous opens ~package =
Expand Down Expand Up @@ -229,7 +229,7 @@ let valueCompletions ~(env : ProcessCmt.queryEnv) suffix =
(* Get rid of lowercase modules (#417) *)
env.qExported.modules
|> Hashtbl.filter_map_inplace (fun name key ->
match isCapitalized name with true -> Some key | false -> None);
if isCapitalized name then Some key else None);
let moduleCompletions =
completionForExporteds env.qExported.modules env.qFile.stamps.modules
suffix (fun m -> Module m)
Expand Down Expand Up @@ -416,7 +416,7 @@ let mkItem ~name ~kind ~detail ~deprecated ~docstring =
match docstring with [] -> "" | _ :: _ -> docstring |> String.concat "\n"
in
let tags =
match deprecated = None with true -> [] | false -> [1 (* deprecated *)]
match deprecated with None -> [] | Some _ -> [1 (* deprecated *)]
in
Protocol.
{
Expand Down Expand Up @@ -553,9 +553,8 @@ let processCompletable ~findItems ~package ~rawOpens
|> String.concat "."
in
let completionName name =
match modulePathMinusOpens = "" with
| true -> name
| false -> modulePathMinusOpens ^ "." ^ name
if modulePathMinusOpens = "" then name
else modulePathMinusOpens ^ "." ^ name
in
let parts = modulePath @ [partialName] in
let items = parts |> findItems ~exact:false in
Expand Down
Loading