packages feed

nanospec (empty) → 0.1.0

raw patch · 5 files changed

+287/−0 lines, 5 filesdep +basedep +hspecdep +silentlysetup-changed

Dependencies added: base, hspec, silently

Files

+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2012 Simon Hengel <sol@typeful.net>++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ nanospec.cabal view
@@ -0,0 +1,45 @@+name:             nanospec+version:          0.1.0+license:          MIT+license-file:     LICENSE+copyright:        (c) 2012 Simon Hengel+author:           Simon Hengel <sol@typeful.net>+maintainer:       Simon Hengel <sol@typeful.net>+category:         Testing+synopsis:         A lightweight implementation of a subset of Hspec's API+description:      A lightweight implementation of a subset of Hspec's API with+                  minimal dependencies.+build-type:       Simple+cabal-version:    >= 1.8++source-repository head+  type: git+  location: https://github.com/hspec/nanospec++library+  exposed:+      False+  ghc-options:+      -Wall+  hs-source-dirs:+      src+  exposed-modules:+      Test.Hspec+  build-depends:+      base >= 4 && <= 5++test-suite spec+  type:+      exitcode-stdio-1.0+  cpp-options:+      -DTEST+  ghc-options:+      -Wall -Werror+  hs-source-dirs:+      src, test+  main-is:+      Test/HspecSpec.hs+  build-depends:+      base+    , hspec >= 1.3+    , silently
+ src/Test/Hspec.hs view
@@ -0,0 +1,132 @@+{-# 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++#ifdef TEST+-- * Internal stuff+, evaluateExpectation+, Result (..)+#endif+) 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))+  ]
+ test/Test/HspecSpec.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE PackageImports #-}+module Main (main) where++import "hspec"   Test.Hspec++import           Control.Applicative+import qualified Test.Hspec as H+import qualified Control.Exception as E+import           System.Exit+import           System.IO.Silently++main :: IO ()+main = hspec spec++failingSpec :: H.Spec+failingSpec = do+  H.describe "foo" $ do+    H.it "foo 1" success+    H.it "foo 2" failure+    H.describe "bar" $ do+      H.it "bar 1" failure+      H.it "bar 2" success+  H.describe "baz" $ do+    H.it "baz 1" failure+  where+    success = H.expect "success" True+    failure = H.expect "failure" False++runSpec :: H.Spec -> IO [String]+runSpec s = lines . fst <$> capture (H.hspec s `E.catch` ignore)+  where+    ignore :: ExitCode -> IO ()+    ignore _ = return ()++spec :: Spec+spec = do++  describe "hspec" $ do+    it "exits with exitFailure if not all examples pass" $ do+      H.hspec failingSpec `shouldThrow` (== ExitFailure 1)++    it "prints a report of the test run" $ do+      runSpec failingSpec `shouldReturn` [+          "/foo/foo 1/ OK"+        , "/foo/foo 2/ FAILED"+        , "failure"+        , "/foo/bar/bar 1/ FAILED"+        , "failure"+        , "/foo/bar/bar 2/ OK"+        , "/baz/baz 1/ FAILED"+        , "failure"+        , "5 example(s), 3 failure(s)"+        ]++  describe "evaluateExpectation" $ do+    it "returns Success if expectation holds" $ do+      H.evaluateExpectation (H.expect "foo" True)+        `shouldReturn` H.Success++    it "returns Failure if expectation does not holds" $ do+      H.evaluateExpectation (H.expect "foo" False)+        `shouldReturn` H.Failure "foo"++    it "returns Failure on uncaught exceptions" $ do+      H.evaluateExpectation (E.throwIO $ E.ErrorCall "foobar")+        `shouldReturn` H.Failure "*** Exception: foobar"++    it "re-throws asynchronous exceptions" $ do+      H.evaluateExpectation (E.throwIO E.UserInterrupt)+        `shouldThrow` (== E.UserInterrupt)++  describe "shouldBe" $ do+    it "succeeds if arguments are equal" $ do+      H.evaluateExpectation (23 `H.shouldBe` (23 :: Int))+        `shouldReturn` H.Success++    it "fails if arguments are not equal" $ do+      H.evaluateExpectation (23 `H.shouldBe` (42 :: Int))+        `shouldReturn` H.Failure "expected: 42\n but got: 23"++  describe "shouldReturn" $ do+    it "succeeds if arguments represent equal values" $ do+      H.evaluateExpectation (return 23 `H.shouldReturn` (23 :: Int))+        `shouldReturn` H.Success++    it "fails if arguments do not represent equal values" $ do+      H.evaluateExpectation (return 23 `H.shouldReturn` (42 :: Int))+        `shouldReturn` H.Failure "expected: 42\n but got: 23"