{-# 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 Distribution.Compat.Prelude hiding ((<>))
import Prelude ()

import Distribution.Backpack.Id

import Distribution.CabalSpecVersion
import Distribution.Package
import Distribution.PackageDescription
import Distribution.Simple.BuildToolDepends
import Distribution.Simple.Flag (Flag)
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.AnnotatedId
import Distribution.Types.ComponentInclude
import Distribution.Utils.Generic
import Distribution.Utils.LogProgress
import Distribution.Utils.MapAccum

import Control.Monad
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Distribution.Compat.NonEmptySet as NonEmptySet
import Distribution.Pretty
import Text.PrettyPrint (Doc, hang, hsep, quotes, text, vcat, ($$))
import qualified Text.PrettyPrint as PP

-- | A configured component, we know exactly what its 'ComponentId' is,
-- and the 'ComponentId's of the things it depends on.
data ConfiguredComponent = ConfiguredComponent
  { ConfiguredComponent -> AnnotatedId ComponentId
cc_ann_id :: AnnotatedId ComponentId
  -- ^ Unique identifier of component, plus extra useful info.
  , ConfiguredComponent -> Component
cc_component :: Component
  -- ^ The fragment of syntax from the Cabal file describing this
  -- component.
  , ConfiguredComponent -> Bool
cc_public :: Bool
  -- ^ 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 -> [AnnotatedId ComponentId]
cc_exe_deps :: [AnnotatedId ComponentId]
  -- ^ Dependencies on executables from @build-tools@ and
  -- @build-tool-depends@.
  , ConfiguredComponent
-> [ComponentInclude ComponentId IncludeRenaming]
cc_includes :: [ComponentInclude ComponentId IncludeRenaming]
  -- ^ 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.
  }

-- | 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
pn LibraryName
ln IncludeRenaming
rns) -> do
    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
pn, LibraryName -> ComponentName
CLibName LibraryName
ln) 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 library"
            Doc -> Doc -> Doc
<+> Doc -> Doc
quotes (PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty PackageName
pn Doc -> Doc -> Doc
<<>> LibraryName -> Doc
prettyLN LibraryName
ln)
            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 a. a -> LogProgress a
forall (m :: * -> *) a. Monad m => a -> m a
return AnnotatedId ComponentId
r
    ComponentInclude ComponentId IncludeRenaming
-> LogProgress (ComponentInclude ComponentId IncludeRenaming)
forall a. a -> LogProgress a
forall (m :: * -> *) a. Monad m => a -> m a
return
      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
                { 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 a. a -> LogProgress a
forall (m :: * -> *) a. Monad m => a -> m a
return
    ConfiguredComponent
      { cc_ann_id :: AnnotatedId ComponentId
cc_ann_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 :: BuildInfo
bi = Component -> BuildInfo
componentBuildInfo Component
component

    prettyLN :: LibraryName -> Doc
    prettyLN :: LibraryName -> Doc
prettyLN LibraryName
LMainLibName = Doc
PP.empty
    prettyLN (LSubLibName UnqualComponentName
n) = Doc
PP.colon Doc -> Doc -> Doc
<<>> UnqualComponentName -> Doc
forall a. Pretty a => a -> Doc
pretty UnqualComponentName
n

    deps_map :: Map (PackageName, ComponentName) (AnnotatedId ComponentId)
    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 a b. (a -> b) -> LogProgress a -> LogProgress b
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
_ NonEmptySet LibraryName
sublibs) -> do
            case PackageName
-> ConfiguredComponentMap
-> Maybe (Map ComponentName (AnnotatedId ComponentId))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name ConfiguredComponentMap
lib_dep_map of
              Maybe (Map ComponentName (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 String
"package"
                    Doc -> Doc -> Doc
<+> PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty PackageName
name
              Just Map ComponentName (AnnotatedId ComponentId)
pkg -> do
                -- 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 (NonEmptySet LibraryName -> [LibraryName]
forall a. NonEmptySet a -> [a]
NonEmptySet.toList NonEmptySet 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 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
name
                        Just AnnotatedId ComponentId
v -> AnnotatedId ComponentId -> LogProgress (AnnotatedId ComponentId)
forall a. a -> LogProgress a
forall (m :: * -> *) a. Monad m => a -> m a
return AnnotatedId ComponentId
v
      else [AnnotatedId ComponentId] -> LogProgress [AnnotatedId ComponentId]
forall a. a -> LogProgress a
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 a. a -> LogProgress a
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 = 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 a b. (a -> b) -> LogProgress a -> LogProgress b
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 a. a -> LogProgress a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfiguredComponent
-> ConfiguredComponentMap -> ConfiguredComponentMap
extendConfiguredComponentMap ConfiguredComponent
cc ConfiguredComponentMap
m, ConfiguredComponent
cc)

newPackageDepsBehaviourMinVersion :: CabalSpecVersion
newPackageDepsBehaviourMinVersion :: CabalSpecVersion
newPackageDepsBehaviourMinVersion = CabalSpecVersion
CabalSpecV1_8

-- 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 -> CabalSpecVersion
specVersion PackageDescription
pkg CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
newPackageDepsBehaviourMinVersion