Commit 1cfec90b authored by Duncan Coutts's avatar Duncan Coutts Committed by Edsko de Vries
Browse files

Extend .cabal format with a custom-setup section

This patch adds it to the package description types and to the parser.
There is a new custom setup section which contains the setup script's
dependencies. Also add some sanity checks.
parent 1effd34b
......@@ -104,6 +104,9 @@ module Distribution.PackageDescription (
RepoKind(..),
RepoType(..),
knownRepoTypes,
-- * Custom setup build information
SetupBuildInfo(..),
) where
import Distribution.Compat.Binary (Binary)
......@@ -186,6 +189,7 @@ data PackageDescription
-- transitioning to specifying just a single version, not a range.
specVersionRaw :: Either Version VersionRange,
buildType :: Maybe BuildType,
setupBuildInfo :: Maybe SetupBuildInfo,
-- components
library :: Maybe Library,
executables :: [Executable],
......@@ -253,6 +257,7 @@ emptyPackageDescription
description = "",
category = "",
customFieldsPD = [],
setupBuildInfo = Nothing,
library = Nothing,
executables = [],
testSuites = [],
......@@ -297,6 +302,29 @@ instance Text BuildType where
"Make" -> Make
_ -> UnknownBuildType name
-- ---------------------------------------------------------------------------
-- The SetupBuildInfo type
-- One can see this as a very cut-down version of BuildInfo below.
-- To keep things simple for tools that compile Setup.hs we limit the
-- options authors can specify to just Haskell package dependencies.
data SetupBuildInfo = SetupBuildInfo {
setupDepends :: [Dependency]
}
deriving (Generic, Show, Eq, Read, Typeable, Data)
instance Binary SetupBuildInfo
instance Monoid SetupBuildInfo where
mempty = SetupBuildInfo {
setupDepends = mempty
}
mappend a b = SetupBuildInfo {
setupDepends = combine setupDepends
}
where combine field = field a `mappend` field b
-- ---------------------------------------------------------------------------
-- Module renaming
......
......@@ -411,6 +411,12 @@ checkFields pkg =
++ commaSep (map display knownBuildTypes)
_ -> Nothing
, check (isJust (setupBuildInfo pkg) && buildType pkg /= Just Custom) $
PackageBuildWarning $
"Ignoring the 'custom-setup' section because the 'build-type' is "
++ "not 'Custom'. Use 'build-type: Custom' if you need to use a "
++ "custom Setup.hs script."
, check (not (null unknownCompilers)) $
PackageBuildWarning $
"Unknown compiler " ++ commaSep (map quote unknownCompilers)
......@@ -1083,6 +1089,16 @@ checkCabalVersion pkg =
++ "specify 'cabal-version: >= 1.4'. Alternatively if you require "
++ "compatibility with earlier Cabal versions then you may be able to "
++ "use an equivalent compiler-specific flag."
, check (specVersion pkg >= Version [1,21] []
&& isNothing (setupBuildInfo pkg)
&& buildType pkg == Just Custom) $
PackageBuildWarning $
"Packages using 'cabal-version: >= 1.22' with 'build-type: Custom' "
++ "must use a 'custom-setup' section with a 'setup-depends' field "
++ "that specifies the dependencies of the Setup.hs script itself. "
++ "The 'setup-depends' field uses the same syntax as 'build-depends', "
++ "so a simple example would be 'setup-depends: base, Cabal'."
]
where
-- Perform a check on packages that use a version of the spec less than
......
......@@ -528,6 +528,15 @@ sourceRepoFieldDescrs =
repoSubdir (\val repo -> repo { repoSubdir = val })
]
------------------------------------------------------------------------------
setupBInfoFieldDescrs :: [FieldDescr SetupBuildInfo]
setupBInfoFieldDescrs =
[ commaListFieldWithSep vcat "setup-depends"
disp parse
setupDepends (\xs binfo -> binfo{setupDepends=xs})
]
-- ---------------------------------------------------------------
-- Parsing
......@@ -739,13 +748,13 @@ parsePackageDescription file = do
-- 'getBody' assumes that the remaining fields only consist of
-- flags, lib and exe sections.
(repos, flags, mlib, exes, tests, bms) <- getBody
(repos, flags, mcsetup, mlib, exes, tests, bms) <- getBody
warnIfRest -- warn if getBody did not parse up to the last field.
-- warn about using old/new syntax with wrong cabal-version:
maybeWarnCabalVersion (not $ oldSyntax fields0) pkg
checkForUndefinedFlags flags mlib exes tests
return $ GenericPackageDescription
pkg { sourceRepos = repos }
pkg { sourceRepos = repos, setupBuildInfo = mcsetup }
flags mlib exes tests bms
where
......@@ -851,6 +860,7 @@ parsePackageDescription file = do
-- The body consists of an optional sequence of declarations of flags and
-- an arbitrary number of executables and at most one library.
getBody :: PM ([SourceRepo], [Flag]
,Maybe SetupBuildInfo
,Maybe (CondTree ConfVar [Dependency] Library)
,[(String, CondTree ConfVar [Dependency] Executable)]
,[(String, CondTree ConfVar [Dependency] TestSuite)]
......@@ -863,8 +873,8 @@ parsePackageDescription file = do
exename <- lift $ runP line_no "executable" parseTokenQ sec_label
flds <- collectFields parseExeFields sec_fields
skipField
(repos, flags, lib, exes, tests, bms) <- getBody
return (repos, flags, lib, (exename, flds): exes, tests, bms)
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
return (repos, flags, csetup, lib, (exename, flds): exes, tests, bms)
| sec_type == "test-suite" -> do
when (null sec_label) $ lift $ syntaxError line_no
......@@ -905,8 +915,9 @@ parsePackageDescription file = do
if checkTestType emptyTestSuite flds
then do
skipField
(repos, flags, lib, exes, tests, bms) <- getBody
return (repos, flags, lib, exes, (testname, flds) : tests, bms)
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
return (repos, flags, csetup, lib, exes,
(testname, flds) : tests, bms)
else lift $ syntaxError line_no $
"Test suite \"" ++ testname
++ "\" is missing required field \"type\" or the field "
......@@ -953,8 +964,9 @@ parsePackageDescription file = do
if checkBenchmarkType emptyBenchmark flds
then do
skipField
(repos, flags, lib, exes, tests, bms) <- getBody
return (repos, flags, lib, exes, tests, (benchname, flds) : bms)
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
return (repos, flags, csetup, lib, exes,
tests, (benchname, flds) : bms)
else lift $ syntaxError line_no $
"Benchmark \"" ++ benchname
++ "\" is missing required field \"type\" or the field "
......@@ -967,10 +979,10 @@ parsePackageDescription file = do
syntaxError line_no "'library' expects no argument"
flds <- collectFields parseLibFields sec_fields
skipField
(repos, flags, lib, exes, tests, bms) <- getBody
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
when (isJust lib) $ lift $ syntaxError line_no
"There can only be one library section in a package description."
return (repos, flags, Just flds, exes, tests, bms)
return (repos, flags, csetup, Just flds, exes, tests, bms)
| sec_type == "flag" -> do
when (null sec_label) $ lift $
......@@ -981,8 +993,8 @@ parsePackageDescription file = do
(MkFlag (FlagName (lowercase sec_label)) "" True False)
sec_fields
skipField
(repos, flags, lib, exes, tests, bms) <- getBody
return (repos, flag:flags, lib, exes, tests, bms)
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
return (repos, flag:flags, csetup, lib, exes, tests, bms)
| sec_type == "source-repository" -> do
when (null sec_label) $ lift $ syntaxError line_no $
......@@ -1006,8 +1018,22 @@ parsePackageDescription file = do
}
sec_fields
skipField
(repos, flags, lib, exes, tests, bms) <- getBody
return (repo:repos, flags, lib, exes, tests, bms)
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
return (repo:repos, flags, csetup, lib, exes, tests, bms)
| sec_type == "custom-setup" -> do
unless (null sec_label) $ lift $
syntaxError line_no "'setup' expects no argument"
flds <- lift $ parseFields
setupBInfoFieldDescrs
warnUnrec
mempty
sec_fields
skipField
(repos, flags, csetup0, lib, exes, tests, bms) <- getBody
when (isJust csetup0) $ lift $ syntaxError line_no
"There can only be one 'custom-setup' section in a package description."
return (repos, flags, Just flds, lib, exes, tests, bms)
| otherwise -> do
lift $ warning $ "Ignoring unknown section type: " ++ sec_type
......@@ -1023,7 +1049,7 @@ parsePackageDescription file = do
"If-blocks are not allowed in between stanzas: " ++ show f
skipField
getBody
Nothing -> return ([], [], Nothing, [], [], [])
Nothing -> return ([], [], Nothing, Nothing, [], [], [])
-- Extracts all fields in a block and returns a 'CondTree'.
--
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment