Merge branch 'why' of https://github.com/theimowski/Paket

# Conflicts:
#	src/Paket/Commands.fs

RELEASE_NOTES.md

@@ -1,4 +1,6 @@
 #### 3.24.0-alpha001 - 22.10.2016
+* New Command: paket why - https://github.com/fsprojects/Paket/pull/1960
+* USABILITY: Bootstraper magic mode & run - https://github.com/fsprojects/Paket/pull/1961
 * USABILITY: Added option to have paket restore fail on check failure - https://github.com/fsprojects/Paket/pull/1963
 
 #### 3.23.2 - 11.10.2016

src/Paket.Core/Paket.Core.fsproj

@@ -141,6 +141,7 @@
     <Compile Include="NugetConvert.fs" />
     <Compile Include="FindOutdated.fs" />
     <Compile Include="FindReferences.fs" />
+    <Compile Include="Why.fs" />
     <Compile Include="PublicAPI.fs" />
     <Compile Include="ScriptGeneration.fs" />
     <None Include="paket.template" />

src/Paket.Core/Why.fs

@@ -0,0 +1,157 @@
+module Paket.Why
+
+open System
+
+open Paket.Domain
+open Paket.Logging
+
+open Chessie.ErrorHandling
+
+type AdjGraph<'a> = list<'a * list<'a>>
+
+let adj n (g: AdjGraph<_>) =
+    g
+    |> List.find (fst >> (=) n)
+    |> snd
+
+let rec paths start stop (g : AdjGraph<'a>) =
+    if start = stop then [[start]]
+    else
+        [ for n in adj start g do
+            for path in paths n stop g do
+                yield start :: path ]
+
+let depGraph (res : PackageResolver.PackageResolution) : AdjGraph<Domain.PackageName> =
+    res
+    |> Seq.toList
+    |> List.map (fun pair -> pair.Key, (pair.Value.Dependencies 
+                                       |> Set.map (fun (p,_,_) -> p) 
+                                       |> Set.toList))
+
+type WhyOptions = 
+    { AllPaths : bool }
+
+type DependencyChain = List<PackageName>
+
+[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
+module DependencyChain =
+    let format (chain : DependencyChain) =
+        chain
+        |> Seq.mapi (fun i name -> sprintf "%s-> %O" (String.replicate i "  ") name)
+        |> String.concat Environment.NewLine
+
+    let formatMany chains =
+        chains
+        |> Seq.map format
+        |> String.concat (String.replicate 2 Environment.NewLine)
+
+// In context of FAKE project dependencies
+type Reason =
+// e.g. Argu - specified in paket.dependencies, is not a dependency of any other package
+| TopLevel
+// e.g. Microsoft.AspNet.Razor - specified in paket.dependencies, but also a dependency of other package(s)
+| Direct of DependencyChain list
+// e.g. Microsoft.AspNet.Mvc - not specified in paket.dependencies, a dependency of other package(s)
+| Transient of DependencyChain list
+
+type InferError =
+| NuGetNotInLockFile
+| NuGetNotInGroup of groupsHavingNuGet : GroupName list
+
+[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
+module Reason =
+    let format = function
+    | TopLevel -> 
+        sprintf "direct (%s) and top-level dependency." 
+                Constants.DependenciesFileName
+    | Direct chains -> 
+        sprintf "direct (%s) dependency."
+                Constants.DependenciesFileName
+    | Transient chains -> 
+        sprintf "transient dependency."
+
+    let infer (packageName : PackageName, 
+               groupName : GroupName,
+               directDeps : Set<PackageName>, 
+               lockFile : LockFile) :
+               Result<Reason, InferError> =
+        let group = lockFile.GetGroup groupName
+        if not <| group.Resolution.ContainsKey packageName then
+            let otherGroups =
+                lockFile.Groups 
+                |> Seq.filter (fun pair -> pair.Value.Resolution.ContainsKey packageName) 
+                |> Seq.map (fun pair -> pair.Key)
+                |> Seq.toList
+            if List.isEmpty otherGroups then
+                Result.Bad [NuGetNotInLockFile]
+            else
+                Result.Bad [NuGetNotInGroup otherGroups]
+        else
+            let graph = depGraph group.Resolution
+            let topLevelDeps = 
+                lockFile.GetTopLevelDependencies groupName
+                |> Seq.map (fun pair -> pair.Key)
+                |> Set.ofSeq
+            let chains = 
+                topLevelDeps
+                |> Set.toList
+                |> List.collect (fun p -> paths p packageName graph)
+            match Set.contains packageName directDeps, Set.contains packageName topLevelDeps with
+            | true, true ->
+                Result.Succeed TopLevel
+            | true, false ->
+                Result.Succeed (Direct chains)
+            | false, false ->
+                Result.Succeed (Transient chains)
+            | false, true ->
+                failwith "impossible"
+
+let ohWhy (packageName, 
+           directDeps : Set<PackageName>, 
+           lockFile : LockFile, 
+           groupName, 
+           usage, 
+           options) =
+
+    match Reason.infer(packageName, groupName, directDeps, lockFile) with
+    | Result.Bad [NuGetNotInLockFile] ->
+        traceErrorfn "NuGet %O was not found in %s" packageName Constants.LockFileName
+    | Result.Bad [NuGetNotInGroup otherGroups] ->
+        traceWarnfn 
+            "NuGet %O was not found in %s group. However it was found in following groups: %A. Specify correct group." 
+            packageName
+            (groupName.ToString())
+            (otherGroups |> List.map (fun pair -> pair.ToString()))
+
+        usage |> traceWarn
+    | Result.Ok (reason, []) ->
+        reason
+        |> Reason.format
+        |> sprintf "NuGet %O is a %s" packageName
+        |> tracen
+
+        match reason with
+        | TopLevel -> ()
+        | Direct chains
+        | Transient chains ->
+            tracefn "It's a part of following dependency chains:"
+            tracen ""
+            for (top, chains) in chains |> List.groupBy (Seq.item 0) do
+                match chains |> List.sortBy Seq.length, options.AllPaths with
+                | shortest :: [], false ->
+                    DependencyChain.format shortest |> tracen
+                | shortest :: rest, false ->
+                    DependencyChain.format shortest |> tracen
+                    tracen ""
+                    tracefn 
+                        "... and %d path%s more starting at %O. To display all paths use --allpaths flag" 
+                        rest.Length 
+                        (if rest.Length > 1 then "s" else "") 
+                        top
+                | all, true ->
+                    DependencyChain.formatMany all |> tracen
+                | _ ->
+                    failwith "impossible"
+                tracen ""
+    | _ ->
+        failwith "impossible"

src/Paket/Commands.fs

@@ -313,6 +313,18 @@ with
         | Framework _ -> "Framework identifier to generate scripts for, such as net4 or netcore."
         | ScriptType _ -> "Language to generate scripts for, must be one of 'fsx' or 'csx'."
 
+type WhyArgs =
+    | [<CustomCommandLine("nuget")>][<Mandatory>] NuGet of package_id:string
+    | [<CustomCommandLine("group")>] Group of name:string
+    | AllPaths
+with
+  interface IArgParserTemplate with
+      member this.Usage = 
+        match this with
+        | NuGet _ -> "Name of the NuGet package."
+        | Group _ -> "Allows to specify the dependency group."
+        | AllPaths -> "Display all paths found from a top level dependency"
+
 type Command =
     // global options
     | [<AltCommandLine("-v"); Inherit>]                 Verbose
@@ -341,6 +353,7 @@ type Command =
     | [<CustomCommandLine("pack")>]                     Pack of ParseResults<PackArgs>
     | [<CustomCommandLine("push")>]                     Push of ParseResults<PushArgs>
     | [<CustomCommandLine("generate-include-scripts")>] GenerateIncludeScripts of ParseResults<GenerateIncludeScriptsArgs>
+    | [<CustomCommandLine("why")>]                      Why of ParseResults<WhyArgs>
 with
     interface IArgParserTemplate with
         member this.Usage =
@@ -365,6 +378,7 @@ with
             | Pack _ -> "Packs all paket.template files within this repository."
             | Push _ -> "Pushes the given `.nupkg` file."
             | GenerateIncludeScripts _ -> "Allows to generate C# and F# include scripts which references installed packages in a interactive environment like F# Interactive or ScriptCS."
+            | Why _ -> "Prints user-friendly reason for referencing a specified package"
             | Log_File _ -> "Specify a log file for the paket process."
             | Silent -> "Suppress console output for the paket process."
             | Verbose -> "Enable verbose console output for the paket process." 

src/Paket/Program.fs

@@ -354,6 +354,24 @@ let generateIncludeScripts (results : ParseResults<GenerateIncludeScriptsArgs>)
         for scriptType in scriptTypesToGenerate do
             Paket.LoadingScripts.ScriptGeneration.generateScriptsForRootFolder scriptType framework rootFolder
 
+let why (results: ParseResults<WhyArgs>) =
+    let packageName = results.GetResult <@ WhyArgs.NuGet @> |> Domain.PackageName
+    let groupName = 
+        defaultArg 
+            (results.TryGetResult <@ WhyArgs.Group @> |> Option.map Domain.GroupName) 
+            Constants.MainDependencyGroup
+    let dependencies = Dependencies.Locate()
+    let lockFile = dependencies.GetLockFile()
+    let directDeps = 
+        dependencies
+            .GetDependenciesFile()
+            .GetDependenciesInGroup(groupName)
+            |> Seq.map (fun pair -> pair.Key)
+            |> Set.ofSeq
+    let options = 
+        { Why.WhyOptions.AllPaths = results.Contains <@ WhyArgs.AllPaths @> }
+
+    Why.ohWhy(packageName, directDeps, lockFile, groupName, results.Parser.PrintUsage(), options)
 
 let main() =
     use consoleTrace = Logging.event.Publish |> Observable.subscribe Logging.traceToConsole
@@ -405,7 +423,8 @@ let main() =
             | ShowGroups r -> processCommand silent showGroups r
             | Pack r -> processCommand silent pack r
             | Push r -> processCommand silent push r
-            | GenerateIncludeScripts r -> processCommand silent generateIncludeScripts r            
+            | GenerateIncludeScripts r -> processCommand silent generateIncludeScripts r
+            | Why r -> processCommand silent why r
             // global options; list here in order to maintain compiler warnings
             // in case of new subcommands added
             | Verbose