{-# 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(..) )
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(..)
, getMapLast, getMapMappend, projectConfigLogsDir
, projectConfigStoreDir, projectConfigBuildOnly
, projectConfigConfigFile )
import Distribution.Simple.Program.Db
( userSpecifyPaths, userSpecifyArgss, defaultProgramDb
, modifyProgramSearchPath, ProgramDb )
import Distribution.Simple.BuildPaths
( exeExtension )
import Distribution.Simple.Program.Find
( ProgramSearchPathEntry(..) )
import Distribution.Client.Config
( defaultInstallPath, getCabalDir, 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(..) )
import Distribution.Solver.Types.SourcePackage
( SourcePackage(..) )
import Distribution.Simple.Command
( CommandUI(..), usageAlternatives )
import Distribution.Simple.Configure
( configCompilerEx )
import Distribution.Simple.Compiler
( Compiler(..), CompilerId(..), CompilerFlavor(..)
, PackageDBStack )
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 )
import Distribution.Utils.Generic
( safeHead, writeFileAtomic )
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Ord
( Down(..) )
import qualified Data.Map as Map
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 :: forall flags.
String
-> String
-> (String -> String)
-> Maybe (String -> String)
-> Maybe (String -> String)
-> flags
-> (ShowOrParseArgs -> [OptionField flags])
-> CommandUI flags
CommandUI
{ commandName :: String
commandName = String
"v2-install"
, commandSynopsis :: String
commandSynopsis = String
"Install packages."
, commandUsage :: String -> String
commandUsage = String -> [String] -> String -> String
usageAlternatives
String
"v2-install" [ String
"[TARGETS] [FLAGS]" ]
, commandDescription :: Maybe (String -> String)
commandDescription = (String -> String) -> Maybe (String -> String)
forall a. a -> Maybe a
Just ((String -> String) -> Maybe (String -> String))
-> (String -> String) -> Maybe (String -> String)
forall a b. (a -> b) -> a -> b
$ \String
_ -> String -> String
wrapText (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
String
"Installs one or more packages. This is done by installing them "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"in the store and symlinking/copying the executables in the directory "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"specified by the --installdir flag (`~/.cabal/bin/` by default). "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"If you want the installed executables to be available globally, "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"make sure that the PATH environment variable contains that directory. "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"If TARGET is a library and --lib (provisional) is used, "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"it will be added to the global environment. "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"When doing this, cabal will try to build a plan that includes all "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"the previously installed libraries. This is currently not implemented."
, commandNotes :: Maybe (String -> String)
commandNotes = (String -> String) -> Maybe (String -> String)
forall a. a -> Maybe a
Just ((String -> String) -> Maybe (String -> String))
-> (String -> String) -> Maybe (String -> String)
forall a b. (a -> b) -> a -> b
$ \String
pname ->
String
"Examples:\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" v2-install\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Install the package in the current directory\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" v2-install pkgname\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Install the package named pkgname"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (fetching it from hackage if necessary)\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" v2-install ./pkgfoo\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Install the package in the ./pkgfoo directory\n"
, commandOptions :: ShowOrParseArgs -> [OptionField (NixStyleFlags ClientInstallFlags)]
commandOptions = (ShowOrParseArgs -> [OptionField ClientInstallFlags])
-> ShowOrParseArgs
-> [OptionField (NixStyleFlags ClientInstallFlags)]
forall a.
(ShowOrParseArgs -> [OptionField a])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags a)]
nixStyleOptions ShowOrParseArgs -> [OptionField ClientInstallFlags]
clientInstallOptions
, commandDefaultFlags :: NixStyleFlags ClientInstallFlags
commandDefaultFlags = ClientInstallFlags -> NixStyleFlags ClientInstallFlags
forall a. a -> NixStyleFlags a
defaultNixStyleFlags ClientInstallFlags
defaultClientInstallFlags
}
installAction :: NixStyleFlags ClientInstallFlags -> [String] -> GlobalFlags -> IO ()
installAction :: NixStyleFlags ClientInstallFlags
-> [String] -> GlobalFlags -> IO ()
installAction flags :: NixStyleFlags ClientInstallFlags
flags@NixStyleFlags { extraFlags :: forall a. NixStyleFlags a -> a
extraFlags = ClientInstallFlags
clientInstallFlags', ConfigFlags
HaddockFlags
TestFlags
BenchmarkFlags
ProjectFlags
InstallFlags
ConfigExFlags
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
projectFlags :: ProjectFlags
benchmarkFlags :: BenchmarkFlags
testFlags :: TestFlags
haddockFlags :: HaddockFlags
installFlags :: InstallFlags
configExFlags :: ConfigExFlags
configFlags :: ConfigFlags
.. } [String]
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' :: [String]
targetStrings' = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
targetStrings then [String
"."] else [String]
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
([String]
targetStrings'', [PackageId]
packageIds) =
[Either String PackageId] -> ([String], [PackageId])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either String PackageId] -> ([String], [PackageId]))
-> ((String -> Either String PackageId)
-> [Either String PackageId])
-> (String -> Either String PackageId)
-> ([String], [PackageId])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((String -> Either String PackageId)
-> [String] -> [Either String PackageId])
-> [String]
-> (String -> Either String PackageId)
-> [Either String PackageId]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> Either String PackageId)
-> [String] -> [Either String PackageId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String]
targetStrings' ((String -> Either String PackageId) -> ([String], [PackageId]))
-> (String -> Either String PackageId) -> ([String], [PackageId])
forall a b. (a -> b) -> a -> b
$
\String
str -> case String -> Maybe PackageId
forall a. Parsec a => String -> Maybe a
simpleParsec String
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 String PackageId
forall a b. b -> Either a b
Right PackageId
pkgId
Maybe PackageId
_ -> String -> Either String PackageId
forall a b. a -> Either a b
Left String
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 (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{PackageName
Version
pkgName :: PackageId -> PackageName
pkgVersion :: Version
pkgName :: PackageName
pkgVersion :: PackageId -> Version
..}
| 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 [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
targetStrings'
then ([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
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 (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
-> [String]
-> IO (Either [TargetSelectorProblem] [TargetSelector])
forall a.
[PackageSpecifier (SourcePackage (PackageLocation a))]
-> Maybe ComponentKind
-> [String]
-> IO (Either [TargetSelectorProblem] [TargetSelector])
readTargetSelectors (ProjectBaseContext -> [PackageSpecifier UnresolvedSourcePackage]
localPackages ProjectBaseContext
localBaseCtx)
Maybe ComponentKind
forall a. Maybe a
Nothing [String]
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 (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 pkg], [URI], [TargetSelector], ProjectConfig)
withoutProject :: ProjectConfig
-> IO
([PackageSpecifier pkg], [URI], [TargetSelector], ProjectConfig)
withoutProject ProjectConfig
globalConfig = do
[WithoutProjectTargetSelector]
tss <- (String -> IO WithoutProjectTargetSelector)
-> [String] -> IO [WithoutProjectTargetSelector]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Verbosity -> String -> IO WithoutProjectTargetSelector
parseWithoutProjectTargetSelector Verbosity
verbosity) [String]
targetStrings'
String
cabalDir <- IO String
getCabalDir
let
projectConfig :: ProjectConfig
projectConfig = ProjectConfig
globalConfig ProjectConfig -> ProjectConfig -> ProjectConfig
forall a. Semigroup a => a -> a -> a
<> ProjectConfig
cliConfig
ProjectConfigBuildOnly {
Flag String
projectConfigLogsDir :: Flag String
projectConfigLogsDir :: ProjectConfigBuildOnly -> Flag String
projectConfigLogsDir
} = ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly ProjectConfig
projectConfig
ProjectConfigShared {
Flag String
projectConfigStoreDir :: Flag String
projectConfigStoreDir :: ProjectConfigShared -> Flag String
projectConfigStoreDir
} = ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
projectConfig
mlogsDir :: Maybe String
mlogsDir = Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe Flag String
projectConfigLogsDir
mstoreDir :: Maybe String
mstoreDir = Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe Flag String
projectConfigStoreDir
cabalDirLayout :: CabalDirLayout
cabalDirLayout = String -> Maybe String -> Maybe String -> CabalDirLayout
mkCabalDirLayout String
cabalDir Maybe String
mstoreDir Maybe String
mlogsDir
buildSettings :: BuildTimeSettings
buildSettings = Verbosity -> CabalDirLayout -> ProjectConfig -> BuildTimeSettings
resolveBuildTimeSettings
Verbosity
verbosity CabalDirLayout
cabalDirLayout
ProjectConfig
projectConfig
SourcePackageDb { PackageIndex UnresolvedSourcePackage
packageIndex :: SourcePackageDb -> PackageIndex UnresolvedSourcePackage
packageIndex :: 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 (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
-> String -> [(PackageName, [UnresolvedSourcePackage])]
forall pkg. PackageIndex pkg -> String -> [(PackageName, [pkg])]
searchByName PackageIndex UnresolvedSourcePackage
packageIndex (PackageName -> String
unPackageName PackageName
name)
let emptyIf :: Bool -> [a] -> [a]
emptyIf Bool
True [a]
_ = []
emptyIf Bool
False [a]
zs = [a]
zs
Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
[ String
"Unknown package \"", PackageName -> String
unPackageName PackageName
name, String
"\". "
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Bool -> [String] -> [String]
forall a. Bool -> [a] -> [a]
emptyIf ([(PackageName, [UnresolvedSourcePackage])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PackageName, [UnresolvedSourcePackage])]
xs)
[ String
"Did you mean any of the following?\n"
, [String] -> String
unlines ((String
"- " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> ((PackageName, [UnresolvedSourcePackage]) -> String)
-> (PackageName, [UnresolvedSourcePackage])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
unPackageName (PackageName -> String)
-> ((PackageName, [UnresolvedSourcePackage]) -> PackageName)
-> (PackageName, [UnresolvedSourcePackage])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageName, [UnresolvedSourcePackage]) -> PackageName
forall a b. (a, b) -> a
fst ((PackageName, [UnresolvedSourcePackage]) -> String)
-> [(PackageName, [UnresolvedSourcePackage])] -> [String]
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 pkg], [URI], [TargetSelector], ProjectConfig)
-> IO
([PackageSpecifier pkg], [URI], [TargetSelector], ProjectConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageSpecifier pkg]
forall pkg. [PackageSpecifier pkg]
packageSpecifiers, [URI]
uris, [TargetSelector]
packageTargets, ProjectConfig
projectConfig)
([PackageSpecifier UnresolvedSourcePackage]
specs, [URI]
uris, [TargetSelector]
targetSelectors, ProjectConfig
config) <-
Verbosity
-> Flag Bool
-> Flag String
-> 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 String
-> IO a
-> (ProjectConfig -> IO a)
-> IO a
withProjectOrGlobalConfig Verbosity
verbosity Flag Bool
ignoreProject Flag String
globalConfigFlag IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
withProject ProjectConfig
-> IO
([PackageSpecifier UnresolvedSourcePackage], [URI],
[TargetSelector], ProjectConfig)
forall pkg.
ProjectConfig
-> IO
([PackageSpecifier pkg], [URI], [TargetSelector], ProjectConfig)
withoutProject
let
ProjectConfig {
projectConfigBuildOnly :: ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly = ProjectConfigBuildOnly {
Flag String
projectConfigLogsDir :: Flag String
projectConfigLogsDir :: ProjectConfigBuildOnly -> Flag String
projectConfigLogsDir
},
projectConfigShared :: ProjectConfig -> ProjectConfigShared
projectConfigShared = ProjectConfigShared {
Flag CompilerFlavor
projectConfigHcFlavor :: ProjectConfigShared -> Flag CompilerFlavor
projectConfigHcFlavor :: Flag CompilerFlavor
projectConfigHcFlavor,
Flag String
projectConfigHcPath :: ProjectConfigShared -> Flag String
projectConfigHcPath :: Flag String
projectConfigHcPath,
Flag String
projectConfigHcPkg :: ProjectConfigShared -> Flag String
projectConfigHcPkg :: Flag String
projectConfigHcPkg,
Flag String
projectConfigStoreDir :: Flag String
projectConfigStoreDir :: ProjectConfigShared -> Flag String
projectConfigStoreDir
},
projectConfigLocalPackages :: ProjectConfig -> PackageConfig
projectConfigLocalPackages = PackageConfig {
MapLast String String
packageConfigProgramPaths :: PackageConfig -> MapLast String String
packageConfigProgramPaths :: MapLast String String
packageConfigProgramPaths,
MapMappend String [String]
packageConfigProgramArgs :: PackageConfig -> MapMappend String [String]
packageConfigProgramArgs :: MapMappend String [String]
packageConfigProgramArgs,
NubList String
packageConfigProgramPathExtra :: PackageConfig -> NubList String
packageConfigProgramPathExtra :: NubList String
packageConfigProgramPathExtra
}
} = ProjectConfig
config
hcFlavor :: Maybe CompilerFlavor
hcFlavor = Flag CompilerFlavor -> Maybe CompilerFlavor
forall a. Flag a -> Maybe a
flagToMaybe Flag CompilerFlavor
projectConfigHcFlavor
hcPath :: Maybe String
hcPath = Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe Flag String
projectConfigHcPath
hcPkg :: Maybe String
hcPkg = Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe Flag String
projectConfigHcPkg
preProgDb :: ProgramDb
preProgDb =
[(String, String)] -> ProgramDb -> ProgramDb
userSpecifyPaths (Map String String -> [(String, String)]
forall k a. Map k a -> [(k, a)]
Map.toList (MapLast String String -> Map String String
forall k v. MapLast k v -> Map k v
getMapLast MapLast String String
packageConfigProgramPaths))
(ProgramDb -> ProgramDb)
-> (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, [String])] -> ProgramDb -> ProgramDb
userSpecifyArgss (Map String [String] -> [(String, [String])]
forall k a. Map k a -> [(k, a)]
Map.toList (MapMappend String [String] -> Map String [String]
forall k v. MapMappend k v -> Map k v
getMapMappend MapMappend String [String]
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]
++ [ String -> ProgramSearchPathEntry
ProgramSearchPathDir String
dir
| String
dir <- NubList String -> [String]
forall a. NubList a -> [a]
fromNubList NubList String
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 String
-> Maybe String
-> ProgramDb
-> Verbosity
-> IO (Compiler, Platform, ProgramDb)
configCompilerEx Maybe CompilerFlavor
hcFlavor Maybe String
hcPath Maybe String
hcPkg ProgramDb
preProgDb Verbosity
verbosity
let
GhcImplInfo{ Bool
supportsPkgEnvFiles :: GhcImplInfo -> Bool
supportsPkgEnvFiles :: Bool
supportsPkgEnvFiles } = Compiler -> GhcImplInfo
getImplInfo Compiler
compiler
String
envFile <- ClientInstallFlags -> Platform -> Version -> IO String
getEnvFile ClientInstallFlags
clientInstallFlags Platform
platform Version
compilerVersion
[GhcEnvironmentFileEntry]
existingEnvEntries <-
Verbosity
-> CompilerFlavor -> Bool -> String -> IO [GhcEnvironmentFileEntry]
getExistingEnvEntries Verbosity
verbosity CompilerFlavor
compilerFlavor Bool
supportsPkgEnvFiles String
envFile
PackageDBStack
packageDbs <- CompilerId -> Flag String -> Flag String -> IO PackageDBStack
getPackageDbStack CompilerId
compilerId Flag String
projectConfigStoreDir Flag String
projectConfigLogsDir
InstalledPackageIndex
installedIndex <- Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
compiler PackageDBStack
packageDbs ProgramDb
progDb
let
([PackageSpecifier a]
envSpecs, [GhcEnvironmentFileEntry]
nonGlobalEnvEntries) =
InstalledPackageIndex
-> [GhcEnvironmentFileEntry]
-> Bool
-> ([PackageSpecifier a], [GhcEnvironmentFileEntry])
forall a.
InstalledPackageIndex
-> [GhcEnvironmentFileEntry]
-> Bool
-> ([PackageSpecifier a], [GhcEnvironmentFileEntry])
getEnvSpecsAndNonGlobalEntries InstalledPackageIndex
installedIndex [GhcEnvironmentFileEntry]
existingEnvEntries Bool
installLibs
String
globalTmp <- IO String
getTemporaryDirectory
Verbosity -> String -> String -> (String -> IO ()) -> IO ()
forall a. Verbosity -> String -> String -> (String -> IO a) -> IO a
withTempDirectory Verbosity
verbosity String
globalTmp String
"cabal-install." ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
tmpDir -> do
DistDirLayout
distDirLayout <- Verbosity -> ProjectConfig -> String -> IO DistDirLayout
establishDummyDistDirLayout Verbosity
verbosity ProjectConfig
config String
tmpDir
[PackageSpecifier UnresolvedSourcePackage]
uriSpecs <- String
-> Rebuild [PackageSpecifier UnresolvedSourcePackage]
-> IO [PackageSpecifier UnresolvedSourcePackage]
forall a. String -> Rebuild a -> IO a
runRebuild String
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 ]
ProjectBaseContext
baseCtx <- Verbosity
-> ProjectConfig
-> DistDirLayout
-> [PackageSpecifier UnresolvedSourcePackage]
-> CurrentCommand
-> IO ProjectBaseContext
establishDummyProjectBaseContext
Verbosity
verbosity
ProjectConfig
config
DistDirLayout
distDirLayout
([PackageSpecifier UnresolvedSourcePackage]
forall pkg. [PackageSpecifier pkg]
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 [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
-> Compiler
-> PackageDBStack
-> ProgramDb
-> String
-> [GhcEnvironmentFileEntry]
-> IO ()
installLibraries Verbosity
verbosity
ProjectBuildContext
buildCtx Compiler
compiler PackageDBStack
packageDbs ProgramDb
progDb String
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
cliConfig :: ProjectConfig
cliConfig = GlobalFlags
-> NixStyleFlags ClientInstallFlags
-> ClientInstallFlags
-> ProjectConfig
forall a.
GlobalFlags
-> NixStyleFlags a -> ClientInstallFlags -> ProjectConfig
commandLineFlagsToProjectConfig
GlobalFlags
globalFlags
NixStyleFlags ClientInstallFlags
flags { configFlags :: ConfigFlags
configFlags = ConfigFlags
configFlags' }
ClientInstallFlags
clientInstallFlags'
globalConfigFlag :: Flag String
globalConfigFlag = ProjectConfigShared -> Flag String
projectConfigConfigFile (ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
cliConfig)
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 -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"--enable-tests was specified, but tests can't "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"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 -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"--enable-benchmarks was specified, but benchmarks can't "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"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 String
configFileFlag = GlobalFlags -> Flag String
globalConfigFile GlobalFlags
globalFlags
SavedConfig
savedConfig <- Verbosity -> Flag String -> IO SavedConfig
loadConfig Verbosity
verbosity Flag String
configFileFlag
ClientInstallFlags -> IO ClientInstallFlags
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 :: String
sdistPath = DistDirLayout -> PackageId -> String
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 :: PackageLocation local
srcpkgSource = String -> PackageLocation local
forall local. String -> PackageLocation local
LocalTarballPackage String
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 (String
-> GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage
forall a. HasCallStack => String -> a
error String
"cannot find target unit") UnitId
targetId Map
UnitId
(GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage)
planMap
PackageIdentifier{PackageName
Version
pkgVersion :: Version
pkgName :: PackageName
pkgName :: PackageId -> PackageName
pkgVersion :: PackageId -> Version
..} = GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
-> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
targetUnit
targets' :: [TargetSelector]
targets' = (UnitId -> TargetSelector) -> [UnitId] -> [TargetSelector]
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 -> String -> IO ()
createDirectoryIfMissing Bool
True (DistDirLayout -> String
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
-> String
-> OutputFormat
-> String
-> UnresolvedSourcePackage
-> IO ()
packageToSdist Verbosity
verbosity
(DistDirLayout -> String
distProjectRootDirectory DistDirLayout
localDistDirLayout) OutputFormat
TarGzArchive
(DistDirLayout -> PackageId -> String
distSdistFile DistDirLayout
localDistDirLayout (UnresolvedSourcePackage -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId UnresolvedSourcePackage
pkg)) UnresolvedSourcePackage
pkg
NamedPackage PackageName
pkgName [PackageProperty]
_ -> String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Got NamedPackage " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow PackageName
pkgName
if TargetsMap -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null TargetsMap
targets
then ([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
-> IO
([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageSpecifier UnresolvedSourcePackage]
hackagePkgs, [TargetSelector]
hackageTargets)
else ([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
-> IO
([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
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
forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem Void) [k]
selectPackageTargets
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 (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 (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
-> String -> [(PackageName, [UnresolvedSourcePackage])]
forall pkg. PackageIndex pkg -> String -> [(PackageName, [pkg])]
searchByName (SourcePackageDb -> PackageIndex UnresolvedSourcePackage
packageIndex SourcePackageDb
pkgDb) (PackageName -> String
unPackageName PackageName
hn) of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[(PackageName, [UnresolvedSourcePackage])]
xs -> Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
[ String
"Unknown package \"", PackageName -> String
unPackageName PackageName
hn, String
"\". "
, String
"Did you mean any of the following?\n"
, [String] -> String
unlines ((String
"- " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> ((PackageName, [UnresolvedSourcePackage]) -> String)
-> (PackageName, [UnresolvedSourcePackage])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
unPackageName (PackageName -> String)
-> ((PackageName, [UnresolvedSourcePackage]) -> PackageName)
-> (PackageName, [UnresolvedSourcePackage])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageName, [UnresolvedSourcePackage]) -> PackageName
forall a b. (a, b) -> a
fst ((PackageName, [UnresolvedSourcePackage]) -> String)
-> [(PackageName, [UnresolvedSourcePackage])] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PackageName, [UnresolvedSourcePackage])]
xs)
]
TargetProblem Void
_ -> () -> IO ()
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 (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 (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 (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 (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
forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem Void) [k]
selectPackageTargets
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 (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 (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
forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem Void) [k]
selectPackageTargets
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 (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 (m :: * -> *) a. Monad m => a -> m a
return ElaboratedInstallPlan
prunedToTargetsElaboratedPlan
(ElaboratedInstallPlan, TargetsMap)
-> IO (ElaboratedInstallPlan, TargetsMap)
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
String
installPath <- IO String
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 :: String
prefix = String -> Flag String -> String
forall a. a -> Flag a -> a
fromFlagOrDefault String
"" ((PathTemplate -> String) -> Flag PathTemplate -> Flag String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathTemplate -> String
InstallDirs.fromPathTemplate (ConfigFlags -> Flag PathTemplate
configProgPrefix ConfigFlags
configFlags))
suffix :: String
suffix = String -> Flag String -> String
forall a. a -> Flag a -> a
fromFlagOrDefault String
"" ((PathTemplate -> String) -> Flag PathTemplate -> Flag String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathTemplate -> String
InstallDirs.fromPathTemplate (ConfigFlags -> Flag PathTemplate
configProgSuffix ConfigFlags
configFlags))
mkUnitBinDir :: UnitId -> FilePath
mkUnitBinDir :: UnitId -> String
mkUnitBinDir =
InstallDirs String -> String
forall dir. InstallDirs dir -> dir
InstallDirs.bindir (InstallDirs String -> String)
-> (UnitId -> InstallDirs String) -> UnitId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
StoreDirLayout -> CompilerId -> UnitId -> InstallDirs String
storePackageInstallDirs' StoreDirLayout
storeDirLayout (Compiler -> CompilerId
compilerId Compiler
compiler)
mkExeName :: UnqualComponentName -> FilePath
mkExeName :: UnqualComponentName -> String
mkExeName UnqualComponentName
exe = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
exe String -> String -> String
<.> Platform -> String
exeExtension Platform
platform
mkFinalExeName :: UnqualComponentName -> FilePath
mkFinalExeName :: UnqualComponentName -> String
mkFinalExeName UnqualComponentName
exe = String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
exe String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
suffix String -> String -> String
<.> Platform -> String
exeExtension Platform
platform
installdirUnknown :: String
installdirUnknown =
String
"installdir is not defined. Set it in your cabal config file "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"or use --installdir=<path>. Using default installdir: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
installPath
String
installdir <- IO String -> Flag (IO String) -> IO String
forall a. a -> Flag a -> a
fromFlagOrDefault
(Verbosity -> String -> IO ()
warn Verbosity
verbosity String
installdirUnknown IO () -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
installPath) (Flag (IO String) -> IO String) -> Flag (IO String) -> IO String
forall a b. (a -> b) -> a -> b
$
String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> Flag String -> Flag (IO String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientInstallFlags -> Flag String
cinstInstalldir ClientInstallFlags
clientInstallFlags
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
False String
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 (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 -> String)
-> (UnqualComponentName -> String)
-> (UnqualComponentName -> String)
-> String
-> InstallMethod
-> (UnitId, [(ComponentTarget, NonEmpty TargetSelector)])
-> IO ()
installUnitExes
Verbosity
verbosity
OverwritePolicy
overwritePolicy
UnitId -> String
mkUnitBinDir UnqualComponentName -> String
mkExeName UnqualComponentName -> String
mkFinalExeName
String
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 (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 (m :: * -> *) a. Monad m => a -> m a
return InstallMethod
InstallMethodSymlink
installLibraries
:: Verbosity
-> ProjectBuildContext
-> Compiler
-> PackageDBStack
-> ProgramDb
-> FilePath
-> [GhcEnvironmentFileEntry]
-> IO ()
installLibraries :: Verbosity
-> ProjectBuildContext
-> Compiler
-> PackageDBStack
-> ProgramDb
-> String
-> [GhcEnvironmentFileEntry]
-> IO ()
installLibraries Verbosity
verbosity ProjectBuildContext
buildCtx Compiler
compiler
PackageDBStack
packageDbs ProgramDb
programDb String
envFile [GhcEnvironmentFileEntry]
envEntries = do
InstalledPackageIndex
installedIndex <- Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
compiler PackageDBStack
packageDbs ProgramDb
programDb
if GhcImplInfo -> Bool
supportsPkgEnvFiles (GhcImplInfo -> Bool) -> GhcImplInfo -> Bool
forall a b. (a -> b) -> a -> b
$ Compiler -> GhcImplInfo
getImplInfo Compiler
compiler
then do
let
getLatest :: PackageName -> [InstalledPackageInfo]
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)
baseEntries :: [GhcEnvironmentFileEntry]
baseEntries =
GhcEnvironmentFileEntry
GhcEnvFileClearPackageDbStack GhcEnvironmentFileEntry
-> [GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry]
forall a. a -> [a] -> [a]
: (PackageDB -> GhcEnvironmentFileEntry)
-> PackageDBStack -> [GhcEnvironmentFileEntry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageDB -> GhcEnvironmentFileEntry
GhcEnvFilePackageDb PackageDBStack
packageDbs
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
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' :: String
contents' = [GhcEnvironmentFileEntry] -> String
renderGhcEnvironmentFile ([GhcEnvironmentFileEntry]
baseEntries [GhcEnvironmentFileEntry]
-> [GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry]
forall a. [a] -> [a] -> [a]
++ [GhcEnvironmentFileEntry]
pkgEntries)
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
envFile)
String -> ByteString -> IO ()
writeFileAtomic String
envFile (String -> ByteString
BS.pack String
contents')
else
Verbosity -> String -> IO ()
warn Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"The current compiler doesn't support safely installing libraries, "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"so only executables will be available. (Library installation is "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"supported on GHC 8.0+ only)"
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 -> String -> IO ()
warn Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"@ WARNING: Installation might not be completed as desired! @\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"The command \"cabal install [TARGETS]\" doesn't expose libraries.\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"* You might have wanted to add them as dependencies to your package." String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
" In this case add \"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (TargetSelector -> String
showTargetSelector (TargetSelector -> String) -> [TargetSelector] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TargetSelector]
selectors) String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"\" to the build-depends field(s) of your package's .cabal file.\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"* You might have wanted to add them to a GHC environment. In this case" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
" use \"cabal install --lib " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
[String] -> String
unwords (TargetSelector -> String
showTargetSelector (TargetSelector -> String) -> [TargetSelector] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TargetSelector]
selectors) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\". " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
" The \"--lib\" flag is provisional: see" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
" 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 (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
globalPackages :: [PackageName]
globalPackages :: [PackageName]
globalPackages = String -> PackageName
mkPackageName (String -> PackageName) -> [String] -> [PackageName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
[ String
"ghc", String
"hoopl", String
"bytestring", String
"unix", String
"base", String
"time", String
"hpc", String
"filepath"
, String
"process", String
"array", String
"integer-gmp", String
"containers", String
"ghc-boot", String
"binary"
, String
"ghc-prim", String
"ghci", String
"rts", String
"terminfo", String
"transformers", String
"deepseq"
, String
"ghc-boot-th", String
"pretty", String
"template-haskell", String
"directory", String
"text"
, String
"bin-package-db"
]
getEnvSpecsAndNonGlobalEntries
:: PI.InstalledPackageIndex
-> [GhcEnvironmentFileEntry]
-> Bool
-> ([PackageSpecifier a], [GhcEnvironmentFileEntry])
getEnvSpecsAndNonGlobalEntries :: InstalledPackageIndex
-> [GhcEnvironmentFileEntry]
-> Bool
-> ([PackageSpecifier a], [GhcEnvironmentFileEntry])
getEnvSpecsAndNonGlobalEntries InstalledPackageIndex
installedIndex [GhcEnvironmentFileEntry]
entries Bool
installLibs =
if Bool
installLibs
then ([PackageSpecifier a]
forall pkg. [PackageSpecifier pkg]
envSpecs, [GhcEnvironmentFileEntry]
envEntries')
else ([], [GhcEnvironmentFileEntry]
envEntries')
where
([PackageSpecifier a]
envSpecs, [GhcEnvironmentFileEntry]
envEntries') = InstalledPackageIndex
-> [GhcEnvironmentFileEntry]
-> ([PackageSpecifier a], [GhcEnvironmentFileEntry])
forall a.
InstalledPackageIndex
-> [GhcEnvironmentFileEntry]
-> ([PackageSpecifier a], [GhcEnvironmentFileEntry])
environmentFileToSpecifiers InstalledPackageIndex
installedIndex [GhcEnvironmentFileEntry]
entries
environmentFileToSpecifiers
:: PI.InstalledPackageIndex -> [GhcEnvironmentFileEntry]
-> ([PackageSpecifier a], [GhcEnvironmentFileEntry])
environmentFileToSpecifiers :: InstalledPackageIndex
-> [GhcEnvironmentFileEntry]
-> ([PackageSpecifier a], [GhcEnvironmentFileEntry])
environmentFileToSpecifiers InstalledPackageIndex
ipi = (GhcEnvironmentFileEntry
-> ([PackageSpecifier a], [GhcEnvironmentFileEntry]))
-> [GhcEnvironmentFileEntry]
-> ([PackageSpecifier a], [GhcEnvironmentFileEntry])
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((GhcEnvironmentFileEntry
-> ([PackageSpecifier a], [GhcEnvironmentFileEntry]))
-> [GhcEnvironmentFileEntry]
-> ([PackageSpecifier a], [GhcEnvironmentFileEntry]))
-> (GhcEnvironmentFileEntry
-> ([PackageSpecifier a], [GhcEnvironmentFileEntry]))
-> [GhcEnvironmentFileEntry]
-> ([PackageSpecifier a], [GhcEnvironmentFileEntry])
forall a b. (a -> b) -> a -> b
$ \case
(GhcEnvFilePackageId UnitId
unitId)
| Just InstalledPackageInfo
{ sourcePackageId :: InstalledPackageInfo -> PackageId
sourcePackageId = PackageIdentifier{PackageName
Version
pkgVersion :: Version
pkgName :: PackageName
pkgName :: PackageId -> PackageName
pkgVersion :: PackageId -> Version
..}, UnitId
installedUnitId :: UnitId
installedUnitId :: InstalledPackageInfo -> 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)]
-> if PackageName
pkgName PackageName -> [PackageName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackageName]
globalPackages
then ([PackageSpecifier a
forall pkg. PackageSpecifier pkg
pkgSpec], [])
else ([PackageSpecifier a
forall pkg. PackageSpecifier pkg
pkgSpec], [UnitId -> GhcEnvironmentFileEntry
GhcEnvFilePackageId UnitId
installedUnitId])
GhcEnvironmentFileEntry
_ -> ([], [])
disableTestsBenchsByDefault :: ConfigFlags -> ConfigFlags
disableTestsBenchsByDefault :: ConfigFlags -> ConfigFlags
disableTestsBenchsByDefault ConfigFlags
configFlags =
ConfigFlags
configFlags { configTests :: Flag Bool
configTests = Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
False Flag Bool -> Flag Bool -> Flag Bool
forall a. Semigroup a => a -> a -> a
<> ConfigFlags -> Flag Bool
configTests ConfigFlags
configFlags
, configBenchmarks :: Flag Bool
configBenchmarks = Bool -> Flag Bool
forall a. a -> Flag a
Flag Bool
False Flag Bool -> Flag Bool -> Flag Bool
forall a. Semigroup a => a -> a -> a
<> ConfigFlags -> Flag Bool
configBenchmarks ConfigFlags
configFlags }
installUnitExes
:: Verbosity
-> OverwritePolicy
-> (UnitId -> FilePath)
-> (UnqualComponentName -> FilePath)
-> (UnqualComponentName -> FilePath)
-> FilePath
-> InstallMethod
-> ( UnitId
, [(ComponentTarget, NonEmpty TargetSelector)] )
-> IO ()
installUnitExes :: Verbosity
-> OverwritePolicy
-> (UnitId -> String)
-> (UnqualComponentName -> String)
-> (UnqualComponentName -> String)
-> String
-> InstallMethod
-> (UnitId, [(ComponentTarget, NonEmpty TargetSelector)])
-> IO ()
installUnitExes Verbosity
verbosity OverwritePolicy
overwritePolicy
UnitId -> String
mkSourceBinDir UnqualComponentName -> String
mkExeName UnqualComponentName -> String
mkFinalExeName
String
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
-> String
-> String
-> String
-> String
-> InstallMethod
-> IO Bool
installBuiltExe
Verbosity
verbosity OverwritePolicy
overwritePolicy
(UnitId -> String
mkSourceBinDir UnitId
unit) (UnqualComponentName -> String
mkExeName UnqualComponentName
exe)
(UnqualComponentName -> String
mkFinalExeName UnqualComponentName
exe)
String
installdir InstallMethod
installMethod
let errorMessage :: String
errorMessage = case OverwritePolicy
overwritePolicy of
OverwritePolicy
NeverOverwrite ->
String
"Path '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String
installdir String -> String -> String
</> UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow UnqualComponentName
exe) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' already exists. "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Use --overwrite-policy=always to overwrite."
OverwritePolicy
_ ->
case InstallMethod
installMethod of
InstallMethod
InstallMethodSymlink -> String
"Symlinking"
InstallMethod
InstallMethodCopy ->
String
"Copying" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UnqualComponentName -> String
forall a. Pretty a => a -> String
prettyShow UnqualComponentName
exe String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' 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 -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
errorMessage
installBuiltExe
:: Verbosity -> OverwritePolicy
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> InstallMethod
-> IO Bool
installBuiltExe :: Verbosity
-> OverwritePolicy
-> String
-> String
-> String
-> String
-> InstallMethod
-> IO Bool
installBuiltExe Verbosity
verbosity OverwritePolicy
overwritePolicy
String
sourceDir String
exeName String
finalExeName
String
installdir InstallMethod
InstallMethodSymlink = do
Verbosity -> String -> IO ()
notice Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Symlinking '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
exeName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' to '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
destination String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"
OverwritePolicy -> String -> String -> String -> String -> IO Bool
symlinkBinary
OverwritePolicy
overwritePolicy
String
installdir
String
sourceDir
String
finalExeName
String
exeName
where
destination :: String
destination = String
installdir String -> String -> String
</> String
finalExeName
installBuiltExe Verbosity
verbosity OverwritePolicy
overwritePolicy
String
sourceDir String
exeName String
finalExeName
String
installdir InstallMethod
InstallMethodCopy = do
Verbosity -> String -> IO ()
notice Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Copying '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
exeName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' to '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
destination String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"
Bool
exists <- String -> IO Bool
doesPathExist String
destination
case (Bool
exists, OverwritePolicy
overwritePolicy) of
(Bool
True , OverwritePolicy
NeverOverwrite ) -> Bool -> IO Bool
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 :: String
source = String
sourceDir String -> String -> String
</> String
exeName
destination :: String
destination = String
installdir String -> String -> String
</> String
finalExeName
remove :: IO ()
remove = do
Bool
isDir <- String -> IO Bool
doesDirectoryExist String
destination
if Bool
isDir
then String -> IO ()
removeDirectory String
destination
else String -> IO ()
removeFile String
destination
copy :: IO Bool
copy = String -> String -> IO ()
copyFile String
source String
destination IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Bool
copy
maybeOverwrite :: IO Bool
maybeOverwrite :: IO Bool
maybeOverwrite
= String -> IO Bool -> IO Bool
promptRun
String
"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 String
getEnvFile ClientInstallFlags
clientInstallFlags Platform
platform Version
compilerVersion = do
String
appDir <- IO String
getGhcAppDir
case Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe (ClientInstallFlags -> Flag String
cinstEnvironmentPath ClientInstallFlags
clientInstallFlags) of
Just String
spec
| String -> String
takeBaseName String
spec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
spec ->
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Platform -> Version -> String -> String
getGlobalEnv String
appDir Platform
platform Version
compilerVersion String
spec)
| Bool
otherwise -> do
String
spec' <- String -> IO String
makeAbsolute String
spec
Bool
isDir <- String -> IO Bool
doesDirectoryExist String
spec'
if Bool
isDir
then String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Platform -> Version -> String
getLocalEnv String
spec' Platform
platform Version
compilerVersion)
else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
spec'
Maybe String
Nothing ->
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Platform -> Version -> String -> String
getGlobalEnv String
appDir Platform
platform Version
compilerVersion String
"default")
getExistingEnvEntries :: Verbosity -> CompilerFlavor -> Bool -> FilePath -> IO [GhcEnvironmentFileEntry]
getExistingEnvEntries :: Verbosity
-> CompilerFlavor -> Bool -> String -> IO [GhcEnvironmentFileEntry]
getExistingEnvEntries Verbosity
verbosity CompilerFlavor
compilerFlavor Bool
supportsPkgEnvFiles String
envFile = do
Bool
envFileExists <- String -> IO Bool
doesFileExist String
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 (String -> IO [GhcEnvironmentFileEntry]
readGhcEnvironmentFile String
envFile) ((ParseErrorExc -> IO [GhcEnvironmentFileEntry])
-> IO [GhcEnvironmentFileEntry])
-> (ParseErrorExc -> IO [GhcEnvironmentFileEntry])
-> IO [GhcEnvironmentFileEntry]
forall a b. (a -> b) -> a -> b
$ \(ParseErrorExc
_ :: ParseErrorExc) ->
Verbosity -> String -> IO ()
warn Verbosity
verbosity (String
"The environment file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
envFile String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" is unparsable. Libraries cannot be installed.") IO ()
-> IO [GhcEnvironmentFileEntry] -> IO [GhcEnvironmentFileEntry]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [GhcEnvironmentFileEntry] -> IO [GhcEnvironmentFileEntry]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else [GhcEnvironmentFileEntry] -> IO [GhcEnvironmentFileEntry]
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 :: String -> Platform -> Version -> String -> String
getGlobalEnv String
appDir Platform
platform Version
compilerVersion String
name =
String
appDir String -> String -> String
</> Platform -> Version -> String
ghcPlatformAndVersionString Platform
platform Version
compilerVersion
String -> String -> String
</> String
"environments" String -> String -> String
</> String
name
getLocalEnv :: FilePath -> Platform -> Version -> FilePath
getLocalEnv :: String -> Platform -> Version -> String
getLocalEnv String
dir Platform
platform Version
compilerVersion =
String
dir String -> String -> String
</>
String
".ghc.environment." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Platform -> Version -> String
ghcPlatformAndVersionString Platform
platform Version
compilerVersion
getPackageDbStack
:: CompilerId
-> Flag FilePath
-> Flag FilePath
-> IO PackageDBStack
getPackageDbStack :: CompilerId -> Flag String -> Flag String -> IO PackageDBStack
getPackageDbStack CompilerId
compilerId Flag String
storeDirFlag Flag String
logsDirFlag = do
String
cabalDir <- IO String
getCabalDir
Maybe String
mstoreDir <- (String -> IO String) -> Maybe String -> IO (Maybe String)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO String
makeAbsolute (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe Flag String
storeDirFlag
let
mlogsDir :: Maybe String
mlogsDir = Flag String -> Maybe String
forall a. Flag a -> Maybe a
flagToMaybe Flag String
logsDirFlag
cabalLayout :: CabalDirLayout
cabalLayout = String -> Maybe String -> Maybe String -> CabalDirLayout
mkCabalDirLayout String
cabalDir Maybe String
mstoreDir Maybe String
mlogsDir
PackageDBStack -> IO PackageDBStack
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 :: TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem Void) [k]
selectPackageTargets TargetSelector
targetSelector [AvailableTarget k]
targets
| Bool -> Bool
not ([k] -> 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 (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 :: 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 :: Verbosity -> [TargetProblem Void] -> IO a
reportBuildTargetProblems Verbosity
verbosity [TargetProblem Void]
problems = Verbosity -> String -> [TargetProblem Void] -> IO a
forall a. Verbosity -> String -> [TargetProblem Void] -> IO a
reportTargetProblems Verbosity
verbosity String
"build" [TargetProblem Void]
problems
reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a
reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a
reportCannotPruneDependencies Verbosity
verbosity =
Verbosity -> String -> IO a
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO a)
-> (CannotPruneDependencies -> String)
-> CannotPruneDependencies
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CannotPruneDependencies -> String
renderCannotPruneDependencies