Skip to content

Commit

Permalink
Support for Cabal 2.0 sub and foreign libraries
Browse files Browse the repository at this point in the history
This should resolve both #3364 and #3361. There is a test case included
that should address both of them as well.

This is still relatively hacky. We will eventually be overhauling the
component system more dramatically to support Backpack with #2540 (CC
@ezyang).

This may still have some problems due to the upstream issue
haskell/cabal#4763, but at least in theory we're matching the behavior
of upstream. We can consider workarounds after that issue comes to a
conclusion.
  • Loading branch information
snoyberg committed Sep 13, 2017
1 parent f6bea15 commit 9ceb409
Show file tree
Hide file tree
Showing 14 changed files with 159 additions and 17 deletions.
30 changes: 22 additions & 8 deletions src/Stack/Build/Execute.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1199,7 +1199,12 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in
, ["bench" | enableBenchmarks]
]
(hasLib, hasExe) = case taskType of
TTFiles lp Local -> (packageHasLibrary (lpPackage lp), not (Set.null (exesToBuild executableBuildStatuses lp)))
TTFiles lp Local ->
let hasLibrary =
case packageLibraries (lpPackage lp) of
NoLibraries -> False
HasLibraries _ -> True
in (hasLibrary, not (Set.null (exesToBuild executableBuildStatuses lp)))
-- This isn't true, but we don't want to have this info for
-- upstream deps.
_ -> (False, False)
Expand Down Expand Up @@ -1411,15 +1416,19 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in
| opt <- hoAdditionalArgs (boptsHaddockOpts eeBuildOpts) ]
]

let shouldCopy = not isFinalBuild && (packageHasLibrary package || not (Set.null (packageExes package)))
let hasLibrary =
case packageLibraries package of
NoLibraries -> False
HasLibraries _ -> True
shouldCopy = not isFinalBuild && (hasLibrary || not (Set.null (packageExes package)))
when shouldCopy $ withMVar eeInstallLock $ \() -> do
announce "copy/register"
eres <- try $ cabal KeepTHLoading ["copy"]
case eres of
Left err@CabalExitedUnsuccessfully{} ->
throwM $ CabalCopyFailed (packageBuildType package == Just C.Simple) (show err)
_ -> return ()
when (packageHasLibrary package) $ cabal KeepTHLoading ["register"]
when hasLibrary $ cabal KeepTHLoading ["register"]

let (installedPkgDb, installedDumpPkgsTVar) =
case taskLocation task of
Expand All @@ -1430,13 +1439,13 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in
( bcoLocalDB eeBaseConfigOpts
, eeLocalDumpPkgs )
let ident = PackageIdentifier (packageName package) (packageVersion package)
mpkgid <- if packageHasLibrary package
then do
mpkgid <- case packageLibraries package of
HasLibraries _ -> do
mpkgid <- loadInstalledPkg eeEnvOverride wc [installedPkgDb] installedDumpPkgsTVar (packageName package)
case mpkgid of
Nothing -> throwM $ Couldn'tFindPkgId $ packageName package
Just pkgid -> return $ Library ident pkgid
else do
NoLibraries -> do
markExeInstalled (taskLocation task) taskProvides -- TODO unify somehow with writeFlagCache?
return $ Executable ident

Expand Down Expand Up @@ -1825,11 +1834,16 @@ extraBuildOptions wc bopts = do

-- Library and executable build components.
primaryComponentOptions :: Map Text ExecutableBuildStatus -> LocalPackage -> [String]
primaryComponentOptions executableBuildStatuses lp = ["lib:" ++ packageNameString (packageName (lpPackage lp))
primaryComponentOptions executableBuildStatuses lp =
-- TODO: get this information from target parsing instead,
-- which will allow users to turn off library building if
-- desired
| packageHasLibrary (lpPackage lp)] ++
(case packageLibraries (lpPackage lp) of
NoLibraries -> []
HasLibraries names ->
map T.unpack
$ T.append "lib:" (packageNameText (packageName (lpPackage lp)))
: map (T.append "flib:") (Set.toList names)) ++
map (T.unpack . T.append "exe:") (Set.toList $ exesToBuild executableBuildStatuses lp)

