Skip to content

Commit f57676b

Browse files
committed
Backpack.
Signed-off-by: Edward Z. Yang <[email protected]>
1 parent 8fff8d8 commit f57676b

File tree

148 files changed

+4296
-920
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

148 files changed

+4296
-920
lines changed

Cabal/Cabal.cabal

Lines changed: 68 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,15 @@ extra-source-files:
4040
tests/PackageTests/AllowOlder/benchmarks/Bench.hs
4141
tests/PackageTests/AllowOlder/src/Foo.hs
4242
tests/PackageTests/AllowOlder/tests/Test.hs
43+
tests/PackageTests/Ambiguity/p/Dupe.hs
44+
tests/PackageTests/Ambiguity/p/p.cabal
45+
tests/PackageTests/Ambiguity/package-import/A.hs
46+
tests/PackageTests/Ambiguity/package-import/package-import.cabal
47+
tests/PackageTests/Ambiguity/q/Dupe.hs
48+
tests/PackageTests/Ambiguity/q/q.cabal
49+
tests/PackageTests/Ambiguity/reexport-test/Main.hs
50+
tests/PackageTests/Ambiguity/reexport-test/reexport-test.cabal
51+
tests/PackageTests/Ambiguity/reexport/reexport.cabal
4352
tests/PackageTests/AutogenModules/Package/Dummy.hs
4453
tests/PackageTests/AutogenModules/Package/MyBenchModule.hs
4554
tests/PackageTests/AutogenModules/Package/MyExeModule.hs
@@ -54,6 +63,44 @@ extra-source-files:
5463
tests/PackageTests/AutogenModules/SrcDist/MyLibrary.hs
5564
tests/PackageTests/AutogenModules/SrcDist/MyTestModule.hs
5665
tests/PackageTests/AutogenModules/SrcDist/my.cabal
66+
tests/PackageTests/Backpack/Includes1/A.hs
67+
tests/PackageTests/Backpack/Includes1/B.hs
68+
tests/PackageTests/Backpack/Includes1/Includes1.cabal
69+
tests/PackageTests/Backpack/Includes2/Includes2.cabal
70+
tests/PackageTests/Backpack/Includes2/exe/Main.hs
71+
tests/PackageTests/Backpack/Includes2/exe/exe.cabal
72+
tests/PackageTests/Backpack/Includes2/fail.cabal
73+
tests/PackageTests/Backpack/Includes2/mylib/Mine.hs
74+
tests/PackageTests/Backpack/Includes2/mylib/mylib.cabal
75+
tests/PackageTests/Backpack/Includes2/mysql/Database/MySQL.hs
76+
tests/PackageTests/Backpack/Includes2/mysql/mysql.cabal
77+
tests/PackageTests/Backpack/Includes2/postgresql/Database/PostgreSQL.hs
78+
tests/PackageTests/Backpack/Includes2/postgresql/postgresql.cabal
79+
tests/PackageTests/Backpack/Includes2/src/App.hs
80+
tests/PackageTests/Backpack/Includes2/src/src.cabal
81+
tests/PackageTests/Backpack/Includes3/Includes3.cabal
82+
tests/PackageTests/Backpack/Includes3/exe/Main.hs
83+
tests/PackageTests/Backpack/Includes3/exe/exe.cabal
84+
tests/PackageTests/Backpack/Includes3/indef/Foo.hs
85+
tests/PackageTests/Backpack/Includes3/indef/indef.cabal
86+
tests/PackageTests/Backpack/Includes3/sigs/sigs.cabal
87+
tests/PackageTests/Backpack/Includes4/Includes4.cabal
88+
tests/PackageTests/Backpack/Includes4/Main.hs
89+
tests/PackageTests/Backpack/Includes4/impl/A.hs
90+
tests/PackageTests/Backpack/Includes4/impl/B.hs
91+
tests/PackageTests/Backpack/Includes4/impl/Rec.hs
92+
tests/PackageTests/Backpack/Includes4/indef/C.hs
93+
tests/PackageTests/Backpack/Includes5/A.hs
94+
tests/PackageTests/Backpack/Includes5/B.hs
95+
tests/PackageTests/Backpack/Includes5/Includes5.cabal
96+
tests/PackageTests/Backpack/Includes5/impl/Foobar.hs
97+
tests/PackageTests/Backpack/Includes5/impl/Quxbaz.hs
98+
tests/PackageTests/Backpack/Indef1/Indef1.cabal
99+
tests/PackageTests/Backpack/Indef1/Provide.hs
100+
tests/PackageTests/Backpack/Reexport1/p/P.hs
101+
tests/PackageTests/Backpack/Reexport1/p/p.cabal
102+
tests/PackageTests/Backpack/Reexport1/q/Q.hs
103+
tests/PackageTests/Backpack/Reexport1/q/q.cabal
57104
tests/PackageTests/BenchmarkExeV10/Foo.hs
58105
tests/PackageTests/BenchmarkExeV10/benchmarks/bench-Foo.hs
59106
tests/PackageTests/BenchmarkExeV10/my.cabal
@@ -209,6 +256,8 @@ extra-source-files:
209256
tests/PackageTests/PreProcessExtraSources/my.cabal
210257
tests/PackageTests/ReexportedModules/containers-dupe/Data/Map.hs
211258
tests/PackageTests/ReexportedModules/containers-dupe/containers-dupe.cabal
259+
tests/PackageTests/ReexportedModules/p/Private.hs
260+
tests/PackageTests/ReexportedModules/p/Public.hs
212261
tests/PackageTests/ReexportedModules/p/fail-ambiguous.cabal
213262
tests/PackageTests/ReexportedModules/p/fail-missing.cabal
214263
tests/PackageTests/ReexportedModules/p/fail-other.cabal
@@ -315,6 +364,21 @@ library
315364
-Wnoncanonical-monadfail-instances
316365

