Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Various optimizations #1599

Merged
merged 2 commits into from
Apr 12, 2016
Merged

Various optimizations #1599

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
6048977
various optimizations
Apr 12, 2016
2a38ce3
fix a typo in function name
Apr 12, 2016
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 2 additions & 6 deletions src/Paket.Core/InstallModel.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -131,9 +131,9 @@ module InstallModel =
TargetsFileFolders = []
Analyzers = [] }

let extractLibFolder path = Utils.extractPath "lib" path
let extractLibFolder path = Utils.extractPath ("lib", path)

let extractBuildFolder path = Utils.extractPath "build" path
let extractBuildFolder path = Utils.extractPath ("build", path)

let mapFolders mapfn (installModel:InstallModel) =
{ installModel with
Expand Down Expand Up @@ -183,12 +183,10 @@ module InstallModel =
else
this


let calcLibFolders libs =
libs
|> Seq.choose extractLibFolder
|> Seq.distinct
|> List.ofSeq
|> PlatformMatching.getSupportedTargetProfiles
|> Seq.map (fun entry -> { Name = entry.Key; Targets = List.ofSeq entry.Value; Files = InstallFiles.empty })
|> Seq.toList
Expand Down Expand Up @@ -286,8 +284,6 @@ module InstallModel =
| Reference.Library lib -> lib.EndsWith ".resources.dll"
| _ -> false

let blacklisted (blacklist:string list) (file:string) = blacklist |> List.exists (String.endsWithIgnoreCase file )

let blackList =
[ includeReferences
excludeSatelliteAssemblies]
Expand Down
60 changes: 40 additions & 20 deletions src/Paket.Core/InstallProcess.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,12 +9,10 @@ open Paket.BindingRedirects
open Paket.ModuleResolver
open Paket.PackageResolver
open System.IO
open FSharp.Polyfill
open System.Reflection
open Paket.PackagesConfigFile
open Paket.Requirements
open System.Collections.Generic
open System.Collections.Concurrent

let updatePackagesConfigFile (model: Map<GroupName*PackageName,SemVerInfo*InstallSettings>) packagesConfigFileName =
let packagesInConfigFile = PackagesConfigFile.Read packagesConfigFileName
Expand All @@ -23,7 +21,6 @@ let updatePackagesConfigFile (model: Map<GroupName*PackageName,SemVerInfo*Instal
model
|> Seq.filter (fun kv -> defaultArg (snd kv.Value).IncludeVersionInPath false)
|> Seq.map (fun kv ->
let settings,version = kv.Value
{ Id = (snd kv.Key).ToString()
Version = fst kv.Value
TargetFramework = None })
Expand Down Expand Up @@ -183,25 +180,36 @@ module private LoadAssembliesSafe =
loadedLibs.[key] <- v
v

let inline private getOrAdd (key: 'key) (getValue: 'key -> 'value) (d: Dictionary<'key, 'value>) : 'value =
let value: 'value ref = ref Unchecked.defaultof<_>
if d.TryGetValue(key, value) then !value
else
let value = getValue key
d.[key] <- value
value

/// Applies binding redirects for all strong-named references to all app. and web.config files.
let private applyBindingRedirects isFirstGroup createNewBindingFiles cleanBindingRedirects redirects root groupName findDependencies allKnownLibs extractedPackages =
let dependencyGraph = ConcurrentDictionary<_,Set<_>>()
let projects = ConcurrentDictionary<_,ProjectFile option>();
let referenceFiles = ConcurrentDictionary<_,ReferencesFile option>();
let private applyBindingRedirects isFirstGroup createNewBindingFiles cleanBindingRedirects redirects
root groupName findDependencies allKnownLibs
(projectCache: Dictionary<string, ProjectFile option>)
extractedPackages =

let dependencyGraph = Dictionary<_,Set<_>>()
let referenceFiles = Dictionary<_,ReferencesFile option>()

let referenceFile (projectFile : ProjectFile) =
let referenceFile (projectFile : ProjectFile) =
ProjectFile.FindReferencesFile (FileInfo projectFile.FileName)
|> Option.map ReferencesFile.FromFile
referenceFiles.GetOrAdd(projectFile, referenceFile)
referenceFiles |> getOrAdd projectFile referenceFile

let rec dependencies (projectFile : ProjectFile) =
match referenceFile projectFile with
| Some referenceFile ->
projectFile.GetInterProjectDependencies()
|> Seq.map (fun r -> projects.GetOrAdd(r.Path, ProjectFile.TryLoad))
|> Seq.map (fun r -> projectCache |> getOrAdd r.Path ProjectFile.TryLoad)
|> Seq.choose id
|> Seq.collect (fun p -> dependencyGraph.GetOrAdd(p, dependencies))
|> Seq.collect (fun p -> dependencyGraph |> getOrAdd p dependencies)
|> Seq.append (
referenceFile.Groups
|> Seq.filter (fun g -> g.Key = groupName)
Expand All @@ -212,7 +220,7 @@ let private applyBindingRedirects isFirstGroup createNewBindingFiles cleanBindin

let bindingRedirects (projectFile : ProjectFile) =
let referenceFile = referenceFile projectFile
let dependencies = dependencyGraph.GetOrAdd(projectFile, dependencies)
let dependencies = dependencyGraph |> getOrAdd projectFile dependencies
let redirectsFromReference packageName =
referenceFile
|> Option.bind (fun r ->
Expand All @@ -222,21 +230,21 @@ let private applyBindingRedirects isFirstGroup createNewBindingFiles cleanBindin
|> Seq.tryFind (fun p -> p.Name = packageName)
|> Option.bind (fun p -> p.Settings.CreateBindingRedirects))

let targetProfile = projectFile.GetTargetProfile()

let assemblies =
extractedPackages
|> Seq.map (fun (model,redirects) -> (model, redirectsFromReference model.PackageName |> Option.fold (fun _ x -> Some x) redirects))
|> Seq.filter (fun (model,_) -> dependencies |> Set.contains model.PackageName)
|> Seq.collect (fun (model,redirects) -> model.GetLibReferences(projectFile.GetTargetProfile()) |> Seq.map (fun lib -> lib,redirects))
|> Seq.collect (fun (model,redirects) -> model.GetLibReferences targetProfile |> Seq.map (fun lib -> lib,redirects))
|> Seq.groupBy (fun (p,_) -> FileInfo(p).Name)
|> Seq.choose(fun (_,librariesForPackage) ->
librariesForPackage
|> Seq.choose(fun (library,redirects) ->
try
let key = FileInfo(library).FullName.ToLowerInvariant()
let assembly = LoadAssembliesSafe.reflectionOnlyLoadFrom library

Some (assembly, BindingRedirects.getPublicKeyToken assembly, assembly.GetReferencedAssemblies(), redirects)
with exn -> None)
with _ -> None)
|> Seq.sortBy(fun (assembly,_,_,_) -> assembly.GetName().Version)
|> Seq.toList
|> List.rev
Expand All @@ -246,12 +254,13 @@ let private applyBindingRedirects isFirstGroup createNewBindingFiles cleanBindin
assemblies
|> Seq.choose (fun (assembly,token,refs,redirects) -> token |> Option.map (fun token -> (assembly,token,refs,redirects)))
|> Seq.filter (fun (_,_,_,packageRedirects) -> defaultArg ((packageRedirects |> Option.map ((<>) Off)) ++ redirects) false)
|> Seq.filter (fun (assembly,_,refs,redirects) ->
|> Seq.filter (fun (assembly,_,_,redirects) ->
let assemblyName = assembly.GetName()
redirects = Some Force
|| assemblies
|> Seq.collect (fun (_,_,refs,_) -> refs)
|> Seq.filter (fun a -> assembly.GetName().Name = a.Name)
|> Seq.exists (fun a -> assembly.GetName().Version > a.Version))
|> Seq.filter (fun a -> assemblyName.Name = a.Name)
|> Seq.exists (fun a -> assemblyName.Version > a.Version))
|> Seq.map(fun (assembly, token,_,_) ->
{ BindingRedirect.AssemblyName = assembly.GetName().Name
Version = assembly.GetName().Version.ToString()
Expand Down Expand Up @@ -296,6 +305,7 @@ let InstallIntoProjects(options : InstallerOptions, forceTouch, dependenciesFile
let root = Path.GetDirectoryName lockFile.FileName
let model = CreateModel(root, options.Force, dependenciesFile, lockFile, Set.ofSeq packagesToInstall) |> Map.ofArray
let lookup = lockFile.GetDependencyLookupTable()
let projectCache = Dictionary<string, ProjectFile option>();

for project, referenceFile in projectsAndReferences do
verbosefn "Installing to %s" project.FileName
Expand Down Expand Up @@ -352,7 +362,7 @@ let InstallIntoProjects(options : InstallerOptions, forceTouch, dependenciesFile
let usedPackages =
let dict = System.Collections.Generic.Dictionary<_,_>()
usedPackages
|> Map.filter (fun (groupName,packageName) (v,_) ->
|> Map.filter (fun (_groupName,packageName) (v,_) ->
match dict.TryGetValue packageName with
| true,v' ->
if v' = v then false else
Expand Down Expand Up @@ -416,6 +426,7 @@ let InstallIntoProjects(options : InstallerOptions, forceTouch, dependenciesFile

processContentFiles root project usedPackages gitRemoteItems options
project.Save forceTouch
projectCache.[project.FileName] <- Some project

let first = ref true

Expand All @@ -441,7 +452,16 @@ let InstallIntoProjects(options : InstallerOptions, forceTouch, dependenciesFile
|> Option.bind (fun p -> p.Settings.CreateBindingRedirects)

(snd kv.Value,packageRedirects))
|> applyBindingRedirects !first options.CreateNewBindingFiles options.Hard (g.Value.Options.Redirects ++ redirects) (FileInfo project.FileName).Directory.FullName g.Key lockFile.GetAllDependenciesOf allKnownLibs
|> applyBindingRedirects
!first
options.CreateNewBindingFiles
options.Hard
(g.Value.Options.Redirects ++ redirects)
(FileInfo project.FileName).Directory.FullName
g.Key
lockFile.GetAllDependenciesOf
allKnownLibs
projectCache
first := false


Expand Down
15 changes: 8 additions & 7 deletions src/Paket.Core/PlatformMatching.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -96,21 +96,22 @@ let rec findBestMatch (paths : #seq<string>) (targetProfile : TargetProfile) =
// Fallback Portable Library
KnownTargetProfiles.AllProfiles
|> Seq.choose (fun p ->
if p.ProfilesCompatibleWithPortableProfile
|> Seq.map SinglePlatform
|> Seq.exists ((=)targetProfile)
then findBestMatch paths p
else None
match targetProfile with
| SinglePlatform x ->
if p.ProfilesCompatibleWithPortableProfile |> Seq.exists ((=) x)
then findBestMatch paths p
else None
| _ -> None
)
|> Seq.sortBy (fun x -> (extractPlatforms x).Length) // prefer portable platform whith less platforms
|> Seq.tryFind (fun _ -> true)
|> Seq.tryHead
| path -> path

let private matchedCache = System.Collections.Concurrent.ConcurrentDictionary<_,_>()

// For a given list of paths and target profiles return tuples of paths with their supported target profiles.
// Every target profile will only be listed for own path - the one that best supports it.
let getSupportedTargetProfiles (paths : string list) =
let getSupportedTargetProfiles (paths : string seq) =
let key = paths
match matchedCache.TryGetValue key with
| true, supportedFrameworks -> supportedFrameworks
Expand Down
67 changes: 39 additions & 28 deletions src/Paket.Core/Utils.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,17 @@ let notNullOrEmpty = not << System.String.IsNullOrEmpty

let inline force (lz: 'a Lazy) = lz.Force()
let inline endsWith text x = (^a:(member EndsWith:string->bool)x, text)
let inline toLower str = (^a:(member ToLower:unit->string)str)
let inline toLower str = (^a:(member ToLower:unit->string)str)

let memoze (f: 'a -> 'b) : 'a -> 'b =
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Should this be named memoize?

let cache = System.Collections.Concurrent.ConcurrentDictionary<'a, 'b>()
fun (x: 'a) ->
let value : 'b ref = ref Unchecked.defaultof<_>
if cache.TryGetValue(x, value) then !value
else
let value = f x
cache.[x] <- value
value

type Auth =
| Credentials of Username : string * Password : string
Expand Down Expand Up @@ -132,25 +142,26 @@ let getNative (path:string) =
if path.Contains "/address-model-64" then "/address-model-64" else
""

let extractPath infix (fileName : string) : string option =
let path = fileName.Replace("\\", "/").ToLower()
let path = if path.StartsWith "lib/" then "/" + path else path
let fi = FileInfo path

let packagesPos = path.LastIndexOf "packages/"
let startPos =
if packagesPos >= 0 then
path.IndexOf(sprintf "/%s/" infix,packagesPos) + 1
let extractPath =
memoze <| fun (infix, fileName : string) ->
let path = fileName.Replace("\\", "/").ToLower()
let path = if path.StartsWith "lib/" then "/" + path else path
let fi = FileInfo path

let packagesPos = path.LastIndexOf "packages/"
let startPos =
if packagesPos >= 0 then
path.IndexOf(sprintf "/%s/" infix,packagesPos) + 1
else
path.LastIndexOf(sprintf "/%s/" infix) + 1

let endPos = path.IndexOf('/', startPos + infix.Length + 1)
if startPos < 0 then None
elif endPos < 0 then Some("")
else
path.LastIndexOf(sprintf "/%s/" infix) + 1

let endPos = path.IndexOf('/', startPos + infix.Length + 1)
if startPos < 0 then None
elif endPos < 0 then Some("")
else
let nativePart = getNative path
let libPart = path.Substring(startPos + infix.Length + 1, endPos - startPos - infix.Length - 1)
Some (libPart + nativePart)
let nativePart = getNative path
let libPart = path.Substring(startPos + infix.Length + 1, endPos - startPos - infix.Length - 1)
Some (libPart + nativePart)

/// [omit]
let inline normalizeXml (doc:XmlDocument) =
Expand Down Expand Up @@ -403,7 +414,7 @@ let RunInLockedAccessMode(rootFolder,action) =
releaseLock()
result
with
| exn ->
| _ ->
releaseLock()
reraise()

Expand Down Expand Up @@ -512,7 +523,7 @@ module ObservableExtensions =
type Microsoft.FSharp.Control.Async with
static member AwaitObservable(ev1:IObservable<'a>) =
synchronize (fun f ->
Async.FromContinuations((fun (cont,econt,ccont) ->
Async.FromContinuations((fun (cont,_econt,_ccont) ->
let rec callback = (fun value ->
remover.Dispose()
f cont value )
Expand All @@ -528,7 +539,7 @@ module ObservableExtensions =
/// operation after 'let!' attaches handler)
let guard f (e:IObservable<'Args>) =
{ new IObservable<'Args> with
member x.Subscribe observer =
member __.Subscribe observer =
let rm = e.Subscribe observer in f(); rm }

let sample milliseconds source =
Expand All @@ -542,17 +553,17 @@ module ObservableExtensions =
loop ()

{ new IObservable<'T> with
member this.Subscribe(observer:IObserver<'T>) =
member __.Subscribe(observer:IObserver<'T>) =
let cts = new System.Threading.CancellationTokenSource()
Async.Start (relay observer, cts.Token)
{ new IDisposable with
member this.Dispose() = cts.Cancel()
member __.Dispose() = cts.Cancel()
}
}

let ofSeq s =
let evt = new Event<_>()
evt.Publish |> guard (fun o ->
evt.Publish |> guard (fun _ ->
for n in s do evt.Trigger(n))

let private oneAndDone (obs : IObserver<_>) value =
Expand Down Expand Up @@ -585,11 +596,11 @@ module ObservableExtensions =
let sub =
input.Subscribe
({ new IObserver<#seq<'a>> with
member x.OnNext values = values |> Seq.iter obs.OnNext
member x.OnCompleted() =
member __.OnNext values = values |> Seq.iter obs.OnNext
member __.OnCompleted() =
cts.Cancel()
obs.OnCompleted()
member x.OnError e =
member __.OnError e =
cts.Cancel()
obs.OnError e })

Expand Down