    -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
    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

    ------------------------------------------------------------------------------
    -- Components graph
    ------------------------------------------------------------------------------

    -- | A graph of source-level components by their source-level
    -- dependencies
    --
    type ComponentsGraph = Graph (Node ComponentName Component)

    -- | A list of components associated with the source level
    -- dependencies between them.
    --
    type ComponentsWithDeps = [(Component, [ComponentName])]

    -- | Pretty-print 'ComponentsWithDeps'.
    --
    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
    <+> ComponentName -> 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
    <+> ComponentName -> Doc
    forall a. Pretty a => a -> Doc
    pretty ComponentName
    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 =
        let g :: 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
    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 ComponentsGraph -> [[Node ComponentName Component]]
    forall a. Graph a -> [[a]]
    Graph.cycles ComponentsGraph
    g of
              []     -> ComponentsGraph -> Either [ComponentName] ComponentsGraph
    forall a b. b -> Either a b
    Right ComponentsGraph
    g
              [[Node ComponentName Component]]
    ccycles -> [ComponentName] -> Either [ComponentName] ComponentsGraph
    forall a b. a -> Either a b
    Left  [ Component -> ComponentName
    componentName Component
    c | N Component
    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 component
        componentDeps :: Component -> [ComponentName]
    componentDeps Component
    component =
            [ComponentName]
    toolDependencies [ComponentName] -> [ComponentName] -> [ComponentName]
    forall a. [a] -> [a] -> [a]
    ++ [ComponentName]
    libDependencies
          where
            bi :: BuildInfo
    bi = Component -> BuildInfo
    componentBuildInfo Component
    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 = do
                Dependency PackageName
    pkgname VersionRange
    _ NonEmptySet LibraryName
    lns <- BuildInfo -> [Dependency]
    targetBuildDepends BuildInfo
    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
    packageName PackageDescription
    pkg_descr)

                LibraryName
    ln <- NonEmptySet LibraryName -> [LibraryName]
    forall a. NonEmptySet a -> [a]
    NES.toList NonEmptySet LibraryName
    lns
                ComponentName -> [ComponentName]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LibraryName -> ComponentName
    CLibName LibraryName
    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 (\(N Component
    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] -> Doc
    componentCycleMsg :: PackageIdentifier -> [ComponentName] -> Doc
    componentCycleMsg PackageIdentifier
    pn [ComponentName]
    cnames =
        String -> Doc
    text String
    "Components in the package" Doc -> Doc -> Doc
    <+> PackageIdentifier -> 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 (String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    " depends on "
                [ String
    "'" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ComponentName -> String
    showComponentName ComponentName
    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) ])