module Distribution.Backpack.ComponentsGraph (
ComponentsGraph,
ComponentsWithDeps,
mkComponentsGraph,
componentsGraphToList,
dispComponentsWithDeps,
componentCycleMsg
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Package
import Distribution.PackageDescription
import Distribution.Simple.BuildToolDepends
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.ComponentRequestedSpec
import Distribution.Compat.Graph (Graph, Node(..))
import qualified Distribution.Compat.Graph as Graph
import qualified Distribution.Compat.NonEmptySet as NES
import Distribution.Utils.Generic
import Distribution.Pretty (pretty)
import Text.PrettyPrint
type ComponentsGraph = Graph (Node ComponentName Component)
type ComponentsWithDeps = [(Component, [ComponentName])]
dispComponentsWithDeps :: ComponentsWithDeps -> Doc
dispComponentsWithDeps :: ComponentsWithDeps -> Doc
dispComponentsWithDeps ComponentsWithDeps
graph =
[Doc] -> Doc
vcat [ Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"component" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty (Component -> ComponentName
componentName Component
c)) Int
4
([Doc] -> Doc
vcat [ String -> Doc
text String
"dependency" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty ComponentName
cdep | ComponentName
cdep <- [ComponentName]
cdeps ])
| (Component
c, [ComponentName]
cdeps) <- ComponentsWithDeps
graph ]
mkComponentsGraph :: ComponentRequestedSpec
-> PackageDescription
-> Either [ComponentName] ComponentsGraph
mkComponentsGraph :: ComponentRequestedSpec
-> PackageDescription -> Either [ComponentName] ComponentsGraph
mkComponentsGraph ComponentRequestedSpec
enabled PackageDescription
pkg_descr =
let g :: ComponentsGraph
g = forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList
[ forall k a. a -> k -> [k] -> Node k a
N Component
c (Component -> ComponentName
componentName Component
c) (Component -> [ComponentName]
componentDeps Component
c)
| Component
c <- PackageDescription -> [Component]
pkgBuildableComponents PackageDescription
pkg_descr
, ComponentRequestedSpec -> Component -> Bool
componentEnabled ComponentRequestedSpec
enabled Component
c ]
in case forall a. Graph a -> [[a]]
Graph.cycles ComponentsGraph
g of
[] -> forall a b. b -> Either a b
Right ComponentsGraph
g
[[Node ComponentName Component]]
ccycles -> forall a b. a -> Either a b
Left [ Component -> ComponentName
componentName Component
c | N Component
c ComponentName
_ [ComponentName]
_ <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Node ComponentName Component]]
ccycles ]
where
componentDeps :: Component -> [ComponentName]
componentDeps Component
component =
[ComponentName]
toolDependencies forall a. [a] -> [a] -> [a]
++ [ComponentName]
libDependencies
where
bi :: BuildInfo
bi = Component -> BuildInfo
componentBuildInfo Component
component
toolDependencies :: [ComponentName]
toolDependencies = UnqualComponentName -> ComponentName
CExeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> BuildInfo -> [UnqualComponentName]
getAllInternalToolDependencies PackageDescription
pkg_descr BuildInfo
bi
libDependencies :: [ComponentName]
libDependencies = do
Dependency PackageName
pkgname VersionRange
_ NonEmptySet LibraryName
lns <- BuildInfo -> [Dependency]
targetBuildDepends BuildInfo
bi
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (PackageName
pkgname forall a. Eq a => a -> a -> Bool
== forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg_descr)
LibraryName
ln <- forall a. NonEmptySet a -> [a]
NES.toList NonEmptySet LibraryName
lns
forall (m :: * -> *) a. Monad m => a -> m a
return (LibraryName -> ComponentName
CLibName LibraryName
ln)
componentsGraphToList :: ComponentsGraph
-> ComponentsWithDeps
componentsGraphToList :: ComponentsGraph -> ComponentsWithDeps
componentsGraphToList =
forall a b. (a -> b) -> [a] -> [b]
map (\(N Component
c ComponentName
_ [ComponentName]
cs) -> (Component
c, [ComponentName]
cs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Graph a -> [a]
Graph.revTopSort
componentCycleMsg :: PackageIdentifier -> [ComponentName] -> Doc
componentCycleMsg :: PackageIdentifier -> [ComponentName] -> Doc
componentCycleMsg PackageIdentifier
pn [ComponentName]
cnames =
String -> Doc
text String
"Components in the package" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty PackageIdentifier
pn Doc -> Doc -> Doc
<+> String -> Doc
text String
"depend on each other in a cyclic way:"
Doc -> Doc -> Doc
$$
String -> Doc
text (forall a. [a] -> [[a]] -> [a]
intercalate String
" depends on "
[ String
"'" forall a. [a] -> [a] -> [a]
++ ComponentName -> String
showComponentName ComponentName
cname forall a. [a] -> [a] -> [a]
++ String
"'"
| ComponentName
cname <- [ComponentName]
cnames forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList (forall a. [a] -> Maybe a
safeHead [ComponentName]
cnames) ])