{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Stack.Build
(build
,buildLocalTargets
,loadPackage
,mkBaseConfigOpts
,queryBuildInfo
,splitObjsWarning
,CabalVersionException(..))
where
import Stack.Prelude hiding (loadPackage)
import Data.Aeson (Value (Object, Array), (.=), object)
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import Data.List ((\\), isPrefixOf)
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 Data.Text.Encoding (decodeUtf8)
import qualified Data.Text.IO as TIO
import Data.Text.Read (decimal)
import qualified Data.Vector as V
import qualified Data.Yaml as Yaml
import qualified Distribution.PackageDescription as C
import Distribution.Types.Dependency (depLibraries)
import Distribution.Version (mkVersion)
import Path (parent)
import Stack.Build.ConstructPlan
import Stack.Build.Execute
import Stack.Build.Installed
import Stack.Build.Source
import Stack.Package
import Stack.Setup (withNewLocalBuildTargets)
import Stack.Types.Build
import Stack.Types.Config
import Stack.Types.NamedComponent
import Stack.Types.Package
import Stack.Types.SourceMap
import Stack.Types.Compiler (compilerVersionText, getGhcVersion)
import System.Terminal (fixCodePage)
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. HasLogFunc 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 (m :: * -> *) a. Monad m => a -> m a
return ()
[PackageIdentifier]
localsIdents -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ [PackageIdentifier] -> StackBuildException
LocalPackagesPresent [PackageIdentifier]
localsIdents
forall env. HasEnvConfig env => RIO env ()
checkCabalVersion
forall env. HasLogFunc env => BuildOpts -> RIO env ()
warnAboutSplitObjs BuildOpts
bopts
forall env. HasLogFunc 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 => 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
Bool
allowNewer <- 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
configAllowNewer
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 (Bool
allowNewer Bool -> Bool -> Bool
&& Version
cabalVer forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
1, Int
22]) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
[Char] -> CabalVersionException
CabalVersionException forall a b. (a -> b) -> a -> b
$
[Char]
"Error: --allow-newer requires at least Cabal version 1.22, but version " forall a. [a] -> [a] -> [a]
++
Version -> [Char]
versionString Version
cabalVer forall a. [a] -> [a] -> [a]
++
[Char]
" was found."
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
cabalVer forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
1, Int
19, Int
2]) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
[Char] -> CabalVersionException
CabalVersionException forall a b. (a -> b) -> a -> b
$
[Char]
"Stack no longer supports Cabal versions older than 1.19.2, but version " forall a. [a] -> [a] -> [a]
++
Version -> [Char]
versionString Version
cabalVer forall a. [a] -> [a] -> [a]
++
[Char]
" was found. To fix this, consider updating the resolver to lts-3.0 or later / nightly-2015-05-05 or later."
newtype CabalVersionException = CabalVersionException { CabalVersionException -> [Char]
unCabalVersionException :: String }
deriving (Typeable)
instance Show CabalVersionException where show :: CabalVersionException -> [Char]
show = CabalVersionException -> [Char]
unCabalVersionException
instance Exception CabalVersionException
warnIfExecutablesWithSameNameCouldBeOverwritten
:: HasLogFunc env => [LocalPackage] -> Plan -> RIO env ()
warnIfExecutablesWithSameNameCouldBeOverwritten :: forall env. HasLogFunc 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 :: Text
exe_s
| forall (t :: * -> *) a. Foldable t => t a -> Int
length [PackageName]
toBuild forall a. Ord a => a -> a -> Bool
> Int
1 = Text
"several executables with the same name:"
| Bool
otherwise = Text
"executable"
exesText :: [PackageName] -> Text
exesText [PackageName]
pkgs =
Text -> [Text] -> Text
T.intercalate
Text
", "
[Text
"'" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (PackageName -> [Char]
packageNameString PackageName
p) forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
exe forall a. Semigroup a => a -> a -> a
<> Text
"'" | PackageName
p <- [PackageName]
pkgs]
(forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat)
[ [ Text
"Building " forall a. Semigroup a => a -> a -> a
<> Text
exe_s forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> [PackageName] -> Text
exesText [PackageName]
toBuild forall a. Semigroup a => a -> a -> a
<> Text
"." ]
, [ Text
"Only one of them will be available via 'stack exec' or locally installed."
| forall (t :: * -> *) a. Foldable t => t a -> Int
length [PackageName]
toBuild forall a. Ord a => a -> a -> Bool
> Int
1
]
, [ Text
"Other executables with the same name might be overwritten: " forall a. Semigroup a => a -> a -> a
<>
[PackageName] -> Text
exesText [PackageName]
otherLocals forall a. Semigroup a => a -> a -> a
<> Text
"."
| 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 :: HasLogFunc env => BuildOpts -> RIO env ()
warnAboutSplitObjs :: forall env. HasLogFunc env => BuildOpts -> RIO env ()
warnAboutSplitObjs BuildOpts
bopts | BuildOpts -> Bool
boptsSplitObjs BuildOpts
bopts = do
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Building with --split-objs is enabled. " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => [Char] -> a
fromString [Char]
splitObjsWarning
warnAboutSplitObjs BuildOpts
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
splitObjsWarning :: String
splitObjsWarning :: [Char]
splitObjsWarning = [[Char]] -> [Char]
unwords
[ [Char]
"Note that this feature is EXPERIMENTAL, and its behavior may be changed and improved."
, [Char]
"You will need to clean your workdirs before use. If you want to compile all dependencies"
, [Char]
"with split-objs, you will need to delete the snapshot (and all snapshots that could"
, [Char]
"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 :: * -> *).
(MonadReader env m, HasEnvConfig env) =>
m [Path Abs Dir]
packageDatabaseExtra
forall (m :: * -> *) a. Monad m => a -> m a
return 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
queryBuildInfo :: HasEnvConfig env
=> [Text]
-> RIO env ()
queryBuildInfo :: forall env. HasEnvConfig env => [Text] -> RIO env ()
queryBuildInfo [Text]
selectors0 =
forall env. HasEnvConfig env => RIO env Value
rawBuildInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {a}.
(MonadIO m, Show a) =>
([Text] -> a) -> [Text] -> Value -> m Value
select forall a. a -> a
id [Text]
selectors0
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
TIO.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
addGlobalHintsComment forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
Yaml.encode
where
select :: ([Text] -> a) -> [Text] -> Value -> m Value
select [Text] -> a
_ [] Value
value = forall (m :: * -> *) a. Monad m => a -> m a
return Value
value
select [Text] -> a
front (Text
sel:[Text]
sels) Value
value =
case Value
value of
Object Object
o ->
case forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (Text -> Key
Key.fromText Text
sel) Object
o of
Maybe Value
Nothing -> forall {m :: * -> *} {a}. MonadIO m => [Char] -> m a
err [Char]
"Selector not found"
Just Value
value' -> Value -> m Value
cont Value
value'
Array Array
v ->
case forall a. Integral a => Reader a
decimal Text
sel of
Right (Int
i, Text
"")
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
< forall a. Vector a -> Int
V.length Array
v -> Value -> m Value
cont forall a b. (a -> b) -> a -> b
$ Array
v forall a. Vector a -> Int -> a
V.! Int
i
| Bool
otherwise -> forall {m :: * -> *} {a}. MonadIO m => [Char] -> m a
err [Char]
"Index out of range"
Either [Char] (Int, Text)
_ -> forall {m :: * -> *} {a}. MonadIO m => [Char] -> m a
err [Char]
"Encountered array and needed numeric selector"
Value
_ -> forall {m :: * -> *} {a}. MonadIO m => [Char] -> m a
err forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot apply selector to " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Value
value
where
cont :: Value -> m Value
cont = ([Text] -> a) -> [Text] -> Value -> m Value
select ([Text] -> a
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
selforall a. a -> [a] -> [a]
:)) [Text]
sels
err :: [Char] -> m a
err [Char]
msg = forall (m :: * -> *) a. (MonadIO m, HasCallStack) => [Char] -> m a
throwString forall a b. (a -> b) -> a -> b
$ [Char]
msg forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ([Text] -> a
front [Text
sel])
addGlobalHintsComment :: Text -> Text
addGlobalHintsComment
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
selectors0 = Text -> Text -> Text -> Text
T.replace Text
globalHintsLine (Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
globalHintsComment forall a. Semigroup a => a -> a -> a
<> Text
globalHintsLine)
| [Text
"global-hints"] forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Text]
selectors0 = (forall a. Semigroup a => a -> a -> a
<> (Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
globalHintsComment))
| Bool
otherwise = forall a. a -> a
id
globalHintsLine :: Text
globalHintsLine = Text
"\nglobal-hints:\n"
globalHintsComment :: Text
globalHintsComment = [Text] -> Text
T.concat
[ Text
"# Note: global-hints is experimental and may be renamed / removed in the future.\n"
, Text
"# See https://github.com/commercialhaskell/stack/issues/3796"
]
rawBuildInfo :: HasEnvConfig env => RIO env Value
rawBuildInfo :: forall env. HasEnvConfig env => RIO env Value
rawBuildInfo = do
[LocalPackage]
locals <- forall env. HasEnvConfig env => RIO env [LocalPackage]
projectLocalPackages
Text
wantedCompiler <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall s r. HasBuildConfig s => Getting r s WantedCompiler
wantedCompilerVersionLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to (Utf8Builder -> Text
utf8BuilderToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display)
Text
actualCompiler <- 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 -> Text
compilerVersionText
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
[ Key
"locals" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Object -> Value
Object (forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LocalPackage -> Pair
localToPair [LocalPackage]
locals)
, Key
"compiler" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
[ Key
"wanted" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
wantedCompiler
, Key
"actual" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
actualCompiler
]
]
where
localToPair :: LocalPackage -> Pair
localToPair LocalPackage
lp =
(Text -> Key
Key.fromText forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ PackageName -> [Char]
packageNameString forall a b. (a -> b) -> a -> b
$ Package -> PackageName
packageName Package
p, Value
value)
where
p :: Package
p = LocalPackage -> Package
lpPackage LocalPackage
lp
value :: Value
value = [Pair] -> Value
object
[ Key
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. a -> CabalString a
CabalString (Package -> Version
packageVersion Package
p)
, Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall b t. Path b t -> [Char]
toFilePath (forall b t. Path b t -> Path b Dir
parent forall a b. (a -> b) -> a -> b
$ LocalPackage -> Path Abs File
lpCabalFile LocalPackage
lp)
]
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 (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ [(PackageName, NamedComponent)] -> StackBuildException
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 :: HasLogFunc env => [ProjectPackage] -> RIO env ()
checkSubLibraryDependencies :: forall env. HasLogFunc env => [ProjectPackage] -> RIO env ()
checkSubLibraryDependencies [ProjectPackage]
proj = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ProjectPackage]
proj forall a b. (a -> b) -> a -> b
$ \ProjectPackage
p -> do
C.GenericPackageDescription PackageDescription
_ 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
p
let 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
libraries :: [LibraryName]
libraries = 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]
dependencies
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {t :: * -> *}. Foldable t => t LibraryName -> Bool
subLibDepExist [LibraryName]
libraries)
(forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"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 :: t LibraryName -> Bool
subLibDepExist t LibraryName
lib =
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\LibraryName
x ->
case LibraryName
x of
C.LSubLibName UnqualComponentName
_ -> Bool
True
LibraryName
C.LMainLibName -> Bool
False
) t LibraryName
lib