{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Build the project.

module Stack.Build
  (build
  ,loadPackage
  ,mkBaseConfigOpts
  ,queryBuildInfo
  ,splitObjsWarning
  ,CabalVersionException(..))
  where

import           Stack.Prelude hiding (loadPackage)
import           Data.Aeson (Value (Object, Array), (.=), object)
import qualified Data.HashMap.Strict as HM
import           Data.List ((\\), isPrefixOf)
import           Data.List.Extra (groupSort)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import           Data.Text.Encoding (decodeUtf8)
import qualified Data.Text.IO as TIO
import           Data.Text.Read (decimal)
import qualified Data.Vector as V
import qualified Data.Yaml as Yaml
import qualified Distribution.PackageDescription as C
import           Distribution.Types.Dependency (depLibraries)
import           Distribution.Version (mkVersion)
import           Path (parent)
import           Stack.Build.ConstructPlan
import           Stack.Build.Execute
import           Stack.Build.Installed
import           Stack.Build.Source
import           Stack.Package
import           Stack.Types.Build
import           Stack.Types.Config
import           Stack.Types.NamedComponent
import           Stack.Types.Package
import           Stack.Types.SourceMap

import           Stack.Types.Compiler (compilerVersionText, getGhcVersion)
import           System.Terminal (fixCodePage)

-- | Build.
--
--   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 :: Maybe (Set (Path Abs File) -> IO ()) -> RIO env ()
build Maybe (Set (Path Abs File) -> IO ())
msetLocalFiles = do
  Bool
mcp <- Getting Bool env Bool -> RIO env Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Bool env Bool -> RIO env Bool)
-> Getting Bool env Bool -> RIO env Bool
forall a b. (a -> b) -> a -> b
$ (Config -> Const Bool Config) -> env -> Const Bool env
forall env. HasConfig env => Lens' env Config
configL((Config -> Const Bool Config) -> env -> Const Bool env)
-> ((Bool -> Const Bool Bool) -> Config -> Const Bool Config)
-> Getting Bool env Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Bool) -> SimpleGetter Config Bool
forall s a. (s -> a) -> SimpleGetter s a
to Config -> Bool
configModifyCodePage
  Version
ghcVersion <- Getting Version env Version -> RIO env Version
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Version env Version -> RIO env Version)
-> Getting Version env Version -> RIO env Version
forall a b. (a -> b) -> a -> b
$ Getting Version env ActualCompiler
forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionLGetting Version env ActualCompiler
-> ((Version -> Const Version Version)
    -> ActualCompiler -> Const Version ActualCompiler)
-> Getting Version env Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ActualCompiler -> Version) -> SimpleGetter ActualCompiler Version
forall s a. (s -> a) -> SimpleGetter s a
to ActualCompiler -> Version
getGhcVersion
  Bool -> Version -> RIO env () -> RIO env ()
forall x y a. x -> y -> a -> a
fixCodePage Bool
mcp Version
ghcVersion (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ do
    BuildOpts
bopts <- Getting BuildOpts env BuildOpts -> RIO env BuildOpts
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildOpts env BuildOpts
forall s. HasConfig s => Lens' s BuildOpts
buildOptsL
    SourceMap
sourceMap <- Getting SourceMap env SourceMap -> RIO env SourceMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting SourceMap env SourceMap -> RIO env SourceMap)
-> Getting SourceMap env SourceMap -> RIO env SourceMap
forall a b. (a -> b) -> a -> b
$ (EnvConfig -> Const SourceMap EnvConfig)
-> env -> Const SourceMap env
forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigL((EnvConfig -> Const SourceMap EnvConfig)
 -> env -> Const SourceMap env)
-> ((SourceMap -> Const SourceMap SourceMap)
    -> EnvConfig -> Const SourceMap EnvConfig)
-> Getting SourceMap env SourceMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EnvConfig -> SourceMap) -> SimpleGetter EnvConfig SourceMap
forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> SourceMap
envConfigSourceMap
    [LocalPackage]
locals <- RIO env [LocalPackage]
forall env. HasEnvConfig env => RIO env [LocalPackage]
projectLocalPackages
    [LocalPackage]
depsLocals <- RIO env [LocalPackage]
forall env. HasEnvConfig env => RIO env [LocalPackage]
localDependencies
    let allLocals :: [LocalPackage]
allLocals = [LocalPackage]
locals [LocalPackage] -> [LocalPackage] -> [LocalPackage]
forall a. Semigroup a => a -> a -> a
<> [LocalPackage]
depsLocals

    [ProjectPackage] -> RIO env ()
forall env. HasLogFunc env => [ProjectPackage] -> RIO env ()
checkSubLibraryDependencies (Map PackageName ProjectPackage -> [ProjectPackage]
forall k a. Map k a -> [a]
Map.elems (Map PackageName ProjectPackage -> [ProjectPackage])
-> Map PackageName ProjectPackage -> [ProjectPackage]
forall a b. (a -> b) -> a -> b
$ SourceMap -> Map PackageName ProjectPackage
smProject SourceMap
sourceMap)

    BuildOptsCLI
