{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.Client.CmdInstall (
installCommand,
installAction,
selectPackageTargets,
selectComponentTarget,
establishDummyDistDirLayout,
establishDummyProjectBaseContext
) where
import Prelude ()
import Distribution.Client.Compat.Prelude
import Distribution.Compat.Directory
( doesPathExist )
import Distribution.Client.ProjectOrchestration
import Distribution.Client.CmdErrorMessages
import Distribution.Client.CmdSdist
import Distribution.Client.TargetProblem
( TargetProblem', TargetProblem (..) )
import Distribution.Client.CmdInstall.ClientInstallFlags
import Distribution.Client.CmdInstall.ClientInstallTargetSelector
import Distribution.Client.Setup
( GlobalFlags(..), ConfigFlags(..), InstallFlags(..) )
import Distribution.Client.Types
( PackageSpecifier(..), PackageLocation(..), UnresolvedSourcePackage
, SourcePackageDb(..) )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Package
( Package(..), PackageName, mkPackageName, unPackageName )
import Distribution.Types.PackageId
( PackageIdentifier(..) )
import Distribution.Client.ProjectConfig
( ProjectPackageLocation(..)
, fetchAndReadSourcePackages
, projectConfigWithBuilderRepoContext
, resolveBuildTimeSettings, withProjectOrGlobalConfig )
import Distribution.Client.NixStyleOptions
( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )
import Distribution.Client.ProjectFlags (ProjectFlags (..))
import Distribution.Client.ProjectConfig.Types
( ProjectConfig(..), ProjectConfigShared(..)
, ProjectConfigBuildOnly(..), PackageConfig(..)
, MapMappend(..)
, getMapLast, getMapMappend, projectConfigLogsDir
, projectConfigStoreDir, projectConfigBuildOnly
, projectConfigConfigFile )
import Distribution.Simple.Program.Db
( userSpecifyPaths, userSpecifyArgss, defaultProgramDb
, modifyProgramSearchPath )
import Distribution.Simple.BuildPaths
( exeExtension )
import Distribution.Simple.Program.Find
( ProgramSearchPathEntry(..) )
import Distribution.Client.Config
( defaultInstallPath, loadConfig, SavedConfig(..) )
import qualified Distribution.Simple.PackageIndex as PI
import Distribution.Solver.Types.PackageIndex
( lookupPackageName, searchByName )
import Distribution.Types.InstalledPackageInfo
( InstalledPackageInfo(..) )
import Distribution.Types.Version
( Version, nullVersion )
import Distribution.Types.VersionRange
( thisVersion )
import Distribution.Solver.Types.PackageConstraint
( PackageProperty(..) )
import Distribution.Client.IndexUtils
( getSourcePackages, getInstalledPackages )
import Distribution.Client.ProjectPlanning
( storePackageInstallDirs' )
import Distribution.Client.ProjectPlanning.Types
( ElaboratedInstallPlan )
import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Client.DistDirLayout
( DistDirLayout(..), mkCabalDirLayout
, cabalStoreDirLayout
, CabalDirLayout(..), StoreDirLayout(..) )
import Distribution.Client.RebuildMonad
( runRebuild )
import Distribution.Client.InstallSymlink
( symlinkBinary, trySymlink, promptRun )
import Distribution.Client.Types.OverwritePolicy
( OverwritePolicy (..) )
import Distribution.Simple.Flag
( fromFlagOrDefault, flagToMaybe, flagElim )
import Distribution.Simple.Setup
( Flag(..), installDirsOptions )
import Distribution.Solver.Types.SourcePackage
( SourcePackage(..) )
import Distribution.Simple.Command
( CommandUI(..), usageAlternatives, optionName )
import Distribution.Simple.Configure
( configCompilerEx )
import Distribution.Simple.Compiler
( Compiler(..), CompilerId(..), CompilerFlavor(..)
, PackageDBStack, PackageDB(..) )
import Distribution.Simple.GHC
( ghcPlatformAndVersionString, getGhcAppDir
, GhcImplInfo(..), getImplInfo
, GhcEnvironmentFileEntry(..)
, renderGhcEnvironmentFile, readGhcEnvironmentFile, ParseErrorExc )
import Distribution.System
( Platform , buildOS, OS (Windows) )
import Distribution.Types.UnitId
( UnitId )
import Distribution.Types.UnqualComponentName
( UnqualComponentName, unUnqualComponentName )
import Distribution.Verbosity
( normal, lessVerbose )
import Distribution.Simple.Utils
( wrapText, die', notice, warn
, withTempDirectory, createDirectoryIfMissingVerbose
, ordNub, safeHead )
import Distribution.Utils.Generic
( writeFileAtomic )
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Ord
( Down(..) )
import qualified Data.Map as Map
import qualified Data.Set as S
import qualified Data.List.NonEmpty as NE
import Distribution.Utils.NubList
( fromNubList )
import Network.URI (URI)
import System.Directory
( doesFileExist, createDirectoryIfMissing
, getTemporaryDirectory, makeAbsolute, doesDirectoryExist
, removeFile, removeDirectory, copyFile )
import System.FilePath
( (</>), (<.>), takeDirectory, takeBaseName )
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/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 { extraFlags :: forall a. NixStyleFlags a -> a
extraFlags = ClientInstallFlags
clientInstallFlags', HaddockFlags
BenchmarkFlags
ConfigFlags
TestFlags
ProjectFlags
InstallFlags
ConfigExFlags
configFlags :: ConfigFlags
configExFlags :: ConfigExFlags
installFlags :: InstallFlags
haddockFlags :: HaddockFlags
testFlags :: TestFlags
benchmarkFlags :: BenchmarkFlags
projectFlags :: ProjectFlags
projectFlags :: forall a. NixStyleFlags a -> ProjectFlags
benchmarkFlags :: forall a. NixStyleFlags a -> BenchmarkFlags
testFlags :: forall a. NixStyleFlags a -> TestFlags
haddockFlags :: forall a. NixStyleFlags a -> HaddockFlags
installFlags :: forall a. NixStyleFlags a -> InstallFlags
configExFlags :: forall a. NixStyleFlags a -> ConfigExFlags
configFlags :: forall a. NixStyleFlags a -> ConfigFlags
.. } [FilePath]
targetStrings GlobalFlags
globalFlags = do
Verbosity -> ConfigFlags -> IO ()
verifyPreconditionsOrDie Verbosity
verbosity ConfigFlags
configFlags'
ClientInstallFlags
clientInstallFlags <- Verbosity
-> GlobalFlags -> ClientInstallFlags -> IO ClientInstallFlags
getClientInstallFlags Verbosity
verbosity GlobalFlags
globalFlags ClientInstallFlags
clientInstallFlags'
let
installLibs :: Bool
installLibs = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (ClientInstallFlags -> Flag Bool
cinstInstallLibs ClientInstallFlags
clientInstallFlags)
targetFilter :: Maybe ComponentKind
targetFilter = if Bool
installLibs then ComponentKind -> Maybe ComponentKind
forall a. a -> Maybe a
Just ComponentKind
LibKind else ComponentKind -> Maybe ComponentKind
forall a. a -> Maybe a
Just ComponentKind
ExeKind
targetStrings' :: [FilePath]
targetStrings' = if [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
targetStrings then [FilePath
"."] else [FilePath]
targetStrings
withProject :: IO ([PackageSpecifier UnresolvedSourcePackage], [URI], [TargetSelector], ProjectConfig)
withProject :: IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
withProject = do
let reducedVerbosity :: Verbosity
reducedVerbosity = Verbosity -> Verbosity
lessVerbose Verbosity
verbosity
ProjectBaseContext
localBaseCtx <-
Verbosity
-> ProjectConfig -> CurrentCommand -> IO ProjectBaseContext
establishProjectBaseContext Verbosity
reducedVerbosity ProjectConfig
cliConfig CurrentCommand
InstallCommand
let localDistDirLayout :: DistDirLayout
localDistDirLayout = ProjectBaseContext -> DistDirLayout
distDirLayout ProjectBaseContext
localBaseCtx
SourcePackageDb
pkgDb <- Verbosity
-> BuildTimeSettings
-> (RepoContext -> IO SourcePackageDb)
-> IO SourcePackageDb
forall a.
Verbosity -> BuildTimeSettings -> (RepoContext -> IO a) -> IO a
projectConfigWithBuilderRepoContext Verbosity
reducedVerbosity
(ProjectBaseContext -> BuildTimeSettings
buildSettings ProjectBaseContext
localBaseCtx) (Verbosity -> RepoContext -> IO SourcePackageDb
getSourcePackages Verbosity
verbosity)
let
([FilePath]
targetStrings'', [PackageId]
packageIds) =
[Either FilePath PackageId] -> ([FilePath], [PackageId])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either FilePath PackageId] -> ([FilePath], [PackageId]))
-> ((FilePath -> Either FilePath PackageId)
-> [Either FilePath PackageId])
-> (FilePath -> Either FilePath PackageId)
-> ([FilePath], [PackageId])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((FilePath -> Either FilePath PackageId)
-> [FilePath] -> [Either FilePath PackageId])
-> [FilePath]
-> (FilePath -> Either FilePath PackageId)
-> [Either FilePath PackageId]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FilePath -> Either FilePath PackageId)
-> [FilePath] -> [Either FilePath PackageId]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath]
targetStrings' ((FilePath -> Either FilePath PackageId)
-> ([FilePath], [PackageId]))
-> (FilePath -> Either FilePath PackageId)
-> ([FilePath], [PackageId])
forall a b. (a -> b) -> a -> b
$
\FilePath
str -> case FilePath -> Maybe PackageId
forall a. Parsec a => FilePath -> Maybe a
simpleParsec FilePath
str of
Just (PackageId
pkgId :: PackageId)
| PackageId -> Version
pkgVersion PackageId
pkgId Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
/= Version
nullVersion -> PackageId -> Either FilePath PackageId
forall a b. b -> Either a b
Right PackageId
pkgId
Maybe PackageId
_ -> FilePath -> Either FilePath PackageId
forall a b. a -> Either a b
Left FilePath
str
packageSpecifiers :: [PackageSpecifier pkg]
packageSpecifiers =
((PackageId -> PackageSpecifier pkg)
-> [PackageId] -> [PackageSpecifier pkg])
-> [PackageId]
-> (PackageId -> PackageSpecifier pkg)
-> [PackageSpecifier pkg]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (PackageId -> PackageSpecifier pkg)
-> [PackageId] -> [PackageSpecifier pkg]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [PackageId]
packageIds ((PackageId -> PackageSpecifier pkg) -> [PackageSpecifier pkg])
-> (PackageId -> PackageSpecifier pkg) -> [PackageSpecifier pkg]
forall a b. (a -> b) -> a -> b
$ \case
PackageIdentifier{Version
PackageName
pkgVersion :: PackageId -> Version
pkgName :: PackageName
pkgVersion :: Version
pkgName :: PackageId -> PackageName
..}
| Version
pkgVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
nullVersion -> PackageName -> [PackageProperty] -> PackageSpecifier pkg
forall pkg.
PackageName -> [PackageProperty] -> PackageSpecifier pkg
NamedPackage PackageName
pkgName []
| Bool
otherwise -> PackageName -> [PackageProperty] -> PackageSpecifier pkg
forall pkg.
PackageName -> [PackageProperty] -> PackageSpecifier pkg
NamedPackage PackageName
pkgName
[VersionRange -> PackageProperty
PackagePropertyVersion
(Version -> VersionRange
thisVersion Version
pkgVersion)]
packageTargets :: [TargetSelector]
packageTargets =
(PackageName -> Maybe ComponentKind -> TargetSelector)
-> Maybe ComponentKind -> PackageName -> TargetSelector
forall a b c. (a -> b -> c) -> b -> a -> c
flip PackageName -> Maybe ComponentKind -> TargetSelector
TargetPackageNamed Maybe ComponentKind
targetFilter (PackageName -> TargetSelector)
-> (PackageId -> PackageName) -> PackageId -> TargetSelector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageId -> PackageName
pkgName (PackageId -> TargetSelector) -> [PackageId] -> [TargetSelector]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PackageId]
packageIds
if [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
targetStrings''
then ([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageSpecifier UnresolvedSourcePackage]
forall {pkg}. [PackageSpecifier pkg]
packageSpecifiers, [], [TargetSelector]
packageTargets, ProjectBaseContext -> ProjectConfig
projectConfig ProjectBaseContext
localBaseCtx)
else do
[TargetSelector]
targetSelectors <-
([TargetSelectorProblem] -> IO [TargetSelector])
-> ([TargetSelector] -> IO [TargetSelector])
-> Either [TargetSelectorProblem] [TargetSelector]
-> IO [TargetSelector]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> [TargetSelectorProblem] -> IO [TargetSelector]
forall a. Verbosity -> [TargetSelectorProblem] -> IO a
reportTargetSelectorProblems Verbosity
verbosity) [TargetSelector] -> IO [TargetSelector]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Either [TargetSelectorProblem] [TargetSelector]
-> IO [TargetSelector])
-> IO (Either [TargetSelectorProblem] [TargetSelector])
-> IO [TargetSelector]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [PackageSpecifier UnresolvedSourcePackage]
-> Maybe ComponentKind
-> [FilePath]
-> IO (Either [TargetSelectorProblem] [TargetSelector])
forall a.
[PackageSpecifier (SourcePackage (PackageLocation a))]
-> Maybe ComponentKind
-> [FilePath]
-> IO (Either [TargetSelectorProblem] [TargetSelector])
readTargetSelectors (ProjectBaseContext -> [PackageSpecifier UnresolvedSourcePackage]
localPackages ProjectBaseContext
localBaseCtx)
Maybe ComponentKind
forall a. Maybe a
Nothing [FilePath]
targetStrings''
([PackageSpecifier UnresolvedSourcePackage]
specs, [TargetSelector]
selectors) <-
Verbosity
-> Verbosity
-> SourcePackageDb
-> [TargetSelector]
-> DistDirLayout
-> ProjectBaseContext
-> Maybe ComponentKind
-> IO
([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
getSpecsAndTargetSelectors
Verbosity
verbosity Verbosity
reducedVerbosity SourcePackageDb
pkgDb [TargetSelector]
targetSelectors DistDirLayout
localDistDirLayout ProjectBaseContext
localBaseCtx Maybe ComponentKind
targetFilter
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ( [PackageSpecifier UnresolvedSourcePackage]
specs [PackageSpecifier UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
forall a. [a] -> [a] -> [a]
++ [PackageSpecifier UnresolvedSourcePackage]
forall {pkg}. [PackageSpecifier pkg]
packageSpecifiers
, []
, [TargetSelector]
selectors [TargetSelector] -> [TargetSelector] -> [TargetSelector]
forall a. [a] -> [a] -> [a]
++ [TargetSelector]
packageTargets
, ProjectBaseContext -> ProjectConfig
projectConfig ProjectBaseContext
localBaseCtx )
withoutProject :: ProjectConfig -> IO ([PackageSpecifier UnresolvedSourcePackage], [URI], [TargetSelector], ProjectConfig)
withoutProject :: ProjectConfig
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
withoutProject ProjectConfig
_ | [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
targetStrings = IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
withProject
withoutProject ProjectConfig
globalConfig = do
[WithoutProjectTargetSelector]
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
projectConfig :: ProjectConfig
projectConfig = ProjectConfig
globalConfig ProjectConfig -> ProjectConfig -> ProjectConfig
forall a. Semigroup a => a -> a -> a
<> ProjectConfig
cliConfig
ProjectConfigBuildOnly {
Flag FilePath
projectConfigLogsDir :: ProjectConfigBuildOnly -> Flag FilePath
projectConfigLogsDir :: Flag FilePath
projectConfigLogsDir
} = ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly ProjectConfig
projectConfig
ProjectConfigShared {
Flag FilePath
projectConfigStoreDir :: ProjectConfigShared -> Flag FilePath
projectConfigStoreDir :: Flag FilePath
projectConfigStoreDir
} = ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
projectConfig
mlogsDir :: Maybe FilePath
mlogsDir = Flag FilePath -> Maybe FilePath
forall a. Flag a -> Maybe a
flagToMaybe Flag FilePath
projectConfigLogsDir
mstoreDir :: Maybe FilePath
mstoreDir = Flag FilePath -> Maybe FilePath
forall a. Flag a -> Maybe a
flagToMaybe Flag FilePath
projectConfigStoreDir
CabalDirLayout
cabalDirLayout <- Maybe FilePath -> Maybe FilePath -> IO CabalDirLayout
mkCabalDirLayout Maybe FilePath
mstoreDir Maybe FilePath
mlogsDir
let
buildSettings :: BuildTimeSettings
buildSettings = Verbosity -> CabalDirLayout -> ProjectConfig -> BuildTimeSettings
resolveBuildTimeSettings
Verbosity
verbosity CabalDirLayout
cabalDirLayout
ProjectConfig
projectConfig
SourcePackageDb { PackageIndex UnresolvedSourcePackage
packageIndex :: PackageIndex UnresolvedSourcePackage
packageIndex :: SourcePackageDb -> PackageIndex UnresolvedSourcePackage
packageIndex } <- Verbosity
-> BuildTimeSettings
-> (RepoContext -> IO SourcePackageDb)
-> IO SourcePackageDb
forall a.
Verbosity -> BuildTimeSettings -> (RepoContext -> IO a) -> IO a
projectConfigWithBuilderRepoContext
Verbosity
verbosity BuildTimeSettings
buildSettings
(Verbosity -> RepoContext -> IO SourcePackageDb
getSourcePackages Verbosity
verbosity)
[PackageName] -> (PackageName -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ((WithoutProjectTargetSelector -> [PackageName])
-> [WithoutProjectTargetSelector] -> [PackageName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap WithoutProjectTargetSelector -> [PackageName]
woPackageNames [WithoutProjectTargetSelector]
tss) ((PackageName -> IO ()) -> IO ())
-> (PackageName -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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
Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$
[ FilePath
"Unknown package \"", PackageName -> FilePath
unPackageName PackageName
name, FilePath
"\". "
] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ 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)
]
let
([URI]
uris, [PackageSpecifier pkg]
packageSpecifiers) = [Either URI (PackageSpecifier pkg)]
-> ([URI], [PackageSpecifier pkg])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either URI (PackageSpecifier pkg)]
-> ([URI], [PackageSpecifier pkg]))
-> [Either URI (PackageSpecifier pkg)]
-> ([URI], [PackageSpecifier pkg])
forall a b. (a -> b) -> a -> b
$ (WithoutProjectTargetSelector -> Either URI (PackageSpecifier pkg))
-> [WithoutProjectTargetSelector]
-> [Either URI (PackageSpecifier pkg)]
forall a b. (a -> b) -> [a] -> [b]
map WithoutProjectTargetSelector -> Either URI (PackageSpecifier pkg)
forall pkg.
WithoutProjectTargetSelector -> Either URI (PackageSpecifier pkg)
woPackageSpecifiers [WithoutProjectTargetSelector]
tss
packageTargets :: [TargetSelector]
packageTargets = (WithoutProjectTargetSelector -> TargetSelector)
-> [WithoutProjectTargetSelector] -> [TargetSelector]
forall a b. (a -> b) -> [a] -> [b]
map WithoutProjectTargetSelector -> TargetSelector
woPackageTargets [WithoutProjectTargetSelector]
tss
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageSpecifier UnresolvedSourcePackage]
forall {pkg}. [PackageSpecifier pkg]
packageSpecifiers, [URI]
uris, [TargetSelector]
packageTargets, ProjectConfig
projectConfig)
([PackageSpecifier UnresolvedSourcePackage]
specs, [URI]
uris, [TargetSelector]
targetSelectors, ProjectConfig
config) <-
Verbosity
-> Flag Bool
-> Flag FilePath
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
-> (ProjectConfig
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig))
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
forall a.
Verbosity
-> Flag Bool
-> Flag FilePath
-> IO a
-> (ProjectConfig -> IO a)
-> IO a
withProjectOrGlobalConfig Verbosity
verbosity Flag Bool
ignoreProject Flag FilePath
globalConfigFlag IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
withProject ProjectConfig
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
withoutProject
let
ProjectConfig {
projectConfigBuildOnly :: ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly = ProjectConfigBuildOnly {
Flag FilePath
projectConfigLogsDir :: ProjectConfigBuildOnly -> Flag FilePath
projectConfigLogsDir :: Flag FilePath
projectConfigLogsDir
},
projectConfigShared :: ProjectConfig -> ProjectConfigShared
projectConfigShared = ProjectConfigShared {
Flag CompilerFlavor
projectConfigHcFlavor :: Flag CompilerFlavor
projectConfigHcFlavor :: ProjectConfigShared -> Flag CompilerFlavor
projectConfigHcFlavor,
Flag FilePath
projectConfigHcPath :: Flag FilePath
projectConfigHcPath :: ProjectConfigShared -> Flag FilePath
projectConfigHcPath,
Flag FilePath
projectConfigHcPkg :: Flag FilePath
projectConfigHcPkg :: ProjectConfigShared -> Flag FilePath
projectConfigHcPkg,
Flag FilePath
projectConfigStoreDir :: ProjectConfigShared -> Flag FilePath
projectConfigStoreDir :: Flag FilePath
projectConfigStoreDir
},
projectConfigLocalPackages :: ProjectConfig -> PackageConfig
projectConfigLocalPackages = PackageConfig {
MapLast FilePath FilePath
packageConfigProgramPaths :: MapLast FilePath FilePath
packageConfigProgramPaths :: PackageConfig -> MapLast FilePath FilePath
packageConfigProgramPaths,
MapMappend FilePath [FilePath]
packageConfigProgramArgs :: MapMappend FilePath [FilePath]
packageConfigProgramArgs :: PackageConfig -> MapMappend FilePath [FilePath]
packageConfigProgramArgs,
NubList FilePath
packageConfigProgramPathExtra :: NubList FilePath
packageConfigProgramPathExtra :: PackageConfig -> NubList FilePath
packageConfigProgramPathExtra
}
} = ProjectConfig
config
hcFlavor :: Maybe CompilerFlavor
hcFlavor = Flag CompilerFlavor -> Maybe CompilerFlavor
forall a. Flag a -> Maybe a
flagToMaybe Flag CompilerFlavor
projectConfigHcFlavor
hcPath :: Maybe FilePath
hcPath = Flag FilePath -> Maybe FilePath
forall a. Flag a -> Maybe a
flagToMaybe Flag FilePath
projectConfigHcPath
hcPkg :: Maybe FilePath
hcPkg = Flag FilePath -> Maybe FilePath
forall a. Flag a -> Maybe a
flagToMaybe Flag FilePath
projectConfigHcPkg
preProgDb :: ProgramDb
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) -> ProgramDb -> ProgramDb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgramSearchPath -> ProgramSearchPath) -> ProgramDb -> ProgramDb
modifyProgramSearchPath
(ProgramSearchPath -> ProgramSearchPath -> ProgramSearchPath
forall a. [a] -> [a] -> [a]
++ [ FilePath -> ProgramSearchPathEntry
ProgramSearchPathDir FilePath
dir
| FilePath
dir <- NubList FilePath -> [FilePath]
forall a. NubList a -> [a]
fromNubList NubList FilePath
packageConfigProgramPathExtra ])
(ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
forall a b. (a -> b) -> a -> b
$ ProgramDb
defaultProgramDb
(compiler :: Compiler
compiler@Compiler { compilerId :: Compiler -> CompilerId
compilerId =
compilerId :: CompilerId
compilerId@(CompilerId CompilerFlavor
compilerFlavor Version
compilerVersion) }, Platform
platform, ProgramDb
progDb) <-
Maybe CompilerFlavor
-> Maybe FilePath
-> Maybe FilePath
-> ProgramDb
-> Verbosity
-> IO (Compiler, Platform, ProgramDb)
configCompilerEx Maybe CompilerFlavor
hcFlavor Maybe FilePath
hcPath Maybe FilePath
hcPkg ProgramDb
preProgDb Verbosity
verbosity
let
GhcImplInfo{ Bool
supportsPkgEnvFiles :: Bool
supportsPkgEnvFiles :: GhcImplInfo -> Bool
supportsPkgEnvFiles } = Compiler -> GhcImplInfo
getImplInfo Compiler
compiler
FilePath
envFile <- ClientInstallFlags -> Platform -> Version -> IO FilePath
getEnvFile ClientInstallFlags
clientInstallFlags Platform
platform Version
compilerVersion
[GhcEnvironmentFileEntry]
existingEnvEntries <-
Verbosity
-> CompilerFlavor
-> Bool
-> FilePath
-> IO [GhcEnvironmentFileEntry]
getExistingEnvEntries Verbosity
verbosity CompilerFlavor
compilerFlavor Bool
supportsPkgEnvFiles FilePath
envFile
PackageDBStack
packageDbs <- CompilerId -> Flag FilePath -> Flag FilePath -> IO PackageDBStack
getPackageDbStack CompilerId
compilerId Flag FilePath
projectConfigStoreDir Flag FilePath
projectConfigLogsDir
InstalledPackageIndex
installedIndex <- Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
compiler PackageDBStack
packageDbs ProgramDb
progDb
let
([PackageSpecifier a]
envSpecs, [(PackageName, GhcEnvironmentFileEntry)]
nonGlobalEnvEntries) =
InstalledPackageIndex
-> [GhcEnvironmentFileEntry]
-> Bool
-> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry)])
forall a.
InstalledPackageIndex
-> [GhcEnvironmentFileEntry]
-> Bool
-> ([PackageSpecifier a], [(PackageName, GhcEnvironmentFileEntry)])
getEnvSpecsAndNonGlobalEntries InstalledPackageIndex
installedIndex [GhcEnvironmentFileEntry]
existingEnvEntries Bool
installLibs
FilePath
globalTmp <- IO FilePath
getTemporaryDirectory
Verbosity -> FilePath -> FilePath -> (FilePath -> IO ()) -> IO ()
forall a.
Verbosity -> FilePath -> FilePath -> (FilePath -> IO a) -> IO a
withTempDirectory Verbosity
verbosity FilePath
globalTmp FilePath
"cabal-install." ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
tmpDir -> do
DistDirLayout
distDirLayout <- Verbosity -> ProjectConfig -> FilePath -> IO DistDirLayout
establishDummyDistDirLayout Verbosity
verbosity ProjectConfig
config FilePath
tmpDir
[PackageSpecifier UnresolvedSourcePackage]
uriSpecs <- FilePath
-> Rebuild [PackageSpecifier UnresolvedSourcePackage]
-> IO [PackageSpecifier UnresolvedSourcePackage]
forall a. FilePath -> Rebuild a -> IO a
runRebuild FilePath
tmpDir (Rebuild [PackageSpecifier UnresolvedSourcePackage]
-> IO [PackageSpecifier UnresolvedSourcePackage])
-> Rebuild [PackageSpecifier UnresolvedSourcePackage]
-> IO [PackageSpecifier UnresolvedSourcePackage]
forall a b. (a -> b) -> a -> b
$ Verbosity
-> DistDirLayout
-> ProjectConfigShared
-> ProjectConfigBuildOnly
-> [ProjectPackageLocation]
-> Rebuild [PackageSpecifier UnresolvedSourcePackage]
fetchAndReadSourcePackages
Verbosity
verbosity
DistDirLayout
distDirLayout
(ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
config)
(ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly ProjectConfig
config)
[ URI -> ProjectPackageLocation
ProjectPackageRemoteTarball URI
uri | URI
uri <- [URI]
uris ]
let getPackageName :: PackageSpecifier UnresolvedSourcePackage -> PackageName
getPackageName :: PackageSpecifier UnresolvedSourcePackage -> PackageName
getPackageName (NamedPackage PackageName
pn [PackageProperty]
_) = PackageName
pn
getPackageName (SpecificSourcePackage (SourcePackage PackageId
pkgId GenericPackageDescription
_ UnresolvedPkgLoc
_ PackageDescriptionOverride
_)) = PackageId -> PackageName
pkgName PackageId
pkgId
targetNames :: Set PackageName
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]
specs [PackageSpecifier UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
forall a. [a] -> [a] -> [a]
++ [PackageSpecifier UnresolvedSourcePackage]
uriSpecs)
envNames :: Set PackageName
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 {pkg}. [PackageSpecifier pkg]
envSpecs
forceInstall :: Bool
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
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
([PackageSpecifier UnresolvedSourcePackage]
envSpecs', [GhcEnvironmentFileEntry]
nonGlobalEnvEntries') <- if Set PackageName -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set PackageName
nameIntersection
then ([PackageSpecifier UnresolvedSourcePackage],
[GhcEnvironmentFileEntry])
-> IO
([PackageSpecifier UnresolvedSourcePackage],
[GhcEnvironmentFileEntry])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PackageSpecifier UnresolvedSourcePackage]
forall {pkg}. [PackageSpecifier pkg]
envSpecs, ((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)]
nonGlobalEnvEntries)
else if Bool
forceInstall
then let es :: [PackageSpecifier UnresolvedSourcePackage]
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 {pkg}. [PackageSpecifier pkg]
envSpecs
nge :: [GhcEnvironmentFileEntry]
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 ([PackageSpecifier UnresolvedSourcePackage],
[GhcEnvironmentFileEntry])
-> IO
([PackageSpecifier UnresolvedSourcePackage],
[GhcEnvironmentFileEntry])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PackageSpecifier UnresolvedSourcePackage]
es, [GhcEnvironmentFileEntry]
nge)
else Verbosity
-> FilePath
-> IO
([PackageSpecifier UnresolvedSourcePackage],
[GhcEnvironmentFileEntry])
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath
-> IO
([PackageSpecifier UnresolvedSourcePackage],
[GhcEnvironmentFileEntry]))
-> FilePath
-> IO
([PackageSpecifier UnresolvedSourcePackage],
[GhcEnvironmentFileEntry])
forall a b. (a -> b) -> a -> b
$ FilePath
"Packages requested to install already exist in environment file at " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
envFile FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
". Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " ((PackageName -> FilePath) -> [PackageName] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map PackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ([PackageName] -> [FilePath]) -> [PackageName] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Set PackageName -> [PackageName]
forall a. Set a -> [a]
S.toList Set PackageName
nameIntersection)
let installedPacks :: [(PackageName, [InstalledPackageInfo])]
installedPacks = InstalledPackageIndex -> [(PackageName, [InstalledPackageInfo])]
forall a. PackageIndex a -> [(PackageName, [a])]
PI.allPackagesByName InstalledPackageIndex
installedIndex
newEnvNames :: Set PackageName
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' :: InstalledPackageIndex
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
ProjectBaseContext
baseCtx <- Verbosity
-> ProjectConfig
-> DistDirLayout
-> [PackageSpecifier UnresolvedSourcePackage]
-> CurrentCommand
-> IO ProjectBaseContext
establishDummyProjectBaseContext
Verbosity
verbosity
ProjectConfig
config
DistDirLayout
distDirLayout
([PackageSpecifier UnresolvedSourcePackage]
envSpecs' [PackageSpecifier UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
forall a. [a] -> [a] -> [a]
++ [PackageSpecifier UnresolvedSourcePackage]
specs [PackageSpecifier UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
forall a. [a] -> [a] -> [a]
++ [PackageSpecifier UnresolvedSourcePackage]
uriSpecs)
CurrentCommand
InstallCommand
ProjectBuildContext
buildCtx <- Verbosity
-> ProjectBaseContext -> [TargetSelector] -> IO ProjectBuildContext
constructProjectBuildContext Verbosity
verbosity (ProjectBaseContext
baseCtx {installedPackages = Just installedIndex'}) [TargetSelector]
targetSelectors
Verbosity -> ProjectBaseContext -> ProjectBuildContext -> IO ()
printPlan Verbosity
verbosity ProjectBaseContext
baseCtx ProjectBuildContext
buildCtx
BuildOutcomes
buildOutcomes <- Verbosity
-> ProjectBaseContext -> ProjectBuildContext -> IO BuildOutcomes
runProjectBuildPhase Verbosity
verbosity ProjectBaseContext
baseCtx ProjectBuildContext
buildCtx
Verbosity
-> ProjectBaseContext
-> ProjectBuildContext
-> BuildOutcomes
-> IO ()
runProjectPostBuildPhase Verbosity
verbosity ProjectBaseContext
baseCtx ProjectBuildContext
buildCtx BuildOutcomes
buildOutcomes
let
dryRun :: Bool
dryRun = BuildTimeSettings -> Bool
buildSettingDryRun (ProjectBaseContext -> BuildTimeSettings
buildSettings ProjectBaseContext
baseCtx)
Bool -> Bool -> Bool
|| BuildTimeSettings -> Bool
buildSettingOnlyDownload (ProjectBaseContext -> BuildTimeSettings
buildSettings ProjectBaseContext
baseCtx)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
dryRun (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
if Bool
installLibs
then Verbosity
-> ProjectBuildContext
-> InstalledPackageIndex
-> Compiler
-> PackageDBStack
-> FilePath
-> [GhcEnvironmentFileEntry]
-> IO ()
installLibraries Verbosity
verbosity
ProjectBuildContext
buildCtx InstalledPackageIndex
installedIndex Compiler
compiler PackageDBStack
packageDbs FilePath
envFile [GhcEnvironmentFileEntry]
nonGlobalEnvEntries'
else Verbosity
-> ProjectBaseContext
-> ProjectBuildContext
-> Platform
-> Compiler
-> ConfigFlags
-> ClientInstallFlags
-> IO ()
installExes Verbosity
verbosity
ProjectBaseContext
baseCtx ProjectBuildContext
buildCtx Platform
platform Compiler
compiler ConfigFlags
configFlags ClientInstallFlags
clientInstallFlags
where
configFlags' :: ConfigFlags
configFlags' = ConfigFlags -> ConfigFlags
disableTestsBenchsByDefault 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
baseCliConfig :: ProjectConfig
baseCliConfig = GlobalFlags
-> NixStyleFlags ClientInstallFlags
-> ClientInstallFlags
-> ProjectConfig
forall a.
GlobalFlags
-> NixStyleFlags a -> ClientInstallFlags -> ProjectConfig
commandLineFlagsToProjectConfig
GlobalFlags
globalFlags
NixStyleFlags ClientInstallFlags
flags { configFlags = configFlags' }
ClientInstallFlags
clientInstallFlags'
cliConfig :: ProjectConfig
cliConfig = ProjectConfig -> [FilePath] -> ProjectConfig
addLocalConfigToTargets ProjectConfig
baseCliConfig [FilePath]
targetStrings
globalConfigFlag :: Flag FilePath
globalConfigFlag = ProjectConfigShared -> Flag FilePath
projectConfigConfigFile (ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
cliConfig)
addLocalConfigToTargets :: ProjectConfig -> [String] -> ProjectConfig
addLocalConfigToTargets :: ProjectConfig -> [FilePath] -> ProjectConfig
addLocalConfigToTargets ProjectConfig
config [FilePath]
targetStrings
= ProjectConfig
config {
projectConfigSpecificPackage = projectConfigSpecificPackage config
<> MapMappend (Map.fromList targetPackageConfigs)
}
where
localConfig :: PackageConfig
localConfig = ProjectConfig -> PackageConfig
projectConfigLocalPackages ProjectConfig
config
targetPackageConfigs :: [(PackageName, PackageConfig)]
targetPackageConfigs = (FilePath -> (PackageName, PackageConfig))
-> [FilePath] -> [(PackageName, PackageConfig)]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
x -> (FilePath -> PackageName
mkPackageName FilePath
x, PackageConfig
localConfig)) [FilePath]
targetStrings
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 -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"--enable-tests was specified, but tests can't "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"be enabled in a remote package"
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 -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"--enable-benchmarks was specified, but benchmarks can't "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"be enabled in a remote package"
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
savedConfig <- Verbosity -> Flag FilePath -> IO SavedConfig
loadConfig Verbosity
verbosity Flag FilePath
configFileFlag
ClientInstallFlags -> IO ClientInstallFlags
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientInstallFlags -> IO ClientInstallFlags)
-> ClientInstallFlags -> IO ClientInstallFlags
forall a b. (a -> b) -> a -> b
$ SavedConfig -> ClientInstallFlags
savedClientInstallFlags SavedConfig
savedConfig ClientInstallFlags -> ClientInstallFlags -> ClientInstallFlags
forall a. Monoid a => a -> a -> a
`mappend` ClientInstallFlags
existingClientInstallFlags
getSpecsAndTargetSelectors
:: Verbosity
-> Verbosity
-> SourcePackageDb
-> [TargetSelector]
-> DistDirLayout
-> ProjectBaseContext
-> Maybe ComponentKindFilter
-> IO ([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
getSpecsAndTargetSelectors :: Verbosity
-> Verbosity
-> SourcePackageDb
-> [TargetSelector]
-> DistDirLayout
-> ProjectBaseContext
-> Maybe ComponentKind
-> IO
([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
getSpecsAndTargetSelectors Verbosity
verbosity Verbosity
reducedVerbosity SourcePackageDb
pkgDb [TargetSelector]
targetSelectors DistDirLayout
localDistDirLayout ProjectBaseContext
localBaseCtx Maybe ComponentKind
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
localBaseCtx ((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
targets, [PackageName]
hackageNames) <-
Verbosity
-> SourcePackageDb
-> ElaboratedInstallPlan
-> [TargetSelector]
-> IO (TargetsMap, [PackageName])
partitionToKnownTargetsAndHackagePackages
Verbosity
verbosity SourcePackageDb
pkgDb ElaboratedInstallPlan
elaboratedPlan [TargetSelector]
targetSelectors
let
planMap :: Map
UnitId
(GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage)
planMap = ElaboratedInstallPlan
-> Map
UnitId
(GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage)
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg
-> Map UnitId (GenericPlanPackage ipkg srcpkg)
InstallPlan.toMap ElaboratedInstallPlan
elaboratedPlan
targetIds :: [UnitId]
targetIds = TargetsMap -> [UnitId]
forall k a. Map k a -> [k]
Map.keys TargetsMap
targets
sdistize :: PackageSpecifier (SourcePackage (PackageLocation local))
-> PackageSpecifier (SourcePackage (PackageLocation local))
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 -> PackageId -> FilePath
distSdistFile DistDirLayout
localDistDirLayout (SourcePackage (PackageLocation local) -> PackageId
forall pkg. Package pkg => pkg -> PackageId
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
local :: [PackageSpecifier UnresolvedSourcePackage]
local = 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
localBaseCtx
gatherTargets :: UnitId -> TargetSelector
gatherTargets :: UnitId -> TargetSelector
gatherTargets UnitId
targetId = PackageName -> Maybe ComponentKind -> TargetSelector
TargetPackageNamed PackageName
pkgName Maybe ComponentKind
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 :: PackageId -> Version
pkgName :: PackageId -> PackageName
pkgName :: PackageName
pkgVersion :: Version
..} = GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
-> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
targetUnit
targets' :: [TargetSelector]
targets' = (UnitId -> TargetSelector) -> [UnitId] -> [TargetSelector]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnitId -> TargetSelector
gatherTargets [UnitId]
targetIds
hackagePkgs :: [PackageSpecifier UnresolvedSourcePackage]
hackagePkgs :: [PackageSpecifier UnresolvedSourcePackage]
hackagePkgs = (PackageName
-> [PackageProperty] -> PackageSpecifier UnresolvedSourcePackage)
-> [PackageProperty]
-> PackageName
-> PackageSpecifier UnresolvedSourcePackage
forall a b c. (a -> b -> c) -> b -> a -> c
flip PackageName
-> [PackageProperty] -> PackageSpecifier UnresolvedSourcePackage
forall pkg.
PackageName -> [PackageProperty] -> PackageSpecifier pkg
NamedPackage [] (PackageName -> PackageSpecifier UnresolvedSourcePackage)
-> [PackageName] -> [PackageSpecifier UnresolvedSourcePackage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PackageName]
hackageNames
hackageTargets :: [TargetSelector]
hackageTargets :: [TargetSelector]
hackageTargets =
(PackageName -> Maybe ComponentKind -> TargetSelector)
-> Maybe ComponentKind -> PackageName -> TargetSelector
forall a b c. (a -> b -> c) -> b -> a -> c
flip PackageName -> Maybe ComponentKind -> TargetSelector
TargetPackageNamed Maybe ComponentKind
targetFilter (PackageName -> TargetSelector)
-> [PackageName] -> [TargetSelector]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PackageName]
hackageNames
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (DistDirLayout -> FilePath
distSdistDirectory DistDirLayout
localDistDirLayout)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TargetsMap -> Bool
forall k a. Map k a -> Bool
Map.null TargetsMap
targets) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [PackageSpecifier UnresolvedSourcePackage]
-> (PackageSpecifier UnresolvedSourcePackage -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (ProjectBaseContext -> [PackageSpecifier UnresolvedSourcePackage]
localPackages ProjectBaseContext
localBaseCtx) ((PackageSpecifier UnresolvedSourcePackage -> IO ()) -> IO ())
-> (PackageSpecifier UnresolvedSourcePackage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PackageSpecifier UnresolvedSourcePackage
lpkg -> case PackageSpecifier UnresolvedSourcePackage
lpkg of
SpecificSourcePackage UnresolvedSourcePackage
pkg -> Verbosity
-> FilePath
-> OutputFormat
-> FilePath
-> UnresolvedSourcePackage
-> IO ()
packageToSdist Verbosity
verbosity
(DistDirLayout -> FilePath
distProjectRootDirectory DistDirLayout
localDistDirLayout) OutputFormat
TarGzArchive
(DistDirLayout -> PackageId -> FilePath
distSdistFile DistDirLayout
localDistDirLayout (UnresolvedSourcePackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId UnresolvedSourcePackage
pkg)) UnresolvedSourcePackage
pkg
NamedPackage PackageName
pkgName [PackageProperty]
_ -> FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Got NamedPackage " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageName
pkgName
if TargetsMap -> Bool
forall a. Map UnitId a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null TargetsMap
targets
then ([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
-> IO
([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageSpecifier UnresolvedSourcePackage]
hackagePkgs, [TargetSelector]
hackageTargets)
else ([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
-> IO
([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageSpecifier UnresolvedSourcePackage]
local [PackageSpecifier UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
forall a. [a] -> [a] -> [a]
++ [PackageSpecifier UnresolvedSourcePackage]
hackagePkgs, [TargetSelector]
targets' [TargetSelector] -> [TargetSelector] -> [TargetSelector]
forall a. [a] -> [a] -> [a]
++ [TargetSelector]
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 -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ())
-> ([FilePath] -> FilePath) -> [FilePath] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$
[ FilePath
"Unknown package \"", PackageName -> FilePath
unPackageName PackageName
hn, FilePath
"\". "
, 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)
]
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 ComponentKind
_
| 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
TargetsMap
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'
(TargetsMap, [PackageName]) -> IO (TargetsMap, [PackageName])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TargetsMap
targets, [PackageName]
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
TargetsMap
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 :: ElaboratedInstallPlan
prunedToTargetsElaboratedPlan =
TargetAction
-> TargetsMap -> ElaboratedInstallPlan -> ElaboratedInstallPlan
pruneInstallPlanToTargets TargetAction
TargetActionBuild TargetsMap
targets ElaboratedInstallPlan
elaboratedPlan
ElaboratedInstallPlan
prunedElaboratedPlan <-
if BuildTimeSettings -> Bool
buildSettingOnlyDeps (ProjectBaseContext -> BuildTimeSettings
buildSettings ProjectBaseContext
baseCtx)
then (CannotPruneDependencies -> IO ElaboratedInstallPlan)
-> (ElaboratedInstallPlan -> IO ElaboratedInstallPlan)
-> Either CannotPruneDependencies ElaboratedInstallPlan
-> IO ElaboratedInstallPlan
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> CannotPruneDependencies -> IO ElaboratedInstallPlan
forall a. Verbosity -> CannotPruneDependencies -> IO a
reportCannotPruneDependencies Verbosity
verbosity) ElaboratedInstallPlan -> IO ElaboratedInstallPlan
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CannotPruneDependencies ElaboratedInstallPlan
-> IO ElaboratedInstallPlan)
-> Either CannotPruneDependencies ElaboratedInstallPlan
-> IO ElaboratedInstallPlan
forall a b. (a -> b) -> a -> b
$
Set UnitId
-> ElaboratedInstallPlan
-> Either CannotPruneDependencies ElaboratedInstallPlan
pruneInstallPlanToDependencies (TargetsMap -> Set UnitId
forall k a. Map k a -> Set k
Map.keysSet TargetsMap
targets)
ElaboratedInstallPlan
prunedToTargetsElaboratedPlan
else ElaboratedInstallPlan -> IO ElaboratedInstallPlan
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ElaboratedInstallPlan
prunedToTargetsElaboratedPlan
(ElaboratedInstallPlan, TargetsMap)
-> IO (ElaboratedInstallPlan, TargetsMap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElaboratedInstallPlan
prunedElaboratedPlan, TargetsMap
targets)
installExes
:: Verbosity
-> ProjectBaseContext
-> ProjectBuildContext
-> Platform
-> Compiler
-> ConfigFlags
-> ClientInstallFlags
-> IO ()
installExes :: Verbosity
-> ProjectBaseContext
-> ProjectBuildContext
-> Platform
-> Compiler
-> ConfigFlags
-> ClientInstallFlags
-> IO ()
installExes Verbosity
verbosity ProjectBaseContext
baseCtx ProjectBuildContext
buildCtx Platform
platform Compiler
compiler
ConfigFlags
configFlags ClientInstallFlags
clientInstallFlags = do
FilePath
installPath <- IO FilePath
defaultInstallPath
let storeDirLayout :: StoreDirLayout
storeDirLayout = CabalDirLayout -> StoreDirLayout
cabalStoreDirLayout (CabalDirLayout -> StoreDirLayout)
-> CabalDirLayout -> StoreDirLayout
forall a b. (a -> b) -> a -> b
$ ProjectBaseContext -> CabalDirLayout
cabalDirLayout ProjectBaseContext
baseCtx
prefix :: FilePath
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
configFlags))
suffix :: FilePath
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
configFlags))
mkUnitBinDir :: UnitId -> FilePath
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 -> CompilerId -> UnitId -> InstallDirs FilePath
storePackageInstallDirs' StoreDirLayout
storeDirLayout (Compiler -> CompilerId
compilerId Compiler
compiler)
mkExeName :: UnqualComponentName -> FilePath
mkExeName :: UnqualComponentName -> FilePath
mkExeName UnqualComponentName
exe = UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
exe FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
platform
mkFinalExeName :: UnqualComponentName -> FilePath
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
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
FilePath
installdir <- IO FilePath -> Flag (IO FilePath) -> IO FilePath
forall a. a -> Flag a -> a
fromFlagOrDefault
(Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity FilePath
installdirUnknown IO () -> IO FilePath -> IO FilePath
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
installPath) (Flag (IO FilePath) -> IO FilePath)
-> Flag (IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$
FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> Flag FilePath -> Flag (IO FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientInstallFlags -> Flag FilePath
cinstInstalldir ClientInstallFlags
clientInstallFlags
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
installdir
Verbosity -> ProjectBuildContext -> IO ()
warnIfNoExes Verbosity
verbosity ProjectBuildContext
buildCtx
InstallMethod
installMethod <- IO InstallMethod
-> (InstallMethod -> IO InstallMethod)
-> Flag InstallMethod
-> IO InstallMethod
forall b a. b -> (a -> b) -> Flag a -> b
flagElim IO InstallMethod
defaultMethod InstallMethod -> IO InstallMethod
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Flag InstallMethod -> IO InstallMethod)
-> Flag InstallMethod -> IO InstallMethod
forall a b. (a -> b) -> a -> b
$
ClientInstallFlags -> Flag InstallMethod
cinstInstallMethod ClientInstallFlags
clientInstallFlags
let
doInstall :: (UnitId, [(ComponentTarget, NonEmpty TargetSelector)]) -> IO ()
doInstall = Verbosity
-> OverwritePolicy
-> (UnitId -> FilePath)
-> (UnqualComponentName -> FilePath)
-> (UnqualComponentName -> FilePath)
-> FilePath
-> InstallMethod
-> (UnitId, [(ComponentTarget, NonEmpty TargetSelector)])
-> IO ()
installUnitExes
Verbosity
verbosity
OverwritePolicy
overwritePolicy
UnitId -> FilePath
mkUnitBinDir UnqualComponentName -> FilePath
mkExeName UnqualComponentName -> FilePath
mkFinalExeName
FilePath
installdir InstallMethod
installMethod
in ((UnitId, [(ComponentTarget, NonEmpty TargetSelector)]) -> IO ())
-> [(UnitId, [(ComponentTarget, NonEmpty TargetSelector)])]
-> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (UnitId, [(ComponentTarget, NonEmpty TargetSelector)]) -> IO ()
doInstall ([(UnitId, [(ComponentTarget, NonEmpty TargetSelector)])] -> IO ())
-> [(UnitId, [(ComponentTarget, NonEmpty TargetSelector)])]
-> IO ()
forall a b. (a -> b) -> a -> b
$ TargetsMap
-> [(UnitId, [(ComponentTarget, NonEmpty TargetSelector)])]
forall k a. Map k a -> [(k, a)]
Map.toList (TargetsMap
-> [(UnitId, [(ComponentTarget, NonEmpty TargetSelector)])])
-> TargetsMap
-> [(UnitId, [(ComponentTarget, NonEmpty TargetSelector)])]
forall a b. (a -> b) -> a -> b
$ ProjectBuildContext -> TargetsMap
targetsMap ProjectBuildContext
buildCtx
where
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
clientInstallFlags
isWindows :: Bool
isWindows = OS
buildOS OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
Windows
defaultMethod :: IO InstallMethod
defaultMethod :: IO InstallMethod
defaultMethod
| Bool
isWindows = do
Bool
symlinks <- Verbosity -> IO Bool
trySymlink Verbosity
verbosity
InstallMethod -> IO InstallMethod
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstallMethod -> IO InstallMethod)
-> InstallMethod -> IO InstallMethod
forall a b. (a -> b) -> a -> b
$ if Bool
symlinks then InstallMethod
InstallMethodSymlink else InstallMethod
InstallMethodCopy
| Bool
otherwise = InstallMethod -> IO InstallMethod
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InstallMethod
InstallMethodSymlink
installLibraries
:: Verbosity
-> ProjectBuildContext
-> PI.PackageIndex InstalledPackageInfo
-> Compiler
-> PackageDBStack
-> FilePath
-> [GhcEnvironmentFileEntry]
-> IO ()
installLibraries :: Verbosity
-> ProjectBuildContext
-> InstalledPackageIndex
-> Compiler
-> PackageDBStack
-> FilePath
-> [GhcEnvironmentFileEntry]
-> IO ()
installLibraries Verbosity
verbosity ProjectBuildContext
buildCtx InstalledPackageIndex
installedIndex Compiler
compiler
PackageDBStack
packageDbs' FilePath
envFile [GhcEnvironmentFileEntry]
envEntries = 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
PackageDBStack
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 :: PackageName -> [InstalledPackageInfo]
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]
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 :: [GhcEnvironmentFileEntry]
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]
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]
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' :: FilePath
contents' = [GhcEnvironmentFileEntry] -> FilePath
renderGhcEnvironmentFile ([GhcEnvironmentFileEntry]
baseEntries [GhcEnvironmentFileEntry]
-> [GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry]
forall a. [a] -> [a] -> [a]
++ [GhcEnvironmentFileEntry]
pkgEntries)
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
envFile)
FilePath -> ByteString -> IO ()
writeFileAtomic FilePath
envFile (FilePath -> ByteString
BS.pack FilePath
contents')
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 {pkg}. [PackageSpecifier pkg]
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 -> PackageId
sourcePackageId = PackageIdentifier{Version
PackageName
pkgVersion :: PackageId -> Version
pkgName :: PackageId -> 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 }
installUnitExes
:: Verbosity
-> OverwritePolicy
-> (UnitId -> FilePath)
-> (UnqualComponentName -> FilePath)
-> (UnqualComponentName -> FilePath)
-> FilePath
-> InstallMethod
-> ( UnitId
, [(ComponentTarget, NonEmpty TargetSelector)] )
-> IO ()
installUnitExes :: Verbosity
-> OverwritePolicy
-> (UnitId -> FilePath)
-> (UnqualComponentName -> FilePath)
-> (UnqualComponentName -> FilePath)
-> FilePath
-> InstallMethod
-> (UnitId, [(ComponentTarget, NonEmpty TargetSelector)])
-> IO ()
installUnitExes Verbosity
verbosity OverwritePolicy
overwritePolicy
UnitId -> FilePath
mkSourceBinDir UnqualComponentName -> FilePath
mkExeName UnqualComponentName -> FilePath
mkFinalExeName
FilePath
installdir InstallMethod
installMethod
(UnitId
unit, [(ComponentTarget, NonEmpty TargetSelector)]
components) =
(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
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
installAndWarn :: UnqualComponentName -> IO ()
installAndWarn UnqualComponentName
exe = do
Bool
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
let errorMessage :: FilePath
errorMessage = case OverwritePolicy
overwritePolicy of
OverwritePolicy
NeverOverwrite ->
FilePath
"Path '" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (FilePath
installdir FilePath -> FilePath -> FilePath
</> UnqualComponentName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow UnqualComponentName
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
<> UnqualComponentName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow UnqualComponentName
exe FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"' failed."
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
success (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity FilePath
errorMessage
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
"'"
OverwritePolicy
-> FilePath -> FilePath -> FilePath -> FilePath -> IO Bool
symlinkBinary
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
"'"
Bool
exists <- FilePath -> IO Bool
doesPathExist FilePath
destination
case (Bool
exists, OverwritePolicy
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
Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
destination
if Bool
isDir
then FilePath -> IO ()
removeDirectory FilePath
destination
else FilePath -> IO ()
removeFile FilePath
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 FilePath
getEnvFile :: ClientInstallFlags -> Platform -> Version -> IO FilePath
getEnvFile ClientInstallFlags
clientInstallFlags Platform
platform Version
compilerVersion = do
FilePath
appDir <- IO FilePath
getGhcAppDir
case Flag FilePath -> Maybe FilePath
forall a. Flag a -> Maybe a
flagToMaybe (ClientInstallFlags -> Flag FilePath
cinstEnvironmentPath ClientInstallFlags
clientInstallFlags) of
Just FilePath
spec
| FilePath -> FilePath
takeBaseName FilePath
spec FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
spec ->
FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Platform -> Version -> FilePath -> FilePath
getGlobalEnv FilePath
appDir Platform
platform Version
compilerVersion FilePath
spec)
| Bool
otherwise -> do
FilePath
spec' <- FilePath -> IO FilePath
makeAbsolute FilePath
spec
Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
spec'
if Bool
isDir
then FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Platform -> Version -> FilePath
getLocalEnv FilePath
spec' Platform
platform Version
compilerVersion)
else FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
spec'
Maybe FilePath
Nothing ->
FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Platform -> Version -> FilePath -> FilePath
getGlobalEnv FilePath
appDir Platform
platform Version
compilerVersion FilePath
"default")
getExistingEnvEntries :: Verbosity -> CompilerFlavor -> Bool -> FilePath -> IO [GhcEnvironmentFileEntry]
getExistingEnvEntries :: Verbosity
-> CompilerFlavor
-> Bool
-> FilePath
-> IO [GhcEnvironmentFileEntry]
getExistingEnvEntries Verbosity
verbosity CompilerFlavor
compilerFlavor Bool
supportsPkgEnvFiles FilePath
envFile = do
Bool
envFileExists <- FilePath -> IO Bool
doesFileExist FilePath
envFile
[GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry]
filterEnvEntries ([GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry])
-> IO [GhcEnvironmentFileEntry] -> IO [GhcEnvironmentFileEntry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if
(CompilerFlavor
compilerFlavor CompilerFlavor -> CompilerFlavor -> Bool
forall a. Eq a => a -> a -> Bool
== CompilerFlavor
GHC Bool -> Bool -> Bool
|| CompilerFlavor
compilerFlavor CompilerFlavor -> CompilerFlavor -> Bool
forall a. Eq a => a -> a -> Bool
== CompilerFlavor
GHCJS)
Bool -> Bool -> Bool
&& Bool
supportsPkgEnvFiles Bool -> Bool -> Bool
&& Bool
envFileExists
then IO [GhcEnvironmentFileEntry]
-> (ParseErrorExc -> IO [GhcEnvironmentFileEntry])
-> IO [GhcEnvironmentFileEntry]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (FilePath -> IO [GhcEnvironmentFileEntry]
readGhcEnvironmentFile FilePath
envFile) ((ParseErrorExc -> IO [GhcEnvironmentFileEntry])
-> IO [GhcEnvironmentFileEntry])
-> (ParseErrorExc -> IO [GhcEnvironmentFileEntry])
-> IO [GhcEnvironmentFileEntry]
forall a b. (a -> b) -> a -> b
$ \(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 [GhcEnvironmentFileEntry] -> IO [GhcEnvironmentFileEntry]
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [GhcEnvironmentFileEntry] -> IO [GhcEnvironmentFileEntry]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else [GhcEnvironmentFileEntry] -> IO [GhcEnvironmentFileEntry]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
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
:: CompilerId
-> Flag FilePath
-> Flag FilePath
-> IO PackageDBStack
getPackageDbStack :: CompilerId -> Flag FilePath -> Flag FilePath -> IO PackageDBStack
getPackageDbStack CompilerId
compilerId Flag FilePath
storeDirFlag Flag FilePath
logsDirFlag = do
Maybe FilePath
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 :: Maybe FilePath
mlogsDir = Flag FilePath -> Maybe FilePath
forall a. Flag a -> Maybe a
flagToMaybe Flag FilePath
logsDirFlag
CabalDirLayout
cabalLayout <- Maybe FilePath -> Maybe FilePath -> IO CabalDirLayout
mkCabalDirLayout Maybe FilePath
mstoreDir Maybe FilePath
mlogsDir
PackageDBStack -> IO PackageDBStack
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageDBStack -> IO PackageDBStack)
-> PackageDBStack -> IO PackageDBStack
forall a b. (a -> b) -> a -> b
$ StoreDirLayout -> CompilerId -> PackageDBStack
storePackageDBStack (CabalDirLayout -> StoreDirLayout
cabalStoreDirLayout CabalDirLayout
cabalLayout) CompilerId
compilerId
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
_ [PackageId]
_ Maybe ComponentKind
Nothing) TargetRequested
TargetNotRequestedByDefault = Bool
False
buildable (TargetAllPackages Maybe ComponentKind
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 -> FilePath -> IO a
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO a)
-> (CannotPruneDependencies -> FilePath)
-> CannotPruneDependencies
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CannotPruneDependencies -> FilePath
renderCannotPruneDependencies