{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Stack.Build
(build
,loadPackage
,mkBaseConfigOpts
,queryBuildInfo
,splitObjsWarning
,CabalVersionException(..))
where
import Stack.Prelude hiding (loadPackage)
import Data.Aeson (Value (Object, Array), (.=), object)
import qualified Data.HashMap.Strict as HM
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.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 :: Maybe (Set (Path Abs File) -> IO ()) -> RIO env ()
build Maybe (Set (Path Abs File) -> IO ())
msetLocalFiles = do
Bool
mcp <- Getting Bool env Bool -> RIO env Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Bool env Bool -> RIO env Bool)
-> Getting Bool env Bool -> RIO env Bool
forall a b. (a -> b) -> a -> b
$ (Config -> Const Bool Config) -> env -> Const Bool env
forall env. HasConfig env => Lens' env Config
configL((Config -> Const Bool Config) -> env -> Const Bool env)
-> ((Bool -> Const Bool Bool) -> Config -> Const Bool Config)
-> Getting Bool env Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Bool) -> SimpleGetter Config Bool
forall s a. (s -> a) -> SimpleGetter s a
to Config -> Bool
configModifyCodePage
Version
ghcVersion <- Getting Version env Version -> RIO env Version
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Version env Version -> RIO env Version)
-> Getting Version env Version -> RIO env Version
forall a b. (a -> b) -> a -> b
$ Getting Version env ActualCompiler
forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionLGetting Version env ActualCompiler
-> ((Version -> Const Version Version)
-> ActualCompiler -> Const Version ActualCompiler)
-> Getting Version env Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ActualCompiler -> Version) -> SimpleGetter ActualCompiler Version
forall s a. (s -> a) -> SimpleGetter s a
to ActualCompiler -> Version
getGhcVersion
Bool -> Version -> RIO env () -> RIO env ()
forall x y a. x -> y -> a -> a
fixCodePage Bool
mcp Version
ghcVersion (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ do
BuildOpts
bopts <- Getting BuildOpts env BuildOpts -> RIO env BuildOpts
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildOpts env BuildOpts
forall s. HasConfig s => Lens' s BuildOpts
buildOptsL
SourceMap
sourceMap <- Getting SourceMap env SourceMap -> RIO env SourceMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting SourceMap env SourceMap -> RIO env SourceMap)
-> Getting SourceMap env SourceMap -> RIO env SourceMap
forall a b. (a -> b) -> a -> b
$ (EnvConfig -> Const SourceMap EnvConfig)
-> env -> Const SourceMap env
forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigL((EnvConfig -> Const SourceMap EnvConfig)
-> env -> Const SourceMap env)
-> ((SourceMap -> Const SourceMap SourceMap)
-> EnvConfig -> Const SourceMap EnvConfig)
-> Getting SourceMap env SourceMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EnvConfig -> SourceMap) -> SimpleGetter EnvConfig SourceMap
forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> SourceMap
envConfigSourceMap
[LocalPackage]
locals <- RIO env [LocalPackage]
forall env. HasEnvConfig env => RIO env [LocalPackage]
projectLocalPackages
[LocalPackage]
depsLocals <- RIO env [LocalPackage]
forall env. HasEnvConfig env => RIO env [LocalPackage]
localDependencies
let allLocals :: [LocalPackage]
allLocals = [LocalPackage]
locals [LocalPackage] -> [LocalPackage] -> [LocalPackage]
forall a. Semigroup a => a -> a -> a
<> [LocalPackage]
depsLocals
[ProjectPackage] -> RIO env ()
forall env. HasLogFunc env => [ProjectPackage] -> RIO env ()
checkSubLibraryDependencies (Map PackageName ProjectPackage -> [ProjectPackage]
forall k a. Map k a -> [a]
Map.elems (Map PackageName ProjectPackage -> [ProjectPackage])
-> Map PackageName ProjectPackage -> [ProjectPackage]
forall a b. (a -> b) -> a -> b
$ SourceMap -> Map PackageName ProjectPackage
smProject SourceMap
sourceMap)
BuildOptsCLI
boptsCli <- Getting BuildOptsCLI env BuildOptsCLI -> RIO env BuildOptsCLI
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting BuildOptsCLI env BuildOptsCLI -> RIO env BuildOptsCLI)
-> Getting BuildOptsCLI env BuildOptsCLI -> RIO env BuildOptsCLI
forall a b. (a -> b) -> a -> b
$ (EnvConfig -> Const BuildOptsCLI EnvConfig)
-> env -> Const BuildOptsCLI env
forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigL((EnvConfig -> Const BuildOptsCLI EnvConfig)
-> env -> Const BuildOptsCLI env)
-> ((BuildOptsCLI -> Const BuildOptsCLI BuildOptsCLI)
-> EnvConfig -> Const BuildOptsCLI EnvConfig)
-> Getting BuildOptsCLI env BuildOptsCLI
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EnvConfig -> BuildOptsCLI) -> SimpleGetter EnvConfig BuildOptsCLI
forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> BuildOptsCLI
envConfigBuildOptsCLI
Path Abs File
stackYaml <- Getting (Path Abs File) env (Path Abs File)
-> RIO env (Path Abs File)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Path Abs File) env (Path Abs File)
forall env. HasBuildConfig env => Lens' env (Path Abs File)
stackYamlL
Maybe (Set (Path Abs File) -> IO ())
-> ((Set (Path Abs File) -> IO ()) -> RIO env ()) -> RIO env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (Set (Path Abs File) -> IO ())
msetLocalFiles (((Set (Path Abs File) -> IO ()) -> RIO env ()) -> RIO env ())
-> ((Set (Path Abs File) -> IO ()) -> RIO env ()) -> RIO env ()
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 [RIO env (Set (Path Abs File))] -> RIO env [Set (Path Abs File)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [LocalPackage -> RIO env (Set (Path Abs File))
forall env.
HasEnvConfig env =>
LocalPackage -> RIO env (Set (Path Abs File))
lpFiles LocalPackage
lp | LocalPackage
lp <- [LocalPackage]
allLocals]
else [LocalPackage]
-> (LocalPackage -> RIO env (Set (Path Abs File)))
-> RIO env [Set (Path Abs File)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [LocalPackage]
allLocals ((LocalPackage -> RIO env (Set (Path Abs File)))
-> RIO env [Set (Path Abs File)])
-> (LocalPackage -> RIO env (Set (Path Abs File)))
-> RIO env [Set (Path Abs File)]
forall a b. (a -> b) -> a -> b
$ \LocalPackage
lp -> do
let pn :: PackageName
pn = Package -> PackageName
packageName (LocalPackage -> Package
lpPackage LocalPackage
lp)
case PackageName -> Map PackageName Target -> Maybe Target
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pn (SMTargets -> Map PackageName Target
smtTargets (SMTargets -> Map PackageName Target)
-> SMTargets -> Map PackageName Target
forall a b. (a -> b) -> a -> b
$ SourceMap -> SMTargets
smTargets SourceMap
sourceMap) of
Maybe Target
Nothing ->
Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set (Path Abs File)
forall a. Set a
Set.empty
Just (TargetAll PackageType
_) ->
LocalPackage -> RIO env (Set (Path Abs File))
forall env.
HasEnvConfig env =>
LocalPackage -> RIO env (Set (Path Abs File))
lpFiles LocalPackage
lp
Just (TargetComps Set NamedComponent
components) ->
Set NamedComponent -> LocalPackage -> RIO env (Set (Path Abs File))
forall env.
HasEnvConfig env =>
Set NamedComponent -> LocalPackage -> RIO env (Set (Path Abs File))
lpFilesForComponents Set NamedComponent
components LocalPackage
lp
IO () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> IO () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Set (Path Abs File) -> IO ()
setLocalFiles (Set (Path Abs File) -> IO ()) -> Set (Path Abs File) -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs File -> Set (Path Abs File) -> Set (Path Abs File)
forall a. Ord a => a -> Set a -> Set a
Set.insert Path Abs File
stackYaml (Set (Path Abs File) -> Set (Path Abs File))
-> Set (Path Abs File) -> Set (Path Abs File)
forall a b. (a -> b) -> a -> b
$ [Set (Path Abs File)] -> Set (Path Abs File)
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set (Path Abs File)]
files
[LocalPackage] -> RIO env ()
forall (m :: * -> *). MonadThrow m => [LocalPackage] -> m ()
checkComponentsBuildable [LocalPackage]
allLocals
InstallMap
installMap <- SourceMap -> RIO env InstallMap
forall (m :: * -> *). MonadIO m => SourceMap -> m InstallMap
toInstallMap SourceMap
sourceMap
(InstalledMap
installedMap, [DumpPackage]
globalDumpPkgs, [DumpPackage]
snapshotDumpPkgs, [DumpPackage]
localDumpPkgs) <-
InstallMap
-> RIO
env (InstalledMap, [DumpPackage], [DumpPackage], [DumpPackage])
forall env.
HasEnvConfig env =>
InstallMap
-> RIO
env (InstalledMap, [DumpPackage], [DumpPackage], [DumpPackage])
getInstalled InstallMap
installMap
BaseConfigOpts
baseConfigOpts <- BuildOptsCLI -> RIO env BaseConfigOpts
forall env.
HasEnvConfig env =>
BuildOptsCLI -> RIO env BaseConfigOpts
mkBaseConfigOpts BuildOptsCLI
boptsCli
Plan
plan <- BaseConfigOpts
-> [DumpPackage]
-> (PackageLocationImmutable
-> Map FlagName Bool -> [Text] -> [Text] -> RIO EnvConfig Package)
-> SourceMap
-> InstalledMap
-> Bool
-> RIO env 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 PackageLocationImmutable
-> Map FlagName Bool -> [Text] -> [Text] -> RIO EnvConfig Package
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 <- Getting Bool env Bool -> RIO env Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Bool env Bool -> RIO env Bool)
-> Getting Bool env Bool -> RIO env Bool
forall a b. (a -> b) -> a -> b
$ (Config -> Const Bool Config) -> env -> Const Bool env
forall env. HasConfig env => Lens' env Config
configL((Config -> Const Bool Config) -> env -> Const Bool env)
-> ((Bool -> Const Bool Bool) -> Config -> Const Bool Config)
-> Getting Bool env Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Bool) -> SimpleGetter Config Bool
forall s a. (s -> a) -> SimpleGetter s a
to Config -> Bool
configAllowLocals
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allowLocals (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ case Plan -> [PackageIdentifier]
justLocals Plan
plan of
[] -> () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[PackageIdentifier]
localsIdents -> StackBuildException -> RIO env ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (StackBuildException -> RIO env ())
-> StackBuildException -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [PackageIdentifier] -> StackBuildException
LocalPackagesPresent [PackageIdentifier]
localsIdents
RIO env ()
forall env. HasEnvConfig env => RIO env ()
checkCabalVersion
BuildOpts -> RIO env ()
forall env. HasLogFunc env => BuildOpts -> RIO env ()
warnAboutSplitObjs BuildOpts
bopts
[LocalPackage] -> Plan -> RIO env ()
forall env. HasLogFunc env => [LocalPackage] -> Plan -> RIO env ()
warnIfExecutablesWithSameNameCouldBeOverwritten [LocalPackage]
locals Plan
plan
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BuildOpts -> Bool
boptsPreFetch BuildOpts
bopts) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$
Plan -> RIO env ()
forall env. HasEnvConfig env => Plan -> RIO env ()
preFetch Plan
plan
if BuildOptsCLI -> Bool
boptsCLIDryrun BuildOptsCLI
boptsCli
then Plan -> RIO env ()
forall env. HasRunner env => Plan -> RIO env ()
printPlan Plan
plan
else BuildOptsCLI
-> BaseConfigOpts
-> [LocalPackage]
-> [DumpPackage]
-> [DumpPackage]
-> [DumpPackage]
-> InstalledMap
-> Map PackageName Target
-> Plan
-> RIO env ()
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 (SMTargets -> Map PackageName Target)
-> SMTargets -> Map PackageName Target
forall a b. (a -> b) -> a -> b
$ SourceMap -> SMTargets
smTargets SourceMap
sourceMap)
Plan
plan
justLocals :: Plan -> [PackageIdentifier]
justLocals :: Plan -> [PackageIdentifier]
justLocals =
(Task -> PackageIdentifier) -> [Task] -> [PackageIdentifier]
forall a b. (a -> b) -> [a] -> [b]
map Task -> PackageIdentifier
taskProvides ([Task] -> [PackageIdentifier])
-> (Plan -> [Task]) -> Plan -> [PackageIdentifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Task -> Bool) -> [Task] -> [Task]
forall a. (a -> Bool) -> [a] -> [a]
filter ((InstallLocation -> InstallLocation -> Bool
forall a. Eq a => a -> a -> Bool
== InstallLocation
Local) (InstallLocation -> Bool)
-> (Task -> InstallLocation) -> Task -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Task -> InstallLocation
taskLocation) ([Task] -> [Task]) -> (Plan -> [Task]) -> Plan -> [Task]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Map PackageName Task -> [Task]
forall k a. Map k a -> [a]
Map.elems (Map PackageName Task -> [Task])
-> (Plan -> Map PackageName Task) -> Plan -> [Task]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Plan -> Map PackageName Task
planTasks
checkCabalVersion :: HasEnvConfig env => RIO env ()
checkCabalVersion :: RIO env ()
checkCabalVersion = do
Bool
allowNewer <- Getting Bool env Bool -> RIO env Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Bool env Bool -> RIO env Bool)
-> Getting Bool env Bool -> RIO env Bool
forall a b. (a -> b) -> a -> b
$ (Config -> Const Bool Config) -> env -> Const Bool env
forall env. HasConfig env => Lens' env Config
configL((Config -> Const Bool Config) -> env -> Const Bool env)
-> ((Bool -> Const Bool Bool) -> Config -> Const Bool Config)
-> Getting Bool env Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Bool) -> SimpleGetter Config Bool
forall s a. (s -> a) -> SimpleGetter s a
to Config -> Bool
configAllowNewer
Version
cabalVer <- Getting Version env Version -> RIO env Version
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Version env Version
forall env. HasCompiler env => SimpleGetter env Version
cabalVersionL
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
allowNewer Bool -> Bool -> Bool
&& Version
cabalVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
1, Int
22]) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ CabalVersionException -> RIO env ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CabalVersionException -> RIO env ())
-> CabalVersionException -> RIO env ()
forall a b. (a -> b) -> a -> b
$
String -> CabalVersionException
CabalVersionException (String -> CabalVersionException)
-> String -> CabalVersionException
forall a b. (a -> b) -> a -> b
$
String
"Error: --allow-newer requires at least Cabal version 1.22, but version " String -> String -> String
forall a. [a] -> [a] -> [a]
++
Version -> String
versionString Version
cabalVer String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" was found."
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
cabalVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
1, Int
19, Int
2]) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ CabalVersionException -> RIO env ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CabalVersionException -> RIO env ())
-> CabalVersionException -> RIO env ()
forall a b. (a -> b) -> a -> b
$
String -> CabalVersionException
CabalVersionException (String -> CabalVersionException)
-> String -> CabalVersionException
forall a b. (a -> b) -> a -> b
$
String
"Stack no longer supports Cabal versions older than 1.19.2, but version " String -> String -> String
forall a. [a] -> [a] -> [a]
++
Version -> String
versionString Version
cabalVer String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" 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 -> String
unCabalVersionException :: String }
deriving (Typeable)
instance Show CabalVersionException where show :: CabalVersionException -> String
show = CabalVersionException -> String
unCabalVersionException
instance Exception CabalVersionException
warnIfExecutablesWithSameNameCouldBeOverwritten
:: HasLogFunc env => [LocalPackage] -> Plan -> RIO env ()
warnIfExecutablesWithSameNameCouldBeOverwritten :: [LocalPackage] -> Plan -> RIO env ()
warnIfExecutablesWithSameNameCouldBeOverwritten [LocalPackage]
locals Plan
plan = do
Utf8Builder -> RIO env ()
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"
[(Text, ([PackageName], [PackageName]))]
-> ((Text, ([PackageName], [PackageName])) -> RIO env ())
-> RIO env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Text ([PackageName], [PackageName])
-> [(Text, ([PackageName], [PackageName]))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text ([PackageName], [PackageName])
warnings) (((Text, ([PackageName], [PackageName])) -> RIO env ())
-> RIO env ())
-> ((Text, ([PackageName], [PackageName])) -> RIO env ())
-> RIO env ()
forall a b. (a -> b) -> a -> b
$ \(Text
exe,([PackageName]
toBuild,[PackageName]
otherLocals)) -> do
let exe_s :: Text
exe_s
| [PackageName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PackageName]
toBuild Int -> Int -> Bool
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
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (PackageName -> String
packageNameString PackageName
p) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
exe Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'" | PackageName
p <- [PackageName]
pkgs]
(Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn (Utf8Builder -> RIO env ())
-> ([[Text]] -> Utf8Builder) -> [[Text]] -> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Text -> Utf8Builder)
-> ([[Text]] -> Text) -> [[Text]] -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text) -> ([[Text]] -> [Text]) -> [[Text]] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat)
[ [ Text
"Building " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
exe_s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [PackageName] -> Text
exesText [PackageName]
toBuild Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." ]
, [ Text
"Only one of them will be available via 'stack exec' or locally installed."
| [PackageName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PackageName]
toBuild Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
]
, [ Text
"Other executables with the same name might be overwritten: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
[PackageName] -> Text
exesText [PackageName]
otherLocals Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
| Bool -> Bool
not ([PackageName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageName]
otherLocals)
]
]
where
warnings :: Map Text ([PackageName],[PackageName])
warnings :: Map Text ([PackageName], [PackageName])
warnings =
((NonEmpty PackageName, NonEmpty PackageName)
-> Maybe ([PackageName], [PackageName]))
-> Map Text (NonEmpty PackageName, NonEmpty PackageName)
-> Map Text ([PackageName], [PackageName])
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,NonEmpty PackageName -> [PackageName]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty PackageName
localPkgs [PackageName] -> [PackageName] -> [PackageName]
forall a. Eq a => [a] -> [a] -> [a]
\\ NonEmpty PackageName -> [PackageName]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty PackageName
pkgsToBuild) of
(PackageName
_ :| [],[]) ->
Maybe ([PackageName], [PackageName])
forall a. Maybe a
Nothing
(NonEmpty PackageName
_,[PackageName]
otherLocals) ->
([PackageName], [PackageName])
-> Maybe ([PackageName], [PackageName])
forall a. a -> Maybe a
Just (NonEmpty PackageName -> [PackageName]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty PackageName
pkgsToBuild,[PackageName]
otherLocals))
((NonEmpty PackageName
-> NonEmpty PackageName
-> (NonEmpty PackageName, NonEmpty PackageName))
-> Map Text (NonEmpty PackageName)
-> Map Text (NonEmpty PackageName)
-> Map Text (NonEmpty PackageName, NonEmpty PackageName)
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 =
[(Text, PackageName)] -> Map Text (NonEmpty PackageName)
forall k v. Ord k => [(k, v)] -> Map k (NonEmpty v)
collect
[ (Text
exe,PackageName
pkgName')
| (PackageName
pkgName',Task
task) <- Map PackageName Task -> [(PackageName, 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 <- (Set Text -> [Text]
forall a. Set a -> [a]
Set.toList (Set Text -> [Text])
-> (LocalPackage -> Set Text) -> LocalPackage -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set NamedComponent -> Set Text
exeComponents (Set NamedComponent -> Set Text)
-> (LocalPackage -> Set NamedComponent) -> LocalPackage -> Set Text
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 =
[(Text, PackageName)] -> Map Text (NonEmpty PackageName)
forall k v. Ord k => [(k, v)] -> Map k (NonEmpty v)
collect
[ (Text
exe,Package -> PackageName
packageName Package
pkg)
| Package
pkg <- (LocalPackage -> Package) -> [LocalPackage] -> [Package]
forall a b. (a -> b) -> [a] -> [b]
map LocalPackage -> Package
lpPackage [LocalPackage]
locals
, Text
exe <- Set Text -> [Text]
forall a. Set a -> [a]
Set.toList (Package -> Set Text
packageExes Package
pkg)
]
collect :: Ord k => [(k,v)] -> Map k (NonEmpty v)
collect :: [(k, v)] -> Map k (NonEmpty v)
collect = ([v] -> NonEmpty v) -> Map k [v] -> Map k (NonEmpty v)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map [v] -> NonEmpty v
forall a. [a] -> NonEmpty a
NE.fromList (Map k [v] -> Map k (NonEmpty v))
-> ([(k, v)] -> Map k [v]) -> [(k, v)] -> Map k (NonEmpty v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, [v])] -> Map k [v]
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(k, [v])] -> Map k [v])
-> ([(k, v)] -> [(k, [v])]) -> [(k, v)] -> Map k [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, v)] -> [(k, [v])]
forall k v. Ord k => [(k, v)] -> [(k, [v])]
groupSort
warnAboutSplitObjs :: HasLogFunc env => BuildOpts -> RIO env ()
warnAboutSplitObjs :: BuildOpts -> RIO env ()
warnAboutSplitObjs BuildOpts
bopts | BuildOpts -> Bool
boptsSplitObjs BuildOpts
bopts = do
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Building with --split-objs is enabled. " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString String
splitObjsWarning
warnAboutSplitObjs BuildOpts
_ = () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
splitObjsWarning :: String
splitObjsWarning :: String
splitObjsWarning = [String] -> String
unwords
[ String
"Note that this feature is EXPERIMENTAL, and its behavior may be changed and improved."
, String
"You will need to clean your workdirs before use. If you want to compile all dependencies"
, String
"with split-objs, you will need to delete the snapshot (and all snapshots that could"
, String
"reference that snapshot)."
]
mkBaseConfigOpts :: (HasEnvConfig env)
=> BuildOptsCLI -> RIO env BaseConfigOpts
mkBaseConfigOpts :: BuildOptsCLI -> RIO env BaseConfigOpts
mkBaseConfigOpts BuildOptsCLI
boptsCli = do
BuildOpts
bopts <- Getting BuildOpts env BuildOpts -> RIO env BuildOpts
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildOpts env BuildOpts
forall s. HasConfig s => Lens' s BuildOpts
buildOptsL
Path Abs Dir
snapDBPath <- RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseDeps
Path Abs Dir
localDBPath <- RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseLocal
Path Abs Dir
snapInstallRoot <- RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootDeps
Path Abs Dir
localInstallRoot <- RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootLocal
[Path Abs Dir]
packageExtraDBs <- RIO env [Path Abs Dir]
forall env (m :: * -> *).
(MonadReader env m, HasEnvConfig env) =>
m [Path Abs Dir]
packageDatabaseExtra
BaseConfigOpts -> RIO env BaseConfigOpts
forall (m :: * -> *) a. Monad m => a -> m a
return BaseConfigOpts :: Path Abs Dir
-> Path Abs Dir
-> Path Abs Dir
-> Path Abs Dir
-> BuildOpts
-> BuildOptsCLI
-> [Path Abs Dir]
-> BaseConfigOpts
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 :: PackageLocationImmutable
-> Map FlagName Bool -> [Text] -> [Text] -> RIO env Package
loadPackage PackageLocationImmutable
loc Map FlagName Bool
flags [Text]
ghcOptions [Text]
cabalConfigOpts = do
ActualCompiler
compiler <- Getting ActualCompiler env ActualCompiler -> RIO env ActualCompiler
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ActualCompiler env ActualCompiler
forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionL
Platform
platform <- Getting Platform env Platform -> RIO env Platform
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Platform env Platform
forall env. HasPlatform env => Lens' env Platform
platformL
let pkgConfig :: PackageConfig
pkgConfig = PackageConfig :: Bool
-> Bool
-> Map FlagName Bool
-> [Text]
-> [Text]
-> ActualCompiler
-> Platform
-> PackageConfig
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 (GenericPackageDescription -> Package)
-> RIO env GenericPackageDescription -> RIO env Package
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageLocationImmutable -> RIO env GenericPackageDescription
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
PackageLocationImmutable -> RIO env GenericPackageDescription
loadCabalFileImmutable PackageLocationImmutable
loc
queryBuildInfo :: HasEnvConfig env
=> [Text]
-> RIO env ()
queryBuildInfo :: [Text] -> RIO env ()
queryBuildInfo [Text]
selectors0 =
RIO env Value
forall env. HasEnvConfig env => RIO env Value
rawBuildInfo
RIO env Value -> (Value -> RIO env Value) -> RIO env Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Text] -> [Text]) -> [Text] -> Value -> RIO env Value
forall (m :: * -> *) c.
(MonadIO m, Show c) =>
([Text] -> c) -> [Text] -> Value -> m Value
select [Text] -> [Text]
forall a. a -> a
id [Text]
selectors0
RIO env Value -> (Value -> RIO env ()) -> RIO env ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> (Value -> IO ()) -> Value -> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> (Value -> Text) -> Value -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
addGlobalHintsComment (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
Yaml.encode
where
select :: ([Text] -> c) -> [Text] -> Value -> m Value
select [Text] -> c
_ [] Value
value = Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
value
select [Text] -> c
front (Text
sel:[Text]
sels) Value
value =
case Value
value of
Object Object
o ->
case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
sel Object
o of
Maybe Value
Nothing -> String -> m Value
forall (m :: * -> *) a. MonadIO m => String -> m a
err String
"Selector not found"
Just Value
value' -> Value -> m Value
cont Value
value'
Array Array
v ->
case Reader Int
forall a. Integral a => Reader a
decimal Text
sel of
Right (Int
i, Text
"")
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Array -> Int
forall a. Vector a -> Int
V.length Array
v -> Value -> m Value
cont (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Array
v Array -> Int -> Value
forall a. Vector a -> Int -> a
V.! Int
i
| Bool
otherwise -> String -> m Value
forall (m :: * -> *) a. MonadIO m => String -> m a
err String
"Index out of range"
Either String (Int, Text)
_ -> String -> m Value
forall (m :: * -> *) a. MonadIO m => String -> m a
err String
"Encountered array and needed numeric selector"
Value
_ -> String -> m Value
forall (m :: * -> *) a. MonadIO m => String -> m a
err (String -> m Value) -> String -> m Value
forall a b. (a -> b) -> a -> b
$ String
"Cannot apply selector to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
value
where
cont :: Value -> m Value
cont = ([Text] -> c) -> [Text] -> Value -> m Value
select ([Text] -> c
front ([Text] -> c) -> ([Text] -> [Text]) -> [Text] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
selText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)) [Text]
sels
err :: String -> m a
err String
msg = String -> m a
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ c -> String
forall a. Show a => a -> String
show ([Text] -> c
front [Text
sel])
addGlobalHintsComment :: Text -> Text
addGlobalHintsComment
| [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
selectors0 = Text -> Text -> Text -> Text
T.replace Text
globalHintsLine (Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
globalHintsComment Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
globalHintsLine)
| [Text
"global-hints"] [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Text]
selectors0 = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
globalHintsComment))
| Bool
otherwise = Text -> Text
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 :: RIO env Value
rawBuildInfo = do
[LocalPackage]
locals <- RIO env [LocalPackage]
forall env. HasEnvConfig env => RIO env [LocalPackage]
projectLocalPackages
Text
wantedCompiler <- Getting Text env Text -> RIO env Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Text env Text -> RIO env Text)
-> Getting Text env Text -> RIO env Text
forall a b. (a -> b) -> a -> b
$ Getting Text env WantedCompiler
forall s r. HasBuildConfig s => Getting r s WantedCompiler
wantedCompilerVersionLGetting Text env WantedCompiler
-> ((Text -> Const Text Text)
-> WantedCompiler -> Const Text WantedCompiler)
-> Getting Text env Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(WantedCompiler -> Text) -> SimpleGetter WantedCompiler Text
forall s a. (s -> a) -> SimpleGetter s a
to (Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (WantedCompiler -> Utf8Builder) -> WantedCompiler -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WantedCompiler -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display)
Text
actualCompiler <- Getting Text env Text -> RIO env Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Text env Text -> RIO env Text)
-> Getting Text env Text -> RIO env Text
forall a b. (a -> b) -> a -> b
$ Getting Text env ActualCompiler
forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionLGetting Text env ActualCompiler
-> ((Text -> Const Text Text)
-> ActualCompiler -> Const Text ActualCompiler)
-> Getting Text env Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ActualCompiler -> Text) -> SimpleGetter ActualCompiler Text
forall s a. (s -> a) -> SimpleGetter s a
to ActualCompiler -> Text
compilerVersionText
Value -> RIO env Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> RIO env Value) -> Value -> RIO env Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
[ Text
"locals" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Object -> Value
Object ([Pair] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([Pair] -> Object) -> [Pair] -> Object
forall a b. (a -> b) -> a -> b
$ (LocalPackage -> Pair) -> [LocalPackage] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map LocalPackage -> Pair
localToPair [LocalPackage]
locals)
, Text
"compiler" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object
[ Text
"wanted" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
wantedCompiler
, Text
"actual" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
actualCompiler
]
]
where
localToPair :: LocalPackage -> Pair
localToPair LocalPackage
lp =
(String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PackageName -> String
packageNameString (PackageName -> String) -> PackageName -> String
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
[ Text
"version" Text -> CabalString Version -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Version -> CabalString Version
forall a. a -> CabalString a
CabalString (Package -> Version
packageVersion Package
p)
, Text
"path" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent (Path Abs File -> Path Abs Dir) -> Path Abs File -> Path Abs Dir
forall a b. (a -> b) -> a -> b
$ LocalPackage -> Path Abs File
lpCabalFile LocalPackage
lp)
]
checkComponentsBuildable :: MonadThrow m => [LocalPackage] -> m ()
checkComponentsBuildable :: [LocalPackage] -> m ()
checkComponentsBuildable [LocalPackage]
lps =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(PackageName, NamedComponent)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PackageName, NamedComponent)]
unbuildable) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ StackBuildException -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (StackBuildException -> m ()) -> StackBuildException -> m ()
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 <- Set NamedComponent -> [NamedComponent]
forall a. Set a -> [a]
Set.toList (LocalPackage -> Set NamedComponent
lpUnbuildable LocalPackage
lp)
]
checkSubLibraryDependencies :: HasLogFunc env => [ProjectPackage] -> RIO env ()
checkSubLibraryDependencies :: [ProjectPackage] -> RIO env ()
checkSubLibraryDependencies [ProjectPackage]
proj = do
[ProjectPackage] -> (ProjectPackage -> RIO env ()) -> RIO env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ProjectPackage]
proj ((ProjectPackage -> RIO env ()) -> RIO env ())
-> (ProjectPackage -> RIO env ()) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ \ProjectPackage
p -> do
C.GenericPackageDescription PackageDescription
_ [Flag]
_ 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 <- IO GenericPackageDescription -> RIO env GenericPackageDescription
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GenericPackageDescription -> RIO env GenericPackageDescription)
-> IO GenericPackageDescription
-> RIO env GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ CommonPackage -> IO GenericPackageDescription
cpGPD (CommonPackage -> IO GenericPackageDescription)
-> (ProjectPackage -> CommonPackage)
-> ProjectPackage
-> IO GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectPackage -> CommonPackage
ppCommon (ProjectPackage -> IO GenericPackageDescription)
-> ProjectPackage -> IO GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ ProjectPackage
p
let dependencies :: [Dependency]
dependencies = ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> [Dependency])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> [Dependency]
forall a v c a. (a, CondTree v c a) -> c
getDeps [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
subLibs [Dependency] -> [Dependency] -> [Dependency]
forall a. Semigroup a => a -> a -> a
<>
((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> [Dependency])
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
-> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> [Dependency]
forall a v c a. (a, CondTree v c a) -> c
getDeps [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
foreignLibs [Dependency] -> [Dependency] -> [Dependency]
forall a. Semigroup a => a -> a -> a
<>
((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> [Dependency])
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
-> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> [Dependency]
forall a v c a. (a, CondTree v c a) -> c
getDeps [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes [Dependency] -> [Dependency] -> [Dependency]
forall a. Semigroup a => a -> a -> a
<>
((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> [Dependency])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> [Dependency]
forall a v c a. (a, CondTree v c a) -> c
getDeps [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
tests [Dependency] -> [Dependency] -> [Dependency]
forall a. Semigroup a => a -> a -> a
<>
((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> [Dependency])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> [Dependency]
forall a v c a. (a, CondTree v c a) -> c
getDeps [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benches [Dependency] -> [Dependency] -> [Dependency]
forall a. Semigroup a => a -> a -> a
<>
[Dependency]
-> (CondTree ConfVar [Dependency] Library -> [Dependency])
-> Maybe (CondTree ConfVar [Dependency] Library)
-> [Dependency]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] CondTree ConfVar [Dependency] Library -> [Dependency]
forall v c a. CondTree v c a -> c
C.condTreeConstraints Maybe (CondTree ConfVar [Dependency] Library)
lib
libraries :: [LibraryName]
libraries = (Dependency -> [LibraryName]) -> [Dependency] -> [LibraryName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Set LibraryName -> [LibraryName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set LibraryName -> [LibraryName])
-> (Dependency -> Set LibraryName) -> Dependency -> [LibraryName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> Set LibraryName
depLibraries) [Dependency]
dependencies
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([LibraryName] -> Bool
forall (t :: * -> *). Foldable t => t LibraryName -> Bool
subLibDepExist [LibraryName]
libraries)
(Utf8Builder -> RIO env ()
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 =
(LibraryName -> Bool) -> t LibraryName -> Bool
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