{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections      #-}
{-# LANGUAGE ViewPatterns       #-}
-- | Parsing command line targets
--
-- There are two relevant data sources for performing this parsing:
-- the project configuration, and command line arguments. Project
-- configurations includes the resolver (defining a LoadedSnapshot of
-- global and snapshot packages), local dependencies, and project
-- packages. It also defines local flag overrides.
--
-- The command line arguments specify both additional local flag
-- overrides and targets in their raw form.
--
-- Flags are simple: we just combine CLI flags with config flags and
-- make one big map of flags, preferring CLI flags when present.
--
-- Raw targets can be a package name, a package name with component,
-- just a component, or a package name and version number. We first
-- must resolve these raw targets into both simple targets and
-- additional dependencies. This works as follows:
--
-- * If a component is specified, find a unique project package which
--   defines that component, and convert it into a name+component
--   target.
--
-- * Ensure that all name+component values refer to valid components
--   in the given project package.
--
-- * For names, check if the name is present in the snapshot, local
--   deps, or project packages. If it is not, then look up the most
--   recent version in the package index and convert to a
--   name+version.
--
-- * For name+version, first ensure that the name is not used by a
--   project package. Next, if that name+version is present in the
--   snapshot or local deps _and_ its location is PLIndex, we have the
--   package. Otherwise, add to local deps with the appropriate
--   PLIndex.
--
-- If in either of the last two bullets we added a package to local
-- deps, print a warning to the user recommending modifying the
-- extra-deps.
--
-- Combine the various 'ResolveResults's together into 'Target'
-- values, by combining various components for a single package and
-- ensuring that no conflicting statements were made about targets.
--
-- At this point, we now have a Map from package name to SimpleTarget,
-- and an updated Map of local dependencies. We still have the
-- aggregated flags, and the snapshot and project packages.
--
-- Finally, we upgrade the snapshot by using
-- calculatePackagePromotion.
module Stack.Build.Target
    ( -- * Types
      Target (..)
    , NeedTargets (..)
    , PackageType (..)
    , parseTargets
      -- * Convenience helpers
    , gpdVersion
      -- * Test suite exports
    , parseRawTarget
    , RawTarget (..)
    , UnresolvedComponent (..)
    ) where

import           Stack.Prelude
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import           Path
import           Path.Extra (rejectMissingDir)
import           Path.IO
import           RIO.Process (HasProcessContext)
import           Stack.SourceMap
import           Stack.Types.Config
import           Stack.Types.NamedComponent
import           Stack.Types.Build
import           Stack.Types.SourceMap

-- | Do we need any targets? For example, `stack build` will fail if
-- no targets are provided.
data NeedTargets = NeedTargets | AllowNoTargets

---------------------------------------------------------------------------------
-- Get the RawInput
---------------------------------------------------------------------------------

-- | Raw target information passed on the command line.
newtype RawInput = RawInput { RawInput -> Text
unRawInput :: Text }

getRawInput :: BuildOptsCLI -> Map PackageName ProjectPackage -> ([Text], [RawInput])
getRawInput :: BuildOptsCLI
-> Map PackageName ProjectPackage -> ([Text], [RawInput])
getRawInput BuildOptsCLI
boptscli Map PackageName ProjectPackage
locals =
    let textTargets' :: [Text]
textTargets' = BuildOptsCLI -> [Text]
boptsCLITargets BuildOptsCLI
boptscli
        textTargets :: [Text]
textTargets =
            -- Handle the no targets case, which means we pass in the names of all project packages
            if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
textTargets'
                then (PackageName -> Text) -> [PackageName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (PackageName -> String) -> PackageName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
packageNameString) (Map PackageName ProjectPackage -> [PackageName]
forall k a. Map k a -> [k]
Map.keys Map PackageName ProjectPackage
locals)
                else [Text]
textTargets'
     in ([Text]
textTargets', (Text -> RawInput) -> [Text] -> [RawInput]
forall a b. (a -> b) -> [a] -> [b]
map Text -> RawInput
RawInput [Text]
textTargets)

---------------------------------------------------------------------------------
-- Turn RawInput into RawTarget
---------------------------------------------------------------------------------

-- | The name of a component, which applies to executables, test
-- suites, and benchmarks
type ComponentName = Text

-- | Either a fully resolved component, or a component name that could be
-- either an executable, test, or benchmark
data UnresolvedComponent
    = ResolvedComponent !NamedComponent
    | UnresolvedComponent !ComponentName
    deriving (Int -> UnresolvedComponent -> ShowS
[UnresolvedComponent] -> ShowS
UnresolvedComponent -> String
(Int -> UnresolvedComponent -> ShowS)
-> (UnresolvedComponent -> String)
-> ([UnresolvedComponent] -> ShowS)
-> Show UnresolvedComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnresolvedComponent] -> ShowS
$cshowList :: [UnresolvedComponent] -> ShowS
show :: UnresolvedComponent -> String
$cshow :: UnresolvedComponent -> String
showsPrec :: Int -> UnresolvedComponent -> ShowS
$cshowsPrec :: Int -> UnresolvedComponent -> ShowS
Show, UnresolvedComponent -> UnresolvedComponent -> Bool
(UnresolvedComponent -> UnresolvedComponent -> Bool)
-> (UnresolvedComponent -> UnresolvedComponent -> Bool)
-> Eq UnresolvedComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnresolvedComponent -> UnresolvedComponent -> Bool
$c/= :: UnresolvedComponent -> UnresolvedComponent -> Bool
== :: UnresolvedComponent -> UnresolvedComponent -> Bool
$c== :: UnresolvedComponent -> UnresolvedComponent -> Bool
Eq, Eq UnresolvedComponent
Eq UnresolvedComponent
-> (UnresolvedComponent -> UnresolvedComponent -> Ordering)
-> (UnresolvedComponent -> UnresolvedComponent -> Bool)
-> (UnresolvedComponent -> UnresolvedComponent -> Bool)
-> (UnresolvedComponent -> UnresolvedComponent -> Bool)
-> (UnresolvedComponent -> UnresolvedComponent -> Bool)
-> (UnresolvedComponent
    -> UnresolvedComponent -> UnresolvedComponent)
-> (UnresolvedComponent
    -> UnresolvedComponent -> UnresolvedComponent)
-> Ord UnresolvedComponent
UnresolvedComponent -> UnresolvedComponent -> Bool
UnresolvedComponent -> UnresolvedComponent -> Ordering
UnresolvedComponent -> UnresolvedComponent -> UnresolvedComponent
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UnresolvedComponent -> UnresolvedComponent -> UnresolvedComponent
$cmin :: UnresolvedComponent -> UnresolvedComponent -> UnresolvedComponent
max :: UnresolvedComponent -> UnresolvedComponent -> UnresolvedComponent
$cmax :: UnresolvedComponent -> UnresolvedComponent -> UnresolvedComponent
>= :: UnresolvedComponent -> UnresolvedComponent -> Bool
$c>= :: UnresolvedComponent -> UnresolvedComponent -> Bool
> :: UnresolvedComponent -> UnresolvedComponent -> Bool
$c> :: UnresolvedComponent -> UnresolvedComponent -> Bool
<= :: UnresolvedComponent -> UnresolvedComponent -> Bool
$c<= :: UnresolvedComponent -> UnresolvedComponent -> Bool
< :: UnresolvedComponent -> UnresolvedComponent -> Bool
$c< :: UnresolvedComponent -> UnresolvedComponent -> Bool
compare :: UnresolvedComponent -> UnresolvedComponent -> Ordering
$ccompare :: UnresolvedComponent -> UnresolvedComponent -> Ordering
$cp1Ord :: Eq UnresolvedComponent
Ord)

-- | Raw command line input, without checking against any databases or list of
-- locals. Does not deal with directories
data RawTarget
    = RTPackageComponent !PackageName !UnresolvedComponent
    | RTComponent !ComponentName
    | RTPackage !PackageName
    -- Explicitly _not_ supporting revisions on the command line. If
    -- you want that, you should be modifying your stack.yaml! (In
    -- fact, you should probably do that anyway, we're just letting
    -- people be lazy, since we're Haskeletors.)
    | RTPackageIdentifier !PackageIdentifier
  deriving (Int -> RawTarget -> ShowS
[RawTarget] -> ShowS
RawTarget -> String
(Int -> RawTarget -> ShowS)
-> (RawTarget -> String)
-> ([RawTarget] -> ShowS)
-> Show RawTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawTarget] -> ShowS
$cshowList :: [RawTarget] -> ShowS
show :: RawTarget -> String
$cshow :: RawTarget -> String
showsPrec :: Int -> RawTarget -> ShowS
$cshowsPrec :: Int -> RawTarget -> ShowS
Show, RawTarget -> RawTarget -> Bool
(RawTarget -> RawTarget -> Bool)
-> (RawTarget -> RawTarget -> Bool) -> Eq RawTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawTarget -> RawTarget -> Bool
$c/= :: RawTarget -> RawTarget -> Bool
== :: RawTarget -> RawTarget -> Bool
$c== :: RawTarget -> RawTarget -> Bool
Eq)

-- | Same as @parseRawTarget@, but also takes directories into account.
parseRawTargetDirs :: MonadIO m
                   => Path Abs Dir -- ^ current directory
                   -> Map PackageName ProjectPackage
                   -> RawInput -- ^ raw target information from the commandline
                   -> m (Either Text [(RawInput, RawTarget)])
parseRawTargetDirs :: Path Abs Dir
-> Map PackageName ProjectPackage
-> RawInput
-> m (Either Text [(RawInput, RawTarget)])
parseRawTargetDirs Path Abs Dir
root Map PackageName ProjectPackage
locals RawInput
ri =
    case Text -> Maybe RawTarget
parseRawTarget Text
t of
        Just RawTarget
rt -> Either Text [(RawInput, RawTarget)]
-> m (Either Text [(RawInput, RawTarget)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text [(RawInput, RawTarget)]
 -> m (Either Text [(RawInput, RawTarget)]))
-> Either Text [(RawInput, RawTarget)]
-> m (Either Text [(RawInput, RawTarget)])
forall a b. (a -> b) -> a -> b
$ [(RawInput, RawTarget)] -> Either Text [(RawInput, RawTarget)]
forall a b. b -> Either a b
Right [(RawInput
ri, RawTarget
rt)]
        Maybe RawTarget
Nothing -> do
            Maybe (Path Abs Dir)
mdir <- IO (Maybe (Path Abs Dir)) -> m (Maybe (Path Abs Dir))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Path Abs Dir)) -> m (Maybe (Path Abs Dir)))
-> IO (Maybe (Path Abs Dir)) -> m (Maybe (Path Abs Dir))
forall a b. (a -> b) -> a -> b
$ IO (Path Abs Dir) -> IO (Maybe (Path Abs Dir))
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (Path Abs Dir -> String -> IO (Path Abs Dir)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs Dir)
resolveDir Path Abs Dir
root (Text -> String
T.unpack Text
t))
              IO (Maybe (Path Abs Dir))
-> (Maybe (Path Abs Dir) -> IO (Maybe (Path Abs Dir)))
-> IO (Maybe (Path Abs Dir))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Path Abs Dir) -> IO (Maybe (Path Abs Dir))
forall (m :: * -> *).
MonadIO m =>
Maybe (Path Abs Dir) -> m (Maybe (Path Abs Dir))
rejectMissingDir
            case Maybe (Path Abs Dir)
mdir of
                Maybe (Path Abs Dir)
Nothing -> Either Text [(RawInput, RawTarget)]
-> m (Either Text [(RawInput, RawTarget)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text [(RawInput, RawTarget)]
 -> m (Either Text [(RawInput, RawTarget)]))
-> Either Text [(RawInput, RawTarget)]
-> m (Either Text [(RawInput, RawTarget)])
forall a b. (a -> b) -> a -> b
$ Text -> Either Text [(RawInput, RawTarget)]
forall a b. a -> Either a b
Left (Text -> Either Text [(RawInput, RawTarget)])
-> Text -> Either Text [(RawInput, RawTarget)]
forall a b. (a -> b) -> a -> b
$ Text
"Directory not found: " Text -> Text -> Text
`T.append` Text
t
                Just Path Abs Dir
dir ->
                    case ((PackageName, ProjectPackage) -> Maybe PackageName)
-> [(PackageName, ProjectPackage)] -> [PackageName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Path Abs Dir -> (PackageName, ProjectPackage) -> Maybe PackageName
forall a. Path Abs Dir -> (a, ProjectPackage) -> Maybe a
childOf Path Abs Dir
dir) ([(PackageName, ProjectPackage)] -> [PackageName])
-> [(PackageName, ProjectPackage)] -> [PackageName]
forall a b. (a -> b) -> a -> b
$ Map PackageName ProjectPackage -> [(PackageName, ProjectPackage)]
forall k a. Map k a -> [(k, a)]
Map.toList Map PackageName ProjectPackage
locals of
                        [] -> Either Text [(RawInput, RawTarget)]
-> m (Either Text [(RawInput, RawTarget)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text [(RawInput, RawTarget)]
 -> m (Either Text [(RawInput, RawTarget)]))
-> Either Text [(RawInput, RawTarget)]
-> m (Either Text [(RawInput, RawTarget)])
forall a b. (a -> b) -> a -> b
$ Text -> Either Text [(RawInput, RawTarget)]
forall a b. a -> Either a b
Left (Text -> Either Text [(RawInput, RawTarget)])
-> Text -> Either Text [(RawInput, RawTarget)]
forall a b. (a -> b) -> a -> b
$
                            Text
"No local directories found as children of " Text -> Text -> Text
`T.append`
                            Text
t
                        [PackageName]
names -> Either Text [(RawInput, RawTarget)]
-> m (Either Text [(RawInput, RawTarget)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text [(RawInput, RawTarget)]
 -> m (Either Text [(RawInput, RawTarget)]))
-> Either Text [(RawInput, RawTarget)]
-> m (Either Text [(RawInput, RawTarget)])
forall a b. (a -> b) -> a -> b
$ [(RawInput, RawTarget)] -> Either Text [(RawInput, RawTarget)]
forall a b. b -> Either a b
Right ([(RawInput, RawTarget)] -> Either Text [(RawInput, RawTarget)])
-> [(RawInput, RawTarget)] -> Either Text [(RawInput, RawTarget)]
forall a b. (a -> b) -> a -> b
$ (PackageName -> (RawInput, RawTarget))
-> [PackageName] -> [(RawInput, RawTarget)]
forall a b. (a -> b) -> [a] -> [b]
map ((RawInput
ri, ) (RawTarget -> (RawInput, RawTarget))
-> (PackageName -> RawTarget)
-> PackageName
-> (RawInput, RawTarget)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> RawTarget
RTPackage) [PackageName]
names
  where
    childOf :: Path Abs Dir -> (a, ProjectPackage) -> Maybe a
childOf Path Abs Dir
dir (a
name, ProjectPackage
pp) =
        if Path Abs Dir
dir Path Abs Dir -> Path Abs Dir -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectPackage -> Path Abs Dir
ppRoot ProjectPackage
pp Bool -> Bool -> Bool
|| Path Abs Dir -> Path Abs Dir -> Bool
forall b t. Path b Dir -> Path b t -> Bool
isProperPrefixOf Path Abs Dir
dir (ProjectPackage -> Path Abs Dir
ppRoot ProjectPackage
pp)
            then a -> Maybe a
forall a. a -> Maybe a
Just a
name
            else Maybe a
forall a. Maybe a
Nothing

    RawInput Text
t = RawInput
ri

-- | If this function returns @Nothing@, the input should be treated as a
-- directory.
parseRawTarget :: Text -> Maybe RawTarget
parseRawTarget :: Text -> Maybe RawTarget
parseRawTarget Text
t =
        (PackageIdentifier -> RawTarget
RTPackageIdentifier (PackageIdentifier -> RawTarget)
-> Maybe PackageIdentifier -> Maybe RawTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe PackageIdentifier
parsePackageIdentifier String
s)
    Maybe RawTarget -> Maybe RawTarget -> Maybe RawTarget
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (PackageName -> RawTarget
RTPackage (PackageName -> RawTarget) -> Maybe PackageName -> Maybe RawTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe PackageName
parsePackageName String
s)
    Maybe RawTarget -> Maybe RawTarget -> Maybe RawTarget
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> RawTarget
RTComponent (Text -> RawTarget) -> Maybe Text -> Maybe RawTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe Text
T.stripPrefix Text
":" Text
t)
    Maybe RawTarget -> Maybe RawTarget -> Maybe RawTarget
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe RawTarget
parsePackageComponent
  where
    s :: String
s = Text -> String
T.unpack Text
t

    parsePackageComponent :: Maybe RawTarget
parsePackageComponent =
        case Text -> Text -> [Text]
T.splitOn Text
":" Text
t of
            [Text
pname, Text
"lib"]
                | Just PackageName
pname' <- String -> Maybe PackageName
parsePackageName (Text -> String
T.unpack Text
pname) ->
                    RawTarget -> Maybe RawTarget
forall a. a -> Maybe a
Just (RawTarget -> Maybe RawTarget) -> RawTarget -> Maybe RawTarget
forall a b. (a -> b) -> a -> b
$ PackageName -> UnresolvedComponent -> RawTarget
RTPackageComponent PackageName
pname' (UnresolvedComponent -> RawTarget)
-> UnresolvedComponent -> RawTarget
forall a b. (a -> b) -> a -> b
$ NamedComponent -> UnresolvedComponent
ResolvedComponent NamedComponent
CLib
            [Text
pname, Text
cname]
                | Just PackageName
pname' <- String -> Maybe PackageName
parsePackageName (Text -> String
T.unpack Text
pname) ->
                    RawTarget -> Maybe RawTarget
forall a. a -> Maybe a
Just (RawTarget -> Maybe RawTarget) -> RawTarget -> Maybe RawTarget
forall a b. (a -> b) -> a -> b
$ PackageName -> UnresolvedComponent -> RawTarget
RTPackageComponent PackageName
pname' (UnresolvedComponent -> RawTarget)
-> UnresolvedComponent -> RawTarget
forall a b. (a -> b) -> a -> b
$ Text -> UnresolvedComponent
UnresolvedComponent Text
cname
            [Text
pname, Text
typ, Text
cname]
                | Just PackageName
pname' <- String -> Maybe PackageName
parsePackageName (Text -> String
T.unpack Text
pname)
                , Just Text -> NamedComponent
wrapper <- Text -> Maybe (Text -> NamedComponent)
forall a. (Eq a, IsString a) => a -> Maybe (Text -> NamedComponent)
parseCompType Text
typ ->
                    RawTarget -> Maybe RawTarget
forall a. a -> Maybe a
Just (RawTarget -> Maybe RawTarget) -> RawTarget -> Maybe RawTarget
forall a b. (a -> b) -> a -> b
$ PackageName -> UnresolvedComponent -> RawTarget
RTPackageComponent PackageName
pname' (UnresolvedComponent -> RawTarget)
-> UnresolvedComponent -> RawTarget
forall a b. (a -> b) -> a -> b
$ NamedComponent -> UnresolvedComponent
ResolvedComponent (NamedComponent -> UnresolvedComponent)
-> NamedComponent -> UnresolvedComponent
forall a b. (a -> b) -> a -> b
$ Text -> NamedComponent
wrapper Text
cname
            [Text]
_ -> Maybe RawTarget
forall a. Maybe a
Nothing

    parseCompType :: a -> Maybe (Text -> NamedComponent)
parseCompType a
t' =
        case a
t' of
            a
"exe" -> (Text -> NamedComponent) -> Maybe (Text -> NamedComponent)
forall a. a -> Maybe a
Just Text -> NamedComponent
CExe
            a
"test" -> (Text -> NamedComponent) -> Maybe (Text -> NamedComponent)
forall a. a -> Maybe a
Just Text -> NamedComponent
CTest
            a
"bench" -> (Text -> NamedComponent) -> Maybe (Text -> NamedComponent)
forall a. a -> Maybe a
Just Text -> NamedComponent
CBench
            a
_ -> Maybe (Text -> NamedComponent)
forall a. Maybe a
Nothing

---------------------------------------------------------------------------------
-- Resolve the raw targets
---------------------------------------------------------------------------------

data ResolveResult = ResolveResult
  { ResolveResult -> PackageName
rrName :: !PackageName
  , ResolveResult -> RawInput
rrRaw :: !RawInput
  , ResolveResult -> Maybe NamedComponent
rrComponent :: !(Maybe NamedComponent)
  -- ^ Was a concrete component specified?
  , ResolveResult -> Maybe PackageLocationImmutable
rrAddedDep :: !(Maybe PackageLocationImmutable)
  -- ^ Only if we're adding this as a dependency
  , ResolveResult -> PackageType
rrPackageType :: !PackageType
  }

-- | Convert a 'RawTarget' into a 'ResolveResult' (see description on
-- the module).
resolveRawTarget ::
       (HasLogFunc env, HasPantryConfig env, HasProcessContext env)
    => SMActual GlobalPackage
    -> Map PackageName PackageLocation
    -> (RawInput, RawTarget)
    -> RIO env (Either Text ResolveResult)
resolveRawTarget :: SMActual GlobalPackage
-> Map PackageName PackageLocation
-> (RawInput, RawTarget)
-> RIO env (Either Text ResolveResult)
resolveRawTarget SMActual GlobalPackage
sma Map PackageName PackageLocation
allLocs (RawInput
ri, RawTarget
rt) =
  RawTarget -> RIO env (Either Text ResolveResult)
go RawTarget
rt
  where
    locals :: Map PackageName ProjectPackage
locals = SMActual GlobalPackage -> Map PackageName ProjectPackage
forall global. SMActual global -> Map PackageName ProjectPackage
smaProject SMActual GlobalPackage
sma
    deps :: Map PackageName DepPackage
deps = SMActual GlobalPackage -> Map PackageName DepPackage
forall global. SMActual global -> Map PackageName DepPackage
smaDeps SMActual GlobalPackage
sma
    globals :: Map PackageName GlobalPackage
globals = SMActual GlobalPackage -> Map PackageName GlobalPackage
forall global. SMActual global -> Map PackageName global
smaGlobal SMActual GlobalPackage
sma
    -- Helper function: check if a 'NamedComponent' matches the given 'ComponentName'
    isCompNamed :: ComponentName -> NamedComponent -> Bool
    isCompNamed :: Text -> NamedComponent -> Bool
isCompNamed Text
_ NamedComponent
CLib = Bool
False
    isCompNamed Text
t1 (CInternalLib Text
t2) = Text
t1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t2
    isCompNamed Text
t1 (CExe Text
t2) = Text
t1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t2
    isCompNamed Text
t1 (CTest Text
t2) = Text
t1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t2
    isCompNamed Text
t1 (CBench Text
t2) = Text
t1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t2

    go :: RawTarget -> RIO env (Either Text ResolveResult)
go (RTComponent Text
cname) = do
        -- Associated list from component name to package that defines
        -- it. We use an assoc list and not a Map so we can detect
        -- duplicates.
        [(PackageName, NamedComponent)]
allPairs <- (Map PackageName [(PackageName, NamedComponent)]
 -> [(PackageName, NamedComponent)])
-> RIO env (Map PackageName [(PackageName, NamedComponent)])
-> RIO env [(PackageName, NamedComponent)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map PackageName [(PackageName, NamedComponent)]
-> [(PackageName, NamedComponent)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (RIO env (Map PackageName [(PackageName, NamedComponent)])
 -> RIO env [(PackageName, NamedComponent)])
-> RIO env (Map PackageName [(PackageName, NamedComponent)])
-> RIO env [(PackageName, NamedComponent)]
forall a b. (a -> b) -> a -> b
$ ((PackageName
  -> ProjectPackage -> RIO env [(PackageName, NamedComponent)])
 -> Map PackageName ProjectPackage
 -> RIO env (Map PackageName [(PackageName, NamedComponent)]))
-> Map PackageName ProjectPackage
-> (PackageName
    -> ProjectPackage -> RIO env [(PackageName, NamedComponent)])
-> RIO env (Map PackageName [(PackageName, NamedComponent)])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (PackageName
 -> ProjectPackage -> RIO env [(PackageName, NamedComponent)])
-> Map PackageName ProjectPackage
-> RIO env (Map PackageName [(PackageName, NamedComponent)])
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey Map PackageName ProjectPackage
locals
          ((PackageName
  -> ProjectPackage -> RIO env [(PackageName, NamedComponent)])
 -> RIO env (Map PackageName [(PackageName, NamedComponent)]))
-> (PackageName
    -> ProjectPackage -> RIO env [(PackageName, NamedComponent)])
-> RIO env (Map PackageName [(PackageName, NamedComponent)])
forall a b. (a -> b) -> a -> b
$ \PackageName
name ProjectPackage
pp -> do
              Set NamedComponent
comps <- ProjectPackage -> RIO env (Set NamedComponent)
forall (m :: * -> *).
MonadIO m =>
ProjectPackage -> m (Set NamedComponent)
ppComponents ProjectPackage
pp
              [(PackageName, NamedComponent)]
-> RIO env [(PackageName, NamedComponent)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(PackageName, NamedComponent)]
 -> RIO env [(PackageName, NamedComponent)])
-> [(PackageName, NamedComponent)]
-> RIO env [(PackageName, NamedComponent)]
forall a b. (a -> b) -> a -> b
$ (NamedComponent -> (PackageName, NamedComponent))
-> [NamedComponent] -> [(PackageName, NamedComponent)]
forall a b. (a -> b) -> [a] -> [b]
map (PackageName
name, ) ([NamedComponent] -> [(PackageName, NamedComponent)])
-> [NamedComponent] -> [(PackageName, NamedComponent)]
forall a b. (a -> b) -> a -> b
$ Set NamedComponent -> [NamedComponent]
forall a. Set a -> [a]
Set.toList Set NamedComponent
comps
        Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text ResolveResult -> RIO env (Either Text ResolveResult))
-> Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall a b. (a -> b) -> a -> b
$ case ((PackageName, NamedComponent) -> Bool)
-> [(PackageName, NamedComponent)]
-> [(PackageName, NamedComponent)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> NamedComponent -> Bool
isCompNamed Text
cname (NamedComponent -> Bool)
-> ((PackageName, NamedComponent) -> NamedComponent)
-> (PackageName, NamedComponent)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageName, NamedComponent) -> NamedComponent
forall a b. (a, b) -> b
snd) [(PackageName, NamedComponent)]
allPairs of
                [] -> Text -> Either Text ResolveResult
forall a b. a -> Either a b
Left (Text -> Either Text ResolveResult)
-> Text -> Either Text ResolveResult
forall a b. (a -> b) -> a -> b
$ Text
cname Text -> Text -> Text
`T.append` Text
" doesn't seem to be a local target. Run 'stack ide targets' for a list of available targets"
                [(PackageName
name, NamedComponent
comp)] -> ResolveResult -> Either Text ResolveResult
forall a b. b -> Either a b
Right ResolveResult :: PackageName
-> RawInput
-> Maybe NamedComponent
-> Maybe PackageLocationImmutable
-> PackageType
-> ResolveResult
ResolveResult
                  { rrName :: PackageName
rrName = PackageName
name
                  , rrRaw :: RawInput
rrRaw = RawInput
ri
                  , rrComponent :: Maybe NamedComponent
rrComponent = NamedComponent -> Maybe NamedComponent
forall a. a -> Maybe a
Just NamedComponent
comp
                  , rrAddedDep :: Maybe PackageLocationImmutable
rrAddedDep = Maybe PackageLocationImmutable
forall a. Maybe a
Nothing
                  , rrPackageType :: PackageType
rrPackageType = PackageType
PTProject
                  }
                [(PackageName, NamedComponent)]
matches -> Text -> Either Text ResolveResult
forall a b. a -> Either a b
Left (Text -> Either Text ResolveResult)
-> Text -> Either Text ResolveResult
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
                    [ Text
"Ambiugous component name "
                    , Text
cname
                    , Text
", matches: "
                    , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [(PackageName, NamedComponent)] -> String
forall a. Show a => a -> String
show [(PackageName, NamedComponent)]
matches
                    ]
    go (RTPackageComponent PackageName
name UnresolvedComponent
ucomp) =
        case PackageName
-> Map PackageName ProjectPackage -> Maybe ProjectPackage
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name Map PackageName ProjectPackage
locals of
            Maybe ProjectPackage
Nothing -> Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text ResolveResult -> RIO env (Either Text ResolveResult))
-> Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ResolveResult
forall a b. a -> Either a b
Left (Text -> Either Text ResolveResult)
-> Text -> Either Text ResolveResult
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Unknown local package: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
packageNameString PackageName
name
            Just ProjectPackage
