{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

-- | cabal-install CLI command: repl
--
module Distribution.Client.CmdRepl (
    -- * The @repl@ CLI and action
    replCommand,
    replAction,

    -- * Internals exposed for testing
    matchesMultipleProblem,
    selectPackageTargets,
    selectComponentTarget
  ) where

import Prelude ()
import Distribution.Client.Compat.Prelude

import Distribution.Compat.Lens
import qualified Distribution.Types.Lens as L

import Distribution.Client.DistDirLayout
         ( DistDirLayout(..) )
import Distribution.Client.NixStyleOptions
         ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )
import Distribution.Client.CmdErrorMessages
         ( renderTargetSelector, showTargetSelector,
           renderTargetProblem,
           targetSelectorRefersToPkgs,
           renderComponentKind, renderListCommaAnd, renderListSemiAnd,
           componentKind, sortGroupOn, Plural(..) )
import Distribution.Client.TargetProblem
         ( TargetProblem(..) )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.ProjectBuilding
         ( rebuildTargetsDryRun, improveInstallPlanWithUpToDatePackages )
import Distribution.Client.ProjectOrchestration
import Distribution.Client.ProjectPlanning
       ( ElaboratedSharedConfig(..), ElaboratedInstallPlan )
import Distribution.Client.ProjectPlanning.Types
       ( elabOrderExeDependencies )
import Distribution.Client.ScriptUtils
         ( AcceptNoTargets(..), withContextAndSelectors, TargetContext(..)
         , updateContextAndWriteProjectFile, updateContextAndWriteProjectFile'
         , fakeProjectSourcePackage, lSrcpkgDescription )
import Distribution.Client.Setup
         ( GlobalFlags, ConfigFlags(..) )
import qualified Distribution.Client.Setup as Client
import Distribution.Client.Types
         ( PackageSpecifier(..), UnresolvedSourcePackage )
import Distribution.Simple.Setup
         ( fromFlagOrDefault, ReplOptions(..), replOptions
         , Flag(..), toFlag, falseArg )
import Distribution.Simple.Command
         ( CommandUI(..), liftOptionL, usageAlternatives, option
         , ShowOrParseArgs, OptionField, reqArg )
import Distribution.Compiler
         ( CompilerFlavor(GHC) )
import Distribution.Simple.Compiler
         ( Compiler, compilerCompatVersion )
import Distribution.Package
         ( Package(..), packageName, UnitId, installedUnitId )
import Distribution.Parsec
         ( parsecCommaList )
import Distribution.ReadE
         ( ReadE, parsecToReadE )
import Distribution.Solver.Types.SourcePackage
         ( SourcePackage(..) )
import Distribution.Types.BuildInfo
         ( BuildInfo(..), emptyBuildInfo )
import Distribution.Types.ComponentName
         ( componentNameString )
import Distribution.Types.CondTree
         ( CondTree(..), traverseCondTreeC )
import Distribution.Types.Dependency
         ( Dependency(..), mainLibSet )
import Distribution.Types.Library
         ( Library(..), emptyLibrary )
import Distribution.Types.Version
         ( Version, mkVersion )
import Distribution.Types.VersionRange
         ( anyVersion )
import Distribution.Utils.Generic
         ( safeHead )
import Distribution.Verbosity
         ( normal, lessVerbose )
