diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,14 @@
+import Distribution.PackageDescription
+import Distribution.Simple
+import Distribution.Simple.LocalBuildInfo
+import System.Cmd
+import System.Exit
+
+
+main :: IO ()
+main = defaultMainWithHooks (simpleUserHooks { runTests = runAllTests })
+
+runAllTests :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
+runAllTests _ _ _ _ = do
+  code <- system "./dist/build/tests/tests"
+  exitWith code
diff --git a/Test/HUnit/Gui.hs b/Test/HUnit/Gui.hs
new file mode 100644
--- /dev/null
+++ b/Test/HUnit/Gui.hs
@@ -0,0 +1,4 @@
+module Test.HUnit.Gui (runTestGui, exitWhenGuiCloses)
+where
+
+import Test.HUnit.Gui.Window
diff --git a/Test/HUnit/Gui/Bar.hs b/Test/HUnit/Gui/Bar.hs
new file mode 100644
--- /dev/null
+++ b/Test/HUnit/Gui/Bar.hs
@@ -0,0 +1,53 @@
+module Test.HUnit.Gui.Bar (Bar, createBar, changeBar)
+where
+
+import Control.Concurrent.MVar
+import Graphics.Rendering.Cairo (liftIO, Render, setSourceRGB, rectangle, fill)
+import Graphics.UI.Gtk hiding (fill)
+import Graphics.UI.Gtk.Gdk.EventM
+import Test.HUnit.Base
+
+import Test.HUnit.Gui.BarComputations
+import Test.HUnit.Gui.Status
+
+data Bar = Bar DrawingArea (MVar Counts)
+
+createBar :: (DrawingArea -> IO ()) -> IO Bar
+createBar addToContainer =
+    do
+      drawingArea <- drawingAreaNew
+      counts' <- newMVar emptyCounts
+      let bar = Bar drawingArea counts'
+      drawingArea `on` exposeEvent $ redrawBar bar
+      widgetSetSizeRequest drawingArea 100 20
+      addToContainer drawingArea
+      return bar
+    where
+      emptyCounts = Counts 1 0 0 0
+
+redrawBar :: Bar -> EventM EExpose Bool
+redrawBar (Bar _ countsRef) = do
+  window <- eventWindow
+  liftIO $ do
+    counts' <- readMVar countsRef
+    (width, height) <- drawableGetSize window
+    renderWithDrawable window $ drawBar counts' width height
+    return True
+
+changeBar :: Bar -> Counts -> IO ()
+changeBar (Bar drawingArea countsRef) newCounts = do
+  modifyMVar_ countsRef (\_ -> return newCounts)
+  widgetQueueResize drawingArea
+
+drawBar :: Counts -> Int -> Int -> Render()
+drawBar counts' width height = do
+  uncurry3 setSourceRGB $ colorForStatus $ succeeded counts'
+  rectangle 0 0 (barWidth counts' width) (fromIntegral height)
+  fill
+
+colorForStatus :: Status -> (Double, Double, Double)
+colorForStatus Red = (1, 0, 0)
+colorForStatus Green = (0, 1, 0)
+
+uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
+uncurry3 f (x, y, z) = f x y z
diff --git a/Test/HUnit/Gui/BarComputations.hs b/Test/HUnit/Gui/BarComputations.hs
new file mode 100644
--- /dev/null
+++ b/Test/HUnit/Gui/BarComputations.hs
@@ -0,0 +1,8 @@
+module Test.HUnit.Gui.BarComputations (barWidth)
+where
+
+import Test.HUnit.Base
+
+barWidth :: Counts -> Int -> Double
+barWidth counts' totalWidth =
+    (fromIntegral totalWidth) * (fromIntegral $ tried counts') / (fromIntegral $ cases counts')
diff --git a/Test/HUnit/Gui/Descriptions.hs b/Test/HUnit/Gui/Descriptions.hs
new file mode 100644
--- /dev/null
+++ b/Test/HUnit/Gui/Descriptions.hs
@@ -0,0 +1,19 @@
+module Test.HUnit.Gui.Descriptions (describeError, describeFailure)
+where
+
+import Test.HUnit.Base
+import Test.HUnit.Text (showPath)
+
+describeError :: String -> State -> String
+describeError = describeProblem
+
+describeFailure :: String -> State -> String
+describeFailure = describeProblem
+
+describeProblem :: String -> State -> String
+describeProblem msg state =
+    let path' = path state
+    in if null path'
+       then msg
+       else (showPath path') ++ ":\n" ++ msg
+
diff --git a/Test/HUnit/Gui/Runner.hs b/Test/HUnit/Gui/Runner.hs
new file mode 100644
--- /dev/null
+++ b/Test/HUnit/Gui/Runner.hs
@@ -0,0 +1,29 @@
+module Test.HUnit.Gui.Runner (GuiInterface(..), runTests)
+where
+
+import Test.HUnit
+
+import Test.HUnit.Gui.Descriptions
+
+data GuiInterface = GuiInterface (String -> IO ()) (String -> IO ()) (Counts -> IO ())
+
+runTests :: GuiInterface -> Test -> IO Counts
+runTests (GuiInterface updateTestsRun updateFailureDetails updateTestBar) tests = do
+  (counts', _) <- performTest reportStart reportErrors reportFailures GuiUpdater tests
+  updateTestsRun $ showCounts counts'
+  return counts'
+    where
+      reportStart state _ = do
+        updateTestsRun $ show $ counts state
+        updateTestBar $ counts state
+        return GuiUpdater
+      reportErrors msg state _ = reportErrorsFailures (describeError msg state) state
+      reportFailures msg state _ = reportErrorsFailures (describeFailure msg state) state
+      reportErrorsFailures msg state = do
+        updateTestBar $ counts state
+        updateFailureDetails msg
+        return GuiUpdater
+
+-- trivial "state" token
+data GuiUpdater = GuiUpdater
+
diff --git a/Test/HUnit/Gui/Status.hs b/Test/HUnit/Gui/Status.hs
new file mode 100644
--- /dev/null
+++ b/Test/HUnit/Gui/Status.hs
@@ -0,0 +1,12 @@
+module Test.HUnit.Gui.Status (Status(..), succeeded)
+where
+
+import Test.HUnit.Base
+
+data Status = Red
+            | Green
+              deriving (Show, Eq)
+
+succeeded :: Counts -> Status
+succeeded (Counts { errors = 0, failures = 0 }) = Green
+succeeded _ = Red
diff --git a/Test/HUnit/Gui/Window.hs b/Test/HUnit/Gui/Window.hs
new file mode 100644
--- /dev/null
+++ b/Test/HUnit/Gui/Window.hs
@@ -0,0 +1,70 @@
+module Test.HUnit.Gui.Window (runTestGui, exitWhenGuiCloses)
+where
+
+import Control.Concurrent
+import Graphics.UI.Gtk
+import System.Exit
+import Test.HUnit
+
+import Test.HUnit.Gui.Bar
+import Test.HUnit.Gui.Runner
+import Test.HUnit.Gui.Status
+
+runTestGui :: Test -> IO (Counts, ThreadId)
+runTestGui tests = do
+  guiInterfaceVar <- newEmptyMVar
+  guiThread <- forkIO $ runGui guiInterfaceVar
+  guiInterface <- takeMVar guiInterfaceVar
+  putStrLn "Close the GUI window to end the test session"
+  counts' <- runTests guiInterface tests
+  return (counts', guiThread)
+
+exitWhenGuiCloses :: (Counts, ThreadId) -> IO ()
+exitWhenGuiCloses (counts', guiThread) = do
+  waitForGuiToClose guiThread
+  exitWithProperStatusCode
+      where
+        exitWithProperStatusCode = exitWith $ statusCodeFor $ succeeded counts'
+        statusCodeFor Green = ExitSuccess
+        statusCodeFor Red = ExitFailure 2
+
+waitForGuiToClose :: ThreadId -> IO ()
+waitForGuiToClose guiThread = do
+  killThread guiThread
+
+runGui :: MVar GuiInterface -> IO ()
+runGui guiInterfaceVar = do
+  initGUI
+  window <- windowNew
+  onDestroy window mainQuit
+
+  container <- vBoxNew False 20
+  set window [ containerChild := container ]
+  set window [ containerBorderWidth := 30 ]
+
+  testsRun <- labelNew $ Just "--"
+  containerAdd container testsRun
+
+  failureDetails <- labelNew $ Nothing
+  containerAdd container failureDetails
+
+  bar <- createBar (containerAdd container)
+
+  widgetShowAll window
+  idleAdd (do yield
+              return True) priorityDefaultIdle
+
+  putMVar guiInterfaceVar (GuiInterface
+                           (labelSetText testsRun)
+                           (labelAppendText failureDetails)
+                           (changeBar bar))
+
+  mainGUI
+
+labelAppendText :: Label -> String -> IO ()
+labelAppendText label str =
+    do
+      text <- labelGetText label
+      labelSetText label (case text of "" -> str
+                                       _ -> text ++ "\n\n" ++ str)
+
diff --git a/examples/Main.hs b/examples/Main.hs
new file mode 100644
--- /dev/null
+++ b/examples/Main.hs
@@ -0,0 +1,26 @@
+module Main
+where
+
+import Test.HUnit
+import Test.HUnit.Gui
+
+main = do
+  testInfo <- runTestGui bigLongTests
+  exitWhenGuiCloses testInfo
+
+-- First and third tests should pass; second and fourth should fail
+bigLongTests :: Test
+bigLongTests = test [ "first" ~: 224743 ~=? (head $ drop 20000 primes)
+                    , "second" ~: 22 ~=? (head $ drop 40000 primes)
+                    , "third" ~: 746777 ~=? (head $ drop 60000 primes)
+                    , "fourth" ~: 44 ~=? (head $ drop 80000 primes)
+                    ]
+    where
+      odds = [3,5..] :: [Integer]
+      primeToList n = not . any (\p -> n `mod` p == 0)
+      primes =
+          let aux [] = []
+              aux ns@(p:_) =
+                  let (knownPrimes, remaining) = span (\n -> n < p*p) ns
+                  in knownPrimes ++ (aux $ filter (\n -> primeToList n knownPrimes) remaining)
+          in 2 : (aux odds)
diff --git a/hunit-gui.cabal b/hunit-gui.cabal
new file mode 100644
--- /dev/null
+++ b/hunit-gui.cabal
@@ -0,0 +1,42 @@
+Name:           hunit-gui
+Version:        0.1
+Cabal-Version:  >= 1.6
+License:        PublicDomain
+Author:         Kim Wallmark
+Homepage:       http://patch-tag.com/r/kwallmar/hunit_gui/home
+Category:       Testing
+Synopsis:       A GUI testrunner for HUnit
+Build-Type:     Simple
+Data-Files:     examples/Main.hs
+Maintainer:	kim_hunitgui@arlim.org
+Description:
+    hunit-gui is a graphical front-end for HUnit.  It provides a test
+    controller you can use in place of runTestTT or runTestText, as well
+    as an optional cleanup step.
+
+Library
+  Exposed-modules:
+    Test.HUnit.Gui,
+    Test.HUnit.Gui.Bar,
+    Test.HUnit.Gui.BarComputations,
+    Test.HUnit.Gui.Descriptions,
+    Test.HUnit.Gui.Runner,
+    Test.HUnit.Gui.Status,
+    Test.HUnit.Gui.Window
+  Hs-Source-Dirs:   .
+  Build-Depends:
+    base == 3.*,
+    HUnit == 1.2.*,
+    gtk == 0.10.*,
+    cairo == 0.10.*
+  Ghc-Options:      -Wall
+
+Executable tests
+  Main-Is:           AllTests.hs
+  Hs-Source-Dirs:    . tests
+  Build-Depends:
+    base == 3.*,
+    HUnit == 1.2.*,
+    gtk == 0.10.*,
+    cairo == 0.10.*
+  Ghc-Options:       -Wall
diff --git a/tests/AllTests.hs b/tests/AllTests.hs
new file mode 100644
--- /dev/null
+++ b/tests/AllTests.hs
@@ -0,0 +1,17 @@
+module Main (main)
+where
+
+import Test.HUnit
+import Test.HUnit.Gui
+
+import qualified BarComputationsTests
+import qualified DescriptionsTests
+import qualified StatusTests
+
+main :: IO ()
+main = do
+  testInfo <- runTestGui $ test [ StatusTests.tests
+                               , DescriptionsTests.tests
+                               , BarComputationsTests.tests
+                               ]
+  exitWhenGuiCloses testInfo