33
44namespace FSharp.Data.GraphQL
55
6- open FSharp. Data . GraphQL . Client
6+ open System
77open System.Collections .Concurrent
8+ open System.Collections .Generic
9+ open System.Timers
10+ open FSharp.Data .GraphQL .Client
811open ProviderImplementation.ProvidedTypes
912
13+ // see: cache implementation http://www.fssnip.net/7UT/title/Threadsafe-Generic-MemoryCache-and-Memoize-Function
14+
15+
16+ type CacheExpirationPolicy =
17+ | NoExpiration
18+ | AbsoluteExpiration of TimeSpan
19+ | SlidingExpiration of TimeSpan
20+
21+ type CacheEntryExpiration =
22+ | NeverExpires
23+ | ExpiresAt of DateTime
24+ | ExpiresAfter of TimeSpan
25+
26+ type CacheEntry < 'key , 'value > =
27+ { Key: 'key
28+ Value: 'value
29+ Expiration: CacheEntryExpiration
30+ LastUsage: DateTime }
31+
32+ module CacheExpiration =
33+ let isExpired ( entry : CacheEntry < _ , _ >) =
34+ match entry.Expiration with
35+ | NeverExpires -> false
36+ | ExpiresAt date -> DateTime.UtcNow > date
37+ | ExpiresAfter window -> ( DateTime.UtcNow - entry.LastUsage) > window
38+
39+ type private IMemoryCacheStore < 'key , 'value > =
40+ inherit IEnumerable< CacheEntry< 'key, 'value>>
41+ abstract member Add: CacheEntry < 'key , 'value > -> unit
42+ abstract member GetOrAdd: 'key -> ( 'key -> CacheEntry < 'key , 'value >) -> CacheEntry < 'key , 'value >
43+ abstract member Remove: 'key -> unit
44+ abstract member Contains: 'key -> bool
45+ abstract member Update: 'key -> ( CacheEntry < 'key , 'value > -> CacheEntry < 'key , 'value >) -> unit
46+ abstract member TryFind: 'key -> CacheEntry < 'key , 'value > option
47+
48+ type MemoryCache < 'key , 'value > (? cacheExpirationPolicy ) =
49+ let policy = defaultArg cacheExpirationPolicy NoExpiration
50+ let store =
51+ let entries = ConcurrentDictionary< 'key, CacheEntry< 'key, 'value>>()
52+ let get , getEnumerator =
53+ let values = entries |> Seq.map ( fun kvp -> kvp.Value)
54+ ( fun () -> ), ( fun () -> ())
55+ { new IMemoryCacheStore< 'key, 'value> with
56+ member __.Add entry = entries.AddOrUpdate( entry.Key, entry, fun _ _ -> entry) |> ignore
57+ member __.GetOrAdd key getValue = entries.GetOrAdd( key, getValue)
58+ member __.Remove key = entries.TryRemove key |> ignore
59+ member __.Contains key = entries.ContainsKey key
60+ member __.Update key update =
61+ match entries.TryGetValue( key) with
62+ | ( true , entry) -> entries.AddOrUpdate( key, entry, fun _ entry -> update entry) |> ignore
63+ | _ -> ()
64+ member __.TryFind key =
65+ match entries.TryGetValue( key) with
66+ | ( true , entry) -> Some entry
67+ | _ -> None
68+ member __.GetEnumerator () = getEnumerator ()
69+ member __.GetEnumerator () = getEnumerator () :> Collections .IEnumerator
70+ }
71+
72+ let checkExpiration () =
73+ store
74+ |> Seq.filter CacheExpiration.isExpired
75+ |> Seq.map ( fun entry -> entry.Key)
76+ |> Seq.iter store.Remove
77+
78+ let newCacheEntry key value =
79+ { Key = key
80+ Value = value
81+ Expiration = match policy with
82+ | NoExpiration -> NeverExpires
83+ | AbsoluteExpiration time -> ExpiresAt ( DateTime.UtcNow + time)
84+ | SlidingExpiration window -> ExpiresAfter window
85+ LastUsage = DateTime.UtcNow
86+ }
87+
88+ let add key value =
89+ if key |> store.Contains
90+ then store.Update key ( fun entry -> { entry with Value = value; LastUsage = DateTime.UtcNow})
91+ else store.Add <| newCacheEntry key value
92+
93+ let remove key =
94+ store.Remove key
95+
96+ let get key =
97+ store.TryFind key |> Option.bind ( fun entry -> Some entry.Value)
98+
99+ let getOrAdd key value =
100+ store.GetOrAdd key ( fun _ -> newCacheEntry key value)
101+ |> fun entry -> entry.Value
102+
103+ let getOrAddResult key f =
104+ store.GetOrAdd key ( fun _ -> newCacheEntry key <| f())
105+ |> fun entry -> entry.Value
106+
107+ let getTimer ( expiration : TimeSpan ) =
108+ if expiration.TotalSeconds < 1.0
109+ then TimeSpan.FromMilliseconds 100.0
110+ elif expiration.TotalMinutes < 1.0
111+ then TimeSpan.FromSeconds 1.0
112+ else TimeSpan.FromMinutes 1.0
113+ |> fun interval -> new Timer( interval.TotalMilliseconds)
114+
115+ let timer =
116+ match policy with
117+ | NoExpiration -> None
118+ | AbsoluteExpiration time -> time |> getTimer |> Some
119+ | SlidingExpiration time -> time |> getTimer |> Some
120+
121+ let observer =
122+ match timer with
123+ | Some t ->
124+ let disposable = t.Elapsed |> Observable.subscribe ( fun _ -> checkExpiration())
125+ t.Start()
126+ Some disposable
127+ | None -> None
128+
129+ member __.Add key value = add key value
130+ member __.Remove key = remove key
131+ member __.Get key = get key
132+ member __.GetOrAdd key value = getOrAdd key value
133+ member __.GetOrAddResult key f = getOrAddResult key f
134+
135+
10136type internal ProviderKey =
11137 { IntrospectionLocation : IntrospectionLocation
12138 CustomHttpHeadersLocation : StringLocation }
13139
14- type internal CacheInvalidator ( key : ProviderKey , invalidateFn : ProviderKey -> unit ) =
15- let lockObj = obj()
16- let mutable remainingTime = 30000
17- do
18- async {
19- while remainingTime > 0 do
20- do ! Async.Sleep( 1000 )
21- lock lockObj ( fun _ -> remainingTime <- remainingTime - 1000 )
22- invalidateFn key
23- } |> Async.Start
24- member __.Reset () = lock lockObj ( fun _ -> remainingTime <- 30000 )
25-
26140module internal DesignTimeCache =
27- let private cache = ConcurrentDictionary < ProviderKey , CacheInvalidator * ProvidedTypeDefinition >( )
28-
141+ let private expiration = CacheExpirationPolicy.SlidingExpiration ( TimeSpan.FromSeconds 30.0 )
142+ let private cache = MemoryCache < ProviderKey , ProvidedTypeDefinition >( expiration )
29143 let getOrAdd ( key : ProviderKey ) ( defMaker : unit -> ProvidedTypeDefinition ) =
30- if not ( cache.ContainsKey( key))
31- then
32- let def = defMaker()
33- let invalidateFn location = cache.TryRemove( location) |> ignore
34- let invalidator = CacheInvalidator( key, invalidateFn)
35- cache.TryAdd( key, ( invalidator, def)) |> ignore
36- def
37- else
38- let invalidator , def = cache.[ key]
39- invalidator.Reset()
40- def
144+ cache.GetOrAddResult key defMaker
0 commit comments