Merge pull request #3955 from mihaimaruseac/mm-stack-internal-libs

Don't recompile in presence of sublibraries
(cherry picked from commit a3a8754)

Author: snoyberg

ChangeLog.md

@@ -12,6 +12,9 @@ Behavior changes:
 Other enhancements:
 
 Bug fixes:
+* When a package contained sublibraries, stack was always recompiling the
+  package. This has been fixed now, no recompilation is being done because of
+  sublibraries. See [#3899](https://github.com/commercialhaskell/stack/issues/3899).
 
 
 ## v1.7.0.1 (release candidate)

src/Stack/Build/Cache.hs

@@ -120,6 +120,7 @@ buildCacheFile dir component = do
     let nonLibComponent prefix name = prefix <> "-" <> T.unpack name
     cacheFileName <- parseRelFile $ case component of
         CLib -> "lib"
+        CInternalLib name -> nonLibComponent "internal-lib" name
         CExe name -> nonLibComponent "exe" name
         CTest name -> nonLibComponent "test" name
         CBench name -> nonLibComponent "bench" name

src/Stack/Build/Installed.hs

@@ -230,25 +230,37 @@ isAllowed opts mcache sourceMap mloc dp
     | otherwise =
         case Map.lookup name sourceMap of
             Nothing ->
-                case mloc of
-                    -- The sourceMap has nothing to say about this global
-                    -- package, so we can use it
-                    Nothing -> Allowed
-                    Just ExtraGlobal -> Allowed
-                    -- For non-global packages, don't include unknown packages.
-                    -- See:
-                    -- https://github.com/commercialhaskell/stack/issues/292
-                    Just _ -> UnknownPkg
-            Just pii
-                | not (checkLocation (piiLocation pii)) -> WrongLocation mloc (piiLocation pii)
-                | version /= piiVersion pii -> WrongVersion version (piiVersion pii)
-                | otherwise -> Allowed
+                -- If the sourceMap has nothing to say about this package,
+                -- check if it represents a sublibrary first
+                -- See: https://github.com/commercialhaskell/stack/issues/3899
+                case dpParentLibIdent dp of
+                  Just (PackageIdentifier parentLibName version') ->
+                    case Map.lookup parentLibName sourceMap of
+                      Nothing -> checkNotFound
+                      Just pii
+                        | version' == version -> checkFound pii
+                        | otherwise -> checkNotFound -- different versions
+                  Nothing -> checkNotFound
+            Just pii -> checkFound pii
   where
     PackageIdentifier name version = dpPackageIdent dp
     -- Ensure that the installed location matches where the sourceMap says it
     -- should be installed
     checkLocation Snap = mloc /= Just (InstalledTo Local) -- we can allow either global or snap
     checkLocation Local = mloc == Just (InstalledTo Local) || mloc == Just ExtraGlobal -- 'locally' installed snapshot packages can come from extra dbs
+    -- Check if a package is allowed if it is found in the sourceMap
+    checkFound pii
+      | not (checkLocation (piiLocation pii)) = WrongLocation mloc (piiLocation pii)
+      | version /= piiVersion pii = WrongVersion version (piiVersion pii)
+      | otherwise = Allowed
+    -- check if a package is allowed if it is not found in the sourceMap
+    checkNotFound = case mloc of
+      -- The sourceMap has nothing to say about this global package, so we can use it
+      Nothing -> Allowed
+      Just ExtraGlobal -> Allowed
+      -- For non-global packages, don't include unknown packages.
+      -- See: https://github.com/commercialhaskell/stack/issues/292
+      Just _ -> UnknownPkg
 
 data LoadHelper = LoadHelper
     { lhId   :: !GhcPkgId

src/Stack/Build/Source.hs

@@ -167,6 +167,7 @@ splitComponents =
   where
     go a b c [] = (Set.fromList $ a [], Set.fromList $ b [], Set.fromList $ c [])
     go a b c (CLib:xs) = go a b c xs
+    go a b c (CInternalLib x:xs) = go (a . (x:)) b c xs
     go a b c (CExe x:xs) = go (a . (x:)) b c xs
     go a b c (CTest x:xs) = go a (b . (x:)) c xs
     go a b c (CBench x:xs) = go a b (c . (x:)) xs
@@ -434,9 +435,9 @@ getPackageFilesForTargets
     -> Set NamedComponent
     -> RIO env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
 getPackageFilesForTargets pkg cabalFP nonLibComponents = do
-    (_,compFiles,otherFiles,warnings) <-
+    (components',compFiles,otherFiles,warnings) <-
         getPackageFiles (packageFiles pkg) cabalFP
-    let components = Set.insert CLib nonLibComponents
+    let components = M.keysSet components' `Set.union` nonLibComponents
         componentsFiles =
             M.map (\files -> Set.union otherFiles (Set.map dotCabalGetPath files)) $
                 M.filterWithKey (\component _ -> component `Set.member` components) compFiles

src/Stack/Build/Target.hs

@@ -230,6 +230,7 @@ resolveRawTarget globals snap deps locals (ri, rt) =
     -- Helper function: check if a 'NamedComponent' matches the given 'ComponentName'
     isCompNamed :: ComponentName -> NamedComponent -> Bool
     isCompNamed _ CLib = False
+    isCompNamed t1 (CInternalLib t2) = t1 == t2
     isCompNamed t1 (CExe t2) = t1 == t2
     isCompNamed t1 (CTest t2) = t1 == t2
     isCompNamed t1 (CBench t2) = t1 == t2

src/Stack/Ghci.hs

@@ -520,6 +520,7 @@ figureOutMainFile bopts mainIsTargets targets0 packages = do
     renderComp c =
         case c of
             CLib -> "lib"
+            CInternalLib name -> "internal-lib:" <> name
             CExe name -> "exe:" <> name
             CTest name -> "test:" <> name
             CBench name -> "bench:" <> name

src/Stack/Package.hs

@@ -42,6 +42,7 @@ module Stack.Package
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as C8
 import           Data.List (isSuffixOf, isPrefixOf)
+import           Data.Maybe (maybe)
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
 import qualified Data.Text as T
@@ -589,6 +590,7 @@ componentBuildDir cabalVer component distDir
     | otherwise =
         case component of
             CLib -> buildDir distDir
+            CInternalLib name -> buildDir distDir </> componentNameToDir name
             CExe name -> buildDir distDir </> componentNameToDir name
             CTest name -> buildDir distDir </> componentNameToDir name
             CBench name -> buildDir distDir </> componentNameToDir name
@@ -598,6 +600,7 @@ componentOutputDir :: NamedComponent -> Path Abs Dir -> Path Abs Dir
 componentOutputDir namedComponent distDir =
     case namedComponent of
         CLib -> buildDir distDir
+        CInternalLib name -> makeTmp name
         CExe name -> makeTmp name
         CTest name -> makeTmp name
         CBench name -> makeTmp name
@@ -700,6 +703,12 @@ packageDescModulesAndFiles pkg = do
             (return (M.empty, M.empty, []))
             (asModuleAndFileMap libComponent libraryFiles)
             (library pkg)
+    (subLibrariesMods,subLibDotCabalFiles,subLibWarnings) <-
+        liftM
+            foldTuples
+            (mapM
+                 (asModuleAndFileMap internalLibComponent libraryFiles)
+                 (subLibraries pkg))
     (executableMods,exeDotCabalFiles,exeWarnings) <-
         liftM
             foldTuples
@@ -719,14 +728,15 @@ packageDescModulesAndFiles pkg = do
     dfiles <- resolveGlobFiles
                     (extraSrcFiles pkg
                         ++ map (dataDir pkg FilePath.</>) (dataFiles pkg))
-    let modules = libraryMods <> executableMods <> testMods <> benchModules
+    let modules = libraryMods <> subLibrariesMods <> executableMods <> testMods <> benchModules
         files =
-            libDotCabalFiles <> exeDotCabalFiles <> testDotCabalFiles <>
+            libDotCabalFiles <> subLibDotCabalFiles <> exeDotCabalFiles <> testDotCabalFiles <>
             benchDotCabalPaths
-        warnings = libWarnings <> exeWarnings <> testWarnings <> benchWarnings
+        warnings = libWarnings <> subLibWarnings <> exeWarnings <> testWarnings <> benchWarnings
     return (modules, files, dfiles, warnings)
   where
     libComponent = const CLib
+    internalLibComponent = CInternalLib . T.pack . maybe "" Cabal.unUnqualComponentName . libName
     exeComponent = CExe . T.pack . Cabal.unUnqualComponentName . exeName
     testComponent = CTest . T.pack . Cabal.unUnqualComponentName . testName
     benchComponent = CBench . T.pack . Cabal.unUnqualComponentName . benchmarkName

src/Stack/PackageDump.hs

@@ -282,6 +282,7 @@ hasDebuggingSymbols dir lib = do
 data DumpPackage profiling haddock symbols = DumpPackage
     { dpGhcPkgId :: !GhcPkgId
     , dpPackageIdent :: !PackageIdentifier
+    , dpParentLibIdent :: !(Maybe PackageIdentifier)
     , dpLicense :: !(Maybe C.License)
     , dpLibDirs :: ![FilePath]
     , dpLibraries :: ![Text]
@@ -356,6 +357,11 @@ conduitDumpPackage = (.| CL.catMaybes) $ eachSection $ do
                         _ -> Nothing
             depends <- mapMaybeM parseDepend $ concatMap T.words $ parseM "depends"
 
+            -- Handle sublibs by recording the name of the parent library
+            -- If name of parent library is missing, this is not a sublib.
+            let mkParentLib n = PackageIdentifier n version
+                parentLib = mkParentLib <$> (parseS "package-name" >>= parsePackageName)
+
             let parseQuoted key =
                     case mapM (P.parseOnly (argsParser NoEscaping)) val of
                         Left{} -> throwM (Couldn'tParseField key val)
@@ -369,6 +375,7 @@ conduitDumpPackage = (.| CL.catMaybes) $ eachSection $ do
             return $ Just DumpPackage
                 { dpGhcPkgId = ghcPkgId
                 , dpPackageIdent = PackageIdentifier name version
+                , dpParentLibIdent = parentLib
                 , dpLicense = license
                 , dpLibDirs = libDirPaths
                 , dpLibraries = T.words $ T.unwords libraries

src/Stack/Types/NamedComponent.hs

@@ -22,13 +22,15 @@ import qualified Data.Text as T
 -- | A single, fully resolved component of a package
 data NamedComponent
     = CLib
+    | CInternalLib !Text
     | CExe !Text
     | CTest !Text
     | CBench !Text
     deriving (Show, Eq, Ord)
 
 renderComponent :: NamedComponent -> Text
 renderComponent CLib = "lib"
+renderComponent (CInternalLib x) = "internal-lib:" <> x
 renderComponent (CExe x) = "exe:" <> x
 renderComponent (CTest x) = "test:" <> x
 renderComponent (CBench x) = "bench:" <> x

src/test/Stack/PackageDumpSpec.hs

@@ -81,6 +81,7 @@ spec = do
             haskell2010 { dpExposedModules = [] } `shouldBe` DumpPackage
                 { dpGhcPkgId = ghcPkgId
                 , dpPackageIdent = packageIdent
+                , dpParentLibIdent = Nothing
                 , dpLicense = Just BSD3
                 , dpLibDirs = ["/opt/ghc/7.8.4/lib/ghc-7.8.4/haskell2010-1.1.2.0"]
                 , dpDepends = depends
@@ -124,6 +125,7 @@ spec = do
             haskell2010 { dpExposedModules = [] } `shouldBe` DumpPackage
                 { dpGhcPkgId = ghcPkgId
                 , dpPackageIdent = pkgIdent
+                , dpParentLibIdent = Nothing
                 , dpLicense = Just BSD3
                 , dpLibDirs = ["/opt/ghc/7.10.1/lib/ghc-7.10.1/ghc_EMlWrQ42XY0BNVbSrKixqY"]
                 , dpHaddockInterfaces = ["/opt/ghc/7.10.1/share/doc/ghc/html/libraries/ghc-7.10.1/ghc.haddock"]
@@ -160,6 +162,7 @@ spec = do
             hmatrix `shouldBe` DumpPackage
                 { dpGhcPkgId = ghcPkgId
                 , dpPackageIdent = pkgId
+                , dpParentLibIdent = Nothing
                 , dpLicense = Just BSD3
                 , dpLibDirs =
                       [ "/Users/alexbiehl/.stack/snapshots/x86_64-osx/lts-2.13/7.8.4/lib/x86_64-osx-ghc-7.8.4/hmatrix-0.16.1.5"
@@ -197,6 +200,7 @@ spec = do
           ghcBoot `shouldBe` DumpPackage
             { dpGhcPkgId = ghcPkgId
             , dpPackageIdent = pkgId
+            , dpParentLibIdent = Nothing
             , dpLicense = Just BSD3
             , dpLibDirs =
                   ["/opt/ghc/head/lib/ghc-7.11.20151213/ghc-boot-0.0.0.0"]

test/integration/tests/3899-dont-rebuild-sublibraries/Main.hs

@@ -0,0 +1,14 @@
+import Control.Monad (unless)
+import Data.List (isInfixOf)
+import StackTest
+
+main :: IO ()
+main = do
+  stack ["clean"]
+  stack ["build"]
+  res <- compilingModulesLines . snd <$> stackStderr ["build"]
+  unless (null res) $ fail "Stack recompiled code"
+
+-- Returns the lines where a module is compiled
+compilingModulesLines :: String -> [String]
+compilingModulesLines = filter (isInfixOf " Compiling ") . lines

test/integration/tests/3899-dont-rebuild-sublibraries/files/Setup.hs

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

test/integration/tests/3899-dont-rebuild-sublibraries/files/files.cabal

@@ -0,0 +1,22 @@
+name:           files
+version:        0.1.0.0
+build-type:     Simple
+cabal-version:  >= 2.0
+
+library
+  hs-source-dirs:   src
+  exposed-modules:  Lib
+  build-depends:    base, lib
+  default-language: Haskell2010
+
+library lib
+  hs-source-dirs:   src-internal
+  exposed-modules:  Internal
+  build-depends:    base
+  default-language: Haskell2010
+
+executable exe
+  hs-source-dirs:   src-exe
+  main-is:          Main.hs
+  build-depends:    base, files
+  default-language: Haskell2010

test/integration/tests/3899-dont-rebuild-sublibraries/files/src-exe/Main.hs

@@ -0,0 +1,7 @@
+module Main where
+
+import Lib
+
+main :: IO ()
+main = do
+  putStrLn "hello world"

test/integration/tests/3899-dont-rebuild-sublibraries/files/src-internal/Internal.hs

@@ -0,0 +1 @@
+module Internal where

test/integration/tests/3899-dont-rebuild-sublibraries/files/src/Lib.hs

@@ -0,0 +1,3 @@
+module Lib where
+
+import Internal

test/integration/tests/3899-dont-rebuild-sublibraries/files/stack.yaml

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