/compiler/2.0/Aug2011/src/fsharp/ReferenceResolution.fs

namespace Microsoft.FSharp.Compiler



module internal MSBuildResolver = 

    open System

    open Microsoft.Build.Tasks

    open Microsoft.Build.Utilities

    open Microsoft.Build.Framework

    open Microsoft.Build.BuildEngine

    open System.IO



    exception ResolutionFailure

    

    type ResolvedFrom =

        | AssemblyFolders

        | AssemblyFoldersEx

        | TargetFrameworkDirectory

        | RawFileName

        | GlobalAssemblyCache

        | Path of string 

        | Unknown

    

    type ResolvedFile = {

            itemSpec:string

            resolvedFrom:ResolvedFrom

            fusionName:string

            version:string

            redist:string        

            baggage:string

        }

        with override this.ToString() = sprintf "ResolvedFile(%s)" this.itemSpec

    

    type ResolutionResults = {

        resolvedFiles:ResolvedFile array

        referenceDependencyPaths:string array

        relatedPaths:string array

        referenceSatellitePaths:string array

        referenceScatterPaths:string array

        referenceCopyLocalPaths:string array

        suggestedBindingRedirects:string array

        }

        

    let ReplaceFrameworkVariables(dirs) =

        let windowsFramework = System.Environment.GetEnvironmentVariable("windir")+ @"\Microsoft.NET\Framework"

        let referenceAssemblies =  System.Environment.GetEnvironmentVariable("ProgramFiles")+ @"\Reference Assemblies\Microsoft\Framework\.NETFramework"

        dirs|>List.map(fun (d:string)->d.Replace("{WindowsFramework}",windowsFramework).Replace("{ReferenceAssemblies}",referenceAssemblies))

        

// Q: Why is there a compilation difference between fsc.exe-2.0 and fsc.exe-4.0? Shouldn't the resolve behavior be the same?

// A: Two reasons

//   1) For 4.0 we don't know the version number in this path: c:\Windows\Microsoft.NET\Framework\v4.0.xxxxx

//   2) Fsc.exe-2.0 by design cannot target 4.0

