Use Hspec instead of nanospec

This is motivated by the fact that Haddock tests are not ran by the
GHC's ‘validate’ script so we're pretty liberal on dependencies in that
area. Full Hspec gives us some nice features such as Quickcheck integration.

3 files changed, 1 insertions, 134 deletions

diff --git a/haddock.cabal b/haddock.cabal
index 054a50f9..78fbe172 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -205,11 +205,9 @@ test-suite spec
   main-is:          Spec.hs
   hs-source-dirs:
       test
-    , test/nanospec
     , src
 
   other-modules:
-      Test.Hspec
       Haddock.ParseSpec
 
   build-depends:
@@ -218,6 +216,7 @@ test-suite spec
     , containers
     , deepseq
     , array
+    , hspec
 
   -- NOTE: As of this writing, Cabal does not properly handle alex/happy for
   -- test suites.  We work around this by adding dist/build to hs-source-dirs,
diff --git a/test/nanospec/README b/test/nanospec/README
deleted file mode 100644
index ffce7c74..00000000
--- a/test/nanospec/README
+++ /dev/null
@@ -1,6 +0,0 @@
-A lightweight implementation of a subset of Hspec's API with minimal
-dependencies.
-
-http://hackage.haskell.org/package/nanospec
-
-This is a copy of version 0.1.0.
diff --git a/test/nanospec/Test/Hspec.hs b/test/nanospec/Test/Hspec.hs
deleted file mode 100644
index 904ce2e0..00000000
--- a/test/nanospec/Test/Hspec.hs
+++ /dev/null
@@ -1,126 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable, CPP #-}
--- | A lightweight implementation of a subset of Hspec's API.
-module Test.Hspec (
--- * Types
-  SpecM
-, Spec
-
--- * Defining a spec
-, describe
-, context
-, it
-
--- ** Setting expectations
-, Expectation
-, expect
-, shouldBe
-, shouldReturn
-
--- * Running a spec
-, hspec
-) where
-
-import           Control.Applicative
-import           Control.Monad
-import           Data.Monoid
-import           Data.List (intercalate)
-import           Data.Typeable
-import qualified Control.Exception as E
-import           System.Exit
-
--- a writer monad
-data SpecM a = SpecM a [SpecTree]
-
-add :: SpecTree -> SpecM ()
-add s = SpecM () [s]
-
-instance Monad SpecM where
-  return a             = SpecM a []
-  SpecM a xs >>= f = case f a of
-    SpecM b ys -> SpecM b (xs ++ ys)
-
-data SpecTree = SpecGroup String Spec
-              | SpecExample String (IO Result)
-
-data Result = Success | Failure String
-  deriving (Eq, Show)
-
-type Spec = SpecM ()
-
-describe :: String -> Spec -> Spec
-describe label = add . SpecGroup label
-
-context :: String -> Spec -> Spec
-context = describe
-
-it :: String -> Expectation -> Spec
-it label = add . SpecExample label . evaluateExpectation
-
--- | Summary of a test run.
-data Summary = Summary Int Int
-
-instance Monoid Summary where
-  mempty = Summary 0 0
-  (Summary x1 x2) `mappend` (Summary y1 y2) = Summary (x1 + y1) (x2 + y2)
-
-runSpec :: Spec -> IO Summary
-runSpec = runForrest []
-  where
-    runForrest :: [String] -> Spec -> IO Summary
-    runForrest labels (SpecM () xs) = mconcat <$> mapM (runTree labels) xs
-
-    runTree :: [String] -> SpecTree -> IO Summary
-    runTree labels spec = case spec of
-      SpecExample label x -> do
-        putStr $ "/" ++ (intercalate "/" . reverse) (label:labels) ++ "/ "
-        r <- x
-        case r of
-          Success   -> do
-            putStrLn "OK"
-            return (Summary 1 0)
-          Failure err -> do
-            putStrLn "FAILED"
-            putStrLn err
-            return (Summary 1 1)
-      SpecGroup label xs  -> do
-        runForrest (label:labels) xs
-
-hspec :: Spec -> IO ()
-hspec spec = do
-  Summary total failures <- runSpec spec
-  putStrLn (show total ++ " example(s), " ++ show failures ++ " failure(s)")
-  when (failures /= 0) exitFailure
-
-type Expectation = IO ()
-
-infix 1 `shouldBe`, `shouldReturn`
-
-shouldBe :: (Show a, Eq a) => a -> a -> Expectation
-actual `shouldBe` expected =
-  expect ("expected: " ++ show expected ++ "\n but got: " ++ show actual) (actual == expected)
-
-shouldReturn :: (Show a, Eq a) => IO a -> a -> Expectation
-action `shouldReturn` expected = action >>= (`shouldBe` expected)
-
-expect :: String -> Bool -> Expectation
-expect label f
-  | f         = return ()
-  | otherwise = E.throwIO (ExpectationFailure label)
-
-data ExpectationFailure = ExpectationFailure String
-  deriving (Show, Eq, Typeable)
-
-instance E.Exception ExpectationFailure
-
-evaluateExpectation :: Expectation -> IO Result
-evaluateExpectation action = (action >> return Success)
-  `E.catches` [
-  -- Re-throw AsyncException, otherwise execution will not terminate on SIGINT
-  -- (ctrl-c).  All AsyncExceptions are re-thrown (not just UserInterrupt)
-  -- because all of them indicate severe conditions and should not occur during
-  -- normal operation.
-    E.Handler $ \e -> E.throw (e :: E.AsyncException)
-
-  , E.Handler $ \(ExpectationFailure err) -> return (Failure err)
-  , E.Handler $ \e -> (return . Failure) ("*** Exception: " ++ show (e :: E.SomeException))
-  ]