    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE NondecreasingIndentation #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE PatternGuards #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE NoMonoLocalBinds #-}

    -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
    --
    -- WARNING: The contents of this module are HIGHLY experimental.
    -- We may refactor it under you.
    module Distribution.Backpack.Configure
      ( configureComponentLocalBuildInfos
      ) where

    import Distribution.Compat.Prelude hiding ((<>))
    import Prelude ()

    import Distribution.Backpack
    import Distribution.Backpack.ComponentsGraph
    import Distribution.Backpack.ConfiguredComponent
    import Distribution.Backpack.FullUnitId
    import Distribution.Backpack.Id
    import Distribution.Backpack.LinkedComponent
    import Distribution.Backpack.PreExistingComponent
    import Distribution.Backpack.ReadyComponent

    import Distribution.Backpack.ModuleShape
    import Distribution.Compat.Graph (Graph, IsNode (..))
    import qualified Distribution.Compat.Graph as Graph
    import Distribution.InstalledPackageInfo
      ( InstalledPackageInfo
      , emptyInstalledPackageInfo
      )
    import qualified Distribution.InstalledPackageInfo as Installed
    import Distribution.ModuleName
    import Distribution.Package
    import Distribution.PackageDescription
    import Distribution.Simple.Compiler
    import Distribution.Simple.Flag
    import Distribution.Simple.LocalBuildInfo
    import Distribution.Simple.PackageIndex (InstalledPackageIndex)
    import qualified Distribution.Simple.PackageIndex as PackageIndex
    import Distribution.Types.AnnotatedId
    import Distribution.Types.ComponentInclude
    import Distribution.Types.ComponentRequestedSpec
    import Distribution.Types.MungedPackageName
    import Distribution.Utils.LogProgress
    import Distribution.Verbosity

    import Data.Either
      ( lefts
      )
    import qualified Data.Map as Map
    import qualified Data.Set as Set
    import Distribution.Pretty
    import Text.PrettyPrint

    ------------------------------------------------------------------------------
    -- Pipeline
    ------------------------------------------------------------------------------

    configureComponentLocalBuildInfos
      :: Verbosity
      -> Bool -- use_external_internal_deps
      -> ComponentRequestedSpec
      -> Bool -- deterministic
      -> Flag String -- configIPID
      -> Flag ComponentId -- configCID
      -> PackageDescription
      -> ([PreExistingComponent], [PromisedComponent])
      -> FlagAssignment -- configConfigurationsFlags
      -> [(ModuleName, Module)] -- configInstantiateWith
      -> InstalledPackageIndex
      -> Compiler
      -> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
    configureComponentLocalBuildInfos :: Verbosity
    -> Bool
    -> ComponentRequestedSpec
    -> Bool
    -> Flag [Char]
    -> Flag ComponentId
    -> PackageDescription
    -> ([PreExistingComponent], [PromisedComponent])
    -> FlagAssignment
    -> [(ModuleName, Module)]
    -> InstalledPackageIndex
    -> Compiler
    -> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
    configureComponentLocalBuildInfos
      Verbosity
    verbosity
      Bool
    use_external_internal_deps
      ComponentRequestedSpec
    enabled
      Bool
    deterministic
      Flag [Char]
    ipid_flag
      Flag ComponentId
    cid_flag
      PackageDescription
    pkg_descr
      ([PreExistingComponent]
    prePkgDeps, [PromisedComponent]
    promisedPkgDeps)
      FlagAssignment
    flags
      [(ModuleName, Module)]
    instantiate_with
      InstalledPackageIndex
    installedPackageSet
      Compiler
    comp = do
        -- NB: In single component mode, this returns a *single* component.
        -- In this graph, the graph is NOT closed.
        graph0 <- case ComponentRequestedSpec
    -> PackageDescription -> Either [ComponentName] ComponentsGraph
    mkComponentsGraph ComponentRequestedSpec
    enabled PackageDescription
    pkg_descr of
          Left [ComponentName]
    ccycle -> Doc -> LogProgress ComponentsWithDeps
    forall a. Doc -> LogProgress a
    dieProgress (PackageIdentifier -> [ComponentName] -> Doc
    componentCycleMsg (PackageDescription -> PackageIdentifier
    package PackageDescription
    pkg_descr) [ComponentName]
    ccycle)
          Right ComponentsGraph
    g -> ComponentsWithDeps -> LogProgress ComponentsWithDeps
    forall a. a -> LogProgress a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ComponentsGraph -> ComponentsWithDeps
    componentsGraphToList ComponentsGraph
    g)
        infoProgress $
          hang
            (text "Source component graph:")
            4
            (dispComponentsWithDeps graph0)

        let conf_pkg_map =
              (Map ComponentName (AnnotatedId ComponentId)
     -> Map ComponentName (AnnotatedId ComponentId)
     -> Map ComponentName (AnnotatedId ComponentId))
    -> [(PackageName, Map ComponentName (AnnotatedId ComponentId))]
    -> Map PackageName (Map ComponentName (AnnotatedId ComponentId))
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith
                Map ComponentName (AnnotatedId ComponentId)
    -> Map ComponentName (AnnotatedId ComponentId)
    -> Map ComponentName (AnnotatedId ComponentId)
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    Map.union
                [ ( PreExistingComponent -> PackageName
    pc_pkgname PreExistingComponent
    pkg
                  , ComponentName
    -> AnnotatedId ComponentId
    -> Map ComponentName (AnnotatedId ComponentId)
    forall k a. k -> a -> Map k a
    Map.singleton
                      (PreExistingComponent -> ComponentName
    pc_compname PreExistingComponent
    pkg)
                      ( AnnotatedId
                          { ann_id :: ComponentId
    ann_id = PreExistingComponent -> ComponentId
    pc_cid PreExistingComponent
    pkg
                          , ann_pid :: PackageIdentifier
    ann_pid = PreExistingComponent -> PackageIdentifier
    forall pkg. Package pkg => pkg -> PackageIdentifier
    packageId PreExistingComponent
    pkg
                          , ann_cname :: ComponentName
    ann_cname = PreExistingComponent -> ComponentName
    pc_compname PreExistingComponent
    pkg
                          }
                      )
                  )
                | PreExistingComponent
    pkg <- [PreExistingComponent]
    prePkgDeps
                ]
                Map PackageName (Map ComponentName (AnnotatedId ComponentId))
    -> Map PackageName (Map ComponentName (AnnotatedId ComponentId))
    -> Map PackageName (Map ComponentName (AnnotatedId ComponentId))
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    `Map.union` (Map ComponentName (AnnotatedId ComponentId)
     -> Map ComponentName (AnnotatedId ComponentId)
     -> Map ComponentName (AnnotatedId ComponentId))
    -> [(PackageName, Map ComponentName (AnnotatedId ComponentId))]
    -> Map PackageName (Map ComponentName (AnnotatedId ComponentId))
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith
                  Map ComponentName (AnnotatedId ComponentId)
    -> Map ComponentName (AnnotatedId ComponentId)
    -> Map ComponentName (AnnotatedId ComponentId)
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    Map.union
                  [ (PackageName
    pkg, ComponentName
    -> AnnotatedId ComponentId
    -> Map ComponentName (AnnotatedId ComponentId)
    forall k a. k -> a -> Map k a
    Map.singleton (AnnotatedId ComponentId -> ComponentName
    forall id. AnnotatedId id -> ComponentName
    ann_cname AnnotatedId ComponentId
    aid) AnnotatedId ComponentId
    aid)
                  | PromisedComponent PackageName
    pkg AnnotatedId ComponentId
    aid <- [PromisedComponent]
    promisedPkgDeps
                  ]
        graph1 <-
          toConfiguredComponents
            use_external_internal_deps
            flags
            deterministic
            ipid_flag
            cid_flag
            pkg_descr
            conf_pkg_map
            (map fst graph0)
        infoProgress $
          hang
            (text "Configured component graph:")
            4
            (vcat (map dispConfiguredComponent graph1))

        let shape_pkg_map =
              [(ComponentId, (OpenUnitId, ModuleShape))]
    -> Map ComponentId (OpenUnitId, ModuleShape)
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList
                [ (PreExistingComponent -> ComponentId
    pc_cid PreExistingComponent
    pkg, (PreExistingComponent -> OpenUnitId
    pc_open_uid PreExistingComponent
    pkg, PreExistingComponent -> ModuleShape
    pc_shape PreExistingComponent
    pkg))
                | PreExistingComponent
    pkg <- [PreExistingComponent]
    prePkgDeps
                ]
                Map ComponentId (OpenUnitId, ModuleShape)
    -> Map ComponentId (OpenUnitId, ModuleShape)
    -> Map ComponentId (OpenUnitId, ModuleShape)
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    `Map.union` [(ComponentId, (OpenUnitId, ModuleShape))]
    -> Map ComponentId (OpenUnitId, ModuleShape)
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList
                  [ ( AnnotatedId ComponentId -> ComponentId
    forall id. AnnotatedId id -> id
    ann_id AnnotatedId ComponentId
    aid
                    ,
                      ( DefUnitId -> OpenUnitId
    DefiniteUnitId
                          ( UnitId -> DefUnitId
    unsafeMkDefUnitId
                              ([Char] -> UnitId
    mkUnitId (ComponentId -> [Char]
    unComponentId (AnnotatedId ComponentId -> ComponentId
    forall id. AnnotatedId id -> id
    ann_id AnnotatedId ComponentId
    aid)))
                          )
                      , ModuleShape
    emptyModuleShape
                      )
                    )
                  | PromisedComponent PackageName
    _ AnnotatedId ComponentId
    aid <- [PromisedComponent]
    promisedPkgDeps
                  ]
            uid_lookup DefUnitId
    def_uid
              | Just InstalledPackageInfo
    pkg <- InstalledPackageIndex -> UnitId -> Maybe InstalledPackageInfo
    forall a. PackageIndex a -> UnitId -> Maybe a
    PackageIndex.lookupUnitId InstalledPackageIndex
    installedPackageSet UnitId
    uid =
                  ComponentId -> OpenModuleSubst -> FullUnitId
    FullUnitId
                    (InstalledPackageInfo -> ComponentId
    Installed.installedComponentId InstalledPackageInfo
    pkg)
                    ([(ModuleName, OpenModule)] -> OpenModuleSubst
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList (InstalledPackageInfo -> [(ModuleName, OpenModule)]
    Installed.instantiatedWith InstalledPackageInfo
    pkg))
              | Bool
    otherwise = [Char] -> FullUnitId
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "uid_lookup: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ UnitId -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow UnitId
    uid)
              where
                uid :: UnitId
    uid = DefUnitId -> UnitId
    unDefUnitId DefUnitId
    def_uid
        graph2 <-
          toLinkedComponents
            verbosity
            (not (null promisedPkgDeps))
            uid_lookup
            (package pkg_descr)
            shape_pkg_map
            graph1

        infoProgress $
          hang
            (text "Linked component graph:")
            4
            (vcat (map dispLinkedComponent graph2))

        let pid_map =
              [(UnitId, MungedPackageId)] -> Map UnitId MungedPackageId
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(UnitId, MungedPackageId)] -> Map UnitId MungedPackageId)
    -> [(UnitId, MungedPackageId)] -> Map UnitId MungedPackageId
    forall a b. (a -> b) -> a -> b
    $
                [ (PreExistingComponent -> UnitId
    pc_uid PreExistingComponent
    pkg, PreExistingComponent -> MungedPackageId
    pc_munged_id PreExistingComponent
    pkg)
                | PreExistingComponent
    pkg <- [PreExistingComponent]
    prePkgDeps
                ]
                  [(UnitId, MungedPackageId)]
    -> [(UnitId, MungedPackageId)] -> [(UnitId, MungedPackageId)]
    forall a. [a] -> [a] -> [a]
    ++ [ (InstalledPackageInfo -> UnitId
    Installed.installedUnitId InstalledPackageInfo
    pkg, InstalledPackageInfo -> MungedPackageId
    forall pkg. HasMungedPackageId pkg => pkg -> MungedPackageId
    mungedId InstalledPackageInfo
    pkg)
                     | (ModuleName
    _, Module DefUnitId
    uid ModuleName
    _) <- [(ModuleName, Module)]
    instantiate_with
                     , Just InstalledPackageInfo
    pkg <-
                        [ InstalledPackageIndex -> UnitId -> Maybe InstalledPackageInfo
    forall a. PackageIndex a -> UnitId -> Maybe a
    PackageIndex.lookupUnitId
                            InstalledPackageIndex
    installedPackageSet
                            (DefUnitId -> UnitId
    unDefUnitId DefUnitId
    uid)
                        ]
                     ]
            subst = [(ModuleName, Module)] -> Map ModuleName Module
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(ModuleName, Module)]
    instantiate_with
            graph3 = Map UnitId MungedPackageId
    -> Map ModuleName Module -> [LinkedComponent] -> [ReadyComponent]
    toReadyComponents Map UnitId MungedPackageId
    pid_map Map ModuleName Module
    subst [LinkedComponent]
    graph2
            graph4 = Graph ReadyComponent -> [ReadyComponent]
    forall a. Graph a -> [a]
    Graph.revTopSort ([ReadyComponent] -> Graph ReadyComponent
    forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
    Graph.fromDistinctList [ReadyComponent]
    graph3)

        infoProgress $
          hang
            (text "Ready component graph:")
            4
            (vcat (map dispReadyComponent graph4))

        toComponentLocalBuildInfos comp installedPackageSet promisedPkgDeps pkg_descr prePkgDeps graph4

    ------------------------------------------------------------------------------
    -- ComponentLocalBuildInfo
    ------------------------------------------------------------------------------

    toComponentLocalBuildInfos
      :: Compiler
      -> InstalledPackageIndex -- FULL set
      -> [PromisedComponent]
      -> PackageDescription
      -> [PreExistingComponent] -- external package deps
      -> [ReadyComponent]
      -> LogProgress
          ( [ComponentLocalBuildInfo]
          , InstalledPackageIndex -- only relevant packages
          )
    toComponentLocalBuildInfos :: Compiler
    -> InstalledPackageIndex
    -> [PromisedComponent]
    -> PackageDescription
    -> [PreExistingComponent]
    -> [ReadyComponent]
    -> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
    toComponentLocalBuildInfos
      Compiler
    comp
      InstalledPackageIndex
    installedPackageSet
      [PromisedComponent]
    promisedPkgDeps
      PackageDescription
    pkg_descr
      [PreExistingComponent]
    externalPkgDeps
      [ReadyComponent]
    graph = do
        -- Check and make sure that every instantiated component exists.
        -- We have to do this now, because prior to linking/instantiating
        -- we don't actually know what the full set of 'UnitId's we need
        -- are.
        let
          -- TODO: This is actually a bit questionable performance-wise,
          -- since we will pay for the ALL installed packages even if
          -- they are not related to what we are building.  This was true
          -- in the old configure code.
          external_graph :: Graph (Either InstalledPackageInfo ReadyComponent)
          external_graph :: Graph (Either InstalledPackageInfo ReadyComponent)
    external_graph =
            [Either InstalledPackageInfo ReadyComponent]
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
    Graph.fromDistinctList
              ([Either InstalledPackageInfo ReadyComponent]
     -> Graph (Either InstalledPackageInfo ReadyComponent))
    -> ([InstalledPackageInfo]
        -> [Either InstalledPackageInfo ReadyComponent])
    -> [InstalledPackageInfo]
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (InstalledPackageInfo
     -> Either InstalledPackageInfo ReadyComponent)
    -> [InstalledPackageInfo]
    -> [Either InstalledPackageInfo ReadyComponent]
    forall a b. (a -> b) -> [a] -> [b]
    map InstalledPackageInfo -> Either InstalledPackageInfo ReadyComponent
    forall a b. a -> Either a b
    Left
              ([InstalledPackageInfo]
     -> Graph (Either InstalledPackageInfo ReadyComponent))
    -> [InstalledPackageInfo]
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    forall a b. (a -> b) -> a -> b
    $ InstalledPackageIndex -> [InstalledPackageInfo]
    forall a. PackageIndex a -> [a]
    PackageIndex.allPackages InstalledPackageIndex
    installedPackageSet
          internal_graph :: Graph (Either InstalledPackageInfo ReadyComponent)
          internal_graph :: Graph (Either InstalledPackageInfo ReadyComponent)
    internal_graph =
            [Either InstalledPackageInfo ReadyComponent]
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
    Graph.fromDistinctList
              ([Either InstalledPackageInfo ReadyComponent]
     -> Graph (Either InstalledPackageInfo ReadyComponent))
    -> ([ReadyComponent]
        -> [Either InstalledPackageInfo ReadyComponent])
    -> [ReadyComponent]
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ReadyComponent -> Either InstalledPackageInfo ReadyComponent)
    -> [ReadyComponent] -> [Either InstalledPackageInfo ReadyComponent]
    forall a b. (a -> b) -> [a] -> [b]
    map ReadyComponent -> Either InstalledPackageInfo ReadyComponent
    forall a b. b -> Either a b
    Right
              ([ReadyComponent]
     -> Graph (Either InstalledPackageInfo ReadyComponent))
    -> [ReadyComponent]
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    forall a b. (a -> b) -> a -> b
    $ [ReadyComponent]
    graph
          combined_graph :: Graph (Either InstalledPackageInfo ReadyComponent)
    combined_graph = Graph (Either InstalledPackageInfo ReadyComponent)
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    forall a. IsNode a => Graph a -> Graph a -> Graph a
    Graph.unionRight Graph (Either InstalledPackageInfo ReadyComponent)
    external_graph Graph (Either InstalledPackageInfo ReadyComponent)
    internal_graph
          local_graph :: [Either InstalledPackageInfo ReadyComponent]
    local_graph =
            [Either InstalledPackageInfo ReadyComponent]
    -> Maybe [Either InstalledPackageInfo ReadyComponent]
    -> [Either InstalledPackageInfo ReadyComponent]
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> [Either InstalledPackageInfo ReadyComponent]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "toComponentLocalBuildInfos: closure returned Nothing") (Maybe [Either InstalledPackageInfo ReadyComponent]
     -> [Either InstalledPackageInfo ReadyComponent])
    -> Maybe [Either InstalledPackageInfo ReadyComponent]
    -> [Either InstalledPackageInfo ReadyComponent]
    forall a b. (a -> b) -> a -> b
    $
              Graph (Either InstalledPackageInfo ReadyComponent)
    -> [Key (Either InstalledPackageInfo ReadyComponent)]
    -> Maybe [Either InstalledPackageInfo ReadyComponent]
    forall a. Graph a -> [Key a] -> Maybe [a]
    Graph.closure Graph (Either InstalledPackageInfo ReadyComponent)
    combined_graph ((ReadyComponent -> UnitId) -> [ReadyComponent] -> [UnitId]
    forall a b. (a -> b) -> [a] -> [b]
    map ReadyComponent -> Key ReadyComponent
    ReadyComponent -> UnitId
    forall a. IsNode a => a -> Key a
    nodeKey [ReadyComponent]
    graph)
          -- The database of transitively reachable installed packages that the
          -- external components the package (as a whole) depends on.  This will be
          -- used in several ways:
          --
          --      * We'll use it to do a consistency check so we're not depending
          --        on multiple versions of the same package (TODO: someday relax
          --        this for private dependencies.)  See right below.
          --
          --      * We'll pass it on in the LocalBuildInfo, where preprocessors
          --        and other things will incorrectly use it to determine what
          --        the include paths and everything should be.
          --
          packageDependsIndex :: InstalledPackageIndex
    packageDependsIndex = [InstalledPackageInfo] -> InstalledPackageIndex
    PackageIndex.fromList ([Either InstalledPackageInfo ReadyComponent]
    -> [InstalledPackageInfo]
    forall a b. [Either a b] -> [a]
    lefts [Either InstalledPackageInfo ReadyComponent]
    local_graph)
          fullIndex :: Graph (Either InstalledPackageInfo ReadyComponent)
    fullIndex = [Either InstalledPackageInfo ReadyComponent]
    -> Graph (Either InstalledPackageInfo ReadyComponent)
    forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
    Graph.fromDistinctList [Either InstalledPackageInfo ReadyComponent]
    local_graph

        case Graph (Either InstalledPackageInfo ReadyComponent)
    -> [(Either InstalledPackageInfo ReadyComponent,
         [Key (Either InstalledPackageInfo ReadyComponent)])]
    forall a. Graph a -> [(a, [Key a])]
    Graph.broken Graph (Either InstalledPackageInfo ReadyComponent)
    fullIndex of
          [] -> () -> LogProgress ()
    forall a. a -> LogProgress a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          -- If there are promised dependencies, we don't know what the dependencies
          -- of these are and that can easily lead to a broken graph. So assume that
          -- any promised package is not broken (ie all its dependencies, transitively,
          -- will be there). That's a promise.
          [(Either InstalledPackageInfo ReadyComponent,
      [Key (Either InstalledPackageInfo ReadyComponent)])]
    broken
            | Bool -> Bool
    not ([PromisedComponent] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [PromisedComponent]
    promisedPkgDeps) -> () -> LogProgress ()
    forall a. a -> LogProgress a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            | Bool
    otherwise ->
                -- TODO: ppr this
                Doc -> LogProgress ()
    forall a. Doc -> LogProgress a
    dieProgress (Doc -> LogProgress ())
    -> ([Char] -> Doc) -> [Char] -> LogProgress ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Doc
    text ([Char] -> LogProgress ()) -> [Char] -> LogProgress ()
    forall a b. (a -> b) -> a -> b
    $
                  [Char]
    "The following packages are broken because other"
                    [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " packages they depend on are missing. These broken "
                    [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "packages must be rebuilt before they can be used.\n"
                    -- TODO: Undupe.
                    [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    unlines
                      [ [Char]
    "installed package "
                        [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ PackageIdentifier -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow (InstalledPackageInfo -> PackageIdentifier
    forall pkg. Package pkg => pkg -> PackageIdentifier
    packageId InstalledPackageInfo
    pkg)
                        [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " is broken due to missing package "
                        [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    ", " ((UnitId -> [Char]) -> [UnitId] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map UnitId -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow [UnitId]
    deps)
                      | (Left InstalledPackageInfo
    pkg, [UnitId]
    deps) <- [(Either InstalledPackageInfo ReadyComponent,
      [Key (Either InstalledPackageInfo ReadyComponent)])]
    [(Either InstalledPackageInfo ReadyComponent, [UnitId])]
    broken
                      ]
                    [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    unlines
                      [ [Char]
    "planned package "
                        [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ PackageIdentifier -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow (ReadyComponent -> PackageIdentifier
    forall pkg. Package pkg => pkg -> PackageIdentifier
    packageId ReadyComponent
    pkg)
                        [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " is broken due to missing package "
                        [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    ", " ((UnitId -> [Char]) -> [UnitId] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map UnitId -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyShow [UnitId]
    deps)
                      | (Right ReadyComponent
    pkg, [UnitId]
    deps) <- [(Either InstalledPackageInfo ReadyComponent,
      [Key (Either InstalledPackageInfo ReadyComponent)])]
    [(Either InstalledPackageInfo ReadyComponent, [UnitId])]
    broken
                      ]

        -- In this section, we'd like to look at the 'packageDependsIndex'
        -- and see if we've picked multiple versions of the same
        -- installed package (this is bad, because it means you might
        -- get an error could not match foo-0.1:Type with foo-0.2:Type).
        --
        -- What is pseudoTopPkg for? I have no idea.  It was used
        -- in the very original commit which introduced checking for
        -- inconsistencies 5115bb2be4e13841ea07dc9166b9d9afa5f0d012,
        -- and then moved out of PackageIndex and put here later.
        -- TODO: Try this code without it...
        --
        -- TODO: Move this into a helper function
        --
        -- TODO: This is probably wrong for Backpack
        let pseudoTopPkg :: InstalledPackageInfo
            pseudoTopPkg :: InstalledPackageInfo
    pseudoTopPkg =
              InstalledPackageInfo
    emptyInstalledPackageInfo
                { Installed.installedUnitId = mkLegacyUnitId (packageId pkg_descr)
                , Installed.sourcePackageId = packageId pkg_descr
                , Installed.depends = map pc_uid externalPkgDeps
                }
        case InstalledPackageIndex
    -> [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])]
    PackageIndex.dependencyInconsistencies
          (InstalledPackageIndex
     -> [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])])
    -> (InstalledPackageIndex -> InstalledPackageIndex)
    -> InstalledPackageIndex
    -> [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . InstalledPackageInfo
    -> InstalledPackageIndex -> InstalledPackageIndex
    PackageIndex.insert InstalledPackageInfo
    pseudoTopPkg
          (InstalledPackageIndex
     -> [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])])
    -> InstalledPackageIndex
    -> [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])]
    forall a b. (a -> b) -> a -> b
    $ InstalledPackageIndex
    packageDependsIndex of
          [] -> () -> LogProgress ()
    forall a. a -> LogProgress a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])]
    inconsistencies ->
            Doc -> LogProgress ()
    warnProgress (Doc -> LogProgress ()) -> Doc -> LogProgress ()
    forall a b. (a -> b) -> a -> b
    $
              Doc -> Int -> Doc -> Doc
    hang
                ( [Char] -> Doc
    text [Char]
    "This package indirectly depends on multiple versions of the same"
                    Doc -> Doc -> Doc
    <+> [Char] -> Doc
    text [Char]
    "package. This is very likely to cause a compile failure."
                )
                Int
    2
                ( [Doc] -> Doc
    vcat
                    [ [Char] -> Doc
    text [Char]
    "package"
                      Doc -> Doc -> Doc
    <+> PackageName -> Doc
    forall a. Pretty a => a -> Doc
    pretty (InstalledPackageInfo -> PackageName
    forall pkg. Package pkg => pkg -> PackageName
    packageName InstalledPackageInfo
    user)
                      Doc -> Doc -> Doc
    <+> Doc -> Doc
    parens (UnitId -> Doc
    forall a. Pretty a => a -> Doc
    pretty (InstalledPackageInfo -> UnitId
    forall pkg. HasUnitId pkg => pkg -> UnitId
    installedUnitId InstalledPackageInfo
    user))
                      Doc -> Doc -> Doc
    <+> [Char] -> Doc
    text [Char]
    "requires"
                      Doc -> Doc -> Doc
    <+> UnitId -> Doc
    forall a. Pretty a => a -> Doc
    pretty UnitId
    inst
                    | (DepUniqueKey
    _dep_key, [(UnitId, [InstalledPackageInfo])]
    insts) <- [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])]
    inconsistencies
                    , (UnitId
    inst, [InstalledPackageInfo]
    users) <- [(UnitId, [InstalledPackageInfo])]
    insts
                    , InstalledPackageInfo
    user <- [InstalledPackageInfo]
    users
                    ]
                )
        let clbis :: [ComponentLocalBuildInfo]
    clbis = Compiler -> [ReadyComponent] -> [ComponentLocalBuildInfo]
    mkLinkedComponentsLocalBuildInfo Compiler
    comp [ReadyComponent]
    graph
        -- forM clbis $ \(clbi,deps) -> info verbosity $ "UNIT" ++ hashUnitId (componentUnitId clbi) ++ "\n" ++ intercalate "\n" (map hashUnitId deps)
        ([ComponentLocalBuildInfo], InstalledPackageIndex)
    -> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
    forall a. a -> LogProgress a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([ComponentLocalBuildInfo]
    clbis, InstalledPackageIndex
    packageDependsIndex)

    -- Build ComponentLocalBuildInfo for each component we are going
    -- to build.
    --
    -- This conversion is lossy; we lose some invariants from ReadyComponent
    mkLinkedComponentsLocalBuildInfo
      :: Compiler
      -> [ReadyComponent]
      -> [ComponentLocalBuildInfo]
    mkLinkedComponentsLocalBuildInfo :: Compiler -> [ReadyComponent] -> [ComponentLocalBuildInfo]
    mkLinkedComponentsLocalBuildInfo Compiler
    comp [ReadyComponent]
    rcs = (ReadyComponent -> ComponentLocalBuildInfo)
    -> [ReadyComponent] -> [ComponentLocalBuildInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map ReadyComponent -> ComponentLocalBuildInfo
    go [ReadyComponent]
    rcs
      where
        internalUnits :: Set UnitId
    internalUnits = [UnitId] -> Set UnitId
    forall a. Ord a => [a] -> Set a
    Set.fromList ((ReadyComponent -> UnitId) -> [ReadyComponent] -> [UnitId]
    forall a b. (a -> b) -> [a] -> [b]
    map ReadyComponent -> UnitId
    rc_uid [ReadyComponent]
    rcs)
        isInternal :: UnitId -> Bool
    isInternal UnitId
    x = UnitId -> Set UnitId -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member UnitId
    x Set UnitId
    internalUnits
        go :: ReadyComponent -> ComponentLocalBuildInfo
    go ReadyComponent
    rc =
          case ReadyComponent -> Component
    rc_component ReadyComponent
    rc of
            CLib Library
    lib ->
              let convModuleExport :: (ModuleName, Module) -> ExposedModule
    convModuleExport (ModuleName
    modname', (Module DefUnitId
    uid ModuleName
    modname))
                    | UnitId
    this_uid UnitId -> UnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    == DefUnitId -> UnitId
    unDefUnitId DefUnitId
    uid
                    , ModuleName
    modname' ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    == ModuleName
    modname =
                        ModuleName -> Maybe OpenModule -> ExposedModule
    Installed.ExposedModule ModuleName
    modname' Maybe OpenModule
    forall a. Maybe a
    Nothing
                    | Bool
    otherwise =
                        ModuleName -> Maybe OpenModule -> ExposedModule
    Installed.ExposedModule
                          ModuleName
    modname'
                          (OpenModule -> Maybe OpenModule
    forall a. a -> Maybe a
    Just (OpenUnitId -> ModuleName -> OpenModule
    OpenModule (DefUnitId -> OpenUnitId
    DefiniteUnitId DefUnitId
    uid) ModuleName
    modname))
                  convOpenModuleExport :: (ModuleName, OpenModule) -> ExposedModule
    convOpenModuleExport (ModuleName
    modname', modu :: OpenModule
    modu@(OpenModule OpenUnitId
    uid ModuleName
    modname))
                    | OpenUnitId
    uid OpenUnitId -> OpenUnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    == OpenUnitId
    this_open_uid
                    , ModuleName
    modname' ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    == ModuleName
    modname =
                        ModuleName -> Maybe OpenModule -> ExposedModule
    Installed.ExposedModule ModuleName
    modname' Maybe OpenModule
    forall a. Maybe a
    Nothing
                    | Bool
    otherwise =
                        ModuleName -> Maybe OpenModule -> ExposedModule
    Installed.ExposedModule ModuleName
    modname' (OpenModule -> Maybe OpenModule
    forall a. a -> Maybe a
    Just OpenModule
    modu)
                  convOpenModuleExport (ModuleName
    _, OpenModuleVar ModuleName
    _) =
                    [Char] -> ExposedModule
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "convOpenModuleExport: top-level modvar"
                  exports :: [ExposedModule]
    exports =
                    -- Loses invariants
                    case ReadyComponent -> Either IndefiniteComponent InstantiatedComponent
    rc_i ReadyComponent
    rc of
                      Left IndefiniteComponent
    indefc ->
                        ((ModuleName, OpenModule) -> ExposedModule)
    -> [(ModuleName, OpenModule)] -> [ExposedModule]
    forall a b. (a -> b) -> [a] -> [b]
    map (ModuleName, OpenModule) -> ExposedModule
    convOpenModuleExport ([(ModuleName, OpenModule)] -> [ExposedModule])
    -> [(ModuleName, OpenModule)] -> [ExposedModule]
    forall a b. (a -> b) -> a -> b
    $
                          OpenModuleSubst -> [(ModuleName, OpenModule)]
    forall k a. Map k a -> [(k, a)]
    Map.toList (IndefiniteComponent -> OpenModuleSubst
    indefc_provides IndefiniteComponent
    indefc)
                      Right InstantiatedComponent
    instc ->
                        ((ModuleName, Module) -> ExposedModule)
    -> [(ModuleName, Module)] -> [ExposedModule]
    forall a b. (a -> b) -> [a] -> [b]
    map (ModuleName, Module) -> ExposedModule
    convModuleExport ([(ModuleName, Module)] -> [ExposedModule])
    -> [(ModuleName, Module)] -> [ExposedModule]
    forall a b. (a -> b) -> a -> b
    $
                          Map ModuleName Module -> [(ModuleName, Module)]
    forall k a. Map k a -> [(k, a)]
    Map.toList (InstantiatedComponent -> Map ModuleName Module
    instc_provides InstantiatedComponent
    instc)
                  insts :: [(ModuleName, OpenModule)]
    insts =
                    case ReadyComponent -> Either IndefiniteComponent InstantiatedComponent
    rc_i ReadyComponent
    rc of
                      Left IndefiniteComponent
    indefc -> [(ModuleName
    m, ModuleName -> OpenModule
    OpenModuleVar ModuleName
    m) | ModuleName
    m <- IndefiniteComponent -> [ModuleName]
    indefc_requires IndefiniteComponent
    indefc]
                      Right InstantiatedComponent
    instc ->
                        [ (ModuleName
    m, OpenUnitId -> ModuleName -> OpenModule
    OpenModule (DefUnitId -> OpenUnitId
    DefiniteUnitId DefUnitId
    uid') ModuleName
    m')
                        | (ModuleName
    m, Module DefUnitId
    uid' ModuleName
    m') <- InstantiatedComponent -> [(ModuleName, Module)]
    instc_insts InstantiatedComponent
    instc
                        ]

                  compat_name :: MungedPackageName
    compat_name = PackageName -> LibraryName -> MungedPackageName
    MungedPackageName (ReadyComponent -> PackageName
    forall pkg. Package pkg => pkg -> PackageName
    packageName ReadyComponent
    rc) (Library -> LibraryName
    libName Library
    lib)
                  compat_key :: [Char]
    compat_key = Compiler -> MungedPackageName -> Version -> UnitId -> [Char]
    computeCompatPackageKey Compiler
    comp MungedPackageName
    compat_name (ReadyComponent -> Version
    forall pkg. Package pkg => pkg -> Version
    packageVersion ReadyComponent
    rc) UnitId
    this_uid
               in LibComponentLocalBuildInfo
                    { componentPackageDeps :: [(UnitId, MungedPackageId)]
    componentPackageDeps = [(UnitId, MungedPackageId)]
    cpds
                    , componentUnitId :: UnitId
    componentUnitId = UnitId
    this_uid
                    , componentComponentId :: ComponentId
    componentComponentId = ComponentId
    this_cid
                    , componentInstantiatedWith :: [(ModuleName, OpenModule)]
    componentInstantiatedWith = [(ModuleName, OpenModule)]
    insts
                    , componentIsIndefinite_ :: Bool
    componentIsIndefinite_ = Bool
    is_indefinite
                    , componentLocalName :: ComponentName
    componentLocalName = ComponentName
    cname
                    , componentInternalDeps :: [UnitId]
    componentInternalDeps = [UnitId]
    internal_deps
                    , componentExeDeps :: [UnitId]
    componentExeDeps = [UnitId]
    exe_deps
                    , componentIncludes :: [(OpenUnitId, ModuleRenaming)]
    componentIncludes = [(OpenUnitId, ModuleRenaming)]
    includes
                    , componentExposedModules :: [ExposedModule]
    componentExposedModules = [ExposedModule]
    exports
                    , componentIsPublic :: Bool
    componentIsPublic = ReadyComponent -> Bool
    rc_public ReadyComponent
    rc
                    , componentCompatPackageKey :: [Char]
    componentCompatPackageKey = [Char]
    compat_key
                    , componentCompatPackageName :: MungedPackageName
    componentCompatPackageName = MungedPackageName
    compat_name
                    }
            CFLib ForeignLib
    _ ->
              FLibComponentLocalBuildInfo
                { componentUnitId :: UnitId
    componentUnitId = UnitId
    this_uid
                , componentComponentId :: ComponentId
    componentComponentId = ComponentId
    this_cid
                , componentLocalName :: ComponentName
    componentLocalName = ComponentName
    cname
                , componentPackageDeps :: [(UnitId, MungedPackageId)]
    componentPackageDeps = [(UnitId, MungedPackageId)]
    cpds
                , componentExeDeps :: [UnitId]
    componentExeDeps = [UnitId]
    exe_deps
                , componentInternalDeps :: [UnitId]
    componentInternalDeps = [UnitId]
    internal_deps
                , componentIncludes :: [(OpenUnitId, ModuleRenaming)]
    componentIncludes = [(OpenUnitId, ModuleRenaming)]
    includes
                }
            CExe Executable
    _ ->
              ExeComponentLocalBuildInfo
                { componentUnitId :: UnitId
    componentUnitId = UnitId
    this_uid
                , componentComponentId :: ComponentId
    componentComponentId = ComponentId
    this_cid
                , componentLocalName :: ComponentName
    componentLocalName = ComponentName
    cname
                , componentPackageDeps :: [(UnitId, MungedPackageId)]
    componentPackageDeps = [(UnitId, MungedPackageId)]
    cpds
                , componentExeDeps :: [UnitId]
    componentExeDeps = [UnitId]
    exe_deps
                , componentInternalDeps :: [UnitId]
    componentInternalDeps = [UnitId]
    internal_deps
                , componentIncludes :: [(OpenUnitId, ModuleRenaming)]
    componentIncludes = [(OpenUnitId, ModuleRenaming)]
    includes
                }
            CTest TestSuite
    _ ->
              TestComponentLocalBuildInfo
                { componentUnitId :: UnitId
    componentUnitId = UnitId
    this_uid
                , componentComponentId :: ComponentId
    componentComponentId = ComponentId
    this_cid
                , componentLocalName :: ComponentName
    componentLocalName = ComponentName
    cname
                , componentPackageDeps :: [(UnitId, MungedPackageId)]
    componentPackageDeps = [(UnitId, MungedPackageId)]
    cpds
                , componentExeDeps :: [UnitId]
    componentExeDeps = [UnitId]
    exe_deps
                , componentInternalDeps :: [UnitId]
    componentInternalDeps = [UnitId]
    internal_deps
                , componentIncludes :: [(OpenUnitId, ModuleRenaming)]
    componentIncludes = [(OpenUnitId, ModuleRenaming)]
    includes
                }
            CBench Benchmark
    _ ->
              BenchComponentLocalBuildInfo
                { componentUnitId :: UnitId
    componentUnitId = UnitId
    this_uid
                , componentComponentId :: ComponentId
    componentComponentId = ComponentId
    this_cid
                , componentLocalName :: ComponentName
    componentLocalName = ComponentName
    cname
                , componentPackageDeps :: [(UnitId, MungedPackageId)]
    componentPackageDeps = [(UnitId, MungedPackageId)]
    cpds
                , componentExeDeps :: [UnitId]
    componentExeDeps = [UnitId]
    exe_deps
                , componentInternalDeps :: [UnitId]
    componentInternalDeps = [UnitId]
    internal_deps
                , componentIncludes :: [(OpenUnitId, ModuleRenaming)]
    componentIncludes = [(OpenUnitId, ModuleRenaming)]
    includes
                }
          where
            this_uid :: UnitId
    this_uid = ReadyComponent -> UnitId
    rc_uid ReadyComponent
    rc
            this_open_uid :: OpenUnitId
    this_open_uid = ReadyComponent -> OpenUnitId
    rc_open_uid ReadyComponent
    rc
            this_cid :: ComponentId
    this_cid = ReadyComponent -> ComponentId
    rc_cid ReadyComponent
    rc
            cname :: ComponentName
    cname = Component -> ComponentName
    componentName (ReadyComponent -> Component
    rc_component ReadyComponent
    rc)
            cpds :: [(UnitId, MungedPackageId)]
    cpds = ReadyComponent -> [(UnitId, MungedPackageId)]
    rc_depends ReadyComponent
    rc
            exe_deps :: [UnitId]
    exe_deps = (AnnotatedId UnitId -> UnitId) -> [AnnotatedId UnitId] -> [UnitId]
    forall a b. (a -> b) -> [a] -> [b]
    map AnnotatedId UnitId -> UnitId
    forall id. AnnotatedId id -> id
    ann_id ([AnnotatedId UnitId] -> [UnitId])
    -> [AnnotatedId UnitId] -> [UnitId]
    forall a b. (a -> b) -> a -> b
    $ ReadyComponent -> [AnnotatedId UnitId]
    rc_exe_deps ReadyComponent
    rc
            is_indefinite :: Bool
    is_indefinite =
              case ReadyComponent -> Either IndefiniteComponent InstantiatedComponent
    rc_i ReadyComponent
    rc of
                Left IndefiniteComponent
    _ -> Bool
    True
                Right InstantiatedComponent
    _ -> Bool
    False
            includes :: [(OpenUnitId, ModuleRenaming)]
    includes =
              (ComponentInclude OpenUnitId ModuleRenaming
     -> (OpenUnitId, ModuleRenaming))
    -> [ComponentInclude OpenUnitId ModuleRenaming]
    -> [(OpenUnitId, ModuleRenaming)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ComponentInclude OpenUnitId ModuleRenaming
    ci -> (ComponentInclude OpenUnitId ModuleRenaming -> OpenUnitId
    forall id rn. ComponentInclude id rn -> id
    ci_id ComponentInclude OpenUnitId ModuleRenaming
    ci, ComponentInclude OpenUnitId ModuleRenaming -> ModuleRenaming
    forall id rn. ComponentInclude id rn -> rn
    ci_renaming ComponentInclude OpenUnitId ModuleRenaming
    ci)) ([ComponentInclude OpenUnitId ModuleRenaming]
     -> [(OpenUnitId, ModuleRenaming)])
    -> [ComponentInclude OpenUnitId ModuleRenaming]
    -> [(OpenUnitId, ModuleRenaming)]
    forall a b. (a -> b) -> a -> b
    $
                case ReadyComponent -> Either IndefiniteComponent InstantiatedComponent
    rc_i ReadyComponent
    rc of
                  Left IndefiniteComponent
    indefc ->
                    IndefiniteComponent -> [ComponentInclude OpenUnitId ModuleRenaming]
    indefc_includes IndefiniteComponent
    indefc
                  Right InstantiatedComponent
    instc ->
                    (ComponentInclude DefUnitId ModuleRenaming
     -> ComponentInclude OpenUnitId ModuleRenaming)
    -> [ComponentInclude DefUnitId ModuleRenaming]
    -> [ComponentInclude OpenUnitId ModuleRenaming]
    forall a b. (a -> b) -> [a] -> [b]
    map
                      (\ComponentInclude DefUnitId ModuleRenaming
    ci -> ComponentInclude DefUnitId ModuleRenaming
    ci{ci_ann_id = fmap DefiniteUnitId (ci_ann_id ci)})
                      (InstantiatedComponent
    -> [ComponentInclude DefUnitId ModuleRenaming]
    instc_includes InstantiatedComponent
    instc)
            internal_deps :: [UnitId]
    internal_deps = (UnitId -> Bool) -> [UnitId] -> [UnitId]
    forall a. (a -> Bool) -> [a] -> [a]
    filter UnitId -> Bool
    isInternal (ReadyComponent -> [Key ReadyComponent]
    forall a. IsNode a => a -> [Key a]
    nodeNeighbors ReadyComponent
    rc)