Commit f88f502d authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

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


Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 5e7531a1
......@@ -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
......
......@@ -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
......
......@@ -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"
......@@ -29,6 +29,9 @@ module Distribution.Simple.BuildTarget (
resolveBuildTargets,
BuildTargetProblem(..),
reportBuildTargetProblems,
-- * Checking build targets
checkBuildTargets
) where
import Distribution.PackageDescription
......@@ -36,6 +39,7 @@ 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"
......@@ -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 ()
......
......@@ -824,7 +824,10 @@ 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)
......@@ -832,19 +835,28 @@ 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 })
......
......@@ -173,7 +173,7 @@ emptyUserHooks
preClean = rn,
cleanHook = ru,
postClean = ru,
preCopy = rn,
preCopy = rn',
copyHook = ru,
postCopy = ru,
preInst = rn,
......
module Main where
main :: IO ()
main = putStrLn "Hello, Haskell!"
module Main where
main :: IO ()
main = putStrLn "Hello, Haskell!"
name: myprog
version: 0.1.0.0
license: BSD3
author: Edward Z. Yang
maintainer: ezyang@cs.stanford.edu
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
name: p
version: 0.1.0.0
license: BSD3
author: Edward Z. Yang
maintainer: ezyang@cs.stanford.edu
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
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment