diff --git a/buckaroo/Command.fs b/buckaroo/Command.fs index fda4129..6b117d4 100644 --- a/buckaroo/Command.fs +++ b/buckaroo/Command.fs @@ -17,6 +17,7 @@ type Command = | UpgradeDependencies of List | AddDependencies of List | RemoveDependencies of List + | Explain of PackageIdentifier | ShowCompletions module Command = @@ -154,6 +155,15 @@ module Command = return RemoveDependencies deps } + let explainParser = parse { + do! CharParsers.spaces + do! CharParsers.skipString "explain" + do! CharParsers.spaces1 + let! package = PackageIdentifier.parser + do! CharParsers.spaces + return Explain package + } + let showCompletionsParser : Parser = parse { do! CharParsers.spaces do! CharParsers.skipString "show-completions" @@ -175,6 +185,7 @@ module Command = <|> versionParser <|> helpParser <|> showCompletionsParser + <|> explainParser <|> startParser do! CharParsers.spaces @@ -277,9 +288,10 @@ module Command = | UpgradeDependencies dependencies -> UpgradeCommand.task context dependencies | AddDependencies dependencies -> AddCommand.task context dependencies | RemoveDependencies dependencies -> RemoveCommand.task context dependencies + | Explain package -> ExplainCommand.task context package | ShowCompletions -> ShowCompletions.task context - do! context.Console.Flush() + do! context.Console.Flush () return returnCode } diff --git a/buckaroo/ExplainCommand.fs b/buckaroo/ExplainCommand.fs new file mode 100644 index 0000000..cd9bdbb --- /dev/null +++ b/buckaroo/ExplainCommand.fs @@ -0,0 +1,102 @@ +module Buckaroo.ExplainCommand + +open FSharp.Control +open Buckaroo.Tasks +open Buckaroo.Logger + +let private explain (logger : Logger) (sourceExplorer : ISourceExplorer) (packageToExplain : PackageIdentifier) (lock : Lock) = async { + let rec computeTraces traces = asyncSeq { + for trace in traces do + match trace with + | head :: tail -> + let package, isPrivate = head + + match lock.Packages |> Map.tryFind package with + | Some lockedPackage -> + yield head :: tail + + logger.Info ("Exploring " + (PackageIdentifier.show package) + "... ") + + let! manifest = + sourceExplorer.FetchManifest (lockedPackage.Location, lockedPackage.Versions) + + let nextTraces = + manifest.Dependencies + |> Seq.map (fun dependency -> (dependency, false)) + |> Seq.append (manifest.PrivateDependencies |> Seq.map (fun dependency -> (dependency, true))) + |> Seq.map (fun (dependency, isPrivate) -> (dependency.Package, isPrivate) :: head :: tail) + |> Set.ofSeq + + yield! nextTraces |> AsyncSeq.ofSeq + + yield! computeTraces nextTraces + | None -> () + | [] -> () + } + + let directDependencies = + lock.Dependencies + |> Seq.choose (fun target -> + match target.PackagePath with + | [], package -> Some [ (package, false) ] + | _ -> None + ) + |> Set.ofSeq + + let! traces = + computeTraces directDependencies + |> AsyncSeq.filter (fun trace -> + match trace with + | (head, _) :: _ -> head = packageToExplain + | _ -> false + ) + |> AsyncSeq.distinctUntilChanged + |> AsyncSeq.toListAsync + + return + traces + |> Seq.sortBy List.length + |> Seq.distinct + |> Seq.toList +} + +let task (context : TaskContext) (package : PackageIdentifier) = async { + let logger = createLogger context.Console None + + logger.Info "Reading lock-file... " + + match! Tasks.readLockIfPresent with + | Some lock -> + logger.Info "Fetching traces... " + + let! traces = explain logger context.SourceExplorer package lock + + if Seq.isEmpty traces + then + logger.Success ("There are no traces for " + (PackageIdentifier.show package) + ". ") + else + logger.Success ("Found the following traces for " + (PackageIdentifier.show package) + ": ") + + for trace in traces do + logger.Print + <| " @ " + + ( + trace + |> List.rev + |> Seq.map (fun (package, isPrivate) -> + let arrow = + if isPrivate + then + "--{private}--> " + else + "-----> " + arrow + PackageIdentifier.show package + ) + |> String.concat " " + ) + + return 0 + | None -> + logger.Warning "No lock-file is present. Run buckaroo resolve first. " + return 1 +} diff --git a/buckaroo/Logger.fs b/buckaroo/Logger.fs index eb4f02a..4a65c5b 100644 --- a/buckaroo/Logger.fs +++ b/buckaroo/Logger.fs @@ -6,6 +6,7 @@ open Buckaroo.RichOutput type Logger = { + Print : string -> Unit Info : string -> Unit RichInfo : RichOutput -> Unit Success : string -> Unit @@ -23,6 +24,9 @@ let createLogger (console : ConsoleManager) (componentName : string option) = |> Option.map (fun x -> "[" + x + "] " |> text |> foreground ConsoleColor.DarkGray) |> Option.defaultValue (text "") + let print (x : string) = + console.Write (componentPrefix + x, LoggingLevel.Info) + let prefix = "info " |> text @@ -71,6 +75,7 @@ let createLogger (console : ConsoleManager) (componentName : string option) = console.Write (componentPrefix + prefix + x, LoggingLevel.Info) { + Print = print Info = info RichInfo = richInfo Success = success diff --git a/buckaroo/buckaroo.fsproj b/buckaroo/buckaroo.fsproj index 41f7a99..d91db56 100644 --- a/buckaroo/buckaroo.fsproj +++ b/buckaroo/buckaroo.fsproj @@ -59,6 +59,7 @@ +