diff --git a/ChangeLog.md b/ChangeLog.md index 2ed91c110c..dc1eb30d0f 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -13,6 +13,7 @@ * Add the __`--file-watch`__ flag to auto-rebuild on file changes [#113](https://github.com/commercialhaskell/stack/issues/113) * Rename `stack docker exec` to `stack exec --plain` * Add the `--skip-msys` flag [#377](https://github.com/commercialhaskell/stack/issues/377) +* `--keep-going`, turned on by default for tests and benchmarks [#478](https://github.com/commercialhaskell/stack/issues/478) ## 0.1.1.0 diff --git a/src/Control/Concurrent/Execute.hs b/src/Control/Concurrent/Execute.hs index 49083fb63c..f2d8e42d60 100644 --- a/src/Control/Concurrent/Execute.hs +++ b/src/Control/Concurrent/Execute.hs @@ -14,7 +14,7 @@ import Control.Applicative import Control.Concurrent.Async (Concurrently (..), async) import Control.Concurrent.STM import Control.Exception -import Control.Monad (join) +import Control.Monad (join, unless) import Data.Foldable (sequenceA_) import Data.Set (Set) import qualified Data.Set as Set @@ -45,6 +45,7 @@ data ExecuteState = ExecuteState , esExceptions :: TVar [SomeException] , esInAction :: TVar (Set ActionId) , esCompleted :: TVar Int + , esKeepGoing :: Bool } data ExecuteException @@ -57,15 +58,17 @@ instance Show ExecuteException where "Inconsistent dependencies were discovered while executing your build plan. This should never happen, please report it as a bug to the stack team." runActions :: Int -- ^ threads + -> Bool -- ^ keep going after one task has failed -> [Action] -> (TVar Int -> IO ()) -- ^ progress updated -> IO [SomeException] -runActions threads actions0 withProgress = do +runActions threads keepGoing actions0 withProgress = do es <- ExecuteState <$> newTVarIO actions0 <*> newTVarIO [] <*> newTVarIO Set.empty <*> newTVarIO 0 + <*> pure keepGoing _ <- async $ withProgress $ esCompleted es if threads <= 1 then runActions' es @@ -78,7 +81,7 @@ runActions' ExecuteState {..} = where breakOnErrs inner = do errs <- readTVar esExceptions - if null errs + if null errs || esKeepGoing then inner else return $ return () withActions inner = do @@ -92,7 +95,8 @@ runActions' ExecuteState {..} = inAction <- readTVar esInAction if Set.null inAction then do - modifyTVar esExceptions (toException InconsistentDependencies:) + unless esKeepGoing $ + modifyTVar esExceptions (toException InconsistentDependencies:) return $ return () else retry (xs, action:ys) -> do @@ -107,15 +111,12 @@ runActions' ExecuteState {..} = eres <- try $ restore $ actionDo action ActionContext { acRemaining = remaining } - case eres of - Left err -> atomically $ do - modifyTVar esExceptions (err:) - modifyTVar esInAction (Set.delete $ actionId action) - modifyTVar esCompleted (+1) - Right () -> do - atomically $ do - modifyTVar esInAction (Set.delete $ actionId action) - modifyTVar esCompleted (+1) + atomically $ do + modifyTVar esInAction (Set.delete $ actionId action) + modifyTVar esCompleted (+1) + case eres of + Left err -> modifyTVar esExceptions (err:) + Right () -> let dropDep a = a { actionDeps = Set.delete (actionId action) $ actionDeps a } - modifyTVar esActions $ map dropDep - restore loop + in modifyTVar esActions $ map dropDep + restore loop diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 63136fe0a4..3ff099ea03 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -333,8 +333,15 @@ executePlan' plan ee@ExecuteEnv {..} = do (planTasks plan) (planFinals plan) threads <- asks $ configJobs . getConfig + let keepGoing = + case boptsKeepGoing eeBuildOpts of + Just kg -> kg + Nothing -> + case boptsFinalAction eeBuildOpts of + DoNothing -> False + _ -> True terminal <- asks getTerminal - errs <- liftIO $ runActions threads actions $ \doneVar -> do + errs <- liftIO $ runActions threads keepGoing actions $ \doneVar -> do let total = length actions loop prev | prev == total = diff --git a/src/Stack/Build/Types.hs b/src/Stack/Build/Types.hs index 36f6eac08a..d931054357 100644 --- a/src/Stack/Build/Types.hs +++ b/src/Stack/Build/Types.hs @@ -297,6 +297,8 @@ data BuildOpts = -- suites. ,boptsFileWatch :: !Bool -- ^ Watch files for changes and automatically rebuild + ,boptsKeepGoing :: !(Maybe Bool) + -- ^ Keep building/running after failure } deriving (Show) @@ -318,6 +320,7 @@ defaultBuildOpts = BuildOpts , boptsOnlySnapshot = False , boptsCoverage = False , boptsFileWatch = False + , boptsKeepGoing = Nothing } -- | Run a Setup.hs action after building a package, before installing. diff --git a/src/main/Main.hs b/src/main/Main.hs index c4d2080ad7..9ff2d99607 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -667,7 +667,7 @@ buildOpts cmd = fmap process $ BuildOpts <$> target <*> libProfiling <*> exeProfiling <*> optimize <*> haddock <*> haddockDeps <*> finalAction <*> dryRun <*> ghcOpts <*> flags <*> installExes <*> preFetch <*> testArgs <*> onlySnapshot <*> coverage <*> - fileWatch' + fileWatch' <*> keepGoing where process bopts = if boptsCoverage bopts then bopts { boptsExeProfile = True @@ -751,6 +751,11 @@ buildOpts cmd = fmap process $ (long "file-watch" <> help "Watch for changes in local files and automatically rebuild") + keepGoing = maybeBoolFlags + "keep-going" + "continue running after a step fails (default: false for build, true for test/bench)" + idm + -- | Parser for docker cleanup arguments. dockerCleanupOpts :: Parser Docker.CleanupOpts dockerCleanupOpts =