317366
exposed-modules:
367+
Distribution.Backpack
368+
Distribution.Backpack.Configure
369+
Distribution.Backpack.ComponentsGraph
370+
Distribution.Backpack.PreExistingComponent
371+
Distribution.Backpack.ConfiguredComponent
372+
Distribution.Backpack.LinkedComponent
373+
Distribution.Backpack.InstantiatedComponent
374+
Distribution.Backpack.MixLink
375+
Distribution.Backpack.ModSubst
376+
Distribution.Backpack.ModuleScope
377+
Distribution.Backpack.ModuleShape
378+
Distribution.Backpack.UnifyM
379+
Distribution.Backpack.Id
380+
Distribution.Utils.LogProgress
381+
Distribution.Utils.MapAccum
318382
Distribution.Compat.CreatePipe
319383
Distribution.Compat.Environment
320384
Distribution.Compat.Exception
@@ -400,6 +464,7 @@ library
400464
Distribution.Types.Library
401465
Distribution.Types.ModuleReexport
402466
Distribution.Types.ModuleRenaming
467+
Distribution.Types.IncludeRenaming
403468
Distribution.Types.SetupBuildInfo
404469
Distribution.Types.TestSuite
405470
Distribution.Types.TestSuiteInterface
@@ -415,6 +480,9 @@ library
415480
Distribution.Types.ComponentRequestedSpec
416481
Distribution.Types.TargetInfo
417482
Distribution.Utils.NubList
483+
Distribution.Utils.UnionFind
484+
Distribution.Utils.Base62
485+
Distribution.Utils.Progress
418486
Distribution.Verbosity
419487
Distribution.Version
420488
Language.Haskell.Extension

Cabal/Distribution/Backpack.hs