#if FX_ATLEAST_40 

    /// The .NET runtime version that F# was built against.

    let DotNetRuntime = "v4.0.30319"

    /// The short version (like 4.0) that F# was built against.

    let DotNetRuntimeShort = "v4.0"

    /// Locations of .NET framework assemblies.

    let DotNetFrameworkDirectories(excludeNonExecutableAssemblies) = 

        if excludeNonExecutableAssemblies 

        then ReplaceFrameworkVariables([@"{WindowsFramework}\"+DotNetRuntime])

        else ReplaceFrameworkVariables([@"{ReferenceAssemblies}\"+DotNetRuntimeShort; @"{WindowsFramework}\"+DotNetRuntime])

#endif        



    /// Derive the target framework directories.        

    let DeriveTargetFrameworkDirectories

                (targetFrameworkVersion:string,             // e.g. v2.0, v3.0, v3.5, v4.0 etc

                 excludeNonExecutableAssemblies:bool,       // True when the assembly must be executable and not just a stub meta assembly.

                 logmessage:string->unit) =

        let targetFrameworkVersion =

            if not(targetFrameworkVersion.StartsWith("v",StringComparison.Ordinal)) then "v"^targetFrameworkVersion

            else targetFrameworkVersion

        let FrameworkStartsWith(short) =

            targetFrameworkVersion.StartsWith(short,StringComparison.Ordinal)

        let result =

            if FrameworkStartsWith("v1.0") then ReplaceFrameworkVariables([@"{WindowsFramework}\v1.0.3705"])

            else if FrameworkStartsWith("v1.1") then ReplaceFrameworkVariables([@"{WindowsFramework}\v1.1.4322"])

            else if FrameworkStartsWith("v2.0") then ReplaceFrameworkVariables([@"{WindowsFramework}\v2.0.50727"])

            else if FrameworkStartsWith("v3.0") then ReplaceFrameworkVariables([@"{ReferenceAssemblies}\v3.0"; @"{WindowsFramework}\v3.0"; @"{WindowsFramework}\v2.0.50727"])

            else if FrameworkStartsWith("v3.5") then ReplaceFrameworkVariables([@"{ReferenceAssemblies}\v3.5"; @"{WindowsFramework}\v3.5"; @"{ReferenceAssemblies}\v3.0"; @"{WindowsFramework}\v3.0"; @"{WindowsFramework}\v2.0.50727"])

#if FX_ATLEAST_40 

            else DotNetFrameworkDirectories(excludeNonExecutableAssemblies)

#else            

            else (ignore(excludeNonExecutableAssemblies); [])

#endif            

        let result = result |> Array.ofList                

        logmessage (sprintf "Derived target framework directories for version %s are: %s" targetFrameworkVersion (String.Join(",", result)))                

        result    

 

    /// Decode the ResolvedFrom code from MSBuild.

    let DecodeResolvedFrom(resolvedFrom:string) : ResolvedFrom = 

        let Same a b = 

            String.CompareOrdinal(a,b) = 0            

        match resolvedFrom with

        | r when Same "{RawFileName}" r -> RawFileName

        | r when Same "{GAC}" r -> GlobalAssemblyCache

        | r when Same "{TargetFrameworkDirectory}" r -> TargetFrameworkDirectory

        | r when Same "{AssemblyFolders}" r -> AssemblyFolders

        | r when r.Length >= 10 && Same "{Registry:" (r.Substring(0,10)) -> AssemblyFoldersEx

        | r -> Path r

        



    type ErrorWarningCallbackSig = ((*code:*)string->(*message*)string->unit)

                      

    type ResolutionEnvironment = CompileTimeLike | RuntimeLike | DesigntimeLike

    

    type Foregrounded =

        | ForegroundedMessage of string 

        | ForegroundedError of string * string

        | ForegroundedWarning of string * string



    let ResolveCore(

                    resolutionEnvironment: ResolutionEnvironment,

                    references:(string*(*baggage*)string)[], 

                    targetFrameworkVersion:string, 

                    targetFrameworkDirectories:string list,

                    targetProcessorArchitecture:string,                

                    outputDirectory:string, 

                    fsharpBinariesDir:string,

                    explicitIncludeDirs:string list,

                    implicitIncludeDir:string,

                    frameworkRegistryBase:string, 

                    assemblyFoldersSuffix:string, 

                    assemblyFoldersConditions:string, 

                    allowRawFileName:bool,

                    logmessage:string->unit, 

                    logwarning:ErrorWarningCallbackSig, 

                    logerror:ErrorWarningCallbackSig ) =



        // Message Foregrounding:

        //   In version 4.0 MSBuild began calling log methods on a background (non-UI) thread. If there is an exception thrown from 

        //   logmessage, logwarning or logerror then it would kill the process.

        //   The fix is to catch these exceptions and log the rest of the messages to a list to output at the end.

        //   It looks simpler to always just accumulate the messages during resolution and show them all at the end, but then 

        //   we couldn't see the messages as resolution progresses.

        let foregrounded = ref []                

        let backgroundException : exn option ref = ref None

        

        let logmessage message = 

            match !backgroundException with

            | Some _ -> foregrounded := ForegroundedMessage(message) :: !foregrounded

            | None -> 

                try 

                    logmessage message

                with e ->

                    backgroundException := Some(e)

                    foregrounded := ForegroundedMessage(message) :: !foregrounded

                

        let logwarning code message = 

            match !backgroundException with

            | Some _ -> foregrounded := ForegroundedWarning(code,message) :: !foregrounded

            | None -> 

                try 

                    logwarning code message

                with e ->

                    backgroundException := Some(e)     

                    foregrounded := ForegroundedWarning(code,message) :: !foregrounded      

                    

        let logerror code message = 

            match !backgroundException with

            | Some _ -> foregrounded := ForegroundedError(code,message) :: !foregrounded

            | None -> 

                try 

                    logerror code message

                with e ->

                    backgroundException := Some(e)     

                    foregrounded := ForegroundedError(code,message) :: !foregrounded                             

                

                

        let engine = { new IBuildEngine with 

                    member be.BuildProjectFile(projectFileName, targetNames, globalProperties, targetOutputs) = true

                    member be.LogCustomEvent(e) = logmessage e.Message

                    member be.LogErrorEvent(e) = logerror e.Code e.Message

                    member be.LogMessageEvent(e) = logmessage e.Message

                    member be.LogWarningEvent(e) = logwarning e.Code e.Message

                    member be.ColumnNumberOfTaskNode with get() = 1

                    member be.LineNumberOfTaskNode with get() = 1

                    member be.ContinueOnError with get() = true

                    member be.ProjectFileOfTaskNode with get() = "" }

                    

        let rar = new ResolveAssemblyReference()

        rar.BuildEngine <- engine

        

        // Derive target framework directory if none was supplied.

        let excludeNonExecutableAssemblies = (resolutionEnvironment = RuntimeLike)

        let targetFrameworkDirectories =

            if targetFrameworkDirectories=[] then DeriveTargetFrameworkDirectories(targetFrameworkVersion,excludeNonExecutableAssemblies,logmessage) 

            else targetFrameworkDirectories |> Array.ofList

            

        // Filter for null and zero length, and escape backslashes so legitimate path characters aren't mistaken for

        // escape characters (E.g., ".\r.dll")            

        let explicitIncludeDirs = explicitIncludeDirs |> List.filter(fun eid->not(String.IsNullOrEmpty(eid)))

        let references = references |> Array.filter(fun (path,_)->not(String.IsNullOrEmpty(path))) // |> Array.map (fun (path,baggage) -> (path.Replace("\\","\\\\"),baggage))

       

        rar.TargetFrameworkDirectories <- targetFrameworkDirectories 

        rar.FindRelatedFiles <- false

        rar.FindDependencies <- false

        rar.FindSatellites <- false

        rar.FindSerializationAssemblies <- false

        rar.TargetProcessorArchitecture <- targetProcessorArchitecture

        

        rar.Assemblies <- [|for (referenceName,baggage) in references -> 

                                        let item = new Microsoft.Build.Utilities.TaskItem(referenceName)

                                        item.SetMetadata("Baggage", baggage)

                                        item:>ITaskItem|]



        let rawFileNamePath = if allowRawFileName then ["{RawFileName}"] else []

        let searchPaths = 

            match resolutionEnvironment with

            | DesigntimeLike

            | RuntimeLike ->

                logmessage("Using scripting resolution precedence.")                      

                // These are search paths for runtime-like or scripting resolution. GAC searching is present.

                rawFileNamePath @        // Quick-resolve straight to filename first 

                explicitIncludeDirs @    // From -I, #I

                [implicitIncludeDir] @   // Usually the project directory

                [fsharpBinariesDir] @    // Location of fsc.exe

                ["{TargetFrameworkDirectory}"] @

                [sprintf "{Registry:%s,%s,%s%s}" frameworkRegistryBase targetFrameworkVersion assemblyFoldersSuffix assemblyFoldersConditions] @

                ["{AssemblyFolders}"] @

                ["{GAC}"] 

            | CompileTimeLike -> 

                logmessage("Using compilation resolution precedence.")                      

                // These are search paths for compile-like resolution. GAC searching is not present.

                ["{TargetFrameworkDirectory}"] @

                rawFileNamePath @        // Quick-resolve straight to filename first

                explicitIncludeDirs @    // From -I, #I

                [implicitIncludeDir] @   // Usually the project directory

                [fsharpBinariesDir] @    // Location of fsc.exe

                [sprintf "{Registry:%s,%s,%s%s}" frameworkRegistryBase targetFrameworkVersion assemblyFoldersSuffix assemblyFoldersConditions] @ // Like {Registry:Software\Microsoft\.NETFramework,v2.0,AssemblyFoldersEx}

                ["{AssemblyFolders}"] @

                [outputDirectory]                    

    

        rar.SearchPaths <- searchPaths |> Array.ofList

                                  

        rar.AllowedAssemblyExtensions <- [| ".exe"; ".dll" |]     

        

        let succeeded = rar.Execute()

        

        // Unroll any foregrounded messages

        match !backgroundException with

        | Some(backGroundException) ->

            logwarning "" "Saw error on logger thread during resolution."

            logwarning "" (sprintf "%A" backGroundException)

            logwarning "" "Showing messages seen after exception."



            !foregrounded

            |> List.iter(fun message-> 

               match message with 

               | ForegroundedMessage(message) -> logmessage message

               | ForegroundedWarning(code,message) -> logwarning code message

               | ForegroundedError(code,message) -> logerror code message )

        | None -> ()            



        if not succeeded then 

            raise ResolutionFailure



        {

            resolvedFiles = [| for p in rar.ResolvedFiles -> {itemSpec = p.ItemSpec; 

                                                              resolvedFrom = DecodeResolvedFrom(p.GetMetadata("ResolvedFrom"));

                                                              fusionName = p.GetMetadata("FusionName"); 

                                                              version = p.GetMetadata("Version"); 

                                                              redist = p.GetMetadata("Redist"); 

                                                              baggage = p.GetMetadata("Baggage") } |]

            referenceDependencyPaths = [| for p in rar.ResolvedDependencyFiles -> p.ItemSpec |]

            relatedPaths = [| for p in rar.RelatedFiles -> p.ItemSpec |]

            referenceSatellitePaths = [| for p in rar.SatelliteFiles -> p.ItemSpec |]

            referenceScatterPaths = [| for p in rar.ScatterFiles -> p.ItemSpec |]

            referenceCopyLocalPaths = [| for p in rar.CopyLocalFiles -> p.ItemSpec |]

            suggestedBindingRedirects = [| for p in rar.SuggestedRedirects -> p.ItemSpec |]

        }



    let Resolve(

                resolutionEnvironment: ResolutionEnvironment,

                references:(string*(*baggage*)string)[], 

                targetFrameworkVersion:string, 

                targetFrameworkDirectories:string list,

                targetProcessorArchitecture:string,                

                outputDirectory:string, 

                fsharpBinariesDir:string,

                explicitIncludeDirs:string list,

                implicitIncludeDir:string,

                frameworkRegistryBase:string, 

                assemblyFoldersSuffix:string, 

                assemblyFoldersConditions:string, 

                logmessage:string->unit, 

                logwarning:ErrorWarningCallbackSig, 

                logerror:ErrorWarningCallbackSig ) =

        // The {RawFileName} target is 'dangerous', in the sense that is uses Directory.GetCurrentDirectory() to resolve unrooted file paths.

        // It is unreliable to use this mutable global state inside Visual Studio.  As a result, we partition all references into a "rooted" set

        // (which contains e.g. C:\MyDir\MyAssem.dll) and "unrooted" (everything else).  We only allow "rooted" to use {RawFileName}.  Note that

        // unrooted may still find 'local' assemblies by virtue of the fact that "implicitIncludeDir" is one of the places searched during 

        // assembly resolution.

        let references = references |> Array.map (fun ((file,baggage) as data) -> 

            // However, MSBuild will not resolve 'relative' paths, even when e.g. implicitIncludeDir is part of the search.  As a result,

            // if we have an unrooted path+filename, we'll assume this is relative to the project directory and root it.

            if System.IO.Path.IsPathRooted(file) then

                data  // fine, e.g. "C:\Dir\foo.dll"

            elif not(file.Contains("\\") || file.Contains("/")) then

                data  // fine, e.g. "System.Transactions.dll"

            else

                // we have a 'relative path', e.g. "bin/Debug/foo.exe" or "..\Yadda\bar.dll"

                // turn it into an absolute path based at implicitIncludeDir

                (System.IO.Path.Combine(implicitIncludeDir, file), baggage)

        )

        let rooted, unrooted = references |> Array.partition (fun (file,_baggage) -> System.IO.Path.IsPathRooted(file))



        let CallResolveCore(references, allowRawFileName) =    

            if Array.isEmpty references then 

                {

                    resolvedFiles = [| |]

                    referenceDependencyPaths = [| |]

                    relatedPaths = [| |]

                    referenceSatellitePaths = [| |]

                    referenceScatterPaths = [| |]

                    referenceCopyLocalPaths = [| |]

                    suggestedBindingRedirects = [| |]

                }

            else

                // all the params are the same...

                ResolveCore(

                    resolutionEnvironment,

                    references, // ... except this

                    targetFrameworkVersion, 

                    targetFrameworkDirectories,

                    targetProcessorArchitecture,                

                    outputDirectory, 

                    fsharpBinariesDir,

                    explicitIncludeDirs,

                    implicitIncludeDir,

                    frameworkRegistryBase, 

                    assemblyFoldersSuffix, 

                    assemblyFoldersConditions, 

                    allowRawFileName, // ... and this

                    logmessage, 

                    logwarning, 

                    logerror)



        let rootedResults = CallResolveCore(rooted, true)

        let unrootedResults = CallResolveCore(unrooted, false)

        // now unify the two sets of results

        {

            resolvedFiles = Array.concat [| rootedResults.resolvedFiles; unrootedResults.resolvedFiles |]

            referenceDependencyPaths = set rootedResults.referenceDependencyPaths |> Set.union (set unrootedResults.referenceDependencyPaths) |> Set.toArray 

            relatedPaths = set rootedResults.relatedPaths |> Set.union (set unrootedResults.relatedPaths) |> Set.toArray 

            referenceSatellitePaths = set rootedResults.referenceSatellitePaths |> Set.union (set unrootedResults.referenceSatellitePaths) |> Set.toArray 

            referenceScatterPaths = set rootedResults.referenceScatterPaths |> Set.union (set unrootedResults.referenceScatterPaths) |> Set.toArray 

            referenceCopyLocalPaths = set rootedResults.referenceCopyLocalPaths |> Set.union (set unrootedResults.referenceCopyLocalPaths) |> Set.toArray 

            suggestedBindingRedirects = set rootedResults.suggestedBindingRedirects |> Set.union (set unrootedResults.suggestedBindingRedirects) |> Set.toArray 

        }