diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index 9aaa5c0f9..54382c394 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -1,6 +1,6 @@ #### 3.0.0-beta2 - Unrelease -* Fixed memory leaks inside the design time components. -* Improved performance of CSV,HTML,XML,JSON type providers. +* 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. diff --git a/src/CommonProviderImplementation/Helpers.fs b/src/CommonProviderImplementation/Helpers.fs index 09dca4bc0..2fb4cbf1c 100644 --- a/src/CommonProviderImplementation/Helpers.fs +++ b/src/CommonProviderImplementation/Helpers.fs @@ -6,6 +6,7 @@ namespace ProviderImplementation open System +open System.Collections.Generic open System.Reflection open System.Text open FSharp.Core.CompilerServices @@ -76,33 +77,48 @@ type DisposableTypeProviderForNamespaces(config, ?assemblyReplacementMap) as x = static let mutable idCount = 0 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 - let addDisposeAction action = lock disposeActions <| fun () -> disposeActions.Add action + member __.SetFileToWatch(fullTypeName, path) = + filesToWatch.Add(fullTypeName, path) - let dispose typeName = lock disposeActions <| fun () -> - log (sprintf "Disposing %s in TypeProviderForNamespaces %O [%d]" typeName x id) - for dispose in disposeActions do + member __.GetFileToWath(fullTypeName) = + match filesToWatch.TryGetValue(fullTypeName) with + | true, path -> Some path + | _ -> None + + member __.AddDisposeAction action = + lock disposeActions <| fun () -> disposeActions.Add action + + 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 // ---------------------------------------------------------------------------------------------- @@ -153,7 +169,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 @@ -207,9 +222,9 @@ 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 + toWatch |> Option.iter (fun path -> tp.SetFileToWatch(fullTypeName, path)) + use reader = reader |> Async.RunSynchronously match maxNumberOfRows with | None -> reader.ReadToEnd() | Some max -> @@ -228,7 +243,7 @@ module internal ProviderHelpers = let sample, isWeb = if isWeb uri then - webUrisCache.GetOrAdd uri.OriginalString readText, true + webUrisCache.GetOrAdd(uri.OriginalString, readText), true else readText(), false @@ -264,37 +279,63 @@ module internal ProviderHelpers = CreateFromTextReaderForSampleList : Expr -> Expr } 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:IDisposableTypeProvider) (fullTypeName:string) f = + let internal getOrCreateProvidedType (cfg: TypeProviderConfig) (tp:DisposableTypeProviderForNamespaces) (fullTypeName:string) f = + using (logTime "GeneratingProvidedType" (sprintf "%s [%d]" fullTypeName tp.Id)) <| fun _ -> + // 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) - match providedTypesCache.TryRetrieve key with - | Some (providedType, fullKey2) when fullKey = fullKey2 -> - log (sprintf "Reusing saved generation of type %s [%d]" fullTypeName tp.Id) + 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) + 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() - providedTypesCache.Set key (providedType, fullKey) - log (sprintf "Saving generation of type %s for 10 seconds [%d]" fullTypeName tp.Id) - - // 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 - log (sprintf "Deleting cache for type %s [%d]" fullTypeName tp.Id) - providedTypesCache.Invalidate key - else - log (sprintf "Saving generation of type %s for 10 seconds awaiting incremental recreation [%d]" fullTypeName tp.Id) - providedTypesCache.Set key (providedType, fullKey) + log "Caching for 10 seconds" + let fileToWatch = tp.GetFileToWath(fullTypeName) + providedTypesCache.Set(fullTypeName, (providedType, fullKey, fileToWatch)) + setupDisposeAction providedType fileToWatch providedType else f() @@ -315,7 +356,7 @@ module internal ProviderHelpers = (tp:DisposableTypeProviderForNamespaces) (cfg:TypeProviderConfig) encodingStr resolutionFolder optResource fullTypeName maxNumberOfRows = - using (logTime "GeneratingType" sampleOrSampleUri) <| fun _ -> + getOrCreateProvidedType cfg tp fullTypeName <| fun () -> let isRunningInFSI = cfg.IsHostedExecution let defaultResolutionFolder = cfg.ResolutionFolder @@ -326,7 +367,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 diff --git a/src/CommonRuntime/Caching.fs b/src/CommonRuntime/Caching.fs index f8a682963..ff3dcfb27 100644 --- a/src/CommonRuntime/Caching.fs +++ b/src/CommonRuntime/Caching.fs @@ -7,37 +7,44 @@ open System.Diagnostics open System.IO open System.Security.Cryptography open System.Text +open FSharp.Data.Runtime.IO 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 Invalidate : key:'TKey -> unit + 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:TimeSpan) = - let dict = ConcurrentDictionary<'TKey_,'TValue*DateTime>() - let queueInvalidation key = - async { - do! Async.Sleep (expiration.Milliseconds) - match dict.TryGetValue(key) with - | true, (_, timestamp) when DateTime.UtcNow - timestamp >= expiration -> dict.TryRemove(key) |> ignore - | _ -> () } - { new ICache<_,_> with - member __.Set key value = - dict.[key] <- (value, DateTime.UtcNow) - queueInvalidation key |> ignore - member __.GetOrAdd key valueFactory = - dict.GetOrAdd(key, fun key -> - queueInvalidation key |> ignore - valueFactory(), DateTime.UtcNow) |> fst - member __.TryRetrieve(key) = - match dict.TryGetValue(key) with - | true, (value, timestamp) when DateTime.UtcNow - timestamp < expiration -> Some value - | _ -> None - member __.Invalidate(key) = - dict.TryRemove(key) |> ignore } - + 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) = @@ -87,31 +94,33 @@ let createInternetFileCache prefix expiration = Debug.WriteLine("Caching: Failed to read file {0} with an exception: {1}", cacheFile, e.Message) None - member __.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 = + member x.GetOrAdd(key, valueFactory) = match x.TryRetrieve key with | Some value -> value | None -> let value = valueFactory() - x.Set key value + x.Set(key, value) value - member __.Invalidate(key) = + member __.Remove(key) = let cacheFile = cacheFile key - try File.Delete(cacheFile) + try + File.Delete(cacheFile) with e -> - Debug.WriteLine("Caching: Failed to delete 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 a sample value to the cache - cache.Set "$$$test$$$" "dummyValue" - match cache.TryRetrieve "$$$test$$$" with + cache.Set("$$$test$$$", "dummyValue") + match cache.TryRetrieve("$$$test$$$") with | Some "dummyValue" -> - cache.Invalidate("$$$test$$$") + cache.Remove("$$$test$$$") |> ignore cache | _ -> // fallback to an in memory cache diff --git a/src/CommonRuntime/IO.fs b/src/CommonRuntime/IO.fs index f839192a0..6db8fe8cc 100644 --- a/src/CommonRuntime/IO.fs +++ b/src/CommonRuntime/IO.fs @@ -72,10 +72,10 @@ let private appendToLog logFile line = appendToLogMultiple logFile [line] let internal log str = -#if NO_TIMESTAMPS - String(' ', indentation * 2) + str -#else +#if TIMESTAMPS_IN_LOG "[" + DateTime.Now.TimeOfDay.ToString() + "] " + String(' ', indentation * 2) + str +#else + String(' ', indentation * 2) + str #endif |> appendToLog "log.txt" @@ -93,7 +93,7 @@ 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() @@ -103,7 +103,7 @@ let internal logTime category (instance:string) = member __.Dispose() = s.Stop() Interlocked.Decrement &indentation |> ignore - log (sprintf "Ended %s %s" category instance) + 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" } @@ -117,99 +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 - -type private Watcher(uri:Uri) = +type private FileWatcher(path) = - let typeProviders = ResizeArray() + let subscriptions = Dictionary unit>() - let getLastWrite() = File.GetLastWriteTime uri.OriginalString + 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) + log (sprintf "File %s: %s" action path) lastWrite <- curr - let typeProviders = typeProviders.ToArray() - for tp, typeName in typeProviders do - match tp.TryGetTarget() with - | true, tp -> tp.InvalidateOneType typeName - | _ -> () + // 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(fun (tpReference, typeName2) -> - match tpReference.TryGetTarget() with - | true, tp2 -> obj.ReferenceEquals(tp, tp2) && typeName = typeName2 - | _ -> false) |> ignore - let alive = typeProviders.Exists(fun (tpReference, _) -> - match tpReference.TryGetTarget() with - | alive, _ -> alive) - 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 + 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 = lock watchers <| fun () -> - match watchers.TryGetValue uri.OriginalString with + match watchers.TryGetValue(path) with | true, watcher -> - log (sprintf "Reusing watcher %s for %s [%d]" typeName uri.OriginalString tp.Id) - watcher.Add key + log (sprintf "Reusing %s watcher" path) + watcher.Subscribe(owner, onChange) watcher | false, _ -> - log (sprintf "Setting up watcher %s for %s [%d]" typeName uri.OriginalString tp.Id) - let watcher = Watcher uri - watcher.Add key - watchers.Add(uri.OriginalString, watcher) + 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 + { new IDisposable with + member __.Dispose() = lock watchers <| fun () -> - if watcher.Remove tp typeName then - watchers.Remove uri.OriginalString |> ignore + 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 { @@ -226,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 @@ -246,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/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/WorldBank/WorldBankRuntime.fs b/src/WorldBank/WorldBankRuntime.fs index fb61b924b..22473b8f9 100644 --- a/src/WorldBank/WorldBankRuntime.fs +++ b/src/WorldBank/WorldBankRuntime.fs @@ -63,7 +63,7 @@ module Implementation = HttpRequestHeaders.Accept HttpContentTypes.Json ]) Debug.WriteLine (sprintf "[WorldBank] got text: %s" (if doc = null then "null" elif doc.Length > 50 then doc.[0..49] + "..." else doc)) if not (String.IsNullOrEmpty doc) then - restCache.Set url doc + restCache.Set(url, doc) return doc with e -> Debug.WriteLine (sprintf "[WorldBank] error: %s" (e.ToString()))