Lines changed: 57 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,57 @@
1+
{-# LANGUAGE FlexibleInstances #-}
2+
{-# LANGUAGE RankNTypes #-}
3+
{-# LANGUAGE PatternGuards #-}
4+
{-# LANGUAGE DeriveGeneric #-}
5+
module Distribution.Backpack (
6+
-- * Utility functions
7+
moduleFreeHoles,
8+
unitIdFreeHoles,
9+
substFreeHoles,
10+
generalizeUnitId,
11+
moduleIsDefinite,
12+
unitIdIsDefinite,
13+
) where
14+
15+
import Prelude ()
16+
import Distribution.Compat.Prelude hiding (mod)
17+
18+
import Distribution.ModuleName
19+
import Distribution.Package
20+
21+
import qualified Data.Map as Map
22+
import Data.Set (Set)
23+
import qualified Data.Set as Set
24+
25+
-----------------------------------------------------------------------
26+
-- Some utility functions.
27+
28+
-- | Get the set of holes ('ModuleVar') embedded in a 'Module'.
29+
moduleFreeHoles :: Module -> Set ModuleName
30+
moduleFreeHoles (ModuleVar mod_name) = Set.singleton mod_name
31+
moduleFreeHoles (Module uid _n) = unitIdFreeHoles uid
32+
33+
-- | Get the set of holes ('ModuleVar') embedded in a 'UnitId'.
34+
unitIdFreeHoles :: UnitId -> Set ModuleName
35+
unitIdFreeHoles (UnitId _ insts) = substFreeHoles insts
36+
unitIdFreeHoles _ = Set.empty
37+
38+
-- | Get the set of holes ('ModuleVar') embedded in a 'ModuleSubst'.
39+
-- This is NOT the domain of the substitution.
40+
substFreeHoles :: ModuleSubst -> Set ModuleName
41+
substFreeHoles insts = Set.unions (map moduleFreeHoles (Map.elems insts))
42+
43+
-- | Given a 'UnitId' which has its holes instantiated in some
44+
-- way, replace this instantiation with the most general possible
45+
-- instantiation. For example, @p[A=q[]:A]@ generalizes to @p[A=<A>]@.
46+
-- When recording dependencies for indefinite packages, we must
47+
-- record the generalized unit ID, since the instantiated unit ID
48+
-- won't exist in the database.
49+
generalizeUnitId :: UnitId -> UnitId
50+
generalizeUnitId (UnitId cid insts) = UnitId cid (Map.mapWithKey (\k _ -> ModuleVar k) insts)
51+
generalizeUnitId uid = uid
52+
53+
moduleIsDefinite :: Module -> Bool
54+
moduleIsDefinite = Set.null . moduleFreeHoles
55+
56+
unitIdIsDefinite :: UnitId -> Bool
57+
unitIdIsDefinite = Set.null . unitIdFreeHoles
Lines changed: 74 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
1+
module Distribution.Backpack.ComponentsGraph (
2+
ComponentsGraph,
3+
dispComponentsGraph,
4+
toComponentsGraph,
5+
componentCycleMsg
6+
) where
7+
8+
import Distribution.Package
9+
import Distribution.PackageDescription as PD hiding (Flag)
10+
import Distribution.Simple.LocalBuildInfo
11+
import Distribution.Types.ComponentRequestedSpec
12+
import Distribution.Simple.Utils
13+
import Distribution.Compat.Graph (Node(..))
14+
import qualified Distribution.Compat.Graph as Graph
15+
16+
import Distribution.Text
17+
( Text(disp) )
18+
import Text.PrettyPrint
19+
20+
------------------------------------------------------------------------------
21+
-- Components graph
22+
------------------------------------------------------------------------------
23+
24+
type ComponentsGraph = [(Component, [ComponentName])]
25+
26+
dispComponentsGraph :: ComponentsGraph -> Doc
27+
dispComponentsGraph graph =
28+
vcat [ hang (text "component" <+> disp (componentName c)) 4
29+
(vcat [ text "dependency" <+> disp cdep | cdep <- cdeps ])
30+
| (c, cdeps) <- graph ]
31+
32+
-- | Given the package description and the set of package names which
33+
-- are considered internal (the current package name and any internal
34+
-- libraries are considered internal), create a graph of dependencies
35+
-- between the components. This is NOT necessarily the build order
36+
-- (although it is in the absence of Backpack.)
37+
toComponentsGraph :: ComponentRequestedSpec
38+
-> PackageDescription
39+
-> Either [ComponentName] ComponentsGraph
40+
toComponentsGraph enabled pkg_descr =
41+
let g = Graph.fromList [ N c (componentName c) (componentDeps c)
42+
| c <- pkgBuildableComponents pkg_descr
43+
, componentEnabled enabled c ]
44+
in case Graph.cycles g of
45+
[] -> Right (map (\(N c _ cs) -> (c, cs)) (Graph.revTopSort g))
46+
ccycles -> Left [ componentName c | N c _ _ <- concat ccycles ]
47+
where
48+
-- The dependencies for the given component
49+
componentDeps component =
50+
[ CExeName toolname | Dependency pkgname _
51+
<- buildTools bi
52+
, let toolname = unPackageName pkgname
53+
, toolname `elem` map exeName
54+
(executables pkg_descr) ]
55+
56+
++ [ if pkgname == packageName pkg_descr
57+
then CLibName
58+
else CSubLibName toolname
59+
| Dependency pkgname _
60+
<- targetBuildDepends bi
61+
, pkgname `elem` internalPkgDeps
62+
, let toolname = unPackageName pkgname ]
63+
where
64+
bi = componentBuildInfo component
65+
internalPkgDeps = map (conv . libName) (allLibraries pkg_descr)
66+
conv Nothing = packageName pkg_descr
67+
conv (Just s) = mkPackageName s
68+
69+
componentCycleMsg :: [ComponentName] -> Doc
70+
componentCycleMsg cnames =
71+
text $ "Components in the package depend on each other in a cyclic way:\n "
72+
++ intercalate " depends on "
73+
[ "'" ++ showComponentName cname ++ "'"
74+
| cname <- cnames ++ [head cnames] ]

0 commit comments

Comments
 (0)