Skip to content

Commit d938b91

Browse files
dcouttsdcoutts
committed
Merge pull request #2515 from edsko/pr/setup-deps
Introduce "setup dependencies"
2 parents f03e310 + ba317c2 commit d938b91

36 files changed

+2305
-401
lines changed

‎Cabal/Distribution/PackageDescription.hs

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -104,6 +104,9 @@ module Distribution.PackageDescription (
104104
RepoKind(..),
105105
RepoType(..),
106106
knownRepoTypes,
107+
108+
-- * Custom setup build information
109+
SetupBuildInfo(..),
107110
) where
108111

109112
import Distribution.Compat.Binary (Binary)
@@ -190,6 +193,7 @@ data PackageDescription
190193
-- transitioning to specifying just a single version, not a range.
191194
specVersionRaw :: Either Version VersionRange,
192195
buildType :: Maybe BuildType,
196+
setupBuildInfo :: Maybe SetupBuildInfo,
193197
-- components
194198
library :: Maybe Library,
195199
executables :: [Executable],
@@ -257,6 +261,7 @@ emptyPackageDescription
257261
description = "",
258262
category = "",
259263
customFieldsPD = [],
264+
setupBuildInfo = Nothing,
260265
library = Nothing,
261266
executables = [],
262267
testSuites = [],
@@ -301,6 +306,29 @@ instance Text BuildType where
301306
"Make" -> Make
302307
_ -> UnknownBuildType name
303308

309+
-- ---------------------------------------------------------------------------
310+
-- The SetupBuildInfo type
311+
312+
-- One can see this as a very cut-down version of BuildInfo below.
313+
-- To keep things simple for tools that compile Setup.hs we limit the
314+
-- options authors can specify to just Haskell package dependencies.
315+
316+
data SetupBuildInfo = SetupBuildInfo {
317+
setupDepends :: [Dependency]
318+
}
319+
deriving (Generic, Show, Eq, Read, Typeable, Data)
320+
321+
instance Binary SetupBuildInfo
322+
323+
instance Monoid SetupBuildInfo where
324+
mempty = SetupBuildInfo {
325+
setupDepends = mempty
326+
}
327+
mappend a b = SetupBuildInfo {
328+
setupDepends = combine setupDepends
329+
}
330+
where combine field = field a `mappend` field b
331+
304332
-- ---------------------------------------------------------------------------
305333
-- Module renaming
306334

‎Cabal/Distribution/PackageDescription/Check.hs

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -412,6 +412,12 @@ checkFields pkg =
412412
++ commaSep (map display knownBuildTypes)
413413
_ -> Nothing
414414

415+
, check (isJust (setupBuildInfo pkg) && buildType pkg /= Just Custom) $
416+
PackageBuildWarning $
417+
"Ignoring the 'custom-setup' section because the 'build-type' is "
418+
++ "not 'Custom'. Use 'build-type: Custom' if you need to use a "
419+
++ "custom Setup.hs script."
420+
415421
, check (not (null unknownCompilers)) $
416422
PackageBuildWarning $
417423
"Unknown compiler " ++ commaSep (map quote unknownCompilers)
@@ -1055,6 +1061,16 @@ checkCabalVersion pkg =
10551061
++ "specify 'cabal-version: >= 1.4'. Alternatively if you require "
10561062
++ "compatibility with earlier Cabal versions then you may be able to "
10571063
++ "use an equivalent compiler-specific flag."
1064+
1065+
, check (specVersion pkg >= Version [1,21] []
1066+
&& isNothing (setupBuildInfo pkg)
1067+
&& buildType pkg == Just Custom) $
1068+
PackageBuildWarning $
1069+
"Packages using 'cabal-version: >= 1.22' with 'build-type: Custom' "
1070+
++ "must use a 'custom-setup' section with a 'setup-depends' field "
1071+
++ "that specifies the dependencies of the Setup.hs script itself. "
1072+
++ "The 'setup-depends' field uses the same syntax as 'build-depends', "
1073+
++ "so a simple example would be 'setup-depends: base, Cabal'."
10581074
]
10591075
where
10601076
-- Perform a check on packages that use a version of the spec less than

‎Cabal/Distribution/PackageDescription/Parse.hs

Lines changed: 41 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -529,6 +529,15 @@ sourceRepoFieldDescrs =
529529
repoSubdir (\val repo -> repo { repoSubdir = val })
530530
]
531531

