{-# LANGUAGE PatternGuards #-}
-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
module Distribution.Backpack.ConfiguredComponent (
    ConfiguredComponent(..),
    cc_name,
    cc_cid,
    cc_pkgid,
    toConfiguredComponent,
    toConfiguredComponents,
    dispConfiguredComponent,

    ConfiguredComponentMap,
    extendConfiguredComponentMap,

    -- TODO: Should go somewhere else
    newPackageDepsBehaviour
) where

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

import Distribution.Backpack.Id

import Distribution.Types.AnnotatedId
import Distribution.Types.Dependency
import Distribution.Types.ExeDependency
import Distribution.Types.IncludeRenaming
import Distribution.Types.ComponentId
import Distribution.Types.PackageId
import Distribution.Types.PackageName
import Distribution.Types.Mixin
import Distribution.Types.ComponentName
import Distribution.Types.LibraryName
import Distribution.Types.UnqualComponentName
import Distribution.Types.ComponentInclude
import Distribution.Package
import Distribution.PackageDescription as PD hiding (Flag)
import Distribution.Simple.BuildToolDepends
import Distribution.Simple.Setup as Setup
import Distribution.Simple.LocalBuildInfo
import Distribution.Version
import Distribution.Utils.LogProgress
import Distribution.Utils.MapAccum
import Distribution.Utils.Generic

import Control.Monad
import qualified Data.Set as Set
import qualified Data.Map as Map
import Distribution.Pretty
import Text.PrettyPrint

-- | A configured component, we know exactly what its 'ComponentId' is,
-- and the 'ComponentId's of the things it depends on.
data ConfiguredComponent
    = ConfiguredComponent {
        -- | Unique identifier of component, plus extra useful info.
        ConfiguredComponent -> AnnotatedId ComponentId
cc_ann_id :: AnnotatedId ComponentId,
        -- | The fragment of syntax from the Cabal file describing this
        -- component.
        ConfiguredComponent -> Component
cc_component :: Component,
        -- | Is this the public library component of the package?
        -- (If we invoke Setup with an instantiation, this is the
        -- component the instantiation applies to.)
        -- Note that in one-component configure mode, this is
        -- always True, because any component is the "public" one.)
        ConfiguredComponent -> Bool
cc_public :: Bool,
        -- | Dependencies on executables from @build-tools@ and
        -- @build-tool-depends@.
        ConfiguredComponent -> [AnnotatedId ComponentId]
cc_exe_deps :: [AnnotatedId ComponentId],
        -- | The mixins of this package, including both explicit (from
        -- the @mixins@ field) and implicit (from @build-depends@).  Not
        -- mix-in linked yet; component configuration only looks at
        -- 'ComponentId's.
        ConfiguredComponent
-> [ComponentInclude ComponentId IncludeRenaming]
cc_includes :: [ComponentInclude ComponentId IncludeRenaming]
      }


-- | Uniquely identifies a configured component.
cc_cid :: ConfiguredComponent -> ComponentId
cc_cid :: ConfiguredComponent -> ComponentId
cc_cid = AnnotatedId ComponentId -> ComponentId
forall id. AnnotatedId id -> id
ann_id (AnnotatedId ComponentId -> ComponentId)
-> (ConfiguredComponent -> AnnotatedId ComponentId)
-> ConfiguredComponent
-> ComponentId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredComponent -> AnnotatedId ComponentId
cc_ann_id

-- | The package this component came from.
cc_pkgid :: ConfiguredComponent -> PackageId
cc_pkgid :: ConfiguredComponent -> PackageId
cc_pkgid = AnnotatedId ComponentId -> PackageId
forall id. AnnotatedId id -> PackageId
ann_pid (AnnotatedId ComponentId -> PackageId)
-> (ConfiguredComponent -> AnnotatedId ComponentId)
-> ConfiguredComponent
-> PackageId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredComponent -> AnnotatedId ComponentId
cc_ann_id

-- | The 'ComponentName' of a component; this uniquely identifies
-- a fragment of syntax within a specified Cabal file describing the
-- component.
cc_name :: ConfiguredComponent -> ComponentName
cc_name :: ConfiguredComponent -> ComponentName
cc_name = AnnotatedId ComponentId -> ComponentName
forall id. AnnotatedId id -> ComponentName
ann_cname (AnnotatedId ComponentId -> ComponentName)
-> (ConfiguredComponent -> AnnotatedId ComponentId)
-> ConfiguredComponent
-> ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredComponent -> AnnotatedId ComponentId
cc_ann_id

