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.

1 files changed, 0 insertions, 126 deletions

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))
-  ]