Recommend package-preserving upgrade paths

Author: thomashoneyman

scripts/src/PackageSetPlanner.purs

@@ -59,6 +59,7 @@ type AutomaticPlan =
 
 type ManualIntervention =
   { compilerError :: Maybe String
+  , directBlockers :: Array PackageName
   , packages :: Map PackageName Version
   , removals :: Array PackageName
   , targets :: Array PackageName
@@ -80,8 +81,8 @@ data ProbeResult
 derive instance Eq ProbeResult
 
 data ManualRemovalResult
-  = RemovalVerified Int (Set PackageName) (Array String)
-  | RemovalFailed Int (Set PackageName) (Array String)
+  = RemovalVerified Int (Set PackageName) (Set PackageName) (Array String)
+  | RemovalFailed Int (Set PackageName) (Set PackageName) (Array String)
   | RemovalAnalysisFailed Int String
   | RemovalSearchTruncated Int
 
@@ -545,6 +546,7 @@ planManualInterventions probe packageSet manifests components automatic = go emp
                           { attempts = state.attempts + 1
                           , interventions = state.interventions <>
                               [ { compilerError: Just compilerError
+                                , directBlockers: Array.fromFoldable seeds
                                 , packages
                                 , removals: []
                                 , targets: Array.fromFoldable $ Map.keys latest
@@ -558,13 +560,14 @@ planManualInterventions probe packageSet manifests components automatic = go emp
                       )
                       rest
                   else do
-                    probeManualRemovals probe packageSet manifests packages removals (state.attempts + 1) >>= case _ of
-                      RemovalVerified attempts verifiedRemovals additionalEvidence ->
+                    probeManualRemovals probe packageSet manifests packages seeds removals (state.attempts + 1) >>= case _ of
+                      RemovalVerified attempts directBlockers verifiedRemovals additionalEvidence ->
                         go
                           ( state
                               { attempts = attempts
                               , interventions = state.interventions <>
                                   [ { compilerError: Just $ combineCompilerEvidence compilerError additionalEvidence
+                                    , directBlockers: Array.fromFoldable directBlockers
                                     , packages
                                     , removals: Array.fromFoldable verifiedRemovals
                                     , targets: Array.fromFoldable $ Map.keys latest
@@ -574,12 +577,13 @@ planManualInterventions probe packageSet manifests components automatic = go emp
                               }
                           )
                           rest
-                      RemovalFailed attempts failedRemovals additionalEvidence ->
+                      RemovalFailed attempts directBlockers failedRemovals additionalEvidence ->
                         go
                           ( state
                               { attempts = attempts
                               , interventions = state.interventions <>
                                   [ { compilerError: Just $ combineCompilerEvidence compilerError additionalEvidence
+                                    , directBlockers: Array.fromFoldable directBlockers
                                     , packages
                                     , removals: Array.fromFoldable failedRemovals
                                     , targets: Array.fromFoldable $ Map.keys latest
@@ -607,33 +611,35 @@ probeManualRemovals
   -> ManifestIndex
   -> Map PackageName Version
   -> Set PackageName
+  -> Set PackageName
   -> Int
   -> Run r ManualRemovalResult
 probeManualRemovals probe packageSet manifests packages = go []
   where
   proposed = applyUpdates packageSet packages
 
-  go evidence removals attempts
+  go evidence directBlockers removals attempts
     | attempts >= manualProbeBudget = pure $ RemovalSearchTruncated attempts
     | otherwise = do
         let changes = map PackageSets.Update packages
         let removalChanges = Map.union (map (const PackageSets.Remove) (Map.fromFoldable (map (\name -> Tuple name unit) (Array.fromFoldable removals)))) changes
         probe packageSet removalChanges >>= case _ of
-          Compiles -> pure $ RemovalVerified (attempts + 1) removals evidence
+          Compiles -> pure $ RemovalVerified (attempts + 1) directBlockers removals evidence
           InfrastructureFailure error -> pure $ RemovalAnalysisFailed (attempts + 1) error
           CompilationFailure error -> do
             let nextEvidence = evidence <> [ error ]
             let remaining = Foldable.foldr Map.delete proposed removals
             let seeds = compilerFailurePackages packageSet packages error
+            let nextDirectBlockers = Set.union directBlockers seeds
             case reverseDependencyClosure remaining manifests seeds of
               Left analysisError -> pure $ RemovalAnalysisFailed (attempts + 1) analysisError
               Right closure -> do
                 let additions = Set.difference closure (Map.keys packages)
                 let next = Set.union removals additions
                 if next == removals then
-                  pure $ RemovalFailed (attempts + 1) removals nextEvidence
+                  pure $ RemovalFailed (attempts + 1) nextDirectBlockers removals nextEvidence
                 else
-                  go nextEvidence next (attempts + 1)
+                  go nextEvidence nextDirectBlockers next (attempts + 1)
 
 combineCompilerEvidence :: String -> Array String -> String
 combineCompilerEvidence initial additional =