diff --git a/ChangeLog b/ChangeLog
new file mode 100644
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,50 @@
+* 0.8.0.0 ?
+  - support for `--quiet' option to report failures only
+  - color support
+  - diff support: if an equality assertions fails, HTF shows a diff of
+    the expected and the given value
+  - more uniform output
+  - tests to execute are now given by a regular expression,
+    tests to ignored are prefixed with `--not'
+
+* 0.7.1.0 (2011-07-08)
+  - support for pending tests and quick check properties
+  - support for ignoring certain tests in the argument list of
+    Test.Framework.TestManager.runTestWithArgs (simply prefix the
+    test names with a '-')
+
+* 0.7.0.1 (2011-05-21)
+  - minor fix for the tutorial (thanks to Marnix)
+
+* 0.7.0.0 (2011-01-25)
+  - htfpp parses extension from pragmas
+  - runTest, runTestWithArgs, runTestWithFilter return an appropriate exit
+    code
+
+* 0.6.0.1 (2010-12-05)
+  - support for GHC 7, QuickCheck 2.3, containers 0.4 and directory 1.1
+    (thanks to David Leuschner)
+
+* 0.6.0.0 (2010-11-12)
+  - generalized mtl dependency to accept version 1.1* and 2.0.*.
+
+* 0.5.0.1 (2010-10-11)
+  - preprocessor now parses bang patterns
+
+* 0.5.0.0 (2010-10-05)
+  - added `--hunit' flag to htfpp. (The `--hunit' flag causes assert-like
+    macros to be expanded in a way that is backwards-compatible with the
+    corresponding functions of the HUnit library.)
+  - Some functions in Test.Framework.HUnitWrapper were renamed in a
+    non-backwards compatible way. The assert*P functions are now called
+    assert*Pretty, and the function assertSetEqual is now called
+    assertListsEqualAsSet
+
+* 0.4.0.0 (2010-09-02)
+  - More specific version constraints in .cabal file
+
+* 0.3.5.0 (2010-08-30)
+  - Testable instance for lists
+
+* 0.3.4.0 (2010-08-30)
+  - htfpp now accepts code subject to preprocessing with cpp
diff --git a/HTF.cabal b/HTF.cabal
--- a/HTF.cabal
+++ b/HTF.cabal
@@ -1,8 +1,8 @@
 Name:             HTF
-Version:          0.7.1.0
+Version:          0.8.0.0
 License:          LGPL
 License-File:     LICENSE
-Copyright:        (c) 2005-2010 Stefan Wehr
+Copyright:        (c) 2005-2011 Stefan Wehr
 Author:           Stefan Wehr <mail@stefanwehr.de>
 Maintainer:       Stefan Wehr <mail@stefanwehr.de>
 Bug-Reports:      mailto:mail@stefanwehr.de
@@ -30,6 +30,7 @@
 Extra-Source-Files:
   README
   TODO
+  ChangeLog
 
 Source-Repository head
   Type:           darcs
@@ -53,11 +54,16 @@
                     process == 1.0.*,
                     directory >= 1.0 && < 1.2,
                     mtl >= 1.1 && < 2.1,
-                    pretty == 1.0.*
+                    pretty == 1.0.*,
+                    Diff >= 0.1.3 && < 0.2,
+                    unix == 2.4.*,
+                    bytestring == 0.9.*,
+                    regex-compat == 0.93.*
   Exposed-Modules:
     Test.Framework
     Test.Framework.HUnitWrapper
     Test.Framework.TestManager
+    Test.Framework.TestConfig
     Test.Framework.QuickCheckWrapper
     Test.Framework.BlackBoxTest
     Test.Framework.Location
@@ -66,4 +72,6 @@
   Other-Modules:
     Test.Framework.TestManagerInternal
     Test.Framework.Utils
+    Test.Framework.Colors
+    Test.Framework.Diff
     Test.Framework.Process
diff --git a/Test/Framework/BlackBoxTest.hs b/Test/Framework/BlackBoxTest.hs
--- a/Test/Framework/BlackBoxTest.hs
+++ b/Test/Framework/BlackBoxTest.hs
@@ -84,14 +84,16 @@
          ExitSuccess | bbtCfg_shouldFail bbt
            -> blackBoxTestFail ("test is supposed to fail but succeeded")
          ExitFailure i | not $ bbtCfg_shouldFail bbt
-           -> do when (bbtCfg_verbose bbt) $
-                   do hPutStrLn stderr ("stderr for " ++ show (bbtCfg_cmd bbt)
-                                        ++ ":")
-                      hPutStrLn stderr (err ++ (endOfOutput "output"))
-                      putStrLn $ "stdout for " ++ show (bbtCfg_cmd bbt) ++ ":"
-                      putStrLn (out ++ (endOfOutput "output"))
-                 blackBoxTestFail ("test is supposed to succeed but failed "
-                                   ++ "with exit code " ++ show i)
+           -> do let details =
+                         if (bbtCfg_verbose bbt)
+                            then ("stderr for " ++ show (bbtCfg_cmd bbt) ++ ":\n" ++
+                                  err ++ endOfOutput "stderr" ++ "\n" ++
+                                  "stdout for " ++ show (bbtCfg_cmd bbt) ++ ":\n" ++
+                                  out ++ endOfOutput "stdout") ++ "\n"
+                            else ""
+                 blackBoxTestFail (details ++
+                                   "test is supposed to succeed but failed " ++
+                                   "with exit code " ++ show i)
          _ -> do cmpOut <- cmp (bbtCfg_stdoutFile bbt) (bbtCfg_stdoutCmp bbt)
                              out "Mismatch on stdout:\n"
                  cmpErr <- cmp (bbtCfg_stderrFile bbt) (bbtCfg_stderrCmp bbt)
