REPL command in project requires a target

cabal-install/src/Distribution/Client/CmdRepl.hs

@@ -106,7 +106,8 @@ import Distribution.Simple.Compiler
   )
 import Distribution.Simple.Program.GHC
 import Distribution.Simple.Setup
-  ( ReplOptions (..)
+  ( Flag
+  , ReplOptions (..)
   , commonSetupTempFileOptions
   )
 import Distribution.Simple.Utils
@@ -170,8 +171,8 @@ import Data.List
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import Distribution.Client.ProjectConfig
-  ( ProjectConfig (projectConfigShared)
-  , ProjectConfigShared (projectConfigConstraints, projectConfigMultiRepl)
+  ( ProjectConfig (..)
+  , ProjectConfigShared (..)
   )
 import Distribution.Client.ReplFlags
   ( EnvFlags (envIncludeTransitive, envPackages)
@@ -195,6 +196,7 @@ import System.FilePath
   , splitSearchPath
   , (</>)
   )
+import Text.PrettyPrint hiding ((<>))
 
 replCommand :: CommandUI (NixStyleFlags ReplFlags)
 replCommand =
@@ -281,15 +283,30 @@ multiReplDecision ctx compiler flags =
 -- For more details on how this works, see the module
 -- "Distribution.Client.ProjectOrchestration"
 replAction :: NixStyleFlags ReplFlags -> [String] -> GlobalFlags -> IO ()
-replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings globalFlags =
-  withContextAndSelectors verbosity AcceptNoTargets (Just LibKind) flags targetStrings globalFlags ReplCommand $ \targetCtx ctx targetSelectors -> do
+replAction flags@NixStyleFlags{extraFlags = replFlags@ReplFlags{..}, configFlags} targetStrings globalFlags = do
+  withCtx verbosity targetStrings $ \targetCtx ctx targetSelectors -> do
     when (buildSettingOnlyDeps (buildSettings ctx)) $
       dieWithException verbosity ReplCommandDoesn'tSupport
     let projectRoot = distProjectRootDirectory $ distDirLayout ctx
         distDir = distDirectory $ distDirLayout ctx
 
     baseCtx <- case targetCtx of
-      ProjectContext -> return ctx
+      ProjectContext -> do
+        let pkgs = projectPackages $ projectConfig ctx
+        when (null targetSelectors && not (null pkgs)) $ do
+          case pkgs of
+            [pkg] ->
+              -- The REPL will work with no targets in the context of a project
+              -- if a single package is in the same directory as the project
+              -- file. To have the same implicit package behaviour when the
+              -- package is somewhere else we try again with an explicit package
+              -- target.
+              replAction flags [pkg] globalFlags
+            _ -> do
+              let projectFile = projectConfigProjectFile . projectConfigShared $ projectConfig ctx
+              dieWithException verbosity $
+                RenderReplTargetProblem [render (reportProjectNoTarget projectFile pkgs)]
+        return ctx
       GlobalContext -> do
         unless (null targetStrings) $
           dieWithException verbosity $
@@ -360,7 +377,7 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings g
         -- especially in the no-project case.
         withInstallPlan (lessVerbose verbosity) baseCtx' $ \elaboratedPlan sharedConfig -> do
           -- targets should be non-empty map, but there's no NonEmptyMap yet.
-          targets <- validatedTargets (projectConfigShared (projectConfig ctx)) (pkgConfigCompiler sharedConfig) elaboratedPlan targetSelectors
+          targets <- validatedTargets' (projectConfigShared (projectConfig ctx)) (pkgConfigCompiler sharedConfig) elaboratedPlan targetSelectors
 
           let
             (unitId, _) = fromMaybe (error "panic: targets should be non-empty") $ safeHead $ Map.toList targets
@@ -384,7 +401,7 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings g
         let ProjectBaseContext{..} = baseCtx''
 
         -- Recalculate with updated project.
-        targets <- validatedTargets (projectConfigShared projectConfig) (pkgConfigCompiler elaboratedShared') elaboratedPlan targetSelectors
+        targets <- validatedTargets' (projectConfigShared projectConfig) (pkgConfigCompiler elaboratedShared') elaboratedPlan targetSelectors
 
         let
           elaboratedPlan' =
@@ -517,31 +534,13 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings g
         go m ("PATH", Just s) = foldl' (\m' f -> Map.insertWith (+) f 1 m') m (splitSearchPath s)
         go m _ = m
 
+    withCtx ctxVerbosity strings =
+      withContextAndSelectors ctxVerbosity AcceptNoTargets (Just LibKind) flags strings globalFlags ReplCommand
+
     verbosity = cfgVerbosity normal flags
     tempFileOptions = commonSetupTempFileOptions $ configCommonFlags configFlags
 
-    validatedTargets ctx compiler elaboratedPlan targetSelectors = do
-      let multi_repl_enabled = multiReplDecision ctx compiler r
-      -- Interpret the targets on the command line as repl targets
-      -- (as opposed to say build or haddock targets).
-      targets <-
-        either (reportTargetProblems verbosity) return $
-          resolveTargetsFromSolver
-            (selectPackageTargets multi_repl_enabled)
-            selectComponentTarget
-            elaboratedPlan
-            Nothing
-            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.
-      when (Set.size (distinctTargetComponents targets) > 1 && not (useMultiRepl multi_repl_enabled)) $
-        reportTargetProblems
-          verbosity
-          [multipleTargetsProblem multi_repl_enabled targets]
-
-      return targets
+    validatedTargets' = validatedTargets verbosity replFlags
 
 -- | Create a constraint which requires a later version of Cabal.
 -- This is used for commands which require a specific feature from the Cabal library
@@ -554,6 +553,68 @@ requireCabal version source =
   , source
   )
 
+reportProjectNoTarget :: Flag FilePath -> [String] -> Doc
+reportProjectNoTarget projectFile pkgs =
+  case (null pkgs, projectName) of
+    (True, Just project) ->
+      text "There are no packages in"
+        <+> (project <> char '.')
+        <+> text "Please add a package to the project and"
+        <+> pickComponent
+    (True, Nothing) ->
+      text "Please add a package to the project and" <+> pickComponent
+    (False, Just project) ->
+      text "Please"
+        <+> pickComponent
+        <+> text "The packages in"
+        <+> project
+        <+> (text "from which to select a component target are" <> colon)
+        $+$ nest 1 (vcat [text "-" <+> text pkg | pkg <- sort pkgs])
+    (False, Nothing) ->
+      text "Please"
+        <+> pickComponent
+        <+> (text "The packages from which to select a component in 'cabal.project'" <> comma)
+        <+> (text "the implicit default as if `--project-file=cabal.project` was added as a command option" <> comma)
+        <+> (text "are" <> colon)
+        $+$ nest 1 (vcat [text "-" <+> text pkg | pkg <- sort pkgs])
+  where
+    projectName = case projectFile of
+      Flag "" -> Nothing
+      Flag n -> Just $ quotes (text n)
+      _ -> Nothing
+    pickComponent = text "pick a single [package:][ctype:]component as target for the REPL command."
+
+validatedTargets
+  :: Verbosity
+  -> ReplFlags
+  -> ProjectConfigShared
+  -> Compiler
+  -> ElaboratedInstallPlan
+  -> [TargetSelector]
+  -> IO TargetsMap
+validatedTargets verbosity replFlags ctx compiler elaboratedPlan targetSelectors = do
+  let multi_repl_enabled = multiReplDecision ctx compiler replFlags
+  -- Interpret the targets on the command line as repl targets (as opposed to
+  -- say build or haddock targets).
+  targets <-
+    either (reportTargetProblems verbosity) return $
+      resolveTargetsFromSolver
+        (selectPackageTargets multi_repl_enabled)
+        selectComponentTarget
+        elaboratedPlan
+        Nothing
+        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.
+  when (Set.size (distinctTargetComponents targets) > 1 && not (useMultiRepl multi_repl_enabled)) $
+    reportTargetProblems
+      verbosity
+      [multipleTargetsProblem multi_repl_enabled targets]
+
+  return targets
+
 -- | First version of GHC which supports multiple home packages
 minMultipleHomeUnitsVersion :: Version
 minMultipleHomeUnitsVersion = mkVersion [9, 4]

cabal-testsuite/PackageTests/ReplOptions/alt.project

@@ -0,0 +1 @@
+packages: alt

cabal-testsuite/PackageTests/ReplOptions/alt/ModuleA.hs

@@ -0,0 +1,4 @@
+module ModuleA where
+
+a :: Int
+a = 42

cabal-testsuite/PackageTests/ReplOptions/alt/ModuleC.hs

@@ -0,0 +1,4 @@
+module ModuleC where
+
+c :: Int
+c = 42

cabal-testsuite/PackageTests/ReplOptions/alt/alt.cabal

@@ -0,0 +1,10 @@
+name: alt
+version: 0.1
+build-type: Simple
+cabal-version: >= 1.10
+
+library
+  exposed-modules: ModuleA, ModuleC
+  build-depends: base
+  default-language: Haskell2010
+

cabal-testsuite/PackageTests/ReplOptions/cabal.alt-multiple-repl-options.out

@@ -0,0 +1,10 @@
+# cabal clean
+# cabal v2-repl
+Configuration is affected by the following files:
+- alt.project
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following will be built:
+ - alt-0.1 (interactive) (lib) (first run)
+Configuring library for alt-0.1...
+Preprocessing library for alt-0.1...

cabal-testsuite/PackageTests/ReplOptions/cabal.alt-single-repl-options.out

@@ -0,0 +1,10 @@
+# cabal clean
+# cabal v2-repl
+Configuration is affected by the following files:
+- alt.project
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following will be built:
+ - alt-0.1 (interactive) (lib) (first run)
+Configuring library for alt-0.1...
+Preprocessing library for alt-0.1...

cabal-testsuite/PackageTests/ReplOptions/cabal.test.hs

@@ -1,29 +1,46 @@
 import Test.Cabal.Prelude
 
+singleOpts = ["--repl-options=-fwrite-interface"]
+multiOpts = "--repl-options=-fdefer-typed-holes" : singleOpts
+altProject = ("--project-file=alt.project" :)
+
 main = do
   cabalTest' "single-repl-options" $ do
     cabal' "clean" []
-    res <- cabalWithStdin "v2-repl" ["--repl-options=-fwrite-interface"] ":set"
+    res <- cabalWithStdin "v2-repl" singleOpts ":set"
     assertOutputContains "Ok, two modules loaded." res
-    assertOutputContains "  -fwrite-interface" res
+
+  cabalTest' "alt-single-repl-options" $ do
+    cabal' "clean" []
+    -- Can we 'cabal repl' without a target when the project has a single package?
+    void $ cabalWithStdin "v2-repl" (altProject singleOpts) ":set"
+
   cabalTest' "multiple-repl-options" $ do
     cabal' "clean" []
-    res <- cabalWithStdin "v2-repl" ["--repl-options=-fwrite-interface", "--repl-options=-fdefer-typed-holes"] ":set"
+    res <- cabalWithStdin "v2-repl" multiOpts ":set"
     assertOutputContains "Ok, two modules loaded." res
     assertOutputContains "  -fwrite-interface" res
     assertOutputContains "  -fdefer-typed-holes" res
+
+  cabalTest' "alt-multiple-repl-options" $ do
+    cabal' "clean" []
+    -- Can we 'cabal repl' without a target when the project has a single package?
+    void $ cabalWithStdin "v2-repl" (altProject multiOpts) ":set"
+
   cabalTest' "single-repl-options-multiple-flags" $ do
     cabal' "clean" []
     res <- cabalWithStdin "v2-repl" ["--repl-options=-fdefer-typed-holes -fwrite-interface"] ":set"
     assertOutputContains "Ok, two modules loaded." res
     assertOutputContains "  -fwrite-interface" res
     assertOutputContains "  -fdefer-typed-holes" res
+
   cabalTest' "single-repl-options-multiple-flags-negative" $ do
     cabal' "clean" []
     res <- fails $ cabalWithStdin "v2-repl" ["--repl-options=-fwrite-interface -fdiagnostics-show-baret"] ":set"
     assertOutputDoesNotContain "Ok, two modules loaded." res
     assertOutputContains "unrecognised flag: -fdiagnostics-show-baret" res
     assertOutputContains "did you mean one of:" res
+
   cabalTest' "multiple-repl-options-multiple-flags" $ do
     cabal' "clean" []
     res <- cabalWithStdin "v2-repl" [

cabal-testsuite/PackageTests/ReplProjectNoneTarget/cabal.out

@@ -0,0 +1,2 @@
+# checking repl command with a missing project
+# cabal repl

cabal-testsuite/PackageTests/ReplProjectNoneTarget/cabal.test.hs

@@ -0,0 +1,18 @@
+import Test.Cabal.Prelude
+
+main = cabalTest . recordMode RecordMarked $ do
+  let log = recordHeader . pure
+
+  -- Triggers "Assertion failed"
+  -- log "checking repl command with no project and --ignore-project"
+  -- _ <- fails $ cabal' "repl" ["--ignore-project"]
+
+  -- Triggers "Assertion failed"
+  -- log "checking repl command with no project and no project options"
+  -- _ <- fails $ cabal' "repl" []
+
+  log "checking repl command with a missing project"
+  missing <- fails $ cabal' "repl" [ "--project-file=missing.project" ]
+  assertOutputContains "The given project file 'missing.project' does not exist." missing
+
+  return ()

cabal-testsuite/PackageTests/ReplProjectNoneTarget/pkg-one/pkg-one.cabal

@@ -0,0 +1,9 @@
+name:           pkg-one
+version:        0.1
+license:        BSD3
+cabal-version:  >= 1.2
+build-type:     Simple
+
+library
+    exposed-modules:    Foo
+    build-depends:      base

cabal-testsuite/PackageTests/ReplProjectNoneTarget/pkg-two/pkg-one.cabal

@@ -0,0 +1,9 @@
+name:           pkg-one
+version:        0.1
+license:        BSD3
+cabal-version:  >= 1.2
+build-type:     Simple
+
+library
+    exposed-modules:    Foo
+    build-depends:      base

cabal-testsuite/PackageTests/ReplProjectTarget/cabal.out

@@ -0,0 +1,26 @@
+# checking repl command with a 'cabal.project' and no project options
+# cabal repl
+Error: [Cabal-7076]
+Please pick a single [package:][ctype:]component as target for the REPL command. The packages from which to select a component in 'cabal.project', the implicit default as if `--project-file=cabal.project` was added as a command option, are:
+ - pkg-one
+ - pkg-two
+# checking repl command using an explicit 'some.project'
+# cabal repl
+Error: [Cabal-7076]
+Please pick a single [package:][ctype:]component as target for the REPL command. The packages in 'some.project' from which to select a component target are:
+ - pkg-one
+ - pkg-two
+# checking repl command using an explicit 'reverse.project', listing packages in reverse order
+# cabal repl
+Error: [Cabal-7076]
+Please pick a single [package:][ctype:]component as target for the REPL command. The packages in 'reverse.project' from which to select a component target are:
+ - pkg-one
+ - pkg-two
+# checking repl command with an 'empty.project' with no packages
+# cabal repl
+Warning: There are no packages or optional-packages in the project
+Resolving dependencies...
+# checking repl command with a missing 'missing.project'
+# cabal repl
+# checking repl command with a missing 'missing.project'
+# cabal repl

cabal-testsuite/PackageTests/ReplProjectTarget/cabal.project

@@ -0,0 +1 @@
+packages: pkg-one pkg-two

cabal-testsuite/PackageTests/ReplProjectTarget/cabal.test.hs

@@ -0,0 +1,44 @@
+import Test.Cabal.Prelude
+import Data.List (isInfixOf)
+
+main = cabalTest . recordMode RecordMarked $ do
+  let log = recordHeader . pure
+
+  -- This triggers "Assertion failed" with backtrace to TemTestDir.hs:37:3
+  -- log "checking repl command with a 'cabal.project' and --ignore-project"
+  -- ignored <- cabal' "repl" ["--ignore-project"]
+
+  log "checking repl command with a 'cabal.project' and no project options"
+  defaultProject <- fails $ cabal' "repl" []
+
+  readFileVerbatim "default-repl.txt"
+    >>= flip (assertOn isInfixOf multilineNeedleHaystack) defaultProject . normalizePathSeparators
+
+  log "checking repl command using an explicit 'some.project'"
+  someProject <- fails $ cabal' "repl" [ "--project-file=some.project" ]
+
+  readFileVerbatim "some-repl.txt"
+    >>= flip (assertOn isInfixOf multilineNeedleHaystack) someProject . normalizePathSeparators
+
+  log "checking repl command using an explicit 'reverse.project', listing packages in reverse order"
+  reverseProject <- fails $ cabal' "repl" [ "--project-file=reverse.project" ]
+
+  readFileVerbatim "reverse-repl.txt"
+    >>= flip (assertOn isInfixOf multilineNeedleHaystack) reverseProject . normalizePathSeparators
+
+  log "checking repl command with an 'empty.project' with no packages"
+  emptyProject <- fails $ cabal' "repl" [ "--project-file=empty.project" ]
+
+  log "checking repl command with a missing 'missing.project'"
+  missing <- fails $ cabal' "repl" [ "--project-file=missing.project" ]
+  assertOutputContains "The given project file 'missing.project' does not exist." missing
+
+  log "checking repl command with a missing 'missing.project'"
+  dotMissing <- fails $ cabal' "repl" [ "--project-dir=.", "--project-file=missing.project" ]
+  assertOutputContains "The given project directory/file combination './missing.project' does not exist." dotMissing
+
+  -- This triggers "Assertion failed" with backtrace to TemTestDir.hs:37:3
+  -- log "checking repl command with a single package in 'one.project'"
+  -- oneProject <- cabal' "repl" [ "--project-file=one.project" ]
+
+  return ()