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 graph =
vcat [ hang (text "component" <+> pretty (componentName c)) 4
(vcat [ text "dependency" <+> pretty cdep | cdep <- cdeps ])
| (c, cdeps) <- graph ]
mkComponentsGraph :: ComponentRequestedSpec
-> PackageDescription
-> Either [ComponentName] ComponentsGraph
mkComponentsGraph enabled pkg_descr =
let g = Graph.fromDistinctList
[ N c (componentName c) (componentDeps c)
| c <- pkgBuildableComponents pkg_descr
, componentEnabled enabled c ]
in case Graph.cycles g of
[] -> Right g
ccycles -> Left [ componentName c | N c _ _ <- concat ccycles ]
where
componentDeps component =
toolDependencies ++ libDependencies
where
bi = componentBuildInfo component
toolDependencies = CExeName <$> getAllInternalToolDependencies pkg_descr bi
libDependencies = do
Dependency pkgname _ lns <- targetBuildDepends bi
guard (pkgname == packageName pkg_descr)
ln <- NES.toList lns
return (CLibName ln)
componentsGraphToList :: ComponentsGraph
-> ComponentsWithDeps
componentsGraphToList =
map (\(N c _ cs) -> (c, cs)) . Graph.revTopSort
componentCycleMsg :: PackageIdentifier -> [ComponentName] -> Doc
componentCycleMsg pn cnames =
text "Components in the package" <+> pretty pn <+> text "depend on each other in a cyclic way:"
$$
text (intercalate " depends on "
[ "'" ++ showComponentName cname ++ "'"
| cname <- cnames ++ maybeToList (safeHead cnames) ])