@@ -99,14 +101,8 @@
                  case (cmpOut, cmpErr) of
                   (Nothing, Nothing) -> return ()
                   (x1, x2) ->
-                      do when (bbtCfg_verbose bbt) $
-                              putStrLn (x1 `concatMaybes` x2)
-                         let mismatchOn =
-                                 case (cmpOut, cmpErr) of
-                                   (Just _, Just _) -> "stdout and stderr"
-                                   (Just _, Nothing) -> "stdout"
-                                   _ -> "stderr"
-                         blackBoxTestFail ("Mismatch on " ++ mismatchOn)
+                      do let details = ensureNewline (x1 `concatMaybes` x2)
+                         blackBoxTestFail details
     where cmp expectFile cmpAction real label =
               do res <- cmpAction expectFile real
                  case res of
diff --git a/Test/Framework/Colors.hs b/Test/Framework/Colors.hs
new file mode 100644
--- /dev/null
+++ b/Test/Framework/Colors.hs
@@ -0,0 +1,79 @@
+--
+-- Copyright (c) 2011   Stefan Wehr - http://www.stefanwehr.de
+--
+-- This library is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU Lesser General Public
+-- License as published by the Free Software Foundation; either
+-- version 2.1 of the License, or (at your option) any later version.
+--
+-- This library is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- Lesser General Public License for more details.
+--
+-- You should have received a copy of the GNU Lesser General Public
+-- License along with this library; if not, write to the Free Software
+-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
+--
+
+module Test.Framework.Colors (
+
+    Color(..), PrimColor(..), startColor, withColor, colorize
+  , reset
+  , firstDiffColor, secondDiffColor, skipDiffColor
+  , warningColor, testStartColor, testOkColor, pendingColor
+
+) where
+
+import Test.Framework.TestConfig
+
+-- REVERSE            = "\033[2m"
+
+firstDiffColor = Color Magenta False
+secondDiffColor = Color Blue False
+skipDiffColor = Color DarkGray False
+warningColor = Color Red True
+testStartColor = Color NoColor True
+testOkColor = Color Green False
+pendingColor = Color Cyan True
+
+data Color = Color PrimColor Bool
+
+data PrimColor = Black | Blue | Green | Cyan | Red | Magenta
+               | Brown | Gray | DarkGray | LightBlue
+               | LightGreen | LightCyan | LightRed | LightMagenta
+               | Yellow | White | NoColor
+             deriving (Eq, Show)
+
+startColor :: Color -> String
+startColor (Color c isBold) =
+    (case c of
+       Black -> "\ESC[0;30m"
+       Blue -> "\ESC[0;34m"
+       Green -> "\ESC[0;32m"
+       Cyan -> "\ESC[0;36m"
+       Red -> "\ESC[0;31m"
+       Magenta -> "\ESC[0;35m"
+       Brown -> "\ESC[0;33m"
+       Gray -> "\ESC[0;37m"
+       DarkGray -> "\ESC[1;30m"
+       LightBlue -> "\ESC[1;34m"
+       LightGreen -> "\ESC[1;32m"
+       LightCyan -> "\ESC[1;36m"
+       LightRed -> "\ESC[1;31m"
+       LightMagenta -> "\ESC[1;35m"
+       Yellow -> "\ESC[1;33m"
+       White -> "\ESC[1;37m"
+       NoColor -> "") ++
+    (if isBold then "\ESC[1m" else "")
+
+reset :: String
+reset = "\ESC[0;0m"
+
+withColor :: Color -> String -> String
+withColor c s = startColor c ++ s ++ reset
+
+colorize :: Color -> String -> IO String
+colorize c s =
+    do b <- useColors
+       return $ if b then withColor c s else s
diff --git a/Test/Framework/Diff.hs b/Test/Framework/Diff.hs
new file mode 100644
--- /dev/null
+++ b/Test/Framework/Diff.hs
@@ -0,0 +1,135 @@
+--
+-- Copyright (c) 2011   Stefan Wehr - http://www.stefanwehr.de
+--
+-- This library is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU Lesser General Public
+-- License as published by the Free Software Foundation; either
+-- version 2.1 of the License, or (at your option) any later version.
+--
+-- This library is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- Lesser General Public License for more details.
+--
+-- You should have received a copy of the GNU Lesser General Public
+-- License along with this library; if not, write to the Free Software
+-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
+--
+
+module Test.Framework.Diff (
+
+    DiffConfig(..), noColorsDiffConfig, coloredDiffConfig, showDiff
+  , defaultTerminalDiffConfig, defaultNoColorsDiffConfig
+  , diffWithSensibleConfig
+
+) where
+
+import Data.Algorithm.Diff
+
+import Test.Framework.Colors
+import Test.Framework.TestConfig
+
+data Pos = First | Middle | Last | FirstLast
+         deriving (Eq)
+
+isLast :: Pos -> Bool
+isLast Last = True
+isLast FirstLast = True
+isLast _ = False
+
+isFirst :: Pos -> Bool
+isFirst First = True
+isFirst FirstLast = True
+isFirst _ = False
+
+isMiddle :: Pos -> Bool
+isMiddle Middle = True
+isMiddle _ = False
+
+data DiffConfig = DiffConfig {
+      dc_fromFirstPrefix :: String
+    , dc_fromFirstSuffix :: String
+    , dc_fromSecondPrefix :: String
+    , dc_fromSecondSuffix :: String
+    , dc_fromBothPrefix :: String
+    , dc_fromBothSuffix :: String
+    , dc_sep :: String
+    , dc_skipPrefix :: String
+    , dc_skipSuffix :: String
+    }
+
+noColorsDiffConfig :: Char -> Char -> DiffConfig
+noColorsDiffConfig f s = DiffConfig {
+      dc_fromFirstPrefix = f : " "
+    , dc_fromFirstSuffix = ""
+    , dc_fromSecondPrefix = s : " "
+    , dc_fromSecondSuffix = ""
+    , dc_fromBothPrefix = "C "
+    , dc_fromBothSuffix = ""
+    , dc_skipPrefix = "<"
+    , dc_skipSuffix = ">"
+    , dc_sep = "\n"
+    }
+
+coloredDiffConfig :: Color -> Color -> Color -> DiffConfig
+coloredDiffConfig c1 c2 c3 = DiffConfig {
+      dc_fromFirstPrefix = startColor c1
+    , dc_fromFirstSuffix = reset
+    , dc_fromSecondPrefix = startColor c2
+    , dc_fromSecondSuffix = reset
+    , dc_fromBothPrefix = ""
+    , dc_fromBothSuffix = ""
+    , dc_skipPrefix = startColor c3
+    , dc_skipSuffix = reset
+    , dc_sep = ""
+    }
+
+
+defaultTerminalDiffConfig :: DiffConfig
+defaultTerminalDiffConfig = coloredDiffConfig firstDiffColor secondDiffColor skipDiffColor
+
+defaultNoColorsDiffConfig :: DiffConfig
+defaultNoColorsDiffConfig = noColorsDiffConfig 'F' 'S'
+
+contextSize :: Int
+contextSize = 10
+
+showDiff :: DiffConfig -> String -> String -> String
+showDiff dc s1 s2 =
+    let groups = getGroupedDiff s1 s2
+    in foldr (\(group, pos) string ->
+                  (showDiffGroup pos group) ++
+                  (if not (isLast pos) then dc_sep dc else "") ++
+                  string)
+             "" (addPositions groups)
+    where
+      showDiffGroup _ (F, s) = dc_fromFirstPrefix dc ++ s ++ dc_fromFirstSuffix dc
+      showDiffGroup _ (S, s) = dc_fromSecondPrefix dc ++ s ++ dc_fromSecondSuffix dc
+      showDiffGroup pos (B, inBoth) =
+          let showStart = not $ isFirst pos
+              showEnd = not $ isLast pos
+              (contextStart, ignored, contextEnd) =
+                  let (s, rest) = splitAt contextSize inBoth
+                      (i, e) = splitAt (length rest - contextSize) rest
+                      start = if showStart then s else ""
+                      end = if showEnd then e else ""
+                      ign = (if showStart then "" else s) ++ i ++
+                            (if showEnd then "" else e)
+                  in (start, ign, end)
+              middle = let n = length ignored
+                           replText = dc_skipPrefix dc ++ "skipped " ++ show n ++ " chars" ++ dc_skipSuffix dc
+                       in if n <= length replText then ignored else replText
+          in dc_fromBothPrefix dc ++ contextStart ++ middle ++ contextEnd ++ dc_fromBothSuffix dc
+      addPositions [] = []
+      addPositions (x:[]) = (x, FirstLast) : []
+      addPositions (x:xs) = (x, First) : addPositions' xs
+      addPositions' [] = []
+      addPositions' (x:[]) = (x, Last) : []
+      addPositions' (x:xs) = (x, Middle) : addPositions' xs
+
+
+diffWithSensibleConfig :: String -> String -> IO String
+diffWithSensibleConfig s1 s2 =
+    do b <- useColors
+       let dc = if b then defaultTerminalDiffConfig else defaultNoColorsDiffConfig
+       return $ showDiff dc s1 s2
diff --git a/Test/Framework/HUnitWrapper.hs b/Test/Framework/HUnitWrapper.hs
--- a/Test/Framework/HUnitWrapper.hs
+++ b/Test/Framework/HUnitWrapper.hs
@@ -70,6 +70,8 @@
 import Test.Framework.TestManagerInternal
 import Test.Framework.Location
 import Test.Framework.Utils
