Skip to content

Commit bec610d

Browse files
committed
cache project config on demand
1 parent d954df8 commit bec610d

File tree

4 files changed

+212
-158
lines changed

4 files changed

+212
-158
lines changed

analysis/bin/main.ml

+5
Original file line numberDiff line numberDiff line change
@@ -110,6 +110,11 @@ let main () =
110110
path line col
111111
in
112112
match args with
113+
| [_; "cache-project"; rootPath] -> (
114+
let uri = Uri.fromPath rootPath in
115+
match Packages.getPackage ~uri with
116+
| Some package -> Cache.cacheProject package
117+
| None -> ())
113118
| [_; "completion"; path; line; col; currentFile] ->
114119
printHeaderInfo path line col;
115120
Commands.completion ~debug ~path

analysis/src/Cache.ml

+39
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,39 @@
1+
open SharedTypes
2+
3+
type cached = {
4+
projectFiles: FileSet.t;
5+
dependenciesFiles: FileSet.t;
6+
pathsForModule: (file, paths) Hashtbl.t;
7+
}
8+
9+
let writeCache filename (data : cached) =
10+
let oc = open_out_bin filename in
11+
Marshal.to_channel oc data [];
12+
close_out oc
13+
14+
let readCache filename =
15+
if !Cfg.useProjectConfigCache && Sys.file_exists filename then
16+
try
17+
let ic = open_in_bin filename in
18+
let data : cached = Marshal.from_channel ic in
19+
close_in ic;
20+
Some data
21+
with _ -> None
22+
else None
23+
24+
let targetFileFromLibBs libBs = Filename.concat libBs ".project-files-cache"
25+
26+
let cacheProject (package : package) =
27+
let cached =
28+
{
29+
projectFiles = package.projectFiles;
30+
dependenciesFiles = package.dependenciesFiles;
31+
pathsForModule = package.pathsForModule;
32+
}
33+
in
34+
match BuildSystem.getLibBs package.rootPath with
35+
| None -> ()
36+
| Some libBs ->
37+
let targetFile = targetFileFromLibBs libBs in
38+
writeCache targetFile cached;
39+
print_endline "OK"

analysis/src/Cfg.ml

+8
Original file line numberDiff line numberDiff line change
@@ -9,3 +9,11 @@ let inIncrementalTypecheckingMode =
99
| "true" -> true
1010
| _ -> false
1111
with _ -> false)
12+
13+
let useProjectConfigCache =
14+
ref
15+
(try
16+
match Sys.getenv "RESCRIPT_PROJECT_CONFIG_CACHE" with
17+
| "true" -> true
18+
| _ -> false
19+
with _ -> false)

analysis/src/Packages.ml

