Add support for build --assume-deps-up-to-date flag, partial fix to haskell#2775 (haskell#3287)

--assume-deps-up-to-date lets you compile a single component without
building its dependencies.

Signed-off-by: Edward Z. Yang <[email protected]>

Author: ezyang

Cabal/Cabal.cabal

@@ -42,6 +42,7 @@ extra-source-files:
   tests/PackageTests/BenchmarkOptions/BenchmarkOptions.cabal
   tests/PackageTests/BenchmarkOptions/test-BenchmarkOptions.hs
   tests/PackageTests/BenchmarkStanza/my.cabal
+  tests/PackageTests/BuildAssumeDepsUpToDate/BuildAssumeDepsUpToDate.cabal
   tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive1/GlobalBuildDepsNotAdditive1.cabal
   tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive1/MyLibrary.hs
   tests/PackageTests/BuildDeps/GlobalBuildDepsNotAdditive2/GlobalBuildDepsNotAdditive2.cabal

Cabal/Distribution/Simple/Build.hs

@@ -75,10 +75,36 @@ build    :: PackageDescription  -- ^ Mostly information from the .cabal file
          -> BuildFlags          -- ^ Flags that the user passed to build
          -> [ PPSuffixHandler ] -- ^ preprocessors to run before compiling
          -> IO ()
-build pkg_descr lbi flags suffixes = do
-  let distPref  = fromFlag (buildDistPref flags)
-      verbosity = fromFlag (buildVerbosity flags)
-
+build pkg_descr lbi flags suffixes
+ | fromFlag (buildAssumeDepsUpToDate flags) = do
+  -- TODO: if checkBuildTargets ignores a target we may accept
+  -- a --assume-deps-up-to-date with multiple arguments. Arguably, we should
+  -- error early in this case.
+  targets <- readBuildTargets pkg_descr (buildArgs flags)
+  (cname, _) <- checkBuildTargets verbosity pkg_descr targets >>= \r -> case r of
+              [] -> die "In --assume-deps-up-to-date mode you must specify a target"
+              [target'] -> return target'
+              _ -> die "In --assume-deps-up-to-date mode you can only build a single target"
+  -- NB: do NOT 'createInternalPackageDB'; we don't want to delete it.
+  -- But this means we have to be careful about unregistering
+  -- ourselves.
+  let dbPath = internalPackageDBPath lbi distPref
+      internalPackageDB = SpecificPackageDB dbPath
+      clbi = getComponentLocalBuildInfo lbi cname
+      comp = getComponent pkg_descr cname
+  -- TODO: do we need to unregister libraries?  In any case, this would
+  -- need to be done in the buildLib functionality.
+  -- Do the build
+  initialBuildSteps distPref pkg_descr lbi clbi verbosity
+  let bi     = componentBuildInfo comp
+      progs' = addInternalBuildTools pkg_descr lbi bi (withPrograms lbi)
+      lbi'   = lbi {
+                 withPrograms  = progs',
+                 withPackageDB = withPackageDB lbi ++ [internalPackageDB]
+               }
+  buildComponent verbosity (buildNumJobs flags) pkg_descr
+                 lbi' suffixes comp clbi distPref
+ | otherwise = do
   targets  <- readBuildTargets pkg_descr (buildArgs flags)
   targets' <- checkBuildTargets verbosity pkg_descr targets
   let componentsToBuild = componentsInBuildOrder lbi (map fst targets')
@@ -102,6 +128,9 @@ build pkg_descr lbi flags suffixes = do
                  }
     buildComponent verbosity (buildNumJobs flags) pkg_descr
                    lbi' suffixes comp clbi distPref
+ where
+  distPref  = fromFlag (buildDistPref flags)
+  verbosity = fromFlag (buildVerbosity flags)
 
 
 repl     :: PackageDescription  -- ^ Mostly information from the .cabal file

Cabal/Distribution/Simple/Setup.hs

