Unlisted dependencies no longer trigger extraneous second build (#838)

ChangeLog.md

@@ -33,6 +33,7 @@ Bug fixes:
 * Support for spaces in Haddock interface files [fpco/minghc#85](https://github.com/fpco/minghc/issues/85)
 * Temporarily building against a "shadowing" local package? [#992](https://github.com/commercialhaskell/stack/issues/992)
 * Fix Setup.exe name for --upgrade-cabal on Windows [#1002](https://github.com/commercialhaskell/stack/issues/1002)
+* Unlisted dependencies no longer trigger extraneous second build [#838](https://github.com/commercialhaskell/stack/issues/838)
 
 ## 0.1.4.1
 

src/Stack/Build/Execute.hs

@@ -52,6 +52,7 @@ import qualified Data.Streaming.Process         as Process
 import           Data.Traversable               (forM)
 import           Data.Text                      (Text)
 import qualified Data.Text                      as T
+import           Data.Time.Clock                (getCurrentTime)
 import           Data.Word8                     (_colon)
 import           Distribution.System            (OS (Windows),
                                                  Platform (Platform))
@@ -928,6 +929,7 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in
         () <- announce "build"
         config <- asks getConfig
         extraOpts <- extraBuildOptions eeBuildOpts
+        preBuildTime <- modTime <$> liftIO getCurrentTime
         cabal (console && configHideTHLoading config) $
             (case taskType of
                 TTLocal lp -> concat
@@ -947,12 +949,26 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in
                     ]
                 TTUpstream _ _ -> ["build"]) ++ extraOpts
 
+        case taskType of
+            TTLocal lp -> do
+                (addBuildCache,warnings) <-
+                    addUnlistedToBuildCache
+                        preBuildTime
+                        (lpPackage lp)
+                        (lpCabalFile lp)
+                        (lpNewBuildCache lp)
+                mapM_ ($logWarn . ("Warning: " <>) . T.pack . show) warnings
+                unless (null addBuildCache) $
+                    writeBuildCache pkgDir $
+                    Map.unions (lpNewBuildCache lp : addBuildCache)
+            TTUpstream _ _ -> return ()
+
         when (doHaddock package) $ do
             announce "haddock"
             hscolourExists <- doesExecutableExist eeEnvOverride "HsColour"
             unless hscolourExists $ $logWarn
                 ("Warning: haddock not generating hyperlinked sources because 'HsColour' not\n" <>
-                 "found on PATH (use 'stack build hscolour --copy-bins' to install).")
+                 "found on PATH (use 'stack install hscolour' to install).")
             cabal False (concat [["haddock", "--html", "--hoogle", "--html-location=../$pkg-$version/"]
                                 ,["--hyperlink-source" | hscolourExists]
                                 ,["--ghcjs" | wc == Ghcjs]])

src/Stack/Build/Source.hs

@@ -14,6 +14,7 @@ module Stack.Build.Source
     , getLocalPackageViews
     , loadLocalPackage
     , parseTargetsFromBuildOpts
+    , addUnlistedToBuildCache
     ) where
 
 
@@ -334,10 +335,7 @@ loadLocalPackage bopts targets (name, (lpv, gpkg)) = do
         testpkg = resolvePackage testconfig gpkg
         benchpkg = resolvePackage benchconfig gpkg
     mbuildCache <- tryGetBuildCache $ lpvRoot lpv
-    (_,compFiles,cabalFiles) <- getPackageFiles (packageFiles pkg) (lpvCabalFP lpv)
-    let files =
-            Set.map dotCabalGetPath (mconcat (M.elems compFiles)) <>
-            cabalFiles
+    (files,_) <- getPackageFilesSimple pkg (lpvCabalFP lpv)
     (isDirty, newBuildCache) <- checkBuildCache
         (fromMaybe Map.empty mbuildCache)
         (map toFilePath $ Set.toList files)
@@ -480,27 +478,69 @@ checkBuildCache oldCache files = liftIO $ do
                             return (True, newFci)
                 return (Any isDirty, Map.singleton fp newFci)
 
-    getModTimeMaybe fp =
-        liftIO
-            (catch
-                 (liftM
-                      (Just . modTime)
-                      (getModificationTime fp))
-                 (\e ->
-                       if isDoesNotExistError e
-                           then return Nothing
-                           else throwM e))
-
-    calcFci modTime' fp =
-        withBinaryFile fp ReadMode $ \h -> do
-            (size, digest) <- CB.sourceHandle h $$ getZipSink
-                ((,)
-                    <$> ZipSink (CL.fold
-                        (\x y -> x + fromIntegral (S.length y))
-                        0)
-                    <*> ZipSink sinkHash)
-            return FileCacheInfo
-                { fciModTime = modTime'
-                , fciSize = size
-                , fciHash = toBytes (digest :: Digest SHA256)
-                }
+-- | Returns entries to add to the build cache for any newly found unlisted modules
+addUnlistedToBuildCache
+    :: (MonadIO m, MonadReader env m, MonadCatch m, MonadLogger m, HasEnvConfig env)
+    => ModTime
+    -> Package
+    -> Path Abs File
+    -> Map FilePath a
+    -> m ([Map FilePath FileCacheInfo], [PackageWarning])
+addUnlistedToBuildCache preBuildTime pkg cabalFP buildCache = do
+    (files,warnings) <- getPackageFilesSimple pkg cabalFP
+    let newFiles =
+            Set.toList $
+            Set.map toFilePath files `Set.difference` Map.keysSet buildCache
+    addBuildCache <- mapM addFileToCache newFiles
+    return (addBuildCache, warnings)
+  where
+    addFileToCache fp = do
+        mmodTime <- getModTimeMaybe fp
+        case mmodTime of
+            Nothing -> return Map.empty
+            Just modTime' ->
+                if modTime' < preBuildTime
+                    then do
+                        newFci <- calcFci modTime' fp
+                        return (Map.singleton fp newFci)
+                    else return Map.empty
+
+-- | Gets list of Paths for files in a package
+getPackageFilesSimple
+    :: (MonadIO m, MonadReader env m, MonadCatch m, MonadLogger m, HasEnvConfig env)
+    => Package -> Path Abs File -> m (Set (Path Abs File), [PackageWarning])
+getPackageFilesSimple pkg cabalFP = do
+    (_,compFiles,cabalFiles,warnings) <-
+        getPackageFiles (packageFiles pkg) cabalFP
+    return
+        ( Set.map dotCabalGetPath (mconcat (M.elems compFiles)) <> cabalFiles
+        , warnings)
+
+-- | Get file modification time, if it exists.
+getModTimeMaybe :: MonadIO m => FilePath -> m (Maybe ModTime)
+getModTimeMaybe fp =
+    liftIO
+        (catch
+             (liftM
+                  (Just . modTime)
+                  (getModificationTime fp))
+             (\e ->
+                   if isDoesNotExistError e
+                       then return Nothing
+                       else throwM e))
+
+-- | Create FileCacheInfo for a file.
+calcFci :: MonadIO m => ModTime -> FilePath -> m FileCacheInfo
+calcFci modTime' fp = liftIO $
+    withBinaryFile fp ReadMode $ \h -> do
+        (size, digest) <- CB.sourceHandle h $$ getZipSink
+            ((,)
+                <$> ZipSink (CL.fold
+                    (\x y -> x + fromIntegral (S.length y))
+                    0)
+                <*> ZipSink sinkHash)
+        return FileCacheInfo
+            { fciModTime = modTime'
+            , fciSize = size
+            , fciHash = toBytes (digest :: Digest SHA256)
+            }

src/Stack/Package.hs

@@ -195,7 +195,7 @@ resolvePackage packageConfig gpkg =
                           , buildable (buildInfo b)]
     , packageOpts = GetPackageOpts $
       \sourceMap locals cabalfp ->
-           do (componentsModules,componentFiles,_) <- getPackageFiles pkgFiles cabalfp
+           do (componentsModules,componentFiles,_,_) <- getPackageFiles pkgFiles cabalfp
               (componentsOpts,generalOpts) <-
                   generatePkgDescOpts sourceMap locals cabalfp pkg componentFiles
               return (componentsModules,componentFiles,componentsOpts,generalOpts)
@@ -211,11 +211,11 @@ resolvePackage packageConfig gpkg =
     pkgFiles = GetPackageFiles $
         \cabalfp ->
              do distDir <- distDirFromDir (parent cabalfp)
-                (componentModules,componentFiles,cabalFiles) <-
+                (componentModules,componentFiles,cabalFiles,warnings) <-
                     runReaderT
                         (packageDescModulesAndFiles pkg)
                         (cabalfp, buildDir distDir)
-                return ( componentModules, componentFiles, cabalFiles)
+                return (componentModules, componentFiles, cabalFiles, warnings)
     pkgId = package (packageDescription gpkg)
     name = fromCabalPackageName (pkgName pkgId)
     pkg = resolvePackageDescription packageConfig gpkg
@@ -454,44 +454,45 @@ allBuildInfo' pkg_descr = [ bi | Just lib <- [library pkg_descr]
 packageDescModulesAndFiles
     :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m, MonadCatch m)
     => PackageDescription
