{-# LANGUAGE PatternGuards #-}
module Distribution.Backpack.ConfiguredComponent (
ConfiguredComponent(..),
cc_name,
cc_cid,
cc_pkgid,
toConfiguredComponent,
toConfiguredComponents,
dispConfiguredComponent,
ConfiguredComponentMap,
extendConfiguredComponentMap,
newPackageDepsBehaviour
) where
import Prelude ()
import Distribution.Compat.Prelude hiding ((<>))
import Distribution.Backpack.Id
import Distribution.CabalSpecVersion
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.ComponentInclude
import Distribution.Package
import Distribution.PackageDescription
import Distribution.Simple.BuildToolDepends
import Distribution.Simple.Setup as Setup
import Distribution.Simple.LocalBuildInfo
import Distribution.Utils.LogProgress
import Distribution.Utils.MapAccum
import Distribution.Utils.Generic
import Control.Monad
import qualified Data.Set as Set
import qualified Distribution.Compat.NonEmptySet as NonEmptySet
import qualified Data.Map as Map
import Distribution.Pretty
import Text.PrettyPrint (Doc, hang, text, vcat, hsep, quotes, ($$))
import qualified Text.PrettyPrint as PP
data ConfiguredComponent
= ConfiguredComponent {
ConfiguredComponent -> AnnotatedId ComponentId
cc_ann_id :: AnnotatedId ComponentId,
ConfiguredComponent -> Component
cc_component :: Component,
ConfiguredComponent -> Bool
cc_public :: Bool,
ConfiguredComponent -> [AnnotatedId ComponentId]
cc_exe_deps :: [AnnotatedId ComponentId],
ConfiguredComponent
-> [ComponentInclude ComponentId IncludeRenaming]
cc_includes :: [ComponentInclude ComponentId IncludeRenaming]
}
cc_cid :: ConfiguredComponent -> ComponentId
cc_cid :: ConfiguredComponent -> ComponentId
cc_cid = forall id. AnnotatedId id -> id
ann_id forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredComponent -> AnnotatedId ComponentId
cc_ann_id
cc_pkgid :: ConfiguredComponent -> PackageId
cc_pkgid :: ConfiguredComponent -> PackageId
cc_pkgid = forall id. AnnotatedId id -> PackageId
ann_pid forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredComponent -> AnnotatedId ComponentId
cc_ann_id
cc_name :: ConfiguredComponent -> ComponentName
cc_name :: ConfiguredComponent -> ComponentName
cc_name = forall id. AnnotatedId id -> ComponentName
ann_cname forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredComponent -> AnnotatedId ComponentId
cc_ann_id
dispConfiguredComponent :: ConfiguredComponent -> Doc
dispConfiguredComponent :: ConfiguredComponent -> Doc
dispConfiguredComponent ConfiguredComponent
cc =
Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"component" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty (ConfiguredComponent -> ComponentId
cc_cid ConfiguredComponent
cc)) Int
4
([Doc] -> Doc
vcat [ [Doc] -> Doc
hsep forall a b. (a -> b) -> a -> b
$ [ String -> Doc
text String
"include"
, forall a. Pretty a => a -> Doc
pretty (forall id rn. ComponentInclude id rn -> id
ci_id ComponentInclude ComponentId IncludeRenaming
incl), forall a. Pretty a => a -> Doc
pretty (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
])
mkConfiguredComponent
:: PackageDescription
-> ComponentId
-> [AnnotatedId ComponentId]
-> [AnnotatedId ComponentId]
-> 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
[ComponentInclude ComponentId IncludeRenaming]
explicit_includes <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (BuildInfo -> [Mixin]
mixins BuildInfo
bi) forall a b. (a -> b) -> a -> b
$ \(Mixin PackageName
pn LibraryName
ln IncludeRenaming
rns) -> do
AnnotatedId ComponentId
aid <- case 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 ->
forall a. Doc -> LogProgress a
dieProgress forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"Mix-in refers to non-existent library" Doc -> Doc -> Doc
<+>
Doc -> Doc
quotes (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 -> forall (m :: * -> *) a. Monad m => a -> m a
return AnnotatedId ComponentId
r
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
}
let used_explicitly :: Set ComponentId
used_explicitly = forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall id rn. ComponentInclude id rn -> id
ci_id [ComponentInclude ComponentId IncludeRenaming]
explicit_includes)
implicit_includes :: [ComponentInclude ComponentId IncludeRenaming]
implicit_includes
= 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
})
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Bool
Set.notMember Set ComponentId
used_explicitly forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall id. AnnotatedId id -> id
ann_id) [AnnotatedId ComponentId]
lib_deps
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 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
<<>> 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 = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ ((forall pkg. Package pkg => pkg -> PackageName
packageName AnnotatedId ComponentId
dep, 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 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (BuildInfo -> [Dependency]
targetBuildDepends BuildInfo
bi) forall a b. (a -> b) -> a -> b
$
\(Dependency PackageName
name VersionRange
_ NonEmptySet LibraryName
sublibs) -> do
Map ComponentName (AnnotatedId ComponentId)
pkg <- case 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 ->
forall a. Doc -> LogProgress a
dieProgress 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
<+> forall a. Pretty a => a -> Doc
pretty PackageName
name
Just Map ComponentName (AnnotatedId ComponentId)
p -> forall (m :: * -> *) a. Monad m => a -> m a
return Map ComponentName (AnnotatedId ComponentId)
p
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a. NonEmptySet a -> [a]
NonEmptySet.toList NonEmptySet LibraryName
sublibs) forall a b. (a -> b) -> a -> b
$ \LibraryName
lib ->
let comp :: ComponentName
comp = LibraryName -> ComponentName
CLibName LibraryName
lib in
case 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 ->
forall a. Doc -> LogProgress a
dieProgress 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
<+> forall a. Pretty a => a -> Doc
pretty PackageName
name
Just AnnotatedId ComponentId
v -> forall (m :: * -> *) a. Monad m => a -> m a
return AnnotatedId ComponentId
v
else 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
old_style_lib_deps :: [AnnotatedId ComponentId]
old_style_lib_deps = [ AnnotatedId ComponentId
e
| (PackageName
pn, Map ComponentName (AnnotatedId ComponentId)
comp_map) <- forall k a. Map k a -> [(k, a)]
Map.toList ConfiguredComponentMap
lib_dep_map
, PackageName
pn forall a. Eq a => a -> a -> Bool
/= forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg_descr
, (ComponentName
cn, AnnotatedId ComponentId
e) <- forall k a. Map k a -> [(k, a)]
Map.toList Map ComponentName (AnnotatedId ComponentId)
comp_map
, ComponentName
cn forall a. Eq a => a -> a -> Bool
== LibraryName -> ComponentName
CLibName LibraryName
LMainLibName ]
exe_deps :: [AnnotatedId ComponentId]
exe_deps = forall a. Ord a => [a] -> [a]
ordNub 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
, Just AnnotatedId ComponentId
exe <- [forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (UnqualComponentName -> ComponentName
CExeName UnqualComponentName
cn) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pn ConfiguredComponentMap
exe_dep_map]
]
toConfiguredComponent'
:: Bool
-> FlagAssignment
-> PackageDescription
-> Bool
-> Flag String
-> Flag ComponentId
-> 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
forall (m :: * -> *) a. Monad m => a -> m a
return 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
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) (forall a. a -> Maybe a
Just ([ComponentId]
deps, FlagAssignment
flags))
deps :: [ComponentId]
deps = [ forall id. AnnotatedId id -> id
ann_id AnnotatedId ComponentId
aid | Map ComponentName (AnnotatedId ComponentId)
m <- forall k a. Map k a -> [a]
Map.elems ConfiguredComponentMap
dep_map
, AnnotatedId ComponentId
aid <- 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 =
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith 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))
(forall k a. k -> a -> Map k a
Map.singleton (ConfiguredComponent -> ComponentName
cc_name ConfiguredComponent
cc) (ConfiguredComponent -> AnnotatedId ComponentId
cc_ann_id ConfiguredComponent
cc))
toConfiguredComponents
:: Bool
-> FlagAssignment
-> Bool
-> Flag String
-> Flag ComponentId
-> 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
= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd (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
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
newPackageDepsBehaviour :: PackageDescription -> Bool
newPackageDepsBehaviour :: PackageDescription -> Bool
newPackageDepsBehaviour PackageDescription
pkg =
PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
newPackageDepsBehaviourMinVersion