pp -> do
                Set NamedComponent
comps <- ProjectPackage -> RIO env (Set NamedComponent)
forall (m :: * -> *).
MonadIO m =>
ProjectPackage -> m (Set NamedComponent)
ppComponents ProjectPackage
pp
                Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text ResolveResult -> RIO env (Either Text ResolveResult))
-> Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall a b. (a -> b) -> a -> b
$ case UnresolvedComponent
ucomp of
                    ResolvedComponent NamedComponent
comp
                        | NamedComponent
comp NamedComponent -> Set NamedComponent -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set NamedComponent
comps -> ResolveResult -> Either Text ResolveResult
forall a b. b -> Either a b
Right ResolveResult :: PackageName
-> RawInput
-> Maybe NamedComponent
-> Maybe PackageLocationImmutable
-> PackageType
-> ResolveResult
ResolveResult
                            { rrName :: PackageName
rrName = PackageName
name
                            , rrRaw :: RawInput
rrRaw = RawInput
ri
                            , rrComponent :: Maybe NamedComponent
rrComponent = NamedComponent -> Maybe NamedComponent
forall a. a -> Maybe a
Just NamedComponent
comp
                            , rrAddedDep :: Maybe PackageLocationImmutable
rrAddedDep = Maybe PackageLocationImmutable
forall a. Maybe a
Nothing
                            , rrPackageType :: PackageType
rrPackageType = PackageType
PTProject
                            }
                        | Bool
