Accept components to copy in ./Setup copy, fixes #2780.

Signed-off-by: Edward Z. Yang <[email protected]>
haskell · Mar 29, 2016 · f88f502 · mgsloan · Aug 12, 2016 · ezyang
1 parent 5e7531a
commit f88f502
Show file tree

Hide file tree

Showing 15 changed files with 166 additions and 65 deletions.
diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
@@ -86,6 +86,15 @@ extra-source-files:
   tests/PackageTests/CMain/Bar.hs
   tests/PackageTests/CMain/foo.c
   tests/PackageTests/CMain/my.cabal
+  tests/PackageTests/Configure/A.hs
+  tests/PackageTests/Configure/Setup.hs
+  tests/PackageTests/Configure/X11.cabal
+  tests/PackageTests/CopyComponent/Exe/Main.hs
+  tests/PackageTests/CopyComponent/Exe/Main2.hs
+  tests/PackageTests/CopyComponent/Exe/myprog.cabal
+  tests/PackageTests/CopyComponent/Lib/Main.hs
+  tests/PackageTests/CopyComponent/Lib/p.cabal
+  tests/PackageTests/CopyComponent/Lib/src/P.hs
   tests/PackageTests/DeterministicAr/Lib.hs
   tests/PackageTests/DeterministicAr/my.cabal
   tests/PackageTests/DuplicateModuleName/DuplicateModuleName.cabal

diff --git a/Cabal/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs
@@ -305,7 +305,7 @@ copyAction hooks flags args = do
         flags' = flags { copyDistPref = toFlag distPref }
     hookedAction preCopy copyHook postCopy
                  (getBuildConfig hooks verbosity distPref)
-                 hooks flags' args
+                 hooks flags' { copyArgs = args } args
 
 installAction :: UserHooks -> InstallFlags -> Args -> IO ()
 installAction hooks flags args = do
