{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}

-- | Build the project.


module Stack.Build
  ( buildCmd
  , build
  , buildLocalTargets
  , loadPackage
  , mkBaseConfigOpts
  , splitObjsWarning
  ) where

import           Data.Attoparsec.Args ( EscapingMode (Escaping), parseArgs )
import           Data.List ( (\\) )
import           Data.List.Extra ( groupSort )
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Distribution.PackageDescription as C
import           Distribution.Types.Dependency ( Dependency (..), depLibraries )
import           Distribution.Version ( mkVersion )
import           Stack.Build.ConstructPlan ( constructPlan )
import           Stack.Build.Execute ( executePlan, preFetch, printPlan )
import           Stack.Build.Installed ( getInstalled, toInstallMap )
import           Stack.Build.Source ( localDependencies, projectLocalPackages )
import           Stack.Build.Target ( NeedTargets (..) )
import           Stack.FileWatch ( fileWatch, fileWatchPoll )
import           Stack.Package ( resolvePackage )
import           Stack.Prelude hiding ( loadPackage )
import           Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig )
import           Stack.Setup ( withNewLocalBuildTargets )
import           Stack.Types.Build
                   ( Plan (..), Task (..), TaskType (..), taskLocation )
import           Stack.Types.Build.Exception
                   ( BuildException (..), BuildPrettyException (..) )
import           Stack.Types.BuildConfig ( HasBuildConfig, stackYamlL )
import           Stack.Types.BuildOpts
                   ( BuildCommand (..), BuildOpts (..), BuildOptsCLI (..)
                   , FileWatchOpts (..), buildOptsMonoidBenchmarksL
                   , buildOptsMonoidHaddockL, buildOptsMonoidInstallExesL
                   , buildOptsMonoidTestsL
                   )
import           Stack.Types.Compiler ( getGhcVersion )
import           Stack.Types.CompilerPaths ( cabalVersionL )
import           Stack.Types.Config
                   ( Config (..), HasConfig (..), buildOptsL
                   )
import           Stack.Types.ConfigureOpts ( BaseConfigOpts (..) )
import           Stack.Types.EnvConfig
                   ( EnvConfig (..), HasEnvConfig (..), HasSourceMap
                   , actualCompilerVersionL, installationRootDeps
                   , installationRootLocal, packageDatabaseDeps
                   , packageDatabaseExtra, packageDatabaseLocal
                   )
import           Stack.Types.GlobalOpts ( globalOptsBuildOptsMonoidL )
import           Stack.Types.NamedComponent ( exeComponents )
import           Stack.Types.Package
                   ( InstallLocation (..), LocalPackage (..), Package (..)
                   , PackageConfig (..), lpFiles, lpFilesForComponents )
import           Stack.Types.Platform ( HasPlatform (..) )
import           Stack.Types.Runner ( Runner, globalOptsL )
import           Stack.Types.SourceMap
                   ( CommonPackage (..), ProjectPackage (..), SMTargets (..)
                   , SourceMap (..), Target (..) )
import           System.Terminal ( fixCodePage )