otherwise -> Text -> Either Text ResolveResult
forall a b. a -> Either a b
Left (Text -> Either Text ResolveResult)
-> Text -> Either Text ResolveResult
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                            [ String
"Component "
                            , NamedComponent -> String
forall a. Show a => a -> String
show NamedComponent
comp
                            , String
" does not exist in package "
                            , PackageName -> String
packageNameString PackageName
name
                            ]
                    UnresolvedComponent Text
comp ->
                        case (NamedComponent -> Bool) -> [NamedComponent] -> [NamedComponent]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> NamedComponent -> Bool
isCompNamed Text
comp) ([NamedComponent] -> [NamedComponent])
-> [NamedComponent] -> [NamedComponent]
forall a b. (a -> b) -> a -> b
$ Set NamedComponent -> [NamedComponent]
forall a. Set a -> [a]
Set.toList Set NamedComponent
comps of
                            [] -> Text -> Either Text ResolveResult
forall a b. a -> Either a b
Left (Text -> Either Text ResolveResult)
-> Text -> Either Text ResolveResult
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
                                [ Text
"Component "
                                , Text
comp
                                , Text
" does not exist in package "
                                , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PackageName -> String
packageNameString PackageName
name
                                ]
                            [NamedComponent
x] -> ResolveResult -> Either Text ResolveResult
forall a b. b -> Either a b
Right ResolveResult :: PackageName
-> RawInput
-> Maybe NamedComponent
-> Maybe PackageLocationImmutable
-> PackageType
-> ResolveResult
ResolveResult
                              { rrName :: PackageName
rrName = PackageName
name
                              , rrRaw :: RawInput
rrRaw = RawInput
ri
                              , rrComponent :: Maybe NamedComponent
rrComponent = NamedComponent -> Maybe NamedComponent
forall a. a -> Maybe a
Just NamedComponent
x
                              , rrAddedDep :: Maybe PackageLocationImmutable
rrAddedDep = Maybe PackageLocationImmutable
forall a. Maybe a
Nothing
                              , rrPackageType :: PackageType
rrPackageType = PackageType
PTProject
                              }
                            [NamedComponent]
