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

Memoize to reduce web requests to external sites like GitHub. #1101

Merged
merged 2 commits into from
Oct 1, 2015
Merged

Memoize to reduce web requests to external sites like GitHub. #1101

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
6d50e1a
Memoization cache to reduce web requests to external sites like GitHu…
Thorium Sep 30, 2015
29fa857
Merge branch 'master' of https://github.com/fsprojects/Paket
Thorium Sep 30, 2015
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
50 changes: 34 additions & 16 deletions src/Paket.Core/Utils.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -196,6 +196,12 @@ let inline createWebClient(url,auth:Auth option) =
client.Proxy <- getDefaultProxyFor url
client

//More generic variant of http://www.fssnip.net/c4
open System.Collections.Concurrent
let cache = ConcurrentDictionary<(string * obj) option,Lazy<obj>>()
let memoizeConcurrent (caller:string) (f: ('a -> 'b)) =
fun (x :'a) ->
(cache.GetOrAdd(Some (caller, x|>box), lazy ((f x)|>box)).Force() |> unbox) : 'b
Copy link
Member

Choose a reason for hiding this comment

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

why the lazy ((f x) |> box)).Force()?
why not (f x) |> box)?

Why is the key (string * obj) option and not just (string * obj)?

Copy link
Member

Choose a reason for hiding this comment

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

are you sure it's really caching?


#nowarn "40"

Expand All @@ -206,10 +212,14 @@ open System.Threading
let downloadFromUrl (auth:Auth option, url : string) (filePath: string) =
async {
try
use client = createWebClient(url,auth)

let task = client.DownloadFileTaskAsync(Uri(url), filePath) |> Async.AwaitTask
let memoized =
memoizeConcurrent "downloadFromUrl" (fun (a, u) p ->
use client = createWebClient(u,a)
client.DownloadFileTaskAsync(Uri(u), p) |> Async.AwaitTask
)
let task = memoized (auth,url) filePath
do! task

with
| exn ->
failwithf "Could not download from %s%s Message: %s" url Environment.NewLine exn.Message
Expand All @@ -219,10 +229,13 @@ let downloadFromUrl (auth:Auth option, url : string) (filePath: string) =
let getFromUrl (auth:Auth option, url : string, contentType : string) =
async {
try
use client = createWebClient(url,auth)
if notNullOrEmpty contentType then
client.Headers.Add(HttpRequestHeader.Accept, contentType)
let s = client.DownloadStringTaskAsync(Uri(url)) |> Async.AwaitTask
let memoized = memoizeConcurrent "getFromUrl" (fun (a, u, c) ->
use client = createWebClient(u,a)
if notNullOrEmpty c then
client.Headers.Add(HttpRequestHeader.Accept, c)
client.DownloadStringTaskAsync(Uri(u)) |> Async.AwaitTask
)
let s = memoized(auth, url, contentType)
return! s
with
| exn ->
Expand All @@ -233,16 +246,19 @@ let getFromUrl (auth:Auth option, url : string, contentType : string) =
let getXmlFromUrl (auth:Auth option, url : string) =
async {
try
use client = createWebClient(url,auth)
let memoized = memoizeConcurrent "getXmlFromUrl" (fun (a,u) ->
use client = createWebClient(u,a)

// mimic the headers sent from nuget client to odata/ endpoints
client.Headers.Add(HttpRequestHeader.Accept, "application/atom+xml, application/xml")
client.Headers.Add(HttpRequestHeader.AcceptCharset, "UTF-8")
client.Headers.Add("DataServiceVersion", "1.0;NetFx")
client.Headers.Add("MaxDataServiceVersion", "2.0;NetFx")

let s = client.DownloadStringTaskAsync(Uri(url)) |> Async.AwaitTask
return! s
client.DownloadStringTaskAsync(Uri(u)) |> Async.AwaitTask
)
let s = memoized(auth, url)
return! s
with
| exn ->
failwithf "Could not retrieve data from %s%s Message: %s" url Environment.NewLine exn.Message
Expand All @@ -253,14 +269,16 @@ let getXmlFromUrl (auth:Auth option, url : string) =
let safeGetFromUrl (auth:Auth option, url : string, contentType : string) =
async {
try
use client = createWebClient(url,auth)
let memoized = memoizeConcurrent "safeGetFromUrl" (fun (a,u,c) ->
use client = createWebClient(u,a)

if notNullOrEmpty contentType then
client.Headers.Add(HttpRequestHeader.Accept, contentType)
if notNullOrEmpty c then
client.Headers.Add(HttpRequestHeader.Accept, c)

let s = client.DownloadStringTaskAsync(Uri(url)) |> Async.AwaitTask
let! raw = s
return Some raw
client.DownloadStringTaskAsync(Uri(u)) |> Async.AwaitTask
)
let! raw = memoized(auth, url, contentType)
return Some raw
with _ -> return None
}

Expand Down