@@ -575,12 +575,9 @@ autoconfUserHooks
     = simpleUserHooks
       {
        postConf    = defaultPostConf,
-       preBuild    = \_ flags ->
-                       -- not using 'readHook' here because 'build' takes
-                       -- extra args
-                       getHookedBuildInfo $ fromFlag $ buildVerbosity flags,
+       preBuild    = readHookWithArgs buildVerbosity,
+       preCopy     = readHookWithArgs copyVerbosity,
        preClean    = readHook cleanVerbosity,
-       preCopy     = readHook copyVerbosity,
        preInst     = readHook installVerbosity,
        preHscolour = readHook hscolourVerbosity,
        preHaddock  = readHook haddockVerbosity,
@@ -604,6 +601,12 @@ autoconfUserHooks
 
           backwardsCompatHack = False
 
+          readHookWithArgs :: (a -> Flag Verbosity) -> Args -> a -> IO HookedBuildInfo
+          readHookWithArgs get_verbosity _ flags = do
+              getHookedBuildInfo verbosity
+            where
+              verbosity = fromFlag (get_verbosity flags)
+
           readHook :: (a -> Flag Verbosity) -> Args -> a -> IO HookedBuildInfo
           readHook get_verbosity a flags = do
               noExtraFlags a

diff --git a/Cabal/Distribution/Simple/Build.hs b/Cabal/Distribution/Simple/Build.hs
@@ -38,7 +38,6 @@ import Distribution.Simple.Compiler hiding (Flag)
 import Distribution.PackageDescription hiding (Flag)
 import qualified Distribution.InstalledPackageInfo as IPI
 import qualified Distribution.ModuleName as ModuleName
-import Distribution.ModuleName (ModuleName)
 
 import Distribution.Simple.Setup
 import Distribution.Simple.BuildTarget
@@ -58,12 +57,10 @@ import Distribution.Verbosity
 
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import Data.Either
-         ( partitionEithers )
 import Data.List
          ( intersect )
 import Control.Monad
-         ( when, unless, forM_ )
+         ( when, unless )
 import System.FilePath
          ( (</>), (<.>) )
 import System.Directory
@@ -569,48 +566,3 @@ writeAutogenFiles verbosity pkg lbi clbi = do
 
   let cppHeaderPath = autogenModulesDir lbi clbi </> cppHeaderName
   rewriteFile cppHeaderPath (Build.Macros.generate pkg lbi clbi)
-
--- | Check that the given build targets are valid in the current context.
---
--- Also swizzle into a more convenient form.
---
-checkBuildTargets :: Verbosity -> PackageDescription -> [BuildTarget]
-                  -> IO [(ComponentName, Maybe (Either ModuleName FilePath))]
-checkBuildTargets _ pkg []      =
-    return [ (componentName c, Nothing) | c <- pkgEnabledComponents pkg ]
-
-checkBuildTargets verbosity pkg targets = do
-
-    let (enabled, disabled) =
-          partitionEithers
-            [ case componentDisabledReason (getComponent pkg cname) of
-                Nothing     -> Left  target'
-                Just reason -> Right (cname, reason)
-            | target <- targets
-            , let target'@(cname,_) = swizzleTarget target ]
-
-    case disabled of
-      []                 -> return ()
-      ((cname,reason):_) -> die $ formatReason (showComponentName cname) reason
-
-    forM_ [ (c, t) | (c, Just t) <- enabled ] $ \(c, t) ->
-      warn verbosity $ "Ignoring '" ++ either display id t ++ ". The whole "
-                    ++ showComponentName c ++ " will be built. (Support for "
-                    ++ "module and file targets has not been implemented yet.)"
-
-    return enabled
-
-  where
-    swizzleTarget (BuildTargetComponent c)   = (c, Nothing)
-    swizzleTarget (BuildTargetModule    c m) = (c, Just (Left  m))
-    swizzleTarget (BuildTargetFile      c f) = (c, Just (Right f))
-
-    formatReason cn DisabledComponent =
-        "Cannot build the " ++ cn ++ " because the component is marked "
-     ++ "as disabled in the .cabal file."
-    formatReason cn DisabledAllTests =
-        "Cannot build the " ++ cn ++ " because test suites are not "
-     ++ "enabled. Run configure with the flag --enable-tests"
-    formatReason cn DisabledAllBenchmarks =
-        "Cannot build the " ++ cn ++ " because benchmarks are not "
-     ++ "enabled. Re-run configure with the flag --enable-benchmarks"
diff --git a/Cabal/Distribution/Simple/BuildTarget.hs b/Cabal/Distribution/Simple/BuildTarget.hs
@@ -29,13 +29,17 @@ module Distribution.Simple.BuildTarget (
     resolveBuildTargets,
     BuildTargetProblem(..),
     reportBuildTargetProblems,
+
+    -- * Checking build targets
+    checkBuildTargets
   ) where
 
 import Distribution.PackageDescription
 import Distribution.ModuleName
 import Distribution.Simple.LocalBuildInfo
 import Distribution.Text
 import Distribution.Simple.Utils
+import Distribution.Verbosity
 
 import Distribution.Compat.Binary (Binary)
 import qualified Distribution.Compat.ReadP as Parse
@@ -937,3 +941,49 @@ matchInexactly cannonicalise xs =
 
 caseFold :: String -> String
 caseFold = lowercase
+
+
+-- | Check that the given build targets are valid in the current context.
+--
+-- Also swizzle into a more convenient form.
+--
+checkBuildTargets :: Verbosity -> PackageDescription -> [BuildTarget]
+                  -> IO [(ComponentName, Maybe (Either ModuleName FilePath))]
+checkBuildTargets _ pkg []      =
+    return [ (componentName c, Nothing) | c <- pkgEnabledComponents pkg ]
+
+checkBuildTargets verbosity pkg targets = do
+
+    let (enabled, disabled) =
+          partitionEithers
+            [ case componentDisabledReason (getComponent pkg cname) of
+                Nothing     -> Left  target'
+                Just reason -> Right (cname, reason)
+            | target <- targets
+            , let target'@(cname,_) = swizzleTarget target ]
+
+    case disabled of
+      []                 -> return ()
+      ((cname,reason):_) -> die $ formatReason (showComponentName cname) reason
+
+    forM_ [ (c, t) | (c, Just t) <- enabled ] $ \(c, t) ->
+      warn verbosity $ "Ignoring '" ++ either display id t ++ ". The whole "
+                    ++ showComponentName c ++ " will be processed. (Support for "
+                    ++ "module and file targets has not been implemented yet.)"
+
+    return enabled
+
+  where
+    swizzleTarget (BuildTargetComponent c)   = (c, Nothing)
+    swizzleTarget (BuildTargetModule    c m) = (c, Just (Left  m))
+    swizzleTarget (BuildTargetFile      c f) = (c, Just (Right f))
+
+    formatReason cn DisabledComponent =
+        "Cannot process the " ++ cn ++ " because the component is marked "
+     ++ "as disabled in the .cabal file."
+    formatReason cn DisabledAllTests =
+        "Cannot process the " ++ cn ++ " because test suites are not "
+     ++ "enabled. Run configure with the flag --enable-tests"
+    formatReason cn DisabledAllBenchmarks =
+        "Cannot process the " ++ cn ++ " because benchmarks are not "
+     ++ "enabled. Re-run configure with the flag --enable-benchmarks"
diff --git a/Cabal/Distribution/Simple/Install.hs b/Cabal/Distribution/Simple/Install.hs
@@ -27,6 +27,7 @@ import Distribution.Simple.Utils
 import Distribution.Simple.Compiler
          ( CompilerFlavor(..), compilerFlavor )
 import Distribution.Simple.Setup (CopyFlags(..), fromFlag)
+import Distribution.Simple.BuildTarget
 
 import qualified Distribution.Simple.GHC   as GHC
 import qualified Distribution.Simple.GHCJS as GHCJS
@@ -82,10 +83,14 @@ install pkg_descr lbi flags = do
   unless (hasLibs pkg_descr || hasExes pkg_descr) $
       die "No executables and no library found. Nothing to do."
 
+  targets <- readBuildTargets pkg_descr (copyArgs flags)
+  targets' <- checkBuildTargets verbosity pkg_descr targets
+
   -- Install (package-global) data files
   installDataFiles verbosity pkg_descr dataPref
 
   -- Install (package-global) Haddock files
+  -- TODO: these should be done per-library
   docExists <- doesDirectoryExist $ haddockPref distPref pkg_descr
   info verbosity ("directory " ++ haddockPref distPref pkg_descr ++
                   " does exist: " ++ show docExists)
@@ -117,7 +122,15 @@ install pkg_descr lbi flags = do
       [ installOrdinaryFile verbosity lfile (docPref </> takeFileName lfile)
       | lfile <- lfiles ]
 
-  withLibLBI pkg_descr lbi $ \lib clbi -> do
+  -- It's not necessary to do these in build-order, but it's harmless
+  withComponentsInBuildOrder pkg_descr lbi (map fst targets') $ \comp clbi ->
+    copyComponent verbosity pkg_descr lbi comp clbi copydest
+
+copyComponent :: Verbosity -> PackageDescription
+              -> LocalBuildInfo -> Component -> ComponentLocalBuildInfo
+              -> CopyDest
+              -> IO ()
+copyComponent verbosity pkg_descr lbi (CLib lib) clbi copydest = do
     let InstallDirs{
             libdir = libPref,
             includedir = incPref
@@ -149,7 +162,7 @@ install pkg_descr lbi flags = do
               ++ display (compilerFlavor (compiler lbi))
               ++ " is not implemented"
 
-  withExeLBI pkg_descr lbi $ \exe clbi -> do
+copyComponent verbosity pkg_descr lbi (CExe exe) clbi copydest = do
     let installDirs@InstallDirs {
             bindir = binPref
             } = absoluteComponentInstallDirs pkg_descr lbi (componentUnitId clbi) copydest
@@ -175,6 +188,9 @@ install pkg_descr lbi flags = do
               ++ display (compilerFlavor (compiler lbi))
               ++ " is not implemented"
 
+-- Nothing to do for benchmark/testsuite
+copyComponent _ _ _ _ _ _ = return ()
+
 -- | Install the files listed in data-files
 --
 installDataFiles :: Verbosity -> PackageDescription -> FilePath -> IO ()

diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs
@@ -824,27 +824,39 @@ instance Semigroup ConfigFlags where
 data CopyFlags = CopyFlags {
     copyDest      :: Flag CopyDest,
     copyDistPref  :: Flag FilePath,
-    copyVerbosity :: Flag Verbosity
+    copyVerbosity :: Flag Verbosity,
+    -- This is the same hack as in 'buildArgs'.  But I (ezyang) don't
+    -- think it's a hack, it's the right way to make hooks more robust
+    copyArgs :: [String]
   }
   deriving (Show, Generic)
 
 defaultCopyFlags :: CopyFlags
 defaultCopyFlags  = CopyFlags {
     copyDest      = Flag NoCopyDest,
     copyDistPref  = NoFlag,
-    copyVerbosity = Flag normal
+    copyVerbosity = Flag normal,
+    copyArgs      = []
   }
 
 copyCommand :: CommandUI CopyFlags
 copyCommand = CommandUI
   { commandName         = "copy"
-  , commandSynopsis     = "Copy the files into the install locations."
+  , commandSynopsis     = "Copy the files of all/specific components to install locations."
   , commandDescription  = Just $ \_ -> wrapText $
-          "Does not call register, and allows a prefix at install time. "
+          "Components encompass executables and libraries."
+       ++ "Does not call register, and allows a prefix at install time. "
        ++ "Without the --destdir flag, configure determines location.\n"
-  , commandNotes        = Nothing
-  , commandUsage        = \pname ->
-      "Usage: " ++ pname ++ " copy [FLAGS]\n"
+  , commandNotes        = Just $ \pname ->
+       "Examples:\n"
+        ++ "  " ++ pname ++ " build           "
+        ++ "    All the components in the package\n"
+        ++ "  " ++ pname ++ " build foo       "
+        ++ "    A component (i.e. lib, exe, test suite)"
+  , commandUsage        = usageAlternatives "copy" $
+      [ "[FLAGS]"
+      , "COMPONENTS [FLAGS]"
+      ]
   , commandDefaultFlags = defaultCopyFlags
   , commandOptions      = \showOrParseArgs ->
       [optionVerbosity copyVerbosity (\v flags -> flags { copyVerbosity = v })

diff --git a/Cabal/Distribution/Simple/UserHooks.hs b/Cabal/Distribution/Simple/UserHooks.hs
@@ -173,7 +173,7 @@ emptyUserHooks
       preClean  = rn,
       cleanHook = ru,
       postClean = ru,
-      preCopy   = rn,
+      preCopy   = rn',
       copyHook  = ru,
       postCopy  = ru,
       preInst   = rn,

diff --git a/Cabal/tests/PackageTests/CopyComponent/Exe/Main.hs b/Cabal/tests/PackageTests/CopyComponent/Exe/Main.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = putStrLn "Hello, Haskell!"
diff --git a/Cabal/tests/PackageTests/CopyComponent/Exe/Main2.hs b/Cabal/tests/PackageTests/CopyComponent/Exe/Main2.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = putStrLn "Hello, Haskell!"
diff --git a/Cabal/tests/PackageTests/CopyComponent/Exe/myprog.cabal b/Cabal/tests/PackageTests/CopyComponent/Exe/myprog.cabal
@@ -0,0 +1,15 @@
+name:                myprog
+version:             0.1.0.0
+license:             BSD3
+author:              Edward Z. Yang
+maintainer:          [email protected]
+build-type:          Simple
+cabal-version:       >=1.10
+
+executable myprog
+  main-is:             Main.hs
+  build-depends:       base
+
+executable myprog2
+  main-is:             Main2.hs
+  build-depends:       base
diff --git a/Cabal/tests/PackageTests/CopyComponent/Lib/Main.hs b/Cabal/tests/PackageTests/CopyComponent/Lib/Main.hs
@@ -0,0 +1,2 @@
+import P
+main = print p
diff --git a/Cabal/tests/PackageTests/CopyComponent/Lib/p.cabal b/Cabal/tests/PackageTests/CopyComponent/Lib/p.cabal
@@ -0,0 +1,17 @@
+name:                p
+version:             0.1.0.0
+license:             BSD3
+author:              Edward Z. Yang
+maintainer:          [email protected]
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     P
+  hs-source-dirs:      src
+  build-depends:       base
+  default-language:    Haskell2010
+
+executable pprog
+  main-is:             Main.hs
+  build-depends:       p
diff --git a/Cabal/tests/PackageTests/CopyComponent/Lib/src/P.hs b/Cabal/tests/PackageTests/CopyComponent/Lib/src/P.hs
@@ -0,0 +1,2 @@
+module P where
+p = 12
diff --git a/Cabal/tests/PackageTests/Tests.hs b/Cabal/tests/PackageTests/Tests.hs
@@ -312,6 +312,20 @@ tests config = do
           _ <- shell "autoreconf" ["-i"]
           cabal_build []
 
+  -- Test that per-component copy works, when only building library
+  tc "CopyComponent/Lib" $
+      withPackageDb $ do
+          cabal "configure" []
+          cabal "build" ["lib:p"]
+          cabal "copy" ["lib:p"]
+
+  -- Test that per-component copy works, when only building one executable
+  tc "CopyComponent/Exe" $
+      withPackageDb $ do
+          cabal "configure" []
+          cabal "build" ["myprog"]
+          cabal "copy" ["myprog"]
+
   where
     ghc_pkg_guess bin_name = do
         cwd <- packageDir

diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs
@@ -2135,6 +2135,7 @@ setupHsCopyFlags _ _ verbosity builddir =
       --TODO: [nice to have] we currently just rely on Setup.hs copy to always do the right
       -- thing, but perhaps we ought really to copy into an image dir and do
       -- some sanity checks and move into the final location ourselves
+      copyArgs      = [], -- TODO: could use this to only copy what we enabled
       copyDest      = toFlag InstallDirs.NoCopyDest,
       copyDistPref  = toFlag builddir,
       copyVerbosity = toFlag verbosity