diff options
Diffstat (limited to 'tests/nanospec/Test')
| -rw-r--r-- | tests/nanospec/Test/Hspec.hs | 126 | 
1 files changed, 0 insertions, 126 deletions
| diff --git a/tests/nanospec/Test/Hspec.hs b/tests/nanospec/Test/Hspec.hs deleted file mode 100644 index 904ce2e0..00000000 --- a/tests/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)) -  ] | 
