WIP: Generate an FSI 'context' for a project or file

.editorconfig

@@ -0,0 +1,20 @@
+# http://editorconfig.org
+root = true
+
+[*]
+indent_style = space
+indent_size = 2
+end_of_line = lf
+charset = utf-8
+trim_trailing_whitespace = true
+insert_final_newline = true
+
+# Batch files use tabs for indentation
+[*.bat]
+indent_style = tab
+
+[*.md]
+trim_trailing_whitespace = false
+
+[*.fs]
+indent_size = 4

.gitignore

@@ -37,3 +37,4 @@ fsautocomplete.suave.zip
 .idea/
 /.vs/
 msbuild.binlog
+.vscode

src/FsAutoComplete.Core/Commands.fs

@@ -59,6 +59,8 @@ type CoreResponse =
     | DotnetNewList of Template list
     | DotnetNewGetDetails of DetailedTemplate
     | DotnetNewCreateCli of commandName: string * parameterStr: string
+    | ProjectScriptContext of projectFile: string * scriptLines: string list * fsiOptions: string list
+    | FileScriptContext of file: string * scriptLines: string list * fsiOptions: string list
 
 [<RequireQualifiedAccess>]
 type NotificationEvent =
@@ -920,14 +922,7 @@ type Commands (serialize : Serializer, backgroundServiceEnabled) =
             state.Projects.[projectFileName] <- proj
 
         let projectLoadedSuccessfully projectFileName response =
-            let project =
-                match state.Projects.TryFind projectFileName with
-                | Some prj -> prj
-                | None ->
-                    let proj = new Project(projectFileName, onChange)
-                    state.Projects.[projectFileName] <- proj
-                    proj
-
+            let project = state.Projects.AddOrUpdate(projectFileName, (fun _ -> new Project(projectFileName, onChange)), (fun key existing -> existing))
             project.Response <- Some response
 
             onProjectLoaded projectFileName response
@@ -1120,3 +1115,30 @@ type Commands (serialize : Serializer, backgroundServiceEnabled) =
     }
 
     member x.GetChecker () = checker.GetFSharpChecker()
+
+    member x.ProjectScriptContext (projectFile: ProjectFilePath) = async {
+        match state.Projects.TryFind projectFile with
+        | Some project ->
+            match project.Response with
+            | Some projectInfo ->
+                let script, options = ScriptContext.makeForProject projectInfo
+                return CoreResponse.ProjectScriptContext (projectFile, script, options)
+            | None -> return CoreResponse.ErrorRes (sprintf "No project info for project '%s'" projectFile)
+        | None ->
+            return CoreResponse.ErrorRes (sprintf "Project '%s' could not be found" projectFile)
+    }
+
+    member x.FileScriptContext (file: string) = async {
+        match state.TryGetFileCheckerOptionsWithSource file with
+        | ResultOrString.Error e ->
+            return CoreResponse.ErrorRes e
+        | Ok (projectOptions, _fileLines) ->
+            match state.Projects.TryFind projectOptions.ProjectFileName with
+            | Some projectInfo ->
+                match projectInfo.Response with
+                | Some projectInfo ->
+                    let script, fsiOptions = ScriptContext.makeForFileInProject file projectInfo
+                    return CoreResponse.FileScriptContext (file, script, fsiOptions)
+                | None -> return CoreResponse.ErrorRes (sprintf "No project info for project '%s'" projectOptions.ProjectFileName)
+            | None -> return CoreResponse.ErrorRes (sprintf "No project info for project '%s'" projectOptions.ProjectFileName)
+    }

src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj

@@ -51,6 +51,7 @@
     <Compile Include="BackgroundServices.fs" />
     <Compile Include="Fsdn.fs" />
     <Compile Include="Lint.fs" />
+    <Compile Include="ScriptContext.fs" />
     <Compile Include="Commands.fs" />
   </ItemGroup>
 

src/FsAutoComplete.Core/ScriptContext.fs

