{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module Distribution.Client.CmdRepl (
replCommand,
replAction,
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 :: [Dependency] -> Flag Bool -> EnvFlags
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
_ =
[ SFlags
-> LFlags
-> SFlags
-> (EnvFlags -> [Dependency])
-> ([Dependency] -> EnvFlags -> EnvFlags)
-> MkOptDescr
(EnvFlags -> [Dependency])
([Dependency] -> EnvFlags -> EnvFlags)
EnvFlags
-> OptionField EnvFlags
forall get set a.
SFlags
-> LFlags
-> SFlags
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [Char
'b'] [SFlags
"build-depends"]
SFlags
"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 })
(SFlags
-> ReadE [Dependency]
-> ([Dependency] -> LFlags)
-> MkOptDescr
(EnvFlags -> [Dependency])
([Dependency] -> EnvFlags -> EnvFlags)
EnvFlags
forall b a.
Monoid b =>
SFlags
-> ReadE b -> (b -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
reqArg SFlags
"DEPENDENCIES" ReadE [Dependency]
dependenciesReadE ((Dependency -> SFlags) -> [Dependency] -> LFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dependency -> SFlags
forall a. Pretty a => a -> SFlags
prettyShow :: [Dependency] -> [String]))
, SFlags
-> LFlags
-> SFlags
-> (EnvFlags -> Flag Bool)
-> (Flag Bool -> EnvFlags -> EnvFlags)
-> MkOptDescr
(EnvFlags -> Flag Bool)
(Flag Bool -> EnvFlags -> EnvFlags)
EnvFlags
-> OptionField EnvFlags
forall get set a.
SFlags
-> LFlags
-> SFlags
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option [] [SFlags
"no-transitive-deps"]
SFlags
"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 =
(SFlags -> SFlags)
-> ParsecParser [Dependency] -> ReadE [Dependency]
forall a. (SFlags -> SFlags) -> ParsecParser a -> ReadE a
parsecToReadE
(SFlags
"couldn't parse dependencies: " SFlags -> SFlags -> SFlags
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
parsec)
replCommand :: CommandUI (NixStyleFlags (ReplOptions, EnvFlags))
replCommand :: CommandUI (NixStyleFlags (ReplOptions, EnvFlags))
replCommand = CommandUI
(ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags,
BenchmarkFlags)
Client.installCommand {
commandName :: SFlags
commandName = SFlags
"v2-repl",
commandSynopsis :: SFlags
commandSynopsis = SFlags
"Open an interactive session for the given component.",
commandUsage :: SFlags -> SFlags
commandUsage = SFlags -> LFlags -> SFlags -> SFlags
usageAlternatives SFlags
"v2-repl" [ SFlags
"[TARGET] [FLAGS]" ],
commandDescription :: Maybe (SFlags -> SFlags)
commandDescription = (SFlags -> SFlags) -> Maybe (SFlags -> SFlags)
forall a. a -> Maybe a
Just ((SFlags -> SFlags) -> Maybe (SFlags -> SFlags))
-> (SFlags -> SFlags) -> Maybe (SFlags -> SFlags)
forall a b. (a -> b) -> a -> b
$ \SFlags
_ -> SFlags -> SFlags
wrapText (SFlags -> SFlags) -> SFlags -> SFlags
forall a b. (a -> b) -> a -> b
$
SFlags
"Open an interactive session for a component within the project. The "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"available targets are the same as for the 'v2-build' command: "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"individual components within packages in the project, including "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"libraries, executables, test-suites or benchmarks. Packages can "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"also be specified in which case the library component in the "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"package will be used, or the (first listed) executable in the "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"package if there is no library.\n\n"
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"Dependencies are built or rebuilt as necessary. Additional "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"configuration flags can be specified on the command line and these "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"extend the project configuration from the 'cabal.project', "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"'cabal.project.local' and other files.",
commandNotes :: Maybe (SFlags -> SFlags)
commandNotes = (SFlags -> SFlags) -> Maybe (SFlags -> SFlags)
forall a. a -> Maybe a
Just ((SFlags -> SFlags) -> Maybe (SFlags -> SFlags))
-> (SFlags -> SFlags) -> Maybe (SFlags -> SFlags)
forall a b. (a -> b) -> a -> b
$ \SFlags
pname ->
SFlags
"Examples, open an interactive session:\n"
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" " SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
pname SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" v2-repl\n"
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" for the default component in the package in the current directory\n"
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" " SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
pname SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" v2-repl pkgname\n"
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" for the default component in the package named 'pkgname'\n"
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" " SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
pname SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" v2-repl ./pkgfoo\n"
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" for the default component in the package in the ./pkgfoo directory\n"
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" " SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
pname SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" v2-repl cname\n"
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" for the component named 'cname'\n"
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" " SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
pname SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" v2-repl pkgname:cname\n"
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" for the component 'cname' in the package 'pkgname'\n\n"
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" " SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
pname SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" v2-repl --build-depends lens\n"
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" add the latest version of the library 'lens' to the default component "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"(or no componentif there is no project present)\n"
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" " SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
pname SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" v2-repl --build-depends \"lens >= 4.15 && < 4.18\"\n"
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" add a version (constrained between 4.15 and 4.18) of the library 'lens' "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"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. Lens (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. Lens (c, a) (c, b) a b
_2) (ShowOrParseArgs -> [OptionField EnvFlags]
envOptions ShowOrParseArgs
showOrParseArgs)
}
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), ConfigFlags
HaddockFlags
TestFlags
BenchmarkFlags
ProjectFlags
InstallFlags
ConfigExFlags
projectFlags :: forall a. NixStyleFlags a -> ProjectFlags
benchmarkFlags :: forall a. NixStyleFlags a -> BenchmarkFlags
testFlags :: forall a. NixStyleFlags a -> TestFlags
haddockFlags :: forall a. NixStyleFlags a -> HaddockFlags
installFlags :: forall a. NixStyleFlags a -> InstallFlags
configExFlags :: forall a. NixStyleFlags a -> ConfigExFlags
configFlags :: forall a. NixStyleFlags a -> ConfigFlags
projectFlags :: ProjectFlags
benchmarkFlags :: BenchmarkFlags
testFlags :: TestFlags
haddockFlags :: HaddockFlags
installFlags :: InstallFlags
configExFlags :: ConfigExFlags
configFlags :: ConfigFlags
..} 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 -> SFlags -> IO ()
forall a. Verbosity -> SFlags -> IO a
die' Verbosity
verbosity (SFlags -> IO ()) -> SFlags -> IO ()
forall a b. (a -> b) -> a -> b
$ SFlags
"The repl command does not support '--only-dependencies'. "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"You may wish to use 'build --only-dependencies' and then "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"use 'repl'."
let projectRoot :: SFlags
projectRoot = DistDirLayout -> SFlags
distProjectRootDirectory (DistDirLayout -> SFlags) -> DistDirLayout -> SFlags
forall a b. (a -> b) -> a -> b
$ ProjectBaseContext -> DistDirLayout
distDirLayout ProjectBaseContext
ctx
ProjectBaseContext
baseCtx <- case TargetContext
targetCtx of
TargetContext
ProjectContext -> ProjectBaseContext -> IO ProjectBaseContext
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 (t :: * -> *) a. Foldable t => t a -> Bool
null LFlags
targetStrings) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> SFlags -> IO ()
forall a. Verbosity -> SFlags -> IO a
die' Verbosity
verbosity (SFlags -> IO ()) -> SFlags -> IO ()
forall a b. (a -> b) -> a -> b
$ SFlags
"'repl' takes no arguments or a script argument outside a project: " SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ LFlags -> SFlags
unwords LFlags
targetStrings
let
sourcePackage :: SourcePackage (PackageLocation loc)
sourcePackage = SFlags -> SourcePackage (PackageLocation loc)
forall loc. SFlags -> SourcePackage (PackageLocation loc)
fakeProjectSourcePackage SFlags
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. Lens' (SourcePackage loc) 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
-> SourcePackage (PackageLocation (Maybe SFlags))
-> IO ProjectBaseContext
updateContextAndWriteProjectFile' ProjectBaseContext
ctx SourcePackage (PackageLocation (Maybe SFlags))
forall loc. SourcePackage (PackageLocation loc)
sourcePackage
ScriptContext SFlags
scriptPath Executable
scriptExecutable -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LFlags -> 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 -> SFlags -> IO ()
forall a. Verbosity -> SFlags -> IO a
die' Verbosity
verbosity (SFlags -> IO ()) -> SFlags -> IO ()
forall a b. (a -> b) -> a -> b
$ SFlags
"'repl' takes a single argument which should be a script: " SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ LFlags -> SFlags
unwords LFlags
targetStrings
Bool
existsScriptPath <- SFlags -> IO Bool
doesFileExist SFlags
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 -> SFlags -> IO ()
forall a. Verbosity -> SFlags -> IO a
die' Verbosity
verbosity (SFlags -> IO ()) -> SFlags -> IO ()
forall a b. (a -> b) -> a -> b
$ SFlags
"'repl' takes a single argument which should be a script: " SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ LFlags -> SFlags
unwords LFlags
targetStrings
ProjectBaseContext -> SFlags -> Executable -> IO ProjectBaseContext
updateContextAndWriteProjectFile ProjectBaseContext
ctx SFlags
scriptPath Executable
scriptExecutable
(Maybe OriginalComponentInfo
originalComponent, ProjectBaseContext
baseCtx') <- if [Dependency] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (EnvFlags -> [Dependency]
envPackages EnvFlags
envFlags)
then (Maybe OriginalComponentInfo, ProjectBaseContext)
-> IO (Maybe OriginalComponentInfo, ProjectBaseContext)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe OriginalComponentInfo
forall a. Maybe a
Nothing, ProjectBaseContext
baseCtx)
else
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
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 (SFlags -> (UnitId, [(ComponentTarget, NonEmpty TargetSelector)])
forall a. HasCallStack => SFlags -> a
error SFlags
"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 (SFlags -> PackageIdentifier
forall a. HasCallStack => SFlags -> a
error (SFlags -> PackageIdentifier) -> SFlags -> PackageIdentifier
forall a b. (a -> b) -> a -> b
$ SFlags
"cannot find " SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ UnitId -> SFlags
forall a. Pretty a => a -> SFlags
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 (m :: * -> *) a. Monad m => a -> m a
return (OriginalComponentInfo -> Maybe OriginalComponentInfo
forall a. a -> Maybe a
Just OriginalComponentInfo
oci, ProjectBaseContext
baseCtx')
(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 (SourcePackage (PackageLocation (Maybe SFlags)))]
CabalDirLayout
DistDirLayout
BuildTimeSettings
ProjectConfig
CurrentCommand
currentCommand :: ProjectBaseContext -> CurrentCommand
localPackages :: ProjectBaseContext
-> [PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags)))]
projectConfig :: ProjectBaseContext -> ProjectConfig
cabalDirLayout :: ProjectBaseContext -> CabalDirLayout
currentCommand :: CurrentCommand
buildSettings :: BuildTimeSettings
localPackages :: [PackageSpecifier (SourcePackage (PackageLocation (Maybe SFlags)))]
projectConfig :: ProjectConfig
cabalDirLayout :: CabalDirLayout
distDirLayout :: DistDirLayout
distDirLayout :: ProjectBaseContext -> DistDirLayout
buildSettings :: ProjectBaseContext -> BuildTimeSettings
..} = ProjectBaseContext
baseCtx'
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 -> SFlags -> IO ()
debugNoWrap Verbosity
verbosity (ElaboratedInstallPlan -> SFlags
forall ipkg srcpkg.
(Package ipkg, Package srcpkg, IsUnit ipkg, IsUnit srcpkg) =>
GenericInstallPlan ipkg srcpkg -> SFlags
InstallPlan.showInstallPlan ElaboratedInstallPlan
elaboratedPlan'')
let
buildCtx :: ProjectBuildContext
buildCtx = ProjectBuildContext :: ElaboratedInstallPlan
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> BuildStatusMap
-> TargetsMap
-> ProjectBuildContext
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 (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 (m :: * -> *) a. Monad m => a -> m a
return ReplOptions
replOpts'
TargetContext
_ -> Compiler -> SFlags -> ReplOptions -> IO ReplOptions
usingGhciScript Compiler
compiler SFlags
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
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 (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
forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem ReplProblem) [k]
selectPackageTargets
forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem ReplProblem) k
selectComponentTarget
ElaboratedInstallPlan
elaboratedPlan
Maybe SourcePackageDb
forall a. Maybe a
Nothing
[TargetSelector]
targetSelectors
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 (m :: * -> *) a. Monad m => a -> m a
return TargetsMap
targets
data OriginalComponentInfo = OriginalComponentInfo
{ OriginalComponentInfo -> UnitId
ociUnitId :: UnitId
, OriginalComponentInfo -> [UnitId]
ociOriginalDeps :: [UnitId]
}
deriving (Int -> OriginalComponentInfo -> SFlags -> SFlags
[OriginalComponentInfo] -> SFlags -> SFlags
OriginalComponentInfo -> SFlags
(Int -> OriginalComponentInfo -> SFlags -> SFlags)
-> (OriginalComponentInfo -> SFlags)
-> ([OriginalComponentInfo] -> SFlags -> SFlags)
-> Show OriginalComponentInfo
forall a.
(Int -> a -> SFlags -> SFlags)
-> (a -> SFlags) -> ([a] -> SFlags -> SFlags) -> Show a
showList :: [OriginalComponentInfo] -> SFlags -> SFlags
$cshowList :: [OriginalComponentInfo] -> SFlags -> SFlags
show :: OriginalComponentInfo -> SFlags
$cshow :: OriginalComponentInfo -> SFlags
showsPrec :: Int -> OriginalComponentInfo -> SFlags -> SFlags
$cshowsPrec :: Int -> OriginalComponentInfo -> SFlags -> SFlags
Show)
addDepsToProjectTarget :: [Dependency]
-> PackageId
-> ProjectBaseContext
-> ProjectBaseContext
addDepsToProjectTarget :: [Dependency]
-> PackageIdentifier -> ProjectBaseContext -> ProjectBaseContext
addDepsToProjectTarget [Dependency]
deps PackageIdentifier
pkgId ProjectBaseContext
ctx =
(\[PackageSpecifier (SourcePackage (PackageLocation (Maybe SFlags)))]
p -> ProjectBaseContext
ctx { localPackages :: [PackageSpecifier (SourcePackage (PackageLocation (Maybe SFlags)))]
localPackages = [PackageSpecifier (SourcePackage (PackageLocation (Maybe SFlags)))]
p }) ([PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags)))]
-> ProjectBaseContext)
-> (ProjectBaseContext
-> [PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags)))])
-> ProjectBaseContext
-> ProjectBaseContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageSpecifier (SourcePackage (PackageLocation (Maybe SFlags)))
-> PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags))))
-> [PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags)))]
-> [PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags)))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageSpecifier (SourcePackage (PackageLocation (Maybe SFlags)))
-> PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags)))
addDeps ([PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags)))]
-> [PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags)))])
-> (ProjectBaseContext
-> [PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags)))])
-> ProjectBaseContext
-> [PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags)))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectBaseContext
-> [PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags)))]
localPackages (ProjectBaseContext -> ProjectBaseContext)
-> ProjectBaseContext -> ProjectBaseContext
forall a b. (a -> b) -> a -> b
$ ProjectBaseContext
ctx
where
addDeps :: PackageSpecifier UnresolvedSourcePackage
-> PackageSpecifier UnresolvedSourcePackage
addDeps :: PackageSpecifier (SourcePackage (PackageLocation (Maybe SFlags)))
-> PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags)))
addDeps (SpecificSourcePackage SourcePackage (PackageLocation (Maybe SFlags))
pkg)
| SourcePackage (PackageLocation (Maybe SFlags)) -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId SourcePackage (PackageLocation (Maybe SFlags))
pkg PackageIdentifier -> PackageIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
/= PackageIdentifier
pkgId = SourcePackage (PackageLocation (Maybe SFlags))
-> PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags)))
forall pkg. pkg -> PackageSpecifier pkg
SpecificSourcePackage SourcePackage (PackageLocation (Maybe SFlags))
pkg
| SourcePackage{PackageDescriptionOverride
GenericPackageDescription
PackageIdentifier
PackageLocation (Maybe SFlags)
srcpkgPackageId :: forall loc. SourcePackage loc -> PackageIdentifier
srcpkgDescription :: forall loc. SourcePackage loc -> GenericPackageDescription
srcpkgSource :: forall loc. SourcePackage loc -> loc
srcpkgDescrOverride :: forall loc. SourcePackage loc -> PackageDescriptionOverride
srcpkgDescrOverride :: PackageDescriptionOverride
srcpkgSource :: PackageLocation (Maybe SFlags)
srcpkgDescription :: GenericPackageDescription
srcpkgPackageId :: PackageIdentifier
..} <- SourcePackage (PackageLocation (Maybe SFlags))
pkg =
SourcePackage (PackageLocation (Maybe SFlags))
-> PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags)))
forall pkg. pkg -> PackageSpecifier pkg
SpecificSourcePackage (SourcePackage (PackageLocation (Maybe SFlags))
-> PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags))))
-> SourcePackage (PackageLocation (Maybe SFlags))
-> PackageSpecifier
(SourcePackage (PackageLocation (Maybe SFlags)))
forall a b. (a -> b) -> a -> b
$ SourcePackage (PackageLocation (Maybe SFlags))
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. Traversal (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 (SourcePackage (PackageLocation (Maybe SFlags)))
spec = PackageSpecifier (SourcePackage (PackageLocation (Maybe SFlags)))
spec
generateReplFlags :: Bool -> ElaboratedInstallPlan -> OriginalComponentInfo -> [String]
generateReplFlags :: Bool -> ElaboratedInstallPlan -> OriginalComponentInfo -> LFlags
generateReplFlags Bool
includeTransitive ElaboratedInstallPlan
elaboratedPlan OriginalComponentInfo{[UnitId]
UnitId
ociOriginalDeps :: [UnitId]
ociUnitId :: UnitId
ociOriginalDeps :: OriginalComponentInfo -> [UnitId]
ociUnitId :: OriginalComponentInfo -> UnitId
..} = LFlags
flags
where
exeDeps :: [UnitId]
exeDeps :: [UnitId]
exeDeps =
(GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage
-> [UnitId])
-> [GenericPlanPackage
InstalledPackageInfo ElaboratedConfiguredPackage]
-> [UnitId]
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 -> SFlags) -> [UnitId] -> LFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SFlags
"-package-id " SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++) (SFlags -> SFlags) -> (UnitId -> SFlags) -> UnitId -> SFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> SFlags
forall a. Pretty a => a -> SFlags
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'
usingGhciScript :: Compiler -> FilePath -> ReplOptions -> IO ReplOptions
usingGhciScript :: Compiler -> SFlags -> ReplOptions -> IO ReplOptions
usingGhciScript Compiler
compiler SFlags
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 :: SFlags
ghciScriptPath = SFlags
projectRoot SFlags -> SFlags -> SFlags
</> SFlags
"setcwd.ghci"
SFlags
cwd <- IO SFlags
getCurrentDirectory
SFlags -> SFlags -> IO ()
writeFile SFlags
ghciScriptPath (SFlags
":cd " SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
cwd)
ReplOptions -> IO ReplOptions
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
%~ ((SFlags
"-ghci-script" SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
ghciScriptPath) SFlags -> LFlags -> LFlags
forall a. a -> [a] -> [a]
:)
| Bool
otherwise = ReplOptions -> IO ReplOptions
forall (m :: * -> *) a. Monad m => a -> m a
return ReplOptions
replOpts
minGhciScriptVersion :: Version
minGhciScriptVersion :: Version
minGhciScriptVersion = [Int] -> Version
mkVersion [Int
7, Int
6]
selectPackageTargets :: TargetSelector
-> [AvailableTarget k] -> Either ReplTargetProblem [k]
selectPackageTargets :: TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem ReplProblem) [k]
selectPackageTargets TargetSelector
targetSelector [AvailableTarget k]
targets
| [k
target] <- [k]
targetsLibsBuildable
= [k] -> Either (TargetProblem ReplProblem) [k]
forall a b. b -> Either a b
Right [k
target]
| Bool -> Bool
not ([k] -> 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')
| [k
target] <- [k]
targetsExesBuildable
= [k] -> Either (TargetProblem ReplProblem) [k]
forall a b. b -> Either a b
Right [k
target]
| Bool -> Bool
not ([k] -> 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')
| [k
target] <- [k]
targetsBuildable
= [k] -> Either (TargetProblem ReplProblem) [k]
forall a b. b -> Either a b
Right [k
target]
| Bool -> Bool
not ([k] -> 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')
| Bool -> Bool
not ([AvailableTarget k] -> 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')
| 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
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
selectComponentTarget :: SubComponentTarget
-> AvailableTarget k -> Either ReplTargetProblem k
selectComponentTarget :: 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 ()]
| TargetProblemMultipleTargets TargetsMap
deriving (ReplProblem -> ReplProblem -> Bool
(ReplProblem -> ReplProblem -> Bool)
-> (ReplProblem -> ReplProblem -> Bool) -> Eq ReplProblem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplProblem -> ReplProblem -> Bool
$c/= :: ReplProblem -> ReplProblem -> Bool
== :: ReplProblem -> ReplProblem -> Bool
$c== :: ReplProblem -> ReplProblem -> Bool
Eq, Int -> ReplProblem -> SFlags -> SFlags
[ReplProblem] -> SFlags -> SFlags
ReplProblem -> SFlags
(Int -> ReplProblem -> SFlags -> SFlags)
-> (ReplProblem -> SFlags)
-> ([ReplProblem] -> SFlags -> SFlags)
-> Show ReplProblem
forall a.
(Int -> a -> SFlags -> SFlags)
-> (a -> SFlags) -> ([a] -> SFlags -> SFlags) -> Show a
showList :: [ReplProblem] -> SFlags -> SFlags
$cshowList :: [ReplProblem] -> SFlags -> SFlags
show :: ReplProblem -> SFlags
$cshow :: ReplProblem -> SFlags
showsPrec :: Int -> ReplProblem -> SFlags -> SFlags
$cshowsPrec :: Int -> ReplProblem -> SFlags -> SFlags
Show)
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 :: Verbosity -> [TargetProblem ReplProblem] -> IO a
reportTargetProblems Verbosity
verbosity =
Verbosity -> SFlags -> IO a
forall a. Verbosity -> SFlags -> IO a
die' Verbosity
verbosity (SFlags -> IO a)
-> ([TargetProblem ReplProblem] -> SFlags)
-> [TargetProblem ReplProblem]
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LFlags -> SFlags
unlines (LFlags -> SFlags)
-> ([TargetProblem ReplProblem] -> LFlags)
-> [TargetProblem ReplProblem]
-> SFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TargetProblem ReplProblem -> SFlags)
-> [TargetProblem ReplProblem] -> LFlags
forall a b. (a -> b) -> [a] -> [b]
map TargetProblem ReplProblem -> SFlags
renderReplTargetProblem
renderReplTargetProblem :: TargetProblem ReplProblem -> String
renderReplTargetProblem :: TargetProblem ReplProblem -> SFlags
renderReplTargetProblem = SFlags
-> (ReplProblem -> SFlags) -> TargetProblem ReplProblem -> SFlags
forall a. SFlags -> (a -> SFlags) -> TargetProblem a -> SFlags
renderTargetProblem SFlags
"open a repl for" ReplProblem -> SFlags
renderReplProblem
renderReplProblem :: ReplProblem -> String
renderReplProblem :: ReplProblem -> SFlags
renderReplProblem (TargetProblemMatchesMultiple TargetSelector
targetSelector [AvailableTarget ()]
targets) =
SFlags
"Cannot open a repl for multiple components at once. The target '"
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ TargetSelector -> SFlags
showTargetSelector TargetSelector
targetSelector SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"' refers to "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ TargetSelector -> SFlags
renderTargetSelector TargetSelector
targetSelector SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" which "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ (if TargetSelector -> Bool
targetSelectorRefersToPkgs TargetSelector
targetSelector then SFlags
"includes " else SFlags
"are ")
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ LFlags -> SFlags
renderListSemiAnd
[ SFlags
"the " SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ Plural -> ComponentKind -> SFlags
renderComponentKind Plural
Plural ComponentKind
ckind SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" " SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++
LFlags -> SFlags
renderListCommaAnd
[ SFlags
-> (UnqualComponentName -> SFlags)
-> Maybe UnqualComponentName
-> SFlags
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PackageName -> SFlags
forall a. Pretty a => a -> SFlags
prettyShow PackageName
pkgname) UnqualComponentName -> SFlags
forall a. Pretty a => a -> SFlags
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
]
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
".\n\n" SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
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) =
SFlags
"Cannot open a repl for multiple components at once. The targets "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ LFlags -> SFlags
renderListCommaAnd
[ SFlags
"'" SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ TargetSelector -> SFlags
showTargetSelector TargetSelector
ts SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"'"
| TargetSelector
ts <- TargetsMap -> [TargetSelector]
uniqueTargetSelectors TargetsMap
selectorMap ]
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
" refer to different components."
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
".\n\n" SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
explanationSingleComponentLimitation
explanationSingleComponentLimitation :: String
explanationSingleComponentLimitation :: SFlags
explanationSingleComponentLimitation =
SFlags
"The reason for this limitation is that current versions of ghci do not "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"support loading multiple components as source. Load just one component "
SFlags -> SFlags -> SFlags
forall a. [a] -> [a] -> [a]
++ SFlags
"and when you make changes to a dependent component then quit and reload."
lElaboratedShared :: Lens' ProjectBuildContext ElaboratedSharedConfig
lElaboratedShared :: LensLike
f
ProjectBuildContext
ProjectBuildContext
ElaboratedSharedConfig
ElaboratedSharedConfig
lElaboratedShared ElaboratedSharedConfig -> f ElaboratedSharedConfig
f ProjectBuildContext
s = (ElaboratedSharedConfig -> ProjectBuildContext)
-> f ElaboratedSharedConfig -> f ProjectBuildContext
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 :: LensLike
f
ElaboratedSharedConfig
ElaboratedSharedConfig
ReplOptions
ReplOptions
lPkgConfigReplOptions ReplOptions -> f ReplOptions
f ElaboratedSharedConfig
s = (ReplOptions -> ElaboratedSharedConfig)
-> f ReplOptions -> f ElaboratedSharedConfig
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 :: LensLike f ReplOptions ReplOptions LFlags LFlags
lReplOptionsFlags LFlags -> f LFlags
f ReplOptions
s = (LFlags -> ReplOptions) -> f LFlags -> f ReplOptions
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 #-}