Merge pull request #3430 from commercialhaskell/sub-foreign-libraries

Support for Cabal 2.0 sub and foreign libraries

src/Stack/Build/Execute.hs

@@ -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)
@@ -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
@@ -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
 
@@ -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:

src/Stack/Build/Source.hs

@@ -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))
 

src/Stack/Coverage.hs

@@ -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

src/Stack/Ghci.hs

@@ -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 [])

src/Stack/Package.hs

@@ -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
@@ -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
@@ -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"
@@ -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
@@ -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.
@@ -557,7 +587,7 @@ packageDependencies :: PackageDescription -> Map PackageName VersionRange
 packageDependencies pkg =
   M.fromListWith intersectVersionRanges $
   map (depName &&& depRange) $
-  concatMap targetBuildDepends (allBuildInfo pkg) ++
+  concatMap targetBuildDepends (allBuildInfo' pkg) ++
   maybe [] setupDepends (setupBuildInfo pkg)
 
 -- | Get all dependencies of the package (buildable targets only).
@@ -566,7 +596,7 @@ packageDependencies pkg =
 -- information.
 packageDescTools :: PackageDescription -> Map ExeName VersionRange
 packageDescTools =
-  M.fromList . concatMap tools . allBuildInfo
+  M.fromList . concatMap tools . allBuildInfo'
   where
     tools bi = map go1 (buildTools bi) ++ map go2 (buildToolDepends bi)
 
@@ -576,13 +606,22 @@ packageDescTools =
     go2 :: Cabal.ExeDependency -> (ExeName, VersionRange)
     go2 (Cabal.ExeDependency _pkg name range) = (ExeName $ T.pack $ Cabal.unUnqualComponentName name, range)
 
+-- | Variant of 'allBuildInfo' from Cabal that includes foreign
+-- libraries; see <https://github.com/haskell/cabal/issues/4763>
+allBuildInfo' :: PackageDescription -> [BuildInfo]
+allBuildInfo' pkg = allBuildInfo pkg ++
+  [ bi | flib <- foreignLibs pkg
+       , let bi = foreignLibBuildInfo flib
+       , buildable bi
+  ]
+
 -- | Get all files referenced by the package.
 packageDescModulesAndFiles
     :: (MonadLogger m, MonadUnliftIO m, MonadReader Ctx m, MonadThrow m)
     => 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)
@@ -829,7 +868,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
@@ -838,6 +877,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
@@ -860,6 +905,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}}

src/Stack/Types/Package.hs

@@ -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.
@@ -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

test/integration/tests/internal-libraries/Main.hs

@@ -0,0 +1,4 @@
+import StackTest
+
+main :: IO ()
+main = stack ["build"]

test/integration/tests/internal-libraries/files/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

test/integration/tests/internal-libraries/files/files.cabal

@@ -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, mtl
+  hs-source-dirs:      src-baz
+  default-language:    Haskell2010

test/integration/tests/internal-libraries/files/src-bar/Main.hs

@@ -0,0 +1,11 @@
+module Main where
+
+import Files
+import Foo
+
+main :: IO ()
+main = do
+  putStrLn "files:"
+  print files
+  putStrLn "foo"
+  foo >>= print

test/integration/tests/internal-libraries/files/src-baz/Baz.hs

@@ -0,0 +1,12 @@
+module Baz where
+
+import Files
+import Foo
+import Control.Monad.Reader
+
+baz :: IO ()
+baz = flip runReaderT () $ lift $ do
+  putStrLn "files:"
+  print files
+  putStrLn "foo"
+  foo >>= print

test/integration/tests/internal-libraries/files/src-foo/Foo.hs

@@ -0,0 +1,7 @@
+module Foo where
+
+import Control.Monad.STM
+import Files
+
+foo :: IO String
+foo = atomically $ return $ "foo using " ++ files

test/integration/tests/internal-libraries/files/src/Files.hs

@@ -0,0 +1,4 @@
+module Files where
+
+files :: String
+files = "files"

test/integration/tests/internal-libraries/files/stack.yaml

@@ -0,0 +1,4 @@
+resolver: ghc-8.2.1
+extra-deps:
+- stm-2.4.4.1
+- mtl-2.2.1