From c17bdbca0f3e049ba5c9a11a2951fd5c598debd3 Mon Sep 17 00:00:00 2001 From: Cameron Taggart Date: Sun, 14 Jun 2015 23:05:23 -0700 Subject: [PATCH 1/6] refactor Logging to use Trace observable fsprojects/Paket#874 --- src/Paket.Core/Logging.fs | 114 +++++++++++-------- src/Paket.Core/Logging.fsi | 39 +++++++ src/Paket.Core/NuGetV2.fs | 1 + src/Paket.Core/Paket.Core.fsproj | 3 +- src/Paket.PowerShell/CmdletExt.fs | 14 ++- src/Paket.PowerShell/Paket.PowerShell.fsproj | 5 + src/Paket.PowerShell/PowerShell.fs | 33 +++--- src/Paket/Program.fs | 7 +- 8 files changed, 150 insertions(+), 66 deletions(-) create mode 100644 src/Paket.Core/Logging.fsi diff --git a/src/Paket.Core/Logging.fs b/src/Paket.Core/Logging.fs index a6d689c3ba..44d684b427 100644 --- a/src/Paket.Core/Logging.fs +++ b/src/Paket.Core/Logging.fs @@ -2,82 +2,102 @@ open System open System.IO +open System.Diagnostics +/// [omit] let mutable verbose = false -let mutable logFile : string option = None -let traceFunctions = System.Collections.Generic.List<_>() +/// [omit] +type Trace = { + Level: TraceLevel + Text: string + NewLine: bool } -let setLogFile fileName = - let fi = FileInfo fileName - logFile <- Some fi.FullName - if fi.Exists then - fi.Delete() - else - if fi.Directory.Exists |> not then - fi.Directory.Create() +/// [omit] +let event = Event() -let inline traceToFile (text:string) = - match logFile with - | Some fileName -> try File.AppendAllLines(fileName,[text]) with | _ -> () - | _ -> () +/// [omit] +let subscribe callback = Observable.subscribe callback event.Publish -let RegisterTraceFunction(traceFunction:Action) = - traceFunctions.Add(traceFunction) +/// [omit] +let monitor = new Object() -let RemoveTraceFunction(traceFunction:Action) = - traceFunctions.Remove(traceFunction) -let inline traceToRegisteredFunctions (text:string) = - traceToFile text - for f in traceFunctions do - f.Invoke(text) +/// [omit] +//let tracen s = traceToRegisteredFunctions TraceLevel.Info s true +let tracen s = event.Trigger { Level = TraceLevel.Info; Text = s; NewLine = true } /// [omit] -let monitor = new Object() +let tracefn fmt = Printf.ksprintf tracen fmt + +/// [omit] +let trace s = event.Trigger { Level = TraceLevel.Info; Text = s; NewLine = false } /// [omit] -let inline tracen (s : string) = lock monitor (fun () -> traceToRegisteredFunctions s; Console.WriteLine s) +let tracef fmt = Printf.ksprintf trace fmt /// [omit] -let inline tracefn fmt = Printf.ksprintf tracen fmt +let traceVerbose s = + if verbose then + event.Trigger { Level = TraceLevel.Verbose; Text = s; NewLine = true } /// [omit] -let inline trace (s : string) = lock monitor (fun () -> traceToRegisteredFunctions s; Console.Write s) +let verbosefn fmt = Printf.ksprintf traceVerbose fmt /// [omit] -let inline tracef fmt = Printf.ksprintf trace fmt +let traceError s = event.Trigger { Level = TraceLevel.Error; Text = s; NewLine = true } /// [omit] -let inline traceVerbose (s : string) = - if verbose then - lock monitor (fun () -> traceToRegisteredFunctions s; Console.WriteLine s) +let traceWarn s = event.Trigger { Level = TraceLevel.Warning; Text = s; NewLine = true } + +/// [omit] +let traceErrorfn fmt = Printf.ksprintf traceError fmt /// [omit] -let inline verbosefn fmt = Printf.ksprintf traceVerbose fmt +let traceWarnfn fmt = Printf.ksprintf traceWarn fmt + + +// Console Trace /// [omit] -let inline traceColored color (s: string) = - lock monitor - (fun () -> - let curColor = Console.ForegroundColor - if curColor <> color then Console.ForegroundColor <- color - traceToRegisteredFunctions s - use textWriter = - match color with - | ConsoleColor.Red -> Console.Error - | _ -> Console.Out - textWriter.WriteLine s - if curColor <> color then Console.ForegroundColor <- curColor) +let traceColored color (s:string) = + let curColor = Console.ForegroundColor + if curColor <> color then Console.ForegroundColor <- color + use textWriter = + match color with + | ConsoleColor.Red -> Console.Error + | _ -> Console.Out + textWriter.WriteLine s + if curColor <> color then Console.ForegroundColor <- curColor /// [omit] -let inline traceError s = traceColored ConsoleColor.Red s +let traceToConsole (trace:Trace) = + match trace.Level with + | TraceLevel.Warning -> traceColored ConsoleColor.Yellow trace.Text + | TraceLevel.Error -> traceColored ConsoleColor.Red trace.Text + | _ -> + if trace.NewLine then Console.WriteLine trace.Text + else Console.Write trace.Text + + +// Log File Trace /// [omit] -let inline traceWarn s = traceColored ConsoleColor.Yellow s +let mutable logFile : string option = None /// [omit] -let inline traceErrorfn fmt = Printf.ksprintf traceError fmt +let traceToFile (trace:Trace) = + match logFile with + | Some fileName -> try File.AppendAllLines(fileName,[trace.Text]) with | _ -> () + | _ -> () /// [omit] -let inline traceWarnfn fmt = Printf.ksprintf traceWarn fmt \ No newline at end of file +let setLogFile fileName = + let fi = FileInfo fileName + logFile <- Some fi.FullName + if fi.Exists then + fi.Delete() + else + if fi.Directory.Exists |> not then + fi.Directory.Create() + subscribe traceToFile \ No newline at end of file diff --git a/src/Paket.Core/Logging.fsi b/src/Paket.Core/Logging.fsi new file mode 100644 index 0000000000..3c89cf1651 --- /dev/null +++ b/src/Paket.Core/Logging.fsi @@ -0,0 +1,39 @@ +module Paket.Logging + +open System +open System.Diagnostics + +val mutable verbose : bool + + +val tracen : string -> unit + +val tracefn : Printf.StringFormat<'a,unit> -> 'a + +val trace : string -> unit + +val tracef : Printf.StringFormat<'a,unit> -> 'a + +val traceVerbose : string -> unit + +val verbosefn : Printf.StringFormat<'a,unit> -> 'a + +val traceError : string -> unit + +val traceWarn : string -> unit + +val traceErrorfn : Printf.StringFormat<'a,unit> -> 'a + +val traceWarnfn : Printf.StringFormat<'a,unit> -> 'a + + +type Trace = { + Level: TraceLevel + Text: string + NewLine: bool } + +val subscribe : (Trace -> unit) -> IDisposable + +val traceToConsole : Trace -> unit + +val setLogFile : string -> IDisposable \ No newline at end of file diff --git a/src/Paket.Core/NuGetV2.fs b/src/Paket.Core/NuGetV2.fs index 7b9fade15d..07433712db 100644 --- a/src/Paket.Core/NuGetV2.fs +++ b/src/Paket.Core/NuGetV2.fs @@ -402,6 +402,7 @@ let ExtractPackage(fileName:string, targetFolder, name, version:SemVerInfo) = File.Move(file.FullName, Path.Combine(file.DirectoryName, newName)) cleanup (DirectoryInfo targetFolder) + // TODO this is on another thread and PS no likey tracefn "%s %A unzipped to %s" name version targetFolder return targetFolder } diff --git a/src/Paket.Core/Paket.Core.fsproj b/src/Paket.Core/Paket.Core.fsproj index d9428cc066..8c5d1ff231 100644 --- a/src/Paket.Core/Paket.Core.fsproj +++ b/src/Paket.Core/Paket.Core.fsproj @@ -79,6 +79,7 @@ + @@ -267,4 +268,4 @@ - + \ No newline at end of file diff --git a/src/Paket.PowerShell/CmdletExt.fs b/src/Paket.PowerShell/CmdletExt.fs index 5c55ae5044..e40cb71ac4 100644 --- a/src/Paket.PowerShell/CmdletExt.fs +++ b/src/Paket.PowerShell/CmdletExt.fs @@ -2,6 +2,9 @@ module Paket.PowerShell.CmdletExt open System.Management.Automation +open System +open System.Diagnostics +open Paket // add F# printf write extensions type Cmdlet with @@ -37,4 +40,13 @@ type PSCmdlet with else false member x.SetCurrentDirectoryToLocation() = - System.Environment.CurrentDirectory <- x.SessionState.Path.CurrentFileSystemLocation.Path \ No newline at end of file + Environment.CurrentDirectory <- x.SessionState.Path.CurrentFileSystemLocation.Path + + member x.RegisterTrace() = + Logging.verbose <- x.Verbose + Logging.subscribe (fun trace -> + match trace.Level with + | TraceLevel.Warning -> x.WriteWarning trace.Text + | TraceLevel.Error -> x.WriteWarning trace.Text + | _ -> x.WriteObject trace.Text + ) \ No newline at end of file diff --git a/src/Paket.PowerShell/Paket.PowerShell.fsproj b/src/Paket.PowerShell/Paket.PowerShell.fsproj index d81626cc56..6a840f5f8b 100644 --- a/src/Paket.PowerShell/Paket.PowerShell.fsproj +++ b/src/Paket.PowerShell/Paket.PowerShell.fsproj @@ -23,6 +23,11 @@ 3 + Project + + + + pdbonly diff --git a/src/Paket.PowerShell/PowerShell.fs b/src/Paket.PowerShell/PowerShell.fs index 1577231c1b..afa1a0ecd6 100644 --- a/src/Paket.PowerShell/PowerShell.fs +++ b/src/Paket.PowerShell/PowerShell.fs @@ -5,6 +5,7 @@ open Paket open Paket.Commands open Nessos.UnionArgParser open System +open System.Diagnostics [] type Add() = @@ -19,7 +20,7 @@ type Add() = [] member val NoInstall = SwitchParameter() with get, set override x.ProcessRecord() = - Logging.verbose <- x.Verbose + use trc = x.RegisterTrace() x.SetCurrentDirectoryToLocation() let parser = UnionArgParser.Create() seq { @@ -50,7 +51,7 @@ type AutoRestoreCmdlet() = [] member val Off = SwitchParameter() with get, set override x.ProcessRecord() = - Logging.verbose <- x.Verbose + use trc = x.RegisterTrace() x.SetCurrentDirectoryToLocation() let parser = UnionArgParser.Create() seq { @@ -70,7 +71,7 @@ type ConfigCmdlet() = [] member val AddCredentials = "" with get, set override x.ProcessRecord() = - Logging.verbose <- x.Verbose + use trc = x.RegisterTrace() x.SetCurrentDirectoryToLocation() let parser = UnionArgParser.Create() seq { @@ -92,7 +93,7 @@ type ConvertFromNuGetCmdlet() = [] member val CredsMigration = "encrypt" with get, set override x.ProcessRecord() = - Logging.verbose <- x.Verbose + use trc = x.RegisterTrace() x.SetCurrentDirectoryToLocation() let parser = UnionArgParser.Create() seq { @@ -116,7 +117,7 @@ type FindRefsCmdlet() = [] member val NuGet : string[] = Array.empty with get, set override x.ProcessRecord() = - Logging.verbose <- x.Verbose + use trc = x.RegisterTrace() x.SetCurrentDirectoryToLocation() let parser = UnionArgParser.Create() seq { @@ -137,7 +138,7 @@ type FindPackagesCmdlet() = [] member val Silent = SwitchParameter() with get, set override x.ProcessRecord() = - Logging.verbose <- x.Verbose + use trc = x.RegisterTrace() x.SetCurrentDirectoryToLocation() let parser = UnionArgParser.Create() seq { @@ -164,7 +165,7 @@ type FindPackageVersionsCmdlet() = [] member val Silent = SwitchParameter() with get, set override x.ProcessRecord() = - Logging.verbose <- x.Verbose + use trc = x.RegisterTrace() x.SetCurrentDirectoryToLocation() let parser = UnionArgParser.Create() seq { @@ -186,7 +187,7 @@ type InitCmdlet() = inherit PSCmdlet() override x.ProcessRecord() = - Logging.verbose <- x.Verbose + use trc = x.RegisterTrace() x.SetCurrentDirectoryToLocation() let parser = UnionArgParser.Create() List.empty @@ -202,7 +203,7 @@ type InstallCmdlet() = [] member val Redirects = SwitchParameter() with get, set override x.ProcessRecord() = - Logging.verbose <- x.Verbose + use trc = x.RegisterTrace() x.SetCurrentDirectoryToLocation() let parser = UnionArgParser.Create() seq { @@ -225,7 +226,7 @@ type OutdatedCmdlet() = [] member val IncludePrereleases = SwitchParameter() with get, set override x.ProcessRecord() = - Logging.verbose <- x.Verbose + use trc = x.RegisterTrace() x.SetCurrentDirectoryToLocation() let parser = UnionArgParser.Create() seq { @@ -248,7 +249,7 @@ type PushCmdlet() = [] member val Endpoint = "" with get, set override x.ProcessRecord() = - Logging.verbose <- x.Verbose + use trc = x.RegisterTrace() x.SetCurrentDirectoryToLocation() let parser = UnionArgParser.Create() seq { @@ -277,7 +278,7 @@ type RemoveCmdlet() = [] member val NoInstall = SwitchParameter() with get, set override x.ProcessRecord() = - Logging.verbose <- x.Verbose + use trc = x.RegisterTrace() x.SetCurrentDirectoryToLocation() let parser = UnionArgParser.Create() seq { @@ -306,7 +307,7 @@ type RestoreCmdlet() = [] member val ReferencesFiles = Array.empty with get, set override x.ProcessRecord() = - Logging.verbose <- x.Verbose + use trc = x.RegisterTrace() x.SetCurrentDirectoryToLocation() let parser = UnionArgParser.Create() seq { @@ -326,7 +327,7 @@ type SimplifyCmdlet() = [] member val Interactive = SwitchParameter() with get, set override x.ProcessRecord() = - Logging.verbose <- x.Verbose + use trc = x.RegisterTrace() x.SetCurrentDirectoryToLocation() let parser = UnionArgParser.Create() seq { @@ -346,7 +347,7 @@ type ShowInstalledPackagesCmdlet() = [] member val Silent = SwitchParameter() with get, set override x.ProcessRecord() = - Logging.verbose <- x.Verbose + use trc = x.RegisterTrace() x.SetCurrentDirectoryToLocation() let parser = UnionArgParser.Create() seq { @@ -372,7 +373,7 @@ type UpdateCmdlet() = [] member val Redirects = SwitchParameter() with get, set override x.ProcessRecord() = - Logging.verbose <- x.Verbose + use trc = x.RegisterTrace() x.SetCurrentDirectoryToLocation() let parser = UnionArgParser.Create() seq { diff --git a/src/Paket/Program.fs b/src/Paket/Program.fs index 7c25dab141..2d6fc76415 100644 --- a/src/Paket/Program.fs +++ b/src/Paket/Program.fs @@ -71,7 +71,7 @@ let processCommand<'T when 'T :> IArgParserTemplate> (commandF : ArgParseResults processWithValidation (fun _ -> true) commandF Logging.verbose <- v -Option.iter setLogFile logFile +//Option.iter setLogFile logFile let add (results : ArgParseResults<_>) = let packageName = results.GetResult <@ AddArgs.Nuget @> @@ -252,6 +252,11 @@ let push (results : ArgParseResults<_>) = ?apiKey = results.TryGetResult <@ PushArgs.ApiKey @>) try + use consoleTrace = Logging.subscribe Logging.traceToConsole + use fileTrace = + match logFile with + | Some lf -> setLogFile lf + | None -> null let parser = UnionArgParser.Create() let results = parser.Parse(inputs = args, From 66e3fcdddd755313bf492f2528f0042c6b825c66 Mon Sep 17 00:00:00 2001 From: Cameron Taggart Date: Mon, 15 Jun 2015 01:06:13 -0700 Subject: [PATCH 2/6] filter only main thread for PS, restore the lock for the console trace to allow multiple threads --- src/Paket.Core/Logging.fs | 21 +++++++++++---------- src/Paket.Core/NuGetV2.fs | 1 - src/Paket.PowerShell/CmdletExt.fs | 12 ++++++++---- 3 files changed, 19 insertions(+), 15 deletions(-) diff --git a/src/Paket.Core/Logging.fs b/src/Paket.Core/Logging.fs index 44d684b427..8a72063d80 100644 --- a/src/Paket.Core/Logging.fs +++ b/src/Paket.Core/Logging.fs @@ -19,12 +19,8 @@ let event = Event() /// [omit] let subscribe callback = Observable.subscribe callback event.Publish -/// [omit] -let monitor = new Object() - /// [omit] -//let tracen s = traceToRegisteredFunctions TraceLevel.Info s true let tracen s = event.Trigger { Level = TraceLevel.Info; Text = s; NewLine = true } /// [omit] @@ -70,14 +66,19 @@ let traceColored color (s:string) = textWriter.WriteLine s if curColor <> color then Console.ForegroundColor <- curColor +/// [omit] +let monitor = new Object() + /// [omit] let traceToConsole (trace:Trace) = - match trace.Level with - | TraceLevel.Warning -> traceColored ConsoleColor.Yellow trace.Text - | TraceLevel.Error -> traceColored ConsoleColor.Red trace.Text - | _ -> - if trace.NewLine then Console.WriteLine trace.Text - else Console.Write trace.Text + lock monitor + (fun () -> + match trace.Level with + | TraceLevel.Warning -> traceColored ConsoleColor.Yellow trace.Text + | TraceLevel.Error -> traceColored ConsoleColor.Red trace.Text + | _ -> + if trace.NewLine then Console.WriteLine trace.Text + else Console.Write trace.Text ) // Log File Trace diff --git a/src/Paket.Core/NuGetV2.fs b/src/Paket.Core/NuGetV2.fs index 07433712db..7b9fade15d 100644 --- a/src/Paket.Core/NuGetV2.fs +++ b/src/Paket.Core/NuGetV2.fs @@ -402,7 +402,6 @@ let ExtractPackage(fileName:string, targetFolder, name, version:SemVerInfo) = File.Move(file.FullName, Path.Combine(file.DirectoryName, newName)) cleanup (DirectoryInfo targetFolder) - // TODO this is on another thread and PS no likey tracefn "%s %A unzipped to %s" name version targetFolder return targetFolder } diff --git a/src/Paket.PowerShell/CmdletExt.fs b/src/Paket.PowerShell/CmdletExt.fs index e40cb71ac4..16483541d5 100644 --- a/src/Paket.PowerShell/CmdletExt.fs +++ b/src/Paket.PowerShell/CmdletExt.fs @@ -44,9 +44,13 @@ type PSCmdlet with member x.RegisterTrace() = Logging.verbose <- x.Verbose + let id = Threading.Thread.CurrentThread.ManagedThreadId Logging.subscribe (fun trace -> - match trace.Level with - | TraceLevel.Warning -> x.WriteWarning trace.Text - | TraceLevel.Error -> x.WriteWarning trace.Text - | _ -> x.WriteObject trace.Text + if id = Threading.Thread.CurrentThread.ManagedThreadId then + match trace.Level with + | TraceLevel.Warning -> x.WriteWarning trace.Text + | TraceLevel.Error -> x.WriteWarning trace.Text + | _ -> x.WriteObject trace.Text + else + Diagnostics.Debug.Write(sprintf "not on main PS thread: %A" trace) ) \ No newline at end of file From e688bc7fd865231a8355dbf63407761dd3fe1222 Mon Sep 17 00:00:00 2001 From: Cameron Taggart Date: Wed, 17 Jun 2015 16:54:01 -0700 Subject: [PATCH 3/6] added EventSink to support logging on main thread --- src/Paket.Core/Logging.fs | 5 +- src/Paket.Core/Logging.fsi | 2 +- src/Paket.PowerShell/CmdletExt.fs | 20 +- src/Paket.PowerShell/EventSink.fs | 31 ++ src/Paket.PowerShell/Paket.PowerShell.fsproj | 1 + src/Paket.PowerShell/PowerShell.fs | 473 ++++++++++--------- src/Paket/Program.fs | 2 +- 7 files changed, 284 insertions(+), 250 deletions(-) create mode 100644 src/Paket.PowerShell/EventSink.fs diff --git a/src/Paket.Core/Logging.fs b/src/Paket.Core/Logging.fs index 8a72063d80..9d3b7811b2 100644 --- a/src/Paket.Core/Logging.fs +++ b/src/Paket.Core/Logging.fs @@ -16,9 +16,6 @@ type Trace = { /// [omit] let event = Event() -/// [omit] -let subscribe callback = Observable.subscribe callback event.Publish - /// [omit] let tracen s = event.Trigger { Level = TraceLevel.Info; Text = s; NewLine = true } @@ -101,4 +98,4 @@ let setLogFile fileName = else if fi.Directory.Exists |> not then fi.Directory.Create() - subscribe traceToFile \ No newline at end of file + event.Publish |> Observable.subscribe traceToFile \ No newline at end of file diff --git a/src/Paket.Core/Logging.fsi b/src/Paket.Core/Logging.fsi index 3c89cf1651..bd7ee9cae2 100644 --- a/src/Paket.Core/Logging.fsi +++ b/src/Paket.Core/Logging.fsi @@ -32,7 +32,7 @@ type Trace = { Text: string NewLine: bool } -val subscribe : (Trace -> unit) -> IDisposable +val event : Event val traceToConsole : Trace -> unit diff --git a/src/Paket.PowerShell/CmdletExt.fs b/src/Paket.PowerShell/CmdletExt.fs index 16483541d5..6c3cbdb265 100644 --- a/src/Paket.PowerShell/CmdletExt.fs +++ b/src/Paket.PowerShell/CmdletExt.fs @@ -2,8 +2,6 @@ module Paket.PowerShell.CmdletExt open System.Management.Automation -open System -open System.Diagnostics open Paket // add F# printf write extensions @@ -37,20 +35,4 @@ type PSCmdlet with let bps = x.MyInvocation.BoundParameters if bps.ContainsKey "Debug" then (bps.["Debug"] :?> SwitchParameter).ToBool() - else false - - member x.SetCurrentDirectoryToLocation() = - Environment.CurrentDirectory <- x.SessionState.Path.CurrentFileSystemLocation.Path - - member x.RegisterTrace() = - Logging.verbose <- x.Verbose - let id = Threading.Thread.CurrentThread.ManagedThreadId - Logging.subscribe (fun trace -> - if id = Threading.Thread.CurrentThread.ManagedThreadId then - match trace.Level with - | TraceLevel.Warning -> x.WriteWarning trace.Text - | TraceLevel.Error -> x.WriteWarning trace.Text - | _ -> x.WriteObject trace.Text - else - Diagnostics.Debug.Write(sprintf "not on main PS thread: %A" trace) - ) \ No newline at end of file + else false \ No newline at end of file diff --git a/src/Paket.PowerShell/EventSink.fs b/src/Paket.PowerShell/EventSink.fs new file mode 100644 index 0000000000..0af4eb0baf --- /dev/null +++ b/src/Paket.PowerShell/EventSink.fs @@ -0,0 +1,31 @@ +namespace Paket.PowerShell + +open System +open System.Collections.Generic +open System.Collections.Concurrent + +type EventSink<'T>() = + let queue = new BlockingCollection<_>() + let subscriptions = List() + + member __.Fill callback (source:IObservable<'T>) = + source |> Observable.subscribe (fun state -> queue.Add((callback, state))) + |> subscriptions.Add + + member __.Drain() = + for callback, state in queue.GetConsumingEnumerable() do + callback state + + member __.StopFill() = + for sb in subscriptions do + use d = sb + () + queue.CompleteAdding() + + interface IDisposable with + member x.Dispose() = + for s in subscriptions do + use d = s + () + use d = queue + () \ No newline at end of file diff --git a/src/Paket.PowerShell/Paket.PowerShell.fsproj b/src/Paket.PowerShell/Paket.PowerShell.fsproj index 6a840f5f8b..98573321bb 100644 --- a/src/Paket.PowerShell/Paket.PowerShell.fsproj +++ b/src/Paket.PowerShell/Paket.PowerShell.fsproj @@ -43,6 +43,7 @@ + diff --git a/src/Paket.PowerShell/PowerShell.fs b/src/Paket.PowerShell/PowerShell.fs index afa1a0ecd6..fd3ae9f17b 100644 --- a/src/Paket.PowerShell/PowerShell.fs +++ b/src/Paket.PowerShell/PowerShell.fs @@ -1,11 +1,34 @@ namespace Paket.PowerShell open System.Management.Automation +open System.Diagnostics open Paket open Paket.Commands open Nessos.UnionArgParser open System -open System.Diagnostics + +[] +module PaketPs = + + let processWithLogging (cmdlet:PSCmdlet) computation = + Environment.CurrentDirectory <- cmdlet.SessionState.Path.CurrentFileSystemLocation.Path + Logging.verbose <- cmdlet.Verbose + let sink = new EventSink() + + Logging.event.Publish |> sink.Fill (fun trace -> + match trace.Level with + | TraceLevel.Error -> cmdlet.WriteWarning trace.Text + | TraceLevel.Warning -> cmdlet.WriteWarning trace.Text + | TraceLevel.Verbose -> cmdlet.WriteVerbose trace.Text + | _ -> cmdlet.WriteObject trace.Text ) + + let stopFill _ = sink.StopFill() + Async.StartWithContinuations ( + async { + do! Async.SwitchToNewThread() + do! computation + }, stopFill, stopFill, stopFill ) + sink.Drain() [] type Add() = @@ -20,28 +43,28 @@ type Add() = [] member val NoInstall = SwitchParameter() with get, set override x.ProcessRecord() = - use trc = x.RegisterTrace() - x.SetCurrentDirectoryToLocation() - let parser = UnionArgParser.Create() - seq { - if String.IsNullOrEmpty x.NuGet = false then - yield AddArgs.Nuget x.NuGet - if String.IsNullOrEmpty x.Version = false then - yield AddArgs.Version x.Version - if String.IsNullOrEmpty x.Project = false then - yield AddArgs.Project x.Project - if x.Force.IsPresent then - yield AddArgs.Force - if x.Interactive.IsPresent then - yield AddArgs.Interactive - if x.Hard.IsPresent then - yield AddArgs.Hard - if x.NoInstall.IsPresent then - yield AddArgs.No_Install - } - |> List.ofSeq - |> parser.CreateParseResultsOfList - |> Program.add + async { + let parser = UnionArgParser.Create() + seq { + if String.IsNullOrEmpty x.NuGet = false then + yield AddArgs.Nuget x.NuGet + if String.IsNullOrEmpty x.Version = false then + yield AddArgs.Version x.Version + if String.IsNullOrEmpty x.Project = false then + yield AddArgs.Project x.Project + if x.Force.IsPresent then + yield AddArgs.Force + if x.Interactive.IsPresent then + yield AddArgs.Interactive + if x.Hard.IsPresent then + yield AddArgs.Hard + if x.NoInstall.IsPresent then + yield AddArgs.No_Install + } + |> List.ofSeq + |> parser.CreateParseResultsOfList + |> Program.add + } |> processWithLogging x [] type AutoRestoreCmdlet() = @@ -51,18 +74,18 @@ type AutoRestoreCmdlet() = [] member val Off = SwitchParameter() with get, set override x.ProcessRecord() = - use trc = x.RegisterTrace() - x.SetCurrentDirectoryToLocation() - let parser = UnionArgParser.Create() - seq { - if x.On.IsPresent then - yield AutoRestoreArgs.On - if x.Off.IsPresent then - yield AutoRestoreArgs.Off - } - |> List.ofSeq - |> parser.CreateParseResultsOfList - |> Program.autoRestore + async { + let parser = UnionArgParser.Create() + seq { + if x.On.IsPresent then + yield AutoRestoreArgs.On + if x.Off.IsPresent then + yield AutoRestoreArgs.Off + } + |> List.ofSeq + |> parser.CreateParseResultsOfList + |> Program.autoRestore + } |> processWithLogging x [] type ConfigCmdlet() = @@ -71,16 +94,16 @@ type ConfigCmdlet() = [] member val AddCredentials = "" with get, set override x.ProcessRecord() = - use trc = x.RegisterTrace() - x.SetCurrentDirectoryToLocation() - let parser = UnionArgParser.Create() - seq { - if String.IsNullOrEmpty x.AddCredentials = false then - yield ConfigArgs.AddCredentials x.AddCredentials - } - |> List.ofSeq - |> parser.CreateParseResultsOfList - |> Program.config + async { + let parser = UnionArgParser.Create() + seq { + if String.IsNullOrEmpty x.AddCredentials = false then + yield ConfigArgs.AddCredentials x.AddCredentials + } + |> List.ofSeq + |> parser.CreateParseResultsOfList + |> Program.config + } |> processWithLogging x [] type ConvertFromNuGetCmdlet() = @@ -93,22 +116,22 @@ type ConvertFromNuGetCmdlet() = [] member val CredsMigration = "encrypt" with get, set override x.ProcessRecord() = - use trc = x.RegisterTrace() - x.SetCurrentDirectoryToLocation() - let parser = UnionArgParser.Create() - seq { - if x.Force.IsPresent then - yield ConvertFromNugetArgs.Force - if x.NoInstall.IsPresent then - yield ConvertFromNugetArgs.No_Install - if x.NoAutoRestore.IsPresent then - yield ConvertFromNugetArgs.No_Auto_Restore - if String.IsNullOrEmpty x.CredsMigration = false then - yield ConvertFromNugetArgs.Creds_Migration x.CredsMigration - } - |> List.ofSeq - |> parser.CreateParseResultsOfList - |> Program.convert + async { + let parser = UnionArgParser.Create() + seq { + if x.Force.IsPresent then + yield ConvertFromNugetArgs.Force + if x.NoInstall.IsPresent then + yield ConvertFromNugetArgs.No_Install + if x.NoAutoRestore.IsPresent then + yield ConvertFromNugetArgs.No_Auto_Restore + if String.IsNullOrEmpty x.CredsMigration = false then + yield ConvertFromNugetArgs.Creds_Migration x.CredsMigration + } + |> List.ofSeq + |> parser.CreateParseResultsOfList + |> Program.convert + } |> processWithLogging x [] type FindRefsCmdlet() = @@ -117,16 +140,16 @@ type FindRefsCmdlet() = [] member val NuGet : string[] = Array.empty with get, set override x.ProcessRecord() = - use trc = x.RegisterTrace() - x.SetCurrentDirectoryToLocation() - let parser = UnionArgParser.Create() - seq { - for p in x.NuGet do - yield FindRefsArgs.Packages p - } - |> List.ofSeq - |> parser.CreateParseResultsOfList - |> Program.findRefs + async { + let parser = UnionArgParser.Create() + seq { + for p in x.NuGet do + yield FindRefsArgs.Packages p + } + |> List.ofSeq + |> parser.CreateParseResultsOfList + |> Program.findRefs + } |> processWithLogging x [] type FindPackagesCmdlet() = @@ -138,22 +161,22 @@ type FindPackagesCmdlet() = [] member val Silent = SwitchParameter() with get, set override x.ProcessRecord() = - use trc = x.RegisterTrace() - x.SetCurrentDirectoryToLocation() - let parser = UnionArgParser.Create() - seq { - if String.IsNullOrEmpty x.SearchText = false then - yield FindPackagesArgs.SearchText x.SearchText - if String.IsNullOrEmpty x.Source = false then - yield FindPackagesArgs.Source x.Source - if x.Max <> Int32.MinValue then - yield FindPackagesArgs.MaxResults x.Max - if x.Silent.IsPresent then - yield FindPackagesArgs.Silent - } - |> List.ofSeq - |> parser.CreateParseResultsOfList - |> Program.findPackages + async { + let parser = UnionArgParser.Create() + seq { + if String.IsNullOrEmpty x.SearchText = false then + yield FindPackagesArgs.SearchText x.SearchText + if String.IsNullOrEmpty x.Source = false then + yield FindPackagesArgs.Source x.Source + if x.Max <> Int32.MinValue then + yield FindPackagesArgs.MaxResults x.Max + if x.Silent.IsPresent then + yield FindPackagesArgs.Silent + } + |> List.ofSeq + |> parser.CreateParseResultsOfList + |> Program.findPackages + } |> processWithLogging x [] type FindPackageVersionsCmdlet() = @@ -165,34 +188,34 @@ type FindPackageVersionsCmdlet() = [] member val Silent = SwitchParameter() with get, set override x.ProcessRecord() = - use trc = x.RegisterTrace() - x.SetCurrentDirectoryToLocation() - let parser = UnionArgParser.Create() - seq { - if String.IsNullOrEmpty x.Name = false then - yield FindPackageVersionsArgs.Name x.Name - if String.IsNullOrEmpty x.Source = false then - yield FindPackageVersionsArgs.Source x.Source - if x.Max <> Int32.MinValue then - yield FindPackageVersionsArgs.MaxResults x.Max - if x.Silent.IsPresent then - yield FindPackageVersionsArgs.Silent - } - |> List.ofSeq - |> parser.CreateParseResultsOfList - |> Program.findPackageVersions + async { + let parser = UnionArgParser.Create() + seq { + if String.IsNullOrEmpty x.Name = false then + yield FindPackageVersionsArgs.Name x.Name + if String.IsNullOrEmpty x.Source = false then + yield FindPackageVersionsArgs.Source x.Source + if x.Max <> Int32.MinValue then + yield FindPackageVersionsArgs.MaxResults x.Max + if x.Silent.IsPresent then + yield FindPackageVersionsArgs.Silent + } + |> List.ofSeq + |> parser.CreateParseResultsOfList + |> Program.findPackageVersions + } |> processWithLogging x [] type InitCmdlet() = inherit PSCmdlet() override x.ProcessRecord() = - use trc = x.RegisterTrace() - x.SetCurrentDirectoryToLocation() - let parser = UnionArgParser.Create() - List.empty - |> parser.CreateParseResultsOfList - |> Program.init + async { + let parser = UnionArgParser.Create() + List.empty + |> parser.CreateParseResultsOfList + |> Program.init + } |> processWithLogging x [] type InstallCmdlet() = @@ -203,20 +226,20 @@ type InstallCmdlet() = [] member val Redirects = SwitchParameter() with get, set override x.ProcessRecord() = - use trc = x.RegisterTrace() - x.SetCurrentDirectoryToLocation() - let parser = UnionArgParser.Create() - seq { - if x.Force.IsPresent then - yield InstallArgs.Force - if x.Hard.IsPresent then - yield InstallArgs.Hard - if x.Redirects.IsPresent then - yield InstallArgs.Redirects - } - |> List.ofSeq - |> parser.CreateParseResultsOfList - |> Program.install + async { + let parser = UnionArgParser.Create() + seq { + if x.Force.IsPresent then + yield InstallArgs.Force + if x.Hard.IsPresent then + yield InstallArgs.Hard + if x.Redirects.IsPresent then + yield InstallArgs.Redirects + } + |> List.ofSeq + |> parser.CreateParseResultsOfList + |> Program.install + } |> processWithLogging x [] type OutdatedCmdlet() = @@ -226,18 +249,18 @@ type OutdatedCmdlet() = [] member val IncludePrereleases = SwitchParameter() with get, set override x.ProcessRecord() = - use trc = x.RegisterTrace() - x.SetCurrentDirectoryToLocation() - let parser = UnionArgParser.Create() - seq { - if x.IgnoreConstraints.IsPresent then - yield OutdatedArgs.Ignore_Constraints - if x.IncludePrereleases.IsPresent then - yield OutdatedArgs.Include_Prereleases - } - |> List.ofSeq - |> parser.CreateParseResultsOfList - |> Program.outdated + async { + let parser = UnionArgParser.Create() + seq { + if x.IgnoreConstraints.IsPresent then + yield OutdatedArgs.Ignore_Constraints + if x.IncludePrereleases.IsPresent then + yield OutdatedArgs.Include_Prereleases + } + |> List.ofSeq + |> parser.CreateParseResultsOfList + |> Program.outdated + } |> processWithLogging x [] type PushCmdlet() = @@ -249,22 +272,22 @@ type PushCmdlet() = [] member val Endpoint = "" with get, set override x.ProcessRecord() = - use trc = x.RegisterTrace() - x.SetCurrentDirectoryToLocation() - let parser = UnionArgParser.Create() - seq { - if String.IsNullOrEmpty x.Url = false then - yield PushArgs.Url x.Url - if String.IsNullOrEmpty x.File = false then - yield PushArgs.FileName x.File - if String.IsNullOrEmpty x.ApiKey = false then - yield PushArgs.ApiKey x.ApiKey - if String.IsNullOrEmpty x.Endpoint = false then - yield PushArgs.EndPoint x.Endpoint - } - |> List.ofSeq - |> parser.CreateParseResultsOfList - |> Program.push + async { + let parser = UnionArgParser.Create() + seq { + if String.IsNullOrEmpty x.Url = false then + yield PushArgs.Url x.Url + if String.IsNullOrEmpty x.File = false then + yield PushArgs.FileName x.File + if String.IsNullOrEmpty x.ApiKey = false then + yield PushArgs.ApiKey x.ApiKey + if String.IsNullOrEmpty x.Endpoint = false then + yield PushArgs.EndPoint x.Endpoint + } + |> List.ofSeq + |> parser.CreateParseResultsOfList + |> Program.push + } |> processWithLogging x [] type RemoveCmdlet() = @@ -278,26 +301,26 @@ type RemoveCmdlet() = [] member val NoInstall = SwitchParameter() with get, set override x.ProcessRecord() = - use trc = x.RegisterTrace() - x.SetCurrentDirectoryToLocation() - let parser = UnionArgParser.Create() - seq { - if String.IsNullOrEmpty x.NuGet = false then - yield RemoveArgs.Nuget x.NuGet - if String.IsNullOrEmpty x.Project = false then - yield RemoveArgs.Project x.Project - if x.Force.IsPresent then - yield RemoveArgs.Force - if x.Interactive.IsPresent then - yield RemoveArgs.Interactive - if x.Hard.IsPresent then - yield RemoveArgs.Hard - if x.NoInstall.IsPresent then - yield RemoveArgs.No_Install - } - |> List.ofSeq - |> parser.CreateParseResultsOfList - |> Program.remove + async { + let parser = UnionArgParser.Create() + seq { + if String.IsNullOrEmpty x.NuGet = false then + yield RemoveArgs.Nuget x.NuGet + if String.IsNullOrEmpty x.Project = false then + yield RemoveArgs.Project x.Project + if x.Force.IsPresent then + yield RemoveArgs.Force + if x.Interactive.IsPresent then + yield RemoveArgs.Interactive + if x.Hard.IsPresent then + yield RemoveArgs.Hard + if x.NoInstall.IsPresent then + yield RemoveArgs.No_Install + } + |> List.ofSeq + |> parser.CreateParseResultsOfList + |> Program.remove + } |> processWithLogging x [] type RestoreCmdlet() = @@ -307,18 +330,18 @@ type RestoreCmdlet() = [] member val ReferencesFiles = Array.empty with get, set override x.ProcessRecord() = - use trc = x.RegisterTrace() - x.SetCurrentDirectoryToLocation() - let parser = UnionArgParser.Create() - seq { - if x.Force.IsPresent then - yield RestoreArgs.Force - for rf in x.ReferencesFiles do - yield RestoreArgs.References_Files rf - } - |> List.ofSeq - |> parser.CreateParseResultsOfList - |> Program.restore + async { + let parser = UnionArgParser.Create() + seq { + if x.Force.IsPresent then + yield RestoreArgs.Force + for rf in x.ReferencesFiles do + yield RestoreArgs.References_Files rf + } + |> List.ofSeq + |> parser.CreateParseResultsOfList + |> Program.restore + } |> processWithLogging x [] type SimplifyCmdlet() = @@ -327,16 +350,16 @@ type SimplifyCmdlet() = [] member val Interactive = SwitchParameter() with get, set override x.ProcessRecord() = - use trc = x.RegisterTrace() - x.SetCurrentDirectoryToLocation() - let parser = UnionArgParser.Create() - seq { - if x.Interactive.IsPresent then - yield SimplifyArgs.Interactive - } - |> List.ofSeq - |> parser.CreateParseResultsOfList - |> Program.simplify + async { + let parser = UnionArgParser.Create() + seq { + if x.Interactive.IsPresent then + yield SimplifyArgs.Interactive + } + |> List.ofSeq + |> parser.CreateParseResultsOfList + |> Program.simplify + } |> processWithLogging x [] type ShowInstalledPackagesCmdlet() = @@ -347,20 +370,20 @@ type ShowInstalledPackagesCmdlet() = [] member val Silent = SwitchParameter() with get, set override x.ProcessRecord() = - use trc = x.RegisterTrace() - x.SetCurrentDirectoryToLocation() - let parser = UnionArgParser.Create() - seq { - if x.All.IsPresent then - yield ShowInstalledPackagesArgs.All - if String.IsNullOrEmpty x.Project = false then - yield ShowInstalledPackagesArgs.Project x.Project - if x.Silent.IsPresent then - yield ShowInstalledPackagesArgs.Silent - } - |> List.ofSeq - |> parser.CreateParseResultsOfList - |> Program.showInstalledPackages + async { + let parser = UnionArgParser.Create() + seq { + if x.All.IsPresent then + yield ShowInstalledPackagesArgs.All + if String.IsNullOrEmpty x.Project = false then + yield ShowInstalledPackagesArgs.Project x.Project + if x.Silent.IsPresent then + yield ShowInstalledPackagesArgs.Silent + } + |> List.ofSeq + |> parser.CreateParseResultsOfList + |> Program.showInstalledPackages + } |> processWithLogging x [] type UpdateCmdlet() = @@ -373,21 +396,21 @@ type UpdateCmdlet() = [] member val Redirects = SwitchParameter() with get, set override x.ProcessRecord() = - use trc = x.RegisterTrace() - x.SetCurrentDirectoryToLocation() - let parser = UnionArgParser.Create() - seq { - if String.IsNullOrEmpty x.NuGet = false then - yield UpdateArgs.Nuget x.NuGet - if String.IsNullOrEmpty x.Version = false then - yield UpdateArgs.Version x.Version - if x.Force.IsPresent then - yield UpdateArgs.Force - if x.Hard.IsPresent then - yield UpdateArgs.Hard - if x.Redirects.IsPresent then - yield UpdateArgs.Redirects - } - |> List.ofSeq - |> parser.CreateParseResultsOfList - |> Program.update \ No newline at end of file + async { + let parser = UnionArgParser.Create() + seq { + if String.IsNullOrEmpty x.NuGet = false then + yield UpdateArgs.Nuget x.NuGet + if String.IsNullOrEmpty x.Version = false then + yield UpdateArgs.Version x.Version + if x.Force.IsPresent then + yield UpdateArgs.Force + if x.Hard.IsPresent then + yield UpdateArgs.Hard + if x.Redirects.IsPresent then + yield UpdateArgs.Redirects + } + |> List.ofSeq + |> parser.CreateParseResultsOfList + |> Program.update + } |> processWithLogging x \ No newline at end of file diff --git a/src/Paket/Program.fs b/src/Paket/Program.fs index 2d6fc76415..69fddb661c 100644 --- a/src/Paket/Program.fs +++ b/src/Paket/Program.fs @@ -252,7 +252,7 @@ let push (results : ArgParseResults<_>) = ?apiKey = results.TryGetResult <@ PushArgs.ApiKey @>) try - use consoleTrace = Logging.subscribe Logging.traceToConsole + use consoleTrace = Logging.event.Publish |> Observable.subscribe Logging.traceToConsole use fileTrace = match logFile with | Some lf -> setLogFile lf From f72527afd4e6888e0dbd9833402c93a4aa74c06d Mon Sep 17 00:00:00 2001 From: Cameron Taggart Date: Wed, 17 Jun 2015 17:23:28 -0700 Subject: [PATCH 4/6] use async try finally --- src/Paket.PowerShell/PowerShell.fs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/Paket.PowerShell/PowerShell.fs b/src/Paket.PowerShell/PowerShell.fs index fd3ae9f17b..cdb071afc5 100644 --- a/src/Paket.PowerShell/PowerShell.fs +++ b/src/Paket.PowerShell/PowerShell.fs @@ -22,12 +22,14 @@ module PaketPs = | TraceLevel.Verbose -> cmdlet.WriteVerbose trace.Text | _ -> cmdlet.WriteObject trace.Text ) - let stopFill _ = sink.StopFill() - Async.StartWithContinuations ( - async { + async { + try do! Async.SwitchToNewThread() do! computation - }, stopFill, stopFill, stopFill ) + finally + sink.StopFill() + } |> Async.Start + sink.Drain() [] From 9ba99284f6ee50a6c1d2fd4229a684dfa4b4ad68 Mon Sep 17 00:00:00 2001 From: Cameron Taggart Date: Wed, 17 Jun 2015 17:49:39 -0700 Subject: [PATCH 5/6] removed commented out code --- src/Paket/Program.fs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Paket/Program.fs b/src/Paket/Program.fs index 69fddb661c..aef9207ba6 100644 --- a/src/Paket/Program.fs +++ b/src/Paket/Program.fs @@ -71,7 +71,6 @@ let processCommand<'T when 'T :> IArgParserTemplate> (commandF : ArgParseResults processWithValidation (fun _ -> true) commandF Logging.verbose <- v -//Option.iter setLogFile logFile let add (results : ArgParseResults<_>) = let packageName = results.GetResult <@ AddArgs.Nuget @> From 36ea71b5d208e5718ac8fc7e5bec0bf99edf50d1 Mon Sep 17 00:00:00 2001 From: Cameron Taggart Date: Wed, 17 Jun 2015 18:10:22 -0700 Subject: [PATCH 6/6] added `use` to dispose of EventSink --- src/Paket.PowerShell/PowerShell.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Paket.PowerShell/PowerShell.fs b/src/Paket.PowerShell/PowerShell.fs index cdb071afc5..ea28084fef 100644 --- a/src/Paket.PowerShell/PowerShell.fs +++ b/src/Paket.PowerShell/PowerShell.fs @@ -13,7 +13,7 @@ module PaketPs = let processWithLogging (cmdlet:PSCmdlet) computation = Environment.CurrentDirectory <- cmdlet.SessionState.Path.CurrentFileSystemLocation.Path Logging.verbose <- cmdlet.Verbose - let sink = new EventSink() + use sink = new EventSink() Logging.event.Publish |> sink.Fill (fun trace -> match trace.Level with