Merge pull request #355 from LoopPerfect/feature/bazel-explain

feature/bazel-explain

buckaroo/Command.fs

@@ -17,6 +17,7 @@ type Command =
   | UpgradeDependencies of List<PackageIdentifier>
   | AddDependencies of List<Dependency>
   | RemoveDependencies of List<PackageIdentifier>
+  | 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<Command, Unit> = 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
   }

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
+}

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

buckaroo/buckaroo.fsproj

@@ -59,6 +59,7 @@
     <Compile Include="QuickstartCommand.fs" />
     <Compile Include="AddCommand.fs" />
     <Compile Include="UpgradeCommand.fs" />
+    <Compile Include="ExplainCommand.fs" />
     <Compile Include="VersionCommand.fs" />
     <Compile Include="ShowCompletions.fs" />
     <Compile Include="Command.fs" />