Merge pull request #8 from rojepp/multiple_file_check

POC: Implement multiple unsaved file checking

Author: rneatherway

FSharp.AutoComplete/FSharp.AutoComplete.fsproj

@@ -59,6 +59,7 @@
   <ItemGroup>
     <Compile Include="AssemblyInfo.fs" />
     <Compile Include="Debug.fs" />
+    <Compile Include="FileSystem.fs" />
     <Compile Include="Options.fs" />
     <Compile Include="TipFormatter.fs" />
     <Compile Include="Program.fs" />

FSharp.AutoComplete/FileSystem.fs

@@ -0,0 +1,57 @@
+namespace FSharp.InteractiveAutocomplete
+
+open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
+open Microsoft.FSharp.Compiler
+open Microsoft.FSharp.Compiler.SourceCodeServices
+open System
+
+type VolatileFile =
+  {
+    Touched: DateTime
+    Lines: string []
+  }
+
+open System.IO
+
+type FileSystem (actualFs: IFileSystem, getFiles: unit -> Map<string, VolatileFile>) =
+    let getFile (filename: string) =
+       let files = getFiles ()
+       Map.tryFind filename files
+
+    let getContent (filename: string) =
+        match getFile filename with
+        | Some d ->
+           let bytes = System.Text.Encoding.UTF8.GetBytes (String.Join ("\n", d.Lines))
+           Some bytes
+        | _ -> None
+
+    let getOrElse f o =
+        match o with
+        | Some v -> v
+        | _      -> f()
+
+    interface IFileSystem with
+        member x.FileStreamReadShim fileName =
+            getContent fileName
+            |> Option.map (fun bytes -> new MemoryStream (bytes) :> Stream)
+            |> getOrElse (fun () -> actualFs.FileStreamReadShim fileName)
+
+        member x.ReadAllBytesShim fileName =
+            getContent fileName
+            |> getOrElse (fun () -> actualFs.ReadAllBytesShim fileName)
+
+        member x.GetLastWriteTimeShim fileName =
+            match getFile fileName with
+                | Some f -> f.Touched
+                | _      -> actualFs.GetLastWriteTimeShim fileName
+
+        member x.GetTempPathShim() = actualFs.GetTempPathShim()
+        member x.FileStreamCreateShim fileName = actualFs.FileStreamCreateShim fileName
+        member x.FileStreamWriteExistingShim fileName = actualFs.FileStreamWriteExistingShim fileName
+        member x.GetFullPathShim fileName = actualFs.GetFullPathShim fileName
+        member x.IsInvalidPathShim fileName = actualFs.IsInvalidPathShim fileName
+        member x.IsPathRootedShim fileName = actualFs.IsPathRootedShim fileName
+        member x.SafeExists fileName = actualFs.SafeExists fileName
+        member x.FileDelete fileName = actualFs.FileDelete fileName
+        member x.AssemblyLoadFrom fileName = actualFs.AssemblyLoadFrom fileName
+        member x.AssemblyLoad(assemblyName) = actualFs.AssemblyLoad assemblyName

FSharp.AutoComplete/Program.fs

@@ -48,7 +48,7 @@ type Location =
     Column: int
   }
 
-type CompletionResponse = 
+type CompletionResponse =
   {
     Name: string
     Glyph: string
@@ -68,12 +68,12 @@ type FSharpErrorSeverityConverter() =
   inherit JsonConverter()
 
   override x.CanConvert(t:System.Type) = t = typeof<FSharpErrorSeverity>
- 
+
   override x.WriteJson(writer, value, serializer) =
     match value :?> FSharpErrorSeverity with
     | FSharpErrorSeverity.Error -> serializer.Serialize(writer, "Error")
     | FSharpErrorSeverity.Warning -> serializer.Serialize(writer, "Warning")
- 
+
   override x.ReadJson(_reader, _t, _, _serializer) =
     raise (System.NotSupportedException())
 
@@ -135,7 +135,7 @@ module internal CommandInput =
       - prints the best guess for the location of fsc and fsi
         (or fsharpc and fsharpi on unix)
     "
-    
+
   let outputText = @"
     Output format
     =============
@@ -323,7 +323,7 @@ module internal CompletionUtils =
 /// Represents current state
 type internal State =
   {
-    Files : Map<string,string[]> //filename -> lines
+    Files : Map<string,VolatileFile> //filename -> lines * touch date
     Projects : Map<string, FSharpProjectFileInfo>
     OutputMode : OutputMode
     HelpText : Map<String, FSharpToolTipText>
@@ -343,7 +343,7 @@ module internal Main =
        }
      loop ()
      )