+import Test.Framework.Diff
+import Test.Framework.Colors
 import Test.Framework.Pretty
 
 -- WARNING: do not forget to add a preprocessor macro for new assertions!!
@@ -119,26 +121,32 @@
 --
 -- Equality Assertions
 --
+
+equalityFailedMessage :: String -> String -> IO String
+equalityFailedMessage exp act =
+    do d <- diffWithSensibleConfig exp act
+       expected_ <- colorize firstDiffColor "expected:"
+       but_got_ <- colorize secondDiffColor "but got:"
+       return ("\n " ++ expected_ ++ " " ++ exp ++
+               "\n " ++ but_got_ ++ "  " ++ act ++
+               "\n diff:\n" ++ d)
+
 _assertEqual_ :: (Eq a, Show a)
                  => String -> Location -> String -> a -> a -> HU.Assertion
 _assertEqual_ name loc s expected actual =
     if expected /= actual
-       then assertFailure (mkMsg name s msg)
+       then do x <- equalityFailedMessage (show expected) (show actual)
+               assertFailure (mkMsg name s $ "failed at " ++ showLoc loc ++ x)
        else return ()
-    where msg = "failed at " ++ showLoc loc ++
-                "\n expected: " ++ show expected ++
-                "\n but got:  " ++ show actual
 CreateAssertionsCtx(assertEqual, (Eq a, Show a), a -> a)
 
 _assertEqualPretty_ :: (Eq a, Pretty a)
                        => String -> Location -> String -> a -> a -> HU.Assertion
 _assertEqualPretty_ name loc s expected actual =
     if expected /= actual