532+
------------------------------------------------------------------------------
533+
534+
setupBInfoFieldDescrs :: [FieldDescr SetupBuildInfo]
535+
setupBInfoFieldDescrs =
536+
[ commaListFieldWithSep vcat "setup-depends"
537+
disp parse
538+
setupDepends (\xs binfo -> binfo{setupDepends=xs})
539+
]
540+
532541
-- ---------------------------------------------------------------
533542
-- Parsing
534543

@@ -740,13 +749,13 @@ parsePackageDescription file = do
740749

741750
-- 'getBody' assumes that the remaining fields only consist of
742751
-- flags, lib and exe sections.
743-
(repos, flags, mlib, exes, tests, bms) <- getBody
752+
(repos, flags, mcsetup, mlib, exes, tests, bms) <- getBody
744753
warnIfRest -- warn if getBody did not parse up to the last field.
745754
-- warn about using old/new syntax with wrong cabal-version:
746755
maybeWarnCabalVersion (not $ oldSyntax fields0) pkg
747756
checkForUndefinedFlags flags mlib exes tests
748757
return $ GenericPackageDescription
749-
pkg { sourceRepos = repos }
758+
pkg { sourceRepos = repos, setupBuildInfo = mcsetup }
750759
flags mlib exes tests bms
751760

752761
where
@@ -852,6 +861,7 @@ parsePackageDescription file = do
852861
-- The body consists of an optional sequence of declarations of flags and
853862
-- an arbitrary number of executables and at most one library.
854863
getBody :: PM ([SourceRepo], [Flag]
864+
,Maybe SetupBuildInfo
855865
,Maybe (CondTree ConfVar [Dependency] Library)
856866
,[(String, CondTree ConfVar [Dependency] Executable)]
857867
,[(String, CondTree ConfVar [Dependency] TestSuite)]
@@ -864,8 +874,8 @@ parsePackageDescription file = do
864874
exename <- lift $ runP line_no "executable" parseTokenQ sec_label
865875
flds <- collectFields parseExeFields sec_fields
866876
skipField
867-
(repos, flags, lib, exes, tests, bms) <- getBody
868-
return (repos, flags, lib, (exename, flds): exes, tests, bms)
877+
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
878+
return (repos, flags, csetup, lib, (exename, flds): exes, tests, bms)
869879

870880
| sec_type == "test-suite" -> do
871881
when (null sec_label) $ lift $ syntaxError line_no
@@ -906,8 +916,9 @@ parsePackageDescription file = do
906916
if checkTestType emptyTestSuite flds
907917
then do
908918
skipField
909-
(repos, flags, lib, exes, tests, bms) <- getBody
910-
return (repos, flags, lib, exes, (testname, flds) : tests, bms)
919+
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
920+
return (repos, flags, csetup, lib, exes,
921+
(testname, flds) : tests, bms)
911922
else lift $ syntaxError line_no $
912923
"Test suite \"" ++ testname
913924
++ "\" is missing required field \"type\" or the field "
@@ -954,8 +965,9 @@ parsePackageDescription file = do
954965
if checkBenchmarkType emptyBenchmark flds
955966
then do
956967
skipField
957-
(repos, flags, lib, exes, tests, bms) <- getBody
958-
return (repos, flags, lib, exes, tests, (benchname, flds) : bms)
968+
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
969+
return (repos, flags, csetup, lib, exes,
970+
tests, (benchname, flds) : bms)
959971
else lift $ syntaxError line_no $
960972
"Benchmark \"" ++ benchname
961973
++ "\" is missing required field \"type\" or the field "
@@ -968,10 +980,10 @@ parsePackageDescription file = do
968980
syntaxError line_no "'library' expects no argument"
969981
flds <- collectFields parseLibFields sec_fields
970982
skipField
971-
(repos, flags, lib, exes, tests, bms) <- getBody
983+
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
972984
when (isJust lib) $ lift $ syntaxError line_no
973985
"There can only be one library section in a package description."
974-
return (repos, flags, Just flds, exes, tests, bms)
986+
return (repos, flags, csetup, Just flds, exes, tests, bms)
975987

976988
| sec_type == "flag" -> do
977989
when (null sec_label) $ lift $
@@ -982,8 +994,8 @@ parsePackageDescription file = do
982994
(MkFlag (FlagName (lowercase sec_label)) "" True False)
983995
sec_fields
984996
skipField
985-
(repos, flags, lib, exes, tests, bms) <- getBody
986-
return (repos, flag:flags, lib, exes, tests, bms)
997+
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
998+
return (repos, flag:flags, csetup, lib, exes, tests, bms)
987999

9881000
| sec_type == "source-repository" -> do
9891001
when (null sec_label) $ lift $ syntaxError line_no $
@@ -1007,8 +1019,22 @@ parsePackageDescription file = do
10071019
}
10081020
sec_fields
10091021
skipField
1010-
(repos, flags, lib, exes, tests, bms) <- getBody
1011-
return (repo:repos, flags, lib, exes, tests, bms)
1022+
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
1023+
return (repo:repos, flags, csetup, lib, exes, tests, bms)
1024+
1025+
| sec_type == "custom-setup" -> do
1026+
unless (null sec_label) $ lift $
1027+
syntaxError line_no "'setup' expects no argument"
1028+
flds <- lift $ parseFields
1029+
setupBInfoFieldDescrs
1030+
warnUnrec
1031+
mempty
1032+
sec_fields
1033+
skipField
1034+
(repos, flags, csetup0, lib, exes, tests, bms) <- getBody
1035+
when (isJust csetup0) $ lift $ syntaxError line_no
1036+
"There can only be one 'custom-setup' section in a package description."
1037+
return (repos, flags, Just flds, lib, exes, tests, bms)
10121038