- 
+
    member x.WriteLine(s) = agent.Post (Choice1Of2 s)
 
    member x.Quit() = agent.PostAndReply(fun ch -> Choice2Of2 ch)
@@ -367,8 +367,13 @@ module internal Main =
   // Main agent that handles IntelliSense requests
   let agent = new FSharp.CompilerBinding.LanguageService(fun _ -> ())
 
-  let rec main (state:State) : int =
+  let mutable currentFiles = Map.empty
+  let originalFs = Microsoft.FSharp.Compiler.AbstractIL.Internal.Library.Shim.FileSystem
+  let fs = new FileSystem(originalFs, fun () -> currentFiles)
+  Microsoft.FSharp.Compiler.AbstractIL.Internal.Library.Shim.FileSystem <- fs
 
+  let rec main (state:State) : int =
+    currentFiles <- state.Files
     let printMsg = printMsg state
 
     let parsed file =
@@ -379,14 +384,14 @@ module internal Main =
     /// Is the specified position consistent with internal state of file?
     //  Note that both emacs and FSC use 1-based line indexing
     let posok file line col =
-      let lines = state.Files.[file]
+      let lines = state.Files.[file].Lines
       let ok = line <= lines.Length && line >= 1 &&
                col <= lines.[line - 1].Length && col >= 0
       if not ok then printMsg "ERROR" "Position is out of range"
       ok
 
     let getoptions file state =
-      let text = String.concat "\n" state.Files.[file]
+      let text = String.concat "\n" state.Files.[file].Lines
       let project = Map.tryFind file state.Projects
       let projFile, args =
           match project with
@@ -399,14 +404,16 @@ module internal Main =
     //             (Map.fold (fun ks k _ -> k::ks) [] state.Files)
     //             state.OutputMode
     match parseCommand(Console.ReadLine()) with
-    
+
     | OutputMode m -> main { state with OutputMode = m }
 
     | Parse(file,kind) ->
         // Trigger parse request for a particular file
         let lines = readInput [] |> Array.ofList
         let file = Path.GetFullPath file
-        let state' =  { state with Files = Map.add file lines state.Files }
+        let state' =  { state with Files = state.Files |> Map.add file
+                                                        { Lines = lines
+                                                          Touched = DateTime.Now } }
         let text, projFile, args = getoptions file state'
 
         let task =
@@ -474,7 +481,7 @@ module internal Main =
         if parsed file then
           let text, projFile, args = getoptions file state
           let parseResult = agent.ParseFileInProject(projFile, file, text, args) |> Async.RunSynchronously
-          let decls = parseResult.GetNavigationItems().Declarations 
+          let decls = parseResult.GetNavigationItems().Declarations
           match state.OutputMode with
           | Text ->
               let declstrings =
@@ -495,7 +502,7 @@ module internal Main =
         match Map.tryFind sym state.HelpText with
         | None -> ()
         | Some d ->
-         
+
           let tip = TipFormatter.formatTip d
           let helptext = Map.add sym tip Map.empty
           prAsJson { Kind = "helptext"; Data = helptext }
@@ -506,7 +513,7 @@ module internal Main =
         let file = Path.GetFullPath file
         if parsed file && posok file line col then
           let text, projFile, args = getoptions file state
-          let lineStr = state.Files.[file].[line - 1]
+          let lineStr = state.Files.[file].Lines.[line - 1]
           // TODO: Deny recent typecheck results under some circumstances (after bracketed expr..)
           let timeout = match timeout with Some x -> x | _ -> 20000
           let tyResOpt = agent.GetTypedParseResultWithTimeout(projFile, file, text, [||], args, AllowStaleResults.MatchingFileName, timeout)