-       then assertFailure (mkMsg name s msg)
+       then do x <- equalityFailedMessage (showPretty expected) (showPretty actual)
+               assertFailure (mkMsg name s $ "failed at " ++ showLoc loc ++ x)
        else return ()
-    where msg = "assertEqual failed at " ++ showLoc loc ++
-                "\n expected:\n" ++ showPretty expected ++
-                "\n but got:\n" ++ showPretty actual
 CreateAssertionsCtx(assertEqualPretty, (Eq a, Pretty a), a -> a)
 
 _assertEqualNoShow_ :: Eq a
@@ -165,10 +173,9 @@
                                  ++ "\n expected length: " ++ show ne
                                  ++ "\n actual length: " ++ show na))
              | not (unorderedEq expected actual) ->
-                 assertFailure (mkMsg "assertSetEqual" s
-                                ("failed at " ++ showLoc loc
-                                 ++ "\n expected: " ++ show expected
-                                 ++ "\n actual: " ++ show actual))
+                 do x <- equalityFailedMessage (show expected) (show actual)
+                    assertFailure (mkMsg "assertSetEqual" s
+                                   ("failed at " ++ showLoc loc ++ x))
              | otherwise -> return ()
     where unorderedEq l1 l2 =
               null (l1 \\ l2) && null (l2 \\ l1)
diff --git a/Test/Framework/QuickCheckWrapper.hs b/Test/Framework/QuickCheckWrapper.hs
--- a/Test/Framework/QuickCheckWrapper.hs
+++ b/Test/Framework/QuickCheckWrapper.hs
@@ -96,15 +96,14 @@
                              then quickCheckTestPending err
                              else quickCheckTestError (Just err)
                       Right (Success { output=msg }) ->
-                          do report (adjustOutput msg)
-                             return ()
+                          quickCheckTestPass (adjustOutput msg)
                       Right (Failure { usedSize=size, usedSeed=gen, output=msg, reason=reason }) ->
                           if pendingPrefix `isPrefixOf` reason
                              then let pendingMsg = let s = drop (length pendingPrefix) reason
                                                    in take (length s - length pendingSuffix) s
                                   in quickCheckTestPending pendingMsg
-                          else do let replay = "Replay argument: " ++ (show (show (Just (gen, size))))
-                                  quickCheckTestFail (Just (adjustOutput msg ++ "\n" ++ replay))
+                             else do let replay = "Replay argument: " ++ (show (show (Just (gen, size))))
+                                     quickCheckTestFail (Just (adjustOutput msg ++ "\n" ++ replay))
                       Right (GaveUp { output=msg }) ->
                           quickCheckTestFail (Just (adjustOutput msg))
                       Right (NoExpectedFailure { output=msg }) ->
diff --git a/Test/Framework/TestConfig.hs b/Test/Framework/TestConfig.hs
new file mode 100644
--- /dev/null
+++ b/Test/Framework/TestConfig.hs
@@ -0,0 +1,64 @@
+--
+-- Copyright (c) 2009-2011   Stefan Wehr - http://www.stefanwehr.de
+--
+-- This library is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU Lesser General Public
+-- License as published by the Free Software Foundation; either
+-- version 2.1 of the License, or (at your option) any later version.
+--
+-- This library is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- Lesser General Public License for more details.
+--
+-- You should have received a copy of the GNU Lesser General Public
+-- License along with this library; if not, write to the Free Software
+-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
+--
+
+module Test.Framework.TestConfig (
+
+    TestConfig(..), defaultTestConfig, ReportLevel(..), report
+  , useColors
+
+) where
+
+import Data.Char (toLower)
+import Control.Monad (unless)
+import System.IO
+
+import System.Posix.Terminal
+import System.Posix.IO (stdOutput)
+import System.Posix.Types (Fd)
+import System.Posix.Env (getEnv)
+
+data TestConfig = TestConfig { tc_quiet :: Bool }
+                deriving (Read,Show,Eq)
+
+defaultTestConfig :: TestConfig
+defaultTestConfig = TestConfig { tc_quiet = False }
+
+data ReportLevel = Debug | Info
+                 deriving (Eq,Ord)
+
+reportHandle :: Handle
+reportHandle = stdout -- keep in sync with reportFd!
+
+reportFd :: Fd
+reportFd = stdOutput -- keep in sync with reportHandle!
+
+report :: TestConfig -> ReportLevel -> String -> IO ()
+report tc level msg =
+    unless (tc_quiet tc && level < Info) $ do hPutStrLn reportHandle msg
+                                              hFlush reportHandle
+
+useColors :: IO Bool
+useColors =
+    do mterm <- getEnv "TERM"
+       case mterm of
+         Nothing -> return False
+         Just s | map toLower s == "dump" -> return False
+         _ -> do mx <- getEnv "HTF_NO_COLORS"
+                 case mx of
+                   Just s | map toLower s `elem` ["", "1", "y", "yes", "true"] -> return False
+                   _ -> queryTerminal reportFd
diff --git a/Test/Framework/TestManager.hs b/Test/Framework/TestManager.hs
--- a/Test/Framework/TestManager.hs
+++ b/Test/Framework/TestManager.hs
@@ -1,5 +1,5 @@
 --