@@ -0,0 +1,68 @@
+/// Wraps up logic around converting project files into lists of arguments for FSI
+module FsAutoComplete.ScriptContext
+
+module List =
+    let satisfyAll tests list =
+        let combinedTest = tests |> List.reduce (fun f j -> fun x -> f x && j x)
+        list |> List.filter combinedTest
+
+
+let inline isReference (option: string) = option.StartsWith "-r:" || option.StartsWith ("--reference:")
+
+let inline isRefAssembly (reference: string) = reference.Contains("/ref/")
+
+let isValidFSIReference (reference: string) = not <| isRefAssembly reference
+
+let isValidFSIOption =
+    let badOptions =
+        Set.ofList
+            [ "--nocopyfsharpcore"
+              "--noframework"
+              "--highentropyva-" ]
+    badOptions.Contains >> not
+
+let isNotReference = isReference >> not
+
+let isNotOutput (option: string) = not <| option.StartsWith "-o:"
+
+let isNotTarget (option: string) = not <| option.StartsWith "--target:"
+
+let makeForProject (projectInfo: ProjectCrackerCache) =
+    // TODO: TFM differences?
+    let dllReferences =
+        projectInfo.References
+        |> List.filter isValidFSIReference
+        |> List.map (sprintf "--reference:%s")
+
+    let otherOptions =
+        projectInfo.Options.OtherOptions
+        |> List.ofArray
+        |> List.satisfyAll [ isValidFSIOption; isNotReference; isNotOutput; isNotTarget]
+
+    // TODO: check referenced projects and figure out
+    // a) what their output dll path is
+    // b) if it's built or not.
+    // if not built, throw an error?
+    let referencedProjects = []
+
+    let allFSIOptions =
+        dllReferences @ otherOptions @ referencedProjects
+
+    [], allFSIOptions
+
+let makeForFileInProject (sourceFilePath: string) (projectInfo: ProjectCrackerCache) =
+    // gather script/options from the project-level
+    let script, options = makeForProject projectInfo
+
+    // append to this a 'load' of each file in the project that comes before the given file
+    let files = projectInfo.Items |> List.map (function | Dotnet.ProjInfo.Workspace.ProjectViewerItem.Compile(path, _config) -> path)
+    let filesBefore = files |> List.takeWhile (fun file -> file <> sourceFilePath)
+
+    // Use 'load' instead of 'use' because 'use' is intended for fsx files, and we're loading fs source files here.
+    // By adding these as fsi parameters instead of #load directives inside a script, we should ensure that they are part of the initially-compiled
+    // dynamic assembly, rather than any that are generated as part of parsing the 'script' generated by user interactions.
+    let fsiLoadOperations =
+        filesBefore
+        |> List.map (sprintf "--load:%s")
+
+    script, options @ fsiLoadOperations

src/FsAutoComplete.Core/State.fs

@@ -128,7 +128,6 @@ type State =
       | Some opts -> Ok (opts, volFile.Lines)
 
   member x.TryGetFileCheckerOptionsWithSource(file: SourceFilePath) : ResultOrString<FSharpProjectOptions * string> =
-    let file = Utils.normalizePath file
     match x.TryGetFileCheckerOptionsWithLines(file) with
     | ResultOrString.Error x -> ResultOrString.Error x
     | Ok (opts, lines) -> Ok (opts, String.concat "\n" lines)
@@ -140,7 +139,6 @@ type State =
     | Some f -> Ok (f.Lines)
 
   member x.TryGetFileCheckerOptionsWithLinesAndLineStr(file: SourceFilePath, pos : pos) : ResultOrString<FSharpProjectOptions * LineStr[] * LineStr> =
-    let file = Utils.normalizePath file
     match x.TryGetFileCheckerOptionsWithLines(file) with
     | ResultOrString.Error x -> ResultOrString.Error x
     | Ok (opts, lines) ->

src/FsAutoComplete/CommandResponse.fs

@@ -435,6 +435,19 @@ module CommandResponse =
     CommandName : string
     ParameterStr : string
   }
+
+  type ProjectScriptContextResponse = {
+    ProjectFile: string
+    ScriptLines: string list
+    InterpreterOptions: string list
+  }
+
+
+  type FileScriptContextResponse = {
+    FilePath: string
+    ScriptLines: string list
+    InterpreterOptions: string list
+  }
 
   let info (serialize : Serializer) (s: string) = serialize { Kind = "info"; Data = s }
 
@@ -865,6 +878,12 @@ module CommandResponse =
   let fakeRuntime (serialize : Serializer) (runtimePath : string) =
      serialize { Kind = "fakeRuntime"; Data = runtimePath }
 
+  let projectScriptContext (serialize: Serializer) (projectFile: string) (scriptLines: string list) (interpreterOptions: string list) =
+    serialize { Kind = "projectScriptContext"; Data = { ProjectFile = projectFile; ScriptLines = scriptLines; InterpreterOptions = interpreterOptions } }
+
+  let fileScriptContext (serialize: Serializer) (filePath: string) (scriptLines: string list) (interpreterOptions: string list) =
+    serialize { Kind = "fileScriptContext"; Data = { FilePath = filePath; ScriptLines = scriptLines; InterpreterOptions = interpreterOptions } }
+
   let serialize (s: Serializer) = function
     | CoreResponse.InfoRes(text) ->
       info s text