-    -> m (Map NamedComponent (Set ModuleName), Map NamedComponent (Set DotCabalPath), Set (Path Abs File))
+    -> m (Map NamedComponent (Set ModuleName), Map NamedComponent (Set DotCabalPath), Set (Path Abs File), [PackageWarning])
 packageDescModulesAndFiles pkg = do
-    (libraryMods,libDotCabalFiles) <-
+    (libraryMods,libDotCabalFiles,libWarnings) <-
         maybe
-            (return (M.empty, M.empty))
+            (return (M.empty, M.empty, []))
             (asModuleAndFileMap libComponent libraryFiles)
             (library pkg)
-    (executableMods,exeDotCabalFiles) <-
+    (executableMods,exeDotCabalFiles,exeWarnings) <-
         liftM
-            foldPairs
+            foldTuples
             (mapM
                  (asModuleAndFileMap exeComponent executableFiles)
                  (executables pkg))
-    (testMods,testDotCabalFiles) <-
+    (testMods,testDotCabalFiles,testWarnings) <-
         liftM
-            foldPairs
+            foldTuples
             (mapM (asModuleAndFileMap testComponent testFiles) (testSuites pkg))
-    (benchModules,benchDotCabalPaths) <-
+    (benchModules,benchDotCabalPaths,benchWarnings) <-
         liftM