-- | History of this function:
Expand Down
9 changes: 7 additions & 2 deletions src/Stack/Build/Source.hs
Original file line number Diff line number Diff line change
Expand Up @@ -218,9 +218,14 @@ loadLocalPackage boptsCli targets (name, lpv) = do
Nothing -> False
-- FIXME: When issue #1406 ("stack 0.1.8 lost ability to
-- build individual executables or library") is resolved,
-- 'packageHasLibrary' is only relevant if the library is
-- 'hasLibrary' is only relevant if the library is
-- part of the target spec.
Just _ -> packageHasLibrary pkg || not (Set.null allComponents)
Just _ ->
let hasLibrary =
case packageLibraries pkg of
NoLibraries -> False
HasLibraries _ -> True
in hasLibrary || not (Set.null allComponents)

filterSkippedComponents = Set.filter (not . (`elem` boptsSkipComponents bopts))

Expand Down
6 changes: 5 additions & 1 deletion src/Stack/Coverage.hs
Original file line number Diff line number Diff line change
Expand Up @@ -100,11 +100,15 @@ generateHpcReport pkgDir package tests = do
let pkgName = packageNameText (packageName package)
pkgId = packageIdentifierString (packageIdentifier package)
ghcVersion = getGhcVersion compilerVersion
hasLibrary =
case packageLibraries package of
NoLibraries -> False
HasLibraries _ -> True
eincludeName <-
-- Pre-7.8 uses plain PKG-version in tix files.
if ghcVersion < $(mkVersion "7.10") then return $ Right $ Just pkgId
-- We don't expect to find a package key if there is no library.
else if not (packageHasLibrary package) then return $ Right Nothing
else if not hasLibrary then return $ Right Nothing
-- Look in the inplace DB for the package key.
-- See https://github.com/commercialhaskell/stack/issues/1181#issuecomment-148968986
else do
Expand Down
4 changes: 3 additions & 1 deletion src/Stack/Ghci.hs
Original file line number Diff line number Diff line change
Expand Up @@ -587,7 +587,9 @@ makeGhciPkgInfo buildOptsCLI sourceMap installedMap locals addPkgs mfileTargets
wantedPackageComponents :: BuildOpts -> Target -> Package -> Set NamedComponent
wantedPackageComponents _ (TargetComps cs) _ = cs
wantedPackageComponents bopts (TargetAll ProjectPackage) pkg = S.fromList $
(if packageHasLibrary pkg then [CLib] else []) ++
(case packageLibraries pkg of
NoLibraries -> []
HasLibraries _names -> CLib : []) ++ -- FIXME. This ignores sub libraries and foreign libraries. Is that OK?
map CExe (S.toList (packageExes pkg)) <>
(if boptsTests bopts then map CTest (M.keys (packageTests pkg)) else []) <>
(if boptsBenchmarks bopts then map CBench (S.toList (packageBenchmarks pkg)) else [])
Expand Down
47 changes: 43 additions & 4 deletions src/Stack/Package.hs
Original file line number Diff line number Diff line change
Expand Up @@ -67,6 +67,7 @@ import Distribution.System (OS (..), Arch, Platform (..))
import qualified Distribution.Text as D
import qualified Distribution.Types.CondTree as Cabal
import qualified Distribution.Types.ExeDependency as Cabal
import Distribution.Types.ForeignLib
import qualified Distribution.Types.LegacyExeDependency as Cabal
import qualified Distribution.Types.UnqualComponentName as Cabal
import qualified Distribution.Verbosity as D
Expand Down Expand Up @@ -249,7 +250,17 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg
, packageDefaultFlags = M.fromList
[(fromCabalFlagName (flagName flag), flagDefault flag) | flag <- pkgFlags]
, packageAllDeps = S.fromList (M.keys deps)
, packageHasLibrary = maybe False (buildable . libBuildInfo) (library pkg)
, packageLibraries =
let mlib = do
lib <- library pkg
guard $ buildable $ libBuildInfo lib
Just lib
in
case mlib of
Nothing
| null extraLibNames -> NoLibraries
| otherwise -> error "Package has buildable sublibraries but no buildable libraries, I'm giving up"
Just _ -> HasLibraries foreignLibNames
, packageTests = M.fromList
[(T.pack (Cabal.unUnqualComponentName $ testName t), testInterface t)
| t <- testSuites pkgNoMod
Expand Down Expand Up @@ -281,6 +292,21 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg
, packageSetupDeps = msetupDeps
}
where
extraLibNames = S.union subLibNames foreignLibNames