import Distribution.Simple.Utils
         ( wrapText, die', debugNoWrap )
import Language.Haskell.Extension
         ( Language(..) )

import Data.List
         ( (\\) )
import qualified Data.Map as Map
import qualified Data.Set as Set
import System.Directory
         ( doesFileExist, getCurrentDirectory )
import System.FilePath
         ( (</>) )

data EnvFlags = EnvFlags
  { EnvFlags -> [Dependency]
envPackages :: [Dependency]
  , EnvFlags -> Flag Bool
envIncludeTransitive :: Flag Bool
  }

defaultEnvFlags :: EnvFlags
defaultEnvFlags :: EnvFlags
defaultEnvFlags = EnvFlags
  { envPackages :: [Dependency]
envPackages = []
  , envIncludeTransitive :: Flag Bool
envIncludeTransitive = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True
  }

envOptions :: ShowOrParseArgs -> [OptionField EnvFlags]
envOptions :: ShowOrParseArgs -> [OptionField EnvFlags]
envOptions ShowOrParseArgs
_ =
  [ [Char]
-> LFlags
-> [Char]
-> (EnvFlags -> [Dependency])
-> ([Dependency] -> EnvFlags -> EnvFlags)
-> MkOptDescr
     (EnvFlags -> [Dependency])
     ([Dependency] -> EnvFlags -> EnvFlags)
     EnvFlags
-> OptionField EnvFlags
forall get set a.
[Char]
-> LFlags
-> [Char]
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [Char
'b'] [[Char]
"build-depends"]
    [Char]
"Include additional packages in the environment presented to GHCi."
    EnvFlags -> [Dependency]
envPackages (\[Dependency]
p EnvFlags
flags -> EnvFlags
flags { envPackages :: [Dependency]
envPackages = [Dependency]
p [Dependency] -> [Dependency] -> [Dependency]
forall a. [a] -> [a] -> [a]
++ EnvFlags -> [Dependency]
envPackages EnvFlags
flags })
    ([Char]
-> ReadE [Dependency]
-> ([Dependency] -> LFlags)
-> MkOptDescr
     (EnvFlags -> [Dependency])
     ([Dependency] -> EnvFlags -> EnvFlags)
     EnvFlags
forall b a.
Monoid b =>
[Char]
-> ReadE b -> (b -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
reqArg [Char]
"DEPENDENCIES" ReadE [Dependency]
dependenciesReadE ((Dependency -> [Char]) -> [Dependency] -> LFlags
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dependency -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow :: [Dependency] -> [String]))
  , [Char]
-> LFlags
-> [Char]
-> (EnvFlags -> Flag Bool)
-> (Flag Bool -> EnvFlags -> EnvFlags)
-> MkOptDescr
     (EnvFlags -> Flag Bool)
     (Flag Bool -> EnvFlags -> EnvFlags)
     EnvFlags
-> OptionField EnvFlags
forall get set a.
[Char]
-> LFlags
-> [Char]
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [] [[Char]
"no-transitive-deps"]
    [Char]
"Don't automatically include transitive dependencies of requested packages."
    EnvFlags -> Flag Bool
envIncludeTransitive (\Flag Bool
p EnvFlags
flags -> EnvFlags
flags { envIncludeTransitive :: Flag Bool
envIncludeTransitive = Flag Bool
p })
    MkOptDescr
  (EnvFlags -> Flag Bool)
  (Flag Bool -> EnvFlags -> EnvFlags)
  EnvFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
falseArg
  ]
  where
    dependenciesReadE :: ReadE [Dependency]
    dependenciesReadE :: ReadE [Dependency]
dependenciesReadE =
      ([Char] -> [Char])
-> ParsecParser [Dependency] -> ReadE [Dependency]
forall a. ([Char] -> [Char]) -> ParsecParser a -> ReadE a
parsecToReadE
        ([Char]
"couldn't parse dependencies: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
        (ParsecParser Dependency -> ParsecParser [Dependency]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecCommaList ParsecParser Dependency
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m Dependency
parsec)

replCommand :: CommandUI (NixStyleFlags (ReplOptions, EnvFlags))
replCommand :: CommandUI (NixStyleFlags (ReplOptions, EnvFlags))
replCommand = CommandUI
  (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags,
   BenchmarkFlags)
Client.installCommand {
  commandName :: [Char]
commandName         = [Char]
"v2-repl",
  commandSynopsis :: [Char]
commandSynopsis     = [Char]
"Open an interactive session for the given component.",
  commandUsage :: [Char] -> [Char]
commandUsage        = [Char] -> LFlags -> [Char] -> [Char]
usageAlternatives [Char]
"v2-repl" [ [Char]
"[TARGET] [FLAGS]" ],
  commandDescription :: Maybe ([Char] -> [Char])
commandDescription  = ([Char] -> [Char]) -> Maybe ([Char] -> [Char])
forall a. a -> Maybe a
Just (([Char] -> [Char]) -> Maybe ([Char] -> [Char]))
-> ([Char] -> [Char]) -> Maybe ([Char] -> [Char])
forall a b. (a -> b) -> a -> b
$ \[Char]
_ -> [Char] -> [Char]
wrapText ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
        [Char]
"Open an interactive session for a component within the project. The "
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"available targets are the same as for the 'v2-build' command: "
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"individual components within packages in the project, including "
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"libraries, executables, test-suites or benchmarks. Packages can "
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"also be specified in which case the library component in the "
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"package will be used, or the (first listed) executable in the "
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"package if there is no library.\n\n"

     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Dependencies are built or rebuilt as necessary. Additional "
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"configuration flags can be specified on the command line and these "
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"extend the project configuration from the 'cabal.project', "
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'cabal.project.local' and other files.",
  commandNotes :: Maybe ([Char] -> [Char])
commandNotes        = ([Char] -> [Char]) -> Maybe ([Char] -> [Char])
forall a. a -> Maybe a
Just (([Char] -> [Char]) -> Maybe ([Char] -> [Char]))
-> ([Char] -> [Char]) -> Maybe ([Char] -> [Char])
forall a b. (a -> b) -> a -> b
$ \[Char]
pname ->
        [Char]
"Examples, open an interactive session:\n"
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" v2-repl\n"
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"    for the default component in the package in the current directory\n"
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" v2-repl pkgname\n"
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"    for the default component in the package named 'pkgname'\n"
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" v2-repl ./pkgfoo\n"
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"    for the default component in the package in the ./pkgfoo directory\n"
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" v2-repl cname\n"
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"    for the component named 'cname'\n"
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" v2-repl pkgname:cname\n"
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"    for the component 'cname' in the package 'pkgname'\n\n"
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" v2-repl --build-depends lens\n"
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"    add the latest version of the library 'lens' to the default component "
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(or no componentif there is no project present)\n"
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" v2-repl --build-depends \"lens >= 4.15 && < 4.18\"\n"
     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"    add a version (constrained between 4.15 and 4.18) of the library 'lens' "
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"to the default component (or no component if there is no project present)\n",

  commandDefaultFlags :: NixStyleFlags (ReplOptions, EnvFlags)
commandDefaultFlags = (ReplOptions, EnvFlags) -> NixStyleFlags (ReplOptions, EnvFlags)
forall a. a -> NixStyleFlags a
defaultNixStyleFlags (ReplOptions
forall a. Monoid a => a
mempty, EnvFlags
defaultEnvFlags),
  commandOptions :: ShowOrParseArgs
-> [OptionField (NixStyleFlags (ReplOptions, EnvFlags))]
commandOptions = (ShowOrParseArgs -> [OptionField (ReplOptions, EnvFlags)])
-> ShowOrParseArgs
-> [OptionField (NixStyleFlags (ReplOptions, EnvFlags))]
forall a.
(ShowOrParseArgs -> [OptionField a])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags a)]
nixStyleOptions ((ShowOrParseArgs -> [OptionField (ReplOptions, EnvFlags)])
 -> ShowOrParseArgs
 -> [OptionField (NixStyleFlags (ReplOptions, EnvFlags))])
-> (ShowOrParseArgs -> [OptionField (ReplOptions, EnvFlags)])
-> ShowOrParseArgs
-> [OptionField (NixStyleFlags (ReplOptions, EnvFlags))]
forall a b. (a -> b) -> a -> b
$ \ShowOrParseArgs
showOrParseArgs ->
    (OptionField ReplOptions -> OptionField (ReplOptions, EnvFlags))
-> [OptionField ReplOptions]
-> [OptionField (ReplOptions, EnvFlags)]
forall a b. (a -> b) -> [a] -> [b]
map (ALens' (ReplOptions, EnvFlags) ReplOptions
-> OptionField ReplOptions -> OptionField (ReplOptions, EnvFlags)
forall b a. ALens' b a -> OptionField a -> OptionField b
liftOptionL ALens' (ReplOptions, EnvFlags) ReplOptions
forall a c b (f :: * -> *).
Functor f =>
LensLike f (a, c) (b, c) a b
_1) (ShowOrParseArgs -> [OptionField ReplOptions]
replOptions ShowOrParseArgs
showOrParseArgs) [OptionField (ReplOptions, EnvFlags)]
-> [OptionField (ReplOptions, EnvFlags)]
-> [OptionField (ReplOptions, EnvFlags)]
forall a. [a] -> [a] -> [a]
++
    (OptionField EnvFlags -> OptionField (ReplOptions, EnvFlags))
-> [OptionField EnvFlags] -> [OptionField (ReplOptions, EnvFlags)]
forall a b. (a -> b) -> [a] -> [b]
map (ALens' (ReplOptions, EnvFlags) EnvFlags
-> OptionField EnvFlags -> OptionField (ReplOptions, EnvFlags)
forall b a. ALens' b a -> OptionField a -> OptionField b
liftOptionL ALens' (ReplOptions, EnvFlags) EnvFlags
forall c a b (f :: * -> *).
Functor f =>
LensLike f (c, a) (c, b) a b
_2) (ShowOrParseArgs -> [OptionField EnvFlags]
envOptions ShowOrParseArgs
showOrParseArgs)
  }

-- | The @repl@ command is very much like @build@. It brings the install plan
-- up to date, selects that part of the plan needed by the given or implicit
-- repl target and then executes the plan.
--
-- Compared to @build@ the difference is that only one target is allowed
-- (given or implicit) and the target type is repl rather than build. The
-- general plan execution infrastructure handles both build and repl targets.
--
-- For more details on how this works, see the module
-- "Distribution.Client.ProjectOrchestration"
--
replAction :: NixStyleFlags (ReplOptions, EnvFlags) -> [String] -> GlobalFlags -> IO ()
replAction :: NixStyleFlags (ReplOptions, EnvFlags)
-> LFlags -> GlobalFlags -> IO ()
replAction flags :: NixStyleFlags (ReplOptions, EnvFlags)
flags@NixStyleFlags { extraFlags :: forall a. NixStyleFlags a -> a
extraFlags = (ReplOptions
replOpts, EnvFlags
envFlags), HaddockFlags
BenchmarkFlags
ConfigFlags
TestFlags
ProjectFlags
InstallFlags
ConfigExFlags
configFlags :: ConfigFlags
configExFlags :: ConfigExFlags
installFlags :: InstallFlags
haddockFlags :: HaddockFlags
testFlags :: TestFlags
benchmarkFlags :: BenchmarkFlags
projectFlags :: ProjectFlags
configFlags :: forall a. NixStyleFlags a -> ConfigFlags
configExFlags :: forall a. NixStyleFlags a -> ConfigExFlags
installFlags :: forall a. NixStyleFlags a -> InstallFlags
haddockFlags :: forall a. NixStyleFlags a -> HaddockFlags
testFlags :: forall a. NixStyleFlags a -> TestFlags
benchmarkFlags :: forall a. NixStyleFlags a -> BenchmarkFlags
projectFlags :: forall a. NixStyleFlags a -> ProjectFlags
..} LFlags
targetStrings GlobalFlags
globalFlags
  = AcceptNoTargets
-> Maybe ComponentKind
-> NixStyleFlags (ReplOptions, EnvFlags)
-> LFlags
-> GlobalFlags
-> (TargetContext
    -> ProjectBaseContext -> [TargetSelector] -> IO ())
-> IO ()
forall a b.
AcceptNoTargets
-> Maybe ComponentKind
-> NixStyleFlags a
-> LFlags
-> GlobalFlags
-> (TargetContext
    -> ProjectBaseContext -> [TargetSelector] -> IO b)
-> IO b
withContextAndSelectors AcceptNoTargets
AcceptNoTargets (ComponentKind -> Maybe ComponentKind
forall a. a -> Maybe a
Just ComponentKind
LibKind) NixStyleFlags (ReplOptions, EnvFlags)
flags LFlags
targetStrings GlobalFlags
globalFlags ((TargetContext -> ProjectBaseContext -> [TargetSelector] -> IO ())
 -> IO ())
-> (TargetContext
    -> ProjectBaseContext -> [TargetSelector] -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \TargetContext
targetCtx ProjectBaseContext
ctx [TargetSelector]
targetSelectors -> do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BuildTimeSettings -> Bool
buildSettingOnlyDeps (ProjectBaseContext -> BuildTimeSettings
buildSettings ProjectBaseContext
ctx)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Verbosity -> [Char] -> IO ()
forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"The repl command does not support '--only-dependencies'. "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"You may wish to use 'build --only-dependencies' and then "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"use 'repl'."

    let projectRoot :: [Char]
projectRoot = DistDirLayout -> [Char]
distProjectRootDirectory (DistDirLayout -> [Char]) -> DistDirLayout -> [Char]
forall a b. (a -> b) -> a -> b
$ ProjectBaseContext -> DistDirLayout
distDirLayout ProjectBaseContext
ctx

    ProjectBaseContext
baseCtx <- case TargetContext
targetCtx of
      TargetContext
ProjectContext -> ProjectBaseContext -> IO ProjectBaseContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectBaseContext
ctx
      TargetContext
GlobalContext  -> do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LFlags -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null LFlags
targetStrings) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          Verbosity -> [Char] -> IO ()
forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"'repl' takes no arguments or a script argument outside a project: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LFlags -> [Char]
unwords LFlags
targetStrings

        let
          sourcePackage :: SourcePackage (PackageLocation loc)
sourcePackage = [Char] -> SourcePackage (PackageLocation loc)
forall loc. [Char] -> SourcePackage (PackageLocation loc)
fakeProjectSourcePackage [Char]
projectRoot
            SourcePackage (PackageLocation loc)
-> (SourcePackage (PackageLocation loc)
    -> SourcePackage (PackageLocation loc))
-> SourcePackage (PackageLocation loc)
forall a b. a -> (a -> b) -> b
& LensLike
  Identity
  (SourcePackage (PackageLocation loc))
  (SourcePackage (PackageLocation loc))
  GenericPackageDescription
  GenericPackageDescription
forall loc (f :: * -> *).
Functor f =>
LensLike
  f
  (SourcePackage loc)
  (SourcePackage loc)
  GenericPackageDescription
  GenericPackageDescription
lSrcpkgDescription LensLike
  Identity
  (SourcePackage (PackageLocation loc))
  (SourcePackage (PackageLocation loc))
  GenericPackageDescription
  GenericPackageDescription
-> ((Maybe (CondTree ConfVar [Dependency] Library)
     -> Identity (Maybe (CondTree ConfVar [Dependency] Library)))
    -> GenericPackageDescription -> Identity GenericPackageDescription)
-> (Maybe (CondTree ConfVar [Dependency] Library)
    -> Identity (Maybe (CondTree ConfVar [Dependency] Library)))
-> SourcePackage (PackageLocation loc)
-> Identity (SourcePackage (PackageLocation loc))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (CondTree ConfVar [Dependency] Library)
 -> Identity (Maybe (CondTree ConfVar [Dependency] Library)))
