Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
70 changes: 39 additions & 31 deletions Cabal/Distribution/PackageDescription.hs
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,7 @@ module Distribution.PackageDescription (
descCabalVersion,
BuildType(..),
knownBuildTypes,
allLibraries,

-- ** Renaming
ModuleRenaming(..),
Expand Down Expand Up @@ -125,7 +126,7 @@ import Distribution.Text
import Language.Haskell.Extension

import Data.Data (Data)
import Data.List (nub, intercalate)
import Data.List (nub, intercalate, find)
import Data.Maybe (fromMaybe, maybeToList)
import Data.Foldable as Fold (Foldable(foldMap))
import Data.Traversable as Trav (Traversable(traverse))
Expand Down Expand Up @@ -189,7 +190,8 @@ data PackageDescription
buildType :: Maybe BuildType,
setupBuildInfo :: Maybe SetupBuildInfo,
-- components
libraries :: [Library],
library :: Maybe Library,
subLibraries :: [Library],
executables :: [Executable],
testSuites :: [TestSuite],
benchmarks :: [Benchmark],
Expand Down Expand Up @@ -256,7 +258,8 @@ emptyPackageDescription
category = "",
customFieldsPD = [],
setupBuildInfo = Nothing,
libraries = [],
library = Nothing,
subLibraries = [],
executables = [],
testSuites = [],
benchmarks = [],
Expand Down Expand Up @@ -393,7 +396,7 @@ instance Text ModuleRenaming where
-- The Library type

data Library = Library {
libName :: String,
libName :: Maybe String,
exposedModules :: [ModuleName],
reexportedModules :: [ModuleReexport],
requiredSignatures:: [ModuleName], -- ^ What sigs need implementations?
Expand All @@ -417,33 +420,31 @@ instance Monoid Library where

instance Semigroup Library where
a <> b = Library {
libName = combine' libName,
libName = combine libName,
exposedModules = combine exposedModules,
reexportedModules = combine reexportedModules,
requiredSignatures = combine requiredSignatures,
libExposed = libExposed a && libExposed b, -- so False propagates
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 a PUBLIC library?
-- | Does this package have a buildable PUBLIC library?
hasPublicLib :: PackageDescription -> Bool
hasPublicLib p = any f (libraries p)
where f lib = buildable (libBuildInfo lib) &&
libName lib == display (packageName (package p))
hasPublicLib p =
case library p of
Just lib -> buildable (libBuildInfo lib)
Nothing -> False

-- | Does this package have any libraries?
hasLibs :: PackageDescription -> Bool
hasLibs p = any (buildable . libBuildInfo) (libraries p)
hasLibs p = any (buildable . libBuildInfo) (allLibraries p)

allLibraries :: PackageDescription -> [Library]
allLibraries p = maybeToList (library p) ++ subLibraries p

-- | If the package description has a buildable library section,
-- call the given function with the library build info as argument.
Expand All @@ -453,7 +454,7 @@ hasLibs p = any (buildable . libBuildInfo) (libraries p)
-- for more information.
withLib :: PackageDescription -> (Library -> IO ()) -> IO ()
withLib pkg_descr f =
sequence_ [f lib | lib <- libraries pkg_descr, buildable (libBuildInfo lib)]
sequence_ [f lib | lib <- allLibraries pkg_descr, buildable (libBuildInfo lib)]

-- | Get all the module names from the library (exposed and internal modules)
-- which need to be compiled. (This does not include reexports, which
Expand Down Expand Up @@ -920,7 +921,7 @@ emptyBuildInfo = mempty
-- all buildable executables, test suites and benchmarks. Useful for gathering
-- dependencies.
allBuildInfo :: PackageDescription -> [BuildInfo]
allBuildInfo pkg_descr = [ bi | lib <- libraries pkg_descr
allBuildInfo pkg_descr = [ bi | lib <- allLibraries pkg_descr
, let bi = libBuildInfo lib
, buildable bi ]
++ [ bi | exe <- executables pkg_descr
Expand Down Expand Up @@ -954,7 +955,8 @@ usedExtensions bi = oldExtensions bi
++ defaultExtensions bi

-- Libraries live in a separate namespace, so must distinguish
data ComponentName = CLibName String
data ComponentName = CLibName
| CSubLibName String
| CExeName String
| CTestName String
| CBenchName String
Expand All @@ -964,13 +966,17 @@ instance Binary ComponentName

-- Build-target-ish syntax
instance Text ComponentName where
disp (CLibName str) = Disp.text ("lib:" ++ str)
disp CLibName = Disp.text "lib"
disp (CSubLibName str) = Disp.text ("lib:" ++ str)
disp (CExeName str) = Disp.text ("exe:" ++ str)
disp (CTestName str) = Disp.text ("test:" ++ str)
disp (CBenchName str) = Disp.text ("bench:" ++ str)

parse = do
ctor <- Parse.choice [ Parse.string "lib:" >> return CLibName
parse = parseComposite <++ parseSingle
where
parseSingle = Parse.string "lib" >> return CLibName
parseComposite = do
ctor <- Parse.choice [ Parse.string "lib:" >> return CSubLibName
, Parse.string "exe:" >> return CExeName
, Parse.string "bench:" >> return CBenchName
, Parse.string "test:" >> return CTestName ]
Expand All @@ -979,8 +985,8 @@ instance Text ComponentName where
-- as package names.)
fmap (ctor . unPackageName) parse

defaultLibName :: PackageIdentifier -> ComponentName
defaultLibName pid = CLibName (display (pkgName pid))
defaultLibName :: ComponentName
defaultLibName = CLibName

type HookedBuildInfo = [(ComponentName, BuildInfo)]

Expand Down Expand Up @@ -1143,11 +1149,16 @@ lowercase = map Char.toLower
updatePackageDescription :: HookedBuildInfo -> PackageDescription -> PackageDescription
updatePackageDescription hooked_bis p
= p{ executables = updateMany (CExeName . exeName) updateExecutable (executables p)
, libraries = updateMany (CLibName . libName) updateLibrary (libraries p)
, library = fmap (updateLibrary lib_bi) (library p)
, subLibraries = updateMany (maybe CLibName CSubLibName . libName) updateLibrary (subLibraries p)
, benchmarks = updateMany (CBenchName . benchmarkName) updateBenchmark (benchmarks p)
, testSuites = updateMany (CTestName . testName) updateTestSuite (testSuites p)
}
where
lib_bi = case find ((== CLibName) . fst) hooked_bis of
Nothing -> mempty
Just (_, bi) -> bi

updateMany :: (a -> ComponentName) -- ^ get 'ComponentName' from @a@
-> (BuildInfo -> a -> a) -- ^ @updateExecutable@, @updateLibrary@, etc
-> [a] -- ^list of components to update
Expand All @@ -1161,11 +1172,7 @@ updatePackageDescription hooked_bis p
-> [a] -- ^list with name component updated
updateOne _ _ _ [] = []
updateOne name_sel update hooked_bi'@(name,bi) (c:cs)
| name_sel c == name ||
-- Special case: an empty name means "please update the BuildInfo for
-- the public library, i.e. the one with the same name as the
-- package." See 'parseHookedBuildInfo'.
name == CLibName "" && name_sel c == defaultLibName (package p)
| name_sel c == name
= update bi c : cs
| otherwise = c : updateOne name_sel update hooked_bi' cs

Expand All @@ -1181,7 +1188,8 @@ data GenericPackageDescription =
GenericPackageDescription {
packageDescription :: PackageDescription,
genPackageFlags :: [Flag],
condLibraries :: [(String, CondTree ConfVar [Dependency] Library)],
condLibrary :: Maybe (CondTree ConfVar [Dependency] Library),
condSubLibraries :: [(String, CondTree ConfVar [Dependency] Library)],
condExecutables :: [(String, CondTree ConfVar [Dependency] Executable)],
condTestSuites :: [(String, CondTree ConfVar [Dependency] TestSuite)],
condBenchmarks :: [(String, CondTree ConfVar [Dependency] Benchmark)]
Expand Down
48 changes: 30 additions & 18 deletions Cabal/Distribution/PackageDescription/Check.hs
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@ import Distribution.Simple.LocalBuildInfo hiding (compiler)
import Language.Haskell.Extension

import Data.Maybe
( isNothing, isJust, catMaybes, mapMaybe, fromMaybe )
( isNothing, isJust, catMaybes, mapMaybe, fromMaybe, maybeToList )
import Data.List (sort, group, isPrefixOf, nub, find)
import Control.Monad
( filterM, liftM )
Expand Down Expand Up @@ -174,19 +174,26 @@ checkSanity pkg =
, check (all ($ pkg) [ null . executables
, null . testSuites
, null . benchmarks
, null . libraries ]) $
, null . allLibraries ]) $
PackageBuildImpossible
"No executables, libraries, tests, or benchmarks found. Nothing to do."

, check (not (null duplicateNames)) $
PackageBuildImpossible $ "Duplicate sections: " ++ commaSep duplicateNames
++ ". The name of every library, executable, test suite, and benchmark section in"
++ " the package must be unique."

-- NB: but it's OK for executables to have the same name!
, check (any (== display (packageName pkg)) subLibNames) $
PackageBuildImpossible $ "Illegal internal library name " ++ display (packageName pkg)
++ ". Internal libraries cannot have the same name as the package. Maybe"
++ " you wanted a non-internal library? If so, rewrite the section stanza"
++ " from 'library: '" ++ display (packageName pkg) ++ "' to 'library'."
]
--TODO: check for name clashes case insensitively: windows file systems cannot
--cope.

++ concatMap (checkLibrary pkg) (libraries pkg)
++ concatMap (checkLibrary pkg) (allLibraries pkg)
++ concatMap (checkExecutable pkg) (executables pkg)
++ concatMap (checkTestSuite pkg) (testSuites pkg)
++ concatMap (checkBenchmark pkg) (benchmarks pkg)
Expand All @@ -200,15 +207,14 @@ checkSanity pkg =
++ "tool only supports up to version " ++ display cabalVersion ++ "."
]
where
-- The public library gets special dispensation, because it
-- The public 'library' gets special dispensation, because it
-- is common practice to export a library and name the executable
-- the same as the package. We always put the public library
-- in the top-level directory in dist, so no conflicts either.
libNames = filter (/= unPackageName (packageName pkg)) . map libName $ libraries pkg
-- the same as the package.
subLibNames = catMaybes . map libName $ subLibraries pkg
Copy link
Copy Markdown
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Shouldn't this be map (fromMaybe (packageName pkg) . libName) $ subLibraries?

Copy link
Copy Markdown
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Mmm. I guess the invariant is that everything in subLibraries has a non-Nothing package name. I guess we can check that!

Copy link
Copy Markdown
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yeah, I was looking for such a check, but it seem we don't have one.

exeNames = map exeName $ executables pkg
testNames = map testName $ testSuites pkg
bmNames = map benchmarkName $ benchmarks pkg
duplicateNames = dups $ libNames ++ exeNames ++ testNames ++ bmNames
duplicateNames = dups $ subLibNames ++ exeNames ++ testNames ++ bmNames

checkLibrary :: PackageDescription -> Library -> [PackageCheck]
checkLibrary pkg lib =
Expand All @@ -221,7 +227,10 @@ checkLibrary pkg lib =

, check (null (libModules lib) && null (reexportedModules lib)) $
PackageDistSuspiciousWarn $
"Library " ++ libName lib ++ " does not expose any modules"
"Library " ++ (case libName lib of
Nothing -> ""
Just n -> n
) ++ "does not expose any modules"

-- check use of required-signatures/exposed-signatures sections
, checkVersion [1,21] (not (null (requiredSignatures lib))) $
Expand Down Expand Up @@ -691,7 +700,7 @@ checkGhcOptions pkg =

where
all_ghc_options = concatMap get_ghc_options (allBuildInfo pkg)
lib_ghc_options = concatMap (get_ghc_options . libBuildInfo) (libraries pkg)
lib_ghc_options = concatMap (get_ghc_options . libBuildInfo) (allLibraries pkg)
get_ghc_options bi = hcOptions GHC bi ++ hcProfOptions GHC bi
++ hcSharedOptions GHC bi

Expand Down Expand Up @@ -915,17 +924,14 @@ checkCabalVersion pkg =
++ "'other-languages' field."

, checkVersion [1,23]
(case libraries pkg of
[lib] -> libName lib /= unPackageName (packageName pkg)
[] -> False
_ -> True) $
(not (null (subLibraries pkg))) $
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]
(any (not.null.reexportedModules) (libraries pkg)) $
(any (not.null.reexportedModules) (allLibraries pkg)) $
PackageDistInexcusable $
"To use the 'reexported-module' field the package needs to specify "
++ "at least 'cabal-version: >= 1.21'."
Expand Down Expand Up @@ -1331,8 +1337,11 @@ checkConditionals pkg =
unknownOSs = [ os | OS (OtherOS os) <- conditions ]
unknownArches = [ arch | Arch (OtherArch arch) <- conditions ]
unknownImpls = [ impl | Impl (OtherCompiler impl) _ <- conditions ]
conditions = concatMap (fvs . snd) (condLibraries pkg)
conditions = concatMap fvs (maybeToList (condLibrary pkg))
++ concatMap (fvs . snd) (condSubLibraries pkg)
++ concatMap (fvs . snd) (condExecutables pkg)
++ concatMap (fvs . snd) (condTestSuites pkg)
++ concatMap (fvs . snd) (condBenchmarks pkg)
fvs (CondNode _ _ ifs) = concatMap compfv ifs -- free variables
compfv (c, ct, mct) = condfv c ++ fvs ct ++ maybe [] fvs mct
condfv c = case c of
Expand Down Expand Up @@ -1435,8 +1444,11 @@ checkDevelopmentOnlyFlags pkg =

allConditionalBuildInfo :: [([Condition ConfVar], BuildInfo)]
allConditionalBuildInfo =
concatMap (collectCondTreePaths libBuildInfo . snd)
(condLibraries pkg)
concatMap (collectCondTreePaths libBuildInfo)
(maybeToList (condLibrary pkg))

++ concatMap (collectCondTreePaths libBuildInfo . snd)
(condSubLibraries pkg)

++ concatMap (collectCondTreePaths buildInfo . snd)
(condExecutables pkg)
Expand Down
Loading