diff --git a/Cabal/doc/nix-local-build.rst b/Cabal/doc/nix-local-build.rst index 20d0faf5ef9..fbbbb4db504 100644 --- a/Cabal/doc/nix-local-build.rst +++ b/Cabal/doc/nix-local-build.rst @@ -557,6 +557,16 @@ repository, this command will build cabal-install HEAD and symlink the $ cabal new-install exe:cabal +Where symlinking is not possible (eg. on Windows), ``--bindir-method`` and +``--copy-bindir`` can be used instead: + +:: + + $ cabal new-install exe:cabal --bindir-method=copy --copy-bindir=~/bin + +Note that copied executables are not self-contained, since they might use +data-files from the store. + It is also possible to "install" libraries using the ``--lib`` flag. For example, this command will build the latest Cabal library and install it: diff --git a/cabal-install/Distribution/Client/CmdBench.hs b/cabal-install/Distribution/Client/CmdBench.hs index f4f290898f0..d40bee5ac71 100644 --- a/cabal-install/Distribution/Client/CmdBench.hs +++ b/cabal-install/Distribution/Client/CmdBench.hs @@ -117,7 +117,9 @@ benchAction (configFlags, configExFlags, installFlags, haddockFlags) verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags -- | This defines what a 'TargetSelector' means for the @bench@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, diff --git a/cabal-install/Distribution/Client/CmdBuild.hs b/cabal-install/Distribution/Client/CmdBuild.hs index 8bc7388fa4d..617fbbb5da2 100644 --- a/cabal-install/Distribution/Client/CmdBuild.hs +++ b/cabal-install/Distribution/Client/CmdBuild.hs @@ -147,7 +147,9 @@ buildAction (buildFlags, verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags -- | This defines what a 'TargetSelector' means for the @bench@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, diff --git a/cabal-install/Distribution/Client/CmdConfigure.hs b/cabal-install/Distribution/Client/CmdConfigure.hs index 7b691e2a21d..9fc288ed82b 100644 --- a/cabal-install/Distribution/Client/CmdConfigure.hs +++ b/cabal-install/Distribution/Client/CmdConfigure.hs @@ -121,5 +121,7 @@ configureAction (configFlags, configExFlags, installFlags, haddockFlags) verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags diff --git a/cabal-install/Distribution/Client/CmdExec.hs b/cabal-install/Distribution/Client/CmdExec.hs index 61308422a59..87c14ca1cb8 100644 --- a/cabal-install/Distribution/Client/CmdExec.hs +++ b/cabal-install/Distribution/Client/CmdExec.hs @@ -193,7 +193,9 @@ execAction (configFlags, configExFlags, installFlags, haddockFlags) verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags withOverrides env args program = program { programOverrideEnv = programOverrideEnv program ++ env , programDefaultArgs = programDefaultArgs program ++ args} diff --git a/cabal-install/Distribution/Client/CmdFreeze.hs b/cabal-install/Distribution/Client/CmdFreeze.hs index dc54d7baebc..38afb9a7600 100644 --- a/cabal-install/Distribution/Client/CmdFreeze.hs +++ b/cabal-install/Distribution/Client/CmdFreeze.hs @@ -130,7 +130,9 @@ freezeAction (configFlags, configExFlags, installFlags, haddockFlags) verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags diff --git a/cabal-install/Distribution/Client/CmdHaddock.hs b/cabal-install/Distribution/Client/CmdHaddock.hs index e645e54d019..019701235be 100644 --- a/cabal-install/Distribution/Client/CmdHaddock.hs +++ b/cabal-install/Distribution/Client/CmdHaddock.hs @@ -111,7 +111,9 @@ haddockAction (configFlags, configExFlags, installFlags, haddockFlags) verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags -- | This defines what a 'TargetSelector' means for the @haddock@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, diff --git a/cabal-install/Distribution/Client/CmdInstall.hs b/cabal-install/Distribution/Client/CmdInstall.hs index 557395650e7..a7f05dea187 100644 --- a/cabal-install/Distribution/Client/CmdInstall.hs +++ b/cabal-install/Distribution/Client/CmdInstall.hs @@ -20,11 +20,15 @@ module Distribution.Client.CmdInstall ( import Prelude () import Distribution.Client.Compat.Prelude +import Distribution.Compat.Directory + ( doesPathExist ) import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages import Distribution.Client.CmdSdist +import Distribution.Client.CmdInstall.ClientInstallFlags + import Distribution.Client.Setup ( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags(..) , configureExOptions, haddockOptions, installOptions @@ -47,11 +51,13 @@ import Distribution.Client.ProjectConfig.Types , projectConfigDistDir, projectConfigConfigFile ) import Distribution.Simple.Program.Db ( userSpecifyPaths, userSpecifyArgss, defaultProgramDb - , modifyProgramSearchPath ) + , modifyProgramSearchPath, ProgramDb ) +import Distribution.Simple.BuildPaths + ( exeExtension ) import Distribution.Simple.Program.Find ( ProgramSearchPathEntry(..) ) import Distribution.Client.Config - ( getCabalDir ) + ( getCabalDir, loadConfig, SavedConfig(..) ) import qualified Distribution.Simple.PackageIndex as PI import Distribution.Solver.Types.PackageIndex ( lookupPackageName, searchByName ) @@ -68,38 +74,40 @@ import Distribution.Client.IndexUtils import Distribution.Client.ProjectConfig ( readGlobalConfig, projectConfigWithBuilderRepoContext , resolveBuildTimeSettings, withProjectOrGlobalConfig ) +import Distribution.Client.ProjectPlanning + ( storePackageInstallDirs' ) +import qualified Distribution.Simple.InstallDirs as InstallDirs import Distribution.Client.DistDirLayout ( defaultDistDirLayout, DistDirLayout(..), mkCabalDirLayout , ProjectRoot(ProjectRootImplicit) - , storePackageDirectory, cabalStoreDirLayout + , cabalStoreDirLayout , CabalDirLayout(..), StoreDirLayout(..) ) import Distribution.Client.RebuildMonad ( runRebuild ) import Distribution.Client.InstallSymlink ( OverwritePolicy(..), symlinkBinary ) import Distribution.Simple.Setup - ( Flag(..), HaddockFlags, fromFlagOrDefault, flagToMaybe - , trueArg, flagToList, toFlag ) + ( Flag(..), HaddockFlags, fromFlagOrDefault, flagToMaybe ) import Distribution.Solver.Types.SourcePackage ( SourcePackage(..) ) -import Distribution.ReadE - ( ReadE(..), succeedReadE ) import Distribution.Simple.Command - ( CommandUI(..), ShowOrParseArgs(..), OptionField(..) - , option, usageAlternatives, reqArg ) + ( CommandUI(..), OptionField(..), usageAlternatives ) import Distribution.Simple.Configure ( configCompilerEx ) import Distribution.Simple.Compiler - ( Compiler(..), CompilerId(..), CompilerFlavor(..) ) + ( Compiler(..), CompilerId(..), CompilerFlavor(..) + , PackageDBStack ) import Distribution.Simple.GHC ( ghcPlatformAndVersionString , GhcImplInfo(..), getImplInfo , GhcEnvironmentFileEntry(..) , renderGhcEnvironmentFile, readGhcEnvironmentFile, ParseErrorExc ) +import Distribution.System + ( Platform ) import Distribution.Types.UnitId ( UnitId ) import Distribution.Types.UnqualComponentName - ( UnqualComponentName, unUnqualComponentName ) + ( UnqualComponentName, unUnqualComponentName, mkUnqualComponentName ) import Distribution.Verbosity ( Verbosity, normal, lessVerbose ) import Distribution.Simple.Utils @@ -127,52 +135,14 @@ import Distribution.Utils.NubList ( fromNubList ) import System.Directory ( getHomeDirectory, doesFileExist, createDirectoryIfMissing - , getTemporaryDirectory, makeAbsolute, doesDirectoryExist ) + , getTemporaryDirectory, makeAbsolute, doesDirectoryExist + , removeFile, removeDirectory, copyFile ) import System.FilePath - ( (), takeDirectory, takeBaseName ) - -data NewInstallFlags = NewInstallFlags - { ninstInstallLibs :: Flag Bool - , ninstEnvironmentPath :: Flag FilePath - , ninstOverwritePolicy :: Flag OverwritePolicy - } - -defaultNewInstallFlags :: NewInstallFlags -defaultNewInstallFlags = NewInstallFlags - { ninstInstallLibs = toFlag False - , ninstEnvironmentPath = mempty - , ninstOverwritePolicy = toFlag NeverOverwrite - } + ( (), (<.>), takeDirectory, takeBaseName ) -newInstallOptions :: ShowOrParseArgs -> [OptionField NewInstallFlags] -newInstallOptions _ = - [ option [] ["lib"] - "Install libraries rather than executables from the target package." - ninstInstallLibs (\v flags -> flags { ninstInstallLibs = v }) - trueArg - , option [] ["package-env", "env"] - "Set the environment file that may be modified." - ninstEnvironmentPath (\pf flags -> flags { ninstEnvironmentPath = pf }) - (reqArg "ENV" (succeedReadE Flag) flagToList) - , option [] ["overwrite-policy"] - "How to handle already existing symlinks." - ninstOverwritePolicy (\v flags -> flags { ninstOverwritePolicy = v }) - $ reqArg - "always|never" - readOverwritePolicyFlag - showOverwritePolicyFlag - ] - where - readOverwritePolicyFlag = ReadE $ \case - "always" -> Right $ Flag AlwaysOverwrite - "never" -> Right $ Flag NeverOverwrite - policy -> Left $ "'" <> policy <> "' isn't a valid overwrite policy" - showOverwritePolicyFlag (Flag AlwaysOverwrite) = ["always"] - showOverwritePolicyFlag (Flag NeverOverwrite) = ["never"] - showOverwritePolicyFlag NoFlag = [] installCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags - , HaddockFlags, NewInstallFlags + , HaddockFlags, ClientInstallFlags ) installCommand = CommandUI { commandName = "new-install" @@ -221,8 +191,8 @@ installCommand = CommandUI (filter ((`notElem` ["v", "verbose", "builddir"]) . optionName) $ haddockOptions showOrParseArgs) - ++ liftOptions get5 set5 (newInstallOptions showOrParseArgs) - , commandDefaultFlags = (mempty, mempty, mempty, mempty, defaultNewInstallFlags) + ++ liftOptions get5 set5 (clientInstallOptions showOrParseArgs) + , commandDefaultFlags = (mempty, mempty, mempty, mempty, defaultClientInstallFlags) } where get1 (a,_,_,_,_) = a; set1 a (_,b,c,d,e) = (a,b,c,d,e) @@ -249,9 +219,9 @@ installCommand = CommandUI -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -installAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, NewInstallFlags) +installAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, ClientInstallFlags) -> [String] -> GlobalFlags -> IO () -installAction (configFlags, configExFlags, installFlags, haddockFlags, newInstallFlags) +installAction (configFlags, configExFlags, installFlags, haddockFlags, clientInstallFlags') targetStrings globalFlags = do -- We never try to build tests/benchmarks for remote packages. -- So we set them as disabled by default and error if they are explicitly @@ -263,6 +233,14 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, newInstal die' verbosity $ "--enable-benchmarks was specified, but benchmarks can't " ++ "be enabled in a remote package" + -- We cannot use establishDummyProjectBaseContext to get these flags, since + -- it requires one of them as an argument. Normal establishProjectBaseContext + -- does not, and this is why this is done only for the install command + clientInstallFlags <- do + let configFileFlag = globalConfigFile globalFlags + savedConfig <- loadConfig verbosity configFileFlag + pure $ savedClientInstallFlags savedConfig `mappend` clientInstallFlags' + let withProject = do let verbosity' = lessVerbose verbosity @@ -482,7 +460,7 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, newInstal GhcEnvFilePackageId _ -> True _ -> False - envFile <- case flagToMaybe (ninstEnvironmentPath newInstallFlags) of + envFile <- case flagToMaybe (cinstEnvironmentPath clientInstallFlags) of Just spec -- Is spec a bare word without any "pathy" content, then it refers to -- a named global environment. @@ -568,68 +546,112 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, newInstal <> "Try rerunning with -j1 if you can't see the error." runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes + -- Now that we built everything we can do the installation part. + -- First, figure out if / what parts we want to install: let dryRun = buildSettingDryRun $ buildSettings baseCtx - mkPkgBinDir = ( "bin") . - storePackageDirectory - (cabalStoreDirLayout $ cabalDirLayout baseCtx) - compilerId - installLibs = fromFlagOrDefault False (ninstInstallLibs newInstallFlags) - - when (not installLibs && not dryRun) $ do - -- If there are exes, symlink them - let symlinkBindirUnknown = - "symlink-bindir is not defined. Set it in your cabal config file " - ++ "or use --symlink-bindir=" - symlinkBindir <- fromFlagOrDefault (die' verbosity symlinkBindirUnknown) - $ fmap makeAbsolute - $ projectConfigSymlinkBinDir - $ projectConfigBuildOnly - $ projectConfig $ baseCtx - createDirectoryIfMissingVerbose verbosity False symlinkBindir - warnIfNoExes verbosity buildCtx - let - doSymlink = symlinkBuiltPackage - verbosity - overwritePolicy - mkPkgBinDir symlinkBindir - in traverse_ doSymlink $ Map.toList $ targetsMap buildCtx - - when (installLibs && not dryRun) $ - if supportsPkgEnvFiles - then do - -- Why do we get it again? If we updated a globalPackage then we need - -- the new version. - installedIndex' <- getInstalledPackages verbosity compiler packageDbs progDb' - let - getLatest = fmap (head . snd) . take 1 . sortBy (comparing (Down . fst)) - . PI.lookupPackageName installedIndex' - globalLatest = concat (getLatest <$> globalPackages) - - baseEntries = - GhcEnvFileClearPackageDbStack : fmap GhcEnvFilePackageDb packageDbs - globalEntries = GhcEnvFilePackageId . installedUnitId <$> globalLatest - pkgEntries = ordNub $ - globalEntries - ++ envEntries' - ++ entriesForLibraryComponents (targetsMap buildCtx) - contents' = renderGhcEnvironmentFile (baseEntries ++ pkgEntries) - createDirectoryIfMissing True (takeDirectory envFile) - writeFileAtomic envFile (BS.pack contents') - else - warn verbosity $ - "The current compiler doesn't support safely installing libraries, " - ++ "so only executables will be available. (Library installation is " - ++ "supported on GHC 8.0+ only)" + installLibs = fromFlagOrDefault False (cinstInstallLibs clientInstallFlags) + + -- Then, install! + when (not dryRun) $ + if installLibs + then installLibraries verbosity buildCtx compiler packageDbs progDb envFile envEntries' + else installExes verbosity baseCtx buildCtx platform compiler clientInstallFlags where configFlags' = disableTestsBenchsByDefault configFlags verbosity = fromFlagOrDefault normal (configVerbosity configFlags') cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags' configExFlags - installFlags haddockFlags + installFlags clientInstallFlags' + haddockFlags globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) + +-- | Install any built exe by symlinking/copying it +-- we don't use BuildOutcomes because we also need the component names +installExes :: Verbosity + -> ProjectBaseContext + -> ProjectBuildContext + -> Platform + -> Compiler + -> ClientInstallFlags + -> IO () +installExes verbosity baseCtx buildCtx platform compiler + clientInstallFlags = do + let storeDirLayout = cabalStoreDirLayout $ cabalDirLayout baseCtx + let mkPkgBinDir :: UnitId -> FilePath + mkPkgBinDir = InstallDirs.bindir . + storePackageInstallDirs' + storeDirLayout + (compilerId compiler) + mkExeName :: UnqualComponentName -> FilePath + mkExeName exe = unUnqualComponentName exe <.> exeExtension platform + symlinkBindirUnknown = + "symlink-bindir is not defined. Set it in your cabal config file " + ++ "or use --symlink-bindir=" + copyBindirUnknown = + "copy-bindir is not defined. Set it in your cabal config file " + ++ "or use --copy-bindir=" + -- TODO check only for the one we use... or use only one. + symlinkBindir <- fromFlagOrDefault (die' verbosity symlinkBindirUnknown) + $ fmap makeAbsolute + $ projectConfigSymlinkBinDir + $ projectConfigBuildOnly + $ projectConfig baseCtx + copyBindir <- fromFlagOrDefault (die' verbosity copyBindirUnknown) + $ pure <$> cinstCopydir clientInstallFlags + createDirectoryIfMissingVerbose verbosity False symlinkBindir + createDirectoryIfMissingVerbose verbosity False copyBindir + warnIfNoExes verbosity buildCtx + let + doInstall = installPackageExes + verbosity + overwritePolicy + mkPkgBinDir + mkExeName + symlinkBindir copyBindir installMethod + in traverse_ doInstall $ Map.toList $ targetsMap buildCtx + where overwritePolicy = fromFlagOrDefault NeverOverwrite - $ ninstOverwritePolicy newInstallFlags + $ cinstOverwritePolicy clientInstallFlags + installMethod = fromFlagOrDefault InstallMethodSymlink + $ cinstInstallMethod clientInstallFlags + +-- | Install any built library by adding it to the default ghc environment +installLibraries :: Verbosity + -> ProjectBuildContext + -> Compiler + -> PackageDBStack + -> ProgramDb + -> FilePath -- ^ Environment file + -> [GhcEnvironmentFileEntry] + -> IO () +installLibraries verbosity buildCtx compiler + packageDbs programDb envFile envEntries = do + -- Why do we get it again? If we updated a globalPackage then we need + -- the new version. + installedIndex <- getInstalledPackages verbosity compiler packageDbs programDb + if supportsPkgEnvFiles $ getImplInfo compiler + then do + let + getLatest = fmap (head . snd) . take 1 . sortBy (comparing (Down . fst)) + . PI.lookupPackageName installedIndex + globalLatest = concat (getLatest <$> globalPackages) + + baseEntries = + GhcEnvFileClearPackageDbStack : fmap GhcEnvFilePackageDb packageDbs + globalEntries = GhcEnvFilePackageId . installedUnitId <$> globalLatest + pkgEntries = ordNub $ + globalEntries + ++ envEntries + ++ entriesForLibraryComponents (targetsMap buildCtx) + contents' = renderGhcEnvironmentFile (baseEntries ++ pkgEntries) + createDirectoryIfMissing True (takeDirectory envFile) + writeFileAtomic envFile (BS.pack contents') + else + warn verbosity $ + "The current compiler doesn't support safely installing libraries, " + ++ "so only executables will be available. (Library installation is " + ++ "supported on GHC 8.0+ only)" warnIfNoExes :: Verbosity -> ProjectBuildContext -> IO () warnIfNoExes verbosity buildCtx = @@ -676,28 +698,37 @@ disableTestsBenchsByDefault configFlags = configFlags { configTests = Flag False <> configTests configFlags , configBenchmarks = Flag False <> configBenchmarks configFlags } --- | Symlink every exe from a package from the store to a given location -symlinkBuiltPackage :: Verbosity - -> OverwritePolicy -- ^ Whether to overwrite existing files - -> (UnitId -> FilePath) -- ^ A function to get an UnitId's - -- store directory - -> FilePath -- ^ Where to put the symlink - -> ( UnitId - , [(ComponentTarget, [TargetSelector])] ) - -> IO () -symlinkBuiltPackage verbosity overwritePolicy - mkSourceBinDir destDir - (pkg, components) = - traverse_ symlinkAndWarn exes +-- | Symlink/copy every exe from a package from the store to a given location +-- TODO s/Package/Unit/ s/pkg/unit/ +installPackageExes :: Verbosity + -> OverwritePolicy -- ^ Whether to overwrite existing files + -> (UnitId -> FilePath) -- ^ A function to get an UnitId's + -- store directory + -> (UnqualComponentName -> FilePath) -- ^ get exe name + -> FilePath + -> FilePath + -> InstallMethod + -> ( UnitId + , [(ComponentTarget, [TargetSelector])] ) + -> IO () +installPackageExes verbosity overwritePolicy + mkSourceBinDir mkExeName + symlinkBindir copyBindir installMethod + (pkg, components) = + traverse_ installAndWarn exes where exes = catMaybes $ (exeMaybe . fst) <$> components exeMaybe (ComponentTarget (CExeName exe) _) = Just exe exeMaybe _ = Nothing - symlinkAndWarn exe = do - success <- symlinkBuiltExe + installAndWarn exe = do + success <- installBuiltExe verbosity overwritePolicy - (mkSourceBinDir pkg) destDir exe - let errorMessage = case overwritePolicy of + (mkSourceBinDir pkg) (mkExeName exe) + symlinkBindir copyBindir installMethod + let destDir = case installMethod + of InstallMethodSymlink -> symlinkBindir + InstallMethodCopy -> copyBindir + errorMessage = case overwritePolicy of NeverOverwrite -> "Path '" <> (destDir prettyShow exe) <> "' already exists. " <> "Use --overwrite-policy=always to overwrite." @@ -706,19 +737,42 @@ symlinkBuiltPackage verbosity overwritePolicy AlwaysOverwrite -> "Symlinking '" <> prettyShow exe <> "' failed." unless success $ die' verbosity errorMessage --- | Symlink a specific exe. -symlinkBuiltExe :: Verbosity -> OverwritePolicy - -> FilePath -> FilePath - -> UnqualComponentName +-- | Install a specific exe. +installBuiltExe :: Verbosity -> OverwritePolicy + -> FilePath + -> FilePath + -> FilePath + -> FilePath + -> InstallMethod -> IO Bool -symlinkBuiltExe verbosity overwritePolicy sourceDir destDir exe = do - notice verbosity $ "Symlinking '" <> prettyShow exe <> "'" +installBuiltExe verbosity overwritePolicy + sourceDir exeName + symlinkBindir _ InstallMethodSymlink = do + notice verbosity $ "Symlinking '" <> exeName <> "'" symlinkBinary overwritePolicy - destDir + symlinkBindir sourceDir - exe - $ unUnqualComponentName exe + (mkUnqualComponentName exeName) + exeName +installBuiltExe verbosity overwritePolicy + sourceDir exeName + _ copyBindir InstallMethodCopy = do + notice verbosity $ "Copying '" <> exeName <> "'" + exists <- doesPathExist destination + case (exists, overwritePolicy) of + (True , NeverOverwrite ) -> pure False + (True , AlwaysOverwrite) -> remove >> copy + (False, _ ) -> copy + where + source = sourceDir exeName + destination = copyBindir exeName + remove = do + isDir <- doesDirectoryExist destination + if isDir + then removeDirectory destination + else removeFile destination + copy = copyFile source destination >> pure True -- | Create 'GhcEnvironmentFileEntry's for packages with exposed libraries. entriesForLibraryComponents :: TargetsMap -> [GhcEnvironmentFileEntry] diff --git a/cabal-install/Distribution/Client/CmdInstall/ClientInstallFlags.hs b/cabal-install/Distribution/Client/CmdInstall/ClientInstallFlags.hs new file mode 100644 index 00000000000..0b59a91adbf --- /dev/null +++ b/cabal-install/Distribution/Client/CmdInstall/ClientInstallFlags.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +module Distribution.Client.CmdInstall.ClientInstallFlags +( InstallMethod(..) +, ClientInstallFlags(..) +, defaultClientInstallFlags +, clientInstallOptions +) where + +import Distribution.Client.Compat.Prelude + +import Distribution.ReadE + ( ReadE(..), succeedReadE ) +import Distribution.Simple.Command + ( ShowOrParseArgs(..), OptionField(..), option, reqArg ) +import Distribution.Simple.Setup + ( Flag(..), trueArg, flagToList, toFlag ) + +import Distribution.Client.InstallSymlink + ( OverwritePolicy(..) ) + + +data InstallMethod = InstallMethodCopy + | InstallMethodSymlink + deriving (Eq, Show, Generic, Bounded, Enum) + +instance Binary InstallMethod + +data ClientInstallFlags = ClientInstallFlags + { cinstInstallLibs :: Flag Bool + , cinstEnvironmentPath :: Flag FilePath + , cinstOverwritePolicy :: Flag OverwritePolicy + , cinstInstallMethod :: Flag InstallMethod + , cinstCopydir :: Flag FilePath + } deriving (Eq, Show, Generic) + +instance Monoid ClientInstallFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup ClientInstallFlags where + (<>) = gmappend + +instance Binary ClientInstallFlags + +defaultClientInstallFlags :: ClientInstallFlags +defaultClientInstallFlags = ClientInstallFlags + { cinstInstallLibs = toFlag False + , cinstEnvironmentPath = mempty + , cinstOverwritePolicy = toFlag NeverOverwrite + , cinstInstallMethod = toFlag InstallMethodSymlink + , cinstCopydir = mempty + } + +clientInstallOptions :: ShowOrParseArgs -> [OptionField ClientInstallFlags] +clientInstallOptions _ = + [ option [] ["lib"] + "Install libraries rather than executables from the target package." + cinstInstallLibs (\v flags -> flags { cinstInstallLibs = v }) + trueArg + , option [] ["package-env", "env"] + "Set the environment file that may be modified." + cinstEnvironmentPath (\pf flags -> flags { cinstEnvironmentPath = pf }) + (reqArg "ENV" (succeedReadE Flag) flagToList) + , option [] ["overwrite-policy"] + "How to handle already existing symlinks." + cinstOverwritePolicy (\v flags -> flags { cinstOverwritePolicy = v }) + $ reqArg + "always|never" + readOverwritePolicyFlag + showOverwritePolicyFlag + , option [] ["install-method"] + "How to install the executable." + cinstInstallMethod (\v flags -> flags { cinstInstallMethod = v }) + $ reqArg + "copy|symlink" + readInstallMethodFlag + showInstallMethodFlag + , option [] ["copy-bindir"] + "Where to copy the executable if --install-method=copy" + cinstCopydir (\v flags -> flags { cinstCopydir = v }) + $ reqArg "DIR" (succeedReadE Flag) flagToList + ] + +readOverwritePolicyFlag :: ReadE (Flag OverwritePolicy) +readOverwritePolicyFlag = ReadE $ \case + "always" -> Right $ Flag AlwaysOverwrite + "never" -> Right $ Flag NeverOverwrite + policy -> Left $ "'" <> policy <> "' isn't a valid overwrite policy" + +showOverwritePolicyFlag :: Flag OverwritePolicy -> [String] +showOverwritePolicyFlag (Flag AlwaysOverwrite) = ["always"] +showOverwritePolicyFlag (Flag NeverOverwrite) = ["never"] +showOverwritePolicyFlag NoFlag = [] + +readInstallMethodFlag :: ReadE (Flag InstallMethod) +readInstallMethodFlag = ReadE $ \case + "copy" -> Right $ Flag InstallMethodCopy + "symlink" -> Right $ Flag InstallMethodSymlink + method -> Left $ "'" <> method <> "' isn't a valid install-method" + +showInstallMethodFlag :: Flag InstallMethod -> [String] +showInstallMethodFlag (Flag InstallMethodCopy) = ["copy"] +showInstallMethodFlag (Flag InstallMethodSymlink) = ["symlink"] +showInstallMethodFlag NoFlag = [] + diff --git a/cabal-install/Distribution/Client/CmdRepl.hs b/cabal-install/Distribution/Client/CmdRepl.hs index 662b7118991..a34222dc557 100644 --- a/cabal-install/Distribution/Client/CmdRepl.hs +++ b/cabal-install/Distribution/Client/CmdRepl.hs @@ -302,7 +302,9 @@ replAction (configFlags, configExFlags, installFlags, haddockFlags, replFlags, e verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) validatedTargets elaboratedPlan targetSelectors = do diff --git a/cabal-install/Distribution/Client/CmdRun.hs b/cabal-install/Distribution/Client/CmdRun.hs index e69537f7789..680dd7bcb7a 100644 --- a/cabal-install/Distribution/Client/CmdRun.hs +++ b/cabal-install/Distribution/Client/CmdRun.hs @@ -296,7 +296,9 @@ runAction (configFlags, configExFlags, installFlags, haddockFlags) verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) -- | Used by the main CLI parser as heuristic to decide whether @cabal@ was diff --git a/cabal-install/Distribution/Client/CmdTest.hs b/cabal-install/Distribution/Client/CmdTest.hs index 4abfdc1bac6..88cf99641eb 100644 --- a/cabal-install/Distribution/Client/CmdTest.hs +++ b/cabal-install/Distribution/Client/CmdTest.hs @@ -123,7 +123,9 @@ testAction (configFlags, configExFlags, installFlags, haddockFlags) verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags -- | This defines what a 'TargetSelector' means for the @test@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, diff --git a/cabal-install/Distribution/Client/CmdUpdate.hs b/cabal-install/Distribution/Client/CmdUpdate.hs index bef738ee973..331b08cb6b6 100644 --- a/cabal-install/Distribution/Client/CmdUpdate.hs +++ b/cabal-install/Distribution/Client/CmdUpdate.hs @@ -168,7 +168,9 @@ updateAction (configFlags, configExFlags, installFlags, haddockFlags) verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags + installFlags + mempty -- ClientInstallFlags, not needed here + haddockFlags globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) updateRepo :: Verbosity -> UpdateFlags -> RepoContext -> (Repo, IndexState) diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index 48d99d602e9..2cacbcef250 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/cabal-install/Distribution/Client/Config.hs @@ -57,6 +57,9 @@ import Distribution.Client.Setup , UploadFlags(..), uploadCommand , ReportFlags(..), reportCommand , showRepo, parseRepo, readRepo ) +import Distribution.Client.CmdInstall.ClientInstallFlags + ( ClientInstallFlags(..), defaultClientInstallFlags + , clientInstallOptions ) import Distribution.Utils.NubList ( NubList, fromNubList, toNubList, overNubList ) @@ -145,6 +148,7 @@ import GHC.Generics ( Generic ) data SavedConfig = SavedConfig { savedGlobalFlags :: GlobalFlags, savedInstallFlags :: InstallFlags, + savedClientInstallFlags :: ClientInstallFlags, savedConfigureFlags :: ConfigFlags, savedConfigureExFlags :: ConfigExFlags, savedUserInstallDirs :: InstallDirs (Flag PathTemplate), @@ -162,6 +166,7 @@ instance Semigroup SavedConfig where a <> b = SavedConfig { savedGlobalFlags = combinedSavedGlobalFlags, savedInstallFlags = combinedSavedInstallFlags, + savedClientInstallFlags = combinedSavedClientInstallFlags, savedConfigureFlags = combinedSavedConfigureFlags, savedConfigureExFlags = combinedSavedConfigureExFlags, savedUserInstallDirs = combinedSavedUserInstallDirs, @@ -278,6 +283,16 @@ instance Semigroup SavedConfig where combine = combine' savedInstallFlags lastNonEmptyNL = lastNonEmptyNL' savedInstallFlags + combinedSavedClientInstallFlags = ClientInstallFlags { + cinstInstallLibs = combine cinstInstallLibs, + cinstEnvironmentPath = combine cinstEnvironmentPath, + cinstOverwritePolicy = combine cinstOverwritePolicy, + cinstInstallMethod = combine cinstInstallMethod, + cinstCopydir = combine cinstCopydir + } + where + combine = combine' savedClientInstallFlags + combinedSavedConfigureFlags = ConfigFlags { configArgs = lastNonEmpty configArgs, configPrograms_ = configPrograms_ . savedConfigureFlags $ b, @@ -482,6 +497,9 @@ initialSavedConfig = do installBuildReports= toFlag AnonymousReports, installNumJobs = toFlag Nothing, installSymlinkBinDir = toFlag symlinkPath + }, + savedClientInstallFlags = mempty { + cinstCopydir = toFlag symlinkPath } } @@ -734,6 +752,7 @@ commentSavedConfig = do globalRemoteRepos = toNubList [defaultRemoteRepo] }, savedInstallFlags = defaultInstallFlags, + savedClientInstallFlags= defaultClientInstallFlags, savedConfigureExFlags = defaultConfigExFlags { configAllowNewer = Just (AllowNewer mempty), configAllowOlder = Just (AllowOlder mempty) @@ -856,6 +875,10 @@ configFieldDescriptions src = (installOptions ParseArgs) ["dry-run", "only", "only-dependencies", "dependencies-only"] [] + ++ toSavedConfig liftClientInstallFlag + (clientInstallOptions ParseArgs) + [] [] + ++ toSavedConfig liftUploadFlag (commandOptions uploadCommand ParseArgs) ["verbose", "check", "documentation", "publish"] [] @@ -963,6 +986,10 @@ liftInstallFlag :: FieldDescr InstallFlags -> FieldDescr SavedConfig liftInstallFlag = liftField savedInstallFlags (\flags conf -> conf { savedInstallFlags = flags }) +liftClientInstallFlag :: FieldDescr ClientInstallFlags -> FieldDescr SavedConfig +liftClientInstallFlag = liftField + savedClientInstallFlags (\flags conf -> conf { savedClientInstallFlags = flags }) + liftUploadFlag :: FieldDescr UploadFlags -> FieldDescr SavedConfig liftUploadFlag = liftField savedUploadFlags (\flags conf -> conf { savedUploadFlags = flags }) diff --git a/cabal-install/Distribution/Client/InstallSymlink.hs b/cabal-install/Distribution/Client/InstallSymlink.hs index 42e1fb9396a..c97f445d276 100644 --- a/cabal-install/Distribution/Client/InstallSymlink.hs +++ b/cabal-install/Distribution/Client/InstallSymlink.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Client.InstallSymlink @@ -19,6 +20,7 @@ module Distribution.Client.InstallSymlink ( #ifdef mingw32_HOST_OS +import Distribution.Compat.Binary ( Binary ) import Distribution.Package (PackageIdentifier) import Distribution.Types.UnqualComponentName import Distribution.Client.InstallPlan (InstallPlan) @@ -27,9 +29,12 @@ import Distribution.Client.Setup (InstallFlags) import Distribution.Simple.Setup (ConfigFlags) import Distribution.Simple.Compiler import Distribution.System +import GHC.Generics (Generic) data OverwritePolicy = NeverOverwrite | AlwaysOverwrite - deriving (Show, Eq) + deriving (Show, Eq, Generic, Bounded, Enum) + +instance Binary OverwritePolicy symlinkBinaries :: Platform -> Compiler -> OverwritePolicy @@ -47,6 +52,9 @@ symlinkBinary _ _ _ _ _ = fail "Symlinking feature not available on Windows" #else +import Distribution.Compat.Binary + ( Binary ) + import Distribution.Client.Types ( ConfiguredPackage(..), BuildOutcomes ) import Distribution.Client.Setup @@ -93,9 +101,13 @@ import Control.Exception ( assert ) import Data.Maybe ( catMaybes ) +import GHC.Generics + ( Generic ) data OverwritePolicy = NeverOverwrite | AlwaysOverwrite - deriving (Show, Eq) + deriving (Show, Eq, Generic, Bounded, Enum) + +instance Binary OverwritePolicy -- | We would like by default to install binaries into some location that is on -- the user's PATH. For per-user installations on Unix systems that basically diff --git a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs index 4c8e27e4d8e..19386395c84 100644 --- a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs @@ -31,6 +31,10 @@ import Distribution.Client.Types import Distribution.Client.Config ( SavedConfig(..), remoteRepoFields ) +import Distribution.Client.CmdInstall.ClientInstallFlags + ( ClientInstallFlags(..), defaultClientInstallFlags + , clientInstallOptions ) + import Distribution.Solver.Types.ConstraintSource import Distribution.Package @@ -131,7 +135,8 @@ data LegacySharedConfig = LegacySharedConfig { legacyGlobalFlags :: GlobalFlags, legacyConfigureShFlags :: ConfigFlags, legacyConfigureExFlags :: ConfigExFlags, - legacyInstallFlags :: InstallFlags + legacyInstallFlags :: InstallFlags, + legacyClientInstallFlags:: ClientInstallFlags } deriving Generic instance Monoid LegacySharedConfig where @@ -155,14 +160,17 @@ instance Semigroup LegacySharedConfig where -- commandLineFlagsToProjectConfig :: GlobalFlags -> ConfigFlags -> ConfigExFlags - -> InstallFlags -> HaddockFlags + -> InstallFlags -> ClientInstallFlags + -> HaddockFlags -> ProjectConfig commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags haddockFlags = + installFlags clientInstallFlags + haddockFlags = mempty { projectConfigBuildOnly = convertLegacyBuildOnlyFlags globalFlags configFlags - installFlags haddockFlags, + installFlags clientInstallFlags + haddockFlags, projectConfigShared = convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags, @@ -209,6 +217,7 @@ convertLegacyGlobalConfig SavedConfig { savedGlobalFlags = globalFlags, savedInstallFlags = installFlags, + savedClientInstallFlags= clientInstallFlags, savedConfigureFlags = configFlags, savedConfigureExFlags = configExFlags, savedUserInstallDirs = _, @@ -227,6 +236,7 @@ convertLegacyGlobalConfig -- defaults in the various resolve functions in terms of the new types. configExFlags' = defaultConfigExFlags <> configExFlags installFlags' = defaultInstallFlags <> installFlags + clientInstallFlags' = defaultClientInstallFlags <> clientInstallFlags haddockFlags' = defaultHaddockFlags <> haddockFlags configAllPackages = convertLegacyPerPackageFlags @@ -236,7 +246,8 @@ convertLegacyGlobalConfig configExFlags' installFlags' configBuildOnly = convertLegacyBuildOnlyFlags globalFlags configFlags - installFlags' haddockFlags' + installFlags' clientInstallFlags' + haddockFlags' -- | Convert the project config from the legacy types to the 'ProjectConfig' @@ -251,7 +262,8 @@ convertLegacyProjectConfig legacyPackagesRepo, legacyPackagesNamed, legacySharedConfig = LegacySharedConfig globalFlags configShFlags - configExFlags installSharedFlags, + configExFlags installSharedFlags + clientInstallFlags, legacyAllConfig, legacyLocalConfig = LegacyPackageConfig configFlags installPerPkgFlags haddockFlags, @@ -281,7 +293,8 @@ convertLegacyProjectConfig configExFlags installSharedFlags configBuildOnly = convertLegacyBuildOnlyFlags globalFlags configShFlags - installSharedFlags haddockFlags + installSharedFlags clientInstallFlags + haddockFlags perPackage (LegacyPackageConfig perPkgConfigFlags perPkgInstallFlags perPkgHaddockFlags) = @@ -425,12 +438,15 @@ convertLegacyPerPackageFlags configFlags installFlags haddockFlags = -- 'ProjectConfigBuildOnly' subset of the 'ProjectConfig'. -- convertLegacyBuildOnlyFlags :: GlobalFlags -> ConfigFlags - -> InstallFlags -> HaddockFlags + -> InstallFlags -> ClientInstallFlags + -> HaddockFlags -> ProjectConfigBuildOnly convertLegacyBuildOnlyFlags globalFlags configFlags - installFlags haddockFlags = + installFlags clientInstallFlags + haddockFlags = ProjectConfigBuildOnly{..} where + projectConfigClientInstallFlags = clientInstallFlags GlobalFlags { globalCacheDir = projectConfigCacheDir, globalLogsDir = projectConfigLogsDir, @@ -504,7 +520,8 @@ convertToLegacySharedConfig legacyGlobalFlags = globalFlags, legacyConfigureShFlags = configFlags, legacyConfigureExFlags = configExFlags, - legacyInstallFlags = installFlags + legacyInstallFlags = installFlags, + legacyClientInstallFlags = projectConfigClientInstallFlags } where globalFlags = GlobalFlags { @@ -923,6 +940,12 @@ legacySharedConfigFieldDescrs = ] . commandOptionsToFields ) (installOptions ParseArgs) + ++ + ( liftFields + legacyClientInstallFlags + (\flags conf -> conf { legacyClientInstallFlags = flags }) + . commandOptionsToFields + ) (clientInstallOptions ParseArgs) where constraintSrc = ConstraintSourceProjectConfig "TODO" diff --git a/cabal-install/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/Distribution/Client/ProjectConfig/Types.hs index ab6f6861139..0bad51ab85a 100644 --- a/cabal-install/Distribution/Client/ProjectConfig/Types.hs +++ b/cabal-install/Distribution/Client/ProjectConfig/Types.hs @@ -33,6 +33,9 @@ import Distribution.Client.BuildReports.Types import Distribution.Client.IndexUtils.Timestamp ( IndexState ) +import Distribution.Client.CmdInstall.ClientInstallFlags + ( ClientInstallFlags(..) ) + import Distribution.Solver.Types.Settings import Distribution.Solver.Types.ConstraintSource @@ -148,7 +151,8 @@ data ProjectConfigBuildOnly projectConfigHttpTransport :: Flag String, projectConfigIgnoreExpiry :: Flag Bool, projectConfigCacheDir :: Flag FilePath, - projectConfigLogsDir :: Flag FilePath + projectConfigLogsDir :: Flag FilePath, + projectConfigClientInstallFlags :: ClientInstallFlags } deriving (Eq, Show, Generic) diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 4b458ad1202..f67412ac06f 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -62,7 +62,9 @@ module Distribution.Client.ProjectPlanning ( -- * Path construction binDirectoryFor, - binDirectories + binDirectories, + storePackageInstallDirs, + storePackageInstallDirs' ) where import Prelude () @@ -3168,13 +3170,20 @@ storePackageInstallDirs :: StoreDirLayout -> CompilerId -> InstalledPackageId -> InstallDirs.InstallDirs FilePath -storePackageInstallDirs StoreDirLayout{ storePackageDirectory - , storeDirectory } - compid ipkgid = +storePackageInstallDirs storeDirLayout compid ipkgid = + storePackageInstallDirs' storeDirLayout compid $ newSimpleUnitId ipkgid + +storePackageInstallDirs' :: StoreDirLayout + -> CompilerId + -> UnitId + -> InstallDirs.InstallDirs FilePath +storePackageInstallDirs' StoreDirLayout{ storePackageDirectory + , storeDirectory } + compid unitid = InstallDirs.InstallDirs {..} where store = storeDirectory compid - prefix = storePackageDirectory compid (newSimpleUnitId ipkgid) + prefix = storePackageDirectory compid unitid bindir = prefix "bin" libdir = prefix "lib" libsubdir = "" diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 8b765d9de0a..383854678b2 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -161,6 +161,7 @@ executable cabal Distribution.Client.CmdFreeze Distribution.Client.CmdHaddock Distribution.Client.CmdInstall + Distribution.Client.CmdInstall.ClientInstallFlags Distribution.Client.CmdRepl Distribution.Client.CmdRun Distribution.Client.CmdTest diff --git a/cabal-install/cabal-install.cabal.pp b/cabal-install/cabal-install.cabal.pp index 9b83290ab42..f01efb46fc6 100644 --- a/cabal-install/cabal-install.cabal.pp +++ b/cabal-install/cabal-install.cabal.pp @@ -87,6 +87,7 @@ Distribution.Client.CmdFreeze Distribution.Client.CmdHaddock Distribution.Client.CmdInstall + Distribution.Client.CmdInstall.ClientInstallFlags Distribution.Client.CmdRepl Distribution.Client.CmdRun Distribution.Client.CmdTest diff --git a/cabal-install/changelog b/cabal-install/changelog index 77ddbc7d413..b02df687671 100644 --- a/cabal-install/changelog +++ b/cabal-install/changelog @@ -9,6 +9,10 @@ * Fix Shebang detection heuristics and properly support passing through program arguments to Shebang cabal scripts (#5600) * Fix misplaced creation of `dist/` folders in CWD (#3699) + * Make v2-install/new-install-specific flags configurable in + ~/.cabal/config + * Add --copy-bindir and --bindir-method=copy flags to v2-install + that copy the executable instead of symlinking it 2.4.1.0 Mikhail Glushenkov November 2018 * Add message to alert user to potential package casing errors. (#5635) diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs index 329b3499aa5..c8d4b9a3795 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs @@ -26,6 +26,8 @@ import Distribution.Simple.Program.Types import Distribution.Simple.Program.Db import Distribution.Client.Types +import Distribution.Client.CmdInstall.ClientInstallFlags +import Distribution.Client.InstallSymlink import Distribution.Client.Dependency.Types import Distribution.Client.BuildReports.Types import Distribution.Client.Targets @@ -342,6 +344,21 @@ arbitraryGlobLikeStr = outerTerm braces s = "{" ++ s ++ "}" +instance Arbitrary OverwritePolicy where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary InstallMethod where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary ClientInstallFlags where + arbitrary = + ClientInstallFlags + <$> arbitrary + <*> arbitraryFlag arbitraryShortToken + <*> arbitrary + <*> arbitrary + <*> arbitraryFlag arbitraryShortToken + instance Arbitrary ProjectConfigBuildOnly where arbitrary = ProjectConfigBuildOnly @@ -362,6 +379,7 @@ instance Arbitrary ProjectConfigBuildOnly where <*> arbitrary <*> (fmap getShortToken <$> arbitrary) <*> (fmap getShortToken <$> arbitrary) + <*> arbitrary where arbitraryNumJobs = fmap (fmap getPositive) <$> arbitrary @@ -381,7 +399,8 @@ instance Arbitrary ProjectConfigBuildOnly where , projectConfigHttpTransport = x13 , projectConfigIgnoreExpiry = x14 , projectConfigCacheDir = x15 - , projectConfigLogsDir = x16 } = + , projectConfigLogsDir = x16 + , projectConfigClientInstallFlags = x17 } = [ ProjectConfigBuildOnly { projectConfigVerbosity = x00' , projectConfigDryRun = x01' , projectConfigOnlyDeps = x02' @@ -398,14 +417,17 @@ instance Arbitrary ProjectConfigBuildOnly where , projectConfigHttpTransport = x13 , projectConfigIgnoreExpiry = x14' , projectConfigCacheDir = x15 - , projectConfigLogsDir = x16 } + , projectConfigLogsDir = x16 + , projectConfigClientInstallFlags = x17' } | ((x00', x01', x02', x03', x04'), (x05', x06', x07', x08', x09'), - (x10', x11', x12', x14')) + (x10', x11', x12', x14'), + ( x17' )) <- shrink ((x00, x01, x02, x03, x04), (x05, x06, x07, x08, preShrink_NumJobs x09), - (x10, x11, x12, x14)) + (x10, x11, x12, x14), + ( x17 )) ] where preShrink_NumJobs = fmap (fmap Positive)