-            foldPairs
+            foldTuples
             (mapM
                  (asModuleAndFileMap benchComponent benchmarkFiles)
                  (benchmarks pkg))
-    dfiles <- resolveGlobFiles (map (dataDir pkg FilePath.</>) (dataFiles pkg))
+    (dfiles) <- resolveGlobFiles (map (dataDir pkg FilePath.</>) (dataFiles pkg))
     let modules = libraryMods <> executableMods <> testMods <> benchModules
         files =
             libDotCabalFiles <> exeDotCabalFiles <> testDotCabalFiles <>
             benchDotCabalPaths
-    return (modules, files, dfiles)
+        warnings = libWarnings <> exeWarnings <> testWarnings <> benchWarnings
+    return (modules, files, dfiles, warnings)
   where
     libComponent = const CLib
     exeComponent = CExe . T.pack . exeName
     testComponent = CTest . T.pack . testName
     benchComponent = CBench . T.pack . benchmarkName
     asModuleAndFileMap label f lib = do
-        (a,b) <- f lib
-        return (M.singleton (label lib) a, M.singleton (label lib) b)
-    foldPairs = foldl' (<>) (M.empty, M.empty)
+        (a,b,c) <- f lib
+        return (M.singleton (label lib) a, M.singleton (label lib) b, c)
+    foldTuples = foldl' (<>) (M.empty, M.empty, [])
 
 -- | Resolve globbing of files (e.g. data files) to absolute paths.
 resolveGlobFiles :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs File, Path Abs Dir) m,MonadCatch m)
@@ -556,19 +557,20 @@ matchDirFileGlob_ dir filepath = case parseFileGlob filepath of
       matches -> return matches
 
 -- | Get all files referenced by the benchmark.
-benchmarkFiles :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m)
-               => Benchmark -> m (Set ModuleName,Set DotCabalPath)
+benchmarkFiles
+    :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m)
+    => Benchmark -> m (Set ModuleName, Set DotCabalPath, [PackageWarning])
 benchmarkFiles bench = do
     dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build)
     dir <- asks (parent . fst)
-    (modules,files) <-
+    (modules,files,warnings) <-
         resolveFilesAndDeps
             (Just $ benchmarkName bench)
             (dirs ++ [dir])
             (bnames <> exposed)
             haskellModuleExts
     cfiles <- buildOtherSources build
-    return (modules, files <> cfiles)
+    return (modules, files <> cfiles, warnings)
   where
     exposed =
         case benchmarkInterface bench of
@@ -581,18 +583,18 @@ benchmarkFiles bench = do
 testFiles
     :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m)
     => TestSuite
-    -> m (Set ModuleName, Set DotCabalPath)
+    -> m (Set ModuleName, Set DotCabalPath, [PackageWarning])
 testFiles test = do
     dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build)
     dir <- asks (parent . fst)
-    (modules,files) <-
+    (modules,files,warnings) <-
         resolveFilesAndDeps
             (Just $ testName test)
             (dirs ++ [dir])
             (bnames <> exposed)
             haskellModuleExts
     cfiles <- buildOtherSources build
-    return (modules, files <> cfiles)
+    return (modules, files <> cfiles, warnings)
   where
     exposed =
         case testInterface test of
@@ -606,36 +608,37 @@ testFiles test = do
 executableFiles
     :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m)
     => Executable
-    -> m (Set ModuleName, Set DotCabalPath)
+    -> m (Set ModuleName, Set DotCabalPath, [PackageWarning])
 executableFiles exe = do
     dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build)
     dir <- asks (parent . fst)
-    (modules,files) <-
+    (modules,files,warnings) <-
         resolveFilesAndDeps
             (Just $ exeName exe)
             (dirs ++ [dir])
             (map DotCabalModule (otherModules build) ++
              [DotCabalMain (modulePath exe)])
             haskellModuleExts
     cfiles <- buildOtherSources build
-    return (modules, files <> cfiles)
+    return (modules, files <> cfiles, warnings)
   where
     build = buildInfo exe
 
 -- | Get all files referenced by the library.
-libraryFiles :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs File, Path Abs Dir) m)
-             => Library -> m (Set ModuleName,Set DotCabalPath)
+libraryFiles
+    :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m)
+    => Library -> m (Set ModuleName, Set DotCabalPath, [PackageWarning])
 libraryFiles lib = do
     dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build)
     dir <- asks (parent . fst)
-    (modules,files) <-
+    (modules,files,warnings) <-
         resolveFilesAndDeps
             Nothing
             (dirs ++ [dir])
             (names <> exposed)
             haskellModuleExts
     cfiles <- buildOtherSources build
-    return (modules, files <> cfiles)
+    return (modules, files <> cfiles, warnings)
   where
     names = concat [bnames, exposed]
     exposed = map DotCabalModule (exposedModules lib)
@@ -796,11 +799,11 @@ resolveFilesAndDeps
     -> [Path Abs Dir] -- ^ Directories to look in.
     -> [DotCabalDescriptor] -- ^ Base names.
     -> [Text] -- ^ Extentions.
-    -> m (Set ModuleName,Set DotCabalPath)
+    -> m (Set ModuleName,Set DotCabalPath,[PackageWarning])
 resolveFilesAndDeps component dirs names0 exts = do
     (dotCabalPaths,foundModules) <- loop names0 S.empty
-    warnUnlisted component (mapMaybe dotCabalModule names0) foundModules
-    return (foundModules, dotCabalPaths)
+    warnings <- warnUnlisted foundModules
+    return (foundModules, dotCabalPaths, warnings)
   where
     loop [] doneModules = return (S.empty, doneModules)
     loop names doneModules0 = do
@@ -821,31 +824,18 @@ resolveFilesAndDeps component dirs names0 exts = do
                        (resolvedFiles <> map DotCabalFilePath thDepFiles))
                   resolvedFiles'
             , doneModules'')
-
--- | Warn about modules which are used but not listed in the cabal
--- file.
-warnUnlisted
-    :: (MonadLogger m, MonadReader (Path Abs File, void) m)
-    => Maybe String -> [ModuleName] -> Set ModuleName -> m ()
-warnUnlisted component names0 foundModules = do
-    cabalfp <- asks fst
-    unless (S.null unlistedModules) $
-        $(logWarn) $
-        T.pack $
-        "Warning: " ++
-        (if S.size unlistedModules == 1
-             then "module"
-             else "modules") ++
-        " not listed in " ++
-        toFilePath (filename cabalfp) ++
-        (case component of
-             Nothing -> " for library"
-             Just c -> " for '" ++ c ++ "'") ++
-        " component (add to other-modules):\n    " ++
-        intercalate "\n    " (map display (S.toList unlistedModules))
-  where
-    unlistedModules =
-        foundModules `S.difference` (S.fromList names0)
+    warnUnlisted foundModules = do
+        let unlistedModules =
+                foundModules `S.difference`
+                (S.fromList $ mapMaybe dotCabalModule names0)
+        cabalfp <- asks fst
+        return $
+            if S.null unlistedModules
+                then []
+                else [ UnlistedModulesWarning
+                           cabalfp
+                           component
+                           (S.toList unlistedModules)]
 
 -- | Get the dependencies of a Haskell module file.
 getDependencies