subLibNames
= S.fromList
$ map (T.pack . Cabal.unUnqualComponentName)
$ mapMaybe libName -- this is a design bug in the Cabal API: this should statically be known to exist
$ filter (buildable . libBuildInfo)
$ subLibraries pkg

foreignLibNames
= S.fromList
$ map (T.pack . Cabal.unUnqualComponentName . foreignLibName)
$ filter (buildable . foreignLibBuildInfo)
$ foreignLibs pkg

-- Gets all of the modules, files, build files, and data files that
-- constitute the package. This is primarily used for dirtiness
-- checking during build, as well as use by "stack ghci"
Expand Down Expand Up @@ -310,7 +336,7 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg
return (componentModules, componentFiles, buildFiles <> dataFiles', warnings)
pkgId = package pkg
name = fromCabalPackageName (pkgName pkgId)
deps = M.filterWithKey (const . (/= name)) (M.union
deps = M.filterWithKey (const . (not . isMe)) (M.union
(packageDependencies pkg)
-- We include all custom-setup deps - if present - in the
-- package deps themselves. Stack always works with the
Expand All @@ -322,6 +348,10 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg
(M.fromList . map (depName &&& depRange) . setupDepends)
(setupBuildInfo pkg)

-- Is the package dependency mentioned here me: either the package
-- name itself, or the name of one of the sub libraries
isMe name' = name' == name || packageNameText name' `S.member` extraLibNames

-- | Generate GHC options for the package's components, and a list of
-- options which apply generally to the package, not one specific
-- component.
Expand Down Expand Up @@ -582,7 +612,7 @@ packageDescModulesAndFiles
=> PackageDescription
-> m (Map NamedComponent (Set ModuleName), Map NamedComponent (Set DotCabalPath), Set (Path Abs File), [PackageWarning])
packageDescModulesAndFiles pkg = do
(libraryMods,libDotCabalFiles,libWarnings) <-
(libraryMods,libDotCabalFiles,libWarnings) <- -- FIXME add in sub libraries
maybe
(return (M.empty, M.empty, []))
(asModuleAndFileMap libComponent libraryFiles)
Expand Down Expand Up @@ -829,7 +859,7 @@ data PackageDescriptionPair = PackageDescriptionPair
resolvePackageDescription :: PackageConfig
-> GenericPackageDescription
-> PackageDescriptionPair
resolvePackageDescription packageConfig (GenericPackageDescription desc defaultFlags mlib _subLibs _foreignLibs exes tests benches) =
resolvePackageDescription packageConfig (GenericPackageDescription desc defaultFlags mlib subLibs foreignLibs' exes tests benches) =
PackageDescriptionPair
{ pdpOrigBuildable = go False
, pdpModifiedBuildable = go True
Expand All @@ -838,6 +868,12 @@ resolvePackageDescription packageConfig (GenericPackageDescription desc defaultF
go modBuildable =
desc {library =
fmap (resolveConditions rc updateLibDeps) mlib
,subLibraries =
map (\(n, v) -> (resolveConditions rc updateLibDeps v){libName=Just n})
subLibs
,foreignLibs =
map (\(n, v) -> (resolveConditions rc updateForeignLibDeps v){foreignLibName=n})
foreignLibs'
,executables =
map (\(n, v) -> (resolveConditions rc updateExeDeps v){exeName=n})
exes
Expand All @@ -860,6 +896,9 @@ resolvePackageDescription packageConfig (GenericPackageDescription desc defaultF
updateLibDeps lib deps =
lib {libBuildInfo =
(libBuildInfo lib) {targetBuildDepends = deps}}
updateForeignLibDeps lib deps =
lib {foreignLibBuildInfo =
(foreignLibBuildInfo lib) {targetBuildDepends = deps}}
updateExeDeps exe deps =
exe {buildInfo =
(buildInfo exe) {targetBuildDepends = deps}}
Expand Down
9 changes: 8 additions & 1 deletion src/Stack/Types/Package.hs
Original file line number Diff line number Diff line change
Expand Up @@ -69,6 +69,13 @@ instance Show PackageException where
, "For more information, see: https://github.com/commercialhaskell/stack/issues/317"
]

-- | Libraries in a package. Since Cabal 2.0, internal libraries are a
-- thing.
data PackageLibraries
= NoLibraries
| HasLibraries !(Set Text) -- ^ the foreign library names, sub libraries get built automatically without explicit component name passing
deriving (Show,Typeable)

-- | Some package info.
data Package =
Package {packageName :: !PackageName -- ^ Name of the package.
Expand All @@ -81,7 +88,7 @@ data Package =
,packageGhcOptions :: ![Text] -- ^ Ghc options used on package.
,packageFlags :: !(Map FlagName Bool) -- ^ Flags used on package.
,packageDefaultFlags :: !(Map FlagName Bool) -- ^ Defaults for unspecified flags.
,packageHasLibrary :: !Bool -- ^ does the package have a buildable library stanza?
,packageLibraries :: !PackageLibraries -- ^ does the package have a buildable library stanza?
,packageTests :: !(Map Text TestSuiteInterface) -- ^ names and interfaces of test suites
,packageBenchmarks :: !(Set Text) -- ^ names of benchmarks
,packageExes :: !(Set Text) -- ^ names of executables
Expand Down
4 changes: 4 additions & 0 deletions test/integration/tests/internal-libraries/Main.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
import StackTest

main :: IO ()
main = stack ["build"]
2 changes: 2 additions & 0 deletions test/integration/tests/internal-libraries/files/Setup.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain
29 changes: 29 additions & 0 deletions test/integration/tests/internal-libraries/files/files.cabal
Original file line number Diff line number Diff line change
@@ -0,0 +1,29 @@
name: files
version: 0.1.0.0
build-type: Simple
cabal-version: >=2.0

library
hs-source-dirs: src
exposed-modules: Files
build-depends: base
default-language: Haskell2010

library foo
hs-source-dirs: src-foo
exposed-modules: Foo
build-depends: base, files, stm
default-language: Haskell2010

executable bar
hs-source-dirs: src-bar
main-is: Main.hs
build-depends: base, files, foo
default-language: Haskell2010

foreign-library baz
type: native-shared
other-modules: Baz
build-depends: base, files, foo
hs-source-dirs: src-baz
default-language: Haskell2010
11 changes: 11 additions & 0 deletions test/integration/tests/internal-libraries/files/src-bar/Main.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
module Main where

import Files
import Foo

main :: IO ()
main = do
putStrLn "files:"
print files
putStrLn "foo"
foo >>= print
11 changes: 11 additions & 0 deletions test/integration/tests/internal-libraries/files/src-baz/Baz.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
module Baz where

import Files
import Foo

baz :: IO ()
baz = do
putStrLn "files:"
print files
putStrLn "foo"
foo >>= print
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
module Foo where

import Control.Monad.STM
import Files

foo :: IO String
foo = atomically $ return $ "foo using " ++ files
4 changes: 4 additions & 0 deletions test/integration/tests/internal-libraries/files/src/Files.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
module Files where

files :: String
files = "files"
3 changes: 3 additions & 0 deletions test/integration/tests/internal-libraries/files/stack.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
resolver: ghc-8.2.1
extra-deps:
- stm-2.4.4.1

0 comments on commit 9ceb409

Please sign in to comment.