Add support for --one-shot flag, partial fix to haskell#2775 (haskell#3287)

--one-shot lets you compile a single component without
building its dependencies.

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

Author: ezyang

Cabal/Cabal.cabal

@@ -80,6 +80,7 @@ extra-source-files:
   tests/PackageTests/BuildDeps/TargetSpecificDeps3/MyLibrary.hs
   tests/PackageTests/BuildDeps/TargetSpecificDeps3/lemon.hs
   tests/PackageTests/BuildDeps/TargetSpecificDeps3/my.cabal
+  tests/PackageTests/BuildOneShot/BuildOneShot.cabal
   tests/PackageTests/BuildTestSuiteDetailedV09/Dummy2.hs
   tests/PackageTests/BuildableField/BuildableField.cabal
   tests/PackageTests/BuildableField/Main.hs

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 (buildOneShot flags) = do
+  -- TODO: if checkBuildTargets ignores a target we may accept
+  -- a --one-shot 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 --one-shot mode you must specify a target"
+              [target'] -> return target'
+              _ -> die "In --one-shot 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
@@ -188,7 +217,7 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
         installedPkgInfo = inplaceInstalledPackageInfo pwd distPref pkg_descr
                                                        (AbiHash "") lib' lbi clbi
 
-    registerPackage verbosity (compiler lbi) (withPrograms lbi) HcPkg.MultiInstance
+    registerPackage verbosity (compiler lbi) (withPrograms lbi) HcPkg.NoMultiInstance
                     (withPackageDB lbi) installedPkgInfo
 
 buildComponent verbosity numJobs pkg_descr lbi suffixes

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.
+    buildOneShot :: 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,
+    buildOneShot     = Flag False,
     buildArgs        = []
   }
 
@@ -1508,6 +1512,11 @@ buildOptions :: ProgramConfiguration -> ShowOrParseArgs
 buildOptions progConf showOrParseArgs =
   [ optionNumJobs
       buildNumJobs (\v flags -> flags { buildNumJobs = v })
+
+  , option "" ["one-shot"]
+      "One-shot build"
+      buildOneShot (\c flags -> flags { buildOneShot = c })
+      trueArg
   ]
 
   ++ programConfigurationPaths progConf showOrParseArgs

Cabal/tests/PackageTests/BuildOneShot/.gitignore

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

Cabal/tests/PackageTests/BuildOneShot/BuildOneShot.cabal

@@ -0,0 +1,22 @@
+-- Initial BuildOneShot.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                BuildOneShot
+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
+  reexported-modules:  A as B
+  default-language:    Haskell2010
+
+executable one-shot
+  main-is: Main.hs
+  hs-source-dirs: one-shot
+  build-depends: BuildOneShot, base
+  default-language:    Haskell2010

Cabal/tests/PackageTests/BuildOneShot/one-shot/.gitignore

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

Cabal/tests/PackageTests/Tests.hs

@@ -378,6 +378,20 @@ tests config = do
       runExe' "hello-world" []
         >>= assertOutputContains "hello from A"
 
+  -- Test build --one-shot
+  tc "BuildOneShot" $ do
+    pkg_dir <- packageDir
+    liftIO $ writeFile (pkg_dir </> "A.hs") "module A where\na = \"a1\""
+    liftIO $ writeFile (pkg_dir </> "one-shot/Main.hs") "import A\nmain = print (a ++ \" b1\")"
+    cabal_build []
+    runExe' "one-shot" []
+        >>= assertOutputContains "a1 b1"
+    liftIO $ writeFile (pkg_dir </> "A.hs") "module A where\na = \"a2\""
+    liftIO $ writeFile (pkg_dir </> "one-shot/Main.hs") "import A\nmain = print (a ++ \" b2\")"
+    cabal "build" ["--one-shot", "one-shot"]
+    runExe' "one-shot" []
+        >>= assertOutputContains "a1 b2"
+
   where
     ghc_pkg_guess bin_name = do
         cwd <- packageDir