@@ -13,12 +13,13 @@ import App.Fossa.VSI.IAT.Types (
13
13
import App.Fossa.VSI.IAT.Types qualified as IAT
14
14
import App.Fossa.VSI.Types qualified as VSI
15
15
import Control.Algebra (Has )
16
- import Control.Effect.Diagnostics (Diagnostics , context , fatalText , recover )
16
+ import Control.Effect.Diagnostics (Diagnostics , context , recover , warn )
17
17
import Control.Effect.FossaApiClient (FossaApiClient , resolveProjectDependencies , resolveUserDefinedBinary )
18
- import Data.Maybe (fromMaybe , isNothing )
18
+ import Control.Monad (unless )
19
+ import Data.Either (partitionEithers )
19
20
import Data.String.Conversion (toText )
20
21
import Data.Text (Text , intercalate )
21
- import Graphing (Graphing , direct , edges , empty )
22
+ import Graphing (Graphing , direct , edges )
22
23
import Srclib.Types (
23
24
SourceUserDefDep (.. ),
24
25
)
@@ -48,30 +49,29 @@ resolveGraph locators skipResolving = context ("Resolving graph for " <> toText
48
49
-- This typically means that the user doesn't have access to the project, or the project doesn't exist.
49
50
-- Collect failed locators and report them to the user, along with mitigation suggestions.
50
51
subgraphs <- traverseZipM (resolveSubgraph skipResolving) locators
51
- if any resolutionFailed subgraphs
52
- then fatalText $ resolveGraphFailureBundle subgraphs
53
- else pure . mconcat $ fmap unwrap subgraphs
52
+ let (warned, success) = partitionMap partitionSubgraph subgraphs
53
+ renderWarnings warned
54
+ pure $ mconcat success
54
55
where
55
- resolutionFailed (_, b) = isNothing b
56
- unwrap (_, b) = fromMaybe empty b
56
+ renderWarnings subgraphs = unless (null subgraphs) . warn $ resolveGraphFailureBundle subgraphs
57
+ partitionSubgraph (a, Nothing ) = Left a
58
+ partitionSubgraph (_, Just b) = Right b
57
59
58
- resolveGraphFailureBundle :: [( VSI. Locator, Maybe ( Graphing VSI. Locator )) ] -> Text
60
+ resolveGraphFailureBundle :: [VSI. Locator ] -> Text
59
61
resolveGraphFailureBundle subgraphs =
60
62
" Failed to resolve dependencies for the following FOSSA projects:\n\t "
61
- <> intercalate " \n\t " (renderFailed subgraphs)
63
+ <> intercalate " \n\t " (fmap VSI. renderLocator subgraphs)
62
64
<> " \n\n "
63
- <> " You may not have access to the projects, or they may not exist (see the warnings below for details).\n "
64
- <> " If desired you can use --experimental-skip-vsi-graph to skip resolving the dependencies of these projects."
65
- where
66
- renderFailed [] = []
67
- renderFailed ((a, b) : xs) = case b of
68
- Just _ -> renderFailed xs
69
- Nothing -> VSI. renderLocator a : renderFailed xs
65
+ <> " You may not have access to the projects, or they may not exist.\n "
70
66
71
67
-- | Given a traverseable list and a monadic function that resolves them to b, traverse and zip the list into a pair of (a, b)
72
68
traverseZipM :: (Traversable t , Applicative m ) => (a -> m b ) -> t a -> m (t (a , b ))
73
69
traverseZipM f = traverse (\ a -> (a,) <$> f a)
74
70
71
+ -- | Split the list into two mapped lists based on the predicate.
72
+ partitionMap :: (a -> Either b c ) -> [a ] -> ([b ], [c ])
73
+ partitionMap split items = partitionEithers $ map split items
74
+
75
75
-- Pass through the list of skipped locators all the way here:
76
76
-- we want to still record the direct dependency, we just don't want to resolve it.
77
77
resolveSubgraph :: (Has FossaApiClient sig m , Has Diagnostics sig m ) => VSI. SkipResolution -> VSI. Locator -> m (Maybe (Graphing VSI. Locator ))
0 commit comments