Repository navigation
Expand file tree
/
Copy pathDesignTimeCache.fs
More file actions
150 lines (127 loc) · 5.89 KB
/
Copy pathDesignTimeCache.fs
File metadata and controls
150 lines (127 loc) · 5.89 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
/// The MIT License (MIT)
/// Copyright (c) 2016 Bazinga Technologies Inc
namespace FSharp.Data.GraphQL
open System
open System.Collections.Concurrent
open System.Collections.Generic
open System.Timers
open FSharp.Data.GraphQL.Client
open ProviderImplementation.ProvidedTypes
open FSharp.Data.GraphQL.Validation
// Cache implementation based on http://www.fssnip.net/7UT/title/Threadsafe-Generic-MemoryCache-and-Memoize-Function
type internal CacheExpirationPolicy =
| NoExpiration
| AbsoluteExpiration of TimeSpan
| SlidingExpiration of TimeSpan
type internal CacheEntryExpiration =
| NeverExpires
| ExpiresAt of DateTime
| ExpiresAfter of TimeSpan
type internal CacheEntry<'key, 'value> =
{ Key: 'key
Value: 'value
Expiration: CacheEntryExpiration
LastUsage: DateTime }
module internal CacheExpiration =
let isExpired (entry: CacheEntry<_,_>) =
match entry.Expiration with
| NeverExpires -> false
| ExpiresAt date -> DateTime.UtcNow > date
| ExpiresAfter window -> (DateTime.UtcNow - entry.LastUsage) > window
type internal IMemoryCacheStore<'key, 'value> =
inherit IEnumerable<CacheEntry<'key, 'value>>
abstract member Add: CacheEntry<'key, 'value> -> unit
abstract member GetOrAdd: 'key -> ('key -> CacheEntry<'key, 'value>) -> CacheEntry<'key, 'value>
abstract member Remove: 'key -> unit
abstract member Contains: 'key -> bool
abstract member Update: 'key -> (CacheEntry<'key, 'value> -> CacheEntry<'key, 'value>) -> unit
abstract member TryFind: 'key -> CacheEntry<'key, 'value> option
type internal MemoryCache<'key, 'value> (?cacheExpirationPolicy) =
let policy = defaultArg cacheExpirationPolicy NoExpiration
let store =
let entries = ConcurrentDictionary<'key, CacheEntry<'key, 'value>>()
let get, getEnumerator =
let values = entries |> Seq.map (fun kvp -> kvp.Value)
(fun () -> values), (fun () -> values.GetEnumerator())
{ new IMemoryCacheStore<'key, 'value> with
member __.Add entry = entries.AddOrUpdate(entry.Key, entry, fun _ _ -> entry) |> ignore
member __.GetOrAdd key getValue = entries.GetOrAdd(key, getValue)
member __.Remove key = entries.TryRemove key |> ignore
member __.Contains key = entries.ContainsKey key
member __.Update key update =
match entries.TryGetValue(key) with
| (true, entry) -> entries.AddOrUpdate(key, entry, fun _ entry -> update entry) |> ignore
| _ -> ()
member __.TryFind key =
match entries.TryGetValue(key) with
| (true, entry) -> Some entry
| _ -> None
member __.GetEnumerator () = getEnumerator ()
member __.GetEnumerator () = getEnumerator () :> Collections.IEnumerator }
let checkExpiration () =
store
|> Seq.choose (fun entry -> if CacheExpiration.isExpired entry then Some entry.Key else None)
|> Seq.iter store.Remove
let newCacheEntry key value =
{ Key = key
Value = value
Expiration = match policy with
| NoExpiration -> NeverExpires
| AbsoluteExpiration time -> ExpiresAt (DateTime.UtcNow + time)
| SlidingExpiration window -> ExpiresAfter window
LastUsage = DateTime.UtcNow }
let add key value =
if key |> store.Contains
then store.Update key (fun entry -> {entry with Value = value; LastUsage = DateTime.UtcNow})
else store.Add <| newCacheEntry key value
let remove key =
store.Remove key
let get key =
store.TryFind key |> Option.bind (fun entry -> Some entry.Value)
let getOrAdd key value =
store.GetOrAdd key (fun _ -> newCacheEntry key value)
|> fun entry -> entry.Value
let getOrAddResult key f =
store.GetOrAdd key (fun _ -> newCacheEntry key <| f())
|> fun entry -> entry.Value
let getTimer (expiration: TimeSpan) =
if expiration.TotalSeconds < 1.0
then TimeSpan.FromMilliseconds 100.0
elif expiration.TotalMinutes < 1.0
then TimeSpan.FromSeconds 1.0
else TimeSpan.FromMinutes 1.0
|> fun interval -> new Timer(interval.TotalMilliseconds)
let timer =
match policy with
| NoExpiration -> None
| AbsoluteExpiration time -> time |> getTimer |> Some
| SlidingExpiration time -> time |> getTimer |> Some
let _observer =
match timer with
| Some t ->
let disposable = t.Elapsed |> Observable.subscribe (fun _ -> checkExpiration())
t.Start()
Some disposable
| None -> None
member __.Add key value = add key value
member __.Remove key = remove key
member __.Get key = get key
member __.GetOrAdd key value = getOrAdd key value
member __.GetOrAddResult key f = getOrAddResult key f
type internal ProviderKey =
{ IntrospectionLocation : IntrospectionLocation
CustomHttpHeadersLocation : StringLocation
UploadInputTypeName : string option
ResolutionFolder : string
ClientQueryValidation: bool }
module internal ProviderDesignTimeCache =
let private expiration = CacheExpirationPolicy.SlidingExpiration(TimeSpan.FromSeconds 30.0)
let private cache = MemoryCache<ProviderKey, ProvidedTypeDefinition>(expiration)
let getOrAdd (key : ProviderKey) (defMaker : unit -> ProvidedTypeDefinition) =
cache.GetOrAddResult key defMaker
module internal QueryValidationDesignTimeCache =
let private expiration = CacheExpirationPolicy.SlidingExpiration(TimeSpan.FromSeconds 30.0)
let private cache = MemoryCache<string, Ast.ValidationResult>(expiration)
let getOrAdd (query : string) (validationResultMaker : unit -> Ast.ValidationResult) =
let key = query.MD5Hash()
cache.GetOrAddResult key validationResultMaker