newtype CabalVersionPrettyException
  = CabalVersionNotSupported Version
  deriving (Int -> CabalVersionPrettyException -> ShowS
[CabalVersionPrettyException] -> ShowS
CabalVersionPrettyException -> String
(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

-- | Helper for build and install commands

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 -> [Text]
boptsCLIGhcOptions BuildOptsCLI
opts)) (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 -> FileWatchOpts
boptsCLIFileWatch BuildOptsCLI
opts 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
  -- Read the build command from the CLI and enable it to run

  modifyGO :: GlobalOpts -> GlobalOpts
modifyGO =
    case BuildOptsCLI -> BuildCommand
boptsCLICommand BuildOptsCLI
opts 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 -- Default case is just Build


-- | Build.

--

--   If a buildLock is passed there is an important contract here.  That lock must

--   protect the snapshot, and it must be safe to unlock it if there are no further

--   modifications to the snapshot to be performed by this build.

build :: HasEnvConfig env
      => Maybe (Set (Path Abs File) -> IO ()) -- ^ callback after discovering all local files

      -> 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 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
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 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 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. HasTerm 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
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
    -- Set local files, necessary for file watching

    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 -> 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)
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 = 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 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 -> 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
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 a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      [PackageIdentifier]
localsIdents -> BuildException -> RIO env ()
forall e a. Exception e => e -> RIO env a
forall (m :: * -> *) e a. (MonadThrow m, 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 -> 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, 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
             (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

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
.
  Plan -> Map PackageName Task
planTasks

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

-- | See https://github.com/commercialhaskell/stack/issues/1198.

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
  -- Cases of several local packages having executables with the same name.

  -- The Map entries have the following form:

  --

  --  executable name: ( package names for executables that are being built

  --                   , package names for other local packages that have an

  --                     executable with the same name

  --                   )

  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
_ :| [],[]) ->
            -- We want to build the executable of single local package

            -- and there are no other local packages with an executable of

            -- the same name. Nothing to warn about, ignore.

            Maybe ([PackageName], [PackageName])
forall a. Maybe a
Nothing
          (NonEmpty PackageName
_,[PackageName]
otherLocals) ->
            -- We could be here for two reasons (or their combination):

            -- 1) We are building two or more executables with the same

            --    name that will end up overwriting each other.

            -- 2) In addition to the executable(s) that we want to build

            --    there are other local packages with an executable of the

            --    same name that might get overwritten.

            -- Both cases warrant a warning.

            ([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 :: forall k v. Ord k => [(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. HasCallStack => [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 :: HasTerm env => BuildOpts -> RIO env ()
warnAboutSplitObjs :: forall env. HasTerm env => BuildOpts -> RIO env ()
warnAboutSplitObjs BuildOpts
bopts | BuildOpts -> Bool
boptsSplitObjs BuildOpts
bopts =
  [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)."

-- | Get the @BaseConfigOpts@ necessary for constructing configure options

mkBaseConfigOpts :: (HasEnvConfig env)
                 => BuildOptsCLI -> RIO env BaseConfigOpts
mkBaseConfigOpts :: forall env.
HasEnvConfig env =>
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
Lens' env 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 :: * -> *).
(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
    { 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
    }

-- | Provide a function for loading package information from the package index

loadPackage ::
     (HasBuildConfig env, HasSourceMap env)
  => PackageLocationImmutable
  -> Map FlagName Bool
  -> [Text] -- ^ GHC options

  -> [Text] -- ^ Cabal configure options

  -> 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 <- 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
        { 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

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 =
    [ (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)
    ]

-- | Find if any sublibrary dependency (other than internal libraries) exists in

-- each project package.

checkSubLibraryDependencies :: HasTerm env => [ProjectPackage] -> RIO env ()
checkSubLibraryDependencies :: forall env. HasTerm env => [ProjectPackage] -> RIO env ()
checkSubLibraryDependencies [ProjectPackage]
projectPackages =
  [ProjectPackage] -> (ProjectPackage -> RIO env ()) -> RIO env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ProjectPackage]
projectPackages ((ProjectPackage -> RIO env ()) -> RIO env ())
-> (ProjectPackage -> RIO env ()) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ \ProjectPackage
projectPackage -> do
    C.GenericPackageDescription PackageDescription
pkgDesc Maybe Version
_ [PackageFlag]
_ Maybe (CondTree ConfVar [Dependency] Library)
lib [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
subLibs [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
foreignLibs [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
tests [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benches <-
      IO GenericPackageDescription -> RIO env GenericPackageDescription
forall a. IO a -> RIO env a
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
projectPackage

    let pName :: PackageName
pName = PackageIdentifier -> PackageName
pkgName (PackageIdentifier -> PackageName)
-> (PackageDescription -> PackageIdentifier)
-> PackageDescription
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
C.package (PackageDescription -> PackageName)
-> PackageDescription -> PackageName
forall a b. (a -> b) -> a -> b
$ PackageDescription
pkgDesc
        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
        notInternal :: Dependency -> Bool
notInternal (Dependency PackageName
pName' VersionRange
_ NonEmptySet LibraryName
_) = PackageName
pName' PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
/= PackageName
pName
        publicDependencies :: [Dependency]
publicDependencies = (Dependency -> Bool) -> [Dependency] -> [Dependency]
forall a. (a -> Bool) -> [a] -> [a]
filter Dependency -> Bool
notInternal [Dependency]
dependencies
        publicLibraries :: [LibraryName]
publicLibraries = (Dependency -> [LibraryName]) -> [Dependency] -> [LibraryName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NonEmptySet LibraryName -> [LibraryName]
forall a. NonEmptySet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmptySet LibraryName -> [LibraryName])
-> (Dependency -> NonEmptySet LibraryName)
-> Dependency
-> [LibraryName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> NonEmptySet LibraryName
depLibraries) [Dependency]
publicDependencies

    Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([LibraryName] -> Bool
subLibDepExist [LibraryName]
publicLibraries) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$
      String -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
String -> m ()
prettyWarnS
        String
"Sublibrary dependency is not supported, this will almost certainly \
        \fail."
 where
  getDeps :: (a, CondTree v c a) -> c
getDeps (a
_, C.CondNode a
_ c
dep [CondBranch v c a]
_) = c
dep
  subLibDepExist :: [LibraryName] -> Bool
subLibDepExist = (LibraryName -> Bool) -> [LibraryName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
    ( \case
        C.LSubLibName UnqualComponentName
_ -> Bool
True
        LibraryName
C.LMainLibName  -> Bool
False
    )