10131039
| otherwise -> do
10141040
lift $ warning $ "Ignoring unknown section type: " ++ sec_type
@@ -1024,7 +1050,7 @@ parsePackageDescription file = do
10241050
"If-blocks are not allowed in between stanzas: " ++ show f
10251051
skipField
10261052
getBody
1027-
Nothing -> return ([], [], Nothing, [], [], [])
1053+
Nothing -> return ([], [], Nothing, Nothing, [], [], [])
10281054

10291055
-- Extracts all fields in a block and returns a 'CondTree'.
10301056
--

‎cabal-install/Distribution/Client/BuildReports/Storage.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ import Distribution.Client.BuildReports.Anonymous (BuildReport)
2828

2929
import Distribution.Client.Types
3030
import qualified Distribution.Client.InstallPlan as InstallPlan
31+
import qualified Distribution.Client.ComponentDeps as CD
3132
import Distribution.Client.InstallPlan
3233
( InstallPlan )
3334

@@ -129,13 +130,13 @@ fromPlanPackage :: Platform -> CompilerId
129130
fromPlanPackage (Platform arch os) comp planPackage = case planPackage of
130131
InstallPlan.Installed (ReadyPackage srcPkg flags _ deps) result
131132
-> Just $ ( BuildReport.new os arch comp
132-
(packageId srcPkg) flags (map packageId deps)
133+
(packageId srcPkg) flags (map packageId (CD.nonSetupDeps deps))
133134
(Right result)
134135
, extractRepo srcPkg)
135136

136137
InstallPlan.Failed (ConfiguredPackage srcPkg flags _ deps) result
137138
-> Just $ ( BuildReport.new os arch comp
138-
(packageId srcPkg) flags (map confSrcId deps)
139+
(packageId srcPkg) flags (map confSrcId (CD.nonSetupDeps deps))
139140
(Left result)
140141
, extractRepo srcPkg )
141142

‎cabal-install/Distribution/Client/ComponentDeps.hs

