Merge pull request #864 from fsharp/cache

forki · forki · commit 6c42e616726a · 2015-07-14T10:52:45.000+02:00
Add caching / fix line break tests
diff --git a/paket.dependencies b/paket.dependencies
@@ -36,3 +36,4 @@ nuget xunit.extensions
 nuget Newtonsoft.Json
 nuget Microsoft.AspNet.Razor 2.0.30506
 nuget Microsoft.AspNet.WebPages 2.0.30506
+nuget HashLib
diff --git a/paket.lock b/paket.lock
@@ -12,14 +12,15 @@ NUGET
     FsCheck.Xunit (1.0.4)
       FsCheck (>= 1.0.4)
       xunit (>= 1.9.2)
-    FSharp.Compiler.Service (0.0.89)
+    FSharp.Compiler.Service (1.3.1.0)
     FSharp.Core (3.1.2.1)
     FSharp.Formatting (2.9.3)
       FSharp.Compiler.Service (>= 0.0.87)
       FSharpVSPowerTools.Core (1.8.0)
     FSharp.Formatting.CommandTool (2.9.3)
     FSharpVSPowerTools.Core (1.8.0)
       FSharp.Compiler.Service (>= 0.0.87)
+    HashLib (2.0.1)
     jQuery (2.1.3)
     Knockout (0.0.1)
       AspNetMvc (>= 4.0.0.0)
@@ -79,4 +80,4 @@ NUGET
     xunit (1.9.2)
     xunit.extensions (1.9.2)
       xunit (1.9.2)
-    xunit.runners (1.9.2)
+    xunit.runners (1.9.2)
diff --git a/src/app/FAKE/Cli.fs b/src/app/FAKE/Cli.fs
@@ -15,6 +15,7 @@ type FakeArg =
     | [<AltCommandLine("-b")>] [<Rest>] Boot of string
     | [<AltCommandLine("-br")>] Break
     | [<AltCommandLine("-st")>] Single_Target
+    | [<AltCommandLine("-nc")>] NoCache
     interface IArgParserTemplate with
         member x.Usage = 
             match x with
@@ -27,6 +28,7 @@ type FakeArg =
             | Boot _ -> "Boostrapp your FAKE script."
             | Break -> "Pauses FAKE with a Debugger.Break() near the start"
             | Single_Target -> "Runs only the specified target and not the dependencies."
+            | NoCache -> "Disables caching of compiled script"
 
 /// Return the parsed FAKE args or the parse exception.
 let parsedArgsOrEx args = 
diff --git a/src/app/FAKE/Program.fs b/src/app/FAKE/Program.fs
@@ -116,7 +116,8 @@ try
                     
                 //TODO if printDetails then printEnvironment cmdArgs args
 
-                if not (runBuildScriptWithFsiArgsAt printDetails fsiArgs envVars) then Environment.ExitCode <- 1
+                let useCache = not (fakeArgs.Contains <@ Cli.NoCache @>)
+                if not (runBuildScriptWithFsiArgsAt printDetails fsiArgs envVars useCache true) then Environment.ExitCode <- 1
                 else if printDetails then log "Ready."
 
                 ()
@@ -135,7 +136,7 @@ try
                 let printDetails = containsParam "details" cmdArgs
                 if printDetails then
                     printEnvironment cmdArgs args
-                if not (runBuildScript printDetails buildScriptArg fsiArgs args) then Environment.ExitCode <- 1
+                if not (runBuildScript printDetails buildScriptArg fsiArgs args true true) then Environment.ExitCode <- 1
                 else if printDetails then log "Ready."
             | Some handler ->
                 handler.Interact()
diff --git a/src/app/FakeLib/FSIHelper.fs b/src/app/FakeLib/FSIHelper.fs
@@ -10,6 +10,49 @@ open System.Threading
 
 let private FSIPath = @".\tools\FSharp\;.\lib\FSharp\;[ProgramFilesX86]\Microsoft SDKs\F#\4.0\Framework\v4.0;[ProgramFilesX86]\Microsoft SDKs\F#\3.1\Framework\v4.0;[ProgramFilesX86]\Microsoft SDKs\F#\3.0\Framework\v4.0;[ProgramFiles]\Microsoft F#\v4.0\;[ProgramFilesX86]\Microsoft F#\v4.0\;[ProgramFiles]\FSharp-2.0.0.0\bin\;[ProgramFilesX86]\FSharp-2.0.0.0\bin\;[ProgramFiles]\FSharp-1.9.9.9\bin\;[ProgramFilesX86]\FSharp-1.9.9.9\bin\"
 