-- | Pretty-print a 'ConfiguredComponent'.
dispConfiguredComponent :: ConfiguredComponent -> Doc
dispConfiguredComponent :: ConfiguredComponent -> Doc
dispConfiguredComponent ConfiguredComponent
cc =
    Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"component" Doc -> Doc -> Doc
<+> ComponentId -> Doc
forall a. Pretty a => a -> Doc
pretty (ConfiguredComponent -> ComponentId
cc_cid ConfiguredComponent
cc)) Int
4
         ([Doc] -> Doc
vcat [ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [ String -> Doc
text String
"include"
                        , ComponentId -> Doc
forall a. Pretty a => a -> Doc
pretty (ComponentInclude ComponentId IncludeRenaming -> ComponentId
forall id rn. ComponentInclude id rn -> id
ci_id ComponentInclude ComponentId IncludeRenaming
incl), IncludeRenaming -> Doc
forall a. Pretty a => a -> Doc
pretty (ComponentInclude ComponentId IncludeRenaming -> IncludeRenaming
forall id rn. ComponentInclude id rn -> rn
ci_renaming ComponentInclude ComponentId IncludeRenaming
incl) ]
               | ComponentInclude ComponentId IncludeRenaming
incl <- ConfiguredComponent
-> [ComponentInclude ComponentId IncludeRenaming]
cc_includes ConfiguredComponent
cc
               ])

-- | Construct a 'ConfiguredComponent', given that the 'ComponentId'
-- and library/executable dependencies are known.  The primary
-- work this does is handling implicit @backpack-include@ fields.
mkConfiguredComponent
    :: PackageDescription
    -> ComponentId
    -> [AnnotatedId ComponentId] -- lib deps
    -> [AnnotatedId ComponentId] -- exe deps
    -> Component
    -> LogProgress ConfiguredComponent
mkConfiguredComponent :: PackageDescription
-> ComponentId
-> [AnnotatedId ComponentId]
-> [AnnotatedId ComponentId]
-> Component
-> LogProgress ConfiguredComponent
mkConfiguredComponent PackageDescription
pkg_descr ComponentId
this_cid [AnnotatedId ComponentId]
lib_deps [AnnotatedId ComponentId]
exe_deps Component
component = do
    -- Resolve each @mixins@ into the actual dependency
    -- from @lib_deps@.
    [ComponentInclude ComponentId IncludeRenaming]
explicit_includes <- [Mixin]
-> (Mixin
    -> LogProgress (ComponentInclude ComponentId IncludeRenaming))
-> LogProgress [ComponentInclude ComponentId IncludeRenaming]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (BuildInfo -> [Mixin]
mixins BuildInfo
bi) ((Mixin
  -> LogProgress (ComponentInclude ComponentId IncludeRenaming))
 -> LogProgress [ComponentInclude ComponentId IncludeRenaming])
-> (Mixin
    -> LogProgress (ComponentInclude ComponentId IncludeRenaming))
-> LogProgress [ComponentInclude ComponentId IncludeRenaming]
forall a b. (a -> b) -> a -> b
$ \(Mixin PackageName
name IncludeRenaming
rns) -> do
        let keys :: (PackageName, ComponentName)
keys = PackageDescription -> PackageName -> (PackageName, ComponentName)
fixFakePkgName PackageDescription
pkg_descr PackageName
name
        AnnotatedId ComponentId
aid <- case (PackageName, ComponentName)
-> Map (PackageName, ComponentName) (AnnotatedId ComponentId)
-> Maybe (AnnotatedId ComponentId)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName, ComponentName)
keys Map (PackageName, ComponentName) (AnnotatedId ComponentId)
deps_map of
                Maybe (AnnotatedId ComponentId)
Nothing ->
                    Doc -> LogProgress (AnnotatedId ComponentId)
forall a. Doc -> LogProgress a
dieProgress (Doc -> LogProgress (AnnotatedId ComponentId))
-> Doc -> LogProgress (AnnotatedId ComponentId)
forall a b. (a -> b) -> a -> b
$
                    String -> Doc
text String
"Mix-in refers to non-existent package" Doc -> Doc -> Doc
<+>
                    Doc -> Doc
quotes (PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty PackageName
name) Doc -> Doc -> Doc
$$
                    String -> Doc
