Add '--repl-no-load' option to skip module load in REPL (#7578)

* Add '--repl-no-load' option to skip module load in REPL * Command docs * Add tests * update changelog Co-authored-by: Stuart Popejoy <[email protected]>
haskell · Aug 29, 2021 · 785ea62 · 785ea62
1 parent 7d4ce47
commit 785ea62
Show file tree

Hide file tree

Showing 19 changed files with 155 additions and 34 deletions.
diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs
@@ -386,7 +386,7 @@ addExtraAsmSources bi extras = bi { asmSources = new }
         exs = Set.fromList extras
 
 
-replComponent :: [String]
+replComponent :: ReplOptions
               -> Verbosity
               -> PackageDescription
               -> LocalBuildInfo
@@ -645,27 +645,27 @@ buildExe verbosity numJobs pkg_descr lbi exe clbi =
     UHC   -> UHC.buildExe   verbosity         pkg_descr lbi exe clbi
     _     -> die' verbosity "Building is not supported with this compiler."
 
-replLib :: [String]        -> Verbosity -> PackageDescription
+replLib :: ReplOptions     -> Verbosity -> PackageDescription
         -> LocalBuildInfo  -> Library   -> ComponentLocalBuildInfo
         -> IO ()
 replLib replFlags verbosity pkg_descr lbi lib clbi =
   case compilerFlavor (compiler lbi) of
     -- 'cabal repl' doesn't need to support 'ghc --make -j', so we just pass
     -- NoFlag as the numJobs parameter.
     GHC   -> GHC.replLib   replFlags verbosity NoFlag pkg_descr lbi lib clbi
-    GHCJS -> GHCJS.replLib replFlags verbosity NoFlag pkg_descr lbi lib clbi
+    GHCJS -> GHCJS.replLib (replOptionsFlags replFlags) verbosity NoFlag pkg_descr lbi lib clbi
     _     -> die' verbosity "A REPL is not supported for this compiler."
 
-replExe :: [String]        -> Verbosity  -> PackageDescription
+replExe :: ReplOptions     -> Verbosity  -> PackageDescription
         -> LocalBuildInfo  -> Executable -> ComponentLocalBuildInfo
         -> IO ()
 replExe replFlags verbosity pkg_descr lbi exe clbi =
   case compilerFlavor (compiler lbi) of
     GHC   -> GHC.replExe   replFlags verbosity NoFlag pkg_descr lbi exe clbi
-    GHCJS -> GHCJS.replExe replFlags verbosity NoFlag pkg_descr lbi exe clbi
+    GHCJS -> GHCJS.replExe (replOptionsFlags replFlags) verbosity NoFlag pkg_descr lbi exe clbi
     _     -> die' verbosity "A REPL is not supported for this compiler."
 
-replFLib :: [String]        -> Verbosity  -> PackageDescription
+replFLib :: ReplOptions     -> Verbosity  -> PackageDescription
          -> LocalBuildInfo  -> ForeignLib -> ComponentLocalBuildInfo
          -> IO ()
 replFLib replFlags verbosity pkg_descr lbi exe clbi =

diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs
@@ -493,13 +493,13 @@ buildLib :: Verbosity          -> Cabal.Flag (Maybe Int)
          -> Library            -> ComponentLocalBuildInfo -> IO ()
 buildLib = buildOrReplLib Nothing
 
-replLib :: [String]                -> Verbosity
+replLib :: ReplOptions             -> Verbosity
         -> Cabal.Flag (Maybe Int)  -> PackageDescription
         -> LocalBuildInfo          -> Library
         -> ComponentLocalBuildInfo -> IO ()
 replLib = buildOrReplLib . Just
 
-buildOrReplLib :: Maybe [String] -> Verbosity
+buildOrReplLib :: Maybe ReplOptions -> Verbosity
                -> Cabal.Flag (Maybe Int) -> PackageDescription
                -> LocalBuildInfo -> Library
                -> ComponentLocalBuildInfo -> IO ()
@@ -609,8 +609,9 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do
       replOpts    = vanillaOpts {
                       ghcOptExtra        = Internal.filterGhciFlags
                                            (ghcOptExtra vanillaOpts)
-                                           <> replFlags,
-                      ghcOptNumJobs      = mempty
+                                           <> replOptionsFlags replFlags,
+                      ghcOptNumJobs      = mempty,
+                      ghcOptInputModules = replNoLoad replFlags (ghcOptInputModules vanillaOpts)
                     }
                     `mappend` linkerOpts
                     `mappend` mempty {
@@ -969,7 +970,7 @@ buildFLib
 buildFLib v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildFLib
 
 replFLib
-  :: [String]                -> Verbosity
+  :: ReplOptions             -> Verbosity
   -> Cabal.Flag (Maybe Int)  -> PackageDescription
   -> LocalBuildInfo          -> ForeignLib
   -> ComponentLocalBuildInfo -> IO ()
@@ -985,7 +986,7 @@ buildExe
 buildExe v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildExe
 
 replExe
-  :: [String]                -> Verbosity
+  :: ReplOptions             -> Verbosity
   -> Cabal.Flag (Maybe Int)  -> PackageDescription
   -> LocalBuildInfo          -> Executable
   -> ComponentLocalBuildInfo -> IO ()
@@ -997,9 +998,9 @@ replExe replFlags v njobs pkg lbi =
 -- 'GBuildMode' distinguishes between the various kinds of operation.
 data GBuildMode =
     GBuildExe  Executable
-  | GReplExe   [String] Executable
+  | GReplExe   ReplOptions Executable
   | GBuildFLib ForeignLib
-  | GReplFLib  [String] ForeignLib
+  | GReplFLib  ReplOptions ForeignLib
 
 gbuildInfo :: GBuildMode -> BuildInfo
 gbuildInfo (GBuildExe  exe)  = buildInfo exe
@@ -1265,6 +1266,11 @@ gbuildSources verbosity specVer tmpDir bm =
     isCxx :: FilePath -> Bool
     isCxx fp = elem (takeExtension fp) [".cpp", ".cxx", ".c++"]
 
+replNoLoad :: Ord a => ReplOptions -> NubListR a -> NubListR a
+replNoLoad replFlags l
+    | replOptionsNoLoad replFlags == Flag True = mempty
+    | otherwise                                = l
+
 -- | Generic build function. See comment for 'GBuildMode'.
 gbuild :: Verbosity          -> Cabal.Flag (Maybe Int)
        -> PackageDescription -> LocalBuildInfo
@@ -1383,7 +1389,9 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
       replOpts   = baseOpts {
                     ghcOptExtra            = Internal.filterGhciFlags
                                              (ghcOptExtra baseOpts)
-                                             <> replFlags
+                                             <> replOptionsFlags replFlags,
+                    ghcOptInputModules     = replNoLoad replFlags (ghcOptInputModules baseOpts),
+                    ghcOptInputFiles       = replNoLoad replFlags (ghcOptInputFiles baseOpts)
                    }
                    -- For a normal compile we do separate invocations of ghc for
                    -- compiling as for linking. But for repl we have to do just

diff --git a/Cabal/src/Distribution/Simple/Setup.hs b/Cabal/src/Distribution/Simple/Setup.hs
@@ -47,6 +47,7 @@ module Distribution.Simple.Setup (
   BuildFlags(..),    emptyBuildFlags,    defaultBuildFlags,    buildCommand,
   ShowBuildInfoFlags(..),                defaultShowBuildFlags, showBuildInfoCommand,
   ReplFlags(..),                         defaultReplFlags,     replCommand,
+  ReplOptions(..),
   CleanFlags(..),    emptyCleanFlags,    defaultCleanFlags,    cleanCommand,
   RegisterFlags(..), emptyRegisterFlags, defaultRegisterFlags, registerCommand,
                                                                unregisterCommand,
@@ -1665,13 +1666,30 @@ instance Semigroup BuildFlags where
 -- * REPL Flags
 -- ------------------------------------------------------------
 
+data ReplOptions = ReplOptions {
+    replOptionsFlags :: [String],
+    replOptionsNoLoad :: Flag Bool
+  }
+  deriving (Show, Generic, Typeable)
+
+instance Binary ReplOptions
+instance Structured ReplOptions
+
+
+instance Monoid ReplOptions where
+  mempty = ReplOptions mempty (Flag False)
+  mappend = (<>)
+
+instance Semigroup ReplOptions where
+  (<>) = gmappend
+
 data ReplFlags = ReplFlags {
     replProgramPaths :: [(String, FilePath)],
     replProgramArgs :: [(String, [String])],
     replDistPref    :: Flag FilePath,
     replVerbosity   :: Flag Verbosity,
     replReload      :: Flag Bool,
-    replReplOptions :: [String]
+    replReplOptions :: ReplOptions
   }
   deriving (Show, Generic, Typeable)
 
@@ -1682,7 +1700,7 @@ defaultReplFlags  = ReplFlags {
     replDistPref    = NoFlag,
     replVerbosity   = Flag normal,
     replReload      = Flag False,
-    replReplOptions = []
+    replReplOptions = mempty
   }
 
 instance Monoid ReplFlags where
@@ -1763,9 +1781,17 @@ replCommand progDb = CommandUI
   where
     liftReplOption = liftOption replReplOptions (\v flags -> flags { replReplOptions = v })
 
-replOptions :: ShowOrParseArgs -> [OptionField [String]]
-replOptions _ = [ option [] ["repl-options"] "use this option for the repl" id
-              const (reqArg "FLAG" (succeedReadE (:[])) id) ]
+replOptions :: ShowOrParseArgs -> [OptionField ReplOptions]
+replOptions _ =
+  [ option [] ["repl-no-load"]
+    "Disable loading of project modules at REPL startup."
+    replOptionsNoLoad (\p flags -> flags { replOptionsNoLoad = p })
+    trueArg
+  , option [] ["repl-options"]
+    "use this option for the repl"
+    replOptionsFlags (\p flags -> flags { replOptionsFlags = p ++ replOptionsFlags flags })
+    (reqArg "FLAG" (succeedReadE (:[])) id)
+  ]
 
 -- ------------------------------------------------------------
 -- * Test flags

diff --git a/cabal-install/src/Distribution/Client/CmdRepl.hs b/cabal-install/src/Distribution/Client/CmdRepl.hs
@@ -52,7 +52,7 @@ import qualified Distribution.Client.Setup as Client
 import Distribution.Client.Types
          ( PackageLocation(..), PackageSpecifier(..), UnresolvedSourcePackage )
 import Distribution.Simple.Setup
-         ( fromFlagOrDefault, replOptions
+         ( fromFlagOrDefault, ReplOptions(..), replOptions
          , Flag(..), toFlag, falseArg )
 import Distribution.Simple.Command
          ( CommandUI(..), liftOptionL, usageAlternatives, option
@@ -111,8 +111,6 @@ import System.Directory
 import System.FilePath
          ( (</>) )
 
-type ReplFlags = [String]
-
 data EnvFlags = EnvFlags
   { envPackages :: [Dependency]
   , envIncludeTransitive :: Flag Bool
@@ -142,7 +140,7 @@ envOptions _ =
         ("couldn't parse dependencies: " ++)
         (parsecCommaList parsec)
 
-replCommand :: CommandUI (NixStyleFlags (ReplFlags, EnvFlags))
+replCommand :: CommandUI (NixStyleFlags (ReplOptions, EnvFlags))
 replCommand = Client.installCommand {
   commandName         = "v2-repl",
   commandSynopsis     = "Open an interactive session for the given component.",
@@ -179,7 +177,7 @@ replCommand = Client.installCommand {
      ++ "    add a version (constrained between 4.15 and 4.18) of the library 'lens' "
         ++ "to the default component (or no component if there is no project present)\n",
 
-  commandDefaultFlags = defaultNixStyleFlags ([], defaultEnvFlags),
+  commandDefaultFlags = defaultNixStyleFlags (mempty, defaultEnvFlags),
   commandOptions = nixStyleOptions $ \showOrParseArgs ->
     map (liftOptionL _1) (replOptions showOrParseArgs) ++
     map (liftOptionL _2) (envOptions showOrParseArgs)
@@ -196,7 +194,7 @@ replCommand = Client.installCommand {
 -- For more details on how this works, see the module
 -- "Distribution.Client.ProjectOrchestration"
 --
-replAction :: NixStyleFlags (ReplFlags, EnvFlags) -> [String] -> GlobalFlags -> IO ()
+replAction :: NixStyleFlags (ReplOptions, EnvFlags) -> [String] -> GlobalFlags -> IO ()
 replAction flags@NixStyleFlags { extraFlags = (replFlags, envFlags), ..} targetStrings globalFlags = do
     let
       with           = withProject    cliConfig             verbosity targetStrings
@@ -286,8 +284,9 @@ replAction flags@NixStyleFlags { extraFlags = (replFlags, envFlags), ..} targetS
 
     let buildCtx' = buildCtx
           { elaboratedShared = (elaboratedShared buildCtx)
-                { pkgConfigReplOptions = replFlags ++ replFlags'' }
-          }
+            { pkgConfigReplOptions = replFlags
+              { replOptionsFlags = (replOptionsFlags replFlags) ++ replFlags''
+          } } }
     printPlan verbosity baseCtx' buildCtx'
 
     buildOutcomes <- runProjectBuildPhase verbosity baseCtx' buildCtx'
@@ -415,7 +414,7 @@ addDepsToProjectTarget deps pkgId ctx =
         }
     addDeps spec = spec
 
-generateReplFlags :: Bool -> ElaboratedInstallPlan -> OriginalComponentInfo -> ReplFlags
+generateReplFlags :: Bool -> ElaboratedInstallPlan -> OriginalComponentInfo -> [String]
 generateReplFlags includeTransitive elaboratedPlan OriginalComponentInfo{..} = flags
   where
     exeDeps :: [UnitId]
@@ -425,7 +424,7 @@ generateReplFlags includeTransitive elaboratedPlan OriginalComponentInfo{..} = f
         (InstallPlan.dependencyClosure elaboratedPlan [ociUnitId])
 
     deps, deps', trans, trans' :: [UnitId]
-    flags :: ReplFlags
+    flags :: [String]
     deps   = installedUnitId <$> InstallPlan.directDeps elaboratedPlan ociUnitId
     deps'  = deps \\ ociOriginalDeps
     trans  = installedUnitId <$> InstallPlan.dependencyClosure elaboratedPlan deps'

diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -1283,7 +1283,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
         pkgConfigPlatform      = platform,
         pkgConfigCompiler      = compiler,
         pkgConfigCompilerProgs = compilerprogdb,
-        pkgConfigReplOptions   = []
+        pkgConfigReplOptions   = mempty
       }
 
     preexistingInstantiatedPkgs =

diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
@@ -95,7 +95,7 @@ import           Distribution.Simple.LocalBuildInfo
                    ( ComponentName(..), LibraryName(..) )
 import qualified Distribution.Simple.InstallDirs as InstallDirs
 import           Distribution.Simple.InstallDirs (PathTemplate)
-import           Distribution.Simple.Setup (HaddockTarget, TestShowDetails)
+import           Distribution.Simple.Setup (HaddockTarget, TestShowDetails, ReplOptions)
 import           Distribution.Version
 
 import qualified Distribution.Solver.Types.ComponentDeps as CD
@@ -147,7 +147,7 @@ data ElaboratedSharedConfig
        -- ghc & ghc-pkg). Once constructed, only the 'configuredPrograms' are
        -- used.
        pkgConfigCompilerProgs :: ProgramDb,
-       pkgConfigReplOptions :: [String]
+       pkgConfigReplOptions :: ReplOptions
      }
   deriving (Show, Generic, Typeable)
   --TODO: [code cleanup] no Eq instance

diff --git a/cabal-testsuite/PackageTests/ReplNoLoad/ModuleA.hs b/cabal-testsuite/PackageTests/ReplNoLoad/ModuleA.hs
@@ -0,0 +1,4 @@
+module ModuleA where
+
+a :: Int
+a = 42
diff --git a/cabal-testsuite/PackageTests/ReplNoLoad/ModuleB.hs b/cabal-testsuite/PackageTests/ReplNoLoad/ModuleB.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import ModuleC
+
+main :: IO ()
+main = print c
diff --git a/cabal-testsuite/PackageTests/ReplNoLoad/ModuleC.hs b/cabal-testsuite/PackageTests/ReplNoLoad/ModuleC.hs
@@ -0,0 +1,4 @@
+module ModuleC where
+
+c :: Int
+c = 42
diff --git a/cabal-testsuite/PackageTests/ReplNoLoad/cabal-repl-no-load.cabal b/cabal-testsuite/PackageTests/ReplNoLoad/cabal-repl-no-load.cabal
@@ -0,0 +1,15 @@
+name: cabal-repl-no-load
+version: 0.1
+build-type: Simple
+cabal-version: >= 1.10
+
+library
+  exposed-modules: ModuleA
+  build-depends: base
+  default-language: Haskell2010
+
+executable exec
+  main-is: ModuleB.hs
+  other-modules: ModuleC
+  build-depends: base
+  default-language: Haskell2010
diff --git a/cabal-testsuite/PackageTests/ReplNoLoad/cabal.exec-no-load.out b/cabal-testsuite/PackageTests/ReplNoLoad/cabal.exec-no-load.out
@@ -0,0 +1,8 @@
+# cabal clean
+# cabal repl
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following will be built:
+ - cabal-repl-no-load-0.1 (lib) (first run)
+Configuring library for cabal-repl-no-load-0.1..
+Preprocessing library for cabal-repl-no-load-0.1..
diff --git a/cabal-testsuite/PackageTests/ReplNoLoad/cabal.exec-normal.out b/cabal-testsuite/PackageTests/ReplNoLoad/cabal.exec-normal.out
@@ -0,0 +1,8 @@
+# cabal clean
+# cabal repl
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following will be built:
+ - cabal-repl-no-load-0.1 (exe:exec) (first run)
+Configuring executable 'exec' for cabal-repl-no-load-0.1..
+Preprocessing executable 'exec' for cabal-repl-no-load-0.1..
diff --git a/cabal-testsuite/PackageTests/ReplNoLoad/cabal.lib-no-load.out b/cabal-testsuite/PackageTests/ReplNoLoad/cabal.lib-no-load.out
@@ -0,0 +1,8 @@
+# cabal clean
+# cabal repl
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following will be built:
+ - cabal-repl-no-load-0.1 (lib) (first run)
+Configuring library for cabal-repl-no-load-0.1..
+Preprocessing library for cabal-repl-no-load-0.1..
diff --git a/cabal-testsuite/PackageTests/ReplNoLoad/cabal.lib-normal.out b/cabal-testsuite/PackageTests/ReplNoLoad/cabal.lib-normal.out
@@ -0,0 +1,8 @@
+# cabal clean
+# cabal repl
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following will be built:
+ - cabal-repl-no-load-0.1 (lib) (first run)
+Configuring library for cabal-repl-no-load-0.1..
+Preprocessing library for cabal-repl-no-load-0.1..
diff --git a/cabal-testsuite/PackageTests/ReplNoLoad/cabal.project b/cabal-testsuite/PackageTests/ReplNoLoad/cabal.project
@@ -0,0 +1 @@
+packages: .
diff --git a/cabal-testsuite/PackageTests/ReplNoLoad/cabal.test.hs b/cabal-testsuite/PackageTests/ReplNoLoad/cabal.test.hs
@@ -0,0 +1,19 @@
+import Test.Cabal.Prelude
+
+main = do
+  cabalTest' "lib-normal" $ do
+    cabal' "clean" []
+    res <- cabalWithStdin "repl" [] ":show modules"
+    assertOutputContains "Ok, one module loaded." res
+  cabalTest' "lib-no-load" $ do
+    cabal' "clean" []
+    res <- cabalWithStdin "repl" ["--repl-no-load"] ":show modules"
+    assertOutputDoesNotContain "Ok, one module loaded." res
+  cabalTest' "exec-normal" $ do
+    cabal' "clean" []
+    res <- cabalWithStdin "repl" ["exec"] ":show modules"
+    assertOutputContains "Ok, two modules loaded." res
+  cabalTest' "exec-no-load" $ do
+    cabal' "clean" []
+    res <- cabalWithStdin "repl" ["--repl-no-load"] ":show modules"
+    assertOutputDoesNotContain "Ok, two modules loaded." res
diff --git a/cabal-testsuite/src/Test/Cabal/Monad.hs b/cabal-testsuite/src/Test/Cabal/Monad.hs
@@ -6,6 +6,7 @@ module Test.Cabal.Monad (
     setupAndCabalTest,
     setupTest,
     cabalTest,
+    cabalTest',
     -- * The monad
     TestM,
     runTestM,

diff --git a/changelog.d/issue-7541 b/changelog.d/issue-7541
@@ -0,0 +1,4 @@
+synopsis: '--repl-no-load' option skips startup modules load in REPL
+issues: #7541
+packages: Cabal cabal-install
+prs: #7578