Update tests, adding more assertions

- Improve test descriptions
- Mention [package:][ctype:]component
- Don't repeat [package:][ctype:]component
- Lift validatedTargets, rename r as replFlags
- Don't use -XRecordWildCards for configFlags
- Add a one.project one pkg test
- Remove target string manipulation
- Make reportProjectNoTarget a function
- Redo ReplProjectTarget tests
- Redo ReplProjectNoneTarget tests
- Satisfy fix-whitespace
- Error whether or not project has packages
- Guard against triggering an assertion if targets are null

Author: philderbeast

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
@@ -157,7 +158,6 @@ import Distribution.Utils.Generic
 import Distribution.Verbosity
   ( lessVerbose
   , normal
-  , silent
   )
 import Language.Haskell.Extension
   ( Language (..)
@@ -197,7 +197,6 @@ import System.FilePath
   , (</>)
   )
 import Text.PrettyPrint hiding ((<>))
-import qualified Text.PrettyPrint as Pretty
 
 replCommand :: CommandUI (NixStyleFlags ReplFlags)
 replCommand =
@@ -284,22 +283,7 @@ 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 = do
-  -- NOTE: 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 behaviour when the package is somewhere else we adjust the targets.
-  targetStrings <-
-    if null targetStrings'
-      then withCtx silent targetStrings' $ \targetCtx ctx _ ->
-        return . fromMaybe [] $ case targetCtx of
-          ProjectContext ->
-            let pkgs = projectPackages $ projectConfig ctx
-             in if length pkgs == 1
-                  then pure <$> listToMaybe pkgs
-                  else Nothing
-          _ -> Nothing
-      else return targetStrings'
-
+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
@@ -308,25 +292,11 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings'
 
     baseCtx <- case targetCtx of
       ProjectContext -> do
-        let pkgs = projectPackages $ projectConfig ctx
-        when (null targetStrings && length pkgs /= 1) $
-          let singleTarget = text "With a project, the REPL command requires a single target"
-              project = case projectConfigProjectFile . projectConfigShared $ projectConfig ctx of
-                Flag projectName -> comma <+> (quotes (text projectName))
-                _ -> Pretty.empty
-              msg =
-                if null pkgs
-                  then
-                    (singleTarget <> comma)
-                      <+> (text "but there are no packages in this project" <> project <> comma)
-                      <+> text "to choose a package (library) or other component from"
-                      <+> "as the target for this command."
-                  else
-                    (singleTarget <> (char '.'))
-                      <+> (text "The packages in this project" <> project <> comma)
-                      <+> (text "are" <> colon)
-                      $+$ nest 1 (vcat [text "-" <+> text pkg | pkg <- sort pkgs])
-           in dieWithException verbosity $ RenderReplTargetProblem [render msg]
+        when (null targetSelectors) $ do
+          let projectFile = projectConfigProjectFile . projectConfigShared $ projectConfig ctx
+          let pkgs = projectPackages $ projectConfig ctx
+          dieWithException verbosity $
+            RenderReplTargetProblem [render (reportProjectNoTarget projectFile pkgs)]
         return ctx
       GlobalContext -> do
         unless (null targetStrings) $
@@ -398,7 +368,7 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings'
         -- 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
@@ -422,14 +392,19 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings'
         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' =
-            pruneInstallPlanToTargets
-              TargetActionRepl
-              targets
-              elaboratedPlan
+            -- Guard against pruning with empty targets and failing an assertion
+            -- within pruneInstallPlanToTargets.
+            if null targets
+              then elaboratedPlan
+              else
+                pruneInstallPlanToTargets
+                  TargetActionRepl
+                  targets
+                  elaboratedPlan
           includeTransitive = fromFlagOrDefault True (envIncludeTransitive replEnvFlags)
 
         pkgsBuildStatus <-
@@ -561,28 +536,7 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings'
     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
@@ -595,6 +549,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/cabal.alt-multiple-repl-options.out

@@ -1,10 +1,5 @@
 # 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...
+Error: [Cabal-7076]
+Please pick a single [package:][ctype:]component as target for the REPL command. The packages in 'alt.project' from which to select a component target are:
+ - alt

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

@@ -1,10 +1,5 @@
 # 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...
+Error: [Cabal-7076]
+Please pick a single [package:][ctype:]component as target for the REPL command. The packages in 'alt.project' from which to select a component target are:
+ - alt

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

@@ -13,7 +13,7 @@ main = do
   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"
+    void . fails $ cabalWithStdin "v2-repl" (altProject singleOpts) ":set"
 
   cabalTest' "multiple-repl-options" $ do
     cabal' "clean" []
@@ -25,7 +25,7 @@ main = do
   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"
+    void . fails $ cabalWithStdin "v2-repl" (altProject multiOpts) ":set"
 
   cabalTest' "single-repl-options-multiple-flags" $ do
     cabal' "clean" []

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

@@ -1,33 +1,27 @@
-# checking repl command with a project using an implicit default 'cabal.project'
+# checking repl command with a 'cabal.project' and no project options
 # cabal repl
-Configuration is affected by the following files:
-- cabal.project
 Error: [Cabal-7076]
-With a project, the REPL command requires a single target. The packages in this project are:
+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 with a project using an explicit 'cabal.project'
+# checking repl command using an explicit 'some.project'
 # cabal repl
-Configuration is affected by the following files:
-- some.project
 Error: [Cabal-7076]
-With a project, the REPL command requires a single target. The packages in this project, 'some.project', are:
+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 with a project listing packages in reverse order
+# checking repl command using an explicit 'reverse.project', listing packages in reverse order
 # cabal repl
-Configuration is affected by the following files:
-- reverse.project
 Error: [Cabal-7076]
-With a project, the REPL command requires a single target. The packages in this project, 'reverse.project', are:
+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 a project with no packages
+# checking repl command with an 'empty.project' with no packages
 # cabal repl
-Configuration is affected by the following files:
-- empty.project
 Warning: There are no packages or optional-packages in the project
 Error: [Cabal-7076]
-With a project, the REPL command requires a single target but there are no packages in this project, 'empty.project', to choose a package (library) or other component from as the target for this command.
-# checking repl command with a missing project
+There are no packages in 'empty.project'. Please add a package to the project and pick a single [package:][ctype:]component as target for the REPL command.
+# checking repl command with a missing 'missing.project'
+# cabal repl
+# checking repl command with a missing 'missing.project'
 # cabal repl