{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Stack.Build
( buildCmd
, build
, buildLocalTargets
, loadPackage
, mkBaseConfigOpts
, splitObjsWarning
) where
import Data.Attoparsec.Args ( EscapingMode (Escaping), parseArgs )
import Data.List ( (\\) )
import Data.List.Extra ( groupSort )
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Distribution.PackageDescription as C
import Distribution.Types.Dependency ( Dependency (..), depLibraries )
import Distribution.Version ( mkVersion )
import Stack.Build.ConstructPlan ( constructPlan )
import Stack.Build.Execute ( executePlan, preFetch, printPlan )
import Stack.Build.Installed ( getInstalled, toInstallMap )
import Stack.Build.Source ( localDependencies, projectLocalPackages )
import Stack.Build.Target ( NeedTargets (..) )
import Stack.FileWatch ( fileWatch, fileWatchPoll )
import Stack.Package ( resolvePackage )
import Stack.Prelude hiding ( loadPackage )
import Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig )
import Stack.Setup ( withNewLocalBuildTargets )
import Stack.Types.Build
( Plan (..), Task (..), TaskType (..), taskLocation )
import Stack.Types.Build.Exception
( BuildException (..), BuildPrettyException (..) )
import Stack.Types.BuildConfig ( HasBuildConfig, stackYamlL )
import Stack.Types.BuildOpts
( BuildCommand (..), BuildOpts (..), BuildOptsCLI (..)
, FileWatchOpts (..), buildOptsMonoidBenchmarksL
, buildOptsMonoidHaddockL, buildOptsMonoidInstallExesL
, buildOptsMonoidTestsL
)
import Stack.Types.Compiler ( getGhcVersion )
import Stack.Types.CompilerPaths ( cabalVersionL )
import Stack.Types.Config
( Config (..), HasConfig (..), buildOptsL
)
import Stack.Types.ConfigureOpts ( BaseConfigOpts (..) )
import Stack.Types.EnvConfig
( EnvConfig (..), HasEnvConfig (..), HasSourceMap
, actualCompilerVersionL, installationRootDeps
, installationRootLocal, packageDatabaseDeps
, packageDatabaseExtra, packageDatabaseLocal
)
import Stack.Types.GlobalOpts ( globalOptsBuildOptsMonoidL )
import Stack.Types.NamedComponent ( exeComponents )
import Stack.Types.Package
( InstallLocation (..), LocalPackage (..), Package (..)
, PackageConfig (..), lpFiles, lpFilesForComponents )
import Stack.Types.Platform ( HasPlatform (..) )
import Stack.Types.Runner ( Runner, globalOptsL )
import Stack.Types.SourceMap
( CommonPackage (..), ProjectPackage (..), SMTargets (..)
, SourceMap (..), Target (..) )
import System.Terminal ( fixCodePage )
newtype CabalVersionPrettyException
= CabalVersionNotSupported Version
deriving (Int -> CabalVersionPrettyException -> ShowS
[CabalVersionPrettyException] -> ShowS
CabalVersionPrettyException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CabalVersionPrettyException] -> ShowS
$cshowList :: [CabalVersionPrettyException] -> ShowS
show :: CabalVersionPrettyException -> String
$cshow :: CabalVersionPrettyException -> String
showsPrec :: Int -> CabalVersionPrettyException -> ShowS
$cshowsPrec :: Int -> CabalVersionPrettyException -> ShowS
Show, Typeable)
instance Pretty CabalVersionPrettyException where
pretty :: CabalVersionPrettyException -> StyleDoc
pretty (CabalVersionNotSupported Version
cabalVer) =
StyleDoc
"[S-5973]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ String -> StyleDoc
flow String
"Stack does not support Cabal versions before 1.22, but \
\version"
, forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ Version -> String
versionString Version
cabalVer
, String -> StyleDoc
flow String
"was found. To fix this, consider updating the snapshot to"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"lts-3.0"
, String -> StyleDoc
flow String
"or later or to"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"nightly-2015-05-05"
, String -> StyleDoc
flow String
"or later."
]
instance Exception CabalVersionPrettyException
buildCmd :: BuildOptsCLI -> RIO Runner ()
buildCmd :: BuildOptsCLI -> RIO Runner ()
buildCmd BuildOptsCLI
opts = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String
"-prof" `elem`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> Either a b -> b
fromRight [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. EscapingMode -> Text -> Either String [String]
parseArgs EscapingMode
Escaping) (BuildOptsCLI -> [Text]
boptsCLIGhcOptions BuildOptsCLI
opts)) forall a b. (a -> b) -> a -> b
$
forall e (m :: * -> *) a.
(Exception e, MonadIO m, Pretty e) =>
e -> m a
prettyThrowIO BuildPrettyException
GHCProfOptionInvalid
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall env. HasRunner env => Lens' env GlobalOpts
globalOptsL GlobalOpts -> GlobalOpts
modifyGO) forall a b. (a -> b) -> a -> b
$
case BuildOptsCLI -> FileWatchOpts
boptsCLIFileWatch BuildOptsCLI
opts of
FileWatchOpts
FileWatchPoll -> forall env.
HasTerm env =>
((Set (Path Abs File) -> IO ()) -> RIO env ()) -> RIO env ()
fileWatchPoll (Maybe (Set (Path Abs File) -> IO ()) -> RIO Runner ()
inner forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
FileWatchOpts
FileWatch -> forall env.
HasTerm env =>
((Set (Path Abs File) -> IO ()) -> RIO env ()) -> RIO env ()
fileWatch (Maybe (Set (Path Abs File) -> IO ()) -> RIO Runner ()
inner forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
FileWatchOpts
NoFileWatch -> Maybe (Set (Path Abs File) -> IO ()) -> RIO Runner ()
inner forall a. Maybe a
Nothing
where
inner ::
Maybe (Set (Path Abs File) -> IO ())
-> RIO Runner ()
inner :: Maybe (Set (Path Abs File) -> IO ()) -> RIO Runner ()
inner Maybe (Set (Path Abs File) -> IO ())
setLocalFiles = forall a. ShouldReexec -> RIO Config a -> RIO Runner a
withConfig ShouldReexec
YesReexec forall a b. (a -> b) -> a -> b
$ forall a.
NeedTargets -> BuildOptsCLI -> RIO EnvConfig a -> RIO Config a
withEnvConfig NeedTargets
NeedTargets BuildOptsCLI
opts forall a b. (a -> b) -> a -> b
$
forall env.
HasEnvConfig env =>
Maybe (Set (Path Abs File) -> IO ()) -> RIO env ()
Stack.Build.build Maybe (Set (Path Abs File) -> IO ())
setLocalFiles
modifyGO :: GlobalOpts -> GlobalOpts
modifyGO =
case BuildOptsCLI -> BuildCommand
boptsCLICommand BuildOptsCLI
opts of
BuildCommand
Test -> forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' GlobalOpts BuildOptsMonoid
globalOptsBuildOptsMonoidLforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidTestsL) (forall a. a -> Maybe a
Just Bool
True)
BuildCommand
Haddock ->
forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' GlobalOpts BuildOptsMonoid
globalOptsBuildOptsMonoidLforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidHaddockL) (forall a. a -> Maybe a
Just Bool
True)
BuildCommand
Bench ->
forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' GlobalOpts BuildOptsMonoid
globalOptsBuildOptsMonoidLforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidBenchmarksL) (forall a. a -> Maybe a
Just Bool
True)
BuildCommand
Install ->
forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' GlobalOpts BuildOptsMonoid
globalOptsBuildOptsMonoidLforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidInstallExesL) (forall a. a -> Maybe a
Just Bool
True)
BuildCommand
Build -> forall a. a -> a
id
build :: HasEnvConfig env
=> Maybe (Set (Path Abs File) -> IO ())
-> RIO env ()
build :: forall env.
HasEnvConfig env =>
Maybe (Set (Path Abs File) -> IO ()) -> RIO env ()
build Maybe (Set (Path Abs File) -> IO ())
msetLocalFiles = do
Bool
mcp <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Config -> Bool
configModifyCodePage
Version
ghcVersion <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to ActualCompiler -> Version
getGhcVersion
forall x y a. x -> y -> a -> a
fixCodePage Bool
mcp Version
ghcVersion forall a b. (a -> b) -> a -> b
$ do
BuildOpts
bopts <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s. HasConfig s => Lens' s BuildOpts
buildOptsL
SourceMap
sourceMap <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> SourceMap
envConfigSourceMap
[LocalPackage]
locals <- forall env. HasEnvConfig env => RIO env [LocalPackage]
projectLocalPackages
[LocalPackage]
depsLocals <- forall env. HasEnvConfig env => RIO env [LocalPackage]
localDependencies
let allLocals :: [LocalPackage]
allLocals = [LocalPackage]
locals forall a. Semigroup a => a -> a -> a
<> [LocalPackage]
depsLocals
forall env. HasTerm env => [ProjectPackage] -> RIO env ()
checkSubLibraryDependencies (forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ SourceMap -> Map PackageName ProjectPackage
smProject SourceMap
sourceMap)
BuildOptsCLI
boptsCli <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> BuildOptsCLI
envConfigBuildOptsCLI
Path Abs File
stackYaml <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasBuildConfig env => Lens' env (Path Abs File)
stackYamlL
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (Set (Path Abs File) -> IO ())
msetLocalFiles forall a b. (a -> b) -> a -> b
$ \Set (Path Abs File) -> IO ()
setLocalFiles -> do
[Set (Path Abs File)]
files <-
if BuildOptsCLI -> Bool
boptsCLIWatchAll BuildOptsCLI
boptsCli
then forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [forall env.
HasEnvConfig env =>
LocalPackage -> RIO env (Set (Path Abs File))
lpFiles LocalPackage
lp | LocalPackage
lp <- [LocalPackage]
allLocals]
else forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [LocalPackage]
allLocals forall a b. (a -> b) -> a -> b
$ \LocalPackage
lp -> do
let pn :: PackageName
pn = Package -> PackageName
packageName (LocalPackage -> Package
lpPackage LocalPackage
lp)
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pn (SMTargets -> Map PackageName Target
smtTargets forall a b. (a -> b) -> a -> b
$ SourceMap -> SMTargets
smTargets SourceMap
sourceMap) of
Maybe Target
Nothing ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Set a
Set.empty
Just (TargetAll PackageType
_) ->
forall env.
HasEnvConfig env =>
LocalPackage -> RIO env (Set (Path Abs File))
lpFiles LocalPackage
lp
Just (TargetComps Set NamedComponent
components) ->
forall env.
HasEnvConfig env =>
Set NamedComponent -> LocalPackage -> RIO env (Set (Path Abs File))
lpFilesForComponents Set NamedComponent
components LocalPackage
lp
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Set (Path Abs File) -> IO ()
setLocalFiles forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Set a
Set.insert Path Abs File
stackYaml forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set (Path Abs File)]
files
forall (m :: * -> *). MonadThrow m => [LocalPackage] -> m ()
checkComponentsBuildable [LocalPackage]
allLocals
InstallMap
installMap <- forall (m :: * -> *). MonadIO m => SourceMap -> m InstallMap
toInstallMap SourceMap
sourceMap
(InstalledMap
installedMap, [DumpPackage]
globalDumpPkgs, [DumpPackage]
snapshotDumpPkgs, [DumpPackage]
localDumpPkgs) <-
forall env.
HasEnvConfig env =>
InstallMap
-> RIO
env (InstalledMap, [DumpPackage], [DumpPackage], [DumpPackage])
getInstalled InstallMap
installMap
BaseConfigOpts
baseConfigOpts <- forall env.
HasEnvConfig env =>
BuildOptsCLI -> RIO env BaseConfigOpts
mkBaseConfigOpts BuildOptsCLI
boptsCli
Plan
plan <- forall env.
HasEnvConfig env =>
BaseConfigOpts
-> [DumpPackage]
-> (PackageLocationImmutable
-> Map FlagName Bool -> [Text] -> [Text] -> RIO EnvConfig Package)
-> SourceMap
-> InstalledMap
-> Bool
-> RIO env Plan
constructPlan BaseConfigOpts
baseConfigOpts [DumpPackage]
localDumpPkgs forall env.
(HasBuildConfig env, HasSourceMap env) =>
PackageLocationImmutable
-> Map FlagName Bool -> [Text] -> [Text] -> RIO env Package
loadPackage SourceMap
sourceMap InstalledMap
installedMap (BuildOptsCLI -> Bool
boptsCLIInitialBuildSteps BuildOptsCLI
boptsCli)
Bool
allowLocals <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Config -> Bool
configAllowLocals
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allowLocals forall a b. (a -> b) -> a -> b
$ case Plan -> [PackageIdentifier]
justLocals Plan
plan of
[] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[PackageIdentifier]
localsIdents -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ [PackageIdentifier] -> BuildException
LocalPackagesPresent [PackageIdentifier]
localsIdents
forall env. HasEnvConfig env => RIO env ()
checkCabalVersion
forall env. HasTerm env => BuildOpts -> RIO env ()
warnAboutSplitObjs BuildOpts
bopts
forall env. HasTerm env => [LocalPackage] -> Plan -> RIO env ()
warnIfExecutablesWithSameNameCouldBeOverwritten [LocalPackage]
locals Plan
plan
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BuildOpts -> Bool
boptsPreFetch BuildOpts
bopts) forall a b. (a -> b) -> a -> b
$
forall env. HasEnvConfig env => Plan -> RIO env ()
preFetch Plan
plan
if BuildOptsCLI -> Bool
boptsCLIDryrun BuildOptsCLI
boptsCli
then forall env. (HasRunner env, HasTerm env) => Plan -> RIO env ()
printPlan Plan
plan
else forall env.
HasEnvConfig env =>
BuildOptsCLI
-> BaseConfigOpts
-> [LocalPackage]
-> [DumpPackage]
-> [DumpPackage]
-> [DumpPackage]
-> InstalledMap
-> Map PackageName Target
-> Plan
-> RIO env ()
executePlan
BuildOptsCLI
boptsCli
BaseConfigOpts
baseConfigOpts
[LocalPackage]
locals
[DumpPackage]
globalDumpPkgs
[DumpPackage]
snapshotDumpPkgs
[DumpPackage]
localDumpPkgs
InstalledMap
installedMap
(SMTargets -> Map PackageName Target
smtTargets forall a b. (a -> b) -> a -> b
$ SourceMap -> SMTargets
smTargets SourceMap
sourceMap)
Plan
plan
buildLocalTargets ::
HasEnvConfig env
=> NonEmpty Text
-> RIO env (Either SomeException ())
buildLocalTargets :: forall env.
HasEnvConfig env =>
NonEmpty Text -> RIO env (Either SomeException ())
buildLocalTargets NonEmpty Text
targets =
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny forall a b. (a -> b) -> a -> b
$ forall env a. HasEnvConfig env => [Text] -> RIO env a -> RIO env a
withNewLocalBuildTargets (forall a. NonEmpty a -> [a]
NE.toList NonEmpty Text
targets) forall a b. (a -> b) -> a -> b
$ forall env.
HasEnvConfig env =>
Maybe (Set (Path Abs File) -> IO ()) -> RIO env ()
build forall a. Maybe a
Nothing
justLocals :: Plan -> [PackageIdentifier]
justLocals :: Plan -> [PackageIdentifier]
justLocals =
forall a b. (a -> b) -> [a] -> [b]
map Task -> PackageIdentifier
taskProvides forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== InstallLocation
Local) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Task -> InstallLocation
taskLocation) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall k a. Map k a -> [a]
Map.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Plan -> Map PackageName Task
planTasks
checkCabalVersion :: HasEnvConfig env => RIO env ()
checkCabalVersion :: forall env. HasEnvConfig env => RIO env ()
checkCabalVersion = do
Version
cabalVer <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasCompiler env => SimpleGetter env Version
cabalVersionL
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
cabalVer forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
1, Int
22]) forall a b. (a -> b) -> a -> b
$
forall e (m :: * -> *) a.
(Exception e, MonadThrow m, Pretty e) =>
e -> m a
prettyThrowM forall a b. (a -> b) -> a -> b
$ Version -> CabalVersionPrettyException
CabalVersionNotSupported Version
cabalVer
warnIfExecutablesWithSameNameCouldBeOverwritten ::
HasTerm env
=> [LocalPackage]
-> Plan
-> RIO env ()
warnIfExecutablesWithSameNameCouldBeOverwritten :: forall env. HasTerm env => [LocalPackage] -> Plan -> RIO env ()
warnIfExecutablesWithSameNameCouldBeOverwritten [LocalPackage]
locals Plan
plan = do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Checking if we are going to build multiple executables with the same name"
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
Map.toList Map Text ([PackageName], [PackageName])
warnings) forall a b. (a -> b) -> a -> b
$ \(Text
exe, ([PackageName]
toBuild, [PackageName]
otherLocals)) -> do
let exe_s :: StyleDoc
exe_s
| forall (t :: * -> *) a. Foldable t => t a -> Int
length [PackageName]
toBuild forall a. Ord a => a -> a -> Bool
> Int
1 = String -> StyleDoc
flow String
"several executables with the same name:"
| Bool
otherwise = StyleDoc
"executable"
exesText :: [PackageName] -> StyleDoc
exesText [PackageName]
pkgs =
[StyleDoc] -> StyleDoc
fillSep forall a b. (a -> b) -> a -> b
$ StyleDoc -> [StyleDoc] -> [StyleDoc]
punctuate
StyleDoc
","
[ Style -> StyleDoc -> StyleDoc
style
Style
PkgComponent
(forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ PackageName -> String
packageNameString PackageName
p forall a. Semigroup a => a -> a -> a
<> String
":" forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
exe)
| PackageName
p <- [PackageName]
pkgs
]
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL forall a b. (a -> b) -> a -> b
$
[ StyleDoc
"Building"
, StyleDoc
exe_s
, [PackageName] -> StyleDoc
exesText [PackageName]
toBuild forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
forall a. Semigroup a => a -> a -> a
<> [ [StyleDoc] -> StyleDoc
fillSep
[ String -> StyleDoc
flow String
"Only one of them will be available via"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"stack exec"
, String -> StyleDoc
flow String
"or locally installed."
]
| forall (t :: * -> *) a. Foldable t => t a -> Int
length [PackageName]
toBuild forall a. Ord a => a -> a -> Bool
> Int
1
]
forall a. Semigroup a => a -> a -> a
<> [ [StyleDoc] -> StyleDoc
fillSep
[ String -> StyleDoc
flow String
"Other executables with the same name might be overwritten:"
, [PackageName] -> StyleDoc
exesText [PackageName]
otherLocals forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageName]
otherLocals)
]
where
warnings :: Map Text ([PackageName],[PackageName])
warnings :: Map Text ([PackageName], [PackageName])
warnings =
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe
(\(NonEmpty PackageName
pkgsToBuild,NonEmpty PackageName
localPkgs) ->
case (NonEmpty PackageName
pkgsToBuild,forall a. NonEmpty a -> [a]
NE.toList NonEmpty PackageName
localPkgs forall a. Eq a => [a] -> [a] -> [a]
\\ forall a. NonEmpty a -> [a]
NE.toList NonEmpty PackageName
pkgsToBuild) of
(PackageName
_ :| [],[]) ->
forall a. Maybe a
Nothing
(NonEmpty PackageName
_,[PackageName]
otherLocals) ->
forall a. a -> Maybe a
Just (forall a. NonEmpty a -> [a]
NE.toList NonEmpty PackageName
pkgsToBuild,[PackageName]
otherLocals))
(forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (,) Map Text (NonEmpty PackageName)
exesToBuild Map Text (NonEmpty PackageName)
localExes)
exesToBuild :: Map Text (NonEmpty PackageName)
exesToBuild :: Map Text (NonEmpty PackageName)
exesToBuild =
forall k v. Ord k => [(k, v)] -> Map k (NonEmpty v)
collect
[ (Text
exe,PackageName
pkgName')
| (PackageName
pkgName',Task
task) <- forall k a. Map k a -> [(k, a)]
Map.toList (Plan -> Map PackageName Task
planTasks Plan
plan)
, TTLocalMutable LocalPackage
lp <- [Task -> TaskType
taskType Task
task]
, Text
exe <- (forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set NamedComponent -> Set Text
exeComponents forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalPackage -> Set NamedComponent
lpComponents) LocalPackage
lp
]
localExes :: Map Text (NonEmpty PackageName)
localExes :: Map Text (NonEmpty PackageName)
localExes =
forall k v. Ord k => [(k, v)] -> Map k (NonEmpty v)
collect
[ (Text
exe,Package -> PackageName
packageName Package
pkg)
| Package
pkg <- forall a b. (a -> b) -> [a] -> [b]
map LocalPackage -> Package
lpPackage [LocalPackage]
locals
, Text
exe <- forall a. Set a -> [a]
Set.toList (Package -> Set Text
packageExes Package
pkg)
]
collect :: Ord k => [(k,v)] -> Map k (NonEmpty v)
collect :: forall k v. Ord k => [(k, v)] -> Map k (NonEmpty v)
collect = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a. [a] -> NonEmpty a
NE.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Ord k => [(k, v)] -> [(k, [v])]
groupSort
warnAboutSplitObjs :: HasTerm env => BuildOpts -> RIO env ()
warnAboutSplitObjs :: forall env. HasTerm env => BuildOpts -> RIO env ()
warnAboutSplitObjs BuildOpts
bopts | BuildOpts -> Bool
boptsSplitObjs BuildOpts
bopts =
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
[ String -> StyleDoc
flow String
"Building with"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"--split-objs"
, String -> StyleDoc
flow String
"is enabled."
, String -> StyleDoc
flow String
splitObjsWarning
]
warnAboutSplitObjs BuildOpts
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
splitObjsWarning :: String
splitObjsWarning :: String
splitObjsWarning =
String
"Note that this feature is EXPERIMENTAL, and its behavior may be changed and \
\improved. You will need to clean your workdirs before use. If you want to \
\compile all dependencies with split-objs, you will need to delete the \
\snapshot (and all snapshots that could reference that snapshot)."
mkBaseConfigOpts :: (HasEnvConfig env)
=> BuildOptsCLI -> RIO env BaseConfigOpts
mkBaseConfigOpts :: forall env.
HasEnvConfig env =>
BuildOptsCLI -> RIO env BaseConfigOpts
mkBaseConfigOpts BuildOptsCLI
boptsCli = do
BuildOpts
bopts <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s. HasConfig s => Lens' s BuildOpts
buildOptsL
Path Abs Dir
snapDBPath <- forall env. HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseDeps
Path Abs Dir
localDBPath <- forall env. HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseLocal
Path Abs Dir
snapInstallRoot <- forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootDeps
Path Abs Dir
localInstallRoot <- forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootLocal
[Path Abs Dir]
packageExtraDBs <- forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m) =>
m [Path Abs Dir]
packageDatabaseExtra
forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseConfigOpts
{ bcoSnapDB :: Path Abs Dir
bcoSnapDB = Path Abs Dir
snapDBPath
, bcoLocalDB :: Path Abs Dir
bcoLocalDB = Path Abs Dir
localDBPath
, bcoSnapInstallRoot :: Path Abs Dir
bcoSnapInstallRoot = Path Abs Dir
snapInstallRoot
, bcoLocalInstallRoot :: Path Abs Dir
bcoLocalInstallRoot = Path Abs Dir
localInstallRoot
, bcoBuildOpts :: BuildOpts
bcoBuildOpts = BuildOpts
bopts
, bcoBuildOptsCLI :: BuildOptsCLI
bcoBuildOptsCLI = BuildOptsCLI
boptsCli
, bcoExtraDBs :: [Path Abs Dir]
bcoExtraDBs = [Path Abs Dir]
packageExtraDBs
}
loadPackage ::
(HasBuildConfig env, HasSourceMap env)
=> PackageLocationImmutable
-> Map FlagName Bool
-> [Text]
-> [Text]
-> RIO env Package
loadPackage :: forall env.
(HasBuildConfig env, HasSourceMap env) =>
PackageLocationImmutable
-> Map FlagName Bool -> [Text] -> [Text] -> RIO env Package
loadPackage PackageLocationImmutable
loc Map FlagName Bool
flags [Text]
ghcOptions [Text]
cabalConfigOpts = do
ActualCompiler
compiler <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionL
Platform
platform <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env Platform
platformL
let pkgConfig :: PackageConfig
pkgConfig = PackageConfig
{ packageConfigEnableTests :: Bool
packageConfigEnableTests = Bool
False
, packageConfigEnableBenchmarks :: Bool
packageConfigEnableBenchmarks = Bool
False
, packageConfigFlags :: Map FlagName Bool
packageConfigFlags = Map FlagName Bool
flags
, packageConfigGhcOptions :: [Text]
packageConfigGhcOptions = [Text]
ghcOptions
, packageConfigCabalConfigOpts :: [Text]
packageConfigCabalConfigOpts = [Text]
cabalConfigOpts
, packageConfigCompilerVersion :: ActualCompiler
packageConfigCompilerVersion = ActualCompiler
compiler
, packageConfigPlatform :: Platform
packageConfigPlatform = Platform
platform
}
PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
pkgConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
PackageLocationImmutable -> RIO env GenericPackageDescription
loadCabalFileImmutable PackageLocationImmutable
loc
checkComponentsBuildable :: MonadThrow m => [LocalPackage] -> m ()
checkComponentsBuildable :: forall (m :: * -> *). MonadThrow m => [LocalPackage] -> m ()
checkComponentsBuildable [LocalPackage]
lps =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PackageName, NamedComponent)]
unbuildable) forall a b. (a -> b) -> a -> b
$
forall e (m :: * -> *) a.
(Exception e, MonadThrow m, Pretty e) =>
e -> m a
prettyThrowM forall a b. (a -> b) -> a -> b
$ [(PackageName, NamedComponent)] -> BuildPrettyException
SomeTargetsNotBuildable [(PackageName, NamedComponent)]
unbuildable
where
unbuildable :: [(PackageName, NamedComponent)]
unbuildable =
[ (Package -> PackageName
packageName (LocalPackage -> Package
lpPackage LocalPackage
lp), NamedComponent
c)
| LocalPackage
lp <- [LocalPackage]
lps
, NamedComponent
c <- forall a. Set a -> [a]
Set.toList (LocalPackage -> Set NamedComponent
lpUnbuildable LocalPackage
lp)
]
checkSubLibraryDependencies :: HasTerm env => [ProjectPackage] -> RIO env ()
checkSubLibraryDependencies :: forall env. HasTerm env => [ProjectPackage] -> RIO env ()
checkSubLibraryDependencies [ProjectPackage]
projectPackages =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ProjectPackage]
projectPackages forall a b. (a -> b) -> a -> b
$ \ProjectPackage
projectPackage -> do
C.GenericPackageDescription PackageDescription
pkgDesc Maybe Version
_ [PackageFlag]
_ Maybe (CondTree ConfVar [Dependency] Library)
lib [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
subLibs [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
foreignLibs [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
tests [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benches <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CommonPackage -> IO GenericPackageDescription
cpGPD forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectPackage -> CommonPackage
ppCommon forall a b. (a -> b) -> a -> b
$ ProjectPackage
projectPackage
let pName :: PackageName
pName = PackageIdentifier -> PackageName
pkgName forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
C.package forall a b. (a -> b) -> a -> b
$ PackageDescription
pkgDesc
dependencies :: [Dependency]
dependencies = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {v} {c} {a}. (a, CondTree v c a) -> c
getDeps [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
subLibs forall a. Semigroup a => a -> a -> a
<>
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {v} {c} {a}. (a, CondTree v c a) -> c
getDeps [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
foreignLibs forall a. Semigroup a => a -> a -> a
<>
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {v} {c} {a}. (a, CondTree v c a) -> c
getDeps [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes forall a. Semigroup a => a -> a -> a
<>
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {v} {c} {a}. (a, CondTree v c a) -> c
getDeps [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
tests forall a. Semigroup a => a -> a -> a
<>
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {v} {c} {a}. (a, CondTree v c a) -> c
getDeps [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benches forall a. Semigroup a => a -> a -> a
<>
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall v c a. CondTree v c a -> c
C.condTreeConstraints Maybe (CondTree ConfVar [Dependency] Library)
lib
notInternal :: Dependency -> Bool
notInternal (Dependency PackageName
pName' VersionRange
_ NonEmptySet LibraryName
_) = PackageName
pName' forall a. Eq a => a -> a -> Bool
/= PackageName
pName
publicDependencies :: [Dependency]
publicDependencies = forall a. (a -> Bool) -> [a] -> [a]
filter Dependency -> Bool
notInternal [Dependency]
dependencies
publicLibraries :: [LibraryName]
publicLibraries = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> NonEmptySet LibraryName
depLibraries) [Dependency]
publicDependencies
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([LibraryName] -> Bool
subLibDepExist [LibraryName]
publicLibraries) forall a b. (a -> b) -> a -> b
$
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
String -> m ()
prettyWarnS
String
"Sublibrary dependency is not supported, this will almost certainly \
\fail."
where
getDeps :: (a, CondTree v c a) -> c
getDeps (a
_, C.CondNode a
_ c
dep [CondBranch v c a]
_) = c
dep
subLibDepExist :: [LibraryName] -> Bool
subLibDepExist = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
( \case
C.LSubLibName UnqualComponentName
_ -> Bool
True
LibraryName
C.LMainLibName -> Bool
False
)