Cabal/src/Distribution/Backpack/ConfiguredComponent.hs

   1 {-# LANGUAGE PatternGuards #-}
   2
   3 -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
   4 module Distribution.Backpack.ConfiguredComponent
   5   ( ConfiguredComponent (..)
   6   , cc_name
   7   , cc_cid
   8   , cc_pkgid
   9   , toConfiguredComponent
  10   , toConfiguredComponents
  11   , dispConfiguredComponent
  12   , ConfiguredComponentMap
  13   , extendConfiguredComponentMap
  14   -- TODO: Should go somewhere else
  15   , newPackageDepsBehaviour
  16   ) where
  17
  18 import Distribution.Compat.Prelude hiding ((<>))
  19 import Prelude ()
  20
  21 import Distribution.Backpack.Id
  22
  23 import Distribution.CabalSpecVersion
  24 import Distribution.Package
  25 import Distribution.PackageDescription
  26 import Distribution.Simple.BuildToolDepends
  27 import Distribution.Simple.Flag (Flag)
  28 import Distribution.Simple.LocalBuildInfo
  29 import Distribution.Types.AnnotatedId
  30 import Distribution.Types.ComponentInclude
  31 import Distribution.Utils.Generic
  32 import Distribution.Utils.LogProgress
  33 import Distribution.Utils.MapAccum
  34
  35 import Control.Monad
  36 import qualified Data.Map as Map
  37 import qualified Data.Set as Set
  38 import qualified Distribution.Compat.NonEmptySet as NonEmptySet
  39 import Distribution.Pretty
  40 import Text.PrettyPrint (Doc, hang, hsep, quotes, text, vcat, ($$))
  41 import qualified Text.PrettyPrint as PP
  42
  43 -- | A configured component, we know exactly what its 'ComponentId' is,
  44 -- and the 'ComponentId's of the things it depends on.
  45 data ConfiguredComponent = ConfiguredComponent
  46   { cc_ann_id :: AnnotatedId ComponentId
  47   -- ^ Unique identifier of component, plus extra useful info.
  48   , cc_component :: Component
  49   -- ^ The fragment of syntax from the Cabal file describing this
  50   -- component.
  51   , cc_public :: Bool
  52   -- ^ Is this the public library component of the package?
  53   -- (If we invoke Setup with an instantiation, this is the
  54   -- component the instantiation applies to.)
  55   -- Note that in one-component configure mode, this is
  56   -- always True, because any component is the "public" one.)
  57   , cc_exe_deps :: [AnnotatedId ComponentId]
  58   -- ^ Dependencies on executables from @build-tools@ and
  59   -- @build-tool-depends@.
  60   , cc_includes :: [ComponentInclude ComponentId IncludeRenaming]
  61   -- ^ The mixins of this package, including both explicit (from
  62   -- the @mixins@ field) and implicit (from @build-depends@).  Not
  63   -- mix-in linked yet; component configuration only looks at
  64   -- 'ComponentId's.
  65   }
  66
  67 -- | Uniquely identifies a configured component.
  68 cc_cid :: ConfiguredComponent -> ComponentId
  69 cc_cid = ann_id . cc_ann_id
  70
  71 -- | The package this component came from.
  72 cc_pkgid :: ConfiguredComponent -> PackageId
  73 cc_pkgid = ann_pid . cc_ann_id
  74
  75 -- | The 'ComponentName' of a component; this uniquely identifies
  76 -- a fragment of syntax within a specified Cabal file describing the
  77 -- component.
  78 cc_name :: ConfiguredComponent -> ComponentName
  79 cc_name = ann_cname . cc_ann_id
  80
  81 -- | Pretty-print a 'ConfiguredComponent'.
  82 dispConfiguredComponent :: ConfiguredComponent -> Doc
  83 dispConfiguredComponent cc =
  84   hang
  85     (text "component" <+> pretty (cc_cid cc))
  86     4
  87     ( vcat
  88         [ hsep $
  89           [ text "include"
  90           , pretty (ci_id incl)
  91           , pretty (ci_renaming incl)
  92           ]
  93         | incl <- cc_includes cc
  94         ]
  95     )
  96
  97 -- | Construct a 'ConfiguredComponent', given that the 'ComponentId'
  98 -- and library/executable dependencies are known.  The primary
  99 -- work this does is handling implicit @backpack-include@ fields.
 100 mkConfiguredComponent
 101   :: PackageDescription
 102   -> ComponentId
 103   -> [AnnotatedId ComponentId] -- lib deps
 104   -> [AnnotatedId ComponentId] -- exe deps
 105   -> Component
 106   -> LogProgress ConfiguredComponent
 107 mkConfiguredComponent pkg_descr this_cid lib_deps exe_deps component = do
 108   -- Resolve each @mixins@ into the actual dependency
 109   -- from @lib_deps@.
 110   explicit_includes <- forM (mixins bi) $ \(Mixin pn ln rns) -> do
 111     aid <- case Map.lookup (pn, CLibName ln) deps_map of
 112       Nothing ->
 113         dieProgress $
 114           text "Mix-in refers to non-existent library"
 115             <+> quotes (pretty pn <<>> prettyLN ln)
 116             $$ text "(did you forget to add the package to build-depends?)"
 117       Just r -> return r
 118     return
 119       ComponentInclude
 120         { ci_ann_id = aid
 121         , ci_renaming = rns
 122         , ci_implicit = False
 123         }
 124
 125   -- Any @build-depends@ which is not explicitly mentioned in
 126   -- @backpack-include@ is converted into an "implicit" include.
 127   let used_explicitly = Set.fromList (map ci_id explicit_includes)
 128       implicit_includes =
 129         map
 130           ( \aid ->
 131               ComponentInclude
 132                 { ci_ann_id = aid
 133                 , ci_renaming = defaultIncludeRenaming
 134                 , ci_implicit = True
 135                 }
 136           )
 137           $ filter (flip Set.notMember used_explicitly . ann_id) lib_deps
 138
 139   return
 140     ConfiguredComponent
 141       { cc_ann_id =
 142           AnnotatedId
 143             { ann_id = this_cid
 144             , ann_pid = package pkg_descr
 145             , ann_cname = componentName component
 146             }
 147       , cc_component = component
 148       , cc_public = is_public
 149       , cc_exe_deps = exe_deps
 150       , cc_includes = explicit_includes ++ implicit_includes
 151       }
 152   where
 153     bi :: BuildInfo
 154     bi = componentBuildInfo component
 155
 156     prettyLN :: LibraryName -> Doc
 157     prettyLN LMainLibName = PP.empty
 158     prettyLN (LSubLibName n) = PP.colon <<>> pretty n
 159
 160     deps_map :: Map (PackageName, ComponentName) (AnnotatedId ComponentId)
 161     deps_map =
 162       Map.fromList
 163         [ ((packageName dep, ann_cname dep), dep)
 164         | dep <- lib_deps
 165         ]
 166
 167     is_public = componentName component == CLibName LMainLibName
 168
 169 type ConfiguredComponentMap =
 170   Map PackageName (Map ComponentName (AnnotatedId ComponentId))
 171
 172 toConfiguredComponent
 173   :: PackageDescription
 174   -> ComponentId
 175   -> ConfiguredComponentMap
 176   -> ConfiguredComponentMap
 177   -> Component
 178   -> LogProgress ConfiguredComponent
 179 toConfiguredComponent pkg_descr this_cid lib_dep_map exe_dep_map component = do
 180   lib_deps <-
 181     if newPackageDepsBehaviour pkg_descr
 182       then fmap concat $
 183         forM (targetBuildDepends bi) $
 184           \(Dependency name _ sublibs) -> do
 185             case Map.lookup name lib_dep_map of
 186               Nothing ->
 187                 dieProgress $
 188                   text "Dependency on unbuildable"
 189                     <+> text "package"
 190                     <+> pretty name
 191               Just pkg -> do
 192                 -- Return all library components
 193                 forM (NonEmptySet.toList sublibs) $ \lib ->
 194                   let comp = CLibName lib
 195                    in case Map.lookup comp pkg of
 196                         Nothing ->
 197                           dieProgress $
 198                             text "Dependency on unbuildable"
 199                               <+> text (showLibraryName lib)
 200                               <+> text "from"
 201                               <+> pretty name
 202                         Just v -> return v
 203       else return old_style_lib_deps
 204   mkConfiguredComponent
 205     pkg_descr
 206     this_cid
 207     lib_deps
 208     exe_deps
 209     component
 210   where
 211     bi = componentBuildInfo component
 212     -- lib_dep_map contains a mix of internal and external deps.
 213     -- We want all the public libraries (dep_cn == CLibName)
 214     -- of all external deps (dep /= pn).  Note that this
 215     -- excludes the public library of the current package:
 216     -- this is not supported by old-style deps behavior
 217     -- because it would imply a cyclic dependency for the
 218     -- library itself.
 219     old_style_lib_deps =
 220       [ e
 221       | (pn, comp_map) <- Map.toList lib_dep_map
 222       , pn /= packageName pkg_descr
 223       , (cn, e) <- Map.toList comp_map
 224       , cn == CLibName LMainLibName
 225       ]
 226     -- We have to nub here, because 'getAllToolDependencies' may return
 227     -- duplicates (see #4986).  (NB: This is not needed for lib_deps,
 228     -- since those elaborate into includes, for which there explicitly
 229     -- may be multiple instances of a package)
 230     exe_deps =
 231       ordNub $
 232         [ exe
 233         | ExeDependency pn cn _ <- getAllToolDependencies pkg_descr bi
 234         , -- The error suppression here is important, because in general
 235         -- we won't know about external dependencies (e.g., 'happy')
 236         -- which the package is attempting to use (those deps are only
 237         -- fed in when cabal-install uses this codepath.)
 238         -- TODO: Let cabal-install request errors here
 239         Just exe <- [Map.lookup (CExeName cn) =<< Map.lookup pn exe_dep_map]
 240         ]
 241
 242 -- | Also computes the 'ComponentId', and sets cc_public if necessary.
 243 -- This is Cabal-only; cabal-install won't use this.
 244 toConfiguredComponent'
 245   :: Bool -- use_external_internal_deps
 246   -> FlagAssignment
 247   -> PackageDescription
 248   -> Bool -- deterministic
 249   -> Flag String -- configIPID (todo: remove me)
 250   -> Flag ComponentId -- configCID
 251   -> ConfiguredComponentMap
 252   -> Component
 253   -> LogProgress ConfiguredComponent
 254 toConfiguredComponent'
 255   use_external_internal_deps
 256   flags
 257   pkg_descr
 258   deterministic
 259   ipid_flag
 260   cid_flag
 261   dep_map
 262   component = do
 263     cc <-
 264       toConfiguredComponent
 265         pkg_descr
 266         this_cid
 267         dep_map
 268         dep_map
 269         component
 270     return $
 271       if use_external_internal_deps
 272         then cc{cc_public = True}
 273         else cc
 274     where
 275       -- TODO: pass component names to it too!
 276       this_cid =
 277         computeComponentId
 278           deterministic
 279           ipid_flag
 280           cid_flag
 281           (package pkg_descr)
 282           (componentName component)
 283           (Just (deps, flags))
 284       deps =
 285         [ ann_id aid | m <- Map.elems dep_map, aid <- Map.elems m
 286         ]
 287
 288 extendConfiguredComponentMap
 289   :: ConfiguredComponent
 290   -> ConfiguredComponentMap
 291   -> ConfiguredComponentMap
 292 extendConfiguredComponentMap cc =
 293   Map.insertWith
 294     Map.union
 295     (pkgName (cc_pkgid cc))
 296     (Map.singleton (cc_name cc) (cc_ann_id cc))
 297
 298 -- Compute the 'ComponentId's for a graph of 'Component's.  The
 299 -- list of internal components must be topologically sorted
 300 -- based on internal package dependencies, so that any internal
 301 -- dependency points to an entry earlier in the list.
 302 --
 303 -- TODO: This function currently restricts the input configured components to
 304 -- one version per package, by using the type ConfiguredComponentMap.  It cannot
 305 -- be used to configure a component that depends on one version of a package for
 306 -- a library and another version for a build-tool.
 307 toConfiguredComponents
 308   :: Bool -- use_external_internal_deps
 309   -> FlagAssignment
 310   -> Bool -- deterministic
 311   -> Flag String -- configIPID
 312   -> Flag ComponentId -- configCID
 313   -> PackageDescription
 314   -> ConfiguredComponentMap
 315   -> [Component]
 316   -> LogProgress [ConfiguredComponent]
 317 toConfiguredComponents
 318   use_external_internal_deps
 319   flags
 320   deterministic
 321   ipid_flag
 322   cid_flag
 323   pkg_descr
 324   dep_map
 325   comps =
 326     fmap snd (mapAccumM go dep_map comps)
 327     where
 328       go m component = do
 329         cc <-
 330           toConfiguredComponent'
 331             use_external_internal_deps
 332             flags
 333             pkg_descr
 334             deterministic
 335             ipid_flag
 336             cid_flag
 337             m
 338             component
 339         return (extendConfiguredComponentMap cc m, cc)
 340
 341 newPackageDepsBehaviourMinVersion :: CabalSpecVersion
 342 newPackageDepsBehaviourMinVersion = CabalSpecV1_8
 343
 344 -- In older cabal versions, there was only one set of package dependencies for
 345 -- the whole package. In this version, we can have separate dependencies per
 346 -- target, but we only enable this behaviour if the minimum cabal version
 347 -- specified is >= a certain minimum. Otherwise, for compatibility we use the
 348 -- old behaviour.
 349 newPackageDepsBehaviour :: PackageDescription -> Bool
 350 newPackageDepsBehaviour pkg =
 351   specVersion pkg >= newPackageDepsBehaviourMinVersion