Lines changed: 142 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,142 @@
1+
-- | Fine-grained package dependencies
2+
--
3+
-- Like many others, this module is meant to be "double-imported":
4+
--
5+
-- > import Distribution.Client.ComponentDeps (
6+
-- > Component
7+
-- > , ComponentDep
8+
-- > , ComponentDeps
9+
-- > )
10+
-- > import qualified Distribution.Client.ComponentDeps as CD
11+
{-# LANGUAGE CPP #-}
12+
{-# LANGUAGE DeriveFunctor #-}
13+
module Distribution.Client.ComponentDeps (
14+
-- * Fine-grained package dependencies
15+
Component(..)
16+
, ComponentDep
17+
, ComponentDeps -- opaque
18+
-- ** Constructing ComponentDeps
19+
, empty
20+
, fromList
21+
, singleton
22+
, insert
23+
, fromLibraryDeps
24+
, fromSetupDeps
25+
, fromInstalled
26+
-- ** Deconstructing ComponentDeps
27+
, toList
28+
, flatDeps
29+
, nonSetupDeps
30+
, libraryDeps
31+
, setupDeps
32+
, select
33+
) where
34+
35+
import Data.Map (Map)
36+
import qualified Data.Map as Map
37+
import Data.Foldable (fold)
38+
39+
#if !MIN_VERSION_base(4,8,0)
40+
import Data.Foldable (Foldable(foldMap))
41+
import Data.Monoid (Monoid(..))
42+
import Data.Traversable (Traversable(traverse))
43+
#endif
44+
45+
{-------------------------------------------------------------------------------
46+
Types
47+
-------------------------------------------------------------------------------}
48+
49+
-- | Component of a package
50+
data Component =
51+
ComponentLib
52+
| ComponentExe String
53+
| ComponentTest String
54+
| ComponentBench String
55+
| ComponentSetup
56+
deriving (Show, Eq, Ord)
57+
58+
-- | Dependency for a single component
59+
type ComponentDep a = (Component, a)
60+
61+
-- | Fine-grained dependencies for a package
62+
newtype ComponentDeps a = ComponentDeps { unComponentDeps :: Map Component a }
63+
deriving (Show, Functor, Eq, Ord)
64+
65+
instance Monoid a => Monoid (ComponentDeps a) where
66+
mempty =
67+
ComponentDeps Map.empty
68+
(ComponentDeps d) `mappend` (ComponentDeps d') =
69+
ComponentDeps (Map.unionWith mappend d d')
70+
71+
instance Foldable ComponentDeps where
72+
foldMap f = foldMap f . unComponentDeps
73+
74+
instance Traversable ComponentDeps where
75+
traverse f = fmap ComponentDeps . traverse f . unComponentDeps
76+
77+
{-------------------------------------------------------------------------------
78+
Construction
79+
-------------------------------------------------------------------------------}
80+
81+
empty :: ComponentDeps a
82+
empty = ComponentDeps $ Map.empty
83+
84+
fromList :: Monoid a => [ComponentDep a] -> ComponentDeps a
85+
fromList = ComponentDeps . Map.fromListWith mappend
86+
87+
singleton :: Component -> a -> ComponentDeps a
88+
singleton comp = ComponentDeps . Map.singleton comp
89+
90+
insert :: Monoid a => Component -> a -> ComponentDeps a -> ComponentDeps a
91+
insert comp a = ComponentDeps . Map.alter aux comp . unComponentDeps
92+
where
93+
aux Nothing = Just a
94+
aux (Just a') = Just $ a `mappend` a'
95+
96+
-- | ComponentDeps containing library dependencies only
97+
fromLibraryDeps :: a -> ComponentDeps a
98+
fromLibraryDeps = singleton ComponentLib
99+
100+
-- | ComponentDeps containing setup dependencies only
101+
fromSetupDeps :: a -> ComponentDeps a
102+
fromSetupDeps = singleton ComponentSetup
103+
104+
-- | ComponentDeps for installed packages
105+
--
106+
-- We assume that installed packages only record their library dependencies
107+
fromInstalled :: a -> ComponentDeps a
108+
fromInstalled = fromLibraryDeps
109+
110+
{-------------------------------------------------------------------------------
111+
Deconstruction
112+
-------------------------------------------------------------------------------}
113+
114+
toList :: ComponentDeps a -> [ComponentDep a]
115+
toList = Map.toList . unComponentDeps
116+
117+
-- | All dependencies of a package
118+
--
119+
-- This is just a synonym for 'fold', but perhaps a use of 'flatDeps' is more
120+
-- obvious than a use of 'fold', and moreover this avoids introducing lots of
121+
-- @#ifdef@s for 7.10 just for the use of 'fold'.
122+
flatDeps :: Monoid a => ComponentDeps a -> a
123+
flatDeps = fold
124+
125+
-- | All dependencies except the setup dependencies
126+
--
127+
-- Prior to the introduction of setup dependencies (TODO: Version? 1.23) this
128+
-- would have been _all_ dependencies
129+
nonSetupDeps :: Monoid a => ComponentDeps a -> a
130+
nonSetupDeps = select (/= ComponentSetup)
131+
132+
-- | Library dependencies proper only
133+
libraryDeps :: Monoid a => ComponentDeps a -> a
134+
libraryDeps = select (== ComponentLib)
135+
136+
-- | Setup dependencies
137+
setupDeps :: Monoid a => ComponentDeps a -> a
138+
setupDeps = select (== ComponentSetup)
139+
140+
-- | Select dependencies satisfying a given predicate
141+
select :: Monoid a => (Component -> Bool) -> ComponentDeps a -> a
142+
select p = foldMap snd . filter (p . fst) . toList

0 commit comments

Comments
 (0)