@@ -950,3 +969,7 @@ module CommandResponse =
     | CoreResponse.DotnetNewGetDetails (detailedTemplate) ->
       dotnetnewgetDetails s detailedTemplate
     | CoreResponse.DotnetNewCreateCli (commandName,parameterStr) -> dotnetnewCreateCli s (commandName, parameterStr)
+    | CoreResponse.ProjectScriptContext (projectFile, scriptLines, interpreterOptions) ->
+      projectScriptContext s projectFile scriptLines interpreterOptions
+    | CoreResponse.FileScriptContext (filePath, scriptLines, interpreterOptions) ->
+      fileScriptContext s filePath scriptLines interpreterOptions

src/FsAutoComplete/FsAutoComplete.Lsp.fs

@@ -1519,7 +1519,7 @@ type FsharpLspServer(commands: Commands, lspClient: FSharpLspClient) =
             }
         )
 
-    member __.FSharpLineLense(p) = async {
+    member __.FSharpLineLense(p: ProjectParms) = async {
         Debug.print "[LSP call] FSharpLineLense"
         let fn = p.Project.GetFilePath()
         let! res = commands.Declarations fn None (commands.TryGetFileVersion fn)
@@ -1567,7 +1567,7 @@ type FsharpLspServer(commands: Commands, lspClient: FSharpLspClient) =
         return res
     }
 
-    member __.FSharpCompile(p) = async {
+    member __.FSharpCompile(p: ProjectParms) = async {
         Debug.print "[LSP call] FSharpCompile"
         let fn = p.Project.GetFilePath()
         let! res = commands.Compile fn
@@ -1616,7 +1616,7 @@ type FsharpLspServer(commands: Commands, lspClient: FSharpLspClient) =
 
     }
 
-    member __.FSharpProject(p) = async {
+    member __.FSharpProject(p: ProjectParms) = async {
         Debug.print "[LSP call] FSharpProject"
         let fn = p.Project.GetFilePath()
         let! res = commands.Project fn false ignore config.ScriptTFM
@@ -1764,6 +1764,32 @@ type FsharpLspServer(commands: Commands, lspClient: FSharpLspClient) =
         return res
     }
 
+    member __.ProjectScriptContext(r: ProjectScriptContextRequest) = async {
+        Debug.print "[LSP call] ProjectScriptContext"
+        match! commands.ProjectScriptContext(fileUriToLocalPath r.Project) with
+        | CoreResponse.InfoRes msg | CoreResponse.ErrorRes msg ->
+            return LspResult.internalError msg
+        | CoreResponse.ProjectScriptContext (projectFile, scriptLines, fsiOpts) ->
+            return
+                { Content = CommandResponse.projectScriptContext FsAutoComplete.JsonSerializer.writeJson projectFile scriptLines fsiOpts }
+                |> LspResult.success
+        | _ ->
+            return LspResult.notImplemented
+    }
+
+    member __.FileScriptContext(r: FileScriptContextRequest) = async {
+        Debug.print "[LSP call] ProjectScriptContext"
+        match! commands.FileScriptContext (fileUriToLocalPath r.File) with
+        | CoreResponse.InfoRes msg | CoreResponse.ErrorRes msg ->
+            return LspResult.internalError msg
+        | CoreResponse.FileScriptContext (filePath, scriptLines, fsiOpts) ->
+            return
+                { Content = CommandResponse.fileScriptContext FsAutoComplete.JsonSerializer.writeJson filePath scriptLines fsiOpts }
+                |> LspResult.success
+        | _ ->
+            return LspResult.notImplemented
+    }
+
 let startCore (commands: Commands) =
     use input = Console.OpenStandardInput()
     use output = Console.OpenStandardOutput()
@@ -1787,6 +1813,8 @@ let startCore (commands: Commands) =
         |> Map.add "fsharp/documentationSymbol" (requestHandling (fun s p -> s.FSharpDocumentationSymbol(p) ))
         |> Map.add "fake/listTargets" (requestHandling (fun s p -> s.FakeTargets(p) ))
         |> Map.add "fake/runtimePath" (requestHandling (fun s p -> s.FakeRuntimePath(p) ))
+        |> Map.add "fsi/projectScriptContext" (requestHandling (fun s p -> s.ProjectScriptContext(p) ))
+        |> Map.add "fsi/fileScriptContext" (requestHandling (fun s p -> s.FileScriptContext(p) ))
 
 
 

src/FsAutoComplete/LspHelpers.fs

@@ -487,6 +487,11 @@ type WorkspacePeekRequest = {Directory : string; Deep: int; ExcludedDirs: string
 type DocumentationForSymbolReuqest = {XmlSig: string; Assembly: string}
 
 type FakeTargetsRequest = {FileName : string; FakeContext : FakeSupport.FakeContext; }
+
+type ProjectScriptContextRequest = { Project: DocumentUri }
+
+type FileScriptContextRequest = { File: DocumentUri }
+
 type LineLensConfig = {
     Enabled: string
     Prefix: string

test/FsAutoComplete.Tests.Lsp/TestCases/ProjectScriptTest/Domain.fs

@@ -0,0 +1,3 @@
+module ProjectScriptTest.Domain
+
+let doAThingWithAString (s: string) = String.replicate 50 s

test/FsAutoComplete.Tests.Lsp/TestCases/ProjectScriptTest/Program.fs

@@ -0,0 +1,8 @@
+// Learn more about F# at http://fsharp.org
+
+open System
+
+[<EntryPoint>]
+let main argv =
+    printfn "Hello World from F#!"
+    0 // return an integer exit code

test/FsAutoComplete.Tests.Lsp/TestCases/ProjectScriptTest/ProjectScriptTest.fsproj

@@ -0,0 +1,18 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+  <PropertyGroup>
+    <OutputType>Exe</OutputType>
+    <DefineConstants>$(DefineConstants);FOO</DefineConstants>
+    <TargetFramework>netcoreapp2.1</TargetFramework>
+  </PropertyGroup>
+
+  <ItemGroup>
+    <Compile Include="Domain.fs" />
+    <Compile Include="Program.fs" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <PackageReference Include="StackExchange.Redis" Version="[2.0.601]" />
+  </ItemGroup>
+
+</Project>

test/FsAutoComplete.Tests.Lsp/Tests.fs

@@ -704,6 +704,54 @@ let dotnetnewTest =
       ))
     ]
 
+let scriptContextTests =
+    let projectDir = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "ProjectScriptTest")
+    let projectFileUri = Path.Combine(projectDir, "ProjectScriptTest.fsproj") |> Uri |> string
+
+    let serverStart = lazy (
+        Utils.runProcess (logDotnetRestore "ProjectScriptTest") projectDir "dotnet" "restore"
+        |> expectExitCodeZero
+        let (server, event) = serverInitialize projectDir defaultConfigDto
+        waitForWorkspaceFinishedParsing event
+        server
+    )
+    let serverTest f () = f serverStart.Value
+
+    testList "Script context tests" [
+        testList "Project script context" [
+            testCase "Contains nuget references"  (serverTest (fun server ->
+                let res = server.ProjectScriptContext({ Project = projectFileUri }) |> Async.RunSynchronously
+                match res with
+                | Result.Error e -> failtestf "Request failed: %A" e
+                | Result.Ok { Content = content } ->
+                    let payload = JsonSerializer.readJson<CommandResponse.ResponseMsg<CommandResponse.ProjectScriptContextResponse>>(content)
+                    Expect.contains payload.Data.InterpreterOptions "--define:FOO" "Should have define from project file"
+
+                    payload.Data.InterpreterOptions
+                    |> Seq.tryFind (fun r -> r.Contains "StackExchange.Redis.dll")
+                    |> Option.defaultWith (fun () -> failwith "Expected to find redis dependency in script options")
+                    |> ignore
+            ))
+        ]
+        testList "File script context" [
+            testCase "Contains files that come before target file" (serverTest (fun server ->
+                let targetFile = Path.Combine(projectDir, "Program.fs") |> Uri |> string
+                let res = server.FileScriptContext({ File = targetFile }) |> Async.RunSynchronously
+                match res with
+                | Result.Error e -> failtestf "Request failed: %A" e
+                | Result.Ok { Content = content } ->
+                    let payload = JsonSerializer.readJson<CommandResponse.ResponseMsg<CommandResponse.FileScriptContextResponse>>(content)
+
+                    let loads =
+                        payload.Data.InterpreterOptions
+                        |> List.filter (fun r -> r.StartsWith "--load:")
+
+                    Expect.hasLength loads 2 "Should have loaded other files in the project (including auto-generated assemblyinfos)"
+                    Expect.stringEnds (List.last loads) "Domain.fs" "Should have loaded the domain file"
+            ))
+        ]
+    ]
+
 ///Global list of tests
 let tests =
    testSequenced <| testList "lsp" [
@@ -717,4 +765,5 @@ let tests =
     fsdnTest
     uriTests
     dotnetnewTest
+    scriptContextTests
   ]