@@ -13,6 +13,14 @@ open System.Collections.ObjectModel
1313open FSharp.Compiler .CodeAnalysis
1414open FSharp.Compiler .Diagnostics
1515open FSharp.Compiler .Text
16+ open FSharp.Compiler .CodeAnalysis .ProjectSnapshot
17+
18+ type FSharpChecker with
19+
20+ member x.ParseAndCheckProject ( opts : AnalyzerProjectOptions ) : Async < FSharpCheckProjectResults > =
21+ match opts with
22+ | BackgroundCompilerOptions options -> x.ParseAndCheckProject options
23+ | TransparentCompilerOptions snapshot -> x.ParseAndCheckProject snapshot
1624
1725type FSharpProjectOptions with
1826
@@ -31,6 +39,25 @@ type FSharpProjectOptions with
3139 Stamp = None
3240 }
3341
42+ type FSharpProjectSnapshot with
43+
44+ static member zero =
45+ FSharpProjectSnapshot.Create(
46+ " " ,
47+ None,
48+ None,
49+ [],
50+ [],
51+ [],
52+ [],
53+ false ,
54+ false ,
55+ DateTime.UtcNow,
56+ None,
57+ [],
58+ None
59+ )
60+
3461type Package =
3562 {
3663 Name: string
@@ -118,10 +145,53 @@ let mkOptions (compilerArgs: string array) =
118145 Stamp = None
119146 }
120147
148+ let mkSnapshot ( compilerArgs : string array ) =
149+
150+ let sourceFiles =
151+ compilerArgs
152+ |> Array.choose ( fun ( line : string ) ->
153+ if
154+ isFSharpFile line
155+ && File.Exists line
156+ then
157+
158+ FSharpFileSnapshot.CreateFromFileSystem( line)
159+ |> Some
160+ else
161+ None
162+ )
163+ |> Array.toList
164+
165+ let otherOptions =
166+ compilerArgs
167+ |> Array.filter ( fun line -> not ( isFSharpFile line))
168+ |> Array.toList
169+
170+ FSharpProjectSnapshot.Create(
171+ " Project" ,
172+ None,
173+ None,
174+ sourceFiles,
175+ [],
176+ otherOptions,
177+ [],
178+ false ,
179+ false ,
180+ DateTime.Now,
181+ None,
182+ [],
183+ None
184+
185+ )
186+
121187let mkOptionsFromBinaryLog build =
122188 let compilerArgs = readCompilerArgsFromBinLog build
123189 mkOptions compilerArgs
124190
191+ let mkSnapshotFromBinaryLog build =
192+ let compilerArgs = readCompilerArgsFromBinLog build
193+ mkSnapshot compilerArgs
194+
125195let getCachedIfOldBuildSucceeded binLogPath =
126196 if File.Exists binLogPath then
127197 let build = BinaryLog.ReadBuild binLogPath
@@ -196,6 +266,8 @@ let createProject
196266 printfn $" Exception:\n %s {e.ToString()}"
197267 }
198268
269+ open System.Threading .Tasks
270+
199271let mkOptionsFromProject ( framework : string ) ( additionalPkgs : Package list ) =
200272 task {
201273 try
@@ -219,7 +291,7 @@ let mkOptionsFromProject (framework: string) (additionalPkgs: Package list) =
219291 let cached = getCachedIfOldBuildSucceeded binLogPath
220292
221293 match cached with
222- | Some f -> task { return f }
294+ | Some f -> Task.FromResult f
223295 | None ->
224296 task {
225297 Directory.CreateDirectory( binLogCache)
@@ -235,77 +307,153 @@ let mkOptionsFromProject (framework: string) (additionalPkgs: Package list) =
235307 return FSharpProjectOptions.zero
236308 }
237309
238- let getContextFor ( opts : FSharpProjectOptions ) isSignature source =
239- let fileName = if isSignature then " A.fsi" else " A.fs"
240- let files = Map.ofArray [| ( fileName, SourceText.ofString source) |]
310+ let mkSnapshotFromProject ( framework : string ) ( additionalPkgs : Package list ) =
311+ task {
312+ try
313+ let id = Guid.NewGuid() .ToString( " N" )
314+ let tmpProjectDir = Path.Combine( Path.GetTempPath(), id)
315+
316+ let uniqueBinLogName =
317+ let packages =
318+ additionalPkgs
319+ |> List.map ( fun p -> p.ToString())
320+ |> String.concat " _"
321+
322+ $" v{Utils.currentFSharpAnalyzersSDKVersion}_{framework}_{packages}.binlog"
241323
242- let documentSource fileName =
243- Map.tryFind fileName files
244- |> async.Return
324+ let binLogCache =
325+ Path.Combine( Path.GetTempPath(), " FSharp.Analyzers.SDK.BinLogCache" )
245326
246- let fcs = Utils.createFCS ( Some documentSource)
247- let pathToAnalyzerDlls = Path.GetFullPath( " ." )
327+ let binLogPath = Path.Combine( binLogCache, uniqueBinLogName)
248328
249- let assemblyLoadStats =
250- let client = Client< CliAnalyzerAttribute, CliContext>()
251- client.LoadAnalyzers pathToAnalyzerDlls
329+ let! binLogFile =
330+ let cached = getCachedIfOldBuildSucceeded binLogPath
252331
253- if assemblyLoadStats.AnalyzerAssemblies = 0 then
254- failwith $" no Dlls found in {pathToAnalyzerDlls}"
332+ match cached with
333+ | Some f -> Task.FromResult f
334+ | None ->
335+ task {
336+ Directory.CreateDirectory( binLogCache)
337+ |> ignore
255338
256- if assemblyLoadStats.Analyzers = 0 then
257- failwith $" no Analyzers found in {pathToAnalyzerDlls}"
339+ let! _ = createProject binLogPath tmpProjectDir framework additionalPkgs
340+ return BinaryLog.ReadBuild binLogPath
341+ }
258342
259- if assemblyLoadStats.FailedAssemblies > 0 then
260- failwith
261- $" failed to load %i {assemblyLoadStats.FailedAssemblies} Analyzers in {pathToAnalyzerDlls}"
343+ return mkSnapshotFromBinaryLog binLogFile
344+ with e ->
345+ printfn $" Exception:\n %s {e.ToString()}"
346+ return FSharpProjectSnapshot.zero
347+ }
262348
263- let opts =
264- { opts with
265- SourceFiles = [| fileName |]
266- }
349+ type SourceFile = { FileName: string ; Source: string }
350+
351+ let getContextFor ( opts : AnalyzerProjectOptions ) allSources fileToAnalyze =
352+ task {
353+
354+ let analyzedFileName = fileToAnalyze.FileName
355+
356+ let docSourceMap =
357+ allSources
358+ |> List.map ( fun sf -> sf.FileName, SourceText.ofString sf.Source)
359+ |> Map.ofList
360+
361+ let documentSource fileName =
362+ Map.tryFind fileName docSourceMap
363+ |> async.Return
364+
365+ let fcs = Utils.createFCS ( Some documentSource)
366+ let pathToAnalyzerDlls = Path.GetFullPath( " ." )
367+
368+ let assemblyLoadStats =
369+ let client = Client< CliAnalyzerAttribute, CliContext>()
370+ client.LoadAnalyzers pathToAnalyzerDlls
371+
372+ if assemblyLoadStats.AnalyzerAssemblies = 0 then
373+ failwith $" no Dlls found in {pathToAnalyzerDlls}"
374+
375+ if assemblyLoadStats.Analyzers = 0 then
376+ failwith $" no Analyzers found in {pathToAnalyzerDlls}"
377+
378+ if assemblyLoadStats.FailedAssemblies > 0 then
379+ failwith
380+ $" failed to load %i {assemblyLoadStats.FailedAssemblies} Analyzers in {pathToAnalyzerDlls}"
381+
382+ let! analyzerOpts =
383+ match opts with
384+ | BackgroundCompilerOptions bOpts ->
385+ task {
386+
387+ let allFileNames =
388+ allSources
389+ |> List.map ( fun sf -> sf.FileName)
390+ |> Array.ofList
391+
392+ let bOpts =
393+ { bOpts with
394+ SourceFiles = allFileNames
395+ }
396+
397+ do ! fcs.NotifyFileChanged( analyzedFileName, bOpts) // workaround for https://github.com/dotnet/fsharp/issues/15960
398+ return BackgroundCompilerOptions bOpts
399+ }
400+ | TransparentCompilerOptions snap ->
401+ let docSource = DocumentSource.Custom documentSource
402+
403+ let fileSnapshots =
404+ allSources
405+ |> List.map ( fun sf ->
406+ FSharpFileSnapshot.CreateFromDocumentSource( sf.FileName, docSource)
407+ )
408+
409+ snap.Replace fileSnapshots
410+ |> TransparentCompilerOptions
411+ |> Task.FromResult
412+
413+ let! checkProjectResults = fcs.ParseAndCheckProject analyzerOpts
414+
415+ let allSymbolUses = checkProjectResults.GetAllUsesOfAllSymbols()
416+
417+ if Array.isEmpty allSymbolUses then
418+ failwith " no symboluses"
419+
420+ match !
421+ Utils.typeCheckFile
422+ fcs
423+ Abstractions.NullLogger.Instance
424+ analyzerOpts
425+ analyzedFileName
426+ ( Utils.SourceOfSource.DiscreteSource fileToAnalyze.Source)
427+ with
428+ | Ok( parseFileResults, checkFileResults) ->
429+ let diagErrors =
430+ checkFileResults.Diagnostics
431+ |> Array.filter ( fun d -> d.Severity = FSharpDiagnosticSeverity.Error)
432+
433+ if not ( Array.isEmpty diagErrors) then
434+ raise ( CompilerDiagnosticErrors diagErrors)
435+
436+ let sourceText = SourceText.ofString fileToAnalyze.Source
437+
438+ return
439+ Utils.createContext
440+ checkProjectResults
441+ analyzedFileName
442+ sourceText
443+ ( parseFileResults, checkFileResults)
444+ analyzerOpts
445+ | Error e -> return failwith $" typechecking file failed: %O {e}"
446+ }
447+
448+ let getContext ( opts : FSharpProjectOptions ) source =
449+ let source = { FileName = " A.fs" ; Source = source }
450+
451+ ( getContextFor ( BackgroundCompilerOptions opts) [ source ] source) .GetAwaiter() .GetResult()
452+
453+ let getContextForSignature ( opts : FSharpProjectOptions ) source =
454+ let source = { FileName = " A.fsi" ; Source = source }
267455
268- fcs.NotifyFileChanged( fileName, opts)
269- |> Async.RunSynchronously // workaround for https://github.com/dotnet/fsharp/issues/15960
270-
271- let checkProjectResults =
272- fcs.ParseAndCheckProject( opts)
273- |> Async.RunSynchronously
274-
275- let allSymbolUses = checkProjectResults.GetAllUsesOfAllSymbols()
276- let analyzerOpts = BackgroundCompilerOptions opts
277-
278- if Array.isEmpty allSymbolUses then
279- failwith " no symboluses"
280-
281- match
282- Utils.typeCheckFile
283- fcs
284- Abstractions.NullLogger.Instance
285- opts
286- fileName
287- ( Utils.SourceOfSource.DiscreteSource source)
288- with
289- | Ok( parseFileResults, checkFileResults) ->
290- let diagErrors =
291- checkFileResults.Diagnostics
292- |> Array.filter ( fun d -> d.Severity = FSharpDiagnosticSeverity.Error)
293-
294- if not ( Array.isEmpty diagErrors) then
295- raise ( CompilerDiagnosticErrors diagErrors)
296-
297- let sourceText = SourceText.ofString source
298-
299- Utils.createContext
300- checkProjectResults
301- fileName
302- sourceText
303- ( parseFileResults, checkFileResults)
304- analyzerOpts
305- | Error e -> failwith $" typechecking file failed: %O {e}"
306-
307- let getContext ( opts : FSharpProjectOptions ) source = getContextFor opts false source
308- let getContextForSignature ( opts : FSharpProjectOptions ) source = getContextFor opts true source
456+ ( getContextFor ( BackgroundCompilerOptions opts) [ source ] source) .GetAwaiter() .GetResult()
309457
310458module Assert =
311459
0 commit comments