text String
"(did you forget to add the package to build-depends?)"
                Just AnnotatedId ComponentId
r  -> AnnotatedId ComponentId -> LogProgress (AnnotatedId ComponentId)
forall (m :: * -> *) a. Monad m => a -> m a
return AnnotatedId ComponentId
r
        ComponentInclude ComponentId IncludeRenaming
-> LogProgress (ComponentInclude ComponentId IncludeRenaming)
forall (m :: * -> *) a. Monad m => a -> m a
return ComponentInclude :: forall id rn.
AnnotatedId id -> rn -> Bool -> ComponentInclude id rn
ComponentInclude {
                ci_ann_id :: AnnotatedId ComponentId
ci_ann_id   = AnnotatedId ComponentId
aid,
                ci_renaming :: IncludeRenaming
ci_renaming = IncludeRenaming
rns,
                ci_implicit :: Bool
ci_implicit = Bool
False
            }

        -- Any @build-depends@ which is not explicitly mentioned in
        -- @backpack-include@ is converted into an "implicit" include.
    let used_explicitly :: Set ComponentId
used_explicitly = [ComponentId] -> Set ComponentId
forall a. Ord a => [a] -> Set a
Set.fromList ((ComponentInclude ComponentId IncludeRenaming -> ComponentId)
-> [ComponentInclude ComponentId IncludeRenaming] -> [ComponentId]
forall a b. (a -> b) -> [a] -> [b]
map ComponentInclude ComponentId IncludeRenaming -> ComponentId
forall id rn. ComponentInclude id rn -> id
ci_id [ComponentInclude ComponentId IncludeRenaming]
explicit_includes)
        implicit_includes :: [ComponentInclude ComponentId IncludeRenaming]
implicit_includes
            = (AnnotatedId ComponentId
 -> ComponentInclude ComponentId IncludeRenaming)
-> [AnnotatedId ComponentId]
-> [ComponentInclude ComponentId IncludeRenaming]
forall a b. (a -> b) -> [a] -> [b]
map (\AnnotatedId ComponentId
aid -> ComponentInclude :: forall id rn.
AnnotatedId id -> rn -> Bool -> ComponentInclude id rn
ComponentInclude {
                                ci_ann_id :: AnnotatedId ComponentId
ci_ann_id = AnnotatedId ComponentId
aid,
                                ci_renaming :: IncludeRenaming
ci_renaming = IncludeRenaming
defaultIncludeRenaming,
                                ci_implicit :: Bool
ci_implicit = Bool
True
                            })
            ([AnnotatedId ComponentId]
 -> [ComponentInclude ComponentId IncludeRenaming])
-> [AnnotatedId ComponentId]
-> [ComponentInclude ComponentId IncludeRenaming]
forall a b. (a -> b) -> a -> b
$ (AnnotatedId ComponentId -> Bool)
-> [AnnotatedId ComponentId] -> [AnnotatedId ComponentId]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ComponentId -> Set ComponentId -> Bool)
-> Set ComponentId -> ComponentId -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ComponentId -> Set ComponentId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember Set ComponentId
used_explicitly (ComponentId -> Bool)
-> (AnnotatedId ComponentId -> ComponentId)
-> AnnotatedId ComponentId
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedId ComponentId -> ComponentId
forall id. AnnotatedId id -> id
ann_id) [AnnotatedId ComponentId]
lib_deps

    ConfiguredComponent -> LogProgress ConfiguredComponent
forall (m :: * -> *) a. Monad m => a -> m a
return ConfiguredComponent :: AnnotatedId ComponentId
-> Component
-> Bool
-> [AnnotatedId ComponentId]
-> [ComponentInclude ComponentId IncludeRenaming]
-> ConfiguredComponent
ConfiguredComponent {
            cc_ann_id :: AnnotatedId ComponentId
cc_ann_id = AnnotatedId :: forall id. PackageId -> ComponentName -> id -> AnnotatedId id
AnnotatedId {
                    ann_id :: ComponentId
ann_id = ComponentId
this_cid,
                    ann_pid :: PackageId
ann_pid = PackageDescription -> PackageId
package PackageDescription
pkg_descr,
                    ann_cname :: ComponentName
ann_cname = Component -> ComponentName
componentName Component
component
                },
            cc_component :: Component
cc_component = Component
component,
            cc_public :: Bool
cc_public = Bool
is_public,
            cc_exe_deps :: [AnnotatedId ComponentId]
cc_exe_deps = [AnnotatedId ComponentId]
exe_deps,
            cc_includes :: [ComponentInclude ComponentId IncludeRenaming]
cc_includes = [ComponentInclude ComponentId IncludeRenaming]
explicit_includes [ComponentInclude ComponentId IncludeRenaming]
-> [ComponentInclude ComponentId IncludeRenaming]
-> [ComponentInclude ComponentId IncludeRenaming]
forall a. [a] -> [a] -> [a]
++ [ComponentInclude ComponentId IncludeRenaming]
implicit_includes
        }
  where
    bi :: BuildInfo
