'stack ghci': build project before launching GHCi (closes #1065, fixes …

…#1180) Optimistically, launch GHCi anyway even if the build fails.
commercialhaskell · Oct 25, 2015 · a612c11 · a612c11
1 parent b6c5233
commit a612c11
Show file tree

Hide file tree

Showing 6 changed files with 39 additions and 19 deletions.
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -13,11 +13,13 @@ Other enhancements:
 * Added a `stack config set resolver RESOLVER` command. Part of work on [#115](https://github.com/commercialhaskell/stack/issues/115)
 * `stack setup` can now install GHCJS on windows.  See [#1145](https://github.com/commercialhaskell/stack/issues/1145) and [#749](https://github.com/commercialhaskell/stack/issues/749)
 * `stack hpc report` command added, which generates reports for HPC tix files
+* `stack ghci` builds the project before launching GHCi.  If the build fails, optimistically launch GHCi anyway [#1065](https://github.com/commercialhaskell/stack/issues/1065)
 
 Bug fixes:
 
-* Haddocks not copied for dependencies [#1105](https://github.com/commercialhaskell/stack/issues/1105)
+* Fix: Haddocks not copied for dependencies [#1105](https://github.com/commercialhaskell/stack/issues/1105)
 * Rebuild when cabal file is changed
+* Fix: 'stack ghci' doesn't notice that a module got deleted [#1180](https://github.com/commercialhaskell/stack/issues/1180)
 
 ## v0.1.6.0
 

diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs
@@ -10,6 +10,7 @@
 module Stack.Ghci (GhciOpts(..),GhciPkgInfo(..), ghciSetup, ghci) where
 
 import           Control.Monad.Catch
+import           Control.Exception.Enclosed (tryAny)
 import           Control.Monad.IO.Class
 import           Control.Monad.Logger
 import           Control.Monad.Reader
@@ -47,6 +48,7 @@ data GhciOpts = GhciOpts
     ,ghciNoLoadModules      :: !Bool
     ,ghciAdditionalPackages :: ![String]
     ,ghciMainIs             :: !(Maybe Text)
+    ,ghciBuildFirst         :: !(Maybe BuildSubset)
     } deriving (Show,Eq)
 
 -- | Necessary information to load a package or its components.
@@ -67,7 +69,7 @@ ghci
     :: (HasConfig r, HasBuildConfig r, HasHttpManager r, MonadMask m, HasLogLevel r, HasTerminal r, HasEnvConfig r, MonadReader r m, MonadIO m, MonadThrow m, MonadLogger m, MonadCatch m, MonadBaseControl IO m)
     => GhciOpts -> m ()
 ghci GhciOpts{..} = do
-    (targets,mainIsTargets,pkgs) <- ghciSetup ghciMainIs ghciTargets
+    (targets,mainIsTargets,pkgs) <- ghciSetup ghciBuildFirst ghciMainIs ghciTargets
     bconfig <- asks getBuildConfig
     mainFile <- figureOutMainFile mainIsTargets targets pkgs
     wc <- getWhichCompiler
@@ -154,10 +156,11 @@ figureOutMainFile mainIsTargets targets0 packages = do
 -- information to load that package/components.
 ghciSetup
     :: (HasConfig r, HasHttpManager r, HasBuildConfig r, MonadMask m, HasTerminal r, HasLogLevel r, HasEnvConfig r, MonadReader r m, MonadIO m, MonadThrow m, MonadLogger m, MonadCatch m, MonadBaseControl IO m)
-    => Maybe Text
+    => Maybe BuildSubset
+    -> Maybe Text
     -> [Text]
     -> m (Map PackageName SimpleTarget, Maybe (Map PackageName SimpleTarget), [GhciPkgInfo])
-ghciSetup mainIs stringTargets = do
+ghciSetup mbuildFirst mainIs stringTargets = do
     (_,_,targets) <-
         parseTargetsFromBuildOpts
             AllowNoTargets
@@ -198,11 +201,21 @@ ghciSetup mainIs stringTargets = do
                                  return (Just (name, (cabalfp, simpleTargets)))
                              Nothing -> return Nothing
                     else return Nothing
+    -- Try to build, but optimistically launch GHCi anyway if it fails (#1065)
+    case (mbuildFirst, M.null realTargets) of
+        (Just _, False) -> do
+            eres <- tryAny $ build (const (return ())) Nothing bopts
+            case eres of
+                Left err -> do
+                    $logError $ T.pack (show err)
+                    $logWarn "Warning: build failed, but optimistically launching GHCi anyway"
+                Right () -> return ()
+        _ -> return ()
+    -- Load the list of modules _after_ building, to catch changes in unlisted dependencies (#1180)
     infos <-
         forM locals $
         \(name,(cabalfp,components)) ->
              makeGhciPkgInfo sourceMap installedMap (map fst locals) name cabalfp components
-    unless (M.null realTargets) (build (const (return ())) Nothing bopts)
     return (realTargets, mainIsTargets, infos)
   where
     makeBuildOpts targets =
@@ -217,7 +230,7 @@ ghciSetup mainIs stringTargets = do
         , boptsBenchmarkOpts = (boptsBenchmarkOpts base)
           { beoDisableRun = True
           }
-        , boptsBuildSubset = BSOnlyDependencies
+        , boptsBuildSubset = fromMaybe BSAll mbuildFirst
         }
       where
         base = defaultBuildOpts

diff --git a/src/Stack/Ide.hs b/src/Stack/Ide.hs
@@ -43,7 +43,7 @@ ide
     -> [String] -- ^ GHC options.
     -> m ()
 ide targets useropts = do
-    (_realTargets,_,pkgs) <- ghciSetup Nothing targets
+    (_realTargets,_,pkgs) <- ghciSetup (Just BSAll) Nothing targets
     pwd <- getWorkingDir
     (pkgopts,_srcfiles) <-
         liftM mconcat $ forM pkgs $ getPackageOptsAndTargetFiles pwd

diff --git a/src/Stack/Options.hs b/src/Stack/Options.hs
@@ -143,16 +143,10 @@ buildOptsParser cmd =
              help "Fetch packages necessary for the build immediately, useful with --dry-run")
 
         buildSubset =
-            flag' BSOnlySnapshot
-                (long "only-snapshot" <>
-                 help "Only build packages for the snapshot database, not the local database")
-            <|> flag' BSOnlyDependencies
-                (long "only-dependencies" <>
-                 help "Only build packages that are dependencies of targets on the command line")
-            <|> flag' BSOnlyDependencies
+            flag' BSOnlyDependencies
                 (long "dependencies-only" <>
                  help "A synonym for --only-dependencies")
-            <|> pure BSAll
+            <|> buildSubsetParser "" ""
 
         fileWatch' =
             flag' FileWatch
@@ -464,8 +458,7 @@ ghciOptsParser = GhciOpts
                      (strOption (long "with-ghc" <>
                                  metavar "GHC" <>
                                  help "Use this command for the GHC to run"))
-             <*> switch (long "no-load" <>
-                         help "Don't load modules on start-up")
+             <*> (not <$> boolFlags True "load" "load modules on start-up" idm)
              <*> packagesParser
              <*> optional
                      (textOption
@@ -474,6 +467,8 @@ ghciOptsParser = GhciOpts
                             help "Specify which target should contain the main \
                                  \module to load, such as for an executable for \
                                  \test suite or benchmark."))
+             <*> (flag' Nothing (long "no-build" <> help "Don't build before launching GHCi") <|>
+                  (Just <$> buildSubsetParser "build-" " before launching GHCi"))
 
 -- | Parser for exec command
 execOptsParser :: Maybe SpecialExecCmd -> Parser ExecOpts
@@ -527,6 +522,16 @@ execOptsExtraParser = eoPlainParser <|>
                           (long "plain" <>
                            help "Use an unmodified environment (only useful with Docker)")
 
+-- | Parser for BuildSubset options
+buildSubsetParser :: String -> String -> Parser BuildSubset
+buildSubsetParser longPrefix helpSuffix =
+    flag' BSOnlySnapshot
+        (long (longPrefix ++ "only-snapshot") <>
+         help ("Only build packages for the snapshot database, not the local database" ++ helpSuffix))
+    <|> flag' BSOnlyDependencies
+        (long (longPrefix ++ "only-dependencies") <>
+         help ("Only build packages that are dependencies of targets on the command line" ++ helpSuffix))
+    <|> pure BSAll
 
 -- | Parser for global command-line options.
 globalOptsParser :: Bool -> Parser GlobalOpts

diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs
@@ -405,7 +405,7 @@ data BuildSubset
     -- ^ Only install packages in the snapshot database, skipping
     -- packages intended for the local database.
     | BSOnlyDependencies
-    deriving Show
+    deriving (Show, Eq)
 
 -- | Configuration for building.
 data BuildOpts =

diff --git a/src/main/Main.hs b/src/main/Main.hs
@@ -884,7 +884,7 @@ packagesCmd () go@GlobalOpts{..} =
 targetsCmd :: Text -> GlobalOpts -> IO ()
 targetsCmd target go@GlobalOpts{..} =
     withBuildConfig go $
-    do (_realTargets,_,pkgs) <- ghciSetup Nothing [target]
+    do (_realTargets,_,pkgs) <- ghciSetup (Just BSAll) Nothing [target]
        pwd <- getWorkingDir
        targets <-
            fmap