matches -> Text -> Either Text ResolveResult
forall a b. a -> Either a b
Left (Text -> Either Text ResolveResult)
-> Text -> Either Text ResolveResult
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
                                [ Text
"Ambiguous component name "
                                , Text
comp
                                , Text
" for package "
                                , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PackageName -> String
packageNameString PackageName
name
                                , Text
": "
                                , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [NamedComponent] -> String
forall a. Show a => a -> String
show [NamedComponent]
matches
                                ]

    go (RTPackage PackageName
name)
      | PackageName -> Map PackageName ProjectPackage -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member PackageName
name Map PackageName ProjectPackage
locals = Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ResolveResult -> RIO env (Either Text ResolveResult))
-> Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall a b. (a -> b) -> a -> b
$ ResolveResult -> Either Text ResolveResult
forall a b. b -> Either a b
Right ResolveResult :: PackageName
-> RawInput
-> Maybe NamedComponent
-> Maybe PackageLocationImmutable
-> PackageType
-> ResolveResult
ResolveResult
          { rrName :: PackageName
rrName = PackageName
name
          , rrRaw :: RawInput
rrRaw = RawInput
ri
          , rrComponent :: Maybe NamedComponent
rrComponent = Maybe NamedComponent
forall a. Maybe a
Nothing
          , rrAddedDep :: Maybe PackageLocationImmutable
rrAddedDep = Maybe PackageLocationImmutable
forall a. Maybe a
Nothing
          , rrPackageType :: PackageType
rrPackageType = PackageType
PTProject
          }
      | PackageName -> Map PackageName DepPackage -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member PackageName
name Map PackageName DepPackage
deps =
          Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text ResolveResult -> RIO env (Either Text ResolveResult))
-> Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall a b. (a -> b) -> a -> b
$ PackageName -> Either Text ResolveResult
deferToConstructPlan PackageName
name
      | Just GlobalPackage
gp <- PackageName -> Map PackageName GlobalPackage -> Maybe GlobalPackage
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name Map PackageName GlobalPackage
globals =
          case GlobalPackage
gp of
              GlobalPackage Version
_ -> Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text ResolveResult -> RIO env (Either Text ResolveResult))
-> Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall a b. (a -> b) -> a -> b
$ PackageName -> Either Text ResolveResult
deferToConstructPlan PackageName
name
              ReplacedGlobalPackage [PackageName]
_ -> PackageName -> RIO env (Either Text ResolveResult)
hackageLatest PackageName
name
      | Bool
otherwise = PackageName -> RIO env (Either Text ResolveResult)
hackageLatest PackageName
name

    -- Note that we use getLatestHackageRevision below, even though it's
    -- non-reproducible, to avoid user confusion. In any event,
    -- reproducible builds should be done by updating your config
    -- files!

    go (RTPackageIdentifier ident :: PackageIdentifier
ident@(PackageIdentifier PackageName
name Version
version))
      | PackageName -> Map PackageName ProjectPackage -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member PackageName
name Map PackageName ProjectPackage
locals = Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ResolveResult -> RIO env (Either Text ResolveResult))
-> Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ResolveResult
forall a b. a -> Either a b
Left (Text -> Either Text ResolveResult)
-> Text -> Either Text ResolveResult
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
            [ String -> Text
forall a. Show a => a -> Text
tshow (PackageName -> String
packageNameString PackageName
name)
            , Text
" target has a specific version number, but it is a local package."
            , Text
"\nTo avoid confusion, we will not install the specified version or build the local one."
            , Text
"\nTo build the local package, specify the target without an explicit version."
            ]
      | Bool
otherwise =
          case PackageName
-> Map PackageName PackageLocation -> Maybe PackageLocation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name Map PackageName PackageLocation
allLocs of
            -- Installing it from the package index, so we're cool
            -- with overriding it if necessary
            Just (PLImmutable (PLIHackage (PackageIdentifier PackageName
_name Version
versionLoc) BlobKey
_cfKey TreeKey
_treeKey)) ->
              if Version
version Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
versionLoc
              then Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text ResolveResult -> RIO env (Either Text ResolveResult))
-> Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall a b. (a -> b) -> a -> b
$ PackageName -> Either Text ResolveResult
deferToConstructPlan PackageName
name
              else PackageName -> Version -> RIO env (Either Text ResolveResult)
hackageLatestRevision PackageName
name Version
version
            -- The package was coming from something besides the
            -- index, so refuse to do the override
            Just PackageLocation
loc' -> Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text ResolveResult -> RIO env (Either Text ResolveResult))
-> Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ResolveResult
forall a b. a -> Either a b
Left (Text -> Either Text ResolveResult)
-> Text -> Either Text ResolveResult
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
              [ Text
"Package with identifier was targeted on the command line: "
              , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> String
packageIdentifierString PackageIdentifier
ident
              , Text
", but it was specified from a non-index location: "
              , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PackageLocation -> String
forall a. Show a => a -> String
show PackageLocation
loc'
              , Text
".\nRecommendation: add the correctly desired version to extra-deps."
              ]
            -- Not present at all, add it from Hackage
            Maybe PackageLocation
Nothing -> do
              Maybe (Revision, BlobKey, TreeKey)
mrev <- RequireHackageIndex
-> PackageName
-> Version
-> RIO env (Maybe (Revision, BlobKey, TreeKey))
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
RequireHackageIndex
-> PackageName
-> Version
-> RIO env (Maybe (Revision, BlobKey, TreeKey))
getLatestHackageRevision RequireHackageIndex
YesRequireHackageIndex PackageName
name Version
version
              Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text ResolveResult -> RIO env (Either Text ResolveResult))
-> Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall a b. (a -> b) -> a -> b
$ case Maybe (Revision, BlobKey, TreeKey)
mrev of
                Maybe (Revision, BlobKey, TreeKey)
Nothing -> PackageName -> Either Text ResolveResult
deferToConstructPlan PackageName
name
                Just (Revision
_rev, BlobKey
cfKey, TreeKey
treeKey) -> ResolveResult -> Either Text ResolveResult
forall a b. b -> Either a b
Right ResolveResult :: PackageName
-> RawInput
-> Maybe NamedComponent
-> Maybe PackageLocationImmutable
-> PackageType
-> ResolveResult
ResolveResult
                  { rrName :: PackageName
rrName = PackageName
name
                  , rrRaw :: RawInput
rrRaw = RawInput
ri
                  , rrComponent :: Maybe NamedComponent
rrComponent = Maybe NamedComponent
forall a. Maybe a
Nothing
                  , rrAddedDep :: Maybe PackageLocationImmutable
rrAddedDep = PackageLocationImmutable -> Maybe PackageLocationImmutable
forall a. a -> Maybe a
Just (PackageLocationImmutable -> Maybe PackageLocationImmutable)
-> PackageLocationImmutable -> Maybe PackageLocationImmutable
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> BlobKey -> TreeKey -> PackageLocationImmutable
PLIHackage (PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
name Version
version) BlobKey
cfKey TreeKey
treeKey
                  , rrPackageType :: PackageType
rrPackageType = PackageType
PTDependency
                  }

    hackageLatest :: PackageName -> RIO env (Either Text ResolveResult)
hackageLatest PackageName
name = do
        Maybe PackageLocationImmutable
mloc <- RequireHackageIndex
-> PackageName
-> UsePreferredVersions
-> RIO env (Maybe PackageLocationImmutable)
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
RequireHackageIndex
-> PackageName
-> UsePreferredVersions
-> RIO env (Maybe PackageLocationImmutable)
getLatestHackageLocation RequireHackageIndex
YesRequireHackageIndex PackageName
name UsePreferredVersions
UsePreferredVersions
        Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text ResolveResult -> RIO env (Either Text ResolveResult))
-> Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall a b. (a -> b) -> a -> b
$ case Maybe PackageLocationImmutable
mloc of
          Maybe PackageLocationImmutable
