Merge pull request #59 from rneatherway/fsharp-core-2

FSharp.Core resolution for scripts and projects

FsAutoComplete.Tests/Tests.fs

@@ -33,3 +33,17 @@ let ``normalCracking`` () =
   Assert.AreEqual(11,col)
   Assert.AreEqual(["First";"Second"],idents)
   Assert.AreEqual("First.Second.Third".[col], 'd')
+
+[<Test>]
+let ``should find FSharp.Core`` () =
+  Assert.That(Option.isSome Environment.fsharpCoreOpt, "FSharp.Core.dll resolution failed")
+
+[<Test>]
+let ``should find fsc on Windows`` () =
+  if not Utils.runningOnMono then
+    Assert.That(Environment.fsc.Contains("Microsoft SDKs"), "fsc.exe resolution failed")
+
+[<Test>]
+let ``should find msbuild on Windows`` () =
+  if not Utils.runningOnMono then
+    Assert.That(Environment.msbuild.Length > "MSBuild.exe".Length, "MSBuild.exe resolution failed")

FsAutoComplete/CommandResponse.fs

@@ -124,6 +124,13 @@ module CommandResponse =
       Text: string
     }
 
+  type CompilerLocationResponse =
+    {
+      Fsc: string
+      Fsi: string
+      MSBuild: string
+    }
+
   type FSharpErrorInfo =
     {
       FileName: string
@@ -275,6 +282,10 @@ module CommandResponse =
   let toolTip(tip) =
     writeJson { Kind = "tooltip"; Data = TipFormatter.formatTip tip }
 
+  let compilerLocation fsc fsi msbuild =
+    let data = { Fsi = fsi; Fsc = fsc; MSBuild = msbuild }
+    writeJson { Kind = "compilerlocation"; Data = data }
+
   let message(kind: string, data: 'a) =
     writeJson { Kind = kind; Data = data }
 

FsAutoComplete/CompilerServiceInterface.fs

@@ -103,23 +103,19 @@ type FSharpCompilerServiceChecker() =
   let checker = FSharpChecker.Instance
   do checker.BeforeBackgroundFileCheck.Add (fun _ -> ())
 
-  let ensureFSharpCore (options: string[]) =
-    if options |> Seq.exists (fun s -> s.Contains("FSharp.Core.dll")) then options
-    else
-      let dirs = FSharpEnvironment.getDefaultDirectories (None, FSharpTargetFramework.NET_4_5 )
-      [| yield! options
-         match FSharpEnvironment.resolveAssembly dirs "FSharp.Core" with
-         | Some fn -> yield sprintf "-r:%s" fn
-         | None ->
-         match FSharpEnvironment.resolveAssembly dirs "FSharp.Compiler.Interactive.Settings" with
-         | Some fn -> yield sprintf "-r:%s" fn
-         | None -> () |]
+  let ensureCorrectFSharpCore (options: string[]) =
+    Environment.fsharpCoreOpt
+    |> Option.map (fun path ->
+                   let fsharpCoreRef = sprintf "-r:%s" path
+                   [| yield fsharpCoreRef
+                      yield! Seq.filter (fun (s: string) -> not (s.EndsWith("FSharp.Core.dll"))) options |])
+    |> Option.getOrElse options
 
   member x.GetProjectOptionsFromScript(file, source) =
     let rawOptions = checker.GetProjectOptionsFromScript(file, source)
                      |> Async.RunSynchronously
     { rawOptions
-      with OtherOptions = ensureFSharpCore rawOptions.OtherOptions }
+      with OtherOptions = ensureCorrectFSharpCore rawOptions.OtherOptions }
 
   member x.ParseAndCheckFileInProject(fileName, version, source, options) =
     checker.ParseAndCheckFileInProject(fileName, version, source, options)
@@ -140,7 +136,11 @@ type FSharpCompilerServiceChecker() =
     else
       try
         let p = FSharpProjectFileInfo.Parse(file)
-        let args = p.Options |> Array.ofList
+        let args, references =
+          if not (Seq.exists (fun (s: string) -> s.Contains "FSharp.Core.dll") p.Options) then
+            ensureCorrectFSharpCore (Array.ofList p.Options), Option.toList Environment.fsharpCoreOpt @ p.References
+          else
+             Array.ofList p.Options, p.References
 
         let projectOptions = checker.GetProjectOptionsFromCommandLineArgs(file, args)
         let referencedProjectOptions =
@@ -150,7 +150,7 @@ type FSharpCompilerServiceChecker() =
         let po =
           { projectOptions
             with ReferencedProjects = referencedProjectOptions }
-        Success (po, p.CompileFiles, p.OutputFile, p.References, p.FrameworkVersion)
+        Success (po, p.CompileFiles, p.OutputFile, references, p.FrameworkVersion)
       with e ->
         Failure e.Message
 

FsAutoComplete/Debug.fs

@@ -1,7 +1,9 @@
 // --------------------------------------------------------------------------------------
 // (c) Robin Neatherway
 // --------------------------------------------------------------------------------------
-module Debug
+namespace FsAutoComplete
+
+module Debug =
 
   let verbose = ref false
   let categories : Ref<Option<Set<string>>> =
@@ -49,4 +51,4 @@ module Debug
 
   let inline flush () =
     if !verbose then
-      (!output).Flush()
+      (!output).Flush()

FsAutoComplete/Environment.fs

@@ -0,0 +1,91 @@
+namespace FsAutoComplete
+
+open System
+open System.IO
+
+module Environment =
+  let private environVar v = Environment.GetEnvironmentVariable v
+
+  let private programFilesX86 =
+      let wow64 = environVar "PROCESSOR_ARCHITEW6432"
+      let globalArch = environVar "PROCESSOR_ARCHITECTURE"
+      match wow64, globalArch with
+      | "AMD64", "AMD64"
+      | null, "AMD64"
+      | "x86", "AMD64" -> environVar "ProgramFiles(x86)"
+      | _ -> environVar "ProgramFiles"
+      |> fun detected -> if detected = null then @"C:\Program Files (x86)\" else detected
+
+  // Below code slightly modified from FAKE MSBuildHelper.fs
+
+  let inline private combinePaths path1 (path2 : string) = Path.Combine(path1, path2.TrimStart [| '\\'; '/' |])
+
+  let inline private (@@) path1 path2 = combinePaths path1 path2
+
+  let private tryFindFile dirs file =
+      let files =
+          dirs
+          |> Seq.map (fun (path : string) ->
+                 let dir = new DirectoryInfo(path)
+                 if not dir.Exists then ""
+                 else
+                     let fi = new FileInfo(dir.FullName @@ file)
+                     if fi.Exists then fi.FullName
+                     else "")
+          |> Seq.filter ((<>) "")
+          |> Seq.cache
+      if not (Seq.isEmpty files) then Some(Seq.head files)
+      else None
+
+  let private tryFindPath backupPaths tool =
+      let paths = Environment.GetEnvironmentVariable "PATH" + string Path.PathSeparator + backupPaths
+      let paths = paths.Split(Path.PathSeparator)
+      tryFindFile paths tool
+
+  let private findPath backupPaths tool =
+      match tryFindPath backupPaths tool with
+      | Some file -> file
+      | None -> tool
+
+  let msbuild =
+      if Utils.runningOnMono then "xbuild"
+      else
+        let MSBuildPath =
+            (programFilesX86 @@ @"\MSBuild\14.0\Bin") + ";" +
+            (programFilesX86 @@ @"\MSBuild\12.0\Bin") + ";" +
+            (programFilesX86 @@ @"\MSBuild\12.0\Bin\amd64") + ";" +
+            @"c:\Windows\Microsoft.NET\Framework\v4.0.30319\;" +
+            @"c:\Windows\Microsoft.NET\Framework\v4.0.30128\;" +
+            @"c:\Windows\Microsoft.NET\Framework\v3.5\"
+        let ev = Environment.GetEnvironmentVariable "MSBuild"
+        if not (String.IsNullOrEmpty ev) then ev
+        else findPath MSBuildPath "MSBuild.exe"
+
+  let private fsharpInstallationPath =
+    ["4.0"; "3.1"; "3.0"]
+    |> List.map (fun v -> programFilesX86 @@ @"\Microsoft SDKs\F#\" @@ v @@ @"\Framework\v4.0")
+    |> List.tryFind Directory.Exists
+
+  let fsi =
+    if Utils.runningOnMono then "fsharpi"
+    else
+      Option.getOrElse "" fsharpInstallationPath @@ "fsi.exe"
+
+  let fsc =
+    if Utils.runningOnMono then "fsharpc"
+    else
+      Option.getOrElse "" fsharpInstallationPath @@ "fsc.exe"
+
+  let fsharpCoreOpt =
+    if Utils.runningOnMono then
+      let mscorlibDir = Path.GetDirectoryName typeof<obj>.Assembly.Location
+      if List.forall File.Exists (List.map (combinePaths mscorlibDir) ["FSharp.Core.dll"; "FSharp.Core.optdata"; "FSharp.Core.sigdata"]) then
+        Some (mscorlibDir @@ "FSharp.Core.dll")
+      else
+        None
+    else
+      let referenceAssembliesPath =
+        programFilesX86 @@ @"Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\"
+      let fsharpCoreVersions = ["4.4.0.0"; "4.3.1.0"; "4.3.0.0"]
+      tryFindFile (List.map (combinePaths referenceAssembliesPath) fsharpCoreVersions) "FSharp.Core.dll"
+

FsAutoComplete/FsAutoComplete.fsproj

@@ -56,15 +56,14 @@
   -->
   <ItemGroup>
     <Compile Include="AssemblyInfo.fs" />
-    <Compile Include="Types.fs" />
-    <Compile Include="Debug.fs" />
     <Compile Include="Utils.fs" />
+    <Compile Include="Debug.fs" />
+    <Compile Include="Environment.fs" />
     <Compile Include="BlockingQueueAgent.fs" />
     <Compile Include="Options.fs" />
     <Compile Include="Parser.fs" />
     <Compile Include="TipFormatter.fs" />
     <Compile Include="FileSystem.fs" />
-    <Compile Include="CompilerLocationUtils.fs" />
     <Compile Include="CompilerServiceInterface.fs" />
     <Compile Include="CommandResponse.fs" />
     <Compile Include="CommandInput.fs" />

FsAutoComplete/Program.fs

@@ -234,11 +234,7 @@ module internal Main =
                 main state
 
       | CompilerLocation ->
-          let locopt = FSharpEnvironment.BinFolderOfDefaultFSharpCompiler None
-          match locopt with
-          | None -> Response.error "Could not find compiler"
-          | Some loc -> Response.message("compilerlocation", loc)
-
+          Response.compilerLocation Environment.fsc Environment.fsi Environment.msbuild
           main state
 
       | Error(msg) ->
@@ -251,8 +247,8 @@ module internal Main =
     with e ->
       let msg = "Unexpected internal error. Please report at \
                  https://github.com/fsharp/FsAutoComplete/issues, \
-                 attaching the following stack trace:\n"
-                 + e.Message + e.StackTrace
+                 attaching the exception information:\n"
+                 + e.ToString()
       Response.error msg
       main state
 

FsAutoComplete/Utils.fs

@@ -2,8 +2,22 @@ namespace FsAutoComplete
 
 open System.IO
 
+type Result<'a> =
+  | Success of 'a
+  | Failure of string
+
 module Utils =
 
   let isAScript fileName =
       let ext = Path.GetExtension fileName
       [".fsx";".fsscript";".sketchfs"] |> List.exists ((=) ext)
+
+  let runningOnMono = 
+    try System.Type.GetType("Mono.Runtime") <> null
+    with _ -> false
+
+module Option =
+  let getOrElse defaultValue option =
+    match option with
+    | None -> defaultValue
+    | Some x -> x

FsAutoComplete/test/integration/NoFSharpCoreReference/FileTwo.fs

@@ -0,0 +1,14 @@
+module FileTwo
+
+type Foo =
+  | Bar
+  | Qux
+
+let addition x y = x + y
+
+let add x y = x + y
+
+type NewObjectType() =
+
+  member x.Terrific (y : int) : int =
+    y

FsAutoComplete/test/integration/NoFSharpCoreReference/Program.fs

@@ -0,0 +1,15 @@
+module X =
+  let func x = x + 1
+
+let testval = FileTwo.NewObjectType()
+
+let val2 = X.func 2
+
+let val3 = testval.Terrific val2
+
+let val4 : FileTwo.NewObjectType = testval
+
+[<EntryPoint>]
+let main args =
+    printfn "Hello %d" val2
+    0

FsAutoComplete/test/integration/NoFSharpCoreReference/Runner.fsx

@@ -0,0 +1,21 @@
+#load "../TestHelpers.fsx"
+open TestHelpers
+open System.IO
+open System
+
+(*
+ * This test is a simple sanity check of a basic run of the program.
+ * A few completions, files and script.
+ *)
+
+Environment.CurrentDirectory <- __SOURCE_DIRECTORY__
+File.Delete "output.json"
+
+let p = new FsAutoCompleteWrapper()
+
+
+p.project "Test1.fsproj"
+p.send "quit\n"
+p.finalOutput ()
+|> writeNormalizedOutput "output.json"
+

FsAutoComplete/test/integration/NoFSharpCoreReference/Script.fsx

@@ -0,0 +1,6 @@
+
+
+module XA =
+  let funky x = x + 1
+
+let val99 = XA.funky 21