+160-158
Original file line numberDiff line numberDiff line change
@@ -44,165 +44,167 @@ let newBsPackage ~rootPath =
4444
in
4545
match Json.parse raw with
4646
| Some config -> (
47-
match FindFiles.findDependencyFiles rootPath config with
48-
| None -> None
49-
| Some (dependencyDirectories, dependenciesFilesAndPaths) -> (
50-
match libBs with
47+
let namespace = FindFiles.getNamespace config in
48+
let rescriptVersion = getReScriptVersion () in
49+
let suffix =
50+
match config |> Json.get "suffix" with
51+
| Some (String suffix) -> suffix
52+
| _ -> ".js"
53+
in
54+
let uncurried =
55+
let ns = config |> Json.get "uncurried" in
56+
match (rescriptVersion, ns) with
57+
| (major, _), None when major >= 11 -> Some true
58+
| _, ns -> Option.bind ns Json.bool
59+
in
60+
let genericJsxModule =
61+
let jsxConfig = config |> Json.get "jsx" in
62+
match jsxConfig with
63+
| Some jsxConfig -> (
64+
match jsxConfig |> Json.get "module" with
65+
| Some (String m) when String.lowercase_ascii m <> "react" -> Some m
66+
| _ -> None)
5167
| None -> None
52-
| Some libBs ->
53-
Some
54-
(let namespace = FindFiles.getNamespace config in
55-
let rescriptVersion = getReScriptVersion () in
56-
let suffix =
57-
match config |> Json.get "suffix" with
58-
| Some (String suffix) -> suffix
59-
| _ -> ".js"
60-
in
61-
let uncurried =
62-
let ns = config |> Json.get "uncurried" in
63-
match (rescriptVersion, ns) with
64-
| (major, _), None when major >= 11 -> Some true
65-
| _, ns -> Option.bind ns Json.bool
66-
in
67-
let genericJsxModule =
68-
let jsxConfig = config |> Json.get "jsx" in
69-
match jsxConfig with
70-
| Some jsxConfig -> (
71-
match jsxConfig |> Json.get "module" with
72-
| Some (String m) when String.lowercase_ascii m <> "react" ->
73-
Some m
74-
| _ -> None)
75-
| None -> None
76-
in
77-
let uncurried = uncurried = Some true in
78-
let sourceDirectories =
79-
FindFiles.getSourceDirectories ~includeDev:true ~baseDir:rootPath
80-
config
81-
in
82-
let projectFilesAndPaths =
83-
FindFiles.findProjectFiles
84-
~public:(FindFiles.getPublic config)
85-
~namespace ~path:rootPath ~sourceDirectories ~libBs
86-
in
87-
projectFilesAndPaths
88-
|> List.iter (fun (_name, paths) -> Log.log (showPaths paths));
89-
let pathsForModule =
90-
makePathsForModule ~projectFilesAndPaths
91-
~dependenciesFilesAndPaths
92-
in
93-
let opens_from_namespace =
94-
match namespace with
95-
| None -> []
96-
| Some namespace ->
97-
let cmt = Filename.concat libBs namespace ^ ".cmt" in
98-
Log.log
99-
("############ Namespaced as " ^ namespace ^ " at " ^ cmt);
100-
Hashtbl.add pathsForModule namespace (Namespace {cmt});
101-
let path = [FindFiles.nameSpaceToName namespace] in
102-
[path]
103-
in
104-
Log.log
105-
("Dependency dirs: "
106-
^ String.concat " "
107-
(dependencyDirectories |> List.map Utils.dumpPath));
108-
let opens_from_bsc_flags =
109-
let bind f x = Option.bind x f in
110-
match Json.get "bsc-flags" config |> bind Json.array with
111-
| Some l ->
112-
List.fold_left
113-
(fun opens item ->
114-
match item |> Json.string with
115-
| None -> opens
116-
| Some s -> (
117-
let parts = String.split_on_char ' ' s in
118-
match parts with
119-
| "-open" :: name :: _ ->
120-
let path = name |> String.split_on_char '.' in
121-
path :: opens
122-
| _ -> opens))
123-
[] l
124-
| None -> []
125-
in
126-
let opens =
127-
[
128-
(if uncurried then "PervasivesU" else "Pervasives");
129-
"JsxModules";
130-
]
131-
:: opens_from_namespace
132-
|> List.rev_append opens_from_bsc_flags
133-
|> List.map (fun path -> path @ ["place holder"])
134-
in
135-
Log.log
136-
("Opens from ReScript config file: "
137-
^ (opens |> List.map pathToString |> String.concat " "));
138-
{
139-
genericJsxModule;
140-
suffix;
141-
rescriptVersion;
142-
rootPath;
143-
projectFiles =
144-
projectFilesAndPaths |> List.map fst |> FileSet.of_list;
145-
dependenciesFiles =
146-
dependenciesFilesAndPaths |> List.map fst |> FileSet.of_list;
147-
pathsForModule;
148-
opens;
149-
namespace;
150-
builtInCompletionModules =
151-
(if
152-
opens_from_bsc_flags
153-
|> List.find_opt (fun opn ->
154-
match opn with
155-
| ["RescriptCore"] -> true
156-
| _ -> false)
157-
|> Option.is_some
158-
then
159-
{
160-
arrayModulePath = ["Array"];
161-
optionModulePath = ["Option"];
162-
stringModulePath = ["String"];
163-
intModulePath = ["Int"];
164-
floatModulePath = ["Float"];
165-
promiseModulePath = ["Promise"];
166-
listModulePath = ["List"];
167-
resultModulePath = ["Result"];
168-
exnModulePath = ["Exn"];
169-
regexpModulePath = ["RegExp"];
170-
}
171-
else if
172-
opens_from_bsc_flags
173-
|> List.find_opt (fun opn ->
174-
match opn with
175-
| ["Belt"] -> true
176-
| _ -> false)
177-
|> Option.is_some
178-
then
179-
{
180-
arrayModulePath = ["Array"];
181-
optionModulePath = ["Option"];
182-
stringModulePath = ["Js"; "String2"];
183-
intModulePath = ["Int"];
184-
floatModulePath = ["Float"];
185-
promiseModulePath = ["Js"; "Promise"];
186-
listModulePath = ["List"];
187-
resultModulePath = ["Result"];
188-
exnModulePath = ["Js"; "Exn"];
189-
regexpModulePath = ["Js"; "Re"];
190-
}
191-
else
192-
{
193-
arrayModulePath = ["Js"; "Array2"];
194-
optionModulePath = ["Belt"; "Option"];
195-
stringModulePath = ["Js"; "String2"];
196-
intModulePath = ["Belt"; "Int"];
197-
floatModulePath = ["Belt"; "Float"];
198-
promiseModulePath = ["Js"; "Promise"];
199-
listModulePath = ["Belt"; "List"];
200-
resultModulePath = ["Belt"; "Result"];
201-
exnModulePath = ["Js"; "Exn"];
202-
regexpModulePath = ["Js"; "Re"];
203-
});
204-
uncurried;
205-
})))
68+
in
69+
let uncurried = uncurried = Some true in
70+
match libBs with
71+
| None -> None
72+
| Some libBs ->
73+
let cached = Cache.readCache (Cache.targetFileFromLibBs libBs) in
74+
let projectFiles, dependenciesFiles, pathsForModule =
75+
match cached with
76+
| Some cached ->
77+
( cached.projectFiles,
78+
cached.dependenciesFiles,
79+
cached.pathsForModule )
80+
| None ->
81+
let dependenciesFilesAndPaths =
82+
match FindFiles.findDependencyFiles rootPath config with
83+
| None -> []
84+
| Some (_dependencyDirectories, dependenciesFilesAndPaths) ->
85+
dependenciesFilesAndPaths
86+
in
87+
let sourceDirectories =
88+
FindFiles.getSourceDirectories ~includeDev:true ~baseDir:rootPath
89+
config
90+
in
91+
let projectFilesAndPaths =
92+
FindFiles.findProjectFiles
93+
~public:(FindFiles.getPublic config)
94+
~namespace ~path:rootPath ~sourceDirectories ~libBs
95+
in
96+
let pathsForModule =
97+
makePathsForModule ~projectFilesAndPaths
98+
~dependenciesFilesAndPaths
99+
in
100+
let projectFiles =
101+
projectFilesAndPaths |> List.map fst |> FileSet.of_list
102+
in
103+
let dependenciesFiles =
104+
dependenciesFilesAndPaths |> List.map fst |> FileSet.of_list
105+
in
106+
(projectFiles, dependenciesFiles, pathsForModule)
107+
in
108+
Some
109+
(let opens_from_namespace =
110+
match namespace with
111+
| None -> []
112+
| Some namespace ->
113+
let cmt = Filename.concat libBs namespace ^ ".cmt" in
114+
Hashtbl.add pathsForModule namespace (Namespace {cmt});
115+
let path = [FindFiles.nameSpaceToName namespace] in
116+
[path]
117+
in
118+
let opens_from_bsc_flags =
119+
let bind f x = Option.bind x f in
120+
match Json.get "bsc-flags" config |> bind Json.array with
121+
| Some l ->
122+
List.fold_left
123+
(fun opens item ->
124+
match item |> Json.string with
125+
| None -> opens
126+
| Some s -> (
127+
let parts = String.split_on_char ' ' s in
128+
match parts with
129+
| "-open" :: name :: _ ->
130+
let path = name |> String.split_on_char '.' in
131+
path :: opens
132+
| _ -> opens))
133+
[] l
134+
| None -> []
135+
in
136+
let opens =
137+
[(if uncurried then "PervasivesU" else "Pervasives"); "JsxModules"]
138+
:: opens_from_namespace
139+
|> List.rev_append opens_from_bsc_flags
140+
|> List.map (fun path -> path @ ["place holder"])
141+
in
142+
{
143+
genericJsxModule;
144+
suffix;
145+
rescriptVersion;
146+
rootPath;
147+
projectFiles;
148+
dependenciesFiles;
149+
pathsForModule;
150+
opens;
151+
namespace;
152+
builtInCompletionModules =
153+
(if
154+
opens_from_bsc_flags
155+
|> List.find_opt (fun opn ->
156+
match opn with
157+
| ["RescriptCore"] -> true
158+
| _ -> false)
159+
|> Option.is_some
160+
then
161+
{
162+
arrayModulePath = ["Array"];
163+
optionModulePath = ["Option"];
164+
stringModulePath = ["String"];
165+
intModulePath = ["Int"];
166+
floatModulePath = ["Float"];
167+
promiseModulePath = ["Promise"];
168+
listModulePath = ["List"];
169+
resultModulePath = ["Result"];
170+
exnModulePath = ["Exn"];
171+
regexpModulePath = ["RegExp"];
172+
}
173+
else if
174+
opens_from_bsc_flags
175+
|> List.find_opt (fun opn ->
176+
match opn with
177+
| ["Belt"] -> true
178+
| _ -> false)
179+
|> Option.is_some
180+
then
181+
{
182+
arrayModulePath = ["Array"];
183+
optionModulePath = ["Option"];
184+
stringModulePath = ["Js"; "String2"];
185+
intModulePath = ["Int"];
186+
floatModulePath = ["Float"];
187+
promiseModulePath = ["Js"; "Promise"];
188+
listModulePath = ["List"];
189+
resultModulePath = ["Result"];
190+
exnModulePath = ["Js"; "Exn"];
191+
regexpModulePath = ["Js"; "Re"];
192+
}
193+
else
194+
{
195+
arrayModulePath = ["Js"; "Array2"];
196+
optionModulePath = ["Belt"; "Option"];
197+
stringModulePath = ["Js"; "String2"];
198+
intModulePath = ["Belt"; "Int"];
199+
floatModulePath = ["Belt"; "Float"];
200+
promiseModulePath = ["Js"; "Promise"];
201+
listModulePath = ["Belt"; "List"];
202+
resultModulePath = ["Belt"; "Result"];
203+
exnModulePath = ["Js"; "Exn"];
204+
regexpModulePath = ["Js"; "Re"];
205+
});
206+
uncurried;
207+
}))
206208
| None -> None
207209
in
208210

0 commit comments

Comments
 (0)