Nothing -> PackageName -> Either Text ResolveResult
deferToConstructPlan PackageName
name
          Just PackageLocationImmutable
loc -> do
            ResolveResult -> Either Text ResolveResult
forall a b. b -> Either a b
Right ResolveResult :: PackageName
-> RawInput
-> Maybe NamedComponent
-> Maybe PackageLocationImmutable
-> PackageType
-> ResolveResult
ResolveResult
                  { rrName :: PackageName
rrName = PackageName
name
                  , rrRaw :: RawInput
rrRaw = RawInput
ri
                  , rrComponent :: Maybe NamedComponent
rrComponent = Maybe NamedComponent
forall a. Maybe a
Nothing
                  , rrAddedDep :: Maybe PackageLocationImmutable
rrAddedDep = PackageLocationImmutable -> Maybe PackageLocationImmutable
forall a. a -> Maybe a
Just PackageLocationImmutable
loc
                  , rrPackageType :: PackageType
rrPackageType = PackageType
PTDependency
                  }

    hackageLatestRevision :: PackageName -> Version -> RIO env (Either Text ResolveResult)
hackageLatestRevision PackageName
name Version
version = do
        Maybe (Revision, BlobKey, TreeKey)
mrev <- RequireHackageIndex
-> PackageName
-> Version
-> RIO env (Maybe (Revision, BlobKey, TreeKey))
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
RequireHackageIndex
-> PackageName
-> Version
-> RIO env (Maybe (Revision, BlobKey, TreeKey))
getLatestHackageRevision RequireHackageIndex
YesRequireHackageIndex PackageName
name Version
version
        Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text ResolveResult -> RIO env (Either Text ResolveResult))
-> Either Text ResolveResult -> RIO env (Either Text ResolveResult)
forall a b. (a -> b) -> a -> b
$ case Maybe (Revision, BlobKey, TreeKey)
mrev of
          Maybe (Revision, BlobKey, TreeKey)
Nothing -> PackageName -> Either Text ResolveResult
deferToConstructPlan PackageName
name
          Just (Revision
_rev, BlobKey
cfKey, TreeKey
treeKey) -> ResolveResult -> Either Text ResolveResult
forall a b. b -> Either a b
Right ResolveResult :: PackageName
-> RawInput
-> Maybe NamedComponent
-> Maybe PackageLocationImmutable
-> PackageType
-> ResolveResult
ResolveResult
            { rrName :: PackageName
rrName = PackageName
name
            , rrRaw :: RawInput
rrRaw = RawInput
ri
            , rrComponent :: Maybe NamedComponent
rrComponent = Maybe NamedComponent
forall a. Maybe a
Nothing
            , rrAddedDep :: Maybe PackageLocationImmutable
rrAddedDep = PackageLocationImmutable -> Maybe PackageLocationImmutable
forall a. a -> Maybe a
Just (PackageLocationImmutable -> Maybe PackageLocationImmutable)
-> PackageLocationImmutable -> Maybe PackageLocationImmutable
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> BlobKey -> TreeKey -> PackageLocationImmutable
PLIHackage (PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
name Version
version) BlobKey
cfKey TreeKey
treeKey
            , rrPackageType :: PackageType
rrPackageType = PackageType
PTDependency
            }

    -- This is actually an error case. We _could_ return a
    -- Left value here, but it turns out to be better to defer
    -- this until the ConstructPlan phase, and let it complain
    -- about the missing package so that we get more errors
    -- together, plus the fancy colored output from that
    -- module.
    deferToConstructPlan :: PackageName -> Either Text ResolveResult
deferToConstructPlan PackageName
name = ResolveResult -> Either Text ResolveResult
forall a b. b -> Either a b
Right ResolveResult :: PackageName
-> RawInput
-> Maybe NamedComponent
-> Maybe PackageLocationImmutable
-> PackageType
-> ResolveResult
ResolveResult
              { rrName :: PackageName
rrName = PackageName
name
              , rrRaw :: RawInput
rrRaw = RawInput
ri
              , rrComponent :: Maybe NamedComponent
rrComponent = Maybe NamedComponent
forall a. Maybe a
Nothing
              , rrAddedDep :: Maybe PackageLocationImmutable
rrAddedDep = Maybe PackageLocationImmutable
forall a. Maybe a
Nothing
              , rrPackageType :: PackageType
rrPackageType = PackageType
PTDependency
              }
---------------------------------------------------------------------------------
-- Combine the ResolveResults
---------------------------------------------------------------------------------

combineResolveResults
  :: forall env. HasLogFunc env
  => [ResolveResult]
  -> RIO env ([Text], Map PackageName Target, Map PackageName PackageLocationImmutable)
combineResolveResults :: [ResolveResult]
-> RIO
     env
     ([Text], Map PackageName Target,
      Map PackageName PackageLocationImmutable)
combineResolveResults [ResolveResult]
results = do
    Map PackageName PackageLocationImmutable
addedDeps <- ([Map PackageName PackageLocationImmutable]
 -> Map PackageName PackageLocationImmutable)
-> RIO env [Map PackageName PackageLocationImmutable]
-> RIO env (Map PackageName PackageLocationImmutable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Map PackageName PackageLocationImmutable]
-> Map PackageName PackageLocationImmutable
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (RIO env [Map PackageName PackageLocationImmutable]
 -> RIO env (Map PackageName PackageLocationImmutable))
-> RIO env [Map PackageName PackageLocationImmutable]
-> RIO env (Map PackageName PackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ [ResolveResult]
-> (ResolveResult
    -> RIO env (Map PackageName PackageLocationImmutable))
-> RIO env [Map PackageName PackageLocationImmutable]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ResolveResult]
results ((ResolveResult
  -> RIO env (Map PackageName PackageLocationImmutable))
 -> RIO env [Map PackageName PackageLocationImmutable])
-> (ResolveResult
    -> RIO env (Map PackageName PackageLocationImmutable))
-> RIO env [Map PackageName PackageLocationImmutable]
forall a b. (a -> b) -> a -> b
$ \ResolveResult
result ->
      case ResolveResult -> Maybe PackageLocationImmutable
rrAddedDep ResolveResult
result of
        Maybe PackageLocationImmutable
Nothing -> Map PackageName PackageLocationImmutable
-> RIO env (Map PackageName PackageLocationImmutable)
forall (m :: * -> *) a. Monad m => a -> m a
return Map PackageName PackageLocationImmutable
forall k a. Map k a
Map.empty
        Just PackageLocationImmutable
pl -> do
          Map PackageName PackageLocationImmutable
-> RIO env (Map PackageName PackageLocationImmutable)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map PackageName PackageLocationImmutable
 -> RIO env (Map PackageName PackageLocationImmutable))
-> Map PackageName PackageLocationImmutable
-> RIO env (Map PackageName PackageLocationImmutable)
forall a b. (a -> b) -> a -> b
$ PackageName
-> PackageLocationImmutable
-> Map PackageName PackageLocationImmutable
forall k a. k -> a -> Map k a
Map.singleton (ResolveResult -> PackageName
rrName ResolveResult
result) PackageLocationImmutable
pl

    let m0 :: Map PackageName [ResolveResult]
m0 = ([ResolveResult] -> [ResolveResult] -> [ResolveResult])
-> [Map PackageName [ResolveResult]]
-> Map PackageName [ResolveResult]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith [ResolveResult] -> [ResolveResult] -> [ResolveResult]
forall a. [a] -> [a] -> [a]
(++) ([Map PackageName [ResolveResult]]
 -> Map PackageName [ResolveResult])
-> [Map PackageName [ResolveResult]]
-> Map PackageName [ResolveResult]
forall a b. (a -> b) -> a -> b
$ (ResolveResult -> Map PackageName [ResolveResult])
-> [ResolveResult] -> [Map PackageName [ResolveResult]]
forall a b. (a -> b) -> [a] -> [b]
map (\ResolveResult
rr -> PackageName -> [ResolveResult] -> Map PackageName [ResolveResult]
forall k a. k -> a -> Map k a
Map.singleton (ResolveResult -> PackageName
rrName ResolveResult
rr) [ResolveResult
rr]) [ResolveResult]
results
        ([Text]
errs, [Map PackageName Target]
ms) = [Either Text (Map PackageName Target)]
-> ([Text], [Map PackageName Target])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either Text (Map PackageName Target)]
 -> ([Text], [Map PackageName Target]))
-> [Either Text (Map PackageName Target)]
-> ([Text], [Map PackageName Target])
forall a b. (a -> b) -> a -> b
$ (((PackageName, [ResolveResult])
  -> Either Text (Map PackageName Target))
 -> [(PackageName, [ResolveResult])]
 -> [Either Text (Map PackageName Target)])
-> [(PackageName, [ResolveResult])]
-> ((PackageName, [ResolveResult])
    -> Either Text (Map PackageName Target))
-> [Either Text (Map PackageName Target)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((PackageName, [ResolveResult])
 -> Either Text (Map PackageName Target))
-> [(PackageName, [ResolveResult])]
-> [Either Text (Map PackageName Target)]
forall a b. (a -> b) -> [a] -> [b]
map (Map PackageName [ResolveResult] -> [(PackageName, [ResolveResult])]
forall k a. Map k a -> [(k, a)]
Map.toList Map PackageName [ResolveResult]
m0) (((PackageName, [ResolveResult])
  -> Either Text (Map PackageName Target))
 -> [Either Text (Map PackageName Target)])
-> ((PackageName, [ResolveResult])
    -> Either Text (Map PackageName Target))
-> [Either Text (Map PackageName Target)]
forall a b. (a -> b) -> a -> b
$ \(PackageName
name, [ResolveResult]
rrs) ->
            let mcomps :: [Maybe NamedComponent]
mcomps = (ResolveResult -> Maybe NamedComponent)
-> [ResolveResult] -> [Maybe NamedComponent]
forall a b. (a -> b) -> [a] -> [b]
map ResolveResult -> Maybe NamedComponent
rrComponent [ResolveResult]
rrs in
            -- Confirm that there is either exactly 1 with no component, or
            -- that all rrs are components
            case [ResolveResult]
rrs of
                [] -> Bool
-> Either Text (Map PackageName Target)
-> Either Text (Map PackageName Target)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False (Either Text (Map PackageName Target)
 -> Either Text (Map PackageName Target))
-> Either Text (Map PackageName Target)
-> Either Text (Map PackageName Target)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Map PackageName Target)
forall a b. a -> Either a b
Left Text
"Somehow got no rrComponent values, that can't happen"
                [ResolveResult
rr] | Maybe NamedComponent -> Bool
forall a. Maybe a -> Bool
isNothing (ResolveResult -> Maybe NamedComponent
rrComponent ResolveResult
rr) -> Map PackageName Target -> Either Text (Map PackageName Target)
forall a b. b -> Either a b
Right (Map PackageName Target -> Either Text (Map PackageName Target))
-> Map PackageName Target -> Either Text (Map PackageName Target)
forall a b. (a -> b) -> a -> b
$ PackageName -> Target -> Map PackageName Target
forall k a. k -> a -> Map k a
Map.singleton PackageName
name (Target -> Map PackageName Target)
-> Target -> Map PackageName Target
forall a b. (a -> b) -> a -> b
$ PackageType -> Target
TargetAll (PackageType -> Target) -> PackageType -> Target
forall a b. (a -> b) -> a -> b
$ ResolveResult -> PackageType
rrPackageType ResolveResult
rr
                [ResolveResult]
_
                  | (Maybe NamedComponent -> Bool) -> [Maybe NamedComponent] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe NamedComponent -> Bool
forall a. Maybe a -> Bool
isJust [Maybe NamedComponent]
mcomps -> Map PackageName Target -> Either Text (Map PackageName Target)
forall a b. b -> Either a b
Right (Map PackageName Target -> Either Text (Map PackageName Target))
-> Map PackageName Target -> Either Text (Map PackageName Target)
forall a b. (a -> b) -> a -> b
$ PackageName -> Target -> Map PackageName Target
forall k a. k -> a -> Map k a
Map.singleton PackageName
name (Target -> Map PackageName Target)
-> Target -> Map PackageName Target
forall a b. (a -> b) -> a -> b
$ Set NamedComponent -> Target
TargetComps (Set NamedComponent -> Target) -> Set NamedComponent -> Target
forall a b. (a -> b) -> a -> b
$ [NamedComponent] -> Set NamedComponent
forall a. Ord a => [a] -> Set a
Set.fromList ([NamedComponent] -> Set NamedComponent)
-> [NamedComponent] -> Set NamedComponent
forall a b. (a -> b) -> a -> b
$ [Maybe NamedComponent] -> [NamedComponent]
forall a. [Maybe a] -> [a]
catMaybes [Maybe NamedComponent]
mcomps
                  | Bool
otherwise -> Text -> Either Text (Map PackageName Target)
forall a b. a -> Either a b
Left (Text -> Either Text (Map PackageName Target))
-> Text -> Either Text (Map PackageName Target)
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
                      [ Text
"The package "
                      , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PackageName -> String
packageNameString PackageName
name
                      , Text
" was specified in multiple, incompatible ways: "
                      , [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (ResolveResult -> Text) -> [ResolveResult] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (RawInput -> Text
unRawInput (RawInput -> Text)
-> (ResolveResult -> RawInput) -> ResolveResult -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolveResult -> RawInput
rrRaw) [ResolveResult]
rrs
                      ]

    ([Text], Map PackageName Target,
 Map PackageName PackageLocationImmutable)
-> RIO
     env
     ([Text], Map PackageName Target,
      Map PackageName PackageLocationImmutable)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text]
errs, [Map PackageName Target] -> Map PackageName Target
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [Map PackageName Target]
ms, Map PackageName PackageLocationImmutable
addedDeps)

---------------------------------------------------------------------------------
-- OK, let's do it!
---------------------------------------------------------------------------------

parseTargets :: HasBuildConfig env
    => NeedTargets
    -> Bool
    -> BuildOptsCLI
    -> SMActual GlobalPackage
    -> RIO env SMTargets
parseTargets :: NeedTargets
-> Bool
-> BuildOptsCLI
-> SMActual GlobalPackage
-> RIO env SMTargets
parseTargets NeedTargets
needTargets Bool
haddockDeps BuildOptsCLI
boptscli SMActual GlobalPackage
smActual = do
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Parsing the targets"
  BuildConfig
bconfig <- Getting BuildConfig env BuildConfig -> RIO env BuildConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildConfig env BuildConfig
forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigL
  Path Abs Dir
workingDir <- RIO env (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
  Map PackageName ProjectPackage
locals <- Getting
  (Map PackageName ProjectPackage)
  env
  (Map PackageName ProjectPackage)
-> RIO env (Map PackageName ProjectPackage)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting
   (Map PackageName ProjectPackage)
   env
   (Map PackageName ProjectPackage)
 -> RIO env (Map PackageName ProjectPackage))
-> Getting
     (Map PackageName ProjectPackage)
     env
     (Map PackageName ProjectPackage)
-> RIO env (Map PackageName ProjectPackage)
forall a b. (a -> b) -> a -> b
$ (BuildConfig -> Const (Map PackageName ProjectPackage) BuildConfig)
-> env -> Const (Map PackageName ProjectPackage) env
forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigL((BuildConfig
  -> Const (Map PackageName ProjectPackage) BuildConfig)
 -> env -> Const (Map PackageName ProjectPackage) env)
-> ((Map PackageName ProjectPackage
     -> Const
          (Map PackageName ProjectPackage) (Map PackageName ProjectPackage))
    -> BuildConfig
    -> Const (Map PackageName ProjectPackage) BuildConfig)
-> Getting
     (Map PackageName ProjectPackage)
     env
     (Map PackageName ProjectPackage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BuildConfig -> Map PackageName ProjectPackage)
-> SimpleGetter BuildConfig (Map PackageName ProjectPackage)
forall s a. (s -> a) -> SimpleGetter s a
to (SMWanted -> Map PackageName ProjectPackage
smwProject (SMWanted -> Map PackageName ProjectPackage)
-> (BuildConfig -> SMWanted)
-> BuildConfig
-> Map PackageName ProjectPackage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> SMWanted
bcSMWanted)
  let ([Text]
textTargets', [RawInput]
rawInput) = BuildOptsCLI
-> Map PackageName ProjectPackage -> ([Text], [RawInput])
getRawInput BuildOptsCLI
boptscli Map PackageName ProjectPackage
locals

  ([Text]
errs1, [[(RawInput, RawTarget)]] -> [(RawInput, RawTarget)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat -> [(RawInput, RawTarget)]
rawTargets) <- ([Either Text [(RawInput, RawTarget)]]
 -> ([Text], [[(RawInput, RawTarget)]]))
-> RIO env [Either Text [(RawInput, RawTarget)]]
-> RIO env ([Text], [[(RawInput, RawTarget)]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either Text [(RawInput, RawTarget)]]
-> ([Text], [[(RawInput, RawTarget)]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (RIO env [Either Text [(RawInput, RawTarget)]]
 -> RIO env ([Text], [[(RawInput, RawTarget)]]))
-> RIO env [Either Text [(RawInput, RawTarget)]]
-> RIO env ([Text], [[(RawInput, RawTarget)]])
forall a b. (a -> b) -> a -> b
$ [RawInput]
-> (RawInput -> RIO env (Either Text [(RawInput, RawTarget)]))
-> RIO env [Either Text [(RawInput, RawTarget)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [RawInput]
rawInput ((RawInput -> RIO env (Either Text [(RawInput, RawTarget)]))
 -> RIO env [Either Text [(RawInput, RawTarget)]])
-> (RawInput -> RIO env (Either Text [(RawInput, RawTarget)]))
-> RIO env [Either Text [(RawInput, RawTarget)]]
forall a b. (a -> b) -> a -> b
$
    Path Abs Dir
-> Map PackageName ProjectPackage
-> RawInput
-> RIO env (Either Text [(RawInput, RawTarget)])
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir
-> Map PackageName ProjectPackage
-> RawInput
-> m (Either Text [(RawInput, RawTarget)])
parseRawTargetDirs Path Abs Dir
workingDir Map PackageName ProjectPackage
locals

  let depLocs :: Map PackageName PackageLocation
depLocs = (DepPackage -> PackageLocation)
-> Map PackageName DepPackage -> Map PackageName PackageLocation
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map DepPackage -> PackageLocation
dpLocation (Map PackageName DepPackage -> Map PackageName PackageLocation)
-> Map PackageName DepPackage -> Map PackageName PackageLocation
forall a b. (a -> b) -> a -> b
$ SMActual GlobalPackage -> Map PackageName DepPackage
forall global. SMActual global -> Map PackageName DepPackage
smaDeps SMActual GlobalPackage
smActual

  ([Text]
errs2, [ResolveResult]
resolveResults) <- ([Either Text ResolveResult] -> ([Text], [ResolveResult]))
-> RIO env [Either Text ResolveResult]
-> RIO env ([Text], [ResolveResult])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either Text ResolveResult] -> ([Text], [ResolveResult])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (RIO env [Either Text ResolveResult]
 -> RIO env ([Text], [ResolveResult]))
-> RIO env [Either Text ResolveResult]
-> RIO env ([Text], [ResolveResult])
forall a b. (a -> b) -> a -> b
$ [(RawInput, RawTarget)]
-> ((RawInput, RawTarget) -> RIO env (Either Text ResolveResult))
-> RIO env [Either Text ResolveResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(RawInput, RawTarget)]
rawTargets (((RawInput, RawTarget) -> RIO env (Either Text ResolveResult))
 -> RIO env [Either Text ResolveResult])
-> ((RawInput, RawTarget) -> RIO env (Either Text ResolveResult))
-> RIO env [Either Text ResolveResult]
forall a b. (a -> b) -> a -> b
$
    SMActual GlobalPackage
-> Map PackageName PackageLocation
-> (RawInput, RawTarget)
-> RIO env (Either Text ResolveResult)
forall env.
(HasLogFunc env, HasPantryConfig env, HasProcessContext env) =>
SMActual GlobalPackage
-> Map PackageName PackageLocation
-> (RawInput, RawTarget)
-> RIO env (Either Text ResolveResult)
resolveRawTarget SMActual GlobalPackage
smActual Map PackageName PackageLocation
depLocs

  ([Text]
errs3, Map PackageName Target
targets, Map PackageName PackageLocationImmutable
addedDeps) <- [ResolveResult]
-> RIO
     env
     ([Text], Map PackageName Target,
      Map PackageName PackageLocationImmutable)
forall env.
HasLogFunc env =>
[ResolveResult]
-> RIO
     env
     ([Text], Map PackageName Target,
      Map PackageName PackageLocationImmutable)
combineResolveResults [ResolveResult]
resolveResults

  case [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text]
errs1, [Text]
errs2, [Text]
errs3] of
    [] -> () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [Text]
errs -> StackBuildException -> RIO env ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (StackBuildException -> RIO env ())
-> StackBuildException -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [Text] -> StackBuildException
TargetParseException [Text]
errs

  case (Map PackageName Target -> Bool
forall k a. Map k a -> Bool
Map.null Map PackageName Target
targets, NeedTargets
needTargets) of
    (Bool
False, NeedTargets
_) -> () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Bool
True, NeedTargets
AllowNoTargets) -> () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Bool
True, NeedTargets
NeedTargets)
      | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
textTargets' Bool -> Bool -> Bool
&& BuildConfig -> Bool
bcImplicitGlobal BuildConfig
bconfig -> StackBuildException -> RIO env ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (StackBuildException -> RIO env ())
-> StackBuildException -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [Text] -> StackBuildException
TargetParseException
          [Text
"The specified targets matched no packages.\nPerhaps you need to run 'stack init'?"]
      | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
textTargets' Bool -> Bool -> Bool
&& Map PackageName ProjectPackage -> Bool
forall k a. Map k a -> Bool
Map.null Map PackageName ProjectPackage
locals -> StackBuildException -> RIO env ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (StackBuildException -> RIO env ())
-> StackBuildException -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [Text] -> StackBuildException
TargetParseException
          [Text
"The project contains no local packages (packages not marked with 'extra-dep')"]
      | Bool
otherwise -> StackBuildException -> RIO env ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (StackBuildException -> RIO env ())
-> StackBuildException -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [Text] -> StackBuildException
TargetParseException
          [Text
"The specified targets matched no packages"]

  Map PackageName DepPackage
addedDeps' <- (PackageLocationImmutable -> RIO env DepPackage)
-> Map PackageName PackageLocationImmutable
-> RIO env (Map PackageName DepPackage)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> PackageLocation -> RIO env DepPackage
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
Bool -> PackageLocation -> RIO env DepPackage
additionalDepPackage Bool
haddockDeps (PackageLocation -> RIO env DepPackage)
-> (PackageLocationImmutable -> PackageLocation)
-> PackageLocationImmutable
-> RIO env DepPackage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageLocationImmutable -> PackageLocation
PLImmutable) Map PackageName PackageLocationImmutable
addedDeps

  SMTargets -> RIO env SMTargets
forall (m :: * -> *) a. Monad m => a -> m a
return SMTargets :: Map PackageName Target -> Map PackageName DepPackage -> SMTargets
SMTargets
    { smtTargets :: Map PackageName Target
smtTargets = Map PackageName Target
targets
    , smtDeps :: Map PackageName DepPackage
smtDeps = Map PackageName DepPackage
addedDeps'
    }
  where
    bcImplicitGlobal :: BuildConfig -> Bool
bcImplicitGlobal BuildConfig
bconfig =
      case Config -> ProjectConfig (Project, Path Abs File)
configProject (Config -> ProjectConfig (Project, Path Abs File))
-> Config -> ProjectConfig (Project, Path Abs File)
forall a b. (a -> b) -> a -> b
$ BuildConfig -> Config
bcConfig BuildConfig
bconfig of
        PCProject (Project, Path Abs File)
_ -> Bool
False
        ProjectConfig (Project, Path Abs File)
PCGlobalProject -> Bool
True
        PCNoProject [PackageIdentifierRevision]
_ -> Bool
False