@@ -537,15 +544,15 @@ module internal Main =
                                   prAsJson { Kind = "helptext"; Data = helptext }
 
                       prAsJson { Kind = "completion"
-                                 Data = [ for d in decls.Items do 
+                                 Data = [ for d in decls.Items do
                                             let (glyph, glyphChar) = CompletionUtils.getIcon d.Glyph
                                             yield { Name = d.Name; Glyph = glyph; GlyphChar = glyphChar } ] }
 
                       let helptext =
                         Seq.fold (fun m (d: FSharpDeclarationListItem) -> Map.add d.Name d.DescriptionText m) Map.empty decls.Items
 
                       main { state with HelpText = helptext }
-              | None -> 
+              | None ->
                   printMsg "ERROR" "Could not get type information"
                   main state
 
@@ -570,20 +577,20 @@ module internal Main =
                     | Json -> prAsJson { Kind = "tooltip"; Data = TipFormatter.formatTip tip }
 
               main state
-          
+
           | FindDeclaration ->
             let declarations = tyRes.GetDeclarationLocation(line,col,lineStr)
                                |> Async.RunSynchronously
             match declarations with
             | FSharpFindDeclResult.DeclNotFound _ -> printMsg "ERROR" "Could not find declaration"
             | FSharpFindDeclResult.DeclFound range ->
-              
+
               match state.OutputMode with
               | Text -> printAgent.WriteLine(sprintf "DATA: finddecl\n%s:%d:%d\n<<EOF>>" range.FileName range.StartLine range.StartColumn)
               | Json ->
                   let data = { Line = range.StartLine; Column = range.StartColumn; File = range.FileName }
                   prAsJson { Kind = "finddecl"; Data = data }
-            
+
             main state
 
         else

FSharp.AutoComplete/test/integration/MultipleUnsavedFiles/FileTwo.fs

@@ -0,0 +1,3 @@
+module FileTwo
+
+let addTwo x y = x + y

FSharp.AutoComplete/test/integration/MultipleUnsavedFiles/Program.fs

@@ -0,0 +1,6 @@
+let testval = FileTwo.addTwo 1 2
+
+[<EntryPoint>]
+let main args =
+    printfn "Hello %d" testval
+    0

FSharp.AutoComplete/test/integration/MultipleUnsavedFiles/multunsaved.fsproj

@@ -0,0 +1,75 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+  <PropertyGroup>
+    <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
+    <Platform Condition=" '$(Platform)' == '' ">x86</Platform>
+    <ProductVersion>8.0.30703</ProductVersion>
+    <SchemaVersion>2.0</SchemaVersion>
+    <ProjectGuid>{116CC2F9-F987-4B3D-915A-34CAC04A73DA}</ProjectGuid>
+    <OutputType>Exe</OutputType>
+    <RootNamespace>Test1</RootNamespace>
+    <AssemblyName>Test1</AssemblyName>
+    <Name>Test1</Name>
+    <UsePartialTypes>False</UsePartialTypes>
+    <BuildOrder>
+      <BuildOrder>
+        <String>Program.fs</String>
+      </BuildOrder>
+    </BuildOrder>
+    <TargetFSharpCoreVersion>4.3.0.0</TargetFSharpCoreVersion>
+    <MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
+  </PropertyGroup>
+  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|x86' ">
+    <DebugSymbols>True</DebugSymbols>
+    <Optimize>False</Optimize>
+    <Tailcalls>False</Tailcalls>
+    <OutputPath>bin\Debug\</OutputPath>
+    <DefineConstants>DEBUG;TRACE</DefineConstants>
+    <WarningLevel>3</WarningLevel>
+    <PlatformTarget>x86</PlatformTarget>
+    <DocumentationFile>bin\Debug\Test1.XML</DocumentationFile>
+  </PropertyGroup>
+  <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|x86' ">
+    <DebugType>pdbonly</DebugType>
+    <Optimize>True</Optimize>
+    <Tailcalls>True</Tailcalls>
+    <OutputPath>bin\Release\</OutputPath>
+    <DefineConstants>TRACE</DefineConstants>
+    <WarningLevel>3</WarningLevel>
+    <PlatformTarget>x86</PlatformTarget>
+    <DocumentationFile>bin\Release\Test1.XML</DocumentationFile>
+    <DebugSymbols>False</DebugSymbols>
+  </PropertyGroup>
+  <ItemGroup>
+    <Reference Include="mscorlib" />
+    <Reference Include="System" />
+    <Reference Include="System.Core" />
+    <Reference Include="FSharp.Core">
+      <Private>True</Private>
+    </Reference>
+  </ItemGroup>
+  <ItemGroup>
+    <Compile Include="FileTwo.fs" />
+    <Compile Include="Program.fs" />
+  </ItemGroup>
+  <Choose>
+    <When Condition="'$(VisualStudioVersion)' == '11.0'">
+      <PropertyGroup>
+        <FSharpTargetsPath>$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets</FSharpTargetsPath>
+      </PropertyGroup>
+    </When>
+    <Otherwise>
+      <PropertyGroup>
+        <FSharpTargetsPath>$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets</FSharpTargetsPath>
+      </PropertyGroup>
+    </Otherwise>
+  </Choose>
+  <Import Project="$(FSharpTargetsPath)" Condition="Exists('$(FSharpTargetsPath)')" />
+  <!-- To modify your build process, add your task inside one of the targets below and uncomment it.
+	     Other similar extension points exist, see Microsoft.Common.targets.
+	<Target Name="BeforeBuild">
+	</Target>
+	<Target Name="AfterBuild">
+	</Target>
+	-->
+</Project>

FSharp.AutoComplete/test/integration/MultipleUnsavedFiles/multunsaved.sln

@@ -0,0 +1,17 @@
+
+Microsoft Visual Studio Solution File, Format Version 11.00
+# Visual Studio 2010
+Project("{f2a71f9b-5d33-465a-a702-920d77279786}") = "multunsaved", "multunsaved.fsproj", "{116CC2F9-F987-4B3D-915A-34CAC04A73DA}"
+EndProject
+Global
+	GlobalSection(SolutionConfigurationPlatforms) = preSolution
+		Debug|x86 = Debug|x86
+		Release|x86 = Release|x86
+	EndGlobalSection
+	GlobalSection(ProjectConfigurationPlatforms) = postSolution
+		{116CC2F9-F987-4B3D-915A-34CAC04A73DA}.Debug|x86.ActiveCfg = Debug|x86
+		{116CC2F9-F987-4B3D-915A-34CAC04A73DA}.Debug|x86.Build.0 = Debug|x86
+		{116CC2F9-F987-4B3D-915A-34CAC04A73DA}.Release|x86.ActiveCfg = Release|x86
+		{116CC2F9-F987-4B3D-915A-34CAC04A73DA}.Release|x86.Build.0 = Release|x86
+	EndGlobalSection
+EndGlobal

FSharp.AutoComplete/test/integration/MultipleUnsavedFiles/multunsavedRunner.fsx

@@ -0,0 +1,27 @@
+#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.txt"
+
+let p = new FSharpAutoCompleteWrapper()
+
+p.project "multunsaved.fsproj"
+p.parse "FileTwo.fs"
+p.parse "Program.fs"
+p.parseContent "FileTwo.fs" """
+module FileTwo
+
+let addTwo2 x y = x + y
+"""
+p.parse "Program.fs"
+p.send "quit\n"
+let output = p.finalOutput ()
+File.WriteAllText("output.txt", output)

FSharp.AutoComplete/test/integration/MultipleUnsavedFiles/output.txt

@@ -0,0 +1,21 @@
+DATA: project
+<absolute path removed>/test/integration/MultipleUnsavedFiles/FileTwo.fs
+<absolute path removed>/test/integration/MultipleUnsavedFiles/Program.fs
+<<EOF>>
+INFO: Synchronous parsing started
+<<EOF>>
+DATA: errors
+<<EOF>>
+INFO: Synchronous parsing started
+<<EOF>>
+DATA: errors
+<<EOF>>
+INFO: Synchronous parsing started
+<<EOF>>
+DATA: errors
+<<EOF>>
+INFO: Synchronous parsing started
+<<EOF>>
+DATA: errors
+[1:22-1:28] ERROR The value, constructor, namespace or type 'addTwo' is not defined
+<<EOF>>