boptsCli <- Getting BuildOptsCLI env BuildOptsCLI -> RIO env BuildOptsCLI
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting BuildOptsCLI env BuildOptsCLI -> RIO env BuildOptsCLI)
-> Getting BuildOptsCLI env BuildOptsCLI -> RIO env BuildOptsCLI
forall a b. (a -> b) -> a -> b
$ (EnvConfig -> Const BuildOptsCLI EnvConfig)
-> env -> Const BuildOptsCLI env
forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigL((EnvConfig -> Const BuildOptsCLI EnvConfig)
 -> env -> Const BuildOptsCLI env)
-> ((BuildOptsCLI -> Const BuildOptsCLI BuildOptsCLI)
    -> EnvConfig -> Const BuildOptsCLI EnvConfig)
-> Getting BuildOptsCLI env BuildOptsCLI
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EnvConfig -> BuildOptsCLI) -> SimpleGetter EnvConfig BuildOptsCLI
forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> BuildOptsCLI
envConfigBuildOptsCLI
    -- 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)
stackYamlL
    Maybe (Set (Path Abs File) -> IO ())
-> ((Set (Path Abs File) -> IO ()) -> RIO env ()) -> RIO env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (Set (Path Abs File) -> IO ())
msetLocalFiles (((Set (Path Abs File) -> IO ()) -> RIO env ()) -> RIO env ())
-> ((Set (Path Abs File) -> IO ()) -> RIO env ()) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ \Set (Path Abs File) -> IO ()
setLocalFiles -> do
      [Set (Path Abs File)]
files <-
        if BuildOptsCLI -> Bool