@@ -1444,6 +1444,9 @@ data BuildFlags = BuildFlags {
     buildDistPref    :: Flag FilePath,
     buildVerbosity   :: Flag Verbosity,
     buildNumJobs     :: Flag (Maybe Int),
+    -- | If this is true, we don't build the dependencies of
+    -- 'buildArgs': only the directly referenced components.
+    buildAssumeDepsUpToDate :: Flag Bool,
     -- TODO: this one should not be here, it's just that the silly
     -- UserHooks stop us from passing extra info in other ways
     buildArgs :: [String]
@@ -1461,6 +1464,7 @@ defaultBuildFlags  = BuildFlags {
     buildDistPref    = mempty,
     buildVerbosity   = Flag normal,
     buildNumJobs     = mempty,
+    buildAssumeDepsUpToDate     = Flag False,
     buildArgs        = []
   }
 
@@ -1508,6 +1512,11 @@ buildOptions :: ProgramConfiguration -> ShowOrParseArgs
 buildOptions progConf showOrParseArgs =
   [ optionNumJobs
       buildNumJobs (\v flags -> flags { buildNumJobs = v })
+
+  , option "" ["assume-deps-up-to-date"]
+      "One-shot build"
+      buildAssumeDepsUpToDate (\c flags -> flags { buildAssumeDepsUpToDate = c })
+      trueArg
   ]
 
   ++ programConfigurationPaths progConf showOrParseArgs

Cabal/tests/PackageTests/BuildAssumeDepsUpToDate/.gitignore

@@ -0,0 +1 @@
+*.hs

Cabal/tests/PackageTests/BuildAssumeDepsUpToDate/BuildAssumeDepsUpToDate.cabal

@@ -0,0 +1,21 @@
+-- Initial BuildAssumeDepsUpToDate.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                BuildAssumeDepsUpToDate
+version:             0.1.0.0
+license:             BSD3
+author:              Edward Z. Yang
+maintainer:          [email protected]
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     A
+  build-depends:       base
+  default-language:    Haskell2010
+
+executable myprog
+  main-is: Main.hs
+  hs-source-dirs: myprog
+  build-depends: BuildAssumeDepsUpToDate, base
+  default-language:    Haskell2010

Cabal/tests/PackageTests/BuildAssumeDepsUpToDate/myprog/.gitignore

@@ -0,0 +1 @@
+*.hs

Cabal/tests/PackageTests/Tests.hs

@@ -408,6 +408,21 @@ tests config = do
     cabal "build" []
     runExe' "T3294" [] >>= assertOutputContains "bbb"
 
+  -- Test build --assume-deps-up-to-date
+  tc "BuildAssumeDepsUpToDate" $ do
+    pkg_dir <- packageDir
+    liftIO $ writeFile (pkg_dir </> "A.hs") "module A where\na = \"a1\""
+    liftIO $ writeFile (pkg_dir </> "myprog/Main.hs") "import A\nmain = print (a ++ \" b1\")"
+    cabal_build []
+    runExe' "myprog" []
+        >>= assertOutputContains "a1 b1"
+    ghcFileModDelay
+    liftIO $ writeFile (pkg_dir </> "A.hs") "module A where\na = \"a2\""
+    liftIO $ writeFile (pkg_dir </> "myprog/Main.hs") "import A\nmain = print (a ++ \" b2\")"
+    cabal "build" ["--assume-deps-up-to-date", "myprog"]
+    runExe' "myprog" []
+        >>= assertOutputContains "a1 b2"
+
   where
     ghc_pkg_guess bin_name = do
         cwd <- packageDir

cabal-install/Distribution/Client/ProjectPlanning.hs

@@ -1914,6 +1914,7 @@ setupHsBuildFlags ElaboratedConfiguredPackage{..} _ verbosity builddir =
       buildProgramArgs  = mempty, --unused, set at configure time
       buildVerbosity    = toFlag verbosity,
       buildDistPref     = toFlag builddir,
+      buildAssumeDepsUpToDate = toFlag False,
       buildNumJobs      = mempty, --TODO: [nice to have] sometimes want to use toFlag (Just numBuildJobs),
       buildArgs         = mempty  -- unused, passed via args not flags
     }