diff --git a/Test/Framework.hs b/Test/Framework.hs
--- a/Test/Framework.hs
+++ b/Test/Framework.hs
@@ -10,7 +10,7 @@
         module Test.Framework.Seed
     ) where
 
-import Test.Framework.Core (Test, TestName, testGroup, plusTestOptions)
+import Test.Framework.Core (Test, TestName, testGroup, plusTestOptions, buildTest, mutuallyExclusive)
 import Test.Framework.Options
 import Test.Framework.Runners.Console
 import Test.Framework.Runners.Options
diff --git a/Test/Framework/Core.hs b/Test/Framework/Core.hs
--- a/Test/Framework/Core.hs
+++ b/Test/Framework/Core.hs
@@ -1,9 +1,12 @@
+{-# LANGUAGE UndecidableInstances #-}
 module Test.Framework.Core where
 
 import Test.Framework.Improving
 import Test.Framework.Options
 
+import Control.Concurrent.MVar
 
+
 -- | Something like the result of a test: works in concert with 'Testlike'.
 -- The type parameters are the type that is used for progress reports and the
 -- type of the final output of the test respectively.
@@ -32,13 +35,38 @@
 --
 -- For an example of how to use test-framework, please see
 -- <http://github.com/batterseapower/test-framework/raw/master/example/Test/Framework/Example.lhs>
-data Test = forall i r t. Testlike i r t => Test TestName t -- ^ A single test of some particular type. 
-          | TestGroup TestName [Test]
-          | PlusTestOptions TestOptions Test
+data Test = forall i r t. Testlike i r t => Test TestName t -- ^ A single test of some particular type
+          | TestGroup TestName [Test]                       -- ^ Assemble a number of tests into a cohesive group
+          | PlusTestOptions TestOptions Test                -- ^ Add some options to child tests
+          | BuildTest (IO Test)                             -- ^ Convenience for creating tests from an 'IO' action
 
 -- | Assemble a number of tests into a cohesive group
 testGroup :: TestName -> [Test] -> Test
 testGroup = TestGroup
 
+-- | Add some options to child tests
 plusTestOptions :: TestOptions -> Test -> Test
 plusTestOptions = PlusTestOptions
+
+-- | Convenience for creating tests from an 'IO' action
+buildTest :: IO Test -> Test
+buildTest = BuildTest
+
+
+data MutuallyExcluded t = ME (MVar ()) t
+
+-- This requires UndecidableInstances, but I think it can't be made inconsistent?
+instance Testlike i r t => Testlike i r (MutuallyExcluded t) where
+    runTest cto (ME mvar x) = withMVar mvar $ \() -> runTest cto x
+    testTypeName ~(ME _ x) = testTypeName x
+
+-- | Mark all tests in this portion of the tree as mutually exclusive, so only one runs at a time
+{-# NOINLINE mutuallyExclusive #-}
+mutuallyExclusive :: Test -> Test
+mutuallyExclusive init_t = BuildTest $ do
+    mvar <- newMVar ()
+    let go (Test tn t)            = Test tn (ME mvar t)
+        go (TestGroup tn ts)      = TestGroup tn (map go ts)
+        go (PlusTestOptions to t) = PlusTestOptions to (go t)
+        go (BuildTest build)      = BuildTest (fmap go build)
+    return (go init_t)
diff --git a/Test/Framework/Runners/Console.hs b/Test/Framework/Runners/Console.hs
--- a/Test/Framework/Runners/Console.hs
+++ b/Test/Framework/Runners/Console.hs
@@ -1,5 +1,6 @@
 module Test.Framework.Runners.Console (
-        defaultMain, defaultMainWithArgs, defaultMainWithOpts
+        defaultMain, defaultMainWithArgs, defaultMainWithOpts,
+        interpretArgs, interpretArgsOrExit
     ) where
 
 import Test.Framework.Core
@@ -65,9 +66,14 @@
             "write a junit-xml summary of the output to FILE",
         Option [] ["plain"]
             (NoArg (mempty { ropt_plain_output = Just True }))
-            "do not use any ANSI terminal features to display the test run"
+            "do not use any ANSI terminal features to display the test run",
+        Option [] ["hide-successes"]
+            (NoArg (mempty { ropt_hide_successes = Just True }))
+            "hide sucessful tests, and only show failures"
     ]
 
+-- | Parse the specified command line arguments into a 'RunnerOptions' and some remaining arguments,
+-- or return a reason as to why we can't.
 interpretArgs :: [String] -> IO (Either String (RunnerOptions, [String]))
 interpretArgs args = do
     prog_name <- getProgName
@@ -77,17 +83,12 @@
         (oas, n, []) | Just os <- sequence oas -> return $ Right (mconcat os, n)
         (_, _, errs)                           -> return $ Left (concat errs ++ usageInfo usage_header optionsDescription)
 
-
-defaultMain :: [Test] -> IO ()
-defaultMain tests = do
-    args <- getArgs
-    defaultMainWithArgs tests args
-
-defaultMainWithArgs :: [Test] -> [String] -> IO ()
-defaultMainWithArgs tests args = do
+-- | A version of 'interpretArgs' that ends the process if it fails.
+interpretArgsOrExit :: [String] -> IO RunnerOptions
+interpretArgsOrExit args = do
     interpreted_args <- interpretArgs args
     case interpreted_args of
-        Right (ropts, [])    -> defaultMainWithOpts tests ropts
+        Right (ropts, [])    -> return ropts
         Right (_, leftovers) -> do
             hPutStrLn stderr $ "Could not understand these extra arguments: " ++ unwords leftovers
             exitWith (ExitFailure 1)
@@ -95,6 +96,21 @@
             hPutStrLn stderr error_message
             exitWith (ExitFailure 1)
 
+
+defaultMain :: [Test] -> IO ()
+defaultMain tests = do
+    args <- getArgs
+    defaultMainWithArgs tests args
+
+-- | A version of 'defaultMain' that lets you ignore the command line arguments
+-- in favour of another list of 'String's.
+defaultMainWithArgs :: [Test] -> [String] -> IO ()
+defaultMainWithArgs tests args = do
+    ropts <- interpretArgsOrExit args
+    defaultMainWithOpts tests ropts
+
+-- | A version of 'defaultMain' that lets you ignore the command line arguments
+-- in favour of an explicit set of 'RunnerOptions'.
 defaultMainWithOpts :: [Test] -> RunnerOptions -> IO ()
 defaultMainWithOpts tests ropts = do
     let ropts' = completeRunnerOptions ropts
@@ -103,7 +119,7 @@
     running_tests <- runTests ropts' tests
     
     -- Show those test results to the user as we get them
-    fin_tests <- showRunTestsTop (unK $ ropt_plain_output ropts') running_tests
+    fin_tests <- showRunTestsTop (unK $ ropt_plain_output ropts') (unK $ ropt_hide_successes ropts') running_tests
     let test_statistics' = gatherStatistics fin_tests
     
     -- Output XML report (if requested)
@@ -123,5 +139,6 @@
             ropt_test_options = K $ ropt_test_options ro `orElse` mempty,
             ropt_test_patterns = K $ ropt_test_patterns ro `orElse` mempty,
             ropt_xml_output = K $ ropt_xml_output ro `orElse` Nothing,
-            ropt_plain_output = K $ ropt_plain_output ro `orElse` False
+            ropt_plain_output = K $ ropt_plain_output ro `orElse` False,
+            ropt_hide_successes = K $ ropt_hide_successes ro `orElse` False
         }
diff --git a/Test/Framework/Runners/Console/Run.hs b/Test/Framework/Runners/Console/Run.hs
--- a/Test/Framework/Runners/Console/Run.hs
+++ b/Test/Framework/Runners/Console/Run.hs
@@ -21,13 +21,14 @@
 import Data.Monoid
 
 import Control.Arrow (second, (&&&))
+import Control.Monad (unless)
 
 
-showRunTestsTop :: Bool -> [RunningTest] -> IO [FinishedTest]
-showRunTestsTop isplain running_tests = (if isplain then id else hideCursorDuring) $ do
+showRunTestsTop :: Bool -> Bool -> [RunningTest] -> IO [FinishedTest]
+showRunTestsTop isplain hide_successes running_tests = (if isplain then id else hideCursorDuring) $ do
     -- Show those test results to the user as we get them. Gather statistics on the fly for a progress bar
     let test_statistics = initialTestStatistics (totalRunTestsList running_tests)
-    (test_statistics', finished_tests) <- showRunTests isplain 0 test_statistics running_tests
+    (test_statistics', finished_tests) <- showRunTests isplain hide_successes 0 test_statistics running_tests
     
     -- Show the final statistics
     putStrLn ""
@@ -38,17 +39,17 @@
 
 -- This code all /really/ sucks.  There must be a better way to seperate out the console-updating
 -- and the improvement-traversing concerns - but how?
-showRunTest :: Bool -> Int -> TestStatistics -> RunningTest -> IO (TestStatistics, FinishedTest)
-showRunTest isplain indent_level test_statistics (RunTest name test_type (SomeImproving improving_result)) = do
+showRunTest :: Bool -> Bool -> Int -> TestStatistics -> RunningTest -> IO (TestStatistics, FinishedTest)
+showRunTest isplain hide_successes indent_level test_statistics (RunTest name test_type (SomeImproving improving_result)) = do
     let progress_bar = testStatisticsProgressBar test_statistics
-    (property_text, property_suceeded) <- showImprovingTestResult isplain indent_level name progress_bar improving_result
+    (property_text, property_suceeded) <- showImprovingTestResult isplain hide_successes indent_level name progress_bar improving_result
     return (updateTestStatistics (\count -> adjustTestCount test_type count mempty) property_suceeded test_statistics, RunTest name test_type (property_text, property_suceeded))
-showRunTest isplain indent_level test_statistics (RunTestGroup name tests) = do
+showRunTest isplain hide_successes indent_level test_statistics (RunTestGroup name tests) = do
     putDoc $ (indent indent_level (text name <> char ':')) <> linebreak
-    fmap (second $ RunTestGroup name) $ showRunTests isplain (indent_level + 2) test_statistics tests
+    fmap (second $ RunTestGroup name) $ showRunTests isplain hide_successes (indent_level + 2) test_statistics tests
 
-showRunTests :: Bool -> Int -> TestStatistics -> [RunningTest] -> IO (TestStatistics, [FinishedTest])
-showRunTests isplain indent_level = mapAccumLM (showRunTest isplain indent_level)
+showRunTests :: Bool -> Bool -> Int -> TestStatistics -> [RunningTest] -> IO (TestStatistics, [FinishedTest])
+showRunTests isplain hide_successes indent_level = mapAccumLM (showRunTest isplain hide_successes indent_level)
 
 
 testStatisticsProgressBar :: TestStatistics -> Doc
@@ -63,19 +64,20 @@
     terminal_width = 79
 
 
-showImprovingTestResult :: TestResultlike i r => Bool -> Int -> String -> Doc -> (i :~> r) -> IO (String, Bool)
-showImprovingTestResult isplain indent_level test_name progress_bar improving = do
+showImprovingTestResult :: TestResultlike i r => Bool -> Bool -> Int -> String -> Doc -> (i :~> r) -> IO (String, Bool)
+showImprovingTestResult isplain hide_successes indent_level test_name progress_bar improving = do
     -- Consume the improving value until the end, displaying progress if we are not in "plain" mode
     (result, success) <- if isplain then return $ improvingLast improving'
                                     else showImprovingTestResultProgress (return ()) indent_level test_name progress_bar improving'
-    let (result_doc, extra_doc) | success   = (brackets $ colorPass (text result), empty)
-                                | otherwise = (brackets (colorFail (text "Failed")), text result <> linebreak)
-  
-    -- Output the final test status and a trailing newline
-    putTestHeader indent_level test_name (possiblyPlain isplain result_doc)
-    -- Output any extra information that may be required, e.g. to show failure reason
-    putDoc extra_doc
-    
+    unless (success && hide_successes) $ do
+        let (result_doc, extra_doc) | success   = (brackets $ colorPass (text result), empty)
+                                    | otherwise = (brackets (colorFail (text "Failed")), text result <> linebreak)
+        
+        -- Output the final test status and a trailing newline
+        putTestHeader indent_level test_name (possiblyPlain isplain result_doc)
+        -- Output any extra information that may be required, e.g. to show failure reason
+        putDoc extra_doc
+
     return (result, success)
   where
     improving' = bimapImproving show (show &&& testSucceeded) improving
diff --git a/Test/Framework/Runners/Core.hs b/Test/Framework/Runners/Core.hs
--- a/Test/Framework/Runners/Core.hs
+++ b/Test/Framework/Runners/Core.hs
@@ -30,38 +30,28 @@
          -> IO [RunningTest]
 runTests ropts tests = do
     let test_patterns = unK $ ropt_test_patterns ropts
-        tests' | null test_patterns = tests
-               | otherwise          = filterTests test_patterns [] tests
-    (run_tests, actions) <- runTests' (unK $ ropt_test_options ropts) tests'
+        use_test path name = null test_patterns || any (`testPatternMatches` (path ++ [name])) test_patterns
+    (run_tests, actions) <- runTests' use_test [] (unK $ ropt_test_options ropts) tests
     _ <- executeOnPool (unK $ ropt_threads ropts) actions
     return run_tests
 
 
-filterTests :: [TestPattern] -> [String] -> [Test] -> [Test]
-filterTests patterns path = mapMaybe (filterTest patterns path)
-
-filterTest :: [TestPattern] -> [String] -> Test -> Maybe Test
-filterTest patterns path test@(Test name _)
-  | any (`testPatternMatches` (path ++ [name])) patterns = Just test
-  | otherwise                                            = Nothing
-filterTest patterns path (TestGroup name tests)
-  | null tests' = Nothing
-  | otherwise   = Just (TestGroup name tests')
-  where
-    tests' = filterTests patterns (path ++ [name]) tests
-filterTest patterns path (PlusTestOptions topts inner_test)
-  = fmap (PlusTestOptions topts) (filterTest patterns path inner_test)
-
-
-runTest' :: TestOptions -> Test -> IO (RunningTest, [IO ()])
-runTest' topts (Test name testlike) = do
+runTest' :: ([String] -> String -> Bool) -> [String]
+         -> TestOptions -> Test -> IO (Maybe (RunningTest, [IO ()]))
+runTest' use_test path topts (Test name testlike)
+  | use_test path name = do
     (result, action) <- runTest (completeTestOptions topts) testlike
-    return (RunTest name (testTypeName testlike) (SomeImproving result), [action])
-runTest' topts (TestGroup name tests) = fmap (onLeft (RunTestGroup name)) $ runTests' topts tests
-runTest' topts (PlusTestOptions extra_topts test) = runTest' (topts `mappend` extra_topts) test
+    return (Just (RunTest name (testTypeName testlike) (SomeImproving result), [action]))
+  | otherwise = return Nothing
+runTest' use_test path topts (TestGroup name tests) = do
+    (results, actions) <- runTests' use_test (path ++ [name]) topts tests
+    return $ if null results then Nothing else Just ((RunTestGroup name results), actions)
+runTest' use_test path topts (PlusTestOptions extra_topts test) = runTest' use_test path (topts `mappend` extra_topts) test
+runTest' use_test path topts (BuildTest build) = build >>= runTest' use_test path topts
 
-runTests' :: TestOptions -> [Test] -> IO ([RunningTest], [IO ()])
-runTests' topts = fmap (onRight concat . unzip) . mapM (runTest' topts)
+runTests' :: ([String] -> String -> Bool) -> [String]
+          -> TestOptions -> [Test] -> IO ([RunningTest], [IO ()])
+runTests' use_test path topts = fmap (onRight concat . unzip . catMaybes) . mapM (runTest' use_test path topts)
 
 
 completeTestOptions :: TestOptions -> CompleteTestOptions
diff --git a/Test/Framework/Runners/Options.hs b/Test/Framework/Runners/Options.hs
--- a/Test/Framework/Runners/Options.hs
+++ b/Test/Framework/Runners/Options.hs
@@ -14,7 +14,8 @@
         ropt_test_options :: f TestOptions,
         ropt_test_patterns :: f [TestPattern],
         ropt_xml_output :: f (Maybe FilePath),
-        ropt_plain_output :: f Bool
+        ropt_plain_output :: f Bool,
+        ropt_hide_successes :: f Bool
     }
 
 instance Monoid (RunnerOptions' Maybe) where
@@ -23,7 +24,8 @@
             ropt_test_options = Nothing,
             ropt_test_patterns = Nothing,
             ropt_xml_output = Nothing,
-            ropt_plain_output = Nothing
+            ropt_plain_output = Nothing,
+            ropt_hide_successes = Nothing
         }
 
     mappend ro1 ro2 = RunnerOptions {
@@ -31,5 +33,6 @@
             ropt_test_options = mappendBy ropt_test_options ro1 ro2,
             ropt_test_patterns = mappendBy ropt_test_patterns ro1 ro2,
             ropt_xml_output = mappendBy ropt_xml_output ro1 ro2,
-            ropt_plain_output = getLast (mappendBy (Last . ropt_plain_output) ro1 ro2)
+            ropt_plain_output = getLast (mappendBy (Last . ropt_plain_output) ro1 ro2),
+            ropt_hide_successes = getLast (mappendBy (Last . ropt_hide_successes) ro1 ro2)
         }
diff --git a/Test/Framework/Utilities.hs b/Test/Framework/Utilities.hs
--- a/Test/Framework/Utilities.hs
+++ b/Test/Framework/Utilities.hs
@@ -1,7 +1,11 @@
 module Test.Framework.Utilities where
 
+import Control.Arrow (first, second)
+
+import Data.Function (on)
 import Data.Maybe
 import Data.Monoid
+import Data.List (intercalate)
 
 
 newtype K a = K { unK :: a }
@@ -17,16 +21,16 @@
 listToMaybeLast = listToMaybe . reverse
 
 mappendBy :: Monoid b => (a -> b) -> a -> a -> b
-mappendBy f left right = (f left) `mappend` (f right)
+mappendBy f = mappend `on` f
 
 orElse :: Maybe a -> a -> a
 orElse = flip fromMaybe
 
 onLeft :: (a -> c) -> (a, b) -> (c, b)
-onLeft f (x, y) = (f x, y)
+onLeft = first
 
 onRight :: (b -> c) -> (a, b) -> (a, c)
-onRight f (x, y) = (x, f y)
+onRight = second
 
 -- | Like 'unlines', but does not append a trailing newline if there
 -- is at least one line.  For example:
@@ -42,9 +46,7 @@
 -- This is closer to the behaviour of 'unwords', which does not append
 -- a trailing space.
 unlinesConcise :: [String] -> String
-unlinesConcise []     = []
-unlinesConcise [l]    = l
-unlinesConcise (l:ls) = l ++ '\n' : unlinesConcise ls
+unlinesConcise = intercalate "\n"
 
 mapAccumLM :: Monad m => (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
 mapAccumLM _ acc [] = return (acc, [])
diff --git a/test-framework.cabal b/test-framework.cabal
--- a/test-framework.cabal
+++ b/test-framework.cabal
@@ -1,5 +1,5 @@
 Name:                test-framework
-Version:             0.3.3
+Version:             0.4.0
 Cabal-Version:       >= 1.2.3
 Category:            Testing
 Synopsis:            Framework for running and organising tests, with HUnit and QuickCheck support