Commit 2040c1c9 authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Implement "convenience libraries", fixes #269.



Convenience libraries are package-private libraries
that can be used as part of executables, libraries, etc
without being exposed to the external world.  Private
libraries are signified using the

    library foo

stanza.  Within a Cabal package, the name convenience library
shadows the conventional meaning of package name in
build-depends, so that references to "foo" do not indicate
foo in Hackage, but the convenience library defined in the
same package. (So, don't shadow Hackage packages!)

This commit implements convenience libraries such that they
ARE installed the package database (this prevents us from
having to special case dynamically linked executables);
in GHC 7.10 and later they are installed under the same
package name as the package that contained them, but have
a distinct "component ID" (one pay off of making the distinction
between component IDs and installed package IDs.)

There is a "default" library which is identified by the fact
that its library name coincides with the package name.  There
are some new convenience functions to permit referencing this.

There are a few latent bugs in this commit which are fixed
in later commits in this patchset.  (Those bugfixes required
a bit of refactoring, so it's clearer if they're not
with this patch.)
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 3c03ccce
......@@ -119,6 +119,14 @@ extra-source-files:
tests/PackageTests/HaddockNewline/A.hs
tests/PackageTests/HaddockNewline/HaddockNewline.cabal
tests/PackageTests/HaddockNewline/Setup.hs
tests/PackageTests/MultipleLibraries/p.cabal
tests/PackageTests/MultipleLibraries/p/P.hs
tests/PackageTests/MultipleLibraries/p/Foo.hs
tests/PackageTests/MultipleLibraries/p/p.cabal
tests/PackageTests/MultipleLibraries/p/p/P.hs
tests/PackageTests/MultipleLibraries/p/q/Q.hs
tests/PackageTests/MultipleLibraries/q/Q.hs
tests/PackageTests/MultipleLibraries/q/q.cabal
tests/PackageTests/Options.hs
tests/PackageTests/OrderFlags/Foo.hs
tests/PackageTests/OrderFlags/my.cabal
......
......@@ -189,7 +189,7 @@ data PackageDescription
buildType :: Maybe BuildType,
setupBuildInfo :: Maybe SetupBuildInfo,
-- components
library :: Maybe Library,
libraries :: [Library],
executables :: [Executable],
testSuites :: [TestSuite],
benchmarks :: [Benchmark],
......@@ -256,7 +256,7 @@ emptyPackageDescription
category = "",
customFieldsPD = [],
setupBuildInfo = Nothing,
library = Nothing,
libraries = [],
executables = [],
testSuites = [],
benchmarks = [],
......@@ -387,6 +387,7 @@ instance Text ModuleRenaming where
-- The Library type
data Library = Library {
libName :: String,
exposedModules :: [ModuleName],
reexportedModules :: [ModuleReexport],
requiredSignatures:: [ModuleName], -- ^ What sigs need implementations?
......@@ -400,6 +401,7 @@ instance Binary Library
instance Monoid Library where
mempty = Library {
libName = mempty,
exposedModules = mempty,
reexportedModules = mempty,
requiredSignatures = mempty,
......@@ -411,6 +413,7 @@ instance Monoid Library where
instance Semigroup Library where
a <> b = Library {
libName = combine' libName,
exposedModules = combine exposedModules,
reexportedModules = combine reexportedModules,
requiredSignatures = combine requiredSignatures,
......@@ -419,20 +422,26 @@ instance Semigroup Library where
libBuildInfo = combine libBuildInfo
}
where combine field = field a `mappend` field b
combine' field = case (field a, field b) of
("","") -> ""
("", x) -> x
(x, "") -> x
(x, y) -> error $ "Ambiguous values for library field: '"
++ x ++ "' and '" ++ y ++ "'"
emptyLibrary :: Library
emptyLibrary = mempty
-- |does this package have any libraries?
hasLibs :: PackageDescription -> Bool
hasLibs p = maybe False (buildable . libBuildInfo) (library p)
hasLibs p = any (buildable . libBuildInfo) (libraries p)
-- |'Maybe' version of 'hasLibs'
maybeHasLibs :: PackageDescription -> Maybe Library
maybeHasLibs :: PackageDescription -> [Library]
maybeHasLibs p =
library p >>= \lib -> if buildable (libBuildInfo lib)
then Just lib
else Nothing
libraries p >>= \lib -> if buildable (libBuildInfo lib)
then return lib
else []
-- |If the package description has a library section, call the given
-- function with the library build info as argument.
......@@ -915,7 +924,7 @@ emptyBuildInfo = mempty
-- all buildable executables, test suites and benchmarks. Useful for gathering
-- dependencies.
allBuildInfo :: PackageDescription -> [BuildInfo]
allBuildInfo pkg_descr = [ bi | Just lib <- [library pkg_descr]
allBuildInfo pkg_descr = [ bi | lib <- libraries pkg_descr
, let bi = libBuildInfo lib
, buildable bi ]
++ [ bi | exe <- executables pkg_descr
......@@ -950,10 +959,10 @@ usedExtensions :: BuildInfo -> [Extension]
usedExtensions bi = oldExtensions bi
++ defaultExtensions bi
type HookedBuildInfo = (Maybe BuildInfo, [(String, BuildInfo)])
type HookedBuildInfo = ([(String, BuildInfo)], [(String, BuildInfo)])
emptyHookedBuildInfo :: HookedBuildInfo
emptyHookedBuildInfo = (Nothing, [])
emptyHookedBuildInfo = ([], [])
-- |Select options for a particular Haskell compiler.
hcOptions :: CompilerFlavor -> BuildInfo -> [String]
......@@ -1109,28 +1118,30 @@ lowercase = map Char.toLower
-- ------------------------------------------------------------
updatePackageDescription :: HookedBuildInfo -> PackageDescription -> PackageDescription
updatePackageDescription (mb_lib_bi, exe_bi) p
= p{ executables = updateExecutables exe_bi (executables p)
, library = updateLibrary mb_lib_bi (library p)
updatePackageDescription (lib_bi, exe_bi) p
= p{ executables = updateMany exeName updateExecutable exe_bi (executables p)
, libraries = updateMany libName updateLibrary lib_bi (libraries p)
}
where
updateLibrary :: Maybe BuildInfo -> Maybe Library -> Maybe Library
updateLibrary (Just bi) (Just lib) = Just (lib{libBuildInfo = bi `mappend` libBuildInfo lib})
updateLibrary Nothing mb_lib = mb_lib
updateLibrary (Just _) Nothing = Nothing
updateExecutables :: [(String, BuildInfo)] -- ^[(exeName, new buildinfo)]
-> [Executable] -- ^list of executables to update
-> [Executable] -- ^list with exeNames updated
updateExecutables exe_bi' executables' = foldr updateExecutable executables' exe_bi'
updateExecutable :: (String, BuildInfo) -- ^(exeName, new buildinfo)
-> [Executable] -- ^list of executables to update
-> [Executable] -- ^list with exeName updated
updateExecutable _ [] = []
updateExecutable exe_bi'@(name,bi) (exe:exes)
| exeName exe == name = exe{buildInfo = bi `mappend` buildInfo exe} : exes
| otherwise = exe : updateExecutable exe_bi' exes
updateMany :: (a -> String) -- ^ @exeName@ or @libName@
-> (BuildInfo -> a -> a) -- ^ @updateExecutable@ or @updateLibrary@
-> [(String, BuildInfo)] -- ^[(name, new buildinfo)]
-> [a] -- ^list of components to update
-> [a] -- ^list with updated components
updateMany name update hooked_bi' cs' = foldr (updateOne name update) cs' hooked_bi'
updateOne :: (a -> String) -- ^ @exeName@ or @libName@
-> (BuildInfo -> a -> a) -- ^ @updateExecutable@ or @updateLibrary@
-> (String, BuildInfo) -- ^(name, new buildinfo)
-> [a] -- ^list of components to update
-> [a] -- ^list with name component updated
updateOne _ _ _ [] = []
updateOne name_sel update hooked_bi'@(name,bi) (c:cs)
| name_sel c == name = update bi c : cs
| otherwise = c : updateOne name_sel update hooked_bi' cs
updateExecutable bi exe = exe{buildInfo = bi `mappend` buildInfo exe}
updateLibrary bi lib = lib{libBuildInfo = bi `mappend` libBuildInfo lib}
-- ---------------------------------------------------------------------------
-- The GenericPackageDescription type
......@@ -1139,7 +1150,7 @@ data GenericPackageDescription =
GenericPackageDescription {
packageDescription :: PackageDescription,
genPackageFlags :: [Flag],
condLibrary :: Maybe (CondTree ConfVar [Dependency] Library),
condLibraries :: [(String, CondTree ConfVar [Dependency] Library)],
condExecutables :: [(String, CondTree ConfVar [Dependency] Executable)],
condTestSuites :: [(String, CondTree ConfVar [Dependency] TestSuite)],
condBenchmarks :: [(String, CondTree ConfVar [Dependency] Benchmark)]
......
......@@ -46,7 +46,7 @@ import Distribution.Text
import Language.Haskell.Extension
import Data.Maybe
( isNothing, isJust, catMaybes, mapMaybe, maybeToList, fromMaybe )
( isNothing, isJust, catMaybes, mapMaybe, fromMaybe )
import Data.List (sort, group, isPrefixOf, nub, find)
import Control.Monad
( filterM, liftM )
......@@ -173,7 +173,7 @@ checkSanity pkg =
, check (all ($ pkg) [ null . executables
, null . testSuites
, null . benchmarks
, isNothing . library ]) $
, null . libraries ]) $
PackageBuildImpossible
"No executables, libraries, tests, or benchmarks found. Nothing to do."
......@@ -185,7 +185,7 @@ checkSanity pkg =
--TODO: check for name clashes case insensitively: windows file systems cannot
--cope.
++ maybe [] (checkLibrary pkg) (library pkg)
++ concatMap (checkLibrary pkg) (libraries pkg)
++ concatMap (checkExecutable pkg) (executables pkg)
++ concatMap (checkTestSuite pkg) (testSuites pkg)
++ concatMap (checkBenchmark pkg) (benchmarks pkg)
......@@ -681,7 +681,7 @@ checkGhcOptions pkg =
where
all_ghc_options = concatMap get_ghc_options (allBuildInfo pkg)
lib_ghc_options = maybe [] (get_ghc_options . libBuildInfo) (library pkg)
lib_ghc_options = concatMap (get_ghc_options . libBuildInfo) (libraries pkg)
get_ghc_options bi = hcOptions GHC bi ++ hcProfOptions GHC bi
++ hcSharedOptions GHC bi
......@@ -904,9 +904,18 @@ checkCabalVersion pkg =
++ "different modules then list the other ones in the "
++ "'other-languages' field."
, checkVersion [1,23]
(case libraries pkg of
[lib] -> libName lib /= unPackageName (packageName pkg)
[] -> False
_ -> True) $
PackageDistInexcusable $
"To use multiple 'library' sections or a named library section "
++ "the package needs to specify at least 'cabal-version >= 1.23'."
-- check use of reexported-modules sections
, checkVersion [1,21]
(maybe False (not.null.reexportedModules) (library pkg)) $
(any (not.null.reexportedModules) (libraries pkg)) $
PackageDistInexcusable $
"To use the 'reexported-module' field the package needs to specify "
++ "at least 'cabal-version: >= 1.21'."
......@@ -1312,7 +1321,7 @@ checkConditionals pkg =
unknownOSs = [ os | OS (OtherOS os) <- conditions ]
unknownArches = [ arch | Arch (OtherArch arch) <- conditions ]
unknownImpls = [ impl | Impl (OtherCompiler impl) _ <- conditions ]
conditions = maybe [] fvs (condLibrary pkg)
conditions = concatMap (fvs . snd) (condLibraries pkg)
++ concatMap (fvs . snd) (condExecutables pkg)
fvs (CondNode _ _ ifs) = concatMap compfv ifs -- free variables
compfv (c, ct, mct) = condfv c ++ fvs ct ++ maybe [] fvs mct
......@@ -1416,8 +1425,8 @@ checkDevelopmentOnlyFlags pkg =
allConditionalBuildInfo :: [([Condition ConfVar], BuildInfo)]
allConditionalBuildInfo =
concatMap (collectCondTreePaths libBuildInfo)
(maybeToList (condLibrary pkg))
concatMap (collectCondTreePaths libBuildInfo . snd)
(condLibraries pkg)
++ concatMap (collectCondTreePaths buildInfo . snd)
(condExecutables pkg)
......
......@@ -274,7 +274,7 @@ resolveWithFlags dom os arch impl constrs trees checkDeps =
env flags flag = (maybe (Left flag) Right . lookup flag) flags
pdTaggedBuildInfo :: PDTagged -> BuildInfo
pdTaggedBuildInfo (Lib l) = libBuildInfo l
pdTaggedBuildInfo (Lib _ l) = libBuildInfo l
pdTaggedBuildInfo (Exe _ e) = buildInfo e
pdTaggedBuildInfo (Test _ t) = testBuildInfo t
pdTaggedBuildInfo (Bench _ b) = benchmarkBuildInfo b
......@@ -410,7 +410,7 @@ overallDependencies (TargetSet targets) = mconcat depss
where
(depss, _) = unzip $ filter (removeDisabledSections . snd) targets
removeDisabledSections :: PDTagged -> Bool
removeDisabledSections (Lib l) = buildable (libBuildInfo l)
removeDisabledSections (Lib _ l) = buildable (libBuildInfo l)
removeDisabledSections (Exe _ e) = buildable (buildInfo e)
removeDisabledSections (Test _ t) = testEnabled t && buildable (testBuildInfo t)
removeDisabledSections (Bench _ b) = benchmarkEnabled b && buildable (benchmarkBuildInfo b)
......@@ -435,50 +435,53 @@ constrainBy left extra =
-- | Collect up the targets in a TargetSet of tagged targets, storing the
-- dependencies as we go.
flattenTaggedTargets :: TargetSet PDTagged ->
(Maybe Library, [(String, Executable)], [(String, TestSuite)]
([(String, Library)], [(String, Executable)], [(String, TestSuite)]
, [(String, Benchmark)])
flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, [], [], []) targets
flattenTaggedTargets (TargetSet targets) = foldr untag ([], [], [], []) targets
where
untag (_, Lib _) (Just _, _, _, _) = userBug "Only one library expected"
untag (deps, Lib l) (Nothing, exes, tests, bms) =
(Just l', exes, tests, bms)
untag (deps, Lib n l) (libs, exes, tests, bms)
| any ((== n) . fst) libs =
userBug $ "There exist several libs with the same name: '" ++ n ++ "'"
-- NB: libraries live in a different namespace than everything else
-- TODO: no, (new-style) TESTS live in same namespace!!
| otherwise = ((n, l'):libs, exes, tests, bms)
where
l' = l {
libBuildInfo = (libBuildInfo l) { targetBuildDepends = fromDepMap deps }
}
untag (deps, Exe n e) (mlib, exes, tests, bms)
untag (deps, Exe n e) (libs, exes, tests, bms)
| any ((== n) . fst) exes =
userBug $ "There exist several exes with the same name: '" ++ n ++ "'"
| any ((== n) . fst) tests =
userBug $ "There exists a test with the same name as an exe: '" ++ n ++ "'"
| any ((== n) . fst) bms =
userBug $ "There exists a benchmark with the same name as an exe: '" ++ n ++ "'"
| otherwise = (mlib, (n, e'):exes, tests, bms)
| otherwise = (libs, (n, e'):exes, tests, bms)
where
e' = e {
buildInfo = (buildInfo e) { targetBuildDepends = fromDepMap deps }
}
untag (deps, Test n t) (mlib, exes, tests, bms)
untag (deps, Test n t) (libs, exes, tests, bms)
| any ((== n) . fst) tests =
userBug $ "There exist several tests with the same name: '" ++ n ++ "'"
| any ((== n) . fst) exes =
userBug $ "There exists an exe with the same name as the test: '" ++ n ++ "'"
| any ((== n) . fst) bms =
userBug $ "There exists a benchmark with the same name as the test: '" ++ n ++ "'"
| otherwise = (mlib, exes, (n, t'):tests, bms)
| otherwise = (libs, exes, (n, t'):tests, bms)
where
t' = t {
testBuildInfo = (testBuildInfo t)
{ targetBuildDepends = fromDepMap deps }
}
untag (deps, Bench n b) (mlib, exes, tests, bms)
untag (deps, Bench n b) (libs, exes, tests, bms)
| any ((== n) . fst) bms =
userBug $ "There exist several benchmarks with the same name: '" ++ n ++ "'"
| any ((== n) . fst) exes =
userBug $ "There exists an exe with the same name as the benchmark: '" ++ n ++ "'"
| any ((== n) . fst) tests =
userBug $ "There exists a test with the same name as the benchmark: '" ++ n ++ "'"
| otherwise = (mlib, exes, tests, (n, b'):bms)
| otherwise = (libs, exes, tests, (n, b'):bms)
where
b' = b {
benchmarkBuildInfo = (benchmarkBuildInfo b)
......@@ -491,7 +494,7 @@ flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, [], [], []) tar
-- Convert GenericPackageDescription to PackageDescription
--
data PDTagged = Lib Library
data PDTagged = Lib String Library
| Exe String Executable
| Test String TestSuite
| Bench String Benchmark
......@@ -505,7 +508,7 @@ instance Monoid PDTagged where
instance Semigroup PDTagged where
PDNull <> x = x
x <> PDNull = x
Lib l <> Lib l' = Lib (l <> l')
Lib n l <> Lib n' l' | n == n' = Lib n (l <> l')
Exe n e <> Exe n' e' | n == n' = Exe n (e <> e')
Test n t <> Test n' t' | n == n' = Test n (t <> t')
Bench n b <> Bench n' b' | n == n' = Bench n (b <> b')
......@@ -548,10 +551,10 @@ finalizePackageDescription ::
-- description along with the flag assignments chosen.
finalizePackageDescription userflags satisfyDep
(Platform arch os) impl constraints
(GenericPackageDescription pkg flags mlib0 exes0 tests0 bms0) =
(GenericPackageDescription pkg flags libs0 exes0 tests0 bms0) =
case resolveFlags of
Right ((mlib, exes', tests', bms'), targetSet, flagVals) ->
Right ( pkg { library = mlib
Right ((libs', exes', tests', bms'), targetSet, flagVals) ->
Right ( pkg { libraries = libs'
, executables = exes'
, testSuites = tests'
, benchmarks = bms'
......@@ -562,7 +565,7 @@ finalizePackageDescription userflags satisfyDep
Left missing -> Left missing
where
-- Combine lib, exes, and tests into one list of @CondTree@s with tagged data
condTrees = maybeToList (fmap (mapTreeData Lib) mlib0 )
condTrees = map (\(name,tree) -> mapTreeData (Lib name) tree) libs0
++ map (\(name,tree) -> mapTreeData (Exe name) tree) exes0
++ map (\(name,tree) -> mapTreeData (Test name) tree) tests0
++ map (\(name,tree) -> mapTreeData (Bench name) tree) bms0
......@@ -570,8 +573,8 @@ finalizePackageDescription userflags satisfyDep
resolveFlags =
case resolveWithFlags flagChoices os arch impl constraints condTrees check of
Right (targetSet, fs) ->
let (mlib, exes, tests, bms) = flattenTaggedTargets targetSet in
Right ( (fmap libFillInDefaults mlib,
let (libs, exes, tests, bms) = flattenTaggedTargets targetSet in
Right ( (map (\(n,l) -> (libFillInDefaults l) { libName = n }) libs,
map (\(n,e) -> (exeFillInDefaults e) { exeName = n }) exes,
map (\(n,t) -> (testFillInDefaults t) { testName = n }) tests,
map (\(n,b) -> (benchFillInDefaults b) { benchmarkName = n }) bms),
......@@ -614,21 +617,21 @@ resolveWithFlags [] Distribution.System.Linux Distribution.System.I386 (Distribu
-- default path will be missing from the package description returned by this
-- function.
flattenPackageDescription :: GenericPackageDescription -> PackageDescription
flattenPackageDescription (GenericPackageDescription pkg _ mlib0 exes0 tests0 bms0) =
pkg { library = mlib
flattenPackageDescription (GenericPackageDescription pkg _ libs0 exes0 tests0 bms0) =
pkg { libraries = reverse libs
, executables = reverse exes
, testSuites = reverse tests
, benchmarks = reverse bms
, buildDepends = ldeps ++ reverse edeps ++ reverse tdeps ++ reverse bdeps
, buildDepends = reverse ldeps ++ reverse edeps ++ reverse tdeps ++ reverse bdeps
}
where
(mlib, ldeps) = case mlib0 of
Just lib -> let (l,ds) = ignoreConditions lib in
(Just (libFillInDefaults l), ds)
Nothing -> (Nothing, [])
(libs, ldeps) = foldr flattenLib ([],[]) libs0
(exes, edeps) = foldr flattenExe ([],[]) exes0
(tests, tdeps) = foldr flattenTst ([],[]) tests0
(bms, bdeps) = foldr flattenBm ([],[]) bms0
flattenLib (n, t) (es, ds) =
let (e, ds') = ignoreConditions t in
( (libFillInDefaults $ e { libName = n }) : es, ds' ++ ds )
flattenExe (n, t) (es, ds) =
let (e, ds') = ignoreConditions t in
( (exeFillInDefaults $ e { exeName = n }) : es, ds' ++ ds )
......@@ -684,7 +687,7 @@ transformAllBuildInfos onBuildInfo onSetupBuildInfo gpd = gpd'
pd = packageDescription gpd
pd' = pd {
library = fmap onLibrary (library pd),
libraries = map onLibrary (libraries pd),
executables = map onExecutable (executables pd),
testSuites = map onTestSuite (testSuites pd),
benchmarks = map onBenchmark (benchmarks pd),
......@@ -724,18 +727,18 @@ transformAllCondTrees onLibrary onExecutable
onTestSuite onBenchmark onDepends gpd = gpd'
where
gpd' = gpd {
condLibrary = condLib',
condLibraries = condLibs',
condExecutables = condExes',
condTestSuites = condTests',
condBenchmarks = condBenchs'
}
condLib = condLibrary gpd
condLibs = condLibraries gpd
condExes = condExecutables gpd
condTests = condTestSuites gpd
condBenchs = condBenchmarks gpd
condLib' = fmap (onCondTree onLibrary) condLib
condLibs' = map (mapSnd $ onCondTree onLibrary) condLibs
condExes' = map (mapSnd $ onCondTree onExecutable) condExes
condTests' = map (mapSnd $ onCondTree onTestSuite) condTests
condBenchs' = map (mapSnd $ onCondTree onBenchmark) condBenchs
......
......@@ -55,7 +55,6 @@ import Distribution.Text
import Distribution.Compat.ReadP hiding (get)
import Data.Char (isSpace)
import Data.Foldable (traverse_)
import Data.Maybe (listToMaybe, isJust)
import Data.List (nub, unfoldr, partition, (\\))
import Control.Monad (liftM, foldM, when, unless, ap)
......@@ -741,14 +740,14 @@ parsePackageDescription file = do
-- 'getBody' assumes that the remaining fields only consist of
-- flags, lib and exe sections.
(repos, flags, mcsetup, mlib, exes, tests, bms) <- getBody
(repos, flags, mcsetup, libs, exes, tests, bms) <- getBody pkg
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
checkForUndefinedFlags flags libs exes tests
return $ GenericPackageDescription
pkg { sourceRepos = repos, setupBuildInfo = mcsetup }
flags mlib exes tests bms
flags libs exes tests bms
where
oldSyntax = all isSimpleField
......@@ -848,17 +847,18 @@ parsePackageDescription file = do
_ -> return (reverse acc)
--
-- body ::= { repo | flag | library | executable | test }+ -- at most one lib
-- body ::= { repo | flag | library | executable | test }+
--
-- 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]
-- an arbitrary number of libraries/executables/tests.
getBody :: PackageDescription
-> PM ([SourceRepo], [Flag]
,Maybe SetupBuildInfo
,Maybe (CondTree ConfVar [Dependency] Library)
,[(String, CondTree ConfVar [Dependency] Library)]
,[(String, CondTree ConfVar [Dependency] Executable)]
,[(String, CondTree ConfVar [Dependency] TestSuite)]
,[(String, CondTree ConfVar [Dependency] Benchmark)])
getBody = peekField >>= \mf -> case mf of
getBody pkg = peekField >>= \mf -> case mf of
Just (Section line_no sec_type sec_label sec_fields)
| sec_type == "executable" -> do
when (null sec_label) $ lift $ syntaxError line_no
......@@ -866,7 +866,7 @@ parsePackageDescription file = do
exename <- lift $ runP line_no "executable" parseTokenQ sec_label
flds <- collectFields parseExeFields sec_fields
skipField
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
(repos, flags, csetup, lib, exes, tests, bms) <- getBody pkg
return (repos, flags, csetup, lib, (exename, flds): exes, tests, bms)
| sec_type == "test-suite" -> do
......@@ -907,7 +907,7 @@ parsePackageDescription file = do
if checkTestType emptyTestSuite flds
then do
skipField
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
(repos, flags, csetup, lib, exes, tests, bms) <- getBody pkg
return (repos, flags, csetup, lib, exes,
(testname, flds) : tests, bms)
else lift $ syntaxError line_no $
......@@ -955,7 +955,7 @@ parsePackageDescription file = do
if checkBenchmarkType emptyBenchmark flds
then do
skipField
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
(repos, flags, csetup, lib, exes, tests, bms) <- getBody pkg
return (repos, flags, csetup, lib, exes,
tests, (benchname, flds) : bms)
else lift $ syntaxError line_no $
......@@ -966,14 +966,15 @@ parsePackageDescription file = do
++ intercalate ", " (map display knownBenchmarkTypes)
| sec_type == "library" -> do
unless (null sec_label) $ lift $
syntaxError line_no "'library' expects no argument"
libname <- if null sec_label
then return (unPackageName (packageName pkg))
-- TODO: relax this parsing so that scoping is handled
-- correctly
else lift $ runP line_no "library" parseTokenQ sec_label
flds <- collectFields parseLibFields sec_fields
skipField
(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, csetup, Just flds, exes, tests, bms)
(repos, flags, csetup, libs, exes, tests, bms) <- getBody pkg
return (repos, flags, csetup, (libname, flds) : libs, exes, tests, bms)
| sec_type == "flag" -> do
when (null sec_label) $ lift $
......@@ -984,7 +985,7 @@ parsePackageDescription file = do
(MkFlag (FlagName (lowercase sec_label)) "" True False)
sec_fields
skipField
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
(repos, flags, csetup, lib, exes, tests, bms) <- getBody pkg
return (repos, flag:flags, csetup, lib, exes, tests, bms)
| sec_type == "source-repository" -> do
......@@ -1009,7 +1010,7 @@ parsePackageDescription file = do
}
sec_fields
skipField
(repos, flags, csetup, lib, exes, tests, bms) <- getBody
(repos, flags, csetup, lib, exes, tests, bms) <- getBody pkg
return (repo:repos, flags, csetup, lib, exes, tests, bms)
| sec_type == "custom-setup" -> do
......@@ -1021,7 +1022,7 @@ parsePackageDescription file = do
mempty
sec_fields
skipField
(repos, flags, csetup0, lib, exes, tests, bms) <- getBody
(repos, flags, csetup0, lib, exes, tests, bms) <- getBody pkg
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)
......@@ -1029,18 +1030,18 @@ parsePackageDescription file = do
| otherwise -> do
lift $ warning $ "Ignoring unknown section type: " ++ sec_type
skipField
getBody
getBody pkg
Just f@(F {}) -> do
_ <- lift $ syntaxError (lineNo f) $
"Plain fields are not allowed in between stanzas: " ++ show f
skipField
getBody
getBody pkg
Just f@(IfBlock {}) -> do
_ <- lift $ syntaxError (lineNo f) $
"If-blocks are not allowed in between stanzas: " ++ show f
skipField
getBody
Nothing -> return ([], [], Nothing, Nothing, [], [], [])
getBody pkg