boptsCLIWatchAll BuildOptsCLI
boptsCli
        then [RIO env (Set (Path Abs File))] -> RIO env [Set (Path Abs File)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [LocalPackage -> RIO env (Set (Path Abs File))
forall env.
HasEnvConfig env =>
LocalPackage -> RIO env (Set (Path Abs File))
lpFiles LocalPackage
lp | LocalPackage
lp <- [LocalPackage]
allLocals]
        else [LocalPackage]
-> (LocalPackage -> RIO env (Set (Path Abs File)))
-> RIO env [Set (Path Abs File)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [LocalPackage]
allLocals ((LocalPackage -> RIO env (Set (Path Abs File)))
 -> RIO env [Set (Path Abs File)])
-> (LocalPackage -> RIO env (Set (Path Abs File)))
-> RIO env [Set (Path Abs File)]
forall a b. (a -> b) -> a -> b
$ \LocalPackage
lp -> do
          let pn :: PackageName
pn = Package -> PackageName
packageName (LocalPackage -> Package
lpPackage LocalPackage
lp)
          case PackageName -> Map PackageName Target -> Maybe Target
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pn (SMTargets -> Map PackageName Target
smtTargets (SMTargets -> Map PackageName Target)
-> SMTargets -> Map PackageName Target
forall a b. (a -> b) -> a -> b
$ SourceMap -> SMTargets
smTargets SourceMap
sourceMap) of
            Maybe Target
Nothing ->
              Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set (Path Abs File)
forall a. Set a
Set.empty
            Just (TargetAll PackageType
_) ->
              LocalPackage -> RIO env (Set (Path Abs File))
forall env.
HasEnvConfig env =>
LocalPackage -> RIO env (Set (Path Abs File))
lpFiles LocalPackage
lp
            Just (TargetComps Set NamedComponent
components) ->
              Set NamedComponent -> LocalPackage -> RIO env (Set (Path Abs File))
forall env.
HasEnvConfig env =>
Set NamedComponent -> LocalPackage -> RIO env (Set (Path Abs File))
lpFilesForComponents Set NamedComponent
components LocalPackage
lp
      IO () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> IO () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Set (Path Abs File) -> IO ()
setLocalFiles (Set (Path Abs File) -> IO ()) -> Set (Path Abs File) -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs File -> Set (Path Abs File) -> Set (Path Abs File)
forall a. Ord a => a -> Set a -> Set a
Set.insert Path Abs File
stackYaml (Set (Path Abs File) -> Set (Path Abs File))
-> Set (Path Abs File) -> Set (Path Abs File)
forall a b. (a -> b) -> a -> b
$ [Set (Path Abs File)] -> Set (Path Abs File)
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set (Path Abs File)]
files

    [LocalPackage] -> RIO env ()
forall (m :: * -> *). MonadThrow m => [LocalPackage] -> m ()
checkComponentsBuildable [LocalPackage]
allLocals

    InstallMap
installMap <- SourceMap -> RIO env InstallMap
forall (m :: * -> *). MonadIO m => SourceMap -> m InstallMap
toInstallMap SourceMap
sourceMap
    (InstalledMap
installedMap, [DumpPackage]
globalDumpPkgs, [DumpPackage]
snapshotDumpPkgs, [DumpPackage]
localDumpPkgs) <-
        InstallMap
-> RIO
     env (InstalledMap, [DumpPackage], [DumpPackage], [DumpPackage])
forall env.
HasEnvConfig env =>
InstallMap
-> RIO
     env (InstalledMap, [DumpPackage], [DumpPackage], [DumpPackage])
getInstalled InstallMap
installMap

    BaseConfigOpts
baseConfigOpts <- BuildOptsCLI -> RIO env BaseConfigOpts
forall env.
HasEnvConfig env =>
BuildOptsCLI -> RIO env BaseConfigOpts
mkBaseConfigOpts BuildOptsCLI
boptsCli
    Plan
plan <- BaseConfigOpts
-> [DumpPackage]
-> (PackageLocationImmutable
    -> Map FlagName Bool -> [Text] -> [Text] -> RIO EnvConfig Package)
-> SourceMap
-> InstalledMap
-> Bool
-> RIO env Plan
forall env.
HasEnvConfig env =>
BaseConfigOpts
-> [DumpPackage]
-> (PackageLocationImmutable
    -> Map FlagName Bool -> [Text] -> [Text] -> RIO EnvConfig Package)
-> SourceMap
-> InstalledMap
-> Bool
-> RIO env Plan
constructPlan BaseConfigOpts
baseConfigOpts [DumpPackage]
localDumpPkgs PackageLocationImmutable
-> Map FlagName Bool -> [Text] -> [Text] -> RIO EnvConfig Package
forall env.
(HasBuildConfig env, HasSourceMap env) =>
PackageLocationImmutable
-> Map FlagName Bool -> [Text] -> [Text] -> RIO env Package
loadPackage SourceMap
sourceMap InstalledMap
installedMap (BuildOptsCLI -> Bool
boptsCLIInitialBuildSteps BuildOptsCLI
boptsCli)

    Bool
allowLocals <- Getting Bool env Bool -> RIO env Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Bool env Bool -> RIO env Bool)
-> Getting Bool env Bool -> RIO env Bool
forall a b. (a -> b) -> a -> b
$ (Config -> Const Bool Config) -> env -> Const Bool env
forall env. HasConfig env => Lens' env Config
configL((Config -> Const Bool Config) -> env -> Const Bool env)
-> ((Bool -> Const Bool Bool) -> Config -> Const Bool Config)
-> Getting Bool env Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Bool) -> SimpleGetter Config Bool
forall s a. (s -> a) -> SimpleGetter s a
to Config -> Bool
configAllowLocals
    Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allowLocals (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ case Plan -> [PackageIdentifier]
justLocals Plan
plan of
      [] -> () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      [PackageIdentifier]
localsIdents -> StackBuildException -> RIO env ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (StackBuildException -> RIO env ())
-> StackBuildException -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [PackageIdentifier] -> StackBuildException
LocalPackagesPresent [PackageIdentifier]
localsIdents

    RIO env ()
forall env. HasEnvConfig env => RIO env ()
checkCabalVersion
    BuildOpts -> RIO env ()
forall env. HasLogFunc env => BuildOpts -> RIO env ()
warnAboutSplitObjs BuildOpts
bopts
    [LocalPackage] -> Plan -> RIO env ()
forall env. HasLogFunc env => [LocalPackage] -> Plan -> RIO env ()
warnIfExecutablesWithSameNameCouldBeOverwritten [LocalPackage]
locals Plan
plan

    Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BuildOpts -> Bool
boptsPreFetch BuildOpts
bopts) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$
        Plan -> RIO env ()
forall env. HasEnvConfig env => Plan -> RIO env ()
preFetch Plan
plan

    if BuildOptsCLI -> Bool
boptsCLIDryrun BuildOptsCLI
boptsCli
        then Plan -> RIO env ()
forall env. HasRunner env => Plan -> RIO env ()
printPlan Plan
plan
        else BuildOptsCLI
-> BaseConfigOpts
-> [LocalPackage]
-> [DumpPackage]
-> [DumpPackage]
-> [DumpPackage]
-> InstalledMap
-> Map PackageName Target
-> Plan
-> RIO env ()
forall env.
HasEnvConfig env =>
BuildOptsCLI
-> BaseConfigOpts
-> [LocalPackage]
-> [DumpPackage]
-> [DumpPackage]
-> [DumpPackage]
-> InstalledMap
-> Map PackageName Target
-> Plan
-> RIO env ()
executePlan BuildOptsCLI
boptsCli BaseConfigOpts
baseConfigOpts [LocalPackage]
locals
                         [DumpPackage]
globalDumpPkgs
                         [DumpPackage]
snapshotDumpPkgs
                         [DumpPackage]
localDumpPkgs
                         InstalledMap
installedMap
                         (SMTargets -> Map PackageName Target
smtTargets (SMTargets -> Map PackageName Target)
-> SMTargets -> Map PackageName Target
forall a b. (a -> b) -> a -> b
$ SourceMap -> SMTargets
smTargets SourceMap
sourceMap)
                         Plan
plan

justLocals :: Plan -> [PackageIdentifier]
justLocals :: Plan -> [PackageIdentifier]
justLocals =
    (Task -> PackageIdentifier) -> [Task] -> [PackageIdentifier]
forall a b. (a -> b) -> [a] -> [b]
map Task -> PackageIdentifier
taskProvides ([Task] -> [PackageIdentifier])
-> (Plan -> [Task]) -> Plan -> [PackageIdentifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (Task -> Bool) -> [Task] -> [Task]
forall a. (a -> Bool) -> [a] -> [a]
filter ((InstallLocation -> InstallLocation -> Bool
forall a. Eq a => a -> a -> Bool
== InstallLocation
Local) (InstallLocation -> Bool)
-> (Task -> InstallLocation) -> Task -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Task -> InstallLocation
taskLocation) ([Task] -> [Task]) -> (Plan -> [Task]) -> Plan -> [Task]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Map PackageName Task -> [Task]
forall k a. Map k a -> [a]
Map.elems (Map PackageName Task -> [Task])
-> (Plan -> Map PackageName Task) -> Plan -> [Task]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Plan -> Map PackageName Task
planTasks

checkCabalVersion :: HasEnvConfig env => RIO env ()
checkCabalVersion :: RIO env ()
checkCabalVersion = do
    Bool
allowNewer <- Getting Bool env Bool -> RIO env Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Bool env Bool -> RIO env Bool)
-> Getting Bool env Bool -> RIO env Bool
forall a b. (a -> b) -> a -> b
$ (Config -> Const Bool Config) -> env -> Const Bool env
forall env. HasConfig env => Lens' env Config
configL((Config -> Const Bool Config) -> env -> Const Bool env)
-> ((Bool -> Const Bool Bool) -> Config -> Const Bool Config)
-> Getting Bool env Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Bool) -> SimpleGetter Config Bool
forall s a. (s -> a) -> SimpleGetter s a
to Config -> Bool
configAllowNewer
    Version
cabalVer <- Getting Version env Version -> RIO env Version
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Version env Version
forall env. HasCompiler env => SimpleGetter env Version
cabalVersionL
    -- https://github.com/haskell/cabal/issues/2023
    Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
allowNewer Bool -> Bool -> Bool
&& Version
cabalVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
1, Int
22]) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ CabalVersionException -> RIO env ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CabalVersionException -> RIO env ())
-> CabalVersionException -> RIO env ()
forall a b. (a -> b) -> a -> b
$
        String -> CabalVersionException
CabalVersionException (String -> CabalVersionException)
-> String -> CabalVersionException
forall a b. (a -> b) -> a -> b
$
            String
"Error: --allow-newer requires at least Cabal version 1.22, but version " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            Version -> String
versionString Version
cabalVer String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
" was found."
    -- Since --exact-configuration is always passed, some old cabal
    -- versions can no longer be used. See the following link for why
    -- it's 1.19.2:
    -- https://github.com/haskell/cabal/blob/580fe6b6bf4e1648b2f66c1cb9da9f1f1378492c/cabal-install/Distribution/Client/Setup.hs#L592
    Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
cabalVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
1, Int
19, Int
2]) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ CabalVersionException -> RIO env ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CabalVersionException -> RIO env ())
-> CabalVersionException -> RIO env ()
forall a b. (a -> b) -> a -> b
$
        String -> CabalVersionException
CabalVersionException (String -> CabalVersionException)
-> String -> CabalVersionException
forall a b. (a -> b) -> a -> b
$
            String
"Stack no longer supports Cabal versions older than 1.19.2, but version " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            Version -> String
versionString Version
cabalVer String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
" was found.  To fix this, consider updating the resolver to lts-3.0 or later / nightly-2015-05-05 or later."

newtype CabalVersionException = CabalVersionException { CabalVersionException -> String
unCabalVersionException :: String }
    deriving (Typeable)

instance Show CabalVersionException where show :: CabalVersionException -> String
show = CabalVersionException -> String
unCabalVersionException
instance Exception CabalVersionException

-- | See https://github.com/commercialhaskell/stack/issues/1198.
warnIfExecutablesWithSameNameCouldBeOverwritten
    :: HasLogFunc env => [LocalPackage] -> Plan -> RIO env ()
warnIfExecutablesWithSameNameCouldBeOverwritten :: [LocalPackage] -> Plan -> RIO env ()
warnIfExecutablesWithSameNameCouldBeOverwritten [LocalPackage]
locals Plan
plan = do
    Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Checking if we are going to build multiple executables with the same name"
    [(Text, ([PackageName], [PackageName]))]
-> ((Text, ([PackageName], [PackageName])) -> RIO env ())
-> RIO env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Text ([PackageName], [PackageName])
-> [(Text, ([PackageName], [PackageName]))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text ([PackageName], [PackageName])
warnings) (((Text, ([PackageName], [PackageName])) -> RIO env ())
 -> RIO env ())
-> ((Text, ([PackageName], [PackageName])) -> RIO env ())
-> RIO env ()
forall a b. (a -> b) -> a -> b
$ \(Text
exe,([PackageName]
toBuild,[PackageName]
otherLocals)) -> do
        let exe_s :: Text
exe_s
                | [PackageName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PackageName]
toBuild Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = Text
"several executables with the same name:"
                | Bool
otherwise = Text
"executable"
            exesText :: [PackageName] -> Text
exesText [PackageName]
pkgs =
                Text -> [Text] -> Text
T.intercalate
                    Text
", "
                    [Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (PackageName -> String
packageNameString PackageName
p) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
exe Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'" | PackageName
p <- [PackageName]
pkgs]
        (Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn (Utf8Builder -> RIO env ())
-> ([[Text]] -> Utf8Builder) -> [[Text]] -> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Text -> Utf8Builder)
-> ([[Text]] -> Text) -> [[Text]] -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text) -> ([[Text]] -> [Text]) -> [[Text]] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat)
            [ [ Text
"Building " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
exe_s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [PackageName] -> Text
exesText [PackageName]
toBuild Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." ]
            , [ Text
"Only one of them will be available via 'stack exec' or locally installed."
              | [PackageName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PackageName]
toBuild Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
              ]
            , [ Text
"Other executables with the same name might be overwritten: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                [PackageName] -> Text
exesText [PackageName]
otherLocals Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
              | Bool -> Bool
not ([PackageName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageName]
otherLocals)
              ]
            ]
  where
    -- 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 :: [(k, v)] -> Map k (NonEmpty v)
collect = ([v] -> NonEmpty v) -> Map k [v] -> Map k (NonEmpty v)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map [v] -> NonEmpty v
forall a. [a] -> NonEmpty a
NE.fromList (Map k [v] -> Map k (NonEmpty v))
-> ([(k, v)] -> Map k [v]) -> [(k, v)] -> Map k (NonEmpty v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, [v])] -> Map k [v]
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(k, [v])] -> Map k [v])
-> ([(k, v)] -> [(k, [v])]) -> [(k, v)] -> Map k [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, v)] -> [(k, [v])]
forall k v. Ord k => [(k, v)] -> [(k, [v])]
groupSort

warnAboutSplitObjs :: HasLogFunc env => BuildOpts -> RIO env ()
warnAboutSplitObjs :: BuildOpts -> RIO env ()
warnAboutSplitObjs BuildOpts
bopts | BuildOpts -> Bool
boptsSplitObjs BuildOpts
bopts = do
    Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Building with --split-objs is enabled. " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> String -> Utf8Builder
forall a. IsString a => String -> a
fromString String
splitObjsWarning
warnAboutSplitObjs BuildOpts
_ = () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

splitObjsWarning :: String
splitObjsWarning :: String
splitObjsWarning = [String] -> String
unwords
     [ String
"Note that this feature is EXPERIMENTAL, and its behavior may be changed and improved."
     , String
"You will need to clean your workdirs before use. If you want to compile all dependencies"
     , String
"with split-objs, you will need to delete the snapshot (and all snapshots that could"
     , String
"reference that snapshot)."
     ]

-- | Get the @BaseConfigOpts@ necessary for constructing configure options
mkBaseConfigOpts :: (HasEnvConfig env)
                 => BuildOptsCLI -> RIO env BaseConfigOpts
mkBaseConfigOpts :: BuildOptsCLI -> RIO env BaseConfigOpts
mkBaseConfigOpts BuildOptsCLI
boptsCli = do
    BuildOpts
bopts <- Getting BuildOpts env BuildOpts -> RIO env BuildOpts
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildOpts env BuildOpts
forall s. HasConfig s => Lens' s BuildOpts
buildOptsL
    Path Abs Dir
snapDBPath <- RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseDeps
    Path Abs Dir
localDBPath <- RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
packageDatabaseLocal
    Path Abs Dir
snapInstallRoot <- RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootDeps
    Path Abs Dir
localInstallRoot <- RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootLocal
    [Path Abs Dir]
packageExtraDBs <- RIO env [Path Abs Dir]
forall env (m :: * -> *).
(MonadReader env m, HasEnvConfig env) =>
m [Path Abs Dir]
packageDatabaseExtra
    BaseConfigOpts -> RIO env BaseConfigOpts