bi = Component -> BuildInfo
componentBuildInfo Component
component
    deps_map :: Map (PackageName, ComponentName) (AnnotatedId ComponentId)
deps_map = [((PackageName, ComponentName), AnnotatedId ComponentId)]
-> Map (PackageName, ComponentName) (AnnotatedId ComponentId)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ ((AnnotatedId ComponentId -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName AnnotatedId ComponentId
dep, AnnotatedId ComponentId -> ComponentName
forall id. AnnotatedId id -> ComponentName
ann_cname AnnotatedId ComponentId
dep), AnnotatedId ComponentId
dep)
                            | AnnotatedId ComponentId
dep <- [AnnotatedId ComponentId]
lib_deps ]
    is_public :: Bool
is_public = Component -> ComponentName
componentName Component
component ComponentName -> ComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== LibraryName -> ComponentName
CLibName LibraryName
LMainLibName

type ConfiguredComponentMap =
        Map PackageName (Map ComponentName (AnnotatedId ComponentId))

toConfiguredComponent
    :: PackageDescription
    -> ComponentId
    -> ConfiguredComponentMap
    -> ConfiguredComponentMap
    -> Component
    -> LogProgress ConfiguredComponent
toConfiguredComponent :: PackageDescription
-> ComponentId
-> ConfiguredComponentMap
-> ConfiguredComponentMap
-> Component
-> LogProgress ConfiguredComponent
toConfiguredComponent PackageDescription
pkg_descr ComponentId
this_cid ConfiguredComponentMap
lib_dep_map ConfiguredComponentMap
exe_dep_map Component
component = do
    [AnnotatedId ComponentId]
lib_deps <-
        if PackageDescription -> Bool
newPackageDepsBehaviour PackageDescription
pkg_descr
            then ([[AnnotatedId ComponentId]] -> [AnnotatedId ComponentId])
-> LogProgress [[AnnotatedId ComponentId]]
-> LogProgress [AnnotatedId ComponentId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[AnnotatedId ComponentId]] -> [AnnotatedId ComponentId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (LogProgress [[AnnotatedId ComponentId]]
 -> LogProgress [AnnotatedId ComponentId])
-> LogProgress [[AnnotatedId ComponentId]]
-> LogProgress [AnnotatedId ComponentId]
forall a b. (a -> b) -> a -> b
$ [Dependency]
-> (Dependency -> LogProgress [AnnotatedId ComponentId])
-> LogProgress [[AnnotatedId ComponentId]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (BuildInfo -> [Dependency]
targetBuildDepends BuildInfo
bi) ((Dependency -> LogProgress [AnnotatedId ComponentId])
 -> LogProgress [[AnnotatedId ComponentId]])
-> (Dependency -> LogProgress [AnnotatedId ComponentId])
-> LogProgress [[AnnotatedId ComponentId]]
forall a b. (a -> b) -> a -> b
$
                 \(Dependency PackageName
name VersionRange
_ Set LibraryName
sublibs) -> do
                    -- The package name still needs fixing in case of legacy
                    -- sublibrary dependency syntax
                    let (PackageName
pn, ComponentName
_) = PackageDescription -> PackageName -> (PackageName, ComponentName)
fixFakePkgName PackageDescription
pkg_descr PackageName
name
                    Map ComponentName (AnnotatedId ComponentId)
pkg <- case PackageName
-> ConfiguredComponentMap
-> Maybe (Map ComponentName (AnnotatedId ComponentId))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pn ConfiguredComponentMap
lib_dep_map of
                        Maybe (Map ComponentName (AnnotatedId ComponentId))
Nothing ->
                            Doc -> LogProgress (Map ComponentName (AnnotatedId ComponentId))
forall a. Doc -> LogProgress a
dieProgress (Doc -> LogProgress (Map ComponentName (AnnotatedId ComponentId)))
-> Doc -> LogProgress (Map ComponentName (AnnotatedId ComponentId))
forall a b. (a -> b) -> a -> b
$
                                String -> Doc
text String
"Dependency on unbuildable" Doc -> Doc -> Doc
<+>
                                String -> Doc
text String
"package" Doc -> Doc -> Doc
<+> PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty PackageName
pn
                        Just Map ComponentName (AnnotatedId ComponentId)
p -> Map ComponentName (AnnotatedId ComponentId)
-> LogProgress (Map ComponentName (AnnotatedId ComponentId))
forall (m :: * -> *) a. Monad m => a -> m a
return Map ComponentName (AnnotatedId ComponentId)
p
                    -- Return all library components
                    [LibraryName]
-> (LibraryName -> LogProgress (AnnotatedId ComponentId))
-> LogProgress [AnnotatedId ComponentId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Set LibraryName -> [LibraryName]
forall a. Set a -> [a]
Set.toList Set LibraryName
sublibs) ((LibraryName -> LogProgress (AnnotatedId ComponentId))
 -> LogProgress [AnnotatedId ComponentId])
-> (LibraryName -> LogProgress (AnnotatedId ComponentId))
-> LogProgress [AnnotatedId ComponentId]
forall a b. (a -> b) -> a -> b
$ \LibraryName
lib ->
                        let comp :: ComponentName
comp = LibraryName -> ComponentName
CLibName LibraryName
lib in
                        case ComponentName
-> Map ComponentName (AnnotatedId ComponentId)
-> Maybe (AnnotatedId ComponentId)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (LibraryName -> ComponentName
CLibName (LibraryName -> ComponentName) -> LibraryName -> ComponentName
forall a b. (a -> b) -> a -> b
$ UnqualComponentName -> LibraryName
LSubLibName (UnqualComponentName -> LibraryName)
-> UnqualComponentName -> LibraryName
forall a b. (a -> b) -> a -> b
$
                                         PackageName -> UnqualComponentName
packageNameToUnqualComponentName PackageName
name) Map ComponentName (AnnotatedId ComponentId)
pkg
                         Maybe (AnnotatedId ComponentId)
-> Maybe (AnnotatedId ComponentId)
-> Maybe (AnnotatedId ComponentId)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ComponentName
-> Map ComponentName (AnnotatedId ComponentId)
-> Maybe (AnnotatedId ComponentId)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ComponentName
comp Map ComponentName (AnnotatedId ComponentId)
pkg
                        of
                            Maybe (AnnotatedId ComponentId)
Nothing ->
                                Doc -> LogProgress (AnnotatedId ComponentId)
forall a. Doc -> LogProgress a
dieProgress (Doc -> LogProgress (AnnotatedId ComponentId))
-> Doc -> LogProgress (AnnotatedId ComponentId)
forall a b. (a -> b) -> a -> b
$
                                    String -> Doc
text String
"Dependency on unbuildable" Doc -> Doc -> Doc
<+>
                                    String -> Doc
text (LibraryName -> String
showLibraryName LibraryName
lib) Doc -> Doc -> Doc
<+>
                                    String -> Doc
text String
"from" Doc -> Doc -> Doc
<+> PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty PackageName
pn
                            Just AnnotatedId ComponentId
v -> AnnotatedId ComponentId -> LogProgress (AnnotatedId ComponentId)
forall (m :: * -> *) a. Monad m => a -> m a
return AnnotatedId ComponentId
v
            else [AnnotatedId ComponentId] -> LogProgress [AnnotatedId ComponentId]
forall (m :: * -> *) a. Monad m => a -> m a
return [AnnotatedId ComponentId]
old_style_lib_deps
    PackageDescription
-> ComponentId
-> [AnnotatedId ComponentId]
-> [AnnotatedId ComponentId]
-> Component
-> LogProgress ConfiguredComponent
mkConfiguredComponent
       PackageDescription
pkg_descr ComponentId
this_cid
       [AnnotatedId ComponentId]
lib_deps [AnnotatedId ComponentId]
exe_deps Component
component
  where
    bi :: BuildInfo
bi = Component -> BuildInfo
componentBuildInfo Component
component
    -- lib_dep_map contains a mix of internal and external deps.
    -- We want all the public libraries (dep_cn == CLibName)
    -- of all external deps (dep /= pn).  Note that this
    -- excludes the public library of the current package:
    -- this is not supported by old-style deps behavior
    -- because it would imply a cyclic dependency for the
    -- library itself.
    old_style_lib_deps :: [AnnotatedId ComponentId]
old_style_lib_deps = [ AnnotatedId ComponentId
e
                         | (PackageName
pn, Map ComponentName (AnnotatedId ComponentId)
comp_map) <- ConfiguredComponentMap
-> [(PackageName, Map ComponentName (AnnotatedId ComponentId))]
forall k a. Map k a -> [(k, a)]
Map.toList ConfiguredComponentMap
lib_dep_map
                         , PackageName
pn PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
/= PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg_descr
                         , (ComponentName
cn, AnnotatedId ComponentId
e) <- Map ComponentName (AnnotatedId ComponentId)
-> [(ComponentName, AnnotatedId ComponentId)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ComponentName (AnnotatedId ComponentId)
comp_map
                         , ComponentName
cn ComponentName -> ComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== LibraryName -> ComponentName
CLibName LibraryName
LMainLibName ]
    -- We have to nub here, because 'getAllToolDependencies' may return
    -- duplicates (see #4986).  (NB: This is not needed for lib_deps,
    -- since those elaborate into includes, for which there explicitly
    -- may be multiple instances of a package)
    exe_deps :: [AnnotatedId ComponentId]
exe_deps = [AnnotatedId ComponentId] -> [AnnotatedId ComponentId]
forall a. Ord a => [a] -> [a]
ordNub ([AnnotatedId ComponentId] -> [AnnotatedId ComponentId])
-> [AnnotatedId ComponentId] -> [AnnotatedId ComponentId]
forall a b. (a -> b) -> a -> b
$
        [ AnnotatedId ComponentId
exe
        | ExeDependency PackageName
pn UnqualComponentName
cn VersionRange
_ <- PackageDescription -> BuildInfo -> [ExeDependency]
getAllToolDependencies PackageDescription
pkg_descr BuildInfo
bi
        -- The error suppression here is important, because in general
        -- we won't know about external dependencies (e.g., 'happy')
        -- which the package is attempting to use (those deps are only
        -- fed in when cabal-install uses this codepath.)
        -- TODO: Let cabal-install request errors here
        , Just AnnotatedId ComponentId
exe <- [ComponentName
-> Map ComponentName (AnnotatedId ComponentId)
-> Maybe (AnnotatedId ComponentId)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (UnqualComponentName -> ComponentName
CExeName UnqualComponentName
cn) (Map ComponentName (AnnotatedId ComponentId)
 -> Maybe (AnnotatedId ComponentId))
-> Maybe (Map ComponentName (AnnotatedId ComponentId))
-> Maybe (AnnotatedId ComponentId)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PackageName
-> ConfiguredComponentMap
-> Maybe (Map ComponentName (AnnotatedId ComponentId))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pn ConfiguredComponentMap
exe_dep_map]
        ]

-- | Also computes the 'ComponentId', and sets cc_public if necessary.
-- This is Cabal-only; cabal-install won't use this.
toConfiguredComponent'
    :: Bool -- use_external_internal_deps
    -> FlagAssignment
    -> PackageDescription
    -> Bool -- deterministic
    -> Flag String      -- configIPID (todo: remove me)
    -> Flag ComponentId -- configCID
    -> ConfiguredComponentMap
    -> Component
    -> LogProgress ConfiguredComponent
toConfiguredComponent' :: Bool
-> FlagAssignment
-> PackageDescription
-> Bool
-> Flag String
-> Flag ComponentId
-> ConfiguredComponentMap
-> Component
-> LogProgress ConfiguredComponent
toConfiguredComponent' Bool
use_external_internal_deps FlagAssignment
flags
                PackageDescription
pkg_descr Bool
deterministic Flag String
ipid_flag Flag ComponentId
cid_flag
                ConfiguredComponentMap
dep_map Component
component = do
    ConfiguredComponent
cc <- PackageDescription
-> ComponentId
-> ConfiguredComponentMap
-> ConfiguredComponentMap
-> Component
-> LogProgress ConfiguredComponent
toConfiguredComponent
                PackageDescription
pkg_descr ComponentId
this_cid
                ConfiguredComponentMap
dep_map ConfiguredComponentMap
dep_map Component
component
    ConfiguredComponent -> LogProgress ConfiguredComponent
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfiguredComponent -> LogProgress ConfiguredComponent)
-> ConfiguredComponent -> LogProgress ConfiguredComponent
forall a b. (a -> b) -> a -> b
$ if Bool
use_external_internal_deps
                then ConfiguredComponent
cc { cc_public :: Bool
cc_public = Bool
True }
                else ConfiguredComponent
cc
  where
    -- TODO: pass component names to it too!
    this_cid :: ComponentId
this_cid = Bool
-> Flag String
-> Flag ComponentId
-> PackageId
-> ComponentName
-> Maybe ([ComponentId], FlagAssignment)
-> ComponentId
computeComponentId Bool
deterministic Flag String
ipid_flag Flag ComponentId
cid_flag
                (PackageDescription -> PackageId
package PackageDescription
pkg_descr) (Component -> ComponentName
componentName Component
component) (([ComponentId], FlagAssignment)
-> Maybe ([ComponentId], FlagAssignment)
forall a. a -> Maybe a
Just ([ComponentId]
deps, FlagAssignment
flags))
    deps :: [ComponentId]
deps = [ AnnotatedId ComponentId -> ComponentId
forall id. AnnotatedId id -> id
ann_id AnnotatedId ComponentId
aid | Map ComponentName (AnnotatedId ComponentId)
m <- ConfiguredComponentMap
-> [Map ComponentName (AnnotatedId ComponentId)]
forall k a. Map k a -> [a]
Map.elems ConfiguredComponentMap
dep_map
                        , AnnotatedId ComponentId
aid <- Map ComponentName (AnnotatedId ComponentId)
-> [AnnotatedId ComponentId]
forall k a. Map k a -> [a]
Map.elems Map ComponentName (AnnotatedId ComponentId)
m ]

extendConfiguredComponentMap
    :: ConfiguredComponent
    -> ConfiguredComponentMap
    -> ConfiguredComponentMap
extendConfiguredComponentMap :: ConfiguredComponent
-> ConfiguredComponentMap -> ConfiguredComponentMap
extendConfiguredComponentMap ConfiguredComponent
cc =
    (Map ComponentName (AnnotatedId ComponentId)
 -> Map ComponentName (AnnotatedId ComponentId)
 -> Map ComponentName (AnnotatedId ComponentId))
-> PackageName
-> Map ComponentName (AnnotatedId ComponentId)
-> ConfiguredComponentMap
-> ConfiguredComponentMap
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith 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
        (PackageId -> PackageName
pkgName (ConfiguredComponent -> PackageId
cc_pkgid ConfiguredComponent
cc))
        (ComponentName
-> AnnotatedId ComponentId
-> Map ComponentName (AnnotatedId ComponentId)
forall k a. k -> a -> Map k a
Map.singleton (ConfiguredComponent -> ComponentName
cc_name ConfiguredComponent
cc) (ConfiguredComponent -> AnnotatedId ComponentId
cc_ann_id ConfiguredComponent
cc))

-- Compute the 'ComponentId's for a graph of 'Component's.  The
-- list of internal components must be topologically sorted
-- based on internal package dependencies, so that any internal
-- dependency points to an entry earlier in the list.
--
-- TODO: This function currently restricts the input configured components to
-- one version per package, by using the type ConfiguredComponentMap.  It cannot
-- be used to configure a component that depends on one version of a package for
-- a library and another version for a build-tool.
toConfiguredComponents
    :: Bool -- use_external_internal_deps
    -> FlagAssignment
    -> Bool -- deterministic
    -> Flag String -- configIPID
    -> Flag ComponentId -- configCID
    -> PackageDescription
    -> ConfiguredComponentMap
    -> [Component]
    -> LogProgress [ConfiguredComponent]
toConfiguredComponents :: Bool
-> FlagAssignment
-> Bool
-> Flag String
-> Flag ComponentId
-> PackageDescription
-> ConfiguredComponentMap
-> [Component]
-> LogProgress [ConfiguredComponent]
toConfiguredComponents
    Bool
use_external_internal_deps FlagAssignment
flags Bool
deterministic Flag String
ipid_flag Flag ComponentId
cid_flag PackageDescription
pkg_descr
    ConfiguredComponentMap
dep_map [Component]
comps
    = ((ConfiguredComponentMap, [ConfiguredComponent])
 -> [ConfiguredComponent])
-> LogProgress (ConfiguredComponentMap, [ConfiguredComponent])
-> LogProgress [ConfiguredComponent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ConfiguredComponentMap, [ConfiguredComponent])
-> [ConfiguredComponent]
forall a b. (a, b) -> b
snd ((ConfiguredComponentMap
 -> Component
 -> LogProgress (ConfiguredComponentMap, ConfiguredComponent))
-> ConfiguredComponentMap
-> [Component]
-> LogProgress (ConfiguredComponentMap, [ConfiguredComponent])
forall (m :: * -> *) (t :: * -> *) a b c.
(Monad m, Traversable t) =>
(a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumM ConfiguredComponentMap
-> Component
-> LogProgress (ConfiguredComponentMap, ConfiguredComponent)
go ConfiguredComponentMap
dep_map [Component]
comps)
  where
    go :: ConfiguredComponentMap
-> Component
-> LogProgress (ConfiguredComponentMap, ConfiguredComponent)
go ConfiguredComponentMap
m Component
component = do
        ConfiguredComponent
cc <- Bool
-> FlagAssignment
-> PackageDescription
-> Bool
-> Flag String
-> Flag ComponentId
-> ConfiguredComponentMap
-> Component
-> LogProgress ConfiguredComponent
toConfiguredComponent'
                        Bool
use_external_internal_deps FlagAssignment
flags PackageDescription
pkg_descr
                        Bool
deterministic Flag String
ipid_flag Flag ComponentId
cid_flag
                        ConfiguredComponentMap
m Component
component
        (ConfiguredComponentMap, ConfiguredComponent)
-> LogProgress (ConfiguredComponentMap, ConfiguredComponent)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfiguredComponent
-> ConfiguredComponentMap -> ConfiguredComponentMap
extendConfiguredComponentMap ConfiguredComponent
cc ConfiguredComponentMap
m, ConfiguredComponent
cc)

newPackageDepsBehaviourMinVersion :: Version
newPackageDepsBehaviourMinVersion :: Version
newPackageDepsBehaviourMinVersion = [Int] -> Version
mkVersion [Int
1,Int
7,Int
1]


-- In older cabal versions, there was only one set of package dependencies for
-- the whole package. In this version, we can have separate dependencies per
-- target, but we only enable this behaviour if the minimum cabal version
-- specified is >= a certain minimum. Otherwise, for compatibility we use the
-- old behaviour.
newPackageDepsBehaviour :: PackageDescription -> Bool
newPackageDepsBehaviour :: PackageDescription -> Bool
newPackageDepsBehaviour PackageDescription
pkg =
   PackageDescription -> Version
specVersion PackageDescription
pkg Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
newPackageDepsBehaviourMinVersion

-- | 'build-depends:' stanzas are currently ambiguous as the external packages
-- and internal libraries are specified the same. For now, we assume internal
-- libraries shadow, and this function disambiguates accordingly, but soon the
-- underlying ambiguity will be addressed.
-- Multiple public libraries (cabal 3.0) added an unambiguous way of specifying
-- sublibraries, but we still have to support the old syntax for bc reasons.
fixFakePkgName :: PackageDescription -> PackageName -> (PackageName, ComponentName)
fixFakePkgName :: PackageDescription -> PackageName -> (PackageName, ComponentName)
fixFakePkgName PackageDescription
pkg_descr PackageName
pn =
  if UnqualComponentName
subLibName UnqualComponentName -> [UnqualComponentName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UnqualComponentName]
internalLibraries
  then (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg_descr, LibraryName -> ComponentName
CLibName (UnqualComponentName -> LibraryName
LSubLibName UnqualComponentName
subLibName))
  else (PackageName
pn,                    LibraryName -> ComponentName
CLibName LibraryName
LMainLibName            )
  where
    subLibName :: UnqualComponentName
subLibName        = PackageName -> UnqualComponentName
packageNameToUnqualComponentName PackageName
pn
    internalLibraries :: [UnqualComponentName]
internalLibraries = (Library -> Maybe UnqualComponentName)
-> [Library] -> [UnqualComponentName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LibraryName -> Maybe UnqualComponentName
libraryNameString (LibraryName -> Maybe UnqualComponentName)
-> (Library -> LibraryName) -> Library -> Maybe UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName)
                        (PackageDescription -> [Library]
allLibraries PackageDescription
pkg_descr)