{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Stack.Build
( build
, buildLocalTargets
, loadPackage
, mkBaseConfigOpts
, queryBuildInfo
, splitObjsWarning
, CabalVersionException (..)
) where
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.Prelude hiding ( loadPackage )
import Stack.Setup ( withNewLocalBuildTargets )
import Stack.Types.Build
import Stack.Types.Compiler ( compilerVersionText, getGhcVersion )
import Stack.Types.Config
import Stack.Types.NamedComponent
import Stack.Types.Package
import Stack.Types.SourceMap
import System.Terminal ( fixCodePage )
data CabalVersionException
= AllowNewerNotSupported Version
| CabalVersionNotSupported Version
deriving (Int -> CabalVersionException -> ShowS
[CabalVersionException] -> ShowS
CabalVersionException -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CabalVersionException] -> ShowS
$cshowList :: [CabalVersionException] -> ShowS
show :: CabalVersionException -> [Char]
$cshow :: CabalVersionException -> [Char]
showsPrec :: Int -> CabalVersionException -> ShowS
$cshowsPrec :: Int -> CabalVersionException -> ShowS
Show, Typeable)
instance Exception CabalVersionException where
displayException :: CabalVersionException -> [Char]
displayException (AllowNewerNotSupported Version
cabalVer) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
"Error: [S-8503]\n"
, [Char]
"'--allow-newer' requires Cabal version 1.22 or greater, but "
, [Char]
"version "
, Version -> [Char]
versionString Version
cabalVer
, [Char]
" was found."
]
displayException (CabalVersionNotSupported Version
cabalVer) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
"Error: [S-5973]\n"
, [Char]
"Stack no longer supports Cabal versions before 1.19.2, "
, [Char]
"but version "
, Version -> [Char]
versionString Version
cabalVer
, [Char]
" was found. To fix this, consider updating the resolver to lts-3.0 "
, [Char]
"or later or to nightly-2015-05-05 or later."
]
data QueryException
= SelectorNotFound [Text]
| IndexOutOfRange [Text]
| NoNumericSelector [Text]
| CannotApplySelector Value [Text]
deriving (Int -> QueryException -> ShowS
[QueryException] -> ShowS
QueryException -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [QueryException] -> ShowS
$cshowList :: [QueryException] -> ShowS
show :: QueryException -> [Char]
$cshow :: QueryException -> [Char]
showsPrec :: Int -> QueryException -> ShowS
$cshowsPrec :: Int -> QueryException -> ShowS
Show, Typeable)
instance Exception QueryException where
displayException :: QueryException -> [Char]
displayException (SelectorNotFound [Text]
sels) =
[Char] -> [Char] -> [Text] -> [Char]
err [Char]
"[S-4419]" [Char]
"Selector not found" [Text]
sels
displayException (IndexOutOfRange [Text]
sels) =
[Char] -> [Char] -> [Text] -> [Char]
err [Char]
"[S-8422]" [Char]
"Index out of range" [Text]
sels
displayException (NoNumericSelector [Text]
sels) =
[Char] -> [Char] -> [Text] -> [Char]
err [Char]
"[S-4360]" [Char]
"Encountered array and needed numeric selector" [Text]
sels
displayException (CannotApplySelector Value
value [Text]
sels) =
[Char] -> [Char] -> [Text] -> [Char]
err [Char]
"[S-1711]" ([Char]
"Cannot apply selector to " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Value
value) [Text]
sels
err :: String -> String -> [Text] -> String
err :: [Char] -> [Char] -> [Text] -> [Char]
err [Char]
msg [Char]
code [Text]
sels = [Char]
"Error: " forall a. [a] -> [a] -> [a]
++ [Char]
code forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++ [Char]
msg forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Text]
sels
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 (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. 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
$
Version -> CabalVersionException
AllowNewerNotSupported Version
cabalVer
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
$
Version -> CabalVersionException
CabalVersionNotSupported Version
cabalVer
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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
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 (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
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 {f :: * -> *}.
MonadIO f =>
([Text] -> [Text]) -> [Text] -> Value -> f 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] -> [Text]) -> [Text] -> Value -> f Value
select [Text] -> [Text]
_ [] Value
value = forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
value
select [Text] -> [Text]
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 :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ [Text] -> QueryException
SelectorNotFound [Text]
sels'
Just Value
value' -> Value -> f 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 -> f Value
cont forall a b. (a -> b) -> a -> b
$ Array
v forall a. Vector a -> Int -> a
V.! Int
i
| Bool
otherwise -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ [Text] -> QueryException
IndexOutOfRange [Text]
sels'
Either [Char] (Int, Text)
_ -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ [Text] -> QueryException
NoNumericSelector [Text]
sels'
Value
_ -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Value -> [Text] -> QueryException
CannotApplySelector Value
value [Text]
sels'
where
cont :: Value -> f Value
cont = ([Text] -> [Text]) -> [Text] -> Value -> f Value
select ([Text] -> [Text]
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
selforall a. a -> [a] -> [a]
:)) [Text]
sels
sels' :: [Text]
sels' = [Text] -> [Text]
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 (f :: * -> *) a. Applicative f => a -> f a
pure 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)] -> BuildException
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