+let createDirectiveRegex id = 
+    Text.RegularExpressions.Regex(
+        "^\s*#" + id + "\s*(@\"|\"\"\"|\")(?<path>.+?)(\"\"\"|\")", 
+        System.Text.RegularExpressions.RegexOptions.Compiled ||| 
+        System.Text.RegularExpressions.RegexOptions.Multiline)
+let loadRegex = createDirectiveRegex "load"
+let rAssemblyRegex = createDirectiveRegex "r"
+let searchPathRegex = createDirectiveRegex "I"
+
+let private extractDirectives (regex : System.Text.RegularExpressions.Regex) scriptContents = 
+    regex.Matches(scriptContents)
+    |> Seq.cast<Text.RegularExpressions.Match>
+    |> Seq.map(fun m ->
+        (m.Groups.Item("path").Value)
+    )
+let rec getAllScripts scriptPath : seq<string * string> = 
+    let scriptPath = 
+        if Path.IsPathRooted scriptPath then
+            scriptPath
+        else
+            Path.Combine(Directory.GetCurrentDirectory(), scriptPath)
+    let scriptContents = File.ReadAllText(scriptPath)
+    let loadedContents = 
+        extractDirectives loadRegex scriptContents
+        |> Seq.collect(fun path -> 
+            let path =
+                if Path.IsPathRooted path then
+                    path
+                else
+                    Path.Combine(Path.GetDirectoryName(scriptPath), path)
+            getAllScripts path
+        )
+    Seq.concat [List.toSeq [scriptPath, scriptContents]; loadedContents]
+
+let getAllScriptContents (pathsAndContents : seq<string * string>) = 
+    pathsAndContents |> Seq.map(snd)
+let getIncludedAssembly scriptContents = extractDirectives rAssemblyRegex scriptContents
+let getSearchPaths scriptContents = extractDirectives searchPathRegex scriptContents
+
+let getScriptHash pathsAndContents =
+    let fullContents = getAllScriptContents pathsAndContents |> String.concat("\n")
+    let hasher = HashLib.HashFactory.Checksum.CreateCRC32a()
+    hasher.ComputeString(fullContents).ToString()
 /// The path to the F# Interactive tool.
 let fsiPath =
     let ev = environVar "FSI"
@@ -87,9 +130,14 @@ let executeFSIWithScriptArgsAndReturnMessages script (scriptArgs: string[]) =
 
 open Microsoft.FSharp.Compiler.Interactive.Shell
 
+type private AssemblySource = 
+| GAC
+| Disk
+
+let hashRegex = Text.RegularExpressions.Regex("(?<script>.+)_(?<hash>[a-zA-Z0-9]+\.dll$)", System.Text.RegularExpressions.RegexOptions.Compiled)
 /// Run the given FAKE script with fsi.exe at the given working directory. Provides full access to Fsi options and args. Redirect output and error messages.
-let internal runFAKEScriptWithFsiArgsAndRedirectMessages printDetails (FsiArgs(fsiOptions, script, scriptArgs)) args onErrMsg onOutMsg =
-    if printDetails then traceFAKE "Running Buildscript: %s" script
+let internal runFAKEScriptWithFsiArgsAndRedirectMessages printDetails (FsiArgs(fsiOptions, scriptPath, scriptArgs)) args onErrMsg onOutMsg useCache cleanCache =
+    if printDetails then traceFAKE "Running Buildscript: %s" scriptPath
 
     // Add arguments to the Environment
     for (k,v) in args do
@@ -113,31 +161,118 @@ let internal runFAKEScriptWithFsiArgsAndRedirectMessages printDetails (FsiArgs(f
                 then onMsg s
         handleMessagesFrom sbOut onOutMsg
         handleMessagesFrom sbErr onErrMsg
+    let handleException (ex : Exception) = 
+        onErrMsg (ex.ToString())
 
     use outStream = new StringWriter(sbOut)
     use errStream = new StringWriter(sbErr)
     use stdin = new StreamReader(Stream.Null)
 
-    try
-        let session = FsiEvaluationSession.Create(fsiConfig, commonOptions, stdin, outStream, errStream)
+    let allScriptContents = getAllScripts scriptPath
+    let scriptHash = lazy (getScriptHash allScriptContents)
+    //TODO this is only calculating the hash for the input file, not anything #load-ed
+    
+    let scriptFileName = lazy(Path.GetFileName(scriptPath))
+    let hashPath = lazy("./.fake/" + scriptFileName.Value + "_" + scriptHash.Value)
+    let assemblyPath = lazy(hashPath.Value + ".dll")
+    let assemblyRefPath = lazy(hashPath.Value + "_references.txt")
+    let cacheValid = lazy (
+        System.IO.File.Exists(assemblyPath.Value) &&
+        System.IO.File.Exists(assemblyRefPath.Value))
+
+    let getScriptAndHash fileName =
+        let matched = hashRegex.Match(fileName)
+        matched.Groups.Item("script").Value, matched.Groups.Item("hash").Value
+
+    if useCache && cacheValid.Value then
+        
+        trace ("Using cache")
+        let noExtension = Path.GetFileNameWithoutExtension(scriptFileName.Value)
+        let fullName = 
+            sprintf "<StartupCode$FSI_0001>.$FSI_0001_%s%s$%s" 
+                (noExtension.Substring(0, 1).ToUpper())
+                (noExtension.Substring(1))
+                (Path.GetExtension(scriptFileName.Value).Substring(1))
 
+        for loc in File.ReadAllLines(assemblyRefPath.Value) do
+            Reflection.Assembly.LoadFrom(loc) |> ignore
+
+        let assembly = Reflection.Assembly.LoadFrom(assemblyPath.Value)
+
+        let mainModule = assembly.GetType(fullName)
+        
         try
-            session.EvalScript script
-            // TODO: Reactivate when FCS don't show output any more 
-            // handleMessages()
+            let _result = 
+                mainModule.InvokeMember(
+                    "main@",  
+                    System.Reflection.BindingFlags.InvokeMethod ||| 
+                    System.Reflection.BindingFlags.Public ||| 
+                    System.Reflection.BindingFlags.Static, null, null, [||])
             true
         with
-        | _ ->
-            handleMessages()
+        | ex ->
+            handleException ex
             false
-    with
-    | exn ->
-        traceError "FsiEvaluationSession could not be created."
-        traceError <| sbErr.ToString()
-        raise exn
+    else
+        if useCache then
+            let cacheDir = DirectoryInfo("./.fake")
+            if cacheDir.Exists then
+                let oldFiles = 
+                    cacheDir.GetFiles()
+                    |> Seq.filter(fun file -> 
+                        let oldScriptName, _ = getScriptAndHash(file.Name)
+                        oldScriptName = scriptFileName.Value
+                    )
+                if (oldFiles |> Seq.length) > 0 then
+                    if cleanCache then
+                        for file in oldFiles do
+                            file.Delete()
+                    trace "Cache is invalid, recompiling"
+                else 
+                    trace "Cache doesnt exist"
+            else
+                trace "Cache doesnt exist"
+        try
+            let session = FsiEvaluationSession.Create(fsiConfig, commonOptions, stdin, outStream, errStream)
+            try
+                session.EvalScript scriptPath
+
+                try
+                    if useCache && not cacheValid.Value then
+                        let assemBuilder = session.DynamicAssembly :?> System.Reflection.Emit.AssemblyBuilder
+                        assemBuilder.Save("FSI-ASSEMBLY.dll")
+                        Directory.CreateDirectory("./.fake") |> ignore
+                        File.Move("./FSI-ASSEMBLY.dll", assemblyPath.Value)
+                    
+                        if File.Exists("./FSI-ASSEMBLY.pdb") then
+                            File.Delete("./FSI-ASSEMBLY.pdb")
+
+                        let refedAssemblies = 
+                            System.AppDomain.CurrentDomain.GetAssemblies()
+                            |> Seq.filter(fun assem -> not assem.IsDynamic)
+                            |> Seq.map(fun assem -> assem.Location)
+                            
+                        File.WriteAllLines(assemblyRefPath.Value, refedAssemblies) |> ignore
+                        trace (System.Environment.NewLine + "Saved cache")
+                with 
+                | ex ->
+                    handleException ex
+                    reraise()
+                // TODO: Reactivate when FCS don't show output any more 
+                // handleMessages()
+                true
+            with
+            | _ex ->
+                handleMessages()
+                false
+        with
+        | exn ->
+            traceError "FsiEvaluationSession could not be created."
+            traceError <| sbErr.ToString()
+            raise exn
 
 /// Run the given buildscript with fsi.exe and allows for extra arguments to the script. Returns output.
-let executeBuildScriptWithArgsAndReturnMessages script (scriptArgs: string[]) =
+let executeBuildScriptWithArgsAndReturnMessages script (scriptArgs: string[]) useCache cleanCache =
     let messages = ref []
     let appendMessage isError msg =
         messages := { IsError = isError
@@ -146,19 +281,21 @@ let executeBuildScriptWithArgsAndReturnMessages script (scriptArgs: string[]) =
     let result =
         runFAKEScriptWithFsiArgsAndRedirectMessages
             true (FsiArgs([], script, scriptArgs |> List.ofArray)) []
-            (appendMessage true) (appendMessage false)
+            (appendMessage true) (appendMessage false) useCache cleanCache
     (result, !messages)
 
 /// Run the given buildscript with fsi.exe at the given working directory.  Provides full access to Fsi options and args.
-let runBuildScriptWithFsiArgsAt printDetails (FsiArgs(fsiOptions, script, scriptArgs)) args =
+let runBuildScriptWithFsiArgsAt printDetails (FsiArgs(fsiOptions, script, scriptArgs)) args useCache cleanCache =
     runFAKEScriptWithFsiArgsAndRedirectMessages
         printDetails (FsiArgs(fsiOptions, script, scriptArgs)) args
         traceError (fun s-> traceFAKE "%s" s)
+        useCache
+        cleanCache
 
 /// Run the given buildscript with fsi.exe at the given working directory.
-let runBuildScriptAt printDetails script extraFsiArgs args =
-    runBuildScriptWithFsiArgsAt printDetails (FsiArgs(extraFsiArgs, script, [])) args
+let runBuildScriptAt printDetails script extraFsiArgs args useCache cleanCache =
+    runBuildScriptWithFsiArgsAt printDetails (FsiArgs(extraFsiArgs, script, [])) args useCache cleanCache
 
 /// Run the given buildscript with fsi.exe
-let runBuildScript printDetails script extraFsiArgs args =
-    runBuildScriptAt printDetails script extraFsiArgs args
+let runBuildScript printDetails script extraFsiArgs args useCache cleanCache =
+    runBuildScriptAt printDetails script extraFsiArgs args useCache cleanCache
diff --git a/src/app/FakeLib/FakeLib.fsproj b/src/app/FakeLib/FakeLib.fsproj
@@ -271,6 +271,17 @@
       </ItemGroup>
     </When>
   </Choose>
+  <Choose>
+    <When Condition="($(TargetFrameworkIdentifier) == '.NETFramework' And ($(TargetFrameworkVersion) == 'v4.0' Or $(TargetFrameworkVersion) == 'v4.5' Or $(TargetFrameworkVersion) == 'v4.5.1' Or $(TargetFrameworkVersion) == 'v4.5.2' Or $(TargetFrameworkVersion) == 'v4.5.3' Or $(TargetFrameworkVersion) == 'v4.6')) Or ($(TargetFrameworkIdentifier) == 'MonoAndroid') Or ($(TargetFrameworkIdentifier) == 'MonoTouch')">
+      <ItemGroup>
+        <Reference Include="HashLib">
+          <HintPath>..\..\..\packages\HashLib\lib\net40\HashLib.dll</HintPath>
+          <Private>True</Private>
+          <Paket>True</Paket>
+        </Reference>
+      </ItemGroup>
+    </When>
+  </Choose>
   <Choose>
     <When Condition="($(TargetFrameworkIdentifier) == '.NETFramework' And ($(TargetFrameworkVersion) == 'v4.0' Or $(TargetFrameworkVersion) == 'v4.5' Or $(TargetFrameworkVersion) == 'v4.5.1' Or $(TargetFrameworkVersion) == 'v4.5.2' Or $(TargetFrameworkVersion) == 'v4.5.3' Or $(TargetFrameworkVersion) == 'v4.6')) Or ($(TargetFrameworkIdentifier) == 'MonoAndroid') Or ($(TargetFrameworkIdentifier) == 'MonoTouch')">
       <ItemGroup>
diff --git a/src/app/FakeLib/paket.references b/src/app/FakeLib/paket.references
@@ -3,4 +3,5 @@ FSharp.Compiler.Service
 Mono.Web.Xdt
 Mono.Cecil
 Nuget.Core
-Newtonsoft.Json
+Newtonsoft.Json
+HashLib
diff --git a/src/test/Test.FAKECore/FSIHelperSpecs.cs b/src/test/Test.FAKECore/FSIHelperSpecs.cs
diff --git a/src/test/Test.FAKECore/Test.FAKECore.csproj b/src/test/Test.FAKECore/Test.FAKECore.csproj