forall (m :: * -> *) a. Monad m => a -> m a
return BaseConfigOpts :: Path Abs Dir
-> Path Abs Dir
-> Path Abs Dir
-> Path Abs Dir
-> BuildOpts
-> BuildOptsCLI
-> [Path Abs Dir]
-> BaseConfigOpts
BaseConfigOpts
        { bcoSnapDB :: Path Abs Dir
bcoSnapDB = Path Abs Dir
snapDBPath
        , bcoLocalDB :: Path Abs Dir
bcoLocalDB = Path Abs Dir
localDBPath
        , bcoSnapInstallRoot :: Path Abs Dir
bcoSnapInstallRoot = Path Abs Dir
snapInstallRoot
        , bcoLocalInstallRoot :: Path Abs Dir
bcoLocalInstallRoot = Path Abs Dir
localInstallRoot
        , bcoBuildOpts :: BuildOpts
bcoBuildOpts = BuildOpts
bopts
        , bcoBuildOptsCLI :: BuildOptsCLI
bcoBuildOptsCLI = BuildOptsCLI
boptsCli
        , bcoExtraDBs :: [Path Abs Dir]
bcoExtraDBs = [Path Abs Dir]
packageExtraDBs
        }

-- | 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 :: PackageLocationImmutable
-> Map FlagName Bool -> [Text] -> [Text] -> RIO env Package
loadPackage PackageLocationImmutable
loc Map FlagName Bool
flags [Text]
ghcOptions [Text]
cabalConfigOpts = do
  ActualCompiler
compiler <- Getting ActualCompiler env ActualCompiler -> RIO env ActualCompiler
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ActualCompiler env ActualCompiler
forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionL
  Platform
platform <- Getting Platform env Platform -> RIO env Platform
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Platform env Platform
forall env. HasPlatform env => Lens' env Platform
platformL
  let pkgConfig :: PackageConfig
pkgConfig = PackageConfig :: Bool
-> Bool
-> Map FlagName Bool
-> [Text]
-> [Text]
-> ActualCompiler
-> Platform
-> PackageConfig
PackageConfig
        { packageConfigEnableTests :: Bool
packageConfigEnableTests = Bool
False
        , packageConfigEnableBenchmarks :: Bool
packageConfigEnableBenchmarks = Bool
False
        , packageConfigFlags :: Map FlagName Bool
packageConfigFlags = Map FlagName Bool
flags
        , packageConfigGhcOptions :: [Text]
packageConfigGhcOptions = [Text]
ghcOptions
        , packageConfigCabalConfigOpts :: [Text]
packageConfigCabalConfigOpts = [Text]
cabalConfigOpts
        , packageConfigCompilerVersion :: ActualCompiler
packageConfigCompilerVersion = ActualCompiler
compiler
        , packageConfigPlatform :: Platform
packageConfigPlatform = Platform
platform
        }
  PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
pkgConfig (GenericPackageDescription -> Package)
-> RIO env GenericPackageDescription -> RIO env Package
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageLocationImmutable -> RIO env GenericPackageDescription
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
PackageLocationImmutable -> RIO env GenericPackageDescription
loadCabalFileImmutable PackageLocationImmutable
loc

-- | Query information about the build and print the result to stdout in YAML format.
queryBuildInfo :: HasEnvConfig env
               => [Text] -- ^ selectors
               -> RIO env ()
queryBuildInfo :: [Text] -> RIO env ()
queryBuildInfo [Text]
selectors0 =
        RIO env Value
forall env. HasEnvConfig env => RIO env Value
rawBuildInfo
    RIO env Value -> (Value -> RIO env Value) -> RIO env Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Text] -> [Text]) -> [Text] -> Value -> RIO env Value
forall (m :: * -> *) c.
(MonadIO m, Show c) =>
([Text] -> c) -> [Text] -> Value -> m Value
select [Text] -> [Text]
forall a. a -> a
id [Text]
selectors0
    RIO env Value -> (Value -> RIO env ()) -> RIO env ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> (Value -> IO ()) -> Value -> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> (Value -> Text) -> Value -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
addGlobalHintsComment (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
Yaml.encode
  where
    select :: ([Text] -> c) -> [Text] -> Value -> m Value
select [Text] -> c
_ [] Value
value = Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
value
    select [Text] -> c
front (Text
sel:[Text]
sels) Value
value =
        case Value
value of
            Object Object
o ->
                case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
sel Object
o of
                    Maybe Value
Nothing -> String -> m Value
forall (m :: * -> *) a. MonadIO m => String -> m a
err String
"Selector not found"
                    Just Value
value' -> Value -> m Value
cont Value
value'
            Array Array
v ->
                case Reader Int
forall a. Integral a => Reader a
decimal Text
sel of
                    Right (Int
i, Text
"")
                        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Array -> Int
forall a. Vector a -> Int
V.length Array
v -> Value -> m Value
cont (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Array
v Array -> Int -> Value
forall a. Vector a -> Int -> a
V.! Int
i
                        | Bool
otherwise -> String -> m Value
forall (m :: * -> *) a. MonadIO m => String -> m a
err String
"Index out of range"
                    Either String (Int, Text)
_ -> String -> m Value
forall (m :: * -> *) a. MonadIO m => String -> m a
err String
"Encountered array and needed numeric selector"
            Value
_ -> String -> m Value
forall (m :: * -> *) a. MonadIO m => String -> m a
err (String -> m Value) -> String -> m Value
forall a b. (a -> b) -> a -> b
$ String
"Cannot apply selector to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
value
      where
        cont :: Value -> m Value
cont = ([Text] -> c) -> [Text] -> Value -> m Value
select ([Text] -> c
front ([Text] -> c) -> ([Text] -> [Text]) -> [Text] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
selText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)) [Text]
sels
        err :: String -> m a
err String
msg = String -> m a
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ c -> String
forall a. Show a => a -> String
show ([Text] -> c
front [Text
sel])
    -- Include comments to indicate that this portion of the "stack
    -- query" API is not necessarily stable.
    addGlobalHintsComment :: Text -> Text
addGlobalHintsComment
      | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
selectors0 = Text -> Text -> Text -> Text
T.replace Text
globalHintsLine (Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
globalHintsComment Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
globalHintsLine)
      -- Append comment instead of pre-pending. The reasoning here is
      -- that something *could* expect that the result of 'stack query
      -- global-hints ghc-boot' is just a string literal. Seems easier
      -- for to expect the first line of the output to be the literal.
      | [Text
"global-hints"] [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Text]
selectors0 = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
globalHintsComment))
      | Bool
