{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
module Stack.Build
( buildCmd
, build
, buildLocalTargets
, loadPackage
, mkBaseConfigOpts
, splitObjsWarning
) where
import Data.Attoparsec.Args ( EscapingMode (Escaping), parseArgs )
import Data.List ( (\\) )
import Data.List.Extra ( groupSort )
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import Distribution.Version ( mkVersion )
import RIO.NonEmpty ( nonEmpty )
import qualified RIO.NonEmpty as NE
import Stack.Build.ConstructPlan ( constructPlan )
import Stack.Build.Execute ( executePlan, preFetch, printPlan )
import Stack.Build.Installed ( getInstalled, toInstallMap )
import Stack.Build.Source ( localDependencies, projectLocalPackages )
import Stack.Build.Target ( NeedTargets (..) )
import Stack.FileWatch ( fileWatch, fileWatchPoll )
import Stack.Package ( buildableExes, resolvePackage )
import Stack.Prelude hiding ( loadPackage )
import Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig )
import Stack.Setup ( withNewLocalBuildTargets )
import Stack.Types.Build
( Plan (..), Task (..), TaskType (..), taskLocation
, taskProvides
)
import Stack.Types.Build.Exception
( BuildException (..), BuildPrettyException (..) )
import Stack.Types.BuildConfig ( HasBuildConfig, stackYamlL )
import Stack.Types.BuildOpts ( BuildOpts (..) )
import Stack.Types.BuildOptsCLI
( BuildCommand (..), BuildOptsCLI (..), FileWatchOpts (..) )
import Stack.Types.BuildOptsMonoid
( buildOptsMonoidBenchmarksL, buildOptsMonoidHaddockL
, buildOptsMonoidInstallExesL, buildOptsMonoidTestsL
)
import Stack.Types.Compiler ( getGhcVersion )
import Stack.Types.CompilerPaths ( cabalVersionL )
import Stack.Types.Config
( Config (..), HasConfig (..), buildOptsL
)
import Stack.Types.ConfigureOpts ( BaseConfigOpts (..) )
import Stack.Types.EnvConfig
( EnvConfig (..), HasEnvConfig (..), HasSourceMap
, actualCompilerVersionL, installationRootDeps
, installationRootLocal, packageDatabaseDeps
, packageDatabaseExtra, packageDatabaseLocal
)
import Stack.Types.GlobalOpts ( globalOptsBuildOptsMonoidL )
import Stack.Types.NamedComponent ( exeComponents )
import Stack.Types.Package
( InstallLocation (..), LocalPackage (..), Package (..)
, PackageConfig (..), lpFiles, lpFilesForComponents
)
import Stack.Types.Platform ( HasPlatform (..) )
import Stack.Types.Runner ( Runner, globalOptsL )
import Stack.Types.SourceMap
( SMTargets (..)
, SourceMap (..), Target (..) )
import System.Terminal ( fixCodePage )
newtype CabalVersionPrettyException
= CabalVersionNotSupported Version
deriving (Int -> CabalVersionPrettyException -> ShowS
[CabalVersionPrettyException] -> ShowS
CabalVersionPrettyException -> String
(Int -> CabalVersionPrettyException -> ShowS)
-> (CabalVersionPrettyException -> String)
-> ([CabalVersionPrettyException] -> ShowS)
-> Show CabalVersionPrettyException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CabalVersionPrettyException -> ShowS
showsPrec :: Int -> CabalVersionPrettyException -> ShowS
$cshow :: CabalVersionPrettyException -> String
show :: CabalVersionPrettyException -> String
$cshowList :: [CabalVersionPrettyException] -> ShowS
showList :: [CabalVersionPrettyException] -> ShowS
Show, Typeable)
instance Pretty CabalVersionPrettyException where
pretty :: CabalVersionPrettyException -> StyleDoc
pretty (CabalVersionNotSupported Version
cabalVer) =
StyleDoc
"[S-5973]"
StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ String -> StyleDoc
flow String
"Stack does not support Cabal versions before 1.24, but \
\version"
, String -> StyleDoc
forall a. IsString a => String -> a
fromString (String -> StyleDoc) -> String -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Version -> String
versionString Version
cabalVer
, String -> StyleDoc
flow String
"was found. To fix this, consider updating the snapshot to"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"lts-7.0"
, String -> StyleDoc
flow String
"or later or to"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"nightly-2016-05-26"
, String -> StyleDoc
flow String
"or later."
]
instance Exception CabalVersionPrettyException
buildCmd :: BuildOptsCLI -> RIO Runner ()
buildCmd :: BuildOptsCLI -> RIO Runner ()
buildCmd BuildOptsCLI
opts = do
Bool -> RIO Runner () -> RIO Runner ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String
"-prof" `elem`) ([String] -> Bool) -> (Text -> [String]) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Either String [String] -> [String]
forall b a. b -> Either a b -> b
fromRight [] (Either String [String] -> [String])
-> (Text -> Either String [String]) -> Text -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EscapingMode -> Text -> Either String [String]
parseArgs EscapingMode
Escaping) BuildOptsCLI
opts.ghcOptions) (RIO Runner () -> RIO Runner ()) -> RIO Runner () -> RIO Runner ()
forall a b. (a -> b) -> a -> b
$
BuildPrettyException -> RIO Runner ()
forall e (m :: * -> *) a.
(Exception e, MonadIO m, Pretty e) =>
e -> m a
prettyThrowIO BuildPrettyException
GHCProfOptionInvalid
(Runner -> Runner) -> RIO Runner () -> RIO Runner ()
forall a. (Runner -> Runner) -> RIO Runner a -> RIO Runner a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (ASetter Runner Runner GlobalOpts GlobalOpts
-> (GlobalOpts -> GlobalOpts) -> Runner -> Runner
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Runner Runner GlobalOpts GlobalOpts
forall env. HasRunner env => Lens' env GlobalOpts
Lens' Runner GlobalOpts
globalOptsL GlobalOpts -> GlobalOpts
modifyGO) (RIO Runner () -> RIO Runner ()) -> RIO Runner () -> RIO Runner ()
forall a b. (a -> b) -> a -> b
$
case BuildOptsCLI
opts.fileWatch of
FileWatchOpts
FileWatchPoll -> ((Set (Path Abs File) -> IO ()) -> RIO Runner ()) -> RIO Runner ()
forall env.
HasTerm env =>
((Set (Path Abs File) -> IO ()) -> RIO env ()) -> RIO env ()
fileWatchPoll (Maybe (Set (Path Abs File) -> IO ()) -> RIO Runner ()
inner (Maybe (Set (Path Abs File) -> IO ()) -> RIO Runner ())
-> ((Set (Path Abs File) -> IO ())
-> Maybe (Set (Path Abs File) -> IO ()))
-> (Set (Path Abs File) -> IO ())
-> RIO Runner ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (Path Abs File) -> IO ())
-> Maybe (Set (Path Abs File) -> IO ())
forall a. a -> Maybe a
Just)
FileWatchOpts
FileWatch -> ((Set (Path Abs File) -> IO ()) -> RIO Runner ()) -> RIO Runner ()
forall env.
HasTerm env =>
((Set (Path Abs File) -> IO ()) -> RIO env ()) -> RIO env ()
fileWatch (Maybe (Set (Path Abs File) -> IO ()) -> RIO Runner ()
inner (Maybe (Set (Path Abs File) -> IO ()) -> RIO Runner ())
-> ((Set (Path Abs File) -> IO ())
-> Maybe (Set (Path Abs File) -> IO ()))
-> (Set (Path Abs File) -> IO ())
-> RIO Runner ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (Path Abs File) -> IO ())
-> Maybe (Set (Path Abs File) -> IO ())
forall a. a -> Maybe a
Just)
FileWatchOpts
NoFileWatch -> Maybe (Set (Path Abs File) -> IO ()) -> RIO Runner ()
inner Maybe (Set (Path Abs File) -> IO ())
forall a. Maybe a
Nothing
where
inner ::
Maybe (Set (Path Abs File) -> IO ())
-> RIO Runner ()
inner :: Maybe (Set (Path Abs File) -> IO ()) -> RIO Runner ()
inner Maybe (Set (Path Abs File) -> IO ())
setLocalFiles = ShouldReexec -> RIO Config () -> RIO Runner ()
forall a. ShouldReexec -> RIO Config a -> RIO Runner a
withConfig ShouldReexec
YesReexec (RIO Config () -> RIO Runner ()) -> RIO Config () -> RIO Runner ()
forall a b. (a -> b) -> a -> b
$ NeedTargets -> BuildOptsCLI -> RIO EnvConfig () -> RIO Config ()
forall a.
NeedTargets -> BuildOptsCLI -> RIO EnvConfig a -> RIO Config a
withEnvConfig NeedTargets
NeedTargets BuildOptsCLI
opts (RIO EnvConfig () -> RIO Config ())
-> RIO EnvConfig () -> RIO Config ()
forall a b. (a -> b) -> a -> b
$
Maybe (Set (Path Abs File) -> IO ()) -> RIO EnvConfig ()
forall env.
HasEnvConfig env =>
Maybe (Set (Path Abs File) -> IO ()) -> RIO env ()
Stack.Build.build Maybe (Set (Path Abs File) -> IO ())
setLocalFiles
modifyGO :: GlobalOpts -> GlobalOpts
modifyGO =
case BuildOptsCLI
opts.command of
BuildCommand
Test -> ASetter GlobalOpts GlobalOpts (Maybe Bool) (Maybe Bool)
-> Maybe Bool -> GlobalOpts -> GlobalOpts
forall s t a b. ASetter s t a b -> b -> s -> t
set
((BuildOptsMonoid -> Identity BuildOptsMonoid)
-> GlobalOpts -> Identity GlobalOpts
Lens' GlobalOpts BuildOptsMonoid
globalOptsBuildOptsMonoidL ((BuildOptsMonoid -> Identity BuildOptsMonoid)
-> GlobalOpts -> Identity GlobalOpts)
-> ((Maybe Bool -> Identity (Maybe Bool))
-> BuildOptsMonoid -> Identity BuildOptsMonoid)
-> ASetter GlobalOpts GlobalOpts (Maybe Bool) (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Identity (Maybe Bool))
-> BuildOptsMonoid -> Identity BuildOptsMonoid
Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidTestsL)
(Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
BuildCommand
Haddock -> ASetter GlobalOpts GlobalOpts (Maybe Bool) (Maybe Bool)
-> Maybe Bool -> GlobalOpts -> GlobalOpts
forall s t a b. ASetter s t a b -> b -> s -> t
set
((BuildOptsMonoid -> Identity BuildOptsMonoid)
-> GlobalOpts -> Identity GlobalOpts
Lens' GlobalOpts BuildOptsMonoid
globalOptsBuildOptsMonoidL ((BuildOptsMonoid -> Identity BuildOptsMonoid)
-> GlobalOpts -> Identity GlobalOpts)
-> ((Maybe Bool -> Identity (Maybe Bool))
-> BuildOptsMonoid -> Identity BuildOptsMonoid)
-> ASetter GlobalOpts GlobalOpts (Maybe Bool) (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Identity (Maybe Bool))
-> BuildOptsMonoid -> Identity BuildOptsMonoid
Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidHaddockL)
(Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
BuildCommand
Bench -> ASetter GlobalOpts GlobalOpts (Maybe Bool) (Maybe Bool)
-> Maybe Bool -> GlobalOpts -> GlobalOpts
forall s t a b. ASetter s t a b -> b -> s -> t
set
((BuildOptsMonoid -> Identity BuildOptsMonoid)
-> GlobalOpts -> Identity GlobalOpts
Lens' GlobalOpts BuildOptsMonoid
globalOptsBuildOptsMonoidL ((BuildOptsMonoid -> Identity BuildOptsMonoid)
-> GlobalOpts -> Identity GlobalOpts)
-> ((Maybe Bool -> Identity (Maybe Bool))
-> BuildOptsMonoid -> Identity BuildOptsMonoid)
-> ASetter GlobalOpts GlobalOpts (Maybe Bool) (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Identity (Maybe Bool))
-> BuildOptsMonoid -> Identity BuildOptsMonoid
Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidBenchmarksL)
(Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
BuildCommand
Install -> ASetter GlobalOpts GlobalOpts (Maybe Bool) (Maybe Bool)
-> Maybe Bool -> GlobalOpts -> GlobalOpts
forall s t a b. ASetter s t a b -> b -> s -> t
set
((BuildOptsMonoid -> Identity BuildOptsMonoid)
-> GlobalOpts -> Identity GlobalOpts
Lens' GlobalOpts BuildOptsMonoid
globalOptsBuildOptsMonoidL ((BuildOptsMonoid -> Identity BuildOptsMonoid)
-> GlobalOpts -> Identity GlobalOpts)
-> ((Maybe Bool -> Identity (Maybe Bool))
-> BuildOptsMonoid -> Identity BuildOptsMonoid)
-> ASetter GlobalOpts GlobalOpts (Maybe Bool) (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Identity (Maybe Bool))
-> BuildOptsMonoid -> Identity BuildOptsMonoid
Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidInstallExesL)
(Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
BuildCommand
Build -> GlobalOpts -> GlobalOpts
forall a. a -> a
id
build :: HasEnvConfig env
=> Maybe (Set (Path Abs File) -> IO ())
-> RIO env ()
build :: forall env.
HasEnvConfig env =>
Maybe (Set (Path Abs File) -> IO ()) -> RIO env ()
build Maybe (Set (Path Abs File) -> IO ())
msetLocalFiles = do
Bool
mcp <- 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
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 (.modifyCodePage)
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
SimpleGetter env ActualCompiler
actualCompilerVersionL Getting 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 env a.
HasTerm env =>
Bool -> Version -> RIO env a -> RIO env 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
Lens' env 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
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 (.sourceMap)
[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
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
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 (.buildOptsCLI)
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)
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
boptsCli.watchAll
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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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 = LocalPackage
lp.package.name
case PackageName -> Map PackageName Target -> Maybe Target
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pn SourceMap
sourceMap.targets.targets of
Maybe Target
Nothing ->
Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall a. a -> RIO env a
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 a. IO a -> RIO env a
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
boptsCli.initialBuildSteps
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
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 (.allowLocals)
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 a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[PackageIdentifier]
localsIdents -> BuildException -> RIO env ()
forall e a. (HasCallStack, Exception e) => e -> RIO env a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (BuildException -> RIO env ()) -> BuildException -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [PackageIdentifier] -> BuildException
LocalPackagesPresent [PackageIdentifier]
localsIdents
RIO env ()
forall env. HasEnvConfig env => RIO env ()
checkCabalVersion
BuildOpts -> RIO env ()
forall env. HasTerm env => BuildOpts -> RIO env ()
warnAboutSplitObjs BuildOpts
bopts
[LocalPackage] -> Plan -> RIO env ()
forall env. HasTerm env => [LocalPackage] -> Plan -> RIO env ()
warnIfExecutablesWithSameNameCouldBeOverwritten [LocalPackage]
locals Plan
plan
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when BuildOpts
bopts.preFetch (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
boptsCli.dryrun
then Plan -> RIO env ()
forall env. (HasRunner env, HasTerm 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
SourceMap
sourceMap.targets.targets
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 =
RIO env () -> RIO env (Either SomeException ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (RIO env () -> RIO env (Either SomeException ()))
-> RIO env () -> RIO env (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ [Text] -> RIO env () -> RIO env ()
forall env a. HasEnvConfig env => [Text] -> RIO env a -> RIO env a
withNewLocalBuildTargets (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Text
targets) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Maybe (Set (Path Abs File) -> IO ()) -> RIO env ()
forall env.
HasEnvConfig env =>
Maybe (Set (Path Abs File) -> IO ()) -> RIO env ()
build Maybe (Set (Path Abs File) -> IO ())
forall a. Maybe a
Nothing
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
.
(.tasks)
checkCabalVersion :: HasEnvConfig env => RIO env ()
checkCabalVersion :: forall env. HasEnvConfig env => RIO env ()
checkCabalVersion = do
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
SimpleGetter env Version
cabalVersionL
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
24]) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$
CabalVersionPrettyException -> RIO env ()
forall e (m :: * -> *) a.
(Exception e, MonadThrow m, Pretty e) =>
e -> m a
prettyThrowM (CabalVersionPrettyException -> RIO env ())
-> CabalVersionPrettyException -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Version -> CabalVersionPrettyException
CabalVersionNotSupported Version
cabalVer
warnIfExecutablesWithSameNameCouldBeOverwritten ::
HasTerm env
=> [LocalPackage]
-> Plan
-> RIO env ()
warnIfExecutablesWithSameNameCouldBeOverwritten :: forall env. HasTerm env => [LocalPackage] -> Plan -> RIO env ()
warnIfExecutablesWithSameNameCouldBeOverwritten [LocalPackage]
locals Plan
plan = do
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 :: StyleDoc
exe_s
| [PackageName] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PackageName]
toBuild Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = String -> StyleDoc
flow String
"several executables with the same name:"
| Bool
otherwise = StyleDoc
"executable"
exesText :: [PackageName] -> StyleDoc
exesText [PackageName]
pkgs =
[StyleDoc] -> StyleDoc
fillSep ([StyleDoc] -> StyleDoc) -> [StyleDoc] -> StyleDoc
forall a b. (a -> b) -> a -> b
$ StyleDoc -> [StyleDoc] -> [StyleDoc]
punctuate
StyleDoc
","
[ Style -> StyleDoc -> StyleDoc
style
Style
PkgComponent
(String -> StyleDoc
forall a. IsString a => String -> a
fromString (String -> StyleDoc) -> String -> StyleDoc
forall a b. (a -> b) -> a -> b
$ PackageName -> String
packageNameString PackageName
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
exe)
| PackageName
p <- [PackageName]
pkgs
]
[StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL ([StyleDoc] -> RIO env ()) -> [StyleDoc] -> RIO env ()
forall a b. (a -> b) -> a -> b
$
[ StyleDoc
"Building"
, StyleDoc
exe_s
, [PackageName] -> StyleDoc
exesText [PackageName]
toBuild StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
[StyleDoc] -> [StyleDoc] -> [StyleDoc]
forall a. Semigroup a => a -> a -> a
<> [ [StyleDoc] -> StyleDoc
fillSep
[ String -> StyleDoc
flow String
"Only one of them will be available via"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"stack exec"
, String -> StyleDoc
flow String
"or locally installed."
]
| [PackageName] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PackageName]
toBuild Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
]
[StyleDoc] -> [StyleDoc] -> [StyleDoc]
forall a. Semigroup a => a -> a -> a
<> [ [StyleDoc] -> StyleDoc
fillSep
[ String -> StyleDoc
flow String
"Other executables with the same name might be overwritten:"
, [PackageName] -> StyleDoc
exesText [PackageName]
otherLocals StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
| Bool -> Bool
not ([PackageName] -> Bool
forall a. [a] -> 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
plan.tasks
, TTLocalMutable LocalPackage
lp <- [Task
task.taskType]
, 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
. (.components)) 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
pkg.name)
| Package
pkg <- (LocalPackage -> Package) -> [LocalPackage] -> [Package]
forall a b. (a -> b) -> [a] -> [b]
map (.package) [LocalPackage]
locals
, Text
exe <- Set Text -> [Text]
forall a. Set a -> [a]
Set.toList (Package -> Set Text
buildableExes Package
pkg)
]
collect :: Ord k => [(k, v)] -> Map k (NonEmpty v)
collect :: forall k v. Ord k => [(k, v)] -> Map k (NonEmpty v)
collect = ([v] -> Maybe (NonEmpty v)) -> Map k [v] -> Map k (NonEmpty v)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe [v] -> Maybe (NonEmpty v)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (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 :: HasTerm env => BuildOpts -> RIO env ()
warnAboutSplitObjs :: forall env. HasTerm env => BuildOpts -> RIO env ()
warnAboutSplitObjs BuildOpts
bopts | BuildOpts
bopts.splitObjs =
[StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
[ String -> StyleDoc
flow String
"Building with"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"--split-objs"
, String -> StyleDoc
flow String
"is enabled."
, String -> StyleDoc
flow String
splitObjsWarning
]
warnAboutSplitObjs BuildOpts
_ = () -> RIO env ()
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
splitObjsWarning :: String
splitObjsWarning :: String
splitObjsWarning =
String
"Note that this feature is EXPERIMENTAL, and its behavior may be changed and \
\improved. You will need to clean your workdirs before use. If you want to \
\compile all dependencies with split-objs, you will need to delete the \
\snapshot (and all snapshots that could reference that snapshot)."
mkBaseConfigOpts :: (HasEnvConfig env)
=> BuildOptsCLI -> RIO env BaseConfigOpts
mkBaseConfigOpts :: forall env.
HasEnvConfig env =>
BuildOptsCLI -> RIO env BaseConfigOpts
mkBaseConfigOpts BuildOptsCLI
buildOptsCLI = do
BuildOpts
buildOpts <- 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
Lens' env BuildOpts
buildOptsL
Path Abs Dir
snapDB <- RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseDeps
Path Abs Dir
localDB <- 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]
extraDBs <- RIO env [Path Abs Dir]
forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m) =>
m [Path Abs Dir]
packageDatabaseExtra
BaseConfigOpts -> RIO env BaseConfigOpts
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseConfigOpts
{ Path Abs Dir
snapDB :: Path Abs Dir
$sel:snapDB:BaseConfigOpts :: Path Abs Dir
snapDB
, Path Abs Dir
localDB :: Path Abs Dir
$sel:localDB:BaseConfigOpts :: Path Abs Dir
localDB
, Path Abs Dir
snapInstallRoot :: Path Abs Dir
$sel:snapInstallRoot:BaseConfigOpts :: Path Abs Dir
snapInstallRoot
, Path Abs Dir
localInstallRoot :: Path Abs Dir
$sel:localInstallRoot:BaseConfigOpts :: Path Abs Dir
localInstallRoot
, BuildOpts
buildOpts :: BuildOpts
$sel:buildOpts:BaseConfigOpts :: BuildOpts
buildOpts
, BuildOptsCLI
buildOptsCLI :: BuildOptsCLI
$sel:buildOptsCLI:BaseConfigOpts :: BuildOptsCLI
buildOptsCLI
, [Path Abs Dir]
extraDBs :: [Path Abs Dir]
$sel:extraDBs:BaseConfigOpts :: [Path Abs Dir]
extraDBs
}
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
compilerVersion <- 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
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
Lens' env Platform
platformL
let pkgConfig :: PackageConfig
pkgConfig = PackageConfig
{ $sel:enableTests:PackageConfig :: Bool
enableTests = Bool
False
, $sel:enableBenchmarks:PackageConfig :: Bool
enableBenchmarks = Bool
False
, Map FlagName Bool
flags :: Map FlagName Bool
$sel:flags:PackageConfig :: Map FlagName Bool
flags
, [Text]
ghcOptions :: [Text]
$sel:ghcOptions:PackageConfig :: [Text]
ghcOptions
, [Text]
cabalConfigOpts :: [Text]
$sel:cabalConfigOpts:PackageConfig :: [Text]
cabalConfigOpts
, ActualCompiler
compilerVersion :: ActualCompiler
$sel:compilerVersion:PackageConfig :: ActualCompiler
compilerVersion
, Platform
platform :: Platform
$sel:platform:PackageConfig :: 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
checkComponentsBuildable :: MonadThrow m => [LocalPackage] -> m ()
checkComponentsBuildable :: forall (m :: * -> *). MonadThrow m => [LocalPackage] -> m ()
checkComponentsBuildable [LocalPackage]
lps =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(PackageName, NamedComponent)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PackageName, NamedComponent)]
unbuildable) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
BuildPrettyException -> m ()
forall e (m :: * -> *) a.
(Exception e, MonadThrow m, Pretty e) =>
e -> m a
prettyThrowM (BuildPrettyException -> m ()) -> BuildPrettyException -> m ()
forall a b. (a -> b) -> a -> b
$ [(PackageName, NamedComponent)] -> BuildPrettyException
SomeTargetsNotBuildable [(PackageName, NamedComponent)]
unbuildable
where
unbuildable :: [(PackageName, NamedComponent)]
unbuildable =
[ (LocalPackage
lp.package.name, NamedComponent
c)
| LocalPackage
lp <- [LocalPackage]
lps
, NamedComponent
c <- Set NamedComponent -> [NamedComponent]
forall a. Set a -> [a]
Set.toList LocalPackage
lp.unbuildable
]