{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Distribution.Client.CmdInstall
(
installCommand
, installAction
, selectPackageTargets
, selectComponentTarget
, establishDummyDistDirLayout
, establishDummyProjectBaseContext
) where
import Distribution.Client.Compat.Prelude
import Distribution.Compat.Directory
( doesPathExist
)
import Prelude ()
import Distribution.Client.CmdErrorMessages
import Distribution.Client.CmdSdist
import Distribution.Client.ProjectOrchestration
import Distribution.Client.TargetProblem
( TargetProblem (..)
, TargetProblem'
)
import Distribution.Client.CmdInstall.ClientInstallFlags
import Distribution.Client.CmdInstall.ClientInstallTargetSelector
import Distribution.Client.Config
( SavedConfig (..)
, defaultInstallPath
, loadConfig
)
import Distribution.Client.DistDirLayout
( CabalDirLayout (..)
, DistDirLayout (..)
, StoreDirLayout (..)
, cabalStoreDirLayout
, mkCabalDirLayout
)
import Distribution.Client.IndexUtils
( getInstalledPackages
, getSourcePackages
)
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.InstallSymlink
( Symlink (..)
, promptRun
, symlinkBinary
, symlinkableBinary
, trySymlink
)
import Distribution.Client.NixStyleOptions
( NixStyleFlags (..)
, defaultNixStyleFlags
, nixStyleOptions
)
import Distribution.Client.ProjectConfig
( ProjectPackageLocation (..)
, fetchAndReadSourcePackages
, projectConfigWithBuilderRepoContext
, resolveBuildTimeSettings
, withGlobalConfig
, withProjectOrGlobalConfig
)
import Distribution.Client.ProjectConfig.Types
( MapMappend (..)
, PackageConfig (..)
, ProjectConfig (..)
, ProjectConfigBuildOnly (..)
, ProjectConfigShared (..)
, getMapLast
, getMapMappend
, projectConfigBuildOnly
, projectConfigConfigFile
, projectConfigLogsDir
, projectConfigStoreDir
)
import Distribution.Client.ProjectFlags (ProjectFlags (..))
import Distribution.Client.ProjectPlanning
( storePackageInstallDirs'
)
import Distribution.Client.ProjectPlanning.Types
( ElaboratedInstallPlan
)
import Distribution.Client.RebuildMonad
( runRebuild
)
import Distribution.Client.Setup
( ConfigFlags (..)
, GlobalFlags (..)
, InstallFlags (..)
)
import Distribution.Client.Types
( PackageLocation (..)
, PackageSpecifier (..)
, SourcePackageDb (..)
, UnresolvedSourcePackage
, mkNamedPackage
, pkgSpecifierTarget
)
import Distribution.Client.Types.OverwritePolicy
( OverwritePolicy (..)
)
import Distribution.Package
( Package (..)
, PackageName
, mkPackageName
, unPackageName
)
import Distribution.Simple.BuildPaths
( exeExtension
)
import Distribution.Simple.Command
( CommandUI (..)
, optionName
, usageAlternatives
)
import Distribution.Simple.Compiler
( Compiler (..)
, CompilerFlavor (..)
, CompilerId (..)
, PackageDB (..)
, PackageDBStack
)
import Distribution.Simple.Configure
( configCompilerEx
)
import Distribution.Simple.Flag
( flagElim
, flagToMaybe
, fromFlagOrDefault
)
import Distribution.Simple.GHC
( GhcEnvironmentFileEntry (..)
, GhcImplInfo (..)
, ParseErrorExc
, getGhcAppDir
, getImplInfo
, ghcPlatformAndVersionString
, readGhcEnvironmentFile
, renderGhcEnvironmentFile
)
import qualified Distribution.Simple.InstallDirs as InstallDirs
import qualified Distribution.Simple.PackageIndex as PI
import Distribution.Simple.Program.Db
( defaultProgramDb
, prependProgramSearchPath
, userSpecifyArgss
, userSpecifyPaths
)
import Distribution.Simple.Setup
( Flag (..)
, installDirsOptions
)
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose
, dieWithException
, notice
, ordNub
, safeHead
, warn
, withTempDirectory
, wrapText
)
import Distribution.Solver.Types.PackageConstraint
( PackageProperty (..)
)
import Distribution.Solver.Types.PackageIndex
( lookupPackageName
, searchByName
)
import Distribution.Solver.Types.SourcePackage
( SourcePackage (..)
)
import Distribution.System
( OS (Windows)
, Platform
, buildOS
)
import Distribution.Types.InstalledPackageInfo
( InstalledPackageInfo (..)
)
import Distribution.Types.PackageId
( PackageIdentifier (..)
)
import Distribution.Types.UnitId
( UnitId
)
import Distribution.Types.UnqualComponentName
( UnqualComponentName
, unUnqualComponentName
)
import Distribution.Types.Version
( Version
, nullVersion
)
import Distribution.Types.VersionRange
( thisVersion
)
import Distribution.Utils.Generic
( writeFileAtomic
)
import Distribution.Verbosity
( lessVerbose
, normal
)
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import Data.Ord
( Down (..)
)
import qualified Data.Set as S
import Distribution.Client.Errors
import Distribution.Utils.NubList
( fromNubList
)
import Network.URI (URI)
import System.Directory
( copyFile
, createDirectoryIfMissing
, doesDirectoryExist
, doesFileExist
, getTemporaryDirectory
, makeAbsolute
, removeDirectory
, removeFile
)
import System.FilePath
( takeBaseName
, takeDirectory
, (<.>)
, (</>)
)
data InstallCheck
=
InstallCheckOnly
|
InstallCheckInstall
type InstallAction =
Verbosity
-> OverwritePolicy
-> InstallExe
-> (UnitId, [(ComponentTarget, NonEmpty TargetSelector)])
-> IO ()
data InstallCfg = InstallCfg
{ InstallCfg -> Verbosity
verbosity :: Verbosity
, InstallCfg -> ProjectBaseContext
baseCtx :: ProjectBaseContext
, InstallCfg -> ProjectBuildContext
buildCtx :: ProjectBuildContext
, InstallCfg -> Platform
platform :: Platform
, InstallCfg -> Compiler
compiler :: Compiler
, InstallCfg -> ConfigFlags
installConfigFlags :: ConfigFlags
, InstallCfg -> ClientInstallFlags
installClientFlags :: ClientInstallFlags
}
data InstallExe = InstallExe
{ InstallExe -> InstallMethod
installMethod :: InstallMethod
, InstallExe -> FilePath
installDir :: FilePath
, InstallExe -> UnitId -> FilePath
mkSourceBinDir :: UnitId -> FilePath
, InstallExe -> UnqualComponentName -> FilePath
mkExeName :: UnqualComponentName -> FilePath
, InstallExe -> UnqualComponentName -> FilePath
mkFinalExeName :: UnqualComponentName -> FilePath
}
installCommand :: CommandUI (NixStyleFlags ClientInstallFlags)
installCommand :: CommandUI (NixStyleFlags ClientInstallFlags)
installCommand =
CommandUI
{ commandName :: FilePath
commandName = FilePath
"v2-install"
, commandSynopsis :: FilePath
commandSynopsis = FilePath
"Install packages."
, commandUsage :: FilePath -> FilePath
commandUsage =
FilePath -> [FilePath] -> FilePath -> FilePath
usageAlternatives
FilePath
"v2-install"
[FilePath
"[TARGETS] [FLAGS]"]
, commandDescription :: Maybe (FilePath -> FilePath)
commandDescription = (FilePath -> FilePath) -> Maybe (FilePath -> FilePath)
forall a. a -> Maybe a
Just ((FilePath -> FilePath) -> Maybe (FilePath -> FilePath))
-> (FilePath -> FilePath) -> Maybe (FilePath -> FilePath)
forall a b. (a -> b) -> a -> b
$ \FilePath
_ ->
FilePath -> FilePath
wrapText (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$
FilePath
"Installs one or more packages. This is done by installing them "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"in the store and symlinking or copying the executables in the directory "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"specified by the --installdir flag (`~/.local/bin/` by default). "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"If you want the installed executables to be available globally, "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"make sure that the PATH environment variable contains that directory. "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"If TARGET is a library and --lib (provisional) is used, "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"it will be added to the global environment. "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"When doing this, cabal will try to build a plan that includes all "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"the previously installed libraries. This is currently not implemented."
, commandNotes :: Maybe (FilePath -> FilePath)
commandNotes = (FilePath -> FilePath) -> Maybe (FilePath -> FilePath)
forall a. a -> Maybe a
Just ((FilePath -> FilePath) -> Maybe (FilePath -> FilePath))
-> (FilePath -> FilePath) -> Maybe (FilePath -> FilePath)
forall a b. (a -> b) -> a -> b
$ \FilePath
pname ->
FilePath
"Examples:\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pname
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" v2-install\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" Install the package in the current directory\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pname
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" v2-install pkgname\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" Install the package named pkgname"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" (fetching it from hackage if necessary)\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pname
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" v2-install ./pkgfoo\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" Install the package in the ./pkgfoo directory\n"
, commandOptions :: ShowOrParseArgs -> [OptionField (NixStyleFlags ClientInstallFlags)]
commandOptions = \ShowOrParseArgs
x -> (OptionField (NixStyleFlags ClientInstallFlags) -> Bool)
-> [OptionField (NixStyleFlags ClientInstallFlags)]
-> [OptionField (NixStyleFlags ClientInstallFlags)]
forall a. (a -> Bool) -> [a] -> [a]
filter OptionField (NixStyleFlags ClientInstallFlags) -> Bool
forall {a}. OptionField a -> Bool
notInstallDirOpt ([OptionField (NixStyleFlags ClientInstallFlags)]
-> [OptionField (NixStyleFlags ClientInstallFlags)])
-> [OptionField (NixStyleFlags ClientInstallFlags)]
-> [OptionField (NixStyleFlags ClientInstallFlags)]
forall a b. (a -> b) -> a -> b
$ (ShowOrParseArgs -> [OptionField ClientInstallFlags])
-> ShowOrParseArgs
-> [OptionField (NixStyleFlags ClientInstallFlags)]
forall a.
(ShowOrParseArgs -> [OptionField a])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags a)]
nixStyleOptions ShowOrParseArgs -> [OptionField ClientInstallFlags]
clientInstallOptions ShowOrParseArgs
x
, commandDefaultFlags :: NixStyleFlags ClientInstallFlags
commandDefaultFlags = ClientInstallFlags -> NixStyleFlags ClientInstallFlags
forall a. a -> NixStyleFlags a
defaultNixStyleFlags ClientInstallFlags
defaultClientInstallFlags
}
where
notInstallDirOpt :: OptionField a -> Bool
notInstallDirOpt OptionField a
x = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ OptionField a -> FilePath
forall a. OptionField a -> FilePath
optionName OptionField a
x FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
installDirOptNames
installDirOptNames :: [FilePath]
installDirOptNames = (OptionField (InstallDirs (Flag PathTemplate)) -> FilePath)
-> [OptionField (InstallDirs (Flag PathTemplate))] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map OptionField (InstallDirs (Flag PathTemplate)) -> FilePath
forall a. OptionField a -> FilePath
optionName [OptionField (InstallDirs (Flag PathTemplate))]
installDirsOptions
installAction :: NixStyleFlags ClientInstallFlags -> [String] -> GlobalFlags -> IO ()
installAction :: NixStyleFlags ClientInstallFlags
-> [FilePath] -> GlobalFlags -> IO ()
installAction flags :: NixStyleFlags ClientInstallFlags
flags@NixStyleFlags{ClientInstallFlags
extraFlags :: ClientInstallFlags
extraFlags :: forall a. NixStyleFlags a -> a
extraFlags, ConfigFlags
configFlags :: ConfigFlags
configFlags :: forall a. NixStyleFlags a -> ConfigFlags
configFlags, InstallFlags
installFlags :: InstallFlags
installFlags :: forall a. NixStyleFlags a -> InstallFlags
installFlags, ProjectFlags
projectFlags :: ProjectFlags
projectFlags :: forall a. NixStyleFlags a -> ProjectFlags
projectFlags} [FilePath]
targetStrings GlobalFlags
globalFlags = do
Verbosity -> ConfigFlags -> IO ()
verifyPreconditionsOrDie Verbosity
verbosity ConfigFlags
configFlags'
clientInstallFlags <- Verbosity
-> GlobalFlags -> ClientInstallFlags -> IO ClientInstallFlags
getClientInstallFlags Verbosity
verbosity GlobalFlags
globalFlags ClientInstallFlags
extraFlags
let
installLibs = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (ClientInstallFlags -> Flag Bool
cinstInstallLibs ClientInstallFlags
clientInstallFlags)
normalisedTargetStrings = if [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
targetStrings then [FilePath
"."] else [FilePath]
targetStrings
(pkgSpecs, uris, targetSelectors, config) <-
let
with = do
(pkgSpecs, targetSelectors, baseConfig) <-
Verbosity
-> ProjectConfig
-> [FilePath]
-> Bool
-> IO
([PackageSpecifier UnresolvedSourcePackage], [TargetSelector],
ProjectConfig)
withProject Verbosity
verbosity ProjectConfig
cliConfig [FilePath]
normalisedTargetStrings Bool
installLibs
return (pkgSpecs, [], targetSelectors, baseConfig)
without =
Verbosity
-> Flag FilePath
-> (ProjectConfig
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig))
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
forall a.
Verbosity -> Flag FilePath -> (ProjectConfig -> IO a) -> IO a
withGlobalConfig Verbosity
verbosity Flag FilePath
globalConfigFlag ((ProjectConfig
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig))
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig))
-> (ProjectConfig
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig))
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
forall a b. (a -> b) -> a -> b
$ \ProjectConfig
globalConfig ->
Verbosity
-> ProjectConfig
-> [FilePath]
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
withoutProject Verbosity
verbosity (ProjectConfig
globalConfig ProjectConfig -> ProjectConfig -> ProjectConfig
forall a. Semigroup a => a -> a -> a
<> ProjectConfig
cliConfig) [FilePath]
normalisedTargetStrings
in
if null targetStrings
then with
else withProjectOrGlobalConfig ignoreProject with without
let
ProjectConfig
{ projectConfigBuildOnly =
ProjectConfigBuildOnly
{ projectConfigLogsDir
}
, projectConfigShared =
ProjectConfigShared
{ projectConfigHcFlavor
, projectConfigHcPath
, projectConfigHcPkg
, projectConfigStoreDir
, projectConfigProgPathExtra
, projectConfigPackageDBs
}
, projectConfigLocalPackages =
PackageConfig
{ packageConfigProgramPaths
, packageConfigProgramArgs
, packageConfigProgramPathExtra
}
} = config
hcFlavor = Flag CompilerFlavor -> Maybe CompilerFlavor
forall a. Flag a -> Maybe a
flagToMaybe Flag CompilerFlavor
projectConfigHcFlavor
hcPath = Flag FilePath -> Maybe FilePath
forall a. Flag a -> Maybe a
flagToMaybe Flag FilePath
projectConfigHcPath
hcPkg = Flag FilePath -> Maybe FilePath
forall a. Flag a -> Maybe a
flagToMaybe Flag FilePath
projectConfigHcPkg
configProgDb <- prependProgramSearchPath verbosity ((fromNubList packageConfigProgramPathExtra) ++ (fromNubList projectConfigProgPathExtra)) defaultProgramDb
let
preProgDb =
[(FilePath, FilePath)] -> ProgramDb -> ProgramDb
userSpecifyPaths (Map FilePath FilePath -> [(FilePath, FilePath)]
forall k a. Map k a -> [(k, a)]
Map.toList (MapLast FilePath FilePath -> Map FilePath FilePath
forall k v. MapLast k v -> Map k v
getMapLast MapLast FilePath FilePath
packageConfigProgramPaths))
(ProgramDb -> ProgramDb)
-> (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FilePath, [FilePath])] -> ProgramDb -> ProgramDb
userSpecifyArgss (Map FilePath [FilePath] -> [(FilePath, [FilePath])]
forall k a. Map k a -> [(k, a)]
Map.toList (MapMappend FilePath [FilePath] -> Map FilePath [FilePath]
forall k v. MapMappend k v -> Map k v
getMapMappend MapMappend FilePath [FilePath]
packageConfigProgramArgs))
(ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
forall a b. (a -> b) -> a -> b
$ ProgramDb
configProgDb
(compiler@Compiler{compilerId = CompilerId compilerFlavor compilerVersion}, platform, progDb) <-
configCompilerEx hcFlavor hcPath hcPkg preProgDb verbosity
let
GhcImplInfo{supportsPkgEnvFiles} = getImplInfo compiler
(usedPackageEnvFlag, envFile) <- getEnvFile clientInstallFlags platform compilerVersion
(usedExistingPkgEnvFile, existingEnvEntries) <-
getExistingEnvEntries verbosity compilerFlavor supportsPkgEnvFiles envFile
packageDbs <- getPackageDbStack compiler projectConfigStoreDir projectConfigLogsDir projectConfigPackageDBs
installedIndex <- getInstalledPackages verbosity compiler packageDbs progDb
let
(envSpecs, nonGlobalEnvEntries) =
getEnvSpecsAndNonGlobalEntries installedIndex existingEnvEntries installLibs
globalTmp <- getTemporaryDirectory
withTempDirectory verbosity globalTmp "cabal-install." $ \FilePath
tmpDir -> do
distDirLayout <- Verbosity -> ProjectConfig -> FilePath -> IO DistDirLayout
establishDummyDistDirLayout Verbosity
verbosity ProjectConfig
config FilePath
tmpDir
uriSpecs <-
runRebuild tmpDir $
fetchAndReadSourcePackages
verbosity
distDirLayout
(projectConfigShared config)
(projectConfigBuildOnly config)
[ProjectPackageRemoteTarball uri | uri <- uris]
let getPackageName :: PackageSpecifier UnresolvedSourcePackage -> PackageName
getPackageName = PackageSpecifier UnresolvedSourcePackage -> PackageName
forall pkg. Package pkg => PackageSpecifier pkg -> PackageName
pkgSpecifierTarget
targetNames = [PackageName] -> Set PackageName
forall a. Ord a => [a] -> Set a
S.fromList ([PackageName] -> Set PackageName)
-> [PackageName] -> Set PackageName
forall a b. (a -> b) -> a -> b
$ (PackageSpecifier UnresolvedSourcePackage -> PackageName)
-> [PackageSpecifier UnresolvedSourcePackage] -> [PackageName]
forall a b. (a -> b) -> [a] -> [b]
map PackageSpecifier UnresolvedSourcePackage -> PackageName
getPackageName ([PackageSpecifier UnresolvedSourcePackage]
pkgSpecs [PackageSpecifier UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
forall a. [a] -> [a] -> [a]
++ [PackageSpecifier UnresolvedSourcePackage]
uriSpecs)
envNames = [PackageName] -> Set PackageName
forall a. Ord a => [a] -> Set a
S.fromList ([PackageName] -> Set PackageName)
-> [PackageName] -> Set PackageName
forall a b. (a -> b) -> a -> b
$ (PackageSpecifier UnresolvedSourcePackage -> PackageName)
-> [PackageSpecifier UnresolvedSourcePackage] -> [PackageName]
forall a b. (a -> b) -> [a] -> [b]
map PackageSpecifier UnresolvedSourcePackage -> PackageName
getPackageName [PackageSpecifier UnresolvedSourcePackage]
forall {a}. [PackageSpecifier a]
envSpecs
forceInstall = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (Flag Bool -> Bool) -> Flag Bool -> Bool
forall a b. (a -> b) -> a -> b
$ InstallFlags -> Flag Bool
installOverrideReinstall InstallFlags
installFlags
nameIntersection = Set PackageName -> Set PackageName -> Set PackageName
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set PackageName
targetNames Set PackageName
envNames
(envSpecs', nonGlobalEnvEntries') <-
if null nameIntersection
then pure (envSpecs, map snd nonGlobalEnvEntries)
else
if forceInstall
then
let es = (PackageSpecifier UnresolvedSourcePackage -> Bool)
-> [PackageSpecifier UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PackageSpecifier UnresolvedSourcePackage
e -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ PackageSpecifier UnresolvedSourcePackage -> PackageName
getPackageName PackageSpecifier UnresolvedSourcePackage
e PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set PackageName
nameIntersection) [PackageSpecifier UnresolvedSourcePackage]
forall {a}. [PackageSpecifier a]
envSpecs
nge = ((PackageName, GhcEnvironmentFileEntry) -> GhcEnvironmentFileEntry)
-> [(PackageName, GhcEnvironmentFileEntry)]
-> [GhcEnvironmentFileEntry]
forall a b. (a -> b) -> [a] -> [b]
map (PackageName, GhcEnvironmentFileEntry) -> GhcEnvironmentFileEntry
forall a b. (a, b) -> b
snd ([(PackageName, GhcEnvironmentFileEntry)]
-> [GhcEnvironmentFileEntry])
-> ([(PackageName, GhcEnvironmentFileEntry)]
-> [(PackageName, GhcEnvironmentFileEntry)])
-> [(PackageName, GhcEnvironmentFileEntry)]
-> [GhcEnvironmentFileEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PackageName, GhcEnvironmentFileEntry) -> Bool)
-> [(PackageName, GhcEnvironmentFileEntry)]
-> [(PackageName, GhcEnvironmentFileEntry)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(PackageName, GhcEnvironmentFileEntry)
e -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (PackageName, GhcEnvironmentFileEntry) -> PackageName
forall a b. (a, b) -> a
fst (PackageName, GhcEnvironmentFileEntry)
e PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set PackageName
nameIntersection) ([(PackageName, GhcEnvironmentFileEntry)]
-> [GhcEnvironmentFileEntry])
-> [(PackageName, GhcEnvironmentFileEntry)]
-> [GhcEnvironmentFileEntry]
forall a b. (a -> b) -> a -> b
$ [(PackageName, GhcEnvironmentFileEntry)]
nonGlobalEnvEntries
in pure (es, nge)
else dieWithException verbosity $ PackagesAlreadyExistInEnvfile envFile (map prettyShow $ S.toList nameIntersection)
let installedPacks = InstalledPackageIndex -> [(PackageName, [InstalledPackageInfo])]
forall a. PackageIndex a -> [(PackageName, [a])]
PI.allPackagesByName InstalledPackageIndex
installedIndex
newEnvNames = [PackageName] -> Set PackageName
forall a. Ord a => [a] -> Set a
S.fromList ([PackageName] -> Set PackageName)
-> [PackageName] -> Set PackageName
forall a b. (a -> b) -> a -> b
$ (PackageSpecifier UnresolvedSourcePackage -> PackageName)
-> [PackageSpecifier UnresolvedSourcePackage] -> [PackageName]
forall a b. (a -> b) -> [a] -> [b]
map PackageSpecifier UnresolvedSourcePackage -> PackageName
getPackageName [PackageSpecifier UnresolvedSourcePackage]
envSpecs'
installedIndex' = [InstalledPackageInfo] -> InstalledPackageIndex
PI.fromList ([InstalledPackageInfo] -> InstalledPackageIndex)
-> ([(PackageName, [InstalledPackageInfo])]
-> [InstalledPackageInfo])
-> [(PackageName, [InstalledPackageInfo])]
-> InstalledPackageIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PackageName, [InstalledPackageInfo]) -> [InstalledPackageInfo])
-> [(PackageName, [InstalledPackageInfo])]
-> [InstalledPackageInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PackageName, [InstalledPackageInfo]) -> [InstalledPackageInfo]
forall a b. (a, b) -> b
snd ([(PackageName, [InstalledPackageInfo])] -> [InstalledPackageInfo])
-> ([(PackageName, [InstalledPackageInfo])]
-> [(PackageName, [InstalledPackageInfo])])
-> [(PackageName, [InstalledPackageInfo])]
-> [InstalledPackageInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PackageName, [InstalledPackageInfo]) -> Bool)
-> [(PackageName, [InstalledPackageInfo])]
-> [(PackageName, [InstalledPackageInfo])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(PackageName, [InstalledPackageInfo])
p -> (PackageName, [InstalledPackageInfo]) -> PackageName
forall a b. (a, b) -> a
fst (PackageName, [InstalledPackageInfo])
p PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set PackageName
newEnvNames) ([(PackageName, [InstalledPackageInfo])] -> InstalledPackageIndex)
-> [(PackageName, [InstalledPackageInfo])] -> InstalledPackageIndex
forall a b. (a -> b) -> a -> b
$ [(PackageName, [InstalledPackageInfo])]
installedPacks
baseCtx <-
establishDummyProjectBaseContext
verbosity
config
distDirLayout
(envSpecs' ++ pkgSpecs ++ uriSpecs)
InstallCommand
buildCtx <- constructProjectBuildContext verbosity (baseCtx{installedPackages = Just installedIndex'}) targetSelectors
printPlan verbosity baseCtx buildCtx
let installCfg = Verbosity
-> ProjectBaseContext
-> ProjectBuildContext
-> Platform
-> Compiler
-> ConfigFlags
-> ClientInstallFlags
-> InstallCfg
InstallCfg Verbosity
verbosity ProjectBaseContext
baseCtx ProjectBuildContext
buildCtx Platform
platform Compiler
compiler ConfigFlags
configFlags ClientInstallFlags
clientInstallFlags
let
dryRun =
BuildTimeSettings -> Bool
buildSettingDryRun (ProjectBaseContext -> BuildTimeSettings
buildSettings ProjectBaseContext
baseCtx)
Bool -> Bool -> Bool
|| BuildTimeSettings -> Bool
buildSettingOnlyDownload (ProjectBaseContext -> BuildTimeSettings
buildSettings ProjectBaseContext
baseCtx)
unless
(dryRun || installLibs)
(traverseInstall (installCheckUnitExes InstallCheckOnly) installCfg)
buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx
runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes
unless dryRun $
if installLibs
then
installLibraries
verbosity
buildCtx
installedIndex
compiler
packageDbs
envFile
nonGlobalEnvEntries'
(not usedExistingPkgEnvFile && not usedPackageEnvFlag)
else
traverseInstall (installCheckUnitExes InstallCheckInstall) installCfg
where
configFlags' :: ConfigFlags
configFlags' = ConfigFlags -> ConfigFlags
disableTestsBenchsByDefault (ConfigFlags -> ConfigFlags)
-> (ConfigFlags -> ConfigFlags) -> ConfigFlags -> ConfigFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigFlags -> ConfigFlags
ignoreProgramAffixes (ConfigFlags -> ConfigFlags) -> ConfigFlags -> ConfigFlags
forall a b. (a -> b) -> a -> b
$ ConfigFlags
configFlags
verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
configFlags')
ignoreProject :: Flag Bool
ignoreProject = ProjectFlags -> Flag Bool
flagIgnoreProject ProjectFlags
projectFlags
cliConfig :: ProjectConfig
cliConfig =
GlobalFlags
-> NixStyleFlags ClientInstallFlags
-> ClientInstallFlags
-> ProjectConfig
forall a.
GlobalFlags
-> NixStyleFlags a -> ClientInstallFlags -> ProjectConfig
commandLineFlagsToProjectConfig
GlobalFlags
globalFlags
NixStyleFlags ClientInstallFlags
flags{configFlags = configFlags'}
ClientInstallFlags
extraFlags
globalConfigFlag :: Flag FilePath
globalConfigFlag = ProjectConfigShared -> Flag FilePath
projectConfigConfigFile (ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
cliConfig)
traverseInstall :: InstallAction -> InstallCfg -> IO ()
traverseInstall :: InstallAction -> InstallCfg -> IO ()
traverseInstall InstallAction
action cfg :: InstallCfg
cfg@InstallCfg{verbosity :: InstallCfg -> Verbosity
verbosity = Verbosity
v, ProjectBuildContext
buildCtx :: InstallCfg -> ProjectBuildContext
buildCtx :: ProjectBuildContext
buildCtx, ClientInstallFlags
installClientFlags :: InstallCfg -> ClientInstallFlags
installClientFlags :: ClientInstallFlags
installClientFlags} = do
let overwritePolicy :: OverwritePolicy
overwritePolicy = OverwritePolicy -> Flag OverwritePolicy -> OverwritePolicy
forall a. a -> Flag a -> a
fromFlagOrDefault OverwritePolicy
NeverOverwrite (Flag OverwritePolicy -> OverwritePolicy)
-> Flag OverwritePolicy -> OverwritePolicy
forall a b. (a -> b) -> a -> b
$ ClientInstallFlags -> Flag OverwritePolicy
cinstOverwritePolicy ClientInstallFlags
installClientFlags
actionOnExe <- InstallAction
action Verbosity
v OverwritePolicy
overwritePolicy (InstallExe
-> (UnitId, [(ComponentTarget, NonEmpty TargetSelector)]) -> IO ())
-> IO InstallExe
-> IO
((UnitId, [(ComponentTarget, NonEmpty TargetSelector)]) -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InstallCfg -> IO InstallExe
prepareExeInstall InstallCfg
cfg
traverse_ actionOnExe . Map.toList $ targetsMap buildCtx
withProject
:: Verbosity
-> ProjectConfig
-> [String]
-> Bool
-> IO ([PackageSpecifier UnresolvedSourcePackage], [TargetSelector], ProjectConfig)
withProject :: Verbosity
-> ProjectConfig
-> [FilePath]
-> Bool
-> IO
([PackageSpecifier UnresolvedSourcePackage], [TargetSelector],
ProjectConfig)
withProject Verbosity
verbosity ProjectConfig
cliConfig [FilePath]
targetStrings Bool
installLibs = do
baseCtx <- Verbosity
-> ProjectConfig -> CurrentCommand -> IO ProjectBaseContext
establishProjectBaseContext Verbosity
reducedVerbosity ProjectConfig
cliConfig CurrentCommand
InstallCommand
(pkgSpecs, targetSelectors) <-
if null unresolvedTargetStrings
then return (parsedPkgSpecs, parsedTargets)
else do
(resolvedPkgSpecs, resolvedTargets) <-
resolveTargetSelectorsInProjectBaseContext verbosity baseCtx unresolvedTargetStrings targetFilter
return (resolvedPkgSpecs ++ parsedPkgSpecs, resolvedTargets ++ parsedTargets)
let config =
ProjectConfig -> [PackageName] -> ProjectConfig
addLocalConfigToPkgs (ProjectBaseContext -> ProjectConfig
projectConfig ProjectBaseContext
baseCtx) ([PackageName] -> ProjectConfig) -> [PackageName] -> ProjectConfig
forall a b. (a -> b) -> a -> b
$
(TargetSelector -> [PackageName])
-> [TargetSelector] -> [PackageName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([PackageSpecifier UnresolvedSourcePackage]
-> TargetSelector -> [PackageName]
targetPkgNames ([PackageSpecifier UnresolvedSourcePackage]
-> TargetSelector -> [PackageName])
-> [PackageSpecifier UnresolvedSourcePackage]
-> TargetSelector
-> [PackageName]
forall a b. (a -> b) -> a -> b
$ ProjectBaseContext -> [PackageSpecifier UnresolvedSourcePackage]
localPackages ProjectBaseContext
baseCtx) [TargetSelector]
targetSelectors
return (pkgSpecs, targetSelectors, config)
where
reducedVerbosity :: Verbosity
reducedVerbosity = Verbosity -> Verbosity
lessVerbose Verbosity
verbosity
([FilePath]
unresolvedTargetStrings, [PackageIdentifier]
parsedPackageIds) =
[Either FilePath PackageIdentifier]
-> ([FilePath], [PackageIdentifier])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either FilePath PackageIdentifier]
-> ([FilePath], [PackageIdentifier]))
-> [Either FilePath PackageIdentifier]
-> ([FilePath], [PackageIdentifier])
forall a b. (a -> b) -> a -> b
$
((FilePath -> Either FilePath PackageIdentifier)
-> [FilePath] -> [Either FilePath PackageIdentifier])
-> [FilePath]
-> (FilePath -> Either FilePath PackageIdentifier)
-> [Either FilePath PackageIdentifier]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FilePath -> Either FilePath PackageIdentifier)
-> [FilePath] -> [Either FilePath PackageIdentifier]
forall a b. (a -> b) -> [a] -> [b]
map [FilePath]
targetStrings ((FilePath -> Either FilePath PackageIdentifier)
-> [Either FilePath PackageIdentifier])
-> (FilePath -> Either FilePath PackageIdentifier)
-> [Either FilePath PackageIdentifier]
forall a b. (a -> b) -> a -> b
$ \FilePath
s ->
case FilePath -> Either FilePath PackageIdentifier
forall a. Parsec a => FilePath -> Either FilePath a
eitherParsec FilePath
s of
Right pkgId :: PackageIdentifier
pkgId@PackageIdentifier{Version
pkgVersion :: Version
pkgVersion :: PackageIdentifier -> Version
pkgVersion}
| Version
pkgVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
/= Version
nullVersion ->
PackageIdentifier -> Either FilePath PackageIdentifier
forall a. a -> Either FilePath a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageIdentifier
pkgId
Either FilePath PackageIdentifier
_ -> FilePath -> Either FilePath PackageIdentifier
forall a b. a -> Either a b
Left FilePath
s
([PackageSpecifier pkg]
parsedPkgSpecs, [TargetSelector]
parsedTargets) =
[(PackageSpecifier pkg, TargetSelector)]
-> ([PackageSpecifier pkg], [TargetSelector])
forall a b. [(a, b)] -> ([a], [b])
unzip
[ (PackageIdentifier -> PackageSpecifier pkg
forall pkg. PackageIdentifier -> PackageSpecifier pkg
mkNamedPackage PackageIdentifier
pkgId, PackageName -> Maybe ComponentKindFilter -> TargetSelector
TargetPackageNamed (PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkgId) Maybe ComponentKindFilter
targetFilter)
| PackageIdentifier
pkgId <- [PackageIdentifier]
parsedPackageIds
]
targetFilter :: Maybe ComponentKindFilter
targetFilter = if Bool
installLibs then ComponentKindFilter -> Maybe ComponentKindFilter
forall a. a -> Maybe a
Just ComponentKindFilter
LibKind else ComponentKindFilter -> Maybe ComponentKindFilter
forall a. a -> Maybe a
Just ComponentKindFilter
ExeKind
resolveTargetSelectorsInProjectBaseContext
:: Verbosity
-> ProjectBaseContext
-> [String]
-> Maybe ComponentKindFilter
-> IO ([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
resolveTargetSelectorsInProjectBaseContext :: Verbosity
-> ProjectBaseContext
-> [FilePath]
-> Maybe ComponentKindFilter
-> IO
([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
resolveTargetSelectorsInProjectBaseContext Verbosity
verbosity ProjectBaseContext
baseCtx [FilePath]
targetStrings Maybe ComponentKindFilter
targetFilter = do
let reducedVerbosity :: Verbosity
reducedVerbosity = Verbosity -> Verbosity
lessVerbose Verbosity
verbosity
sourcePkgDb <-
Verbosity
-> BuildTimeSettings
-> (RepoContext -> IO SourcePackageDb)
-> IO SourcePackageDb
forall a.
Verbosity -> BuildTimeSettings -> (RepoContext -> IO a) -> IO a
projectConfigWithBuilderRepoContext
Verbosity
reducedVerbosity
(ProjectBaseContext -> BuildTimeSettings
buildSettings ProjectBaseContext
baseCtx)
(Verbosity -> RepoContext -> IO SourcePackageDb
getSourcePackages Verbosity
verbosity)
targetSelectors <-
readTargetSelectors (localPackages baseCtx) Nothing targetStrings
>>= \case
Left [TargetSelectorProblem]
problems -> Verbosity -> [TargetSelectorProblem] -> IO [TargetSelector]
forall a. Verbosity -> [TargetSelectorProblem] -> IO a
reportTargetSelectorProblems Verbosity
verbosity [TargetSelectorProblem]
problems
Right [TargetSelector]
ts -> [TargetSelector] -> IO [TargetSelector]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [TargetSelector]
ts
getSpecsAndTargetSelectors
verbosity
reducedVerbosity
sourcePkgDb
targetSelectors
(distDirLayout baseCtx)
baseCtx
targetFilter
withoutProject
:: Verbosity
-> ProjectConfig
-> [String]
-> IO ([PackageSpecifier UnresolvedSourcePackage], [URI], [TargetSelector], ProjectConfig)
withoutProject :: Verbosity
-> ProjectConfig
-> [FilePath]
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
withoutProject Verbosity
verbosity ProjectConfig
globalConfig [FilePath]
targetStrings = do
tss <- (FilePath -> IO WithoutProjectTargetSelector)
-> [FilePath] -> IO [WithoutProjectTargetSelector]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Verbosity -> FilePath -> IO WithoutProjectTargetSelector
parseWithoutProjectTargetSelector Verbosity
verbosity) [FilePath]
targetStrings
let
ProjectConfigBuildOnly
{ projectConfigLogsDir
} = projectConfigBuildOnly globalConfig
ProjectConfigShared
{ projectConfigStoreDir
} = projectConfigShared globalConfig
mlogsDir = Flag FilePath -> Maybe FilePath
forall a. Flag a -> Maybe a
flagToMaybe Flag FilePath
projectConfigLogsDir
mstoreDir = Flag FilePath -> Maybe FilePath
forall a. Flag a -> Maybe a
flagToMaybe Flag FilePath
projectConfigStoreDir
cabalDirLayout <- mkCabalDirLayout mstoreDir mlogsDir
let buildSettings = Verbosity -> CabalDirLayout -> ProjectConfig -> BuildTimeSettings
resolveBuildTimeSettings Verbosity
verbosity CabalDirLayout
cabalDirLayout ProjectConfig
globalConfig
SourcePackageDb{packageIndex} <-
projectConfigWithBuilderRepoContext
verbosity
buildSettings
(getSourcePackages verbosity)
for_ (concatMap woPackageNames tss) $ \PackageName
name -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([UnresolvedSourcePackage] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageIndex UnresolvedSourcePackage
-> PackageName -> [UnresolvedSourcePackage]
forall pkg. Package pkg => PackageIndex pkg -> PackageName -> [pkg]
lookupPackageName PackageIndex UnresolvedSourcePackage
packageIndex PackageName
name)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let xs :: [(PackageName, [UnresolvedSourcePackage])]
xs = PackageIndex UnresolvedSourcePackage
-> FilePath -> [(PackageName, [UnresolvedSourcePackage])]
forall pkg. PackageIndex pkg -> FilePath -> [(PackageName, [pkg])]
searchByName PackageIndex UnresolvedSourcePackage
packageIndex (PackageName -> FilePath
unPackageName PackageName
name)
let emptyIf :: Bool -> [a] -> [a]
emptyIf Bool
True [a]
_ = []
emptyIf Bool
False [a]
zs = [a]
zs
str2 :: [FilePath]
str2 =
Bool -> [FilePath] -> [FilePath]
forall {a}. Bool -> [a] -> [a]
emptyIf
([(PackageName, [UnresolvedSourcePackage])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PackageName, [UnresolvedSourcePackage])]
xs)
[ FilePath
"Did you mean any of the following?\n"
, [FilePath] -> FilePath
unlines ((FilePath
"- " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> ((PackageName, [UnresolvedSourcePackage]) -> FilePath)
-> (PackageName, [UnresolvedSourcePackage])
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> FilePath
unPackageName (PackageName -> FilePath)
-> ((PackageName, [UnresolvedSourcePackage]) -> PackageName)
-> (PackageName, [UnresolvedSourcePackage])
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageName, [UnresolvedSourcePackage]) -> PackageName
forall a b. (a, b) -> a
fst ((PackageName, [UnresolvedSourcePackage]) -> FilePath)
-> [(PackageName, [UnresolvedSourcePackage])] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PackageName, [UnresolvedSourcePackage])]
xs)
]
Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO ()) -> CabalInstallException -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> CabalInstallException
WithoutProject (PackageName -> FilePath
unPackageName PackageName
name) [FilePath]
str2
let
packageSpecifiers :: [PackageSpecifier UnresolvedSourcePackage]
(uris, packageSpecifiers) = partitionEithers $ map woPackageSpecifiers tss
packageTargets = (WithoutProjectTargetSelector -> TargetSelector)
-> [WithoutProjectTargetSelector] -> [TargetSelector]
forall a b. (a -> b) -> [a] -> [b]
map WithoutProjectTargetSelector -> TargetSelector
woPackageTargets [WithoutProjectTargetSelector]
tss
let config = ProjectConfig -> [PackageName] -> ProjectConfig
addLocalConfigToPkgs ProjectConfig
globalConfig ((WithoutProjectTargetSelector -> [PackageName])
-> [WithoutProjectTargetSelector] -> [PackageName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap WithoutProjectTargetSelector -> [PackageName]
woPackageNames [WithoutProjectTargetSelector]
tss)
return (packageSpecifiers, uris, packageTargets, config)
addLocalConfigToPkgs :: ProjectConfig -> [PackageName] -> ProjectConfig
addLocalConfigToPkgs :: ProjectConfig -> [PackageName] -> ProjectConfig
addLocalConfigToPkgs ProjectConfig
config [PackageName]
pkgs =
ProjectConfig
config
{ projectConfigSpecificPackage =
projectConfigSpecificPackage config
<> MapMappend (Map.fromList targetPackageConfigs)
}
where
localConfig :: PackageConfig
localConfig = ProjectConfig -> PackageConfig
projectConfigLocalPackages ProjectConfig
config
targetPackageConfigs :: [(PackageName, PackageConfig)]
targetPackageConfigs = (PackageName -> (PackageName, PackageConfig))
-> [PackageName] -> [(PackageName, PackageConfig)]
forall a b. (a -> b) -> [a] -> [b]
map (,PackageConfig
localConfig) [PackageName]
pkgs
targetPkgNames
:: [PackageSpecifier UnresolvedSourcePackage]
-> TargetSelector
-> [PackageName]
targetPkgNames :: [PackageSpecifier UnresolvedSourcePackage]
-> TargetSelector -> [PackageName]
targetPkgNames [PackageSpecifier UnresolvedSourcePackage]
localPkgs = \case
TargetPackage TargetImplicitCwd
_ [PackageIdentifier]
pkgIds Maybe ComponentKindFilter
_ -> (PackageIdentifier -> PackageName)
-> [PackageIdentifier] -> [PackageName]
forall a b. (a -> b) -> [a] -> [b]
map PackageIdentifier -> PackageName
pkgName [PackageIdentifier]
pkgIds
TargetPackageNamed PackageName
name Maybe ComponentKindFilter
_ -> [PackageName
name]
TargetAllPackages Maybe ComponentKindFilter
_ -> (PackageSpecifier UnresolvedSourcePackage -> PackageName)
-> [PackageSpecifier UnresolvedSourcePackage] -> [PackageName]
forall a b. (a -> b) -> [a] -> [b]
map PackageSpecifier UnresolvedSourcePackage -> PackageName
forall pkg. Package pkg => PackageSpecifier pkg -> PackageName
pkgSpecifierTarget [PackageSpecifier UnresolvedSourcePackage]
localPkgs
TargetComponent PackageIdentifier
pkgId ComponentName
_ SubComponentTarget
_ -> [PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkgId]
TargetComponentUnknown PackageName
name Either UnqualComponentName ComponentName
_ SubComponentTarget
_ -> [PackageName
name]
verifyPreconditionsOrDie :: Verbosity -> ConfigFlags -> IO ()
verifyPreconditionsOrDie :: Verbosity -> ConfigFlags -> IO ()
verifyPreconditionsOrDie Verbosity
verbosity ConfigFlags
configFlags = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ConfigFlags -> Flag Bool
configTests ConfigFlags
configFlags Flag Bool -> Flag Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
True) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
ConfigTests
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ConfigFlags -> Flag Bool
configBenchmarks ConfigFlags
configFlags Flag Bool -> Flag Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
True) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
ConfigBenchmarks
getClientInstallFlags :: Verbosity -> GlobalFlags -> ClientInstallFlags -> IO ClientInstallFlags
getClientInstallFlags :: Verbosity
-> GlobalFlags -> ClientInstallFlags -> IO ClientInstallFlags
getClientInstallFlags Verbosity
verbosity GlobalFlags
globalFlags ClientInstallFlags
existingClientInstallFlags = do
let configFileFlag :: Flag FilePath
configFileFlag = GlobalFlags -> Flag FilePath
globalConfigFile GlobalFlags
globalFlags
savedConfig <- Verbosity -> Flag FilePath -> IO SavedConfig
loadConfig Verbosity
verbosity Flag FilePath
configFileFlag
pure $ savedClientInstallFlags savedConfig `mappend` existingClientInstallFlags
getSpecsAndTargetSelectors
:: Verbosity
-> Verbosity
-> SourcePackageDb
-> [TargetSelector]
-> DistDirLayout
-> ProjectBaseContext
-> Maybe ComponentKindFilter
-> IO ([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
getSpecsAndTargetSelectors :: Verbosity
-> Verbosity
-> SourcePackageDb
-> [TargetSelector]
-> DistDirLayout
-> ProjectBaseContext
-> Maybe ComponentKindFilter
-> IO
([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
getSpecsAndTargetSelectors Verbosity
verbosity Verbosity
reducedVerbosity SourcePackageDb
sourcePkgDb [TargetSelector]
targetSelectors DistDirLayout
distDirLayout ProjectBaseContext
baseCtx Maybe ComponentKindFilter
targetFilter =
Verbosity
-> ProjectBaseContext
-> (ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> IO
([PackageSpecifier UnresolvedSourcePackage], [TargetSelector]))
-> IO
([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
forall a.
Verbosity
-> ProjectBaseContext
-> (ElaboratedInstallPlan -> ElaboratedSharedConfig -> IO a)
-> IO a
withInstallPlan Verbosity
reducedVerbosity ProjectBaseContext
baseCtx ((ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> IO
([PackageSpecifier UnresolvedSourcePackage], [TargetSelector]))
-> IO
([PackageSpecifier UnresolvedSourcePackage], [TargetSelector]))
-> (ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> IO
([PackageSpecifier UnresolvedSourcePackage], [TargetSelector]))
-> IO
([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
forall a b. (a -> b) -> a -> b
$ \ElaboratedInstallPlan
elaboratedPlan ElaboratedSharedConfig
_ -> do
(targetsMap, hackageNames) <-
Verbosity
-> SourcePackageDb
-> ElaboratedInstallPlan
-> [TargetSelector]
-> IO (TargetsMap, [PackageName])
partitionToKnownTargetsAndHackagePackages
Verbosity
verbosity
SourcePackageDb
sourcePkgDb
ElaboratedInstallPlan
elaboratedPlan
[TargetSelector]
targetSelectors
let
planMap = ElaboratedInstallPlan
-> Map
UnitId
(GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage)
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg
-> Map UnitId (GenericPlanPackage ipkg srcpkg)
InstallPlan.toMap ElaboratedInstallPlan
elaboratedPlan
sdistize (SpecificSourcePackage SourcePackage (PackageLocation local)
spkg) =
SourcePackage (PackageLocation local)
-> PackageSpecifier (SourcePackage (PackageLocation local))
forall pkg. pkg -> PackageSpecifier pkg
SpecificSourcePackage SourcePackage (PackageLocation local)
forall {local}. SourcePackage (PackageLocation local)
spkg'
where
sdistPath :: FilePath
sdistPath = DistDirLayout -> PackageIdentifier -> FilePath
distSdistFile DistDirLayout
distDirLayout (SourcePackage (PackageLocation local) -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId SourcePackage (PackageLocation local)
spkg)
spkg' :: SourcePackage (PackageLocation local)
spkg' = SourcePackage (PackageLocation local)
spkg{srcpkgSource = LocalTarballPackage sdistPath}
sdistize PackageSpecifier (SourcePackage (PackageLocation local))
named = PackageSpecifier (SourcePackage (PackageLocation local))
named
localPkgs = PackageSpecifier UnresolvedSourcePackage
-> PackageSpecifier UnresolvedSourcePackage
forall {local}.
PackageSpecifier (SourcePackage (PackageLocation local))
-> PackageSpecifier (SourcePackage (PackageLocation local))
sdistize (PackageSpecifier UnresolvedSourcePackage
-> PackageSpecifier UnresolvedSourcePackage)
-> [PackageSpecifier UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectBaseContext -> [PackageSpecifier UnresolvedSourcePackage]
localPackages ProjectBaseContext
baseCtx
gatherTargets :: UnitId -> TargetSelector
gatherTargets UnitId
targetId = PackageName -> Maybe ComponentKindFilter -> TargetSelector
TargetPackageNamed PackageName
pkgName Maybe ComponentKindFilter
targetFilter
where
targetUnit :: GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
targetUnit = GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
-> UnitId
-> Map
UnitId
(GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage)
-> GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (FilePath
-> GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage
forall a. HasCallStack => FilePath -> a
error FilePath
"cannot find target unit") UnitId
targetId Map
UnitId
(GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage)
planMap
PackageIdentifier{Version
PackageName
pkgVersion :: PackageIdentifier -> Version
pkgName :: PackageIdentifier -> PackageName
pkgName :: PackageName
pkgVersion :: Version
..} = GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
-> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
targetUnit
localTargets = (UnitId -> TargetSelector) -> [UnitId] -> [TargetSelector]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> TargetSelector
gatherTargets (TargetsMap -> [UnitId]
forall k a. Map k a -> [k]
Map.keys TargetsMap
targetsMap)
hackagePkgs :: [PackageSpecifier UnresolvedSourcePackage]
hackagePkgs = [PackageName
-> [PackageProperty] -> PackageSpecifier UnresolvedSourcePackage
forall pkg.
PackageName -> [PackageProperty] -> PackageSpecifier pkg
NamedPackage PackageName
pn [] | PackageName
pn <- [PackageName]
hackageNames]
hackageTargets :: [TargetSelector]
hackageTargets = [PackageName -> Maybe ComponentKindFilter -> TargetSelector
TargetPackageNamed PackageName
pn Maybe ComponentKindFilter
targetFilter | PackageName
pn <- [PackageName]
hackageNames]
createDirectoryIfMissing True (distSdistDirectory distDirLayout)
unless (Map.null targetsMap) $ for_ (localPackages baseCtx) $ \case
SpecificSourcePackage UnresolvedSourcePackage
pkg ->
Verbosity
-> FilePath
-> OutputFormat
-> FilePath
-> UnresolvedSourcePackage
-> IO ()
packageToSdist
Verbosity
verbosity
(DistDirLayout -> FilePath
distProjectRootDirectory DistDirLayout
distDirLayout)
OutputFormat
TarGzArchive
(DistDirLayout -> PackageIdentifier -> FilePath
distSdistFile DistDirLayout
distDirLayout (UnresolvedSourcePackage -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId UnresolvedSourcePackage
pkg))
UnresolvedSourcePackage
pkg
NamedPackage PackageName
_ [PackageProperty]
_ ->
() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
if null targetsMap
then return (hackagePkgs, hackageTargets)
else return (localPkgs ++ hackagePkgs, localTargets ++ hackageTargets)
partitionToKnownTargetsAndHackagePackages
:: Verbosity
-> SourcePackageDb
-> ElaboratedInstallPlan
-> [TargetSelector]
-> IO (TargetsMap, [PackageName])
partitionToKnownTargetsAndHackagePackages :: Verbosity
-> SourcePackageDb
-> ElaboratedInstallPlan
-> [TargetSelector]
-> IO (TargetsMap, [PackageName])
partitionToKnownTargetsAndHackagePackages Verbosity
verbosity SourcePackageDb
pkgDb ElaboratedInstallPlan
elaboratedPlan [TargetSelector]
targetSelectors = do
let mTargets :: Either [TargetProblem Void] TargetsMap
mTargets =
(forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem Void) [k])
-> (forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem Void) k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [TargetProblem Void] TargetsMap
forall err.
(forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem err) [k])
-> (forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem err) k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [TargetProblem err] TargetsMap
resolveTargets
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem Void) [k]
forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem Void) [k]
selectPackageTargets
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem Void) k
forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem Void) k
selectComponentTarget
ElaboratedInstallPlan
elaboratedPlan
(SourcePackageDb -> Maybe SourcePackageDb
forall a. a -> Maybe a
Just SourcePackageDb
pkgDb)
[TargetSelector]
targetSelectors
case Either [TargetProblem Void] TargetsMap
mTargets of
Right TargetsMap
targets ->
(TargetsMap, [PackageName]) -> IO (TargetsMap, [PackageName])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TargetsMap
targets, [])
Left [TargetProblem Void]
errs -> do
let
([TargetProblem Void]
errs', [PackageName]
hackageNames) = [Either (TargetProblem Void) PackageName]
-> ([TargetProblem Void], [PackageName])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either (TargetProblem Void) PackageName]
-> ([TargetProblem Void], [PackageName]))
-> ((TargetProblem Void -> Either (TargetProblem Void) PackageName)
-> [Either (TargetProblem Void) PackageName])
-> (TargetProblem Void -> Either (TargetProblem Void) PackageName)
-> ([TargetProblem Void], [PackageName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TargetProblem Void -> Either (TargetProblem Void) PackageName)
-> [TargetProblem Void]
-> [Either (TargetProblem Void) PackageName])
-> [TargetProblem Void]
-> (TargetProblem Void -> Either (TargetProblem Void) PackageName)
-> [Either (TargetProblem Void) PackageName]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TargetProblem Void -> Either (TargetProblem Void) PackageName)
-> [TargetProblem Void]
-> [Either (TargetProblem Void) PackageName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [TargetProblem Void]
errs ((TargetProblem Void -> Either (TargetProblem Void) PackageName)
-> ([TargetProblem Void], [PackageName]))
-> (TargetProblem Void -> Either (TargetProblem Void) PackageName)
-> ([TargetProblem Void], [PackageName])
forall a b. (a -> b) -> a -> b
$ \case
TargetAvailableInIndex PackageName
name -> PackageName -> Either (TargetProblem Void) PackageName
forall a b. b -> Either a b
Right PackageName
name
TargetProblem Void
err -> TargetProblem Void -> Either (TargetProblem Void) PackageName
forall a b. a -> Either a b
Left TargetProblem Void
err
[TargetProblem Void] -> (TargetProblem Void -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [TargetProblem Void]
errs' ((TargetProblem Void -> IO ()) -> IO ())
-> (TargetProblem Void -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \case
TargetNotInProject PackageName
hn ->
case PackageIndex UnresolvedSourcePackage
-> FilePath -> [(PackageName, [UnresolvedSourcePackage])]
forall pkg. PackageIndex pkg -> FilePath -> [(PackageName, [pkg])]
searchByName (SourcePackageDb -> PackageIndex UnresolvedSourcePackage
packageIndex SourcePackageDb
pkgDb) (PackageName -> FilePath
unPackageName PackageName
hn) of
[] -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[(PackageName, [UnresolvedSourcePackage])]
xs ->
Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO ()) -> CabalInstallException -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> CabalInstallException
UnknownPackage (PackageName -> FilePath
unPackageName PackageName
hn) ((FilePath
"- " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> ((PackageName, [UnresolvedSourcePackage]) -> FilePath)
-> (PackageName, [UnresolvedSourcePackage])
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> FilePath
unPackageName (PackageName -> FilePath)
-> ((PackageName, [UnresolvedSourcePackage]) -> PackageName)
-> (PackageName, [UnresolvedSourcePackage])
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageName, [UnresolvedSourcePackage]) -> PackageName
forall a b. (a, b) -> a
fst ((PackageName, [UnresolvedSourcePackage]) -> FilePath)
-> [(PackageName, [UnresolvedSourcePackage])] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PackageName, [UnresolvedSourcePackage])]
xs)
TargetProblem Void
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool)
-> ([TargetProblem Void] -> Bool) -> [TargetProblem Void] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TargetProblem Void] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TargetProblem Void] -> Bool) -> [TargetProblem Void] -> Bool
forall a b. (a -> b) -> a -> b
$ [TargetProblem Void]
errs') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> [TargetProblem Void] -> IO ()
forall a. Verbosity -> [TargetProblem Void] -> IO a
reportBuildTargetProblems Verbosity
verbosity [TargetProblem Void]
errs'
let
targetSelectors' :: [TargetSelector]
targetSelectors' = ((TargetSelector -> Bool) -> [TargetSelector] -> [TargetSelector])
-> [TargetSelector] -> (TargetSelector -> Bool) -> [TargetSelector]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TargetSelector -> Bool) -> [TargetSelector] -> [TargetSelector]
forall a. (a -> Bool) -> [a] -> [a]
filter [TargetSelector]
targetSelectors ((TargetSelector -> Bool) -> [TargetSelector])
-> (TargetSelector -> Bool) -> [TargetSelector]
forall a b. (a -> b) -> a -> b
$ \case
TargetComponentUnknown PackageName
name Either UnqualComponentName ComponentName
_ SubComponentTarget
_
| PackageName
name PackageName -> [PackageName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackageName]
hackageNames -> Bool
False
TargetPackageNamed PackageName
name Maybe ComponentKindFilter
_
| PackageName
name PackageName -> [PackageName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackageName]
hackageNames -> Bool
False
TargetSelector
_ -> Bool
True
targets <-
([TargetProblem Void] -> IO TargetsMap)
-> (TargetsMap -> IO TargetsMap)
-> Either [TargetProblem Void] TargetsMap
-> IO TargetsMap
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> [TargetProblem Void] -> IO TargetsMap
forall a. Verbosity -> [TargetProblem Void] -> IO a
reportBuildTargetProblems Verbosity
verbosity) TargetsMap -> IO TargetsMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [TargetProblem Void] TargetsMap -> IO TargetsMap)
-> Either [TargetProblem Void] TargetsMap -> IO TargetsMap
forall a b. (a -> b) -> a -> b
$
(forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem Void) [k])
-> (forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem Void) k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [TargetProblem Void] TargetsMap
forall err.
(forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem err) [k])
-> (forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem err) k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [TargetProblem err] TargetsMap
resolveTargets
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem Void) [k]
forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem Void) [k]
selectPackageTargets
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem Void) k
forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem Void) k
selectComponentTarget
ElaboratedInstallPlan
elaboratedPlan
Maybe SourcePackageDb
forall a. Maybe a
Nothing
[TargetSelector]
targetSelectors'
return (targets, hackageNames)
constructProjectBuildContext
:: Verbosity
-> ProjectBaseContext
-> [TargetSelector]
-> IO ProjectBuildContext
constructProjectBuildContext :: Verbosity
-> ProjectBaseContext -> [TargetSelector] -> IO ProjectBuildContext
constructProjectBuildContext Verbosity
verbosity ProjectBaseContext
baseCtx [TargetSelector]
targetSelectors = do
Verbosity
-> ProjectBaseContext
-> (ElaboratedInstallPlan
-> IO (ElaboratedInstallPlan, TargetsMap))
-> IO ProjectBuildContext
runProjectPreBuildPhase Verbosity
verbosity ProjectBaseContext
baseCtx ((ElaboratedInstallPlan -> IO (ElaboratedInstallPlan, TargetsMap))
-> IO ProjectBuildContext)
-> (ElaboratedInstallPlan
-> IO (ElaboratedInstallPlan, TargetsMap))
-> IO ProjectBuildContext
forall a b. (a -> b) -> a -> b
$ \ElaboratedInstallPlan
elaboratedPlan -> do
targets <-
([TargetProblem Void] -> IO TargetsMap)
-> (TargetsMap -> IO TargetsMap)
-> Either [TargetProblem Void] TargetsMap
-> IO TargetsMap
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> [TargetProblem Void] -> IO TargetsMap
forall a. Verbosity -> [TargetProblem Void] -> IO a
reportBuildTargetProblems Verbosity
verbosity) TargetsMap -> IO TargetsMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [TargetProblem Void] TargetsMap -> IO TargetsMap)
-> Either [TargetProblem Void] TargetsMap -> IO TargetsMap
forall a b. (a -> b) -> a -> b
$
(forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem Void) [k])
-> (forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem Void) k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [TargetProblem Void] TargetsMap
forall err.
(forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem err) [k])
-> (forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem err) k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [TargetProblem err] TargetsMap
resolveTargets
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem Void) [k]
forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem Void) [k]
selectPackageTargets
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem Void) k
forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem Void) k
selectComponentTarget
ElaboratedInstallPlan
elaboratedPlan
Maybe SourcePackageDb
forall a. Maybe a
Nothing
[TargetSelector]
targetSelectors
let prunedToTargetsElaboratedPlan =
TargetAction
-> TargetsMap -> ElaboratedInstallPlan -> ElaboratedInstallPlan
pruneInstallPlanToTargets TargetAction
TargetActionBuild TargetsMap
targets ElaboratedInstallPlan
elaboratedPlan
prunedElaboratedPlan <-
if buildSettingOnlyDeps (buildSettings baseCtx)
then
either (reportCannotPruneDependencies verbosity) return $
pruneInstallPlanToDependencies
(Map.keysSet targets)
prunedToTargetsElaboratedPlan
else return prunedToTargetsElaboratedPlan
return (prunedElaboratedPlan, targets)
prepareExeInstall :: InstallCfg -> IO InstallExe
prepareExeInstall :: InstallCfg -> IO InstallExe
prepareExeInstall
InstallCfg{Verbosity
verbosity :: InstallCfg -> Verbosity
verbosity :: Verbosity
verbosity, ProjectBaseContext
baseCtx :: InstallCfg -> ProjectBaseContext
baseCtx :: ProjectBaseContext
baseCtx, ProjectBuildContext
buildCtx :: InstallCfg -> ProjectBuildContext
buildCtx :: ProjectBuildContext
buildCtx, Platform
platform :: InstallCfg -> Platform
platform :: Platform
platform, Compiler
compiler :: InstallCfg -> Compiler
compiler :: Compiler
compiler, ConfigFlags
installConfigFlags :: InstallCfg -> ConfigFlags
installConfigFlags :: ConfigFlags
installConfigFlags, ClientInstallFlags
installClientFlags :: InstallCfg -> ClientInstallFlags
installClientFlags :: ClientInstallFlags
installClientFlags} = do
installPath <- IO FilePath
defaultInstallPath
let storeDirLayout = CabalDirLayout -> StoreDirLayout
cabalStoreDirLayout (CabalDirLayout -> StoreDirLayout)
-> CabalDirLayout -> StoreDirLayout
forall a b. (a -> b) -> a -> b
$ ProjectBaseContext -> CabalDirLayout
cabalDirLayout ProjectBaseContext
baseCtx
prefix = FilePath -> Flag FilePath -> FilePath
forall a. a -> Flag a -> a
fromFlagOrDefault FilePath
"" ((PathTemplate -> FilePath) -> Flag PathTemplate -> Flag FilePath
forall a b. (a -> b) -> Flag a -> Flag b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathTemplate -> FilePath
InstallDirs.fromPathTemplate (ConfigFlags -> Flag PathTemplate
configProgPrefix ConfigFlags
installConfigFlags))
suffix = FilePath -> Flag FilePath -> FilePath
forall a. a -> Flag a -> a
fromFlagOrDefault FilePath
"" ((PathTemplate -> FilePath) -> Flag PathTemplate -> Flag FilePath
forall a b. (a -> b) -> Flag a -> Flag b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathTemplate -> FilePath
InstallDirs.fromPathTemplate (ConfigFlags -> Flag PathTemplate
configProgSuffix ConfigFlags
installConfigFlags))
mkUnitBinDir :: UnitId -> FilePath
mkUnitBinDir =
InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
InstallDirs.bindir
(InstallDirs FilePath -> FilePath)
-> (UnitId -> InstallDirs FilePath) -> UnitId -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreDirLayout -> Compiler -> UnitId -> InstallDirs FilePath
storePackageInstallDirs' StoreDirLayout
storeDirLayout Compiler
compiler
mkExeName :: UnqualComponentName -> FilePath
mkExeName UnqualComponentName
exe = UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
exe FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
platform
mkFinalExeName :: UnqualComponentName -> FilePath
mkFinalExeName UnqualComponentName
exe = FilePath
prefix FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
exe FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
suffix FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
platform
installdirUnknown =
FilePath
"installdir is not defined. Set it in your cabal config file "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"or use --installdir=<path>. Using default installdir: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
installPath
installdir <-
fromFlagOrDefault
(warn verbosity installdirUnknown >> pure installPath)
$ pure <$> cinstInstalldir installClientFlags
createDirectoryIfMissingVerbose verbosity True installdir
warnIfNoExes verbosity buildCtx
let defaultMethod :: IO InstallMethod
defaultMethod
| OS
buildOS OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
Windows = do
symlinks <- Verbosity -> IO Bool
trySymlink Verbosity
verbosity
return $ if symlinks then InstallMethodSymlink else InstallMethodCopy
| Bool
otherwise = InstallMethod -> IO InstallMethod
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InstallMethod
InstallMethodSymlink
installMethod <- flagElim defaultMethod return $ cinstInstallMethod installClientFlags
return $ InstallExe installMethod installdir mkUnitBinDir mkExeName mkFinalExeName
installLibraries
:: Verbosity
-> ProjectBuildContext
-> PI.PackageIndex InstalledPackageInfo
-> Compiler
-> PackageDBStack
-> FilePath
-> [GhcEnvironmentFileEntry]
-> Bool
-> IO ()
installLibraries :: Verbosity
-> ProjectBuildContext
-> InstalledPackageIndex
-> Compiler
-> PackageDBStack
-> FilePath
-> [GhcEnvironmentFileEntry]
-> Bool
-> IO ()
installLibraries
Verbosity
verbosity
ProjectBuildContext
buildCtx
InstalledPackageIndex
installedIndex
Compiler
compiler
PackageDBStack
packageDbs'
FilePath
envFile
[GhcEnvironmentFileEntry]
envEntries
Bool
showWarning = do
if GhcImplInfo -> Bool
supportsPkgEnvFiles (GhcImplInfo -> Bool) -> GhcImplInfo -> Bool
forall a b. (a -> b) -> a -> b
$ Compiler -> GhcImplInfo
getImplInfo Compiler
compiler
then do
let validDb :: PackageDB -> IO Bool
validDb (SpecificPackageDB FilePath
fp) = FilePath -> IO Bool
doesPathExist FilePath
fp
validDb PackageDB
_ = Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
packageDbs <- (PackageDB -> IO Bool) -> PackageDBStack -> IO PackageDBStack
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM PackageDB -> IO Bool
validDb PackageDBStack
packageDbs'
let
getLatest =
((Version, [InstalledPackageInfo]) -> [InstalledPackageInfo])
-> [(Version, [InstalledPackageInfo])] -> [InstalledPackageInfo]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (Maybe InstalledPackageInfo -> [InstalledPackageInfo]
forall a. Maybe a -> [a]
maybeToList (Maybe InstalledPackageInfo -> [InstalledPackageInfo])
-> ((Version, [InstalledPackageInfo])
-> Maybe InstalledPackageInfo)
-> (Version, [InstalledPackageInfo])
-> [InstalledPackageInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstalledPackageInfo] -> Maybe InstalledPackageInfo
forall a. [a] -> Maybe a
safeHead ([InstalledPackageInfo] -> Maybe InstalledPackageInfo)
-> ((Version, [InstalledPackageInfo]) -> [InstalledPackageInfo])
-> (Version, [InstalledPackageInfo])
-> Maybe InstalledPackageInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version, [InstalledPackageInfo]) -> [InstalledPackageInfo]
forall a b. (a, b) -> b
snd)
([(Version, [InstalledPackageInfo])] -> [InstalledPackageInfo])
-> (PackageName -> [(Version, [InstalledPackageInfo])])
-> PackageName
-> [InstalledPackageInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [(Version, [InstalledPackageInfo])]
-> [(Version, [InstalledPackageInfo])]
forall a. Int -> [a] -> [a]
take Int
1
([(Version, [InstalledPackageInfo])]
-> [(Version, [InstalledPackageInfo])])
-> (PackageName -> [(Version, [InstalledPackageInfo])])
-> PackageName
-> [(Version, [InstalledPackageInfo])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Version, [InstalledPackageInfo])
-> (Version, [InstalledPackageInfo]) -> Ordering)
-> [(Version, [InstalledPackageInfo])]
-> [(Version, [InstalledPackageInfo])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Version, [InstalledPackageInfo]) -> Down Version)
-> (Version, [InstalledPackageInfo])
-> (Version, [InstalledPackageInfo])
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Version -> Down Version
forall a. a -> Down a
Down (Version -> Down Version)
-> ((Version, [InstalledPackageInfo]) -> Version)
-> (Version, [InstalledPackageInfo])
-> Down Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version, [InstalledPackageInfo]) -> Version
forall a b. (a, b) -> a
fst))
([(Version, [InstalledPackageInfo])]
-> [(Version, [InstalledPackageInfo])])
-> (PackageName -> [(Version, [InstalledPackageInfo])])
-> PackageName
-> [(Version, [InstalledPackageInfo])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageIndex
-> PackageName -> [(Version, [InstalledPackageInfo])]
forall a. PackageIndex a -> PackageName -> [(Version, [a])]
PI.lookupPackageName InstalledPackageIndex
installedIndex
globalLatest = [[InstalledPackageInfo]] -> [InstalledPackageInfo]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (PackageName -> [InstalledPackageInfo]
getLatest (PackageName -> [InstalledPackageInfo])
-> [PackageName] -> [[InstalledPackageInfo]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PackageName]
globalPackages)
globalEntries = UnitId -> GhcEnvironmentFileEntry
GhcEnvFilePackageId (UnitId -> GhcEnvironmentFileEntry)
-> (InstalledPackageInfo -> UnitId)
-> InstalledPackageInfo
-> GhcEnvironmentFileEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> UnitId
installedUnitId (InstalledPackageInfo -> GhcEnvironmentFileEntry)
-> [InstalledPackageInfo] -> [GhcEnvironmentFileEntry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InstalledPackageInfo]
globalLatest
baseEntries =
GhcEnvironmentFileEntry
GhcEnvFileClearPackageDbStack GhcEnvironmentFileEntry
-> [GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry]
forall a. a -> [a] -> [a]
: (PackageDB -> GhcEnvironmentFileEntry)
-> PackageDBStack -> [GhcEnvironmentFileEntry]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageDB -> GhcEnvironmentFileEntry
GhcEnvFilePackageDb PackageDBStack
packageDbs
pkgEntries =
[GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry]
forall a. Ord a => [a] -> [a]
ordNub ([GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry])
-> [GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry]
forall a b. (a -> b) -> a -> b
$
[GhcEnvironmentFileEntry]
globalEntries
[GhcEnvironmentFileEntry]
-> [GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry]
forall a. [a] -> [a] -> [a]
++ [GhcEnvironmentFileEntry]
envEntries
[GhcEnvironmentFileEntry]
-> [GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry]
forall a. [a] -> [a] -> [a]
++ TargetsMap -> [GhcEnvironmentFileEntry]
entriesForLibraryComponents (ProjectBuildContext -> TargetsMap
targetsMap ProjectBuildContext
buildCtx)
contents' = [GhcEnvironmentFileEntry] -> FilePath
renderGhcEnvironmentFile ([GhcEnvironmentFileEntry]
baseEntries [GhcEnvironmentFileEntry]
-> [GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry]
forall a. [a] -> [a] -> [a]
++ [GhcEnvironmentFileEntry]
pkgEntries)
createDirectoryIfMissing True (takeDirectory envFile)
writeFileAtomic envFile (BS.pack contents')
when showWarning $
warn verbosity $
"The libraries were installed by creating a global GHC environment file at:\n"
++ envFile
++ "\n"
++ "\n"
++ "The presence of such an environment file is likely to confuse or break other "
++ "tools because it changes GHC's behaviour: it changes the default package set in "
++ "ghc and ghci from its normal value (which is \"all boot libraries\"). GHC "
++ "environment files are little-used and often not tested for.\n"
++ "\n"
++ "Furthermore, management of these environment files is still more difficult than "
++ "it could be; see e.g. https://github.com/haskell/cabal/issues/6481 .\n"
++ "\n"
++ "Double-check that creating a global GHC environment file is really what you "
++ "wanted! You can limit the effects of the environment file by creating it in a "
++ "specific directory using the --package-env flag. For example, use:\n"
++ "\n"
++ "cabal install --lib <packages...> --package-env .\n"
++ "\n"
++ "to create the file in the current directory."
else
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"The current compiler doesn't support safely installing libraries, "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"so only executables will be available. (Library installation is "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"supported on GHC 8.0+ only)"
globalPackages :: [PackageName]
globalPackages :: [PackageName]
globalPackages = FilePath -> PackageName
mkPackageName (FilePath -> PackageName) -> [FilePath] -> [PackageName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath
"base"]
warnIfNoExes :: Verbosity -> ProjectBuildContext -> IO ()
warnIfNoExes :: Verbosity -> ProjectBuildContext -> IO ()
warnIfNoExes Verbosity
verbosity ProjectBuildContext
buildCtx =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
noExes (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"\n"
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"@ WARNING: Installation might not be completed as desired! @\n"
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"The command \"cabal install [TARGETS]\" doesn't expose libraries.\n"
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"* You might have wanted to add them as dependencies to your package."
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" In this case add \""
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " (TargetSelector -> FilePath
showTargetSelector (TargetSelector -> FilePath) -> [TargetSelector] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TargetSelector]
selectors)
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"\" to the build-depends field(s) of your package's .cabal file.\n"
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"* You might have wanted to add them to a GHC environment. In this case"
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" use \"cabal install --lib "
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath
unwords (TargetSelector -> FilePath
showTargetSelector (TargetSelector -> FilePath) -> [TargetSelector] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TargetSelector]
selectors)
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"\". "
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" The \"--lib\" flag is provisional: see"
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" https://github.com/haskell/cabal/issues/6481 for more information."
where
targets :: [(ComponentTarget, NonEmpty TargetSelector)]
targets = [[(ComponentTarget, NonEmpty TargetSelector)]]
-> [(ComponentTarget, NonEmpty TargetSelector)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(ComponentTarget, NonEmpty TargetSelector)]]
-> [(ComponentTarget, NonEmpty TargetSelector)])
-> [[(ComponentTarget, NonEmpty TargetSelector)]]
-> [(ComponentTarget, NonEmpty TargetSelector)]
forall a b. (a -> b) -> a -> b
$ TargetsMap -> [[(ComponentTarget, NonEmpty TargetSelector)]]
forall k a. Map k a -> [a]
Map.elems (TargetsMap -> [[(ComponentTarget, NonEmpty TargetSelector)]])
-> TargetsMap -> [[(ComponentTarget, NonEmpty TargetSelector)]]
forall a b. (a -> b) -> a -> b
$ ProjectBuildContext -> TargetsMap
targetsMap ProjectBuildContext
buildCtx
components :: [ComponentTarget]
components = (ComponentTarget, NonEmpty TargetSelector) -> ComponentTarget
forall a b. (a, b) -> a
fst ((ComponentTarget, NonEmpty TargetSelector) -> ComponentTarget)
-> [(ComponentTarget, NonEmpty TargetSelector)]
-> [ComponentTarget]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ComponentTarget, NonEmpty TargetSelector)]
targets
selectors :: [TargetSelector]
selectors = ((ComponentTarget, NonEmpty TargetSelector) -> [TargetSelector])
-> [(ComponentTarget, NonEmpty TargetSelector)] -> [TargetSelector]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NonEmpty TargetSelector -> [TargetSelector]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty TargetSelector -> [TargetSelector])
-> ((ComponentTarget, NonEmpty TargetSelector)
-> NonEmpty TargetSelector)
-> (ComponentTarget, NonEmpty TargetSelector)
-> [TargetSelector]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ComponentTarget, NonEmpty TargetSelector)
-> NonEmpty TargetSelector
forall a b. (a, b) -> b
snd) [(ComponentTarget, NonEmpty TargetSelector)]
targets
noExes :: Bool
noExes = [UnqualComponentName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([UnqualComponentName] -> Bool) -> [UnqualComponentName] -> Bool
forall a b. (a -> b) -> a -> b
$ [Maybe UnqualComponentName] -> [UnqualComponentName]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe UnqualComponentName] -> [UnqualComponentName])
-> [Maybe UnqualComponentName] -> [UnqualComponentName]
forall a b. (a -> b) -> a -> b
$ ComponentTarget -> Maybe UnqualComponentName
exeMaybe (ComponentTarget -> Maybe UnqualComponentName)
-> [ComponentTarget] -> [Maybe UnqualComponentName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ComponentTarget]
components
exeMaybe :: ComponentTarget -> Maybe UnqualComponentName
exeMaybe (ComponentTarget (CExeName UnqualComponentName
exe) SubComponentTarget
_) = UnqualComponentName -> Maybe UnqualComponentName
forall a. a -> Maybe a
Just UnqualComponentName
exe
exeMaybe ComponentTarget
_ = Maybe UnqualComponentName
forall a. Maybe a
Nothing
getEnvSpecsAndNonGlobalEntries
:: PI.InstalledPackageIndex
-> [GhcEnvironmentFileEntry]
-> Bool
-> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry)])
getEnvSpecsAndNonGlobalEntries :: forall a.
InstalledPackageIndex
-> [GhcEnvironmentFileEntry]
-> Bool
-> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry)])
getEnvSpecsAndNonGlobalEntries InstalledPackageIndex
installedIndex [GhcEnvironmentFileEntry]
entries Bool
installLibs =
if Bool
installLibs
then ([PackageSpecifier a]
forall {a}. [PackageSpecifier a]
envSpecs, [(PackageName, GhcEnvironmentFileEntry)]
envEntries')
else ([], [(PackageName, GhcEnvironmentFileEntry)]
envEntries')
where
([PackageSpecifier a]
envSpecs, [(PackageName, GhcEnvironmentFileEntry)]
envEntries') = InstalledPackageIndex
-> [GhcEnvironmentFileEntry]
-> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry)])
forall a.
InstalledPackageIndex
-> [GhcEnvironmentFileEntry]
-> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry)])
environmentFileToSpecifiers InstalledPackageIndex
installedIndex [GhcEnvironmentFileEntry]
entries
environmentFileToSpecifiers
:: PI.InstalledPackageIndex
-> [GhcEnvironmentFileEntry]
-> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry)])
environmentFileToSpecifiers :: forall a.
InstalledPackageIndex
-> [GhcEnvironmentFileEntry]
-> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry)])
environmentFileToSpecifiers InstalledPackageIndex
ipi = (GhcEnvironmentFileEntry
-> ([PackageSpecifier a],
[(PackageName, GhcEnvironmentFileEntry)]))
-> [GhcEnvironmentFileEntry]
-> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry)])
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((GhcEnvironmentFileEntry
-> ([PackageSpecifier a],
[(PackageName, GhcEnvironmentFileEntry)]))
-> [GhcEnvironmentFileEntry]
-> ([PackageSpecifier a],
[(PackageName, GhcEnvironmentFileEntry)]))
-> (GhcEnvironmentFileEntry
-> ([PackageSpecifier a],
[(PackageName, GhcEnvironmentFileEntry)]))
-> [GhcEnvironmentFileEntry]
-> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry)])
forall a b. (a -> b) -> a -> b
$ \case
(GhcEnvFilePackageId UnitId
unitId)
| Just
InstalledPackageInfo
{ sourcePackageId :: InstalledPackageInfo -> PackageIdentifier
sourcePackageId = PackageIdentifier{Version
PackageName
pkgVersion :: PackageIdentifier -> Version
pkgName :: PackageIdentifier -> PackageName
pkgName :: PackageName
pkgVersion :: Version
..}
, UnitId
installedUnitId :: InstalledPackageInfo -> UnitId
installedUnitId :: UnitId
installedUnitId
} <-
InstalledPackageIndex -> UnitId -> Maybe InstalledPackageInfo
forall a. PackageIndex a -> UnitId -> Maybe a
PI.lookupUnitId InstalledPackageIndex
ipi UnitId
unitId
, let pkgSpec :: PackageSpecifier pkg
pkgSpec =
PackageName -> [PackageProperty] -> PackageSpecifier pkg
forall pkg.
PackageName -> [PackageProperty] -> PackageSpecifier pkg
NamedPackage
PackageName
pkgName
[VersionRange -> PackageProperty
PackagePropertyVersion (Version -> VersionRange
thisVersion Version
pkgVersion)] ->
([PackageSpecifier a
forall {pkg}. PackageSpecifier pkg
pkgSpec], [(PackageName
pkgName, UnitId -> GhcEnvironmentFileEntry
GhcEnvFilePackageId UnitId
installedUnitId)])
GhcEnvironmentFileEntry
_ -> ([], [])
disableTestsBenchsByDefault :: ConfigFlags -> ConfigFlags
disableTestsBenchsByDefault :: ConfigFlags -> ConfigFlags
disableTestsBenchsByDefault ConfigFlags
configFlags =
ConfigFlags
configFlags
{ configTests = Flag False <> configTests configFlags
, configBenchmarks = Flag False <> configBenchmarks configFlags
}
ignoreProgramAffixes :: ConfigFlags -> ConfigFlags
ignoreProgramAffixes :: ConfigFlags -> ConfigFlags
ignoreProgramAffixes ConfigFlags
configFlags =
ConfigFlags
configFlags
{ configProgPrefix = NoFlag
, configProgSuffix = NoFlag
}
symlink :: OverwritePolicy -> InstallExe -> UnitId -> UnqualComponentName -> Symlink
symlink :: OverwritePolicy
-> InstallExe -> UnitId -> UnqualComponentName -> Symlink
symlink
OverwritePolicy
overwritePolicy
InstallExe{FilePath
installDir :: InstallExe -> FilePath
installDir :: FilePath
installDir, UnitId -> FilePath
mkSourceBinDir :: InstallExe -> UnitId -> FilePath
mkSourceBinDir :: UnitId -> FilePath
mkSourceBinDir, UnqualComponentName -> FilePath
mkExeName :: InstallExe -> UnqualComponentName -> FilePath
mkExeName :: UnqualComponentName -> FilePath
mkExeName, UnqualComponentName -> FilePath
mkFinalExeName :: InstallExe -> UnqualComponentName -> FilePath
mkFinalExeName :: UnqualComponentName -> FilePath
mkFinalExeName}
UnitId
unit
UnqualComponentName
exe =
OverwritePolicy
-> FilePath -> FilePath -> FilePath -> FilePath -> Symlink
Symlink
OverwritePolicy
overwritePolicy
FilePath
installDir
(UnitId -> FilePath
mkSourceBinDir UnitId
unit)
(UnqualComponentName -> FilePath
mkExeName UnqualComponentName
exe)
(UnqualComponentName -> FilePath
mkFinalExeName UnqualComponentName
exe)
installCheckUnitExes :: InstallCheck -> InstallAction
installCheckUnitExes :: InstallCheck -> InstallAction
installCheckUnitExes
InstallCheck
installCheck
Verbosity
verbosity
OverwritePolicy
overwritePolicy
installExe :: InstallExe
installExe@InstallExe{InstallMethod
installMethod :: InstallExe -> InstallMethod
installMethod :: InstallMethod
installMethod, FilePath
installDir :: InstallExe -> FilePath
installDir :: FilePath
installDir, UnitId -> FilePath
mkSourceBinDir :: InstallExe -> UnitId -> FilePath
mkSourceBinDir :: UnitId -> FilePath
mkSourceBinDir, UnqualComponentName -> FilePath
mkExeName :: InstallExe -> UnqualComponentName -> FilePath
mkExeName :: UnqualComponentName -> FilePath
mkExeName, UnqualComponentName -> FilePath
mkFinalExeName :: InstallExe -> UnqualComponentName -> FilePath
mkFinalExeName :: UnqualComponentName -> FilePath
mkFinalExeName}
(UnitId
unit, [(ComponentTarget, NonEmpty TargetSelector)]
components) = do
symlinkables :: [Bool] <- (UnqualComponentName -> IO Bool)
-> [UnqualComponentName] -> IO [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Symlink -> IO Bool
symlinkableBinary (Symlink -> IO Bool)
-> (UnqualComponentName -> Symlink)
-> UnqualComponentName
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverwritePolicy
-> InstallExe -> UnitId -> UnqualComponentName -> Symlink
symlink OverwritePolicy
overwritePolicy InstallExe
installExe UnitId
unit) [UnqualComponentName]
exes
case installCheck of
InstallCheck
InstallCheckOnly -> ((Bool, UnqualComponentName) -> IO ())
-> [(Bool, UnqualComponentName)] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Bool, UnqualComponentName) -> IO ()
forall {a}. Pretty a => (Bool, a) -> IO ()
warnAbout ([Bool] -> [UnqualComponentName] -> [(Bool, UnqualComponentName)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Bool]
symlinkables [UnqualComponentName]
exes)
InstallCheck
InstallCheckInstall ->
if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
symlinkables
then (UnqualComponentName -> IO ()) -> [UnqualComponentName] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ UnqualComponentName -> IO ()
installAndWarn [UnqualComponentName]
exes
else ((Bool, UnqualComponentName) -> IO ())
-> [(Bool, UnqualComponentName)] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Bool, UnqualComponentName) -> IO ()
forall {a}. Pretty a => (Bool, a) -> IO ()
warnAbout ([Bool] -> [UnqualComponentName] -> [(Bool, UnqualComponentName)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Bool]
symlinkables [UnqualComponentName]
exes)
where
exes :: [UnqualComponentName]
exes = [Maybe UnqualComponentName] -> [UnqualComponentName]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe UnqualComponentName] -> [UnqualComponentName])
-> [Maybe UnqualComponentName] -> [UnqualComponentName]
forall a b. (a -> b) -> a -> b
$ (ComponentTarget -> Maybe UnqualComponentName
exeMaybe (ComponentTarget -> Maybe UnqualComponentName)
-> ((ComponentTarget, NonEmpty TargetSelector) -> ComponentTarget)
-> (ComponentTarget, NonEmpty TargetSelector)
-> Maybe UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ComponentTarget, NonEmpty TargetSelector) -> ComponentTarget
forall a b. (a, b) -> a
fst) ((ComponentTarget, NonEmpty TargetSelector)
-> Maybe UnqualComponentName)
-> [(ComponentTarget, NonEmpty TargetSelector)]
-> [Maybe UnqualComponentName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ComponentTarget, NonEmpty TargetSelector)]
components
exeMaybe :: ComponentTarget -> Maybe UnqualComponentName
exeMaybe (ComponentTarget (CExeName UnqualComponentName
exe) SubComponentTarget
_) = UnqualComponentName -> Maybe UnqualComponentName
forall a. a -> Maybe a
Just UnqualComponentName
exe
exeMaybe ComponentTarget
_ = Maybe UnqualComponentName
forall a. Maybe a
Nothing
warnAbout :: (Bool, a) -> IO ()
warnAbout (Bool
True, a
_) = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
warnAbout (Bool
False, a
exe) = Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO ()) -> CabalInstallException -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> CabalInstallException
InstallUnitExes (FilePath -> a -> FilePath
forall {a}. Pretty a => FilePath -> a -> FilePath
errorMessage FilePath
installDir a
exe)
installAndWarn :: UnqualComponentName -> IO ()
installAndWarn UnqualComponentName
exe = do
success <-
Verbosity
-> OverwritePolicy
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> InstallMethod
-> IO Bool
installBuiltExe
Verbosity
verbosity
OverwritePolicy
overwritePolicy
(UnitId -> FilePath
mkSourceBinDir UnitId
unit)
(UnqualComponentName -> FilePath
mkExeName UnqualComponentName
exe)
(UnqualComponentName -> FilePath
mkFinalExeName UnqualComponentName
exe)
FilePath
installDir
InstallMethod
installMethod
unless success $ dieWithException verbosity $ InstallUnitExes (errorMessage installDir exe)
errorMessage :: FilePath -> a -> FilePath
errorMessage FilePath
installdir a
exe = case OverwritePolicy
overwritePolicy of
OverwritePolicy
NeverOverwrite ->
FilePath
"Path '"
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (FilePath
installdir FilePath -> FilePath -> FilePath
</> a -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow a
exe)
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"' already exists. "
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"Use --overwrite-policy=always to overwrite."
OverwritePolicy
_ ->
case InstallMethod
installMethod of
InstallMethod
InstallMethodSymlink -> FilePath
"Symlinking"
InstallMethod
InstallMethodCopy -> FilePath
"Copying" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" '" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> a -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow a
exe FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"' failed."
installBuiltExe
:: Verbosity
-> OverwritePolicy
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> InstallMethod
-> IO Bool
installBuiltExe :: Verbosity
-> OverwritePolicy
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> InstallMethod
-> IO Bool
installBuiltExe
Verbosity
verbosity
OverwritePolicy
overwritePolicy
FilePath
sourceDir
FilePath
exeName
FilePath
finalExeName
FilePath
installdir
InstallMethod
InstallMethodSymlink = do
Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Symlinking '" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeName FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"' to '" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
destination FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"'"
Symlink -> IO Bool
symlinkBinary
( OverwritePolicy
-> FilePath -> FilePath -> FilePath -> FilePath -> Symlink
Symlink
OverwritePolicy
overwritePolicy
FilePath
installdir
FilePath
sourceDir
FilePath
finalExeName
FilePath
exeName
)
where
destination :: FilePath
destination = FilePath
installdir FilePath -> FilePath -> FilePath
</> FilePath
finalExeName
installBuiltExe
Verbosity
verbosity
OverwritePolicy
overwritePolicy
FilePath
sourceDir
FilePath
exeName
FilePath
finalExeName
FilePath
installdir
InstallMethod
InstallMethodCopy = do
Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Copying '" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeName FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"' to '" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
destination FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"'"
exists <- FilePath -> IO Bool
doesPathExist FilePath
destination
case (exists, overwritePolicy) of
(Bool
True, OverwritePolicy
NeverOverwrite) -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
(Bool
True, OverwritePolicy
AlwaysOverwrite) -> IO Bool
overwrite
(Bool
True, OverwritePolicy
PromptOverwrite) -> IO Bool
maybeOverwrite
(Bool
False, OverwritePolicy
_) -> IO Bool
copy
where
source :: FilePath
source = FilePath
sourceDir FilePath -> FilePath -> FilePath
</> FilePath
exeName
destination :: FilePath
destination = FilePath
installdir FilePath -> FilePath -> FilePath
</> FilePath
finalExeName
remove :: IO ()
remove = do
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
destination
if isDir
then removeDirectory destination
else removeFile destination
copy :: IO Bool
copy = FilePath -> FilePath -> IO ()
copyFile FilePath
source FilePath
destination IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
overwrite :: IO Bool
overwrite :: IO Bool
overwrite = IO ()
remove IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Bool
copy
maybeOverwrite :: IO Bool
maybeOverwrite :: IO Bool
maybeOverwrite =
FilePath -> IO Bool -> IO Bool
promptRun
FilePath
"Existing file found while installing executable. Do you want to overwrite that file? (y/n)"
IO Bool
overwrite
entriesForLibraryComponents :: TargetsMap -> [GhcEnvironmentFileEntry]
entriesForLibraryComponents :: TargetsMap -> [GhcEnvironmentFileEntry]
entriesForLibraryComponents = (UnitId
-> [(ComponentTarget, NonEmpty TargetSelector)]
-> [GhcEnvironmentFileEntry]
-> [GhcEnvironmentFileEntry])
-> [GhcEnvironmentFileEntry]
-> TargetsMap
-> [GhcEnvironmentFileEntry]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey' (\UnitId
k [(ComponentTarget, NonEmpty TargetSelector)]
v -> [GhcEnvironmentFileEntry]
-> [GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry]
forall a. Monoid a => a -> a -> a
mappend (UnitId
-> [(ComponentTarget, NonEmpty TargetSelector)]
-> [GhcEnvironmentFileEntry]
go UnitId
k [(ComponentTarget, NonEmpty TargetSelector)]
v)) []
where
hasLib :: (ComponentTarget, NonEmpty TargetSelector) -> Bool
hasLib :: (ComponentTarget, NonEmpty TargetSelector) -> Bool
hasLib (ComponentTarget (CLibName LibraryName
_) SubComponentTarget
_, NonEmpty TargetSelector
_) = Bool
True
hasLib (ComponentTarget, NonEmpty TargetSelector)
_ = Bool
False
go
:: UnitId
-> [(ComponentTarget, NonEmpty TargetSelector)]
-> [GhcEnvironmentFileEntry]
go :: UnitId
-> [(ComponentTarget, NonEmpty TargetSelector)]
-> [GhcEnvironmentFileEntry]
go UnitId
unitId [(ComponentTarget, NonEmpty TargetSelector)]
targets
| ((ComponentTarget, NonEmpty TargetSelector) -> Bool)
-> [(ComponentTarget, NonEmpty TargetSelector)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ComponentTarget, NonEmpty TargetSelector) -> Bool
hasLib [(ComponentTarget, NonEmpty TargetSelector)]
targets = [UnitId -> GhcEnvironmentFileEntry
GhcEnvFilePackageId UnitId
unitId]
| Bool
otherwise = []
getEnvFile :: ClientInstallFlags -> Platform -> Version -> IO (Bool, FilePath)
getEnvFile :: ClientInstallFlags -> Platform -> Version -> IO (Bool, FilePath)
getEnvFile ClientInstallFlags
clientInstallFlags Platform
platform Version
compilerVersion = do
appDir <- IO FilePath
getGhcAppDir
case flagToMaybe (cinstEnvironmentPath clientInstallFlags) of
Just FilePath
spec
| FilePath -> FilePath
takeBaseName FilePath
spec FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
spec ->
(Bool, FilePath) -> IO (Bool, FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, FilePath -> Platform -> Version -> FilePath -> FilePath
getGlobalEnv FilePath
appDir Platform
platform Version
compilerVersion FilePath
spec)
| Bool
otherwise -> do
spec' <- FilePath -> IO FilePath
makeAbsolute FilePath
spec
isDir <- doesDirectoryExist spec'
if isDir
then
return (True, getLocalEnv spec' platform compilerVersion)
else
return (True, spec')
Maybe FilePath
Nothing ->
(Bool, FilePath) -> IO (Bool, FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, FilePath -> Platform -> Version -> FilePath -> FilePath
getGlobalEnv FilePath
appDir Platform
platform Version
compilerVersion FilePath
"default")
getExistingEnvEntries :: Verbosity -> CompilerFlavor -> Bool -> FilePath -> IO (Bool, [GhcEnvironmentFileEntry])
getExistingEnvEntries :: Verbosity
-> CompilerFlavor
-> Bool
-> FilePath
-> IO (Bool, [GhcEnvironmentFileEntry])
getExistingEnvEntries Verbosity
verbosity CompilerFlavor
compilerFlavor Bool
supportsPkgEnvFiles FilePath
envFile = do
envFileExists <- FilePath -> IO Bool
doesFileExist FilePath
envFile
(usedExisting, allEntries) <-
if (compilerFlavor == GHC || compilerFlavor == GHCJS)
&& supportsPkgEnvFiles
&& envFileExists
then catch ((True,) <$> readGhcEnvironmentFile envFile) $ \(ParseErrorExc
_ :: ParseErrorExc) ->
Verbosity -> FilePath -> IO ()
warn
Verbosity
verbosity
( FilePath
"The environment file "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
envFile
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is unparsable. Libraries cannot be installed."
)
IO ()
-> IO (Bool, [GhcEnvironmentFileEntry])
-> IO (Bool, [GhcEnvironmentFileEntry])
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Bool, [GhcEnvironmentFileEntry])
-> IO (Bool, [GhcEnvironmentFileEntry])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, [])
else return (False, [])
return (usedExisting, filterEnvEntries allEntries)
where
filterEnvEntries :: [GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry]
filterEnvEntries = (GhcEnvironmentFileEntry -> Bool)
-> [GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry]
forall a. (a -> Bool) -> [a] -> [a]
filter ((GhcEnvironmentFileEntry -> Bool)
-> [GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry])
-> (GhcEnvironmentFileEntry -> Bool)
-> [GhcEnvironmentFileEntry]
-> [GhcEnvironmentFileEntry]
forall a b. (a -> b) -> a -> b
$ \case
GhcEnvFilePackageId UnitId
_ -> Bool
True
GhcEnvironmentFileEntry
_ -> Bool
False
getGlobalEnv :: FilePath -> Platform -> Version -> String -> FilePath
getGlobalEnv :: FilePath -> Platform -> Version -> FilePath -> FilePath
getGlobalEnv FilePath
appDir Platform
platform Version
compilerVersion FilePath
name =
FilePath
appDir
FilePath -> FilePath -> FilePath
</> Platform -> Version -> FilePath
ghcPlatformAndVersionString Platform
platform Version
compilerVersion
FilePath -> FilePath -> FilePath
</> FilePath
"environments"
FilePath -> FilePath -> FilePath
</> FilePath
name
getLocalEnv :: FilePath -> Platform -> Version -> FilePath
getLocalEnv :: FilePath -> Platform -> Version -> FilePath
getLocalEnv FilePath
dir Platform
platform Version
compilerVersion =
FilePath
dir
FilePath -> FilePath -> FilePath
</> FilePath
".ghc.environment."
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Platform -> Version -> FilePath
ghcPlatformAndVersionString Platform
platform Version
compilerVersion
getPackageDbStack
:: Compiler
-> Flag FilePath
-> Flag FilePath
-> [Maybe PackageDB]
-> IO PackageDBStack
getPackageDbStack :: Compiler
-> Flag FilePath
-> Flag FilePath
-> [Maybe PackageDB]
-> IO PackageDBStack
getPackageDbStack Compiler
compiler Flag FilePath
storeDirFlag Flag FilePath
logsDirFlag [Maybe PackageDB]
packageDbs = do
mstoreDir <- (FilePath -> IO FilePath) -> Maybe FilePath -> IO (Maybe FilePath)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse FilePath -> IO FilePath
makeAbsolute (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ Flag FilePath -> Maybe FilePath
forall a. Flag a -> Maybe a
flagToMaybe Flag FilePath
storeDirFlag
let
mlogsDir = Flag FilePath -> Maybe FilePath
forall a. Flag a -> Maybe a
flagToMaybe Flag FilePath
logsDirFlag
cabalLayout <- mkCabalDirLayout mstoreDir mlogsDir
pure $ storePackageDBStack (cabalStoreDirLayout cabalLayout) compiler packageDbs
selectPackageTargets
:: TargetSelector
-> [AvailableTarget k]
-> Either TargetProblem' [k]
selectPackageTargets :: forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem Void) [k]
selectPackageTargets TargetSelector
targetSelector [AvailableTarget k]
targets
| Bool -> Bool
not ([k] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [k]
targetsBuildable) =
[k] -> Either (TargetProblem Void) [k]
forall a b. b -> Either a b
Right [k]
targetsBuildable
| Bool -> Bool
not ([AvailableTarget k] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AvailableTarget k]
targets) =
TargetProblem Void -> Either (TargetProblem Void) [k]
forall a b. a -> Either a b
Left (TargetSelector -> [AvailableTarget ()] -> TargetProblem Void
forall a. TargetSelector -> [AvailableTarget ()] -> TargetProblem a
TargetProblemNoneEnabled TargetSelector
targetSelector [AvailableTarget ()]
targets')
| Bool
otherwise =
TargetProblem Void -> Either (TargetProblem Void) [k]
forall a b. a -> Either a b
Left (TargetSelector -> TargetProblem Void
forall a. TargetSelector -> TargetProblem a
TargetProblemNoTargets TargetSelector
targetSelector)
where
targets' :: [AvailableTarget ()]
targets' = [AvailableTarget k] -> [AvailableTarget ()]
forall k. [AvailableTarget k] -> [AvailableTarget ()]
forgetTargetsDetail [AvailableTarget k]
targets
targetsBuildable :: [k]
targetsBuildable =
(TargetRequested -> Bool) -> [AvailableTarget k] -> [k]
forall k. (TargetRequested -> Bool) -> [AvailableTarget k] -> [k]
selectBuildableTargetsWith
(TargetSelector -> TargetRequested -> Bool
buildable TargetSelector
targetSelector)
[AvailableTarget k]
targets
buildable :: TargetSelector -> TargetRequested -> Bool
buildable (TargetPackage TargetImplicitCwd
_ [PackageIdentifier]
_ Maybe ComponentKindFilter
Nothing) TargetRequested
TargetNotRequestedByDefault = Bool
False
buildable (TargetAllPackages Maybe ComponentKindFilter
Nothing) TargetRequested
TargetNotRequestedByDefault = Bool
False
buildable TargetSelector
_ TargetRequested
_ = Bool
True
selectComponentTarget
:: SubComponentTarget
-> AvailableTarget k
-> Either TargetProblem' k
selectComponentTarget :: forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem Void) k
selectComponentTarget = SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem Void) k
forall k a.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem a) k
selectComponentTargetBasic
reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a
reportBuildTargetProblems :: forall a. Verbosity -> [TargetProblem Void] -> IO a
reportBuildTargetProblems Verbosity
verbosity [TargetProblem Void]
problems = Verbosity -> FilePath -> [TargetProblem Void] -> IO a
forall a. Verbosity -> FilePath -> [TargetProblem Void] -> IO a
reportTargetProblems Verbosity
verbosity FilePath
"build" [TargetProblem Void]
problems
reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a
reportCannotPruneDependencies :: forall a. Verbosity -> CannotPruneDependencies -> IO a
reportCannotPruneDependencies Verbosity
verbosity =
Verbosity -> CabalInstallException -> IO a
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO a)
-> (CannotPruneDependencies -> CabalInstallException)
-> CannotPruneDependencies
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> CabalInstallException
SelectComponentTargetError (FilePath -> CabalInstallException)
-> (CannotPruneDependencies -> FilePath)
-> CannotPruneDependencies
-> CabalInstallException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CannotPruneDependencies -> FilePath
renderCannotPruneDependencies