Cabal/src/Distribution/Backpack/ComponentsGraph.hs

   1 -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
   2 module Distribution.Backpack.ComponentsGraph
   3   ( ComponentsGraph
   4   , ComponentsWithDeps
   5   , mkComponentsGraph
   6   , componentsGraphToList
   7   , dispComponentsWithDeps
   8   , componentCycleMsg
   9   ) where
  10
  11 import Distribution.Compat.Prelude
  12 import Prelude ()
  13
  14 import Distribution.Compat.Graph (Graph, Node (..))
  15 import qualified Distribution.Compat.Graph as Graph
  16 import qualified Distribution.Compat.NonEmptySet as NES
  17 import Distribution.Package
  18 import Distribution.PackageDescription
  19 import Distribution.Simple.BuildToolDepends
  20 import Distribution.Simple.LocalBuildInfo
  21 import Distribution.Types.ComponentRequestedSpec
  22 import Distribution.Utils.Generic
  23
  24 import Distribution.Pretty (pretty)
  25 import Text.PrettyPrint
  26
  27 ------------------------------------------------------------------------------
  28 -- Components graph
  29 ------------------------------------------------------------------------------
  30
  31 -- | A graph of source-level components by their source-level
  32 -- dependencies
  33 type ComponentsGraph = Graph (Node ComponentName Component)
  34
  35 -- | A list of components associated with the source level
  36 -- dependencies between them.
  37 type ComponentsWithDeps = [(Component, [ComponentName])]
  38
  39 -- | Pretty-print 'ComponentsWithDeps'.
  40 dispComponentsWithDeps :: ComponentsWithDeps -> Doc
  41 dispComponentsWithDeps graph =
  42   vcat
  43     [ hang
  44       (text "component" <+> pretty (componentName c))
  45       4
  46       (vcat [text "dependency" <+> pretty cdep | cdep <- cdeps])
  47     | (c, cdeps) <- graph
  48     ]
  49
  50 -- | Create a 'Graph' of 'Component', or report a cycle if there is a
  51 -- problem.
  52 mkComponentsGraph
  53   :: ComponentRequestedSpec
  54   -> PackageDescription
  55   -> Either [ComponentName] ComponentsGraph
  56 mkComponentsGraph enabled pkg_descr =
  57   let g =
  58         Graph.fromDistinctList
  59           [ N c (componentName c) (componentDeps c)
  60           | c <- pkgBuildableComponents pkg_descr
  61           , componentEnabled enabled c
  62           ]
  63    in case Graph.cycles g of
  64         [] -> Right g
  65         ccycles -> Left [componentName c | N c _ _ <- concat ccycles]
  66   where
  67     -- The dependencies for the given component
  68     componentDeps component =
  69       toolDependencies ++ libDependencies
  70       where
  71         bi = componentBuildInfo component
  72
  73         toolDependencies = CExeName <$> getAllInternalToolDependencies pkg_descr bi
  74
  75         libDependencies = do
  76           Dependency pkgname _ lns <- targetBuildDepends bi
  77           guard (pkgname == packageName pkg_descr)
  78
  79           ln <- NES.toList lns
  80           return (CLibName ln)
  81
  82 -- | Given the package description and a 'PackageDescription' (used
  83 -- to determine if a package name is internal or not), sort the
  84 -- components in dependency order (fewest dependencies first).  This is
  85 -- NOT necessarily the build order (although it is in the absence of
  86 -- Backpack.)
  87 componentsGraphToList
  88   :: ComponentsGraph
  89   -> ComponentsWithDeps
  90 componentsGraphToList =
  91   map (\(N c _ cs) -> (c, cs)) . Graph.revTopSort
  92
  93 -- | Error message when there is a cycle; takes the SCC of components.
  94 componentCycleMsg :: PackageIdentifier -> [ComponentName] -> Doc
  95 componentCycleMsg pn cnames =
  96   text "Components in the package"
  97     <+> pretty pn
  98     <+> text "depend on each other in a cyclic way:"
  99     $$ text
 100       ( intercalate
 101           " depends on "
 102           [ "'" ++ showComponentName cname ++ "'"
 103           | cname <- cnames ++ maybeToList (safeHead cnames)
 104           ]
 105       )