--- Copyright (c) 2009   Stefan Wehr - http://www.stefanwehr.de
+-- Copyright (c) 2009-2011   Stefan Wehr - http://www.stefanwehr.de
 --
 -- This library is free software; you can redistribute it and/or
 -- modify it under the terms of the GNU Lesser General Public
@@ -25,22 +25,32 @@
   makeAnonTestSuite,
   addToTestSuite, testSuiteAsTest,
 
-  runTest, runTestWithArgs, runTestWithFilter
+  parseTestArgs, runTest, runTestWithArgs, runTestWithOptions
 
 ) where
 
 import Control.Monad
-import Control.Monad.State
+import Control.Monad.RWS
 import System.Exit (ExitCode(..))
 import Data.List ( isInfixOf, isPrefixOf, partition )
 import Text.PrettyPrint
 import qualified Data.List as List
+import Data.Maybe (isJust)
 
+import System.Directory (getTemporaryDirectory, removeFile)
+import System.IO
+import System.Console.GetOpt
+import GHC.IO.Handle
+import qualified Data.ByteString.Lazy as BSL
+import qualified Text.Regex as R
+
 import qualified Test.HUnit.Lang as HU
 
 import Test.Framework.Location ( Location, showLoc )
-import Test.Framework.Utils ( readM )
+import Test.Framework.Utils ( readM, ensureNewline )
 import {-# SOURCE #-} Test.Framework.TestManagerInternal
+import Test.Framework.TestConfig
+import Test.Framework.Colors
 
 type Assertion = IO ()
 
@@ -118,106 +128,238 @@
 initTestState :: TestState
 initTestState = TestState [] [] [] []
 
-type TR = StateT TestState IO
+type TR = RWST TestConfig () TestState IO
 
+data HandleRedirection = HandleRedirection { hr_original :: Handle
+                                           , hr_originalCopy :: Handle
+                                           , hr_newHandle :: Handle
+                                           , hr_newFilePath :: FilePath }
+
+redirectHandle :: String -> Handle -> IO HandleRedirection
+redirectHandle nameTmpl h =
+    do tmpDir <- getTemporaryDirectory
+       (path, new) <- openBinaryTempFile tmpDir nameTmpl
+       copy <- hDuplicate h
+       hDuplicateTo new h
+       return $ HandleRedirection { hr_original = h
+                                  , hr_originalCopy = copy
+                                  , hr_newHandle = new
+                                  , hr_newFilePath = path }
+
+unredirectHandle :: HandleRedirection -> IO ()
+unredirectHandle hr =
+    do hClose (hr_newHandle hr)
+       hDuplicateTo (hr_originalCopy hr) (hr_original hr) -- restore
+
+cleanupRedirection :: Bool -> HandleRedirection -> IO ()
+cleanupRedirection printOutput hr =
+    do when (printOutput) $ do x <- BSL.readFile (hr_newFilePath hr)
+                               BSL.hPut (hr_original hr) x
+                               hFlush (hr_original hr)
+       removeFile (hr_newFilePath hr)
+
 runFlatTest :: FlatTest -> TR ()
 runFlatTest (FlatTest sort id mloc ass) =
     do let name = id ++ case mloc of
                           Nothing -> ""
                           Just loc -> " (" ++ showLoc loc ++ ")"
-       liftIO $ report name
+       x <- atStart name
        res <- liftIO $ HU.performTestCase ass
-       case res of
-         Nothing -> reportSuccess name
-         Just (isFailure', msg') ->
-             let (isFailure, msg, doReport) =
-                     if sort /= QuickCheckTest
-                        then (isFailure', msg', True)
-                        else case readM msg' :: Maybe (Bool, Maybe String) of
-                               Nothing ->
-                                   error ("ERROR: " ++
-                                          "Cannot deserialize QuickCheck " ++
-                                          "error message " ++ show msg')
-                               Just (b, ms) ->
-                                   case ms of
-                                     Nothing -> (b, "", True)
-                                     Just s -> (b, s, True)
-             in if isFailure
-                   then case extractPendingMessage msg of
-                          Nothing -> do modify (\s -> s { ts_failed =
-                                                             name : (ts_failed s) })
-                                        when doReport $ reportFailure msg
-                          Just msg -> do modify (\s -> s { ts_pending =
-                                                             name : (ts_pending s) })
-                                         when doReport $ reportPending msg
-                   else do modify (\s -> s { ts_error =
-                                             name : (ts_error s) })
-                           when doReport $ reportError msg
-       liftIO $ report ""
+       let (testResult, msg) =
+             case res of
+               Nothing -> (Pass, "")
+               Just (isFailure, msg') ->
+                   if sort /= QuickCheckTest
+                      then if isFailure
+                              then case extractPendingMessage msg' of
+                                     Nothing -> (Fail, msg')
+                                     Just msg'' -> (Pending, msg'')
+                              else (Error, msg')
+                      else case readM msg' :: Maybe (TestResult, Maybe String) of
+                             Nothing ->
+                                 error ("ERROR: " ++
+                                        "Cannot deserialize QuickCheck " ++
+                                        "error message " ++ show msg')
+                             Just (r, ms) ->
+                                 case ms of
+                                   Nothing -> (r, "")
+                                   Just s -> (r, s)
+       afterRunning x name testResult
+       case testResult of
+         Pass -> reportSuccess name msg
+         Pending ->
+             do modify (\s -> s { ts_pending = name : (ts_pending s) })
+                reportPending msg
+         Fail ->
+             do modify (\s -> s { ts_failed = name : (ts_failed s) })
+                reportFailure msg
+         Error ->
+             do modify (\s -> s { ts_error = name : (ts_error s) })
+                reportError msg
+       atEnd testResult
     where
-      reportSuccess name =
+      testStartMessage name =
+          do t <- colorize testStartColor "[TEST] "
+             return $ t ++ name
+      atStart name =
+          do tc <- ask
+             if tc_quiet tc
+                then liftIO $
+                     do stdoutRedir <- redirectHandle "HTF.out" stdout
+                        stderrRedir <- redirectHandle "HTF.err" stderr
+                        return $ Just (stdoutRedir, stderrRedir)
+                else do msg <- liftIO $ testStartMessage name
+                        reportTR Debug msg
+                        return Nothing
+      afterRunning x name testResult =
+          do tc <- ask
+             if tc_quiet tc
+                then case x of
+                       Just (stdoutRedir, stderrRedir) -> liftIO $
+                          do unredirectHandle stderrRedir
+                             unredirectHandle stdoutRedir
+                             let printOutput = needsReport testResult
+                             when printOutput $
+                                  do msg <- testStartMessage name
+                                     report tc Info msg
+                             cleanupRedirection printOutput stderrRedir
+                             cleanupRedirection printOutput stdoutRedir
+                else return ()
+      atEnd testResult =
+          do tc <- ask
+             if not (tc_quiet tc) || needsReport testResult
+                then reportTR Info ""
+                else return ()
+      needsReport testResult = testResult `elem` [Fail, Error, Pending]
+      reportSuccess name msg =
           do modify (\s -> s { ts_passed = name : (ts_passed s) })
-             liftIO $ report "+++ OK"
+             pref <- okPrefix
+             reportTR Debug (ensureNewline msg ++ pref)
       reportPending msg =
-          reportMessage msg pendingPrefix
+          do pref <- pendingPrefix
+             reportMessage Info msg  pref
       reportFailure msg =
-          reportMessage msg failurePrefix
+          do pref <- failurePrefix
+             reportMessage Info msg pref
       reportError msg =
-          reportMessage msg errorPrefix
-      reportMessage msg prefix = liftIO $ report (prefix ++ msg)
-      failurePrefix = "*** Failed! "
-      errorPrefix = "@@@ Error! "
-      pendingPrefix = "^^^ Pending! "
+          do pref <- errorPrefix
+             reportMessage Info msg pref
+      reportMessage isImportant msg prefix =
+          reportTR isImportant (ensureNewline msg ++ prefix)
+      failurePrefix = liftIO $ colorize warningColor "*** Failed! "
+      errorPrefix = liftIO $ colorize warningColor "@@@ Error! "
+      pendingPrefix = liftIO $ colorize pendingColor "^^^ Pending! "
+      okPrefix = liftIO $ colorize testOkColor  "+++ OK"
 
 runFlatTests :: [FlatTest] -> TR ()
 runFlatTests = mapM_ runFlatTest
 
 runTest :: TestableHTF t => t -> IO ExitCode
-runTest = runTestWithFilter (\_ -> True)
+runTest = runTestWithOptions defaultTestOptions
 
+optionDescriptions :: [OptDescr (TestOptions -> TestOptions)]
+optionDescriptions =
+    [ Option ['v']     ["verbose"] (NoArg (\o -> o { opts_quiet = False })) "chatty output"
+    , Option ['q']     ["quiet"]   (NoArg (\o -> o { opts_quiet = True })) "only display errors"
+    , Option ['n']     ["not"]     (ReqArg (\s o -> o { opts_negated = s : (opts_negated o) })
+                                           "TEST_PATTERN") "tests to exclude"
+    , Option ['h']     ["help"]    (NoArg (\o -> o { opts_help = True })) "display this message"
+    ]
+
 runTestWithArgs :: TestableHTF t => [String] -> t -> IO ExitCode
-runTestWithArgs l tests =
-    let (pos, neg') = partition (\x -> not $ "-" `isPrefixOf` x) l
-        neg = map tail neg'
-    in runTestWithFilter (pred pos neg) tests
+runTestWithArgs args t =
+    case parseTestArgs args of
+      Left err ->
+          do hPutStrLn stderr err
+             return $ ExitFailure 1
+      Right opts ->
+          runTestWithOptions opts t
+
+parseTestArgs :: [String] -> Either String TestOptions
+parseTestArgs args =
+    case getOpt Permute optionDescriptions args of
+      (optTrans, tests, []  ) ->
+          let posStrs = tests
+              negStrs = opts_negated opts
+              pos = map mkRegex posStrs
+              neg = map mkRegex negStrs
+              pred (FlatTest _ id _ _) =
+                  if (any (\s -> s `matches` id) neg)
+                     then False
+                     else null pos || any (\s -> s `matches` id) pos
+              opts = (foldr ($) defaultTestOptions optTrans) { opts_filter = pred }
+          in Right opts
+      (_,_,errs) ->
+          Left (concat errs ++ usageInfo usageHeader optionDescriptions)
     where
-      pred pos neg (FlatTest _ id _ _) =
-          if (any (\s -> s `isInfixOf` id) neg)
-             then False
-             else null pos || any (\s -> s `isInfixOf` id) pos
+      matches r s = isJust $ R.matchRegex r s
+      mkRegex s = R.mkRegexWithOpts s True False
 
+usageHeader :: String
+usageHeader = ("USAGE: COMMAND [OPTION ...] TEST_PATTERN ...\n\n" ++
+               "       where TEST_PATTERN is a posix regular expression.\n")
+
 type Filter = FlatTest -> Bool
 
-runTestWithFilter :: TestableHTF t => Filter -> t -> IO ExitCode
-runTestWithFilter pred t =
-    do s <- execStateT (runFlatTests (filter pred (flatten t)))
-                       initTestState
-       let passed = length (ts_passed s)
-           pending = length (ts_pending s)
-           failed = length (ts_failed s)
-           error = length (ts_error s)
-           total = passed + failed + error + pending
-       report ("* Tests:    " ++ show total ++ "\n" ++
-               "* Passed:   " ++ show passed ++ "\n" ++
-               "* Pending:  " ++ show pending ++ "\n" ++
-               "* Failures: " ++ show failed ++ "\n" ++
-               "* Errors:   " ++ show error )
-       when (pending > 0) $
-          reportDoc (text "\nPending:" $$ renderTestNames
-                                             (reverse (ts_pending s)))
-       when (failed > 0) $
-          reportDoc (text "\nFailures:" $$ renderTestNames
-                                             (reverse (ts_failed s)))
-       when (error > 0) $
-          reportDoc (text "\nErrors:" $$ renderTestNames
-                                             (reverse (ts_error s)))
-       return $ case () of
-                  _| failed == 0 && error == 0 -> ExitSuccess
-                   | error == 0                -> ExitFailure 1
-                   | otherwise                 -> ExitFailure 2
+data TestOptions = TestOptions {
+      opts_quiet :: Bool
+    , opts_filter :: Filter
+    , opts_help :: Bool
+    , opts_negated :: [String]
+    }
+
+defaultTestOptions = TestOptions {
+      opts_quiet = tc_quiet defaultTestConfig
+    , opts_filter = const True
+    , opts_help = False
+    , opts_negated = []
+    }
+
+runTestWithOptions :: TestableHTF t => TestOptions -> t -> IO ExitCode
+runTestWithOptions opts t =
+    if opts_help opts
+       then do hPutStrLn stderr (usageInfo usageHeader optionDescriptions)
+               return $ ExitFailure 1
+       else
+         do let pred = opts_filter opts
+                tc = optsToConfig opts
+            (_, s, _) <- runRWST (runFlatTests (filter pred (flatten t))) tc initTestState
+            let passed = length (ts_passed s)
+                pending = length (ts_pending s)
+                failed = length (ts_failed s)
+                error = length (ts_error s)
+                total = passed + failed + error + pending
+            pendings <- colorize pendingColor "* Pending:"
+            failures <- colorize warningColor "* Failures:"
+            errors <- colorize warningColor "* Errors:"
+            report tc Info ("* Tests:    " ++ show total ++ "\n" ++
+                            "* Passed:   " ++ show passed ++ "\n" ++
+                            pendings ++ "  " ++ show pending ++ "\n" ++
+                            failures ++ " " ++ show failed ++ "\n" ++
+                            errors ++ "   " ++ show error )
+            when (pending > 0) $
+               reportDoc tc Info
+                   (text ('\n' : pendings) $$ renderTestNames (reverse (ts_pending s)))
+            when (failed > 0) $
+               reportDoc tc Info
+                   (text ('\n' : failures) $$ renderTestNames (reverse (ts_failed s)))
+            when (error > 0) $
+               reportDoc tc Info
+                   (text ('\n' : errors) $$ renderTestNames (reverse (ts_error s)))
+            return $ case () of
+                       _| failed == 0 && error == 0 -> ExitSuccess
+                        | error == 0                -> ExitFailure 1
+                        | otherwise                 -> ExitFailure 2
     where
       renderTestNames l =
           nest 2 (vcat (map (\name -> text "*" <+> text name) l))
+      optsToConfig opts =
+          TestConfig { tc_quiet = opts_quiet opts }
 
-reportDoc :: Doc -> IO ()
-reportDoc doc = report (render doc)
+reportDoc :: TestConfig -> ReportLevel -> Doc -> IO ()
+reportDoc tc level doc = report tc level (render doc)
+
+reportTR :: ReportLevel -> String -> TR ()
+reportTR level msg =
+    do tc <- ask
+       liftIO $ report tc level msg
diff --git a/Test/Framework/TestManagerInternal.hs b/Test/Framework/TestManagerInternal.hs
--- a/Test/Framework/TestManagerInternal.hs
+++ b/Test/Framework/TestManagerInternal.hs
@@ -20,9 +20,10 @@
 
   extractPendingMessage,
   quickCheckTestFail, quickCheckTestError, quickCheckTestPending,
+  quickCheckTestPass,
   unitTestFail, unitTestPending, blackBoxTestFail,
 
-  report
+  TestResult(..)
 
 ) where
 
@@ -31,6 +32,9 @@
 
 import Test.Framework.TestManager
 
+data TestResult = Error | Fail | Pending | Pass
+                  deriving (Show, Read, Eq)
+
 -- A pending test case is treated as a failed testcase, but the error message
 -- starts with the given prefix.
 pendingPrefix :: String
@@ -53,14 +57,17 @@
 -- This is a HACK: we encode a custom error message for QuickCheck
 -- failures and errors in a string, which is later parsed using read!
 quickCheckTestError :: Maybe String -> Assertion
-quickCheckTestError m = assertFailureHTF (show (False, m))
+quickCheckTestError m = assertFailureHTF (show (Error, m))
 
 quickCheckTestFail :: Maybe String -> Assertion
-quickCheckTestFail m = assertFailureHTF (show (True, m))
+quickCheckTestFail m = assertFailureHTF (show (Fail, m))
 
 quickCheckTestPending :: String -> Assertion
-quickCheckTestPending m = quickCheckTestFail (Just $ makePendingMessage m)
+quickCheckTestPending m = assertFailureHTF (show (Pending, Just m))
 
+quickCheckTestPass :: String -> Assertion
+quickCheckTestPass m = assertFailureHTF (show (Pass, Just m))
+
 unitTestFail :: String -> IO a
 unitTestFail s =
     do assertFailureHTF s
@@ -71,6 +78,3 @@
 
 blackBoxTestFail :: String -> Assertion
 blackBoxTestFail = assertFailureHTF
-
-report :: String -> IO ()
-report = putStrLn
diff --git a/Test/Framework/TestManagerInternal.hs-boot b/Test/Framework/TestManagerInternal.hs-boot
--- a/Test/Framework/TestManagerInternal.hs-boot
+++ b/Test/Framework/TestManagerInternal.hs-boot
@@ -1,5 +1,8 @@
 module Test.Framework.TestManagerInternal where
 
-extractPendingMessage :: String -> Maybe String
+data TestResult = Error | Fail | Pending | Pass
+instance Read TestResult
+instance Show TestResult
+instance Eq TestResult
 
-report :: String -> IO ()
+extractPendingMessage :: String -> Maybe String
diff --git a/Test/Framework/Tutorial.hs b/Test/Framework/Tutorial.hs
--- a/Test/Framework/Tutorial.hs
+++ b/Test/Framework/Tutorial.hs
@@ -66,7 +66,7 @@
 @
 main =
     do args <- getArgs
-       runTestWithArgs args reverseTests
+       runTestWithArgs args allHTFTests
 @
 
 Here is the skeleton of a @.cabal@ file which you may want to use to
diff --git a/Test/Framework/Utils.hs b/Test/Framework/Utils.hs
--- a/Test/Framework/Utils.hs
+++ b/Test/Framework/Utils.hs
@@ -1,12 +1,12 @@
 {-# LANGUAGE PatternGuards #-}
--- 
+--
 -- Copyright (c) 2005   Stefan Wehr - http://www.stefanwehr.de
 --
 -- This library is free software; you can redistribute it and/or
 -- modify it under the terms of the GNU Lesser General Public
 -- License as published by the Free Software Foundation; either
 -- version 2.1 of the License, or (at your option) any later version.
--- 
+--
 -- This library is distributed in the hope that it will be useful,
 -- but WITHOUT ANY WARRANTY; without even the implied warranty of
 -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
@@ -20,7 +20,7 @@
 module Test.Framework.Utils where
 
 import System.Directory
-import Data.Char 
+import Data.Char
 
 infixr 6 </>
 
@@ -38,17 +38,17 @@
         p' -> p'
 
 startswith :: String -> String -> Bool
-startswith s pref = 
+startswith s pref =
     let n = length pref
         in take n s == pref
 
 endswith :: String -> String -> Bool
-endswith s suf = 
+endswith s suf =
     let n = length s - length suf
         in drop n s == suf
 
 dropPrefix :: String -> String -> String
-dropPrefix s pref = 
+dropPrefix s pref =
     if startswith s pref
        then drop (length pref) s
        else s
@@ -63,11 +63,11 @@
 dropSpace :: [Char] -> [Char]
 dropSpace = let f = reverse . dropWhile isSpace in f . f
 
-data DirectoryEntryType = File | Directory | Other 
+data DirectoryEntryType = File | Directory | Other
                         deriving (Eq, Show)
 
 directoryEntryType :: FilePath -> IO DirectoryEntryType
-directoryEntryType fp = 
+directoryEntryType fp =
     do b <- doesFileExist fp
        if b then return File else do b <- doesDirectoryExist fp
                                      return $ if b then Directory else Other
@@ -76,16 +76,16 @@
              -> String                  -- suffix of the file names to collect
              -> (FilePath -> [FilePath] -> IO Bool)
                -- predicate that determines
-               -- whether files below a certain 
+               -- whether files below a certain
                -- directory should be pruned.
                -- The first argument is the
                -- name of the directory, the
-               -- second the entries of the 
+               -- second the entries of the
                -- directory
              -> IO [FilePath]
-collectFiles root suf prune = 
+collectFiles root suf prune =
     do entries <- getDirectoryContents root
-       b <- prune root entries 
+       b <- prune root entries
        if b then return []
           else do all <- mapM (collect root) entries
                   return $ concat all
@@ -98,7 +98,7 @@
                    _ -> return []
 
 maybeFile :: FilePath -> IO (Maybe FilePath)
-maybeFile f = 
+maybeFile f =
     do b <- doesFileExist f
        return $ if b then Just f else Nothing
 
@@ -107,11 +107,11 @@
            => (acc -> x -> m (acc, y)) -- Function of elt of input list
                                        -- and accumulator, returning new
                                        -- accumulator and elt of result list
-          -> acc            -- Initial accumulator 
+          -> acc            -- Initial accumulator
           -> [x]            -- Input list
           -> m (acc, [y])   -- Final accumulator and result list
 mapAccumLM _ s []        = return (s, [])
-mapAccumLM f s (x:xs)    = do (s', y ) <- f s x 
+mapAccumLM f s (x:xs)    = do (s', y ) <- f s x
                               (s'',ys) <- mapAccumLM f s' xs
                               return (s'',y:ys)
 
@@ -121,3 +121,9 @@
     where
       parse = [x | (x,t) <- reads s]
 
+ensureNewline :: String -> String
+ensureNewline s =
+    s ++ case dropWhile (== ' ') (reverse s) of
+           '\n':_ -> ""
+           _ | null s -> ""
+             | otherwise -> "\n"