diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index 8d85c4abe..54382c394 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -1,9 +1,13 @@ +#### 3.0.0-beta2 - Unrelease +* Fixed memory leaks inside the the type provider design time components. +* Improved the performance of the type provider design time components. + #### 3.0.0-beta - April 04 2018 -* Drop PCL Profile 259, 7, 78 support in favour of netstandard2.0 -* Support [F# RFC FST-1003 loading into .NET Core-based F# tooling](https://github.com/fsharp/fslang-design/blob/master/tooling/FST-1003-loading-type-provider-design-time-components.md) +* Drop PCL Profile 259, 7, 78 support in favour of netstandard2.0. +* Support [F# RFC FST-1003 loading into .NET Core-based F# tooling](https://github.com/fsharp/fslang-design/blob/master/tooling/FST-1003-loading-type-provider-design-time-components.md). * Integer values for optional parameter for the `System.Text.Encoding` are only supported when the F# compiler is run using .NET Framework. By default, new-style .NET SDK project files run the F# compiler with .NET Core. - To force the use of an F# compiler running with .NET Framework see [this guide](https://github.com/Microsoft/visualfsharp/issues/3303) + To force the use of an F# compiler running with .NET Framework see [this guide](https://github.com/Microsoft/visualfsharp/issues/3303). #### 2.4.6 - March 25 2018 * Added `ContentTypeWithEncoding` helper to `HttpRequestHeaders`. diff --git a/src/CommonProviderImplementation/Helpers.fs b/src/CommonProviderImplementation/Helpers.fs index 5ed156b2f..8a245778a 100644 --- a/src/CommonProviderImplementation/Helpers.fs +++ b/src/CommonProviderImplementation/Helpers.fs @@ -7,7 +7,6 @@ namespace ProviderImplementation open System open System.Collections.Generic -open System.Collections.Concurrent open System.Reflection open System.Text open FSharp.Core.CompilerServices @@ -75,42 +74,61 @@ type DisposableTypeProviderForNamespaces(config, ?assemblyReplacementMap) as x = let disposeActions = ResizeArray() - static let idCount = ref 0 + static let mutable idCount = 0 - let id = !idCount - - do incr idCount + let id = idCount + let filesToWatch = Dictionary() + + do idCount <- idCount + 1 - do log (sprintf "Creating TypeProviderForNamespaces %O [%d]" x id) + let dispose typeNameOpt = + lock disposeActions <| fun () -> + for i = disposeActions.Count-1 downto 0 do + let disposeAction = disposeActions.[i] + let discard = disposeAction typeNameOpt + if discard then + disposeActions.RemoveAt(i) + + do + log (sprintf "Creating TypeProviderForNamespaces %O [%d]" x id) + x.Disposing.Add <| fun _ -> + using (logTime "DisposingEvent" (sprintf "%O [%d]" x id)) <| fun _ -> + dispose None + + member __.Id = id + + member __.SetFileToWatch(fullTypeName, path) = + lock filesToWatch <| fun () -> + filesToWatch.Add(fullTypeName, path) - let addDisposeAction action = lock disposeActions <| fun () -> disposeActions.Add action + member __.GetFileToWath(fullTypeName) = + lock filesToWatch <| fun () -> + match filesToWatch.TryGetValue(fullTypeName) with + | true, path -> Some path + | _ -> None + + member __.AddDisposeAction action = + lock disposeActions <| fun () -> disposeActions.Add action - let dispose typeName = lock disposeActions <| fun () -> - log (sprintf "Disposing %s in TypeProviderForNamespaces %O [%d]" typeName x id) - for dispose in disposeActions do + member __.InvalidateOneType typeName = + using (logTime "InvalidateOneType" (sprintf "%s in %O [%d]" typeName x id)) <| fun _ -> dispose (Some typeName) + log (sprintf "Calling invalidate for %O [%d]" x id) + base.Invalidate() - let disposeAll() = lock disposeActions <| fun () -> - log (sprintf "Disposing all types in TypeProviderForNamespaces %O [%d]" x id) - for dispose in disposeActions do - dispose None +#if LOGGING_ENABLED - do - x.Disposing.Add(fun _ -> disposeAll()) - - interface IDisposableTypeProvider with - member __.InvalidateOneType typeName = dispose typeName; ``base``.Invalidate() - member __.AddDisposeAction action = addDisposeAction action - member __.Id = id + override x.Finalize() = + log (sprintf "Finalize %O [%d]" x id) + +#endif // ---------------------------------------------------------------------------------------------- module internal ProviderHelpers = open System.IO - open FSharp.Reflection open FSharp.Data.Runtime.Caching - open FSharp.Data.Runtime.IO let unitsOfMeasureProvider = { new StructuralInference.IUnitsOfMeasureProvider with @@ -119,7 +137,7 @@ module internal ProviderHelpers = member x.Inverse(denominator): Type = ProvidedMeasureBuilder.Inverse(denominator) } let asyncMap (resultType:Type) (valueAsync:Expr>) (body:Expr<'T>->Expr) = - let (?) = ProviderImplementation.QuotationBuilder.(?) + let (?) = QuotationBuilder.(?) let convFunc = ReflectionHelpers.makeDelegate (Expr.Cast >> body) typeof<'T> let f = Var("f", convFunc.Type) let body = typeof?AsyncMap (typeof<'T>, resultType) (valueAsync, Expr.Var f) @@ -132,7 +150,7 @@ module internal ProviderHelpers = let private cacheDuration = TimeSpan.FromMinutes 30.0 let private invalidChars = [ for c in "\"|<>{}[]," -> c ] @ [ for i in 0..31 -> char i ] |> set - let private webUrisCache, _ = createInternetFileCache "DesignTimeURIs" cacheDuration + let private webUrisCache = createInternetFileCache "DesignTimeURIs" cacheDuration type private ParseTextResult<'T> = { TypedSamples : 'T [] @@ -154,7 +172,6 @@ module internal ProviderHelpers = /// Reads a sample parameter for a type provider, detecting if it is a uri and fetching it if needed /// Samples from the web are cached for 30 minutes /// Samples from the filesystem are read using shared read, so it works when the file is locked by Excel or similar tools, - /// and a filesystem watcher that calls the invalidate function whenever the file changes is setup /// /// Parameters: /// * sampleOrSampleUri - the text which can be a sample or an uri for a sample @@ -168,7 +185,7 @@ module internal ProviderHelpers = let private parseTextAtDesignTime sampleOrSampleUri parseFunc formatName (tp:DisposableTypeProviderForNamespaces) (cfg:TypeProviderConfig) encodingStr resolutionFolder optResource fullTypeName maxNumberOfRows = - using (logTime "Loading" sampleOrSampleUri) <| fun _ -> + using (logTime "LoadingSample" sampleOrSampleUri) <| fun _ -> let tryGetResource() = if String.IsNullOrWhiteSpace(optResource) @@ -208,9 +225,11 @@ module internal ProviderHelpers = ResolutionFolder = resolutionFolder } let readText() = - use reader = - asyncRead (Some ((tp :> IDisposableTypeProvider), fullTypeName)) resolver formatName encodingStr uri - |> Async.RunSynchronously + let reader, toWatch = asyncRead resolver formatName encodingStr uri + // Non need to register file watchers in fsc.exe and fsi.exe + if cfg.IsInvalidationSupported then + toWatch |> Option.iter (fun path -> tp.SetFileToWatch(fullTypeName, path)) + use reader = reader |> Async.RunSynchronously match maxNumberOfRows with | None -> reader.ReadToEnd() | Some max -> @@ -229,13 +248,9 @@ module internal ProviderHelpers = let sample, isWeb = if isWeb uri then - match webUrisCache.TryRetrieve uri.OriginalString with - | Some value -> value, true - | None -> - let value = readText() - webUrisCache.Set(uri.OriginalString, value) - value, true - else readText(), false + webUrisCache.GetOrAdd(uri.OriginalString, readText), true + else + readText(), false { TypedSamples = parseFunc (Path.GetExtension uri.OriginalString) sample SampleIsUri = true @@ -268,48 +283,67 @@ module internal ProviderHelpers = // the constructor from a text reader to an array of the representation CreateFromTextReaderForSampleList : Expr -> Expr } - type CacheValue = ProvidedTypeDefinition * (string * string * string * Version) - //let (|CacheValue|_|) (wr: WeakReference) = match wr.Target with null -> None | v -> Some (v :?> CacheValue) - //let CacheValue (pair: CacheValue) = System.WeakReference (box pair) - //let private providedTypesCache = Dictionary<_,WeakReference>() - - let (|CacheValue|_|) (x: CacheValue) = Some x - let CacheValue (pair: CacheValue) = pair - let private providedTypesCache = ConcurrentDictionary<_,CacheValue>() - - // Cache generated types temporarily during partial invalidation of a type provider. - let internal getOrCreateProvidedType (cfg: TypeProviderConfig) (tp:IDisposableTypeProvider) (fullTypeName:string) f = + let private providedTypesCache = createInMemoryCache (TimeSpan.FromSeconds 10.) + let private activeDisposeActions = HashSet<_>() + + // Cache generated types for a short time, since VS invokes the TP multiple tiems + // Also cache temporarily during partial invalidation since the invalidation of one TP always causes invalidation of all TPs + let internal getOrCreateProvidedType (cfg: TypeProviderConfig) (tp:DisposableTypeProviderForNamespaces) (fullTypeName:string) f = - // The fsc.exe and fsi.exe processes don't invalidate, so caching is not useful - if cfg.IsInvalidationSupported then - let key = fullTypeName - let fullKey = (fullTypeName, cfg.RuntimeAssembly, cfg.ResolutionFolder, cfg.SystemRuntimeAssemblyVersion) + using (logTime "GeneratingProvidedType" (sprintf "%s [%d]" fullTypeName tp.Id)) <| fun _ -> - match providedTypesCache.TryGetValue key with - | true, CacheValue (providedType, fullKey2) when fullKey = fullKey2 -> - log (sprintf "Reusing saved generation of type %s [%d]" fullTypeName tp.Id) + let fullKey = (fullTypeName, cfg.RuntimeAssembly, cfg.ResolutionFolder, cfg.SystemRuntimeAssemblyVersion) + + let setupDisposeAction providedType fileToWatch = + + if activeDisposeActions.Add(fullTypeName, tp.Id) then + + log "Setting up dispose action" + + let watcher = + match fileToWatch with + | Some file -> + let name = sprintf "%s [%d]" fullTypeName tp.Id + let invalidateAction() = tp.InvalidateOneType(fullTypeName) + Some (watchForChanges file (name, invalidateAction)) + | None -> None + + // On disposal of one of the types, remove that type from the cache, and add all others to the cache + tp.AddDisposeAction <| fun typeNameBeingDisposedOpt -> + + // might be called more than once for each watcher, but the Dispose action is a NOP the second time + watcher |> Option.iter (fun watcher -> watcher.Dispose()) + + match typeNameBeingDisposedOpt with + | Some typeNameBeingDisposed when fullTypeName = typeNameBeingDisposed -> + providedTypesCache.Remove(fullTypeName) + log (sprintf "Dropping dispose action for %s [%d]" fullTypeName tp.Id) + // for the case where a file used by two TPs, when the file changes + // there will be two invalidations: A and B + // when the dispose action is called with A, A is removed from the cache + // so we need to remove the dispose action so it will won't be added when disposed is called with B + true + | _ -> + log (sprintf "Caching %s [%d] for 10 seconds" fullTypeName tp.Id) + providedTypesCache.Set(fullTypeName, (providedType, fullKey, fileToWatch)) + // for the case where a file used by two TPs, when the file changes + // there will be two invalidations: A and B + // when the dispose action is called with A, B is added to the cache + // so we need to keep the dispose action around so it will be called with B and the cache is removed + false + + match providedTypesCache.TryRetrieve(fullTypeName) with + | Some (providedType, fullKey2, watchedFile) when fullKey = fullKey2 -> + log "Retrieved from cache" + setupDisposeAction providedType watchedFile providedType | _ -> let providedType = f() - - // On disposal of one of the types, temporarily save the type if we know for sure that a different type is being invalidated. - tp.AddDisposeAction <| fun typeNameBeingDisposedOpt -> - match typeNameBeingDisposedOpt with - | None -> () - | Some typeNameBeingDisposed -> - // Check if a different type is being invalidated - if fullTypeName = typeNameBeingDisposed then - providedTypesCache.TryRemove key |> ignore - else - log (sprintf "Saving generation of type %s for 10 seconds awaiting incremental recreation [%d]" fullTypeName tp.Id) - providedTypesCache.[key] <- CacheValue (providedType, fullKey) - // Remove the cache entry in 10 seconds - async { do! Async.Sleep (10000) - providedTypesCache.TryRemove(key) |> ignore } |> Async.StartImmediate + log "Caching for 10 seconds" + let fileToWatch = tp.GetFileToWath(fullTypeName) + providedTypesCache.Set(fullTypeName, (providedType, fullKey, fileToWatch)) + setupDisposeAction providedType fileToWatch providedType - else - f() - /// Creates all the constructors for a type provider: (Async)Parse, (Async)Load, (Async)GetSample(s), and default constructor /// * sampleOrSampleUri - the text which can be a sample or an uri for a sample @@ -327,6 +361,8 @@ module internal ProviderHelpers = (tp:DisposableTypeProviderForNamespaces) (cfg:TypeProviderConfig) encodingStr resolutionFolder optResource fullTypeName maxNumberOfRows = + getOrCreateProvidedType cfg tp fullTypeName <| fun () -> + let isRunningInFSI = cfg.IsHostedExecution let defaultResolutionFolder = cfg.ResolutionFolder @@ -336,7 +372,6 @@ module internal ProviderHelpers = else [| parseSingle extension value |] - getOrCreateProvidedType cfg tp fullTypeName <| fun () -> // Infer the schema from a specified uri or inline text let parseResult = parseTextAtDesignTime sampleOrSampleUri parse formatName tp cfg encodingStr resolutionFolder optResource fullTypeName maxNumberOfRows @@ -346,7 +381,7 @@ module internal ProviderHelpers = let resultType = spec.RepresentationType let resultTypeAsync = typedefof>.MakeGenericType(resultType) - using (logTime "TypeGeneration" sampleOrSampleUri) <| fun _ -> + using (logTime "CommonTypeGeneration" sampleOrSampleUri) <| fun _ -> [ // Generate static Parse method let args = [ ProvidedParameter("text", typeof) ] diff --git a/src/CommonRuntime/Caching.fs b/src/CommonRuntime/Caching.fs index ca7aa06f4..ff3dcfb27 100644 --- a/src/CommonRuntime/Caching.fs +++ b/src/CommonRuntime/Caching.fs @@ -7,29 +7,44 @@ open System.Diagnostics open System.IO open System.Security.Cryptography open System.Text +open FSharp.Data.Runtime.IO -/// Represents a cache (various implementations are available) -type ICache<'T> = - abstract TryRetrieve : string -> 'T option - abstract Set : string * 'T -> unit - -/// Creates a fake cache -let createNonCachingCache() = - { new ICache<'T> with - member __.Set(_, _) = () - member __.TryRetrieve(_) = None } +type ICache<'TKey, 'TValue> = + abstract TryRetrieve : key:'TKey -> 'TValue option + abstract Set : key:'TKey * value:'TValue -> unit + abstract GetOrAdd : key:'TKey * valueFactory:(unit -> 'TValue) -> 'TValue + abstract Remove : key:'TKey -> unit /// Creates a cache that uses in-memory collection -let createInMemoryCache expiration = - let dict = new ConcurrentDictionary<_, _>() - { new ICache<_> with - member __.Set(key, value) = - dict.[key] <- (value, DateTime.UtcNow) - member __.TryRetrieve(key) = - match dict.TryGetValue(key) with - | true, (value, timestamp) when DateTime.UtcNow - timestamp < expiration -> Some value - | _ -> None } - +let createInMemoryCache (expiration:TimeSpan) = + let dict = ConcurrentDictionary<'TKey_,'TValue*DateTime>() + let queueInvalidation key = + async { + do! Async.Sleep (int expiration.TotalMilliseconds) + match dict.TryGetValue(key) with + | true, (_, timestamp) when DateTime.UtcNow - timestamp >= expiration -> + match dict.TryRemove(key) with + | true, _ -> log (sprintf "Cache expired: %O" key) + | _ -> () + | _ -> () + } |> Async.Start + { new ICache<_,_> with + member __.Set(key, value) = + dict.[key] <- (value, DateTime.UtcNow) + queueInvalidation key + member __.GetOrAdd(key, valueFactory) = + dict.GetOrAdd(key, fun key -> + queueInvalidation key + valueFactory(), DateTime.UtcNow) |> fst + member __.TryRetrieve(key) = + match dict.TryGetValue(key) with + | true, (value, timestamp) when DateTime.UtcNow - timestamp < expiration -> Some value + | _ -> None + member __.Remove(key) = + match dict.TryRemove(key) with + | true, _ -> log (sprintf "Explicitly removed from cache: %O" key) + | _ -> () + } /// Get hash code of a string - used to determine cache file let private hashString (plainText:string) = @@ -65,8 +80,8 @@ let createInternetFileCache prefix expiration = Directory.CreateDirectory downloadCache |> ignore let cache = - { new ICache with - member x.TryRetrieve(key) = + { new ICache with + member __.TryRetrieve(key) = let cacheFile = cacheFile key try if File.Exists cacheFile && File.GetLastWriteTimeUtc cacheFile - DateTime.UtcNow < expiration then @@ -79,18 +94,38 @@ let createInternetFileCache prefix expiration = Debug.WriteLine("Caching: Failed to read file {0} with an exception: {1}", cacheFile, e.Message) None - member x.Set(key,value) = + member __.Set(key, value) = + let cacheFile = cacheFile key + try File.WriteAllText(cacheFile, value) + with e -> + Debug.WriteLine("Caching: Failed to write file {0} with an exception: {1}", cacheFile, e.Message) + + member x.GetOrAdd(key, valueFactory) = + match x.TryRetrieve key with + | Some value -> value + | None -> + let value = valueFactory() + x.Set(key, value) + value + + member __.Remove(key) = let cacheFile = cacheFile key - try File.WriteAllText(cacheFile,value) + try + File.Delete(cacheFile) with e -> - Debug.WriteLine("Caching: Failed to write file {0} with an exception: {1}", cacheFile, e.Message) } + Debug.WriteLine("Caching: Failed to delete file {0} with an exception: {1}", cacheFile, e.Message) + } - // Ensure that we can access the file system by writing sample thing to a cache - cache.Set("$$$test$$$", "empty") - if cache.TryRetrieve("$$$test$$$") <> Some "empty" then - createInMemoryCache expiration, null - else - cache, downloadCache + // Ensure that we can access the file system by writing a sample value to the cache + cache.Set("$$$test$$$", "dummyValue") + match cache.TryRetrieve("$$$test$$$") with + | Some "dummyValue" -> + cache.Remove("$$$test$$$") |> ignore + cache + | _ -> + // fallback to an in memory cache + createInMemoryCache expiration with e -> Debug.WriteLine("Caching: Fall back to memory cache, because of an exception: {0}", e.Message) - createInMemoryCache expiration, null + // fallback to an in memory cache + createInMemoryCache expiration diff --git a/src/CommonRuntime/IO.fs b/src/CommonRuntime/IO.fs index 66f037e72..6db8fe8cc 100644 --- a/src/CommonRuntime/IO.fs +++ b/src/CommonRuntime/IO.fs @@ -2,8 +2,8 @@ module FSharp.Data.Runtime.IO open System +open System.Collections.Generic open System.IO -open System.Net open System.Text open FSharp.Data @@ -58,6 +58,7 @@ type internal UriResolver = #if LOGGING_ENABLED let private logLock = obj() +let mutable private indentation = 0 let private appendToLogMultiple logFile lines = lock logLock <| fun () -> let path = __SOURCE_DIRECTORY__ + "/../../" + logFile @@ -71,7 +72,11 @@ let private appendToLog logFile line = appendToLogMultiple logFile [line] let internal log str = - "[" + DateTime.Now.TimeOfDay.ToString() + "] " + str +#if TIMESTAMPS_IN_LOG + "[" + DateTime.Now.TimeOfDay.ToString() + "] " + String(' ', indentation * 2) + str +#else + String(' ', indentation * 2) + str +#endif |> appendToLog "log.txt" let internal logWithStackTrace (str:string) = @@ -84,10 +89,12 @@ let internal logWithStackTrace (str:string) = str::stackTrace |> appendToLogMultiple "log.txt" open System.Diagnostics +open System.Threading let internal logTime category (instance:string) = - log (sprintf "Started %s %s" category instance) + log (sprintf "%s %s" category instance) + Interlocked.Increment &indentation |> ignore let s = Stopwatch() s.Start() @@ -95,7 +102,8 @@ let internal logTime category (instance:string) = { new IDisposable with member __.Dispose() = s.Stop() - log (sprintf "Ended %s %s" category instance) + Interlocked.Decrement &indentation |> ignore + log (sprintf "Finished %s [%dms]" category s.ElapsedMilliseconds) let instance = instance.Replace("\r", null).Replace("\n","\\n") sprintf "%s|%s|%d" category instance s.ElapsedMilliseconds |> appendToLog "log.csv" } @@ -109,95 +117,85 @@ let inline internal logTime (_:string) (_:string) = dummyDisposable #endif -type internal IDisposableTypeProvider = - abstract InvalidateOneType : string -> unit - abstract AddDisposeAction : (string option -> unit) -> unit - abstract Id : int - -// Use weak references to type provider instances that may get reactively invalidated. A file watcher alone -// shouldn't keep a type provider instance alive. -type private TypeProviderReference = WeakReference -let private (|TypeProviderReference|_|) (x:TypeProviderReference) = match x.Target with null -> None | x -> Some (x :?> IDisposableTypeProvider) -let private TypeProviderReference (x:IDisposableTypeProvider) = System.WeakReference x +type private FileWatcher(path) = -type private Watcher(uri:Uri) = + let subscriptions = Dictionary unit>() - let typeProviders = ResizeArray() - - let getLastWrite() = File.GetLastWriteTime uri.OriginalString - let lastWrite = ref (getLastWrite()) + let getLastWrite() = File.GetLastWriteTime path + let mutable lastWrite = getLastWrite() let watcher = - let path = Path.GetDirectoryName uri.OriginalString - let name = Path.GetFileName uri.OriginalString - new FileSystemWatcher(Filter = name, Path = path, EnableRaisingEvents = true) + new FileSystemWatcher( + Filter = Path.GetFileName path, + Path = Path.GetDirectoryName path, + EnableRaisingEvents = true) - let checkForChanges _ = + let checkForChanges action _ = let curr = getLastWrite() - if !lastWrite <> curr then - log ("Invalidated " + uri.OriginalString) - lastWrite := curr - let typeProviders = typeProviders.ToArray() - for tp, typeName in typeProviders do - match tp with - | TypeProviderReference tp -> tp.InvalidateOneType typeName - | _ -> () + if lastWrite <> curr then + log (sprintf "File %s: %s" action path) + lastWrite <- curr + // creating a copy since the handler can be unsubscribed during the iteration + let handlers = subscriptions.Values |> Seq.toArray + for handler in handlers do + handler() do - watcher.Changed.Add checkForChanges - watcher.Renamed.Add checkForChanges - watcher.Deleted.Add checkForChanges - - member __.Add(tp:IDisposableTypeProvider, typeName) = - typeProviders.Add(TypeProviderReference tp,typeName) - - member __.Remove (tp:IDisposableTypeProvider) typeName = - log (sprintf "Removing %s [%d] from watcher %s" typeName tp.Id uri.OriginalString) - typeProviders.RemoveAll (Predicate(function (TypeProviderReference tp2, typeName2) -> obj.ReferenceEquals(tp,tp2) && typeName = typeName2 | _ -> false)) |> ignore - let alive = typeProviders.Exists(Predicate(function (TypeProviderReference _tp, _tn) -> true | _ -> false)) - if not alive then - log ("Disposing watcher " + uri.OriginalString) - watcher.Dispose() - true + watcher.Changed.Add (checkForChanges "changed") + watcher.Renamed.Add (checkForChanges "renamed") + watcher.Deleted.Add (checkForChanges "deleted") + + member __.Subscribe(name, action) = + subscriptions.Add(name, action) + + member __.Unsubscribe(name) = + if subscriptions.Remove(name) then + log (sprintf "Unsubscribed %s from %s watcher" name path) + if subscriptions.Count = 0 then + log (sprintf "Disposing %s watcher" path) + watcher.Dispose() + true + else + false else - false - -open System.Collections.Generic + false -let private watchers = Dictionary() +let private watchers = Dictionary() // sets up a filesystem watcher that calls the invalidate function whenever the file changes -// adds the filesystem watcher to the list of objects to dispose by the type provider -let private watchForChanges (uri:Uri) (((tp:IDisposableTypeProvider), typeName) as key) = +let watchForChanges path (owner, onChange) = let watcher = - match watchers.TryGetValue uri.OriginalString with - | true, watcher -> + lock watchers <| fun () -> - log (sprintf "Reusing watcher %s for %s [%d]" typeName uri.OriginalString tp.Id) - watcher + match watchers.TryGetValue(path) with + | true, watcher -> - | false, _ -> - - log (sprintf "Setting up watcher %s for %s [%d]" typeName uri.OriginalString tp.Id) - let watcher = Watcher uri - watchers.Add(uri.OriginalString, watcher) - watcher + log (sprintf "Reusing %s watcher" path) + watcher.Subscribe(owner, onChange) + watcher - watcher.Add key + | false, _ -> + + log (sprintf "Setting up %s watcher" path) + let watcher = FileWatcher path + watcher.Subscribe(owner, onChange) + watchers.Add(path, watcher) + watcher - tp.AddDisposeAction <| fun typeNameBeingDisposedOpt -> - - if (match typeNameBeingDisposedOpt with None -> true | Some typeNameBeingDisposed -> typeName = typeNameBeingDisposed) then - if watcher.Remove tp typeName then - watchers.Remove uri.OriginalString |> ignore + { new IDisposable with + member __.Dispose() = + lock watchers <| fun () -> + if watcher.Unsubscribe(owner) then + watchers.Remove(path) |> ignore + } /// Opens a stream to the uri using the uriResolver resolution rules /// It the uri is a file, uses shared read, so it works when the file locked by Excel or similar tools, /// and sets up a filesystem watcher that calls the invalidate function whenever the file changes -let internal asyncRead (_tp:(IDisposableTypeProvider*string) option) (uriResolver:UriResolver) formatName encodingStr (uri:Uri) = +let internal asyncRead (uriResolver:UriResolver) formatName encodingStr (uri:Uri) = let uri, isWeb = uriResolver.Resolve uri if isWeb then async { @@ -214,15 +212,14 @@ let internal asyncRead (_tp:(IDisposableTypeProvider*string) option) (uriResolve // Download the whole web resource at once, otherwise with some servers we won't get the full file let! text = Http.AsyncRequestString(uri.OriginalString, headers = headers, responseEncodingOverride = encodingStr) return new StringReader(text) :> TextReader - } + }, None else let path = uri.OriginalString.Replace(Uri.UriSchemeFile + "://", "") async { let file = File.Open(path, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) - _tp |> Option.iter (watchForChanges uri) let encoding = if encodingStr = "" then Encoding.UTF8 else HttpEncodings.getEncoding encodingStr return new StreamReader(file, encoding) :> TextReader - } + }, Some path let private withUri uri f = match Uri.TryCreate(uri, UriKind.RelativeOrAbsolute) with @@ -234,11 +231,11 @@ let asyncReadTextAtRuntime forFSI defaultResolutionFolder resolutionFolder forma withUri uri <| fun uri -> let resolver = UriResolver.Create((if forFSI then RuntimeInFSI else Runtime), defaultResolutionFolder, resolutionFolder) - asyncRead None resolver formatName encodingStr uri + asyncRead resolver formatName encodingStr uri |> fst /// Returns a TextReader for the uri using the designtime resolution rules let asyncReadTextAtRuntimeWithDesignTimeRules defaultResolutionFolder resolutionFolder formatName encodingStr uri = withUri uri <| fun uri -> let resolver = UriResolver.Create(DesignTime, defaultResolutionFolder, resolutionFolder) - asyncRead None resolver formatName encodingStr uri + asyncRead resolver formatName encodingStr uri |> fst diff --git a/src/FSharp.Data.DesignTime/FSharp.Data.DesignTime.fsproj b/src/FSharp.Data.DesignTime/FSharp.Data.DesignTime.fsproj index 770d3f307..d576163c7 100644 --- a/src/FSharp.Data.DesignTime/FSharp.Data.DesignTime.fsproj +++ b/src/FSharp.Data.DesignTime/FSharp.Data.DesignTime.fsproj @@ -79,13 +79,13 @@ - - + + - - - - + + + + \ No newline at end of file diff --git a/src/FSharp.Data.DesignTime/Properties/launchSettings.json b/src/FSharp.Data.DesignTime/Properties/launchSettings.json new file mode 100644 index 000000000..5ba49a2b3 --- /dev/null +++ b/src/FSharp.Data.DesignTime/Properties/launchSettings.json @@ -0,0 +1,9 @@ +{ + "profiles": { + "FSharp.Data.DesignTime": { + "commandName": "Executable", + "executablePath": "C:\\Program Files (x86)\\Microsoft Visual Studio\\2017\\Community\\Common7\\IDE\\devenv.exe", + "commandLineArgs": "C:\\Users\\guguer\\Desktop\\temp.fsx" + } + } +} \ No newline at end of file diff --git a/src/FSharp.Data/FSharp.Data.fsproj b/src/FSharp.Data/FSharp.Data.fsproj index 4b0626901..bf7e8c783 100644 --- a/src/FSharp.Data/FSharp.Data.fsproj +++ b/src/FSharp.Data/FSharp.Data.fsproj @@ -55,9 +55,9 @@ - - - + + + \ No newline at end of file diff --git a/src/Json/JsonGenerator.fs b/src/Json/JsonGenerator.fs index 487625d5b..4ab355e2c 100644 --- a/src/Json/JsonGenerator.fs +++ b/src/Json/JsonGenerator.fs @@ -5,14 +5,12 @@ namespace ProviderImplementation open System open System.Collections.Generic -open System.Reflection open FSharp.Quotations open FSharp.Data open FSharp.Data.Runtime open FSharp.Data.Runtime.BaseTypes open FSharp.Data.Runtime.StructuralTypes open ProviderImplementation -open ProviderImplementation.JsonInference open ProviderImplementation.JsonConversionsGenerator open ProviderImplementation.ProvidedTypes diff --git a/src/WorldBank/WorldBankProvider.fs b/src/WorldBank/WorldBankProvider.fs index defd6256e..b3108197e 100644 --- a/src/WorldBank/WorldBankProvider.fs +++ b/src/WorldBank/WorldBankProvider.fs @@ -25,7 +25,7 @@ type public WorldBankProvider(cfg:TypeProviderConfig) as this = let defaultServiceUrl = "http://api.worldbank.org" let cacheDuration = TimeSpan.FromDays 30.0 - let restCache, _ = createInternetFileCache "WorldBankSchema" cacheDuration + let restCache = createInternetFileCache "WorldBankSchema" cacheDuration let createTypesForSources(sources, worldBankTypeName, asynchronous) = diff --git a/src/WorldBank/WorldBankRuntime.fs b/src/WorldBank/WorldBankRuntime.fs index d9c01402d..22473b8f9 100644 --- a/src/WorldBank/WorldBankRuntime.fs +++ b/src/WorldBank/WorldBankRuntime.fs @@ -39,7 +39,7 @@ module Implementation = Name : string Description : string } - type internal ServiceConnection(restCache:ICache<_>,serviceUrl:string, sources) = + type internal ServiceConnection(restCache:ICache<_,_>,serviceUrl:string, sources) = let worldBankUrl (functions: string list) (props: (string * string) list) = let url = @@ -384,7 +384,7 @@ type IWorldBankData = /// [omit] type WorldBankData(serviceUrl:string, sources:string) = let sources = sources.Split([| ';' |], StringSplitOptions.RemoveEmptyEntries) |> Array.toList - let restCache, _ = createInternetFileCache "WorldBankRuntime" (TimeSpan.FromDays 30.0) + let restCache = createInternetFileCache "WorldBankRuntime" (TimeSpan.FromDays 30.0) let connection = new ServiceConnection(restCache, serviceUrl, sources) interface IWorldBankData with member x.GetCountries() = CountryCollection(connection, None) :> seq<_> diff --git a/src/Xml/XmlGenerator.fs b/src/Xml/XmlGenerator.fs index 7e7c2ee62..0d1c0e479 100644 --- a/src/Xml/XmlGenerator.fs +++ b/src/Xml/XmlGenerator.fs @@ -5,16 +5,12 @@ namespace ProviderImplementation open System open System.Collections.Generic -open System.IO -open System.Reflection open System.Xml.Linq open FSharp.Quotations -open FSharp.Data open FSharp.Data.Runtime open FSharp.Data.Runtime.BaseTypes open FSharp.Data.Runtime.StructuralTypes open ProviderImplementation -open ProviderImplementation.JsonInference open ProviderImplementation.ProvidedTypes open ProviderImplementation.QuotationBuilder