[commit: haddock] master: Use Hspec instead of nanospec (489d95b)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branch  : master
Link       : http://git.haskell.org/?p=haddock.git;a=commit;h=489d95b9603c1f34575a67b2d1f069e80769d59a

>---------------------------------------------------------------

commit 489d95b9603c1f34575a67b2d1f069e80769d59a
Author: Mateusz Kowalczyk <fuuzetsu at fuuzetsu.co.uk>
Date:   Sat Aug 10 13:57:58 2013 +0100

    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.


>---------------------------------------------------------------

489d95b9603c1f34575a67b2d1f069e80769d59a
 haddock.cabal               |    3 +-
 test/nanospec/README        |    6 ---
 test/nanospec/Test/Hspec.hs |  126 -------------------------------------------
 3 files changed, 1 insertion(+), 134 deletions(-)

diff --git a/haddock.cabal b/haddock.cabal
index 054a50f..78fbe17 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 ffce7c7..0000000
--- 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 904ce2e..0000000
--- 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))
-  ]