otherwise = Text -> Text
forall a. a -> a
id
    globalHintsLine :: Text
globalHintsLine = Text
"\nglobal-hints:\n"
    globalHintsComment :: Text
globalHintsComment = [Text] -> Text
T.concat
      [ Text
"# Note: global-hints is experimental and may be renamed / removed in the future.\n"
      , Text
"# See https://github.com/commercialhaskell/stack/issues/3796"
      ]
-- | Get the raw build information object
rawBuildInfo :: HasEnvConfig env => RIO env Value
rawBuildInfo :: RIO env Value
rawBuildInfo = do
    [LocalPackage]
locals <- RIO env [LocalPackage]
forall env. HasEnvConfig env => RIO env [LocalPackage]
projectLocalPackages
    Text
wantedCompiler <- Getting Text env Text -> RIO env Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Text env Text -> RIO env Text)
-> Getting Text env Text -> RIO env Text
forall a b. (a -> b) -> a -> b
$ Getting Text env WantedCompiler
forall s r. HasBuildConfig s => Getting r s WantedCompiler
wantedCompilerVersionLGetting Text env WantedCompiler
-> ((Text -> Const Text Text)
    -> WantedCompiler -> Const Text WantedCompiler)
-> Getting Text env Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(WantedCompiler -> Text) -> SimpleGetter WantedCompiler Text
forall s a. (s -> a) -> SimpleGetter s a
to (Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (WantedCompiler -> Utf8Builder) -> WantedCompiler -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WantedCompiler -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display)
    Text
actualCompiler <- Getting Text env Text -> RIO env Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Text env Text -> RIO env Text)
-> Getting Text env Text -> RIO env Text
forall a b. (a -> b) -> a -> b
$ Getting Text env ActualCompiler
forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionLGetting Text env ActualCompiler
-> ((Text -> Const Text Text)
    -> ActualCompiler -> Const Text ActualCompiler)
-> Getting Text env Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ActualCompiler -> Text) -> SimpleGetter ActualCompiler Text
forall s a. (s -> a) -> SimpleGetter s a
to ActualCompiler -> Text
compilerVersionText
    Value -> RIO env Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> RIO env Value) -> Value -> RIO env Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
        [ Text
"locals" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Object -> Value
Object ([Pair] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([Pair] -> Object) -> [Pair] -> Object
forall a b. (a -> b) -> a -> b
$ (LocalPackage -> Pair) -> [LocalPackage] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map LocalPackage -> Pair
localToPair [LocalPackage]
locals)
        , Text
"compiler" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object
            [ Text
"wanted" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
wantedCompiler
            , Text
"actual" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
actualCompiler
            ]
        ]
  where
    localToPair :: LocalPackage -> Pair
localToPair LocalPackage
lp =
        (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PackageName -> String
packageNameString (PackageName -> String) -> PackageName -> String
forall a b. (a -> b) -> a -> b
$ Package -> PackageName
packageName Package
p, Value
value)
      where
        p :: Package
p = LocalPackage -> Package
lpPackage LocalPackage
lp
        value :: Value
value = [Pair] -> Value
object
            [ Text
"version" Text -> CabalString Version -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Version -> CabalString Version
forall a. a -> CabalString a
CabalString (Package -> Version
packageVersion Package
p)
            , Text
"path" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent (Path Abs File -> Path Abs Dir) -> Path Abs File -> Path Abs Dir
forall a b. (a -> b) -> a -> b
$ LocalPackage -> Path Abs File
lpCabalFile LocalPackage
lp)
            ]

