-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>moduleDistribution.Backpack.ComponentsGraph(ComponentsGraph ,ComponentsWithDeps ,mkComponentsGraph ,componentsGraphToList ,dispComponentsWithDeps ,componentCycleMsg )whereimportDistribution.Compat.PreludeimportPrelude()importDistribution.Compat.Graph(Graph,Node(..))importqualifiedDistribution.Compat.GraphasGraphimportqualifiedDistribution.Compat.NonEmptySetasNESimportDistribution.PackageimportDistribution.PackageDescriptionimportDistribution.Simple.BuildToolDepends importDistribution.Simple.LocalBuildInfo importDistribution.Types.ComponentRequestedSpecimportDistribution.Utils.GenericimportDistribution.Pretty(pretty)importText.PrettyPrint-------------------------------------------------------------------------------- Components graph-------------------------------------------------------------------------------- | A graph of source-level components by their source-level-- dependenciestypeComponentsGraph =Graph(NodeComponentNameComponent)-- | A list of components associated with the source level-- dependencies between them.typeComponentsWithDeps =[(Component,[ComponentName])]-- | Pretty-print 'ComponentsWithDeps'.dispComponentsWithDeps ::ComponentsWithDeps ->DocdispComponentsWithDeps :: ComponentsWithDeps -> Doc
dispComponentsWithDeps ComponentsWithDeps
graph =[Doc] -> Doc
vcat[Doc -> Int -> Doc -> Doc
hang(String -> Doc
textString
"component"Doc -> Doc -> Doc
<+>ComponentName -> Doc
forall a. Pretty a => a -> Doc
pretty(Component -> ComponentName
componentNameComponent
c ))Int
4([Doc] -> Doc
vcat[String -> Doc
textString
"dependency"Doc -> Doc -> Doc
<+>ComponentName -> Doc
forall a. Pretty a => a -> Doc
prettyComponentName
cdep |ComponentName
cdep <-[ComponentName]
cdeps ])|(Component
c ,[ComponentName]
cdeps )<-ComponentsWithDeps
graph ]-- | Create a 'Graph' of 'Component', or report a cycle if there is a-- problem.mkComponentsGraph ::ComponentRequestedSpec->PackageDescription->Either[ComponentName]ComponentsGraph mkComponentsGraph :: ComponentRequestedSpec
-> PackageDescription -> Either [ComponentName] ComponentsGraph
mkComponentsGraph ComponentRequestedSpec
enabled PackageDescription
pkg_descr =letg :: ComponentsGraph
g =[Node ComponentName Component] -> ComponentsGraph
forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList[Component
-> ComponentName -> [ComponentName] -> Node ComponentName Component
forall k a. a -> k -> [k] -> Node k a
NComponent
c (Component -> ComponentName
componentNameComponent
c )(Component -> [ComponentName]
componentDeps Component
c )|Component
c <-PackageDescription -> [Component]
pkgBuildableComponentsPackageDescription
pkg_descr ,ComponentRequestedSpec -> Component -> Bool
componentEnabledComponentRequestedSpec
enabled Component
c ]incaseComponentsGraph -> [[Node ComponentName Component]]
forall a. Graph a -> [[a]]
Graph.cyclesComponentsGraph
g of[]->ComponentsGraph -> Either [ComponentName] ComponentsGraph
forall a b. b -> Either a b
RightComponentsGraph
g [[Node ComponentName Component]]
ccycles ->[ComponentName] -> Either [ComponentName] ComponentsGraph
forall a b. a -> Either a b
Left[Component -> ComponentName
componentNameComponent
c |NComponent
c ComponentName
_[ComponentName]
_<-[[Node ComponentName Component]] -> [Node ComponentName Component]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat[[Node ComponentName Component]]
ccycles ]where-- The dependencies for the given componentcomponentDeps :: Component -> [ComponentName]
componentDeps Component
component =[ComponentName]
toolDependencies [ComponentName] -> [ComponentName] -> [ComponentName]
forall a. [a] -> [a] -> [a]
++[ComponentName]
libDependencies wherebi :: BuildInfo
bi =Component -> BuildInfo
componentBuildInfoComponent
component toolDependencies :: [ComponentName]
toolDependencies =UnqualComponentName -> ComponentName
CExeName(UnqualComponentName -> ComponentName)
-> [UnqualComponentName] -> [ComponentName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>PackageDescription -> BuildInfo -> [UnqualComponentName]
getAllInternalToolDependencies PackageDescription
pkg_descr BuildInfo
bi libDependencies :: [ComponentName]
libDependencies =doDependencyPackageName
pkgname VersionRange
_NonEmptySet LibraryName
lns <-BuildInfo -> [Dependency]
targetBuildDependsBuildInfo
bi Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard(PackageName
pkgname PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
==PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageNamePackageDescription
pkg_descr )LibraryName
ln <-NonEmptySet LibraryName -> [LibraryName]
forall a. NonEmptySet a -> [a]
NES.toListNonEmptySet LibraryName
lns ComponentName -> [ComponentName]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return(LibraryName -> ComponentName
CLibNameLibraryName
ln )-- | Given the package description and a 'PackageDescription' (used-- to determine if a package name is internal or not), sort the-- components in dependency order (fewest dependencies first). This is-- NOT necessarily the build order (although it is in the absence of-- Backpack.)componentsGraphToList ::ComponentsGraph ->ComponentsWithDeps componentsGraphToList :: ComponentsGraph -> ComponentsWithDeps
componentsGraphToList =(Node ComponentName Component -> (Component, [ComponentName]))
-> [Node ComponentName Component] -> ComponentsWithDeps
forall a b. (a -> b) -> [a] -> [b]
map(\(NComponent
c ComponentName
_[ComponentName]
cs )->(Component
c ,[ComponentName]
cs ))([Node ComponentName Component] -> ComponentsWithDeps)
-> (ComponentsGraph -> [Node ComponentName Component])
-> ComponentsGraph
-> ComponentsWithDeps
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ComponentsGraph -> [Node ComponentName Component]
forall a. Graph a -> [a]
Graph.revTopSort-- | Error message when there is a cycle; takes the SCC of components.componentCycleMsg ::PackageIdentifier->[ComponentName]->DoccomponentCycleMsg :: PackageIdentifier -> [ComponentName] -> Doc
componentCycleMsg PackageIdentifier
pn [ComponentName]
cnames =String -> Doc
textString
"Components in the package"Doc -> Doc -> Doc
<+>PackageIdentifier -> Doc
forall a. Pretty a => a -> Doc
prettyPackageIdentifier
pn Doc -> Doc -> Doc
<+>String -> Doc
textString
"depend on each other in a cyclic way:"Doc -> Doc -> Doc
$$String -> Doc
text(String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalateString
" depends on "[String
"'"String -> String -> String
forall a. [a] -> [a] -> [a]
++ComponentName -> String
showComponentNameComponentName
cname String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"'"|ComponentName
cname <-[ComponentName]
cnames [ComponentName] -> [ComponentName] -> [ComponentName]
forall a. [a] -> [a] -> [a]
++Maybe ComponentName -> [ComponentName]
forall a. Maybe a -> [a]
maybeToList([ComponentName] -> Maybe ComponentName
forall a. [a] -> Maybe a
safeHead[ComponentName]
cnames )])