-> GenericPackageDescription -> Identity GenericPackageDescription
Lens'
  GenericPackageDescription
  (Maybe (CondTree ConfVar [Dependency] Library))
L.condLibrary
            ((Maybe (CondTree ConfVar [Dependency] Library)
  -> Identity (Maybe (CondTree ConfVar [Dependency] Library)))
 -> SourcePackage (PackageLocation loc)
 -> Identity (SourcePackage (PackageLocation loc)))
-> Maybe (CondTree ConfVar [Dependency] Library)
-> SourcePackage (PackageLocation loc)
-> SourcePackage (PackageLocation loc)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CondTree ConfVar [Dependency] Library
-> Maybe (CondTree ConfVar [Dependency] Library)
forall a. a -> Maybe a
Just (Library
-> [Dependency]
-> [CondBranch ConfVar [Dependency] Library]
-> CondTree ConfVar [Dependency] Library
forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode Library
library [Dependency
baseDep] [])
          library :: Library
library = Library
emptyLibrary { libBuildInfo :: BuildInfo
libBuildInfo = BuildInfo
lBuildInfo }
          lBuildInfo :: BuildInfo
lBuildInfo = BuildInfo
emptyBuildInfo
            { targetBuildDepends :: [Dependency]
targetBuildDepends = [Dependency
baseDep]
            , defaultLanguage :: Maybe Language
defaultLanguage = Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Haskell2010
            }
          baseDep :: Dependency
baseDep = PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
"base" VersionRange
anyVersion NonEmptySet LibraryName
mainLibSet

        ProjectBaseContext
-> UnresolvedSourcePackage -> IO ProjectBaseContext
updateContextAndWriteProjectFile' ProjectBaseContext
ctx UnresolvedSourcePackage
forall {loc}. SourcePackage (PackageLocation loc)
sourcePackage
      ScriptContext [Char]
scriptPath Executable
scriptExecutable -> do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LFlags -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length LFlags
targetStrings Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          Verbosity -> [Char] -> IO ()
forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"'repl' takes a single argument which should be a script: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LFlags -> [Char]
unwords LFlags
targetStrings
        Bool
existsScriptPath <- [Char] -> IO Bool
doesFileExist [Char]
scriptPath
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
existsScriptPath (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          Verbosity -> [Char] -> IO ()
forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"'repl' takes a single argument which should be a script: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LFlags -> [Char]
unwords LFlags
targetStrings

        ProjectBaseContext -> [Char] -> Executable -> IO ProjectBaseContext
updateContextAndWriteProjectFile ProjectBaseContext
ctx [Char]
scriptPath Executable
scriptExecutable

    (Maybe OriginalComponentInfo
originalComponent, ProjectBaseContext
baseCtx') <- if [Dependency] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (EnvFlags -> [Dependency]
envPackages EnvFlags
envFlags)
      then (Maybe OriginalComponentInfo, ProjectBaseContext)
-> IO (Maybe OriginalComponentInfo, ProjectBaseContext)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe OriginalComponentInfo
forall a. Maybe a
Nothing, ProjectBaseContext
baseCtx)
      else
        -- Unfortunately, the best way to do this is to let the normal solver
        -- help us resolve the targets, but that isn't ideal for performance,
        -- especially in the no-project case.
        Verbosity
-> ProjectBaseContext
-> (ElaboratedInstallPlan
    -> ElaboratedSharedConfig
    -> IO (Maybe OriginalComponentInfo, ProjectBaseContext))
-> IO (Maybe OriginalComponentInfo, ProjectBaseContext)
forall a.
Verbosity
-> ProjectBaseContext
-> (ElaboratedInstallPlan -> ElaboratedSharedConfig -> IO a)
-> IO a
withInstallPlan (Verbosity -> Verbosity
lessVerbose Verbosity
verbosity) ProjectBaseContext
baseCtx ((ElaboratedInstallPlan
  -> ElaboratedSharedConfig
  -> IO (Maybe OriginalComponentInfo, ProjectBaseContext))
 -> IO (Maybe OriginalComponentInfo, ProjectBaseContext))
-> (ElaboratedInstallPlan
    -> ElaboratedSharedConfig
    -> IO (Maybe OriginalComponentInfo, ProjectBaseContext))
-> IO (Maybe OriginalComponentInfo, ProjectBaseContext)
forall a b. (a -> b) -> a -> b
$ \ElaboratedInstallPlan
elaboratedPlan ElaboratedSharedConfig
_ -> do
          -- targets should be non-empty map, but there's no NonEmptyMap yet.
          TargetsMap
targets <- ElaboratedInstallPlan -> [TargetSelector] -> IO TargetsMap
validatedTargets ElaboratedInstallPlan
elaboratedPlan [TargetSelector]
targetSelectors

          let
            (UnitId
unitId, [(ComponentTarget, NonEmpty TargetSelector)]
_) = (UnitId, [(ComponentTarget, NonEmpty TargetSelector)])
-> Maybe (UnitId, [(ComponentTarget, NonEmpty TargetSelector)])
-> (UnitId, [(ComponentTarget, NonEmpty TargetSelector)])
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (UnitId, [(ComponentTarget, NonEmpty TargetSelector)])
forall a. HasCallStack => [Char] -> a
error [Char]
"panic: targets should be non-empty") (Maybe (UnitId, [(ComponentTarget, NonEmpty TargetSelector)])
 -> (UnitId, [(ComponentTarget, NonEmpty TargetSelector)]))
-> Maybe (UnitId, [(ComponentTarget, NonEmpty TargetSelector)])
-> (UnitId, [(ComponentTarget, NonEmpty TargetSelector)])
forall a b. (a -> b) -> a -> b
$ [(UnitId, [(ComponentTarget, NonEmpty TargetSelector)])]
-> Maybe (UnitId, [(ComponentTarget, NonEmpty TargetSelector)])
forall a. [a] -> Maybe a
safeHead ([(UnitId, [(ComponentTarget, NonEmpty TargetSelector)])]
 -> Maybe (UnitId, [(ComponentTarget, NonEmpty TargetSelector)]))
-> [(UnitId, [(ComponentTarget, NonEmpty TargetSelector)])]
-> Maybe (UnitId, [(ComponentTarget, NonEmpty TargetSelector)])
forall a b. (a -> b) -> a -> b
$ TargetsMap
-> [(UnitId, [(ComponentTarget, NonEmpty TargetSelector)])]
forall k a. Map k a -> [(k, a)]
Map.toList TargetsMap
targets
            originalDeps :: [UnitId]
originalDeps = GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
-> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId (GenericPlanPackage
   InstalledPackageInfo ElaboratedConfiguredPackage
 -> UnitId)
-> [GenericPlanPackage
      InstalledPackageInfo ElaboratedConfiguredPackage]
-> [UnitId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElaboratedInstallPlan
-> UnitId
-> [GenericPlanPackage
      InstalledPackageInfo ElaboratedConfiguredPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg
-> UnitId -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.directDeps ElaboratedInstallPlan
elaboratedPlan UnitId
unitId
            oci :: OriginalComponentInfo
oci = UnitId -> [UnitId] -> OriginalComponentInfo
OriginalComponentInfo UnitId
unitId [UnitId]
originalDeps
            pkgId :: PackageIdentifier
pkgId = PackageIdentifier -> Maybe PackageIdentifier -> PackageIdentifier
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> PackageIdentifier
forall a. HasCallStack => [Char] -> a
error ([Char] -> PackageIdentifier) -> [Char] -> PackageIdentifier
forall a b. (a -> b) -> a -> b
$ [Char]
"cannot find " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UnitId -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow UnitId
unitId) (Maybe PackageIdentifier -> PackageIdentifier)
-> Maybe PackageIdentifier -> PackageIdentifier
forall a b. (a -> b) -> a -> b
$ GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
-> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId (GenericPlanPackage
   InstalledPackageInfo ElaboratedConfiguredPackage
 -> PackageIdentifier)
-> Maybe
     (GenericPlanPackage
        InstalledPackageInfo ElaboratedConfiguredPackage)
-> Maybe PackageIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElaboratedInstallPlan
-> UnitId
-> Maybe
     (GenericPlanPackage
        InstalledPackageInfo ElaboratedConfiguredPackage)
forall ipkg srcpkg.
(IsUnit ipkg, IsUnit srcpkg) =>
GenericInstallPlan ipkg srcpkg
-> UnitId -> Maybe (GenericPlanPackage ipkg srcpkg)
InstallPlan.lookup ElaboratedInstallPlan
elaboratedPlan UnitId
unitId
            baseCtx' :: ProjectBaseContext
baseCtx' = [Dependency]
-> PackageIdentifier -> ProjectBaseContext -> ProjectBaseContext
addDepsToProjectTarget (EnvFlags -> [Dependency]
envPackages EnvFlags
envFlags) PackageIdentifier
pkgId ProjectBaseContext
baseCtx

          (Maybe OriginalComponentInfo, ProjectBaseContext)
-> IO (Maybe OriginalComponentInfo, ProjectBaseContext)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (OriginalComponentInfo -> Maybe OriginalComponentInfo
forall a. a -> Maybe a
Just OriginalComponentInfo
oci, ProjectBaseContext
baseCtx')

    -- Now, we run the solver again with the added packages. While the graph
    -- won't actually reflect the addition of transitive dependencies,
    -- they're going to be available already and will be offered to the REPL
    -- and that's good enough.
    --
    -- In addition, to avoid a *third* trip through the solver, we are
    -- replicating the second half of 'runProjectPreBuildPhase' by hand
    -- here.
    (ProjectBuildContext
buildCtx, Compiler
compiler, ReplOptions
replOpts') <- Verbosity
-> ProjectBaseContext
-> (ElaboratedInstallPlan
    -> ElaboratedSharedConfig
    -> IO (ProjectBuildContext, Compiler, ReplOptions))
-> IO (ProjectBuildContext, Compiler, ReplOptions)
forall a.
Verbosity
-> ProjectBaseContext
-> (ElaboratedInstallPlan -> ElaboratedSharedConfig -> IO a)
-> IO a
withInstallPlan Verbosity
verbosity ProjectBaseContext
baseCtx' ((ElaboratedInstallPlan
  -> ElaboratedSharedConfig
  -> IO (ProjectBuildContext, Compiler, ReplOptions))
 -> IO (ProjectBuildContext, Compiler, ReplOptions))
-> (ElaboratedInstallPlan
    -> ElaboratedSharedConfig
    -> IO (ProjectBuildContext, Compiler, ReplOptions))
-> IO (ProjectBuildContext, Compiler, ReplOptions)
forall a b. (a -> b) -> a -> b
$
      \ElaboratedInstallPlan
elaboratedPlan ElaboratedSharedConfig
elaboratedShared' -> do
        let ProjectBaseContext{[PackageSpecifier UnresolvedSourcePackage]
CabalDirLayout
DistDirLayout
BuildTimeSettings
ProjectConfig
CurrentCommand
buildSettings :: ProjectBaseContext -> BuildTimeSettings
distDirLayout :: ProjectBaseContext -> DistDirLayout
distDirLayout :: DistDirLayout
cabalDirLayout :: CabalDirLayout
projectConfig :: ProjectConfig
localPackages :: [PackageSpecifier UnresolvedSourcePackage]
buildSettings :: BuildTimeSettings
currentCommand :: CurrentCommand
cabalDirLayout :: ProjectBaseContext -> CabalDirLayout
projectConfig :: ProjectBaseContext -> ProjectConfig
localPackages :: ProjectBaseContext -> [PackageSpecifier UnresolvedSourcePackage]
currentCommand :: ProjectBaseContext -> CurrentCommand
..} = ProjectBaseContext
baseCtx'

        -- Recalculate with updated project.
        TargetsMap
targets <- ElaboratedInstallPlan -> [TargetSelector] -> IO TargetsMap
validatedTargets ElaboratedInstallPlan
elaboratedPlan [TargetSelector]
targetSelectors

        let
          elaboratedPlan' :: ElaboratedInstallPlan
elaboratedPlan' = TargetAction
-> TargetsMap -> ElaboratedInstallPlan -> ElaboratedInstallPlan
pruneInstallPlanToTargets
                              TargetAction
TargetActionRepl
                              TargetsMap
targets
                              ElaboratedInstallPlan
elaboratedPlan
          includeTransitive :: Bool
includeTransitive = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
True (EnvFlags -> Flag Bool
envIncludeTransitive EnvFlags
envFlags)

        BuildStatusMap
pkgsBuildStatus <- DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedInstallPlan
-> IO BuildStatusMap
rebuildTargetsDryRun DistDirLayout
distDirLayout ElaboratedSharedConfig
elaboratedShared'
                                          ElaboratedInstallPlan
elaboratedPlan'

        let elaboratedPlan'' :: ElaboratedInstallPlan
elaboratedPlan'' = BuildStatusMap -> ElaboratedInstallPlan -> ElaboratedInstallPlan
improveInstallPlanWithUpToDatePackages
                                BuildStatusMap
pkgsBuildStatus ElaboratedInstallPlan
elaboratedPlan'
        Verbosity -> [Char] -> IO ()
debugNoWrap Verbosity
verbosity (ElaboratedInstallPlan -> [Char]
forall ipkg srcpkg.
(Package ipkg, Package srcpkg, IsUnit ipkg, IsUnit srcpkg) =>
GenericInstallPlan ipkg srcpkg -> [Char]
InstallPlan.showInstallPlan ElaboratedInstallPlan
elaboratedPlan'')

        let
          buildCtx :: ProjectBuildContext
buildCtx = ProjectBuildContext
            { elaboratedPlanOriginal :: ElaboratedInstallPlan
elaboratedPlanOriginal = ElaboratedInstallPlan
elaboratedPlan
            , elaboratedPlanToExecute :: ElaboratedInstallPlan
elaboratedPlanToExecute = ElaboratedInstallPlan
elaboratedPlan''
            , elaboratedShared :: ElaboratedSharedConfig
elaboratedShared = ElaboratedSharedConfig
elaboratedShared'
            , BuildStatusMap
pkgsBuildStatus :: BuildStatusMap
pkgsBuildStatus :: BuildStatusMap
pkgsBuildStatus
            , targetsMap :: TargetsMap
targetsMap = TargetsMap
targets
            }

          ElaboratedSharedConfig { pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
pkgConfigCompiler = Compiler
compiler } = ElaboratedSharedConfig
elaboratedShared'

          replFlags :: LFlags
replFlags = case Maybe OriginalComponentInfo
originalComponent of
            Just OriginalComponentInfo
oci -> Bool -> ElaboratedInstallPlan -> OriginalComponentInfo -> LFlags
generateReplFlags Bool
includeTransitive ElaboratedInstallPlan
elaboratedPlan' OriginalComponentInfo
oci
            Maybe OriginalComponentInfo
Nothing  -> []

        (ProjectBuildContext, Compiler, ReplOptions)
-> IO (ProjectBuildContext, Compiler, ReplOptions)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectBuildContext
buildCtx, Compiler
compiler, ReplOptions
replOpts ReplOptions -> (ReplOptions -> ReplOptions) -> ReplOptions
forall a b. a -> (a -> b) -> b
& LensLike Identity ReplOptions ReplOptions LFlags LFlags
Lens' ReplOptions LFlags
lReplOptionsFlags LensLike Identity ReplOptions ReplOptions LFlags LFlags
-> (LFlags -> LFlags) -> ReplOptions -> ReplOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (LFlags -> LFlags -> LFlags
forall a. [a] -> [a] -> [a]
++ LFlags
replFlags))

    ReplOptions
replOpts'' <- case TargetContext
targetCtx of
      TargetContext
ProjectContext -> ReplOptions -> IO ReplOptions
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ReplOptions
replOpts'
      TargetContext
_              -> Compiler -> [Char] -> ReplOptions -> IO ReplOptions
usingGhciScript Compiler
compiler [Char]
projectRoot ReplOptions
replOpts'

    let buildCtx' :: ProjectBuildContext
buildCtx' = ProjectBuildContext
buildCtx ProjectBuildContext
-> (ProjectBuildContext -> ProjectBuildContext)
-> ProjectBuildContext
forall a b. a -> (a -> b) -> b
& LensLike
  Identity
  ProjectBuildContext
  ProjectBuildContext
  ElaboratedSharedConfig
  ElaboratedSharedConfig
Lens' ProjectBuildContext ElaboratedSharedConfig
lElaboratedShared LensLike
  Identity
  ProjectBuildContext
  ProjectBuildContext
  ElaboratedSharedConfig
  ElaboratedSharedConfig
-> ((ReplOptions -> Identity ReplOptions)
    -> ElaboratedSharedConfig -> Identity ElaboratedSharedConfig)
-> (ReplOptions -> Identity ReplOptions)
-> ProjectBuildContext
-> Identity ProjectBuildContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReplOptions -> Identity ReplOptions)
-> ElaboratedSharedConfig -> Identity ElaboratedSharedConfig
Lens' ElaboratedSharedConfig ReplOptions
lPkgConfigReplOptions ((ReplOptions -> Identity ReplOptions)
 -> ProjectBuildContext -> Identity ProjectBuildContext)
-> ReplOptions -> ProjectBuildContext -> ProjectBuildContext
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ReplOptions
replOpts''
    Verbosity -> ProjectBaseContext -> ProjectBuildContext -> IO ()
printPlan Verbosity
verbosity ProjectBaseContext
baseCtx' ProjectBuildContext
buildCtx'

    BuildOutcomes
buildOutcomes <- Verbosity
-> ProjectBaseContext -> ProjectBuildContext -> IO BuildOutcomes
runProjectBuildPhase Verbosity
verbosity ProjectBaseContext
baseCtx' ProjectBuildContext
buildCtx'
    Verbosity
-> ProjectBaseContext
-> ProjectBuildContext
-> BuildOutcomes
-> IO ()
runProjectPostBuildPhase Verbosity
verbosity ProjectBaseContext
baseCtx' ProjectBuildContext
buildCtx' BuildOutcomes
buildOutcomes
  where
    verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
configFlags)

    validatedTargets :: ElaboratedInstallPlan -> [TargetSelector] -> IO TargetsMap
validatedTargets ElaboratedInstallPlan
elaboratedPlan [TargetSelector]
targetSelectors = do
      -- Interpret the targets on the command line as repl targets
      -- (as opposed to say build or haddock targets).
      TargetsMap
targets <- ([TargetProblem ReplProblem] -> IO TargetsMap)
-> (TargetsMap -> IO TargetsMap)
-> Either [TargetProblem ReplProblem] TargetsMap
-> IO TargetsMap
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> [TargetProblem ReplProblem] -> IO TargetsMap
forall a. Verbosity -> [TargetProblem ReplProblem] -> IO a
reportTargetProblems Verbosity
verbosity) TargetsMap -> IO TargetsMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
          (Either [TargetProblem ReplProblem] TargetsMap -> IO TargetsMap)
-> Either [TargetProblem ReplProblem] TargetsMap -> IO TargetsMap
forall a b. (a -> b) -> a -> b
$ (forall k.
 TargetSelector
 -> [AvailableTarget k] -> Either (TargetProblem ReplProblem) [k])
-> (forall k.
    SubComponentTarget
    -> AvailableTarget k -> Either (TargetProblem ReplProblem) k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [TargetProblem ReplProblem] TargetsMap
forall err.
(forall k.
 TargetSelector
 -> [AvailableTarget k] -> Either (TargetProblem err) [k])
-> (forall k.
    SubComponentTarget
    -> AvailableTarget k -> Either (TargetProblem err) k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [TargetProblem err] TargetsMap
resolveTargets
              TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem ReplProblem) [k]
forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem ReplProblem) [k]
selectPackageTargets
              SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem ReplProblem) k
forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem ReplProblem) k
selectComponentTarget
              ElaboratedInstallPlan
elaboratedPlan
              Maybe SourcePackageDb
forall a. Maybe a
Nothing
              [TargetSelector]
targetSelectors

      -- Reject multiple targets, or at least targets in different
      -- components. It is ok to have two module/file targets in the
      -- same component, but not two that live in different components.
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set (UnitId, ComponentName) -> Int
forall a. Set a -> Int
Set.size (TargetsMap -> Set (UnitId, ComponentName)
distinctTargetComponents TargetsMap
targets) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Verbosity -> [TargetProblem ReplProblem] -> IO ()
forall a. Verbosity -> [TargetProblem ReplProblem] -> IO a
reportTargetProblems Verbosity
verbosity
          [TargetsMap -> TargetProblem ReplProblem
multipleTargetsProblem TargetsMap
targets]

      TargetsMap -> IO TargetsMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TargetsMap
targets

data OriginalComponentInfo = OriginalComponentInfo
  { OriginalComponentInfo -> UnitId
ociUnitId :: UnitId
  , OriginalComponentInfo -> [UnitId]
ociOriginalDeps :: [UnitId]
  }
  deriving (Int -> OriginalComponentInfo -> [Char] -> [Char]
[OriginalComponentInfo] -> [Char] -> [Char]
OriginalComponentInfo -> [Char]
(Int -> OriginalComponentInfo -> [Char] -> [Char])
-> (OriginalComponentInfo -> [Char])
-> ([OriginalComponentInfo] -> [Char] -> [Char])
-> Show OriginalComponentInfo
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> OriginalComponentInfo -> [Char] -> [Char]
showsPrec :: Int -> OriginalComponentInfo -> [Char] -> [Char]
$cshow :: OriginalComponentInfo -> [Char]
show :: OriginalComponentInfo -> [Char]
$cshowList :: [OriginalComponentInfo] -> [Char] -> [Char]
showList :: [OriginalComponentInfo] -> [Char] -> [Char]
Show)

addDepsToProjectTarget :: [Dependency]
                       -> PackageId
                       -> ProjectBaseContext
                       -> ProjectBaseContext
addDepsToProjectTarget :: [Dependency]
-> PackageIdentifier -> ProjectBaseContext -> ProjectBaseContext
addDepsToProjectTarget [Dependency]
deps PackageIdentifier
pkgId ProjectBaseContext
ctx =
    (\[PackageSpecifier UnresolvedSourcePackage]
p -> ProjectBaseContext
ctx { localPackages :: [PackageSpecifier UnresolvedSourcePackage]
localPackages = [PackageSpecifier UnresolvedSourcePackage]
p }) ([PackageSpecifier UnresolvedSourcePackage] -> ProjectBaseContext)
-> (ProjectBaseContext
    -> [PackageSpecifier UnresolvedSourcePackage])
-> ProjectBaseContext
-> ProjectBaseContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageSpecifier UnresolvedSourcePackage
 -> PackageSpecifier UnresolvedSourcePackage)
-> [PackageSpecifier UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageSpecifier UnresolvedSourcePackage
-> PackageSpecifier UnresolvedSourcePackage
addDeps ([PackageSpecifier UnresolvedSourcePackage]
 -> [PackageSpecifier UnresolvedSourcePackage])
-> (ProjectBaseContext
    -> [PackageSpecifier UnresolvedSourcePackage])
-> ProjectBaseContext
-> [PackageSpecifier UnresolvedSourcePackage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectBaseContext -> [PackageSpecifier UnresolvedSourcePackage]
localPackages (ProjectBaseContext -> ProjectBaseContext)
-> ProjectBaseContext -> ProjectBaseContext
forall a b. (a -> b) -> a -> b
$ ProjectBaseContext
ctx
  where
    addDeps :: PackageSpecifier UnresolvedSourcePackage
            -> PackageSpecifier UnresolvedSourcePackage
    addDeps :: PackageSpecifier UnresolvedSourcePackage
-> PackageSpecifier UnresolvedSourcePackage
addDeps (SpecificSourcePackage UnresolvedSourcePackage
pkg)
      | UnresolvedSourcePackage -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId UnresolvedSourcePackage
pkg PackageIdentifier -> PackageIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
/= PackageIdentifier
pkgId = UnresolvedSourcePackage -> PackageSpecifier UnresolvedSourcePackage
forall pkg. pkg -> PackageSpecifier pkg
SpecificSourcePackage UnresolvedSourcePackage
pkg
      | SourcePackage{PackageDescriptionOverride
PackageIdentifier
GenericPackageDescription
UnresolvedPkgLoc
srcpkgPackageId :: PackageIdentifier
srcpkgDescription :: GenericPackageDescription
srcpkgSource :: UnresolvedPkgLoc
srcpkgDescrOverride :: PackageDescriptionOverride
srcpkgPackageId :: forall loc. SourcePackage loc -> PackageIdentifier
srcpkgDescription :: forall loc. SourcePackage loc -> GenericPackageDescription
srcpkgSource :: forall loc. SourcePackage loc -> loc
srcpkgDescrOverride :: forall loc. SourcePackage loc -> PackageDescriptionOverride
..} <- UnresolvedSourcePackage
pkg =
        UnresolvedSourcePackage -> PackageSpecifier UnresolvedSourcePackage
forall pkg. pkg -> PackageSpecifier pkg
SpecificSourcePackage (UnresolvedSourcePackage
 -> PackageSpecifier UnresolvedSourcePackage)
-> UnresolvedSourcePackage
-> PackageSpecifier UnresolvedSourcePackage
forall a b. (a -> b) -> a -> b
$ UnresolvedSourcePackage
pkg { srcpkgDescription :: GenericPackageDescription
srcpkgDescription =
          GenericPackageDescription
srcpkgDescription GenericPackageDescription
-> (GenericPackageDescription -> GenericPackageDescription)
-> GenericPackageDescription
forall a b. a -> (a -> b) -> b
& (\[Dependency] -> Identity [Dependency]
f -> (forall a.
 CondTree ConfVar [Dependency] a
 -> Identity (CondTree ConfVar [Dependency] a))
-> GenericPackageDescription -> Identity GenericPackageDescription
forall (f :: * -> *).
Applicative f =>
(forall a.
 CondTree ConfVar [Dependency] a
 -> f (CondTree ConfVar [Dependency] a))
-> GenericPackageDescription -> f GenericPackageDescription
L.allCondTrees ((forall a.
  CondTree ConfVar [Dependency] a
  -> Identity (CondTree ConfVar [Dependency] a))
 -> GenericPackageDescription -> Identity GenericPackageDescription)
-> (forall a.
    CondTree ConfVar [Dependency] a
    -> Identity (CondTree ConfVar [Dependency] a))
-> GenericPackageDescription
-> Identity GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ LensLike
  Identity
  (CondTree ConfVar [Dependency] a)
  (CondTree ConfVar [Dependency] a)
  [Dependency]
  [Dependency]
forall v c a d (f :: * -> *).
Applicative f =>
LensLike f (CondTree v c a) (CondTree v d a) c d
traverseCondTreeC [Dependency] -> Identity [Dependency]
f)
                            (([Dependency] -> Identity [Dependency])
 -> GenericPackageDescription -> Identity GenericPackageDescription)
-> ([Dependency] -> [Dependency])
-> GenericPackageDescription
-> GenericPackageDescription
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Dependency]
deps [Dependency] -> [Dependency] -> [Dependency]
forall a. [a] -> [a] -> [a]
++)
        }
    addDeps PackageSpecifier UnresolvedSourcePackage
spec = PackageSpecifier UnresolvedSourcePackage
spec

generateReplFlags :: Bool -> ElaboratedInstallPlan -> OriginalComponentInfo -> [String]
generateReplFlags :: Bool -> ElaboratedInstallPlan -> OriginalComponentInfo -> LFlags
generateReplFlags Bool
includeTransitive ElaboratedInstallPlan
elaboratedPlan OriginalComponentInfo{[UnitId]
UnitId
ociUnitId :: OriginalComponentInfo -> UnitId
ociOriginalDeps :: OriginalComponentInfo -> [UnitId]
ociUnitId :: UnitId
ociOriginalDeps :: [UnitId]
..} = LFlags
flags
  where
    exeDeps :: [UnitId]
    exeDeps :: [UnitId]
exeDeps =
      (GenericPlanPackage
   InstalledPackageInfo ElaboratedConfiguredPackage
 -> [UnitId])
-> [GenericPlanPackage
      InstalledPackageInfo ElaboratedConfiguredPackage]
-> [UnitId]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        ((InstalledPackageInfo -> [UnitId])
-> (ElaboratedConfiguredPackage -> [UnitId])
-> GenericPlanPackage
     InstalledPackageInfo ElaboratedConfiguredPackage
-> [UnitId]
forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
InstallPlan.foldPlanPackage ([UnitId] -> InstalledPackageInfo -> [UnitId]
forall a b. a -> b -> a
const []) ElaboratedConfiguredPackage -> [UnitId]
elabOrderExeDependencies)
        (ElaboratedInstallPlan
-> [UnitId]
-> [GenericPlanPackage
      InstalledPackageInfo ElaboratedConfiguredPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg
-> [UnitId] -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.dependencyClosure ElaboratedInstallPlan
elaboratedPlan [UnitId
ociUnitId])

    deps, deps', trans, trans' :: [UnitId]
    flags :: [String]
    deps :: [UnitId]
deps   = GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
-> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId (GenericPlanPackage
   InstalledPackageInfo ElaboratedConfiguredPackage
 -> UnitId)
-> [GenericPlanPackage
      InstalledPackageInfo ElaboratedConfiguredPackage]
-> [UnitId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElaboratedInstallPlan
-> UnitId
-> [GenericPlanPackage
      InstalledPackageInfo ElaboratedConfiguredPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg
-> UnitId -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.directDeps ElaboratedInstallPlan
elaboratedPlan UnitId
ociUnitId
    deps' :: [UnitId]
deps'  = [UnitId]
deps [UnitId] -> [UnitId] -> [UnitId]
forall a. Eq a => [a] -> [a] -> [a]
\\ [UnitId]
ociOriginalDeps
    trans :: [UnitId]
trans  = GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
-> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId (GenericPlanPackage
   InstalledPackageInfo ElaboratedConfiguredPackage
 -> UnitId)
-> [GenericPlanPackage
      InstalledPackageInfo ElaboratedConfiguredPackage]
-> [UnitId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElaboratedInstallPlan
-> [UnitId]
-> [GenericPlanPackage
      InstalledPackageInfo ElaboratedConfiguredPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg
-> [UnitId] -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.dependencyClosure ElaboratedInstallPlan
elaboratedPlan [UnitId]
deps'
    trans' :: [UnitId]
trans' = [UnitId]
trans [UnitId] -> [UnitId] -> [UnitId]
forall a. Eq a => [a] -> [a] -> [a]
\\ [UnitId]
ociOriginalDeps
    flags :: LFlags
flags  = (UnitId -> [Char]) -> [UnitId] -> LFlags
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Char]
"-package-id " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> (UnitId -> [Char]) -> UnitId -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow) ([UnitId] -> LFlags)
-> ([UnitId] -> [UnitId]) -> [UnitId] -> LFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([UnitId] -> [UnitId] -> [UnitId]
forall a. Eq a => [a] -> [a] -> [a]
\\ [UnitId]
exeDeps)
      ([UnitId] -> LFlags) -> [UnitId] -> LFlags
forall a b. (a -> b) -> a -> b
$ if Bool
includeTransitive then [UnitId]
trans' else [UnitId]
deps'

-- | Add repl options to ensure the repl actually starts in the current working directory.
--
-- In a global or script context, when we are using a fake package, @cabal repl@
-- starts in the fake package directory instead of the directory it was called from,
-- so we need to tell ghci to change back to the correct directory.
--
-- The @-ghci-script@ flag is path to the ghci script responsible for changing to the
-- correct directory. Only works on GHC >= 7.6, though. 🙁
usingGhciScript :: Compiler -> FilePath -> ReplOptions -> IO ReplOptions
usingGhciScript :: Compiler -> [Char] -> ReplOptions -> IO ReplOptions
usingGhciScript Compiler
compiler [Char]
projectRoot ReplOptions
replOpts
  | CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion CompilerFlavor
GHC Compiler
compiler Maybe Version -> Maybe Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version -> Maybe Version
forall a. a -> Maybe a
Just Version
minGhciScriptVersion = do
      let ghciScriptPath :: [Char]
ghciScriptPath = [Char]
projectRoot [Char] -> [Char] -> [Char]
</> [Char]
"setcwd.ghci"
      [Char]
cwd <- IO [Char]
getCurrentDirectory
      [Char] -> [Char] -> IO ()
writeFile [Char]
ghciScriptPath ([Char]
":cd " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cwd)
      ReplOptions -> IO ReplOptions
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReplOptions -> IO ReplOptions) -> ReplOptions -> IO ReplOptions
forall a b. (a -> b) -> a -> b
$ ReplOptions
replOpts ReplOptions -> (ReplOptions -> ReplOptions) -> ReplOptions
forall a b. a -> (a -> b) -> b
& LensLike Identity ReplOptions ReplOptions LFlags LFlags
Lens' ReplOptions LFlags
lReplOptionsFlags LensLike Identity ReplOptions ReplOptions LFlags LFlags
-> (LFlags -> LFlags) -> ReplOptions -> ReplOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (([Char]
"-ghci-script" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ghciScriptPath) [Char] -> LFlags -> LFlags
forall a. a -> [a] -> [a]
:)
  | Bool
otherwise = ReplOptions -> IO ReplOptions
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ReplOptions
replOpts

-- | First version of GHC where GHCi supported the flag we need.
-- https://downloads.haskell.org/~ghc/7.6.1/docs/html/users_guide/release-7-6-1.html
minGhciScriptVersion :: Version
minGhciScriptVersion :: Version
minGhciScriptVersion = [Int] -> Version
mkVersion [Int
7, Int
6]

-- | This defines what a 'TargetSelector' means for the @repl@ command.
-- It selects the 'AvailableTarget's that the 'TargetSelector' refers to,
-- or otherwise classifies the problem.
--
-- For repl we select:
--
-- * the library if there is only one and it's buildable; or
--
-- * the exe if there is only one and it's buildable; or
--
-- * any other buildable component.
--
-- Fail if there are no buildable lib\/exe components, or if there are
-- multiple libs or exes.
--
selectPackageTargets  :: TargetSelector
                      -> [AvailableTarget k] -> Either ReplTargetProblem [k]
selectPackageTargets :: forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem ReplProblem) [k]
selectPackageTargets TargetSelector
targetSelector [AvailableTarget k]
targets

    -- If there is exactly one buildable library then we select that
  | [k
target] <- [k]
targetsLibsBuildable
  = [k] -> Either (TargetProblem ReplProblem) [k]
forall a b. b -> Either a b
Right [k
target]

    -- but fail if there are multiple buildable libraries.
  | Bool -> Bool
not ([k] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [k]
targetsLibsBuildable)
  = TargetProblem ReplProblem -> Either (TargetProblem ReplProblem) [k]
forall a b. a -> Either a b
Left (TargetSelector -> [AvailableTarget ()] -> TargetProblem ReplProblem
matchesMultipleProblem TargetSelector
targetSelector [AvailableTarget ()]
targetsLibsBuildable')

    -- If there is exactly one buildable executable then we select that
  | [k
target] <- [k]
targetsExesBuildable
  = [k] -> Either (TargetProblem ReplProblem) [k]
forall a b. b -> Either a b
Right [k
target]

    -- but fail if there are multiple buildable executables.
  | Bool -> Bool
not ([k] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [k]
targetsExesBuildable)
  = TargetProblem ReplProblem -> Either (TargetProblem ReplProblem) [k]
forall a b. a -> Either a b
Left (TargetSelector -> [AvailableTarget ()] -> TargetProblem ReplProblem
matchesMultipleProblem TargetSelector
targetSelector [AvailableTarget ()]
targetsExesBuildable')

    -- If there is exactly one other target then we select that
  | [k
target] <- [k]
targetsBuildable
  = [k] -> Either (TargetProblem ReplProblem) [k]
forall a b. b -> Either a b
Right [k
target]

    -- but fail if there are multiple such targets
  | Bool -> Bool
not ([k] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [k]
targetsBuildable)
  = TargetProblem ReplProblem -> Either (TargetProblem ReplProblem) [k]
forall a b. a -> Either a b
Left (TargetSelector -> [AvailableTarget ()] -> TargetProblem ReplProblem
matchesMultipleProblem TargetSelector
targetSelector [AvailableTarget ()]
targetsBuildable')

    -- If there are targets but none are buildable then we report those
  | Bool -> Bool
not ([AvailableTarget k] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AvailableTarget k]
targets)
  = TargetProblem ReplProblem -> Either (TargetProblem ReplProblem) [k]
forall a b. a -> Either a b
Left (TargetSelector -> [AvailableTarget ()] -> TargetProblem ReplProblem
forall a. TargetSelector -> [AvailableTarget ()] -> TargetProblem a
TargetProblemNoneEnabled TargetSelector
targetSelector [AvailableTarget ()]
targets')

    -- If there are no targets at all then we report that
  | Bool
otherwise
  = TargetProblem ReplProblem -> Either (TargetProblem ReplProblem) [k]
forall a b. a -> Either a b
Left (TargetSelector -> TargetProblem ReplProblem
forall a. TargetSelector -> TargetProblem a
TargetProblemNoTargets TargetSelector
targetSelector)
  where
    targets' :: [AvailableTarget ()]
targets'                = [AvailableTarget k] -> [AvailableTarget ()]
forall k. [AvailableTarget k] -> [AvailableTarget ()]
forgetTargetsDetail [AvailableTarget k]
targets
    ([k]
targetsLibsBuildable,
     [AvailableTarget ()]
targetsLibsBuildable') = [AvailableTarget k] -> ([k], [AvailableTarget ()])
forall k. [AvailableTarget k] -> ([k], [AvailableTarget ()])
selectBuildableTargets'
                            ([AvailableTarget k] -> ([k], [AvailableTarget ()]))
-> ([AvailableTarget k] -> [AvailableTarget k])
-> [AvailableTarget k]
-> ([k], [AvailableTarget ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
forall k.
ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKind
LibKind
                            ([AvailableTarget k] -> ([k], [AvailableTarget ()]))
-> [AvailableTarget k] -> ([k], [AvailableTarget ()])
forall a b. (a -> b) -> a -> b
$ [AvailableTarget k]
targets
    ([k]
targetsExesBuildable,
     [AvailableTarget ()]
targetsExesBuildable') = [AvailableTarget k] -> ([k], [AvailableTarget ()])
forall k. [AvailableTarget k] -> ([k], [AvailableTarget ()])
selectBuildableTargets'
                            ([AvailableTarget k] -> ([k], [AvailableTarget ()]))
-> ([AvailableTarget k] -> [AvailableTarget k])
-> [AvailableTarget k]
-> ([k], [AvailableTarget ()])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
forall k.
ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKind
ExeKind
                            ([AvailableTarget k] -> ([k], [AvailableTarget ()]))
-> [AvailableTarget k] -> ([k], [AvailableTarget ()])
forall a b. (a -> b) -> a -> b
$ [AvailableTarget k]
targets
    ([k]
targetsBuildable,
     [AvailableTarget ()]
targetsBuildable')     = (TargetRequested -> Bool)
-> [AvailableTarget k] -> ([k], [AvailableTarget ()])
forall k.
(TargetRequested -> Bool)
-> [AvailableTarget k] -> ([k], [AvailableTarget ()])
selectBuildableTargetsWith'
                                (TargetSelector -> TargetRequested -> Bool
isRequested TargetSelector
targetSelector) [AvailableTarget k]
targets

    -- When there's a target filter like "pkg:tests" then we do select tests,
    -- but if it's just a target like "pkg" then we don't build tests unless
    -- they are requested by default (i.e. by using --enable-tests)
    isRequested :: TargetSelector -> TargetRequested -> Bool
isRequested (TargetAllPackages  Maybe ComponentKind
Nothing) TargetRequested
TargetNotRequestedByDefault = Bool
False
    isRequested (TargetPackage TargetImplicitCwd
_ [PackageIdentifier]
_  Maybe ComponentKind
Nothing) TargetRequested
TargetNotRequestedByDefault = Bool
False
    isRequested TargetSelector
_ TargetRequested
_ = Bool
True


-- | For a 'TargetComponent' 'TargetSelector', check if the component can be
-- selected.
--
-- For the @repl@ command we just need the basic checks on being buildable etc.
--
selectComponentTarget :: SubComponentTarget
                      -> AvailableTarget k -> Either ReplTargetProblem k
selectComponentTarget :: forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem ReplProblem) k
selectComponentTarget = SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem ReplProblem) k
forall k a.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem a) k
selectComponentTargetBasic


data ReplProblem
  = TargetProblemMatchesMultiple TargetSelector [AvailableTarget ()]

    -- | Multiple 'TargetSelector's match multiple targets
  | TargetProblemMultipleTargets TargetsMap
  deriving (ReplProblem -> ReplProblem -> Bool
(ReplProblem -> ReplProblem -> Bool)
-> (ReplProblem -> ReplProblem -> Bool) -> Eq ReplProblem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReplProblem -> ReplProblem -> Bool
== :: ReplProblem -> ReplProblem -> Bool
$c/= :: ReplProblem -> ReplProblem -> Bool
/= :: ReplProblem -> ReplProblem -> Bool
Eq, Int -> ReplProblem -> [Char] -> [Char]
[ReplProblem] -> [Char] -> [Char]
ReplProblem -> [Char]
(Int -> ReplProblem -> [Char] -> [Char])
-> (ReplProblem -> [Char])
-> ([ReplProblem] -> [Char] -> [Char])
-> Show ReplProblem
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ReplProblem -> [Char] -> [Char]
showsPrec :: Int -> ReplProblem -> [Char] -> [Char]
$cshow :: ReplProblem -> [Char]
show :: ReplProblem -> [Char]
$cshowList :: [ReplProblem] -> [Char] -> [Char]
showList :: [ReplProblem] -> [Char] -> [Char]
Show)

-- | The various error conditions that can occur when matching a
-- 'TargetSelector' against 'AvailableTarget's for the @repl@ command.
--
type ReplTargetProblem = TargetProblem ReplProblem

matchesMultipleProblem
  :: TargetSelector
  -> [AvailableTarget ()]
  -> ReplTargetProblem
matchesMultipleProblem :: TargetSelector -> [AvailableTarget ()] -> TargetProblem ReplProblem
matchesMultipleProblem TargetSelector
targetSelector [AvailableTarget ()]
targetsExesBuildable =
  ReplProblem -> TargetProblem ReplProblem
forall a. a -> TargetProblem a
CustomTargetProblem (ReplProblem -> TargetProblem ReplProblem)
-> ReplProblem -> TargetProblem ReplProblem
forall a b. (a -> b) -> a -> b
$ TargetSelector -> [AvailableTarget ()] -> ReplProblem
TargetProblemMatchesMultiple TargetSelector
targetSelector [AvailableTarget ()]
targetsExesBuildable

multipleTargetsProblem
  :: TargetsMap
  -> ReplTargetProblem
multipleTargetsProblem :: TargetsMap -> TargetProblem ReplProblem
multipleTargetsProblem = ReplProblem -> TargetProblem ReplProblem
forall a. a -> TargetProblem a
CustomTargetProblem (ReplProblem -> TargetProblem ReplProblem)
-> (TargetsMap -> ReplProblem)
-> TargetsMap
-> TargetProblem ReplProblem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetsMap -> ReplProblem
TargetProblemMultipleTargets

reportTargetProblems :: Verbosity -> [TargetProblem ReplProblem] -> IO a
reportTargetProblems :: forall a. Verbosity -> [TargetProblem ReplProblem] -> IO a
reportTargetProblems Verbosity
verbosity =
    Verbosity -> [Char] -> IO a
forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity ([Char] -> IO a)
-> ([TargetProblem ReplProblem] -> [Char])
-> [TargetProblem ReplProblem]
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LFlags -> [Char]
unlines (LFlags -> [Char])
-> ([TargetProblem ReplProblem] -> LFlags)
-> [TargetProblem ReplProblem]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TargetProblem ReplProblem -> [Char])
-> [TargetProblem ReplProblem] -> LFlags
forall a b. (a -> b) -> [a] -> [b]
map TargetProblem ReplProblem -> [Char]
renderReplTargetProblem

renderReplTargetProblem :: TargetProblem ReplProblem -> String
renderReplTargetProblem :: TargetProblem ReplProblem -> [Char]
renderReplTargetProblem = [Char]
-> (ReplProblem -> [Char]) -> TargetProblem ReplProblem -> [Char]
forall a. [Char] -> (a -> [Char]) -> TargetProblem a -> [Char]
renderTargetProblem [Char]
"open a repl for" ReplProblem -> [Char]
renderReplProblem

renderReplProblem :: ReplProblem -> String
renderReplProblem :: ReplProblem -> [Char]
renderReplProblem (TargetProblemMatchesMultiple TargetSelector
targetSelector [AvailableTarget ()]
targets) =
    [Char]
"Cannot open a repl for multiple components at once. The target '"
 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
targetSelector [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' refers to "
 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
renderTargetSelector TargetSelector
targetSelector [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" which "
 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (if TargetSelector -> Bool
targetSelectorRefersToPkgs TargetSelector
targetSelector then [Char]
"includes " else [Char]
"are ")
 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LFlags -> [Char]
renderListSemiAnd
      [ [Char]
"the " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Plural -> ComponentKind -> [Char]
renderComponentKind Plural
Plural ComponentKind
ckind [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
        LFlags -> [Char]
renderListCommaAnd
          [ [Char]
-> (UnqualComponentName -> [Char])
-> Maybe UnqualComponentName
-> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PackageName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow PackageName
pkgname) UnqualComponentName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (ComponentName -> Maybe UnqualComponentName
componentNameString ComponentName
cname)
          | AvailableTarget ()
t <- [AvailableTarget ()]
ts
          , let cname :: ComponentName
cname   = AvailableTarget () -> ComponentName
forall k. AvailableTarget k -> ComponentName
availableTargetComponentName AvailableTarget ()
t
                pkgname :: PackageName
pkgname = PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName (AvailableTarget () -> PackageIdentifier
forall k. AvailableTarget k -> PackageIdentifier
availableTargetPackageId AvailableTarget ()
t)
          ]
      | (ComponentKind
ckind, [AvailableTarget ()]
ts) <- (AvailableTarget () -> ComponentKind)
-> [AvailableTarget ()] -> [(ComponentKind, [AvailableTarget ()])]
forall b a. Ord b => (a -> b) -> [a] -> [(b, [a])]
sortGroupOn AvailableTarget () -> ComponentKind
forall {k}. AvailableTarget k -> ComponentKind
availableTargetComponentKind [AvailableTarget ()]
targets
      ]
 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".\n\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
explanationSingleComponentLimitation
  where
    availableTargetComponentKind :: AvailableTarget k -> ComponentKind
availableTargetComponentKind = ComponentName -> ComponentKind
componentKind
                                 (ComponentName -> ComponentKind)
-> (AvailableTarget k -> ComponentName)
-> AvailableTarget k
-> ComponentKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AvailableTarget k -> ComponentName
forall k. AvailableTarget k -> ComponentName
availableTargetComponentName

renderReplProblem (TargetProblemMultipleTargets TargetsMap
selectorMap) =
    [Char]
"Cannot open a repl for multiple components at once. The targets "
 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LFlags -> [Char]
renderListCommaAnd
      [ [Char]
"'" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
ts [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"
      | TargetSelector
ts <- TargetsMap -> [TargetSelector]
uniqueTargetSelectors TargetsMap
selectorMap ]
 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" refer to different components."
 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".\n\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
explanationSingleComponentLimitation

explanationSingleComponentLimitation :: String
explanationSingleComponentLimitation :: [Char]
explanationSingleComponentLimitation =
    [Char]
"The reason for this limitation is that current versions of ghci do not "
 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"support loading multiple components as source. Load just one component "
 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"and when you make changes to a dependent component then quit and reload."

-- Lenses
lElaboratedShared :: Lens' ProjectBuildContext ElaboratedSharedConfig
lElaboratedShared :: Lens' ProjectBuildContext ElaboratedSharedConfig
lElaboratedShared ElaboratedSharedConfig -> f ElaboratedSharedConfig
f ProjectBuildContext
s = (ElaboratedSharedConfig -> ProjectBuildContext)
-> f ElaboratedSharedConfig -> f ProjectBuildContext
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ElaboratedSharedConfig
x -> ProjectBuildContext
s { elaboratedShared :: ElaboratedSharedConfig
elaboratedShared = ElaboratedSharedConfig
x }) (ElaboratedSharedConfig -> f ElaboratedSharedConfig
f (ProjectBuildContext -> ElaboratedSharedConfig
elaboratedShared ProjectBuildContext
s))
{-# inline lElaboratedShared #-}

lPkgConfigReplOptions :: Lens' ElaboratedSharedConfig ReplOptions
lPkgConfigReplOptions :: Lens' ElaboratedSharedConfig ReplOptions
lPkgConfigReplOptions ReplOptions -> f ReplOptions
f ElaboratedSharedConfig
s = (ReplOptions -> ElaboratedSharedConfig)
-> f ReplOptions -> f ElaboratedSharedConfig
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ReplOptions
x -> ElaboratedSharedConfig
s { pkgConfigReplOptions :: ReplOptions
pkgConfigReplOptions = ReplOptions
x }) (ReplOptions -> f ReplOptions
f (ElaboratedSharedConfig -> ReplOptions
pkgConfigReplOptions ElaboratedSharedConfig
s))
{-# inline lPkgConfigReplOptions #-}

lReplOptionsFlags :: Lens' ReplOptions [String]
lReplOptionsFlags :: Lens' ReplOptions LFlags
lReplOptionsFlags LFlags -> f LFlags
f ReplOptions
s = (LFlags -> ReplOptions) -> f LFlags -> f ReplOptions
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\LFlags
x -> ReplOptions
s { replOptionsFlags :: LFlags
replOptionsFlags = LFlags
x }) (LFlags -> f LFlags
f (ReplOptions -> LFlags
replOptionsFlags ReplOptions
s))
{-# inline lReplOptionsFlags #-}