checkComponentsBuildable :: MonadThrow m => [LocalPackage] -> m ()
checkComponentsBuildable :: [LocalPackage] -> m ()
checkComponentsBuildable [LocalPackage]
lps =
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(PackageName, NamedComponent)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PackageName, NamedComponent)]
unbuildable) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ StackBuildException -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (StackBuildException -> m ()) -> StackBuildException -> m ()
forall a b. (a -> b) -> a -> b
$ [(PackageName, NamedComponent)] -> StackBuildException
SomeTargetsNotBuildable [(PackageName, NamedComponent)]
unbuildable
  where
    unbuildable :: [(PackageName, NamedComponent)]
unbuildable =
        [ (Package -> PackageName
packageName (LocalPackage -> Package
lpPackage LocalPackage
lp), NamedComponent
c)
        | LocalPackage
lp <- [LocalPackage]
lps
        , NamedComponent
c <- Set NamedComponent -> [NamedComponent]
forall a. Set a -> [a]
Set.toList (LocalPackage -> Set NamedComponent
lpUnbuildable LocalPackage
lp)
        ]

-- | Find if sublibrary dependency exist in each project
checkSubLibraryDependencies :: HasLogFunc env => [ProjectPackage] -> RIO env ()
checkSubLibraryDependencies :: [ProjectPackage] -> RIO env ()
checkSubLibraryDependencies [ProjectPackage]
proj = do
  [ProjectPackage] -> (ProjectPackage -> RIO env ()) -> RIO env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ProjectPackage]
proj ((ProjectPackage -> RIO env ()) -> RIO env ())
-> (ProjectPackage -> RIO env ()) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ \ProjectPackage
p -> do
    C.GenericPackageDescription PackageDescription
_ [Flag]
_ Maybe (CondTree ConfVar [Dependency] Library)
lib [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
subLibs [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
foreignLibs [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
tests [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benches <- IO GenericPackageDescription -> RIO env GenericPackageDescription
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GenericPackageDescription -> RIO env GenericPackageDescription)
-> IO GenericPackageDescription
-> RIO env GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ CommonPackage -> IO GenericPackageDescription
cpGPD (CommonPackage -> IO GenericPackageDescription)
-> (ProjectPackage -> CommonPackage)
-> ProjectPackage
-> IO GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectPackage -> CommonPackage
ppCommon (ProjectPackage -> IO GenericPackageDescription)
-> ProjectPackage -> IO GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ ProjectPackage
p

    let dependencies :: [Dependency]
dependencies = ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> [Dependency])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> [Dependency]
forall a v c a. (a, CondTree v c a) -> c
getDeps [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
subLibs [Dependency] -> [Dependency] -> [Dependency]
forall a. Semigroup a => a -> a -> a
<>
                       ((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
 -> [Dependency])
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> [Dependency]
forall a v c a. (a, CondTree v c a) -> c
getDeps [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
foreignLibs [Dependency] -> [Dependency] -> [Dependency]
forall a. Semigroup a => a -> a -> a
<>
                       ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> [Dependency])
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> [Dependency]
forall a v c a. (a, CondTree v c a) -> c
getDeps [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes [Dependency] -> [Dependency] -> [Dependency]
forall a. Semigroup a => a -> a -> a
<>
                       ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> [Dependency])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> [Dependency]
forall a v c a. (a, CondTree v c a) -> c
getDeps [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
tests [Dependency] -> [Dependency] -> [Dependency]
forall a. Semigroup a => a -> a -> a
<>
                       ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> [Dependency])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> [Dependency]
forall a v c a. (a, CondTree v c a) -> c
getDeps [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benches [Dependency] -> [Dependency] -> [Dependency]
forall a. Semigroup a => a -> a -> a
<>
                       [Dependency]
-> (CondTree ConfVar [Dependency] Library -> [Dependency])
-> Maybe (CondTree ConfVar [Dependency] Library)
-> [Dependency]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] CondTree ConfVar [Dependency] Library -> [Dependency]
forall v c a. CondTree v c a -> c
C.condTreeConstraints Maybe (CondTree ConfVar [Dependency] Library)
lib
        libraries :: [LibraryName]
libraries = (Dependency -> [LibraryName]) -> [Dependency] -> [LibraryName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Set LibraryName -> [LibraryName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set LibraryName -> [LibraryName])
-> (Dependency -> Set LibraryName) -> Dependency -> [LibraryName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> Set LibraryName
depLibraries) [Dependency]
dependencies

    Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([LibraryName] -> Bool
forall (t :: * -> *). Foldable t => t LibraryName -> Bool
subLibDepExist [LibraryName]
libraries)
      (Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"SubLibrary dependency is not supported, this will almost certainly fail")
  where
    getDeps :: (a, CondTree v c a) -> c
getDeps (a
_, C.CondNode a
_ c
dep [CondBranch v c a]
_) = c
dep
    subLibDepExist :: t LibraryName -> Bool
subLibDepExist t LibraryName
lib = 
      (LibraryName -> Bool) -> t LibraryName -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\LibraryName
x ->
        case LibraryName
x of
          C.LSubLibName UnqualComponentName
_ -> Bool
True
          LibraryName
C.LMainLibName  -> Bool
False
      ) t LibraryName
lib