add project parser

docs/content/project.fsx

@@ -8,6 +8,10 @@ This tutorial demonstrates how to can analyze a whole project using services pro
 
 > **NOTE:** The API used below is experimental and subject to change when later versions of the nuget package are published
 
+*)
+
+
+(**
 
 Getting whole-project results
 -----------------------------
@@ -295,6 +299,48 @@ correctly and then analyze each project in turn.
 
 **)
 
+(**
+Cracking a project file
+-----------------------------
+
+F# projects normally use the '.fsproj' project file format.  You can get options corresponding to a project file
+using GetProjectOptionsFromProjectFile.  In this example we get the project options for one of the 
+project files in the F# Compiler Service project itself - you should also be able to use this technique
+for any project that cleans buildly using the command line tools 'xbuild' or 'msbuild'.
+
+
+*)
+
+(*** define-output:options1 ***)
+
+checker.GetProjectOptionsFromProject(__SOURCE_DIRECTORY__ + @"/../../src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj")
+
+
+(**
+
+The options produced in this case are:
+
+*)
+
+(*** include-it:options1 ***)
+
+
+(**
+
+Another utility is provided to simply get the command line arguments for a project file
+
+*)
+
+(*** define-output:options2 ***)
+
+InteractiveChecker.GetCommandLineArgsFromProject(__SOURCE_DIRECTORY__ + @"/../../src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj")
+
+(**
+
+Here the arguments are simply returned as an array of command line arguments suitable for the F# compiler or compiler service.
+
+*)
+
 (**
 Summary
 -------

src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj

@@ -595,6 +595,7 @@
     <Reference Include="mscorlib" />
     <Reference Include="System" />
     <Reference Include="System.Core" />
+    <Reference Include="System.Xml" />
     <Reference Include="Microsoft.Build.Framework" />
     <Reference Include="Microsoft.Build.Engine" />
     <Reference Include="Microsoft.Build" />

src/fsharp/vs/service.fs

@@ -2421,6 +2421,223 @@ type InteractiveChecker(projectCacheSize) =
           LoadTime = loadedTimeStamp
           UnresolvedReferences = None }
 
+#if SILVERLIGHT
+#else
+    member ic.GetProjectOptionsFromProject(projectFileName, ?properties : (string * string) list, ?loadedTimeStamp) = 
+        let args = InteractiveChecker.GetCommandLineArgsFromProject(projectFileName, ?properties=properties)
+        ic.GetProjectOptionsFromCommandLineArgs(projectFileName, args, ?loadedTimeStamp=loadedTimeStamp)
+
+    static member GetCommandLineArgsFromProject(projectFileName:string, ?properties : (string * string) list) = 
+
+        // It seems the current directory must be set to get correct processing
+        use _pwd = 
+            let dir = Environment.CurrentDirectory
+            Environment.CurrentDirectory <- Path.GetDirectoryName(projectFileName)
+            { new System.IDisposable with member x.Dispose() = Environment.CurrentDirectory <- dir }
+
+        use engine = new Microsoft.Build.Evaluation.ProjectCollection()
+
+        use xmlReader = System.Xml.XmlReader.Create(FileSystem.FileStreamReadShim(projectFileName))
+
+        let project = 
+            if runningOnMono then 
+                engine.LoadProject(xmlReader, "4.0", FullPath=projectFileName)
+            else
+                engine.LoadProject(xmlReader, FullPath=projectFileName)
+        let properties = defaultArg properties []
+        for (p, v) in properties do
+            project.SetProperty(p, v) |> ignore
+
+        let project = project.CreateProjectInstance()
+
+        let b = project.Build([| "ResolveReferences" |], null)
+        if not b then 
+            failwith (sprintf "resolving references failed for project '%s'" projectFileName)
+
+        let mkAbsolute dir v = 
+            if FileSystem.IsPathRootedShim v then v
+            else Path.Combine(dir, v)
+
+        let fileItems = project.GetItems("Compile")
+        let resourceItems = project.GetItems("Resource")
+        let dir = Path.GetDirectoryName project.FullPath
+
+        let getprop s = 
+            let v = project.GetPropertyValue s
+            if String.IsNullOrWhiteSpace v then None
+            else Some v
+
+        let split (s : string option) (cs : char []) = 
+            match s with
+            | None -> [||]
+            | Some s -> 
+                if String.IsNullOrWhiteSpace s then [||]
+                else s.Split(cs, StringSplitOptions.RemoveEmptyEntries)
+
+        let getbool (s : string option) = 
+            match s with
+            | None -> false
+            | Some s -> 
+                match (Boolean.TryParse s) with
+                | (true, result) -> result
+                | (false, _) -> false
+
+        let optimize = getprop "Optimize" |> getbool
+        let assemblyNameOpt = getprop "AssemblyName"
+        let tailcalls = getprop "Tailcalls" |> getbool
+        let outputPathOpt = getprop "OutputPath"
+        let docFileOpt = getprop "DocumentationFile"
+        let outputTypeOpt = getprop "OutputType"
+        let debugTypeOpt = getprop "DebugType"
+        let baseAddressOpt = getprop "BaseAddress"
+        let sigFileOpt = getprop "GenerateSignatureFile"
+        let keyFileOpt = getprop "KeyFile"
+        let pdbFileOpt = getprop "PdbFile"
+        let platformOpt = getprop "Platform"
+        let targetTypeOpt = getprop "TargetType"
+        let versionFileOpt = getprop "VersionFile"
+        let targetProfileOpt = getprop "TargetProfile"
+        let warnLevelOpt = getprop "Warn"
+        let subsystemVersionOpt = getprop "SubsystemVersion"
+        let win32ResOpt = getprop "Win32ResourceFile"
+        let heOpt = getprop "HighEntropyVA" |> getbool
+        let win32ManifestOpt = getprop "Win32ManifestFile"
+        let debugSymbols = getprop "DebugSymbols" |> getbool
+        let prefer32bit = getprop "Prefer32Bit" |> getbool
+        let warnAsError = getprop "TreatWarningsAsErrors" |> getbool
+        let defines = split (getprop "DefineConstants") [| ';'; ','; ' ' |]
+        let nowarn = split (getprop "NoWarn") [| ';'; ','; ' ' |]
+        let warningsAsError = split (getprop "WarningsAsErrors") [| ';'; ','; ' ' |]
+        let libPaths = split (getprop "ReferencePath") [| ';'; ',' |]
+        let otherFlags = split (getprop "OtherFlags") [| ' ' |]
+        let isLib = (outputTypeOpt = Some "Library")
+
+        let outputFileOpt = 
+            match outputPathOpt, assemblyNameOpt with
+            | Some outputPath, Some assemblyName -> 
+                let v = 
+                    Path.Combine(outputPath, assemblyName) + (if isLib then ".dll"
+                                                              else ".exe")
+                Some(mkAbsolute dir v)
+            | _ -> None
+
+        let docFileOpt = 
+            match docFileOpt with
+            | None -> None
+            | Some docFile -> Some(mkAbsolute dir docFile)
+
+        let files = 
+            [| for f in fileItems do
+                   yield mkAbsolute dir f.EvaluatedInclude |]
+
+        let resources = 
+            [| for f in resourceItems do
+                   yield "--resource:" + mkAbsolute dir f.EvaluatedInclude |]
+
+        //let fxVer = project.GetPropertyValue("TargetFrameworkVersion")
+
+        let references = 
+            [| for i in project.GetItems("ReferencePath") do
+                   yield "-r:" + mkAbsolute dir i.EvaluatedInclude |]
+
+        let libPaths = 
+            [| for i in libPaths do
+                   yield "--lib:" + mkAbsolute dir i |]
+
+        let options = 
+            [| yield "--simpleresolution"
+               yield "--noframework"
+               match outputFileOpt with
+               | None -> ()
+               | Some outputFile -> yield "--out:" + outputFile
+               match docFileOpt with
+               | None -> ()
+               | Some docFile -> yield "--doc:" + docFile
+               match baseAddressOpt with
+               | None -> ()
+               | Some baseAddress -> yield "--baseaddress:" + baseAddress
+               match keyFileOpt with
+               | None -> ()
+               | Some keyFile -> yield "--keyfile:" + keyFile
+               match sigFileOpt with
+               | None -> ()
+               | Some sigFile -> yield "--sig:" + sigFile
+               match pdbFileOpt with
+               | None -> ()
+               | Some pdbFile -> yield "--pdb:" + pdbFile
+               match versionFileOpt with
+               | None -> ()
+               | Some versionFile -> yield "--versionfile:" + versionFile
+               match warnLevelOpt with
+               | None -> ()
+               | Some warnLevel -> yield "--warn:" + warnLevel
+               match subsystemVersionOpt with
+               | None -> ()
+               | Some s -> yield "--subsystemversion:" + s
+               if heOpt then yield "--highentropyva+"
+               match win32ResOpt with
+               | None -> ()
+               | Some win32Res -> yield "--win32res:" + win32Res
+               match win32ManifestOpt with
+               | None -> ()
+               | Some win32Manifest -> yield "--win32manifest:" + win32Manifest
+               match targetProfileOpt with
+               | None -> ()
+               | Some targetProfile -> yield "--targetprofile:" + targetProfile
+               yield "--fullpaths"
+               yield "--flaterrors"
+               if warnAsError then yield "--warnaserror"
+               yield if isLib then "--target:library"
+                     else "--target:exe"
+               for symbol in defines do
+                   if not (String.IsNullOrWhiteSpace symbol) then yield "--define:" + symbol
+               for nw in nowarn do
+                   if not (String.IsNullOrWhiteSpace nw) then yield "--nowarn:" + nw
+               for nw in warningsAsError do
+                   if not (String.IsNullOrWhiteSpace nw) then yield "--warnaserror:" + nw
+               yield if debugSymbols then "debug+"
+                     else "--debug-"
+               yield if optimize then "--optimize+"
+                     else "--optimize-"
+               yield if tailcalls then "--tailcalls+"
+                     else "--tailcalls-"
+               match debugTypeOpt with
+               | None -> ()
+               | Some debugType -> 
+                   match debugType.ToUpperInvariant() with
+                   | "NONE" -> ()
+                   | "PDBONLY" -> yield "--debug:pdbonly"
+                   | "FULL" -> yield "--debug:full"
+                   | _ -> ()
+               match platformOpt |> Option.map (fun o -> o.ToUpperInvariant()), prefer32bit, 
+                     targetTypeOpt |> Option.map (fun o -> o.ToUpperInvariant()) with
+               | Some "ANYCPU", true, Some "EXE" | Some "ANYCPU", true, Some "WINEXE" -> yield "anycpu32bitpreferred"
+               | Some "ANYCPU", _, _ -> yield "anycpu"
+               | Some "X86", _, _ -> yield "x86"
+               | Some "X64", _, _ -> yield "x64"
+               | Some "ITANIUM", _, _ -> yield "Itanium"
+               | _ -> ()
+               match targetTypeOpt |> Option.map (fun o -> o.ToUpperInvariant()) with
+               | Some "LIBRARY" -> yield "--target:library"
+               | Some "EXE" -> yield "--target:exe"
+               | Some "WINEXE" -> yield "--target:winexe"
+               | Some "MODULE" -> yield "--target:module"
+               | _ -> ()
+               yield! otherFlags
+               yield! resources
+               yield! libPaths
+               yield! references
+               yield! files |]
+
+        // Finalization of the default BuildManager on Mono causes a thread to start when 'BuildNodeManager' is accessed
+        // in the finalizer on exit.  The thread start doesn't work when exiting, and an error is printed
+        // and even worse the thread is not marked as a background computation thread, so a console 
+        // application doesn't exit correctly.
+        if runningOnMono then 
+            System.GC.SuppressFinalize(Microsoft.Build.Execution.BuildManager.DefaultBuildManager)
+        options
+#endif
+
     /// Begin background parsing the given project.
     member ic.StartBackgroundCompile(options) = backgroundCompiler.StartBackgroundCompile(options) 
 

src/fsharp/vs/service.fsi

@@ -496,6 +496,24 @@ type InteractiveChecker =
     /// so that references are re-resolved.</param>
     member GetProjectOptionsFromCommandLineArgs : projectFileName: string * argv: string[] * ?loadedTimeStamp: DateTime -> ProjectOptions
            
+    /// <summary>
+    /// <para>Get the command line arguments implied by a standard F# project file in the xbuild/msbuild format.</para>
+    /// </summary>
+    ///
+    /// <param name="projectFileName">Used to differentiate between projects and for the base directory of the project.</param>
+    /// <param name="properties">The build properties such as Configuration=Debug etc.</param>
+    static member GetCommandLineArgsFromProject : projectFileName: string * ?properties : (string * string) list -> string[]
+
+    /// <summary>
+    /// <para>Get the project options implied by a standard F# project file in the xbuild/msbuild format.</para>
+    /// </summary>
+    ///
+    /// <param name="projectFileName">Used to differentiate between projects and for the base directory of the project.</param>
+    /// <param name="properties">The build properties such as Configuration=Debug etc.</param>
+    /// <param name="loadedTimeStamp">Indicates when the project was loaded into the editing environment,
+    /// so that an 'unload' and 'reload' action will cause the project to be considered as a new project.</param>
+    member GetProjectOptionsFromProject : projectFileName: string * ?properties : (string * string) list * ?loadedTimeStamp: DateTime -> ProjectOptions
+
     [<Obsolete("This member has been renamed to 'GetProjectOptionsFromScript'")>]
     member GetProjectOptionsFromScriptRoot : filename: string * source: string * ?loadedTimeStamp: DateTime * ?otherFlags: string[] * ?useFsiAuxLib: bool -> ProjectOptions