hspec-2.2.1/0000755000000000000000000000000012627366732011022 5ustar0000000000000000hspec-2.2.1/LICENSE0000644000000000000000000000226112627366732012030 0ustar0000000000000000Copyright (c) 2011-2015 Simon Hengel Copyright (c) 2011-2012 Trystan Spangler Copyright (c) 2011-2011 Greg Weber 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. hspec-2.2.1/changelog0000644000000000000000000000010012627366732012663 0ustar0000000000000000See https://github.com/hspec/hspec/blob/master/CHANGES.markdown hspec-2.2.1/hspec.cabal0000644000000000000000000000403012627366732013105 0ustar0000000000000000name: hspec version: 2.2.1 license: MIT license-file: LICENSE copyright: (c) 2011-2015 Simon Hengel, (c) 2011-2012 Trystan Spangler, (c) 2011 Greg Weber maintainer: Simon Hengel build-type: Simple cabal-version: >= 1.10 category: Testing stability: experimental bug-reports: https://github.com/hspec/hspec/issues homepage: http://hspec.github.io/ synopsis: A Testing Framework for Haskell description: Hspec is a testing framework for Haskell. It is inspired by the Ruby library RSpec. Some of Hspec's distinctive features are: . * a friendly DSL for defining tests . * integration with QuickCheck, SmallCheck, and HUnit . * parallel test execution . * automatic discovery of test files . The Hspec Manual is at . extra-source-files: changelog source-repository head type: git location: https://github.com/hspec/hspec library ghc-options: -Wall hs-source-dirs: src build-depends: base == 4.* , hspec-core == 2.2.1 , hspec-discover == 2.2.1 , hspec-expectations == 0.7.2.* , transformers >= 0.2.2.0 , QuickCheck >= 2.5.1 , HUnit >= 1.2.5 exposed-modules: Test.Hspec Test.Hspec.Runner Test.Hspec.Formatters Test.Hspec.QuickCheck Test.Hspec.Discover Test.Hspec.Core Test.Hspec.HUnit default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 ghc-options: -Wall hs-source-dirs: test main-is: Spec.hs other-modules: Helper HelperSpec Test.Hspec.DiscoverSpec build-depends: base == 4.* , hspec-core , hspec , directory , stringbuilder , hspec-meta >= 2.2.0 default-language: Haskell2010 hspec-2.2.1/Setup.lhs0000644000000000000000000000011412627366732012626 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain hspec-2.2.1/test/0000755000000000000000000000000012627366732012001 5ustar0000000000000000hspec-2.2.1/test/Helper.hs0000644000000000000000000000066512627366732013563 0ustar0000000000000000module Helper ( module Test.Hspec.Meta , withFileContent ) where import Control.Exception (finally) import System.Directory import System.IO import Test.Hspec.Meta withFileContent :: String -> (FilePath -> IO a) -> IO a withFileContent input action = do dir <- getTemporaryDirectory (file, h) <- openTempFile dir "temp" hPutStr h input hClose h action file `finally` removeFile file hspec-2.2.1/test/Spec.hs0000644000000000000000000000006112627366732013224 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-meta-discover #-} hspec-2.2.1/test/HelperSpec.hs0000644000000000000000000000101212627366732014361 0ustar0000000000000000module HelperSpec (main, spec) where import Helper import System.IO.Error (isDoesNotExistError) main :: IO () main = hspec spec spec :: Spec spec = do describe "withFileContent" $ do it "creates a file with specified content and runs specified action" $ do withFileContent "foo" $ \file -> do readFile file `shouldReturn` "foo" it "removes file after action has been run" $ do file <- withFileContent "foo" return readFile file `shouldThrow` isDoesNotExistError hspec-2.2.1/test/Test/0000755000000000000000000000000012627366732012720 5ustar0000000000000000hspec-2.2.1/test/Test/Hspec/0000755000000000000000000000000012627366732013762 5ustar0000000000000000hspec-2.2.1/test/Test/Hspec/DiscoverSpec.hs0000644000000000000000000000510512627366732016710 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} module Test.Hspec.DiscoverSpec (main, spec) where import Helper import Data.String import Data.String.Builder import qualified Test.Hspec.Core.Spec as H import Test.Hspec.Core (Tree(..), Item(..), Location(..), LocationAccuracy(..), runSpecM) import qualified Test.Hspec.Discover as H infix 1 `shouldHaveLocation` shouldHaveLocation :: Item a -> (String, Int) -> Expectation item `shouldHaveLocation` (src, line) = itemLocation item `shouldBe` Just (Location src line 0 BestEffort) removeLocations :: H.SpecWith a -> H.SpecWith a removeLocations = H.mapSpecItem_ (\item -> item{H.itemLocation = Nothing}) main :: IO () main = hspec spec spec :: Spec spec = do describe "postProcessSpec" $ do it "adds heuristic source locations" $ do let c = build $ do "" strlit "foo" "" strlit "bar" "" strlit "baz" withFileContent c $ \src -> do [Leaf item1, Leaf item2, Leaf item3] <- runSpecM . H.postProcessSpec src . removeLocations $ do H.it "foo" True H.it "bar" True H.it "baz" True item1 `shouldHaveLocation` (src, 2) item2 `shouldHaveLocation` (src, 4) item3 `shouldHaveLocation` (src, 6) context "when same requirement is used multiple times" $ do it "assigns locations sequentially" $ do let c = build $ do strlit "foo" strlit "foo" strlit "foo" withFileContent c $ \src -> do [Leaf item1, Leaf item2, Leaf item3] <- runSpecM . H.postProcessSpec src . removeLocations $ do H.it "foo" True H.it "foo" True H.it "foo" True item1 `shouldHaveLocation` (src, 1) item2 `shouldHaveLocation` (src, 2) item3 `shouldHaveLocation` (src, 3) context "when a requirement occurs more often in the spec tree than in the source file" $ do it "assigns Nothing" $ do let c = build $ do strlit "foo" strlit "foo" withFileContent c $ \src -> do [Leaf item1, Leaf item2, Leaf item3] <- runSpecM . H.postProcessSpec src . removeLocations $ do H.it "foo" True H.it "foo" True H.it "foo" True itemLocation item1 `shouldBe` Nothing itemLocation item2 `shouldBe` Nothing itemLocation item3 `shouldBe` Nothing where strlit :: String -> Builder strlit = fromString . show hspec-2.2.1/src/0000755000000000000000000000000012627366732011611 5ustar0000000000000000hspec-2.2.1/src/Test/0000755000000000000000000000000012627366732012530 5ustar0000000000000000hspec-2.2.1/src/Test/Hspec.hs0000644000000000000000000000246312627366732014133 0ustar0000000000000000-- | -- Stability: stable -- -- Hspec is a testing framework for Haskell. -- -- This is the library reference for Hspec. -- The contains more in-depth -- documentation. module Test.Hspec ( -- * Types Spec , SpecWith , Arg , Example -- * Setting expectations , module Test.Hspec.Expectations -- * Defining a spec , describe , context , it , specify , example , pending , pendingWith , parallel , runIO -- * Hooks , ActionWith , before , before_ , beforeWith , beforeAll , beforeAll_ , after , after_ , afterAll , afterAll_ , around , around_ , aroundWith -- * Running a spec , hspec ) where import Test.Hspec.Core.Spec import Test.Hspec.Core.Hooks import Test.Hspec.Runner import Test.Hspec.Expectations -- | @example@ is a type restricted version of `id`. It can be used to get better -- error messages on type mismatches. -- -- Compare e.g. -- -- > it "exposes some behavior" $ example $ do -- > putStrLn -- -- with -- -- > it "exposes some behavior" $ do -- > putStrLn example :: Expectation -> Expectation example = id -- | @context@ is an alias for `describe`. context :: String -> SpecWith a -> SpecWith a context = describe -- | @specify@ is an alias for `it`. specify :: Example a => String -> a -> SpecWith (Arg a) specify = it hspec-2.2.1/src/Test/Hspec/0000755000000000000000000000000012627366732013572 5ustar0000000000000000hspec-2.2.1/src/Test/Hspec/Core.hs0000644000000000000000000000075012627366732015020 0ustar0000000000000000-- | Stability: unstable module Test.Hspec.Core {-# DEPRECATED "use \"Test.Hspec.Core.Spec\" instead" #-} ( module Test.Hspec.Core.Spec -- * Deprecated functions , describe , it ) where import Test.Hspec.Core.Spec hiding (describe, it) {-# DEPRECATED describe "use `specGroup` instead" #-} describe :: String -> [SpecTree a] -> SpecTree a describe = specGroup {-# DEPRECATED it "use `specItem` instead" #-} it :: Example a => String -> a -> SpecTree (Arg a) it = specItem hspec-2.2.1/src/Test/Hspec/Runner.hs0000644000000000000000000000014712627366732015401 0ustar0000000000000000module Test.Hspec.Runner (module Test.Hspec.Core.Runner) where import Test.Hspec.Core.Runner hspec-2.2.1/src/Test/Hspec/QuickCheck.hs0000644000000000000000000000127412627366732016144 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,8,1) #define HAS_SOURCE_LOCATIONS {-# LANGUAGE ImplicitParams #-} #endif module Test.Hspec.QuickCheck ( -- * Params modifyMaxSuccess , modifyMaxDiscardRatio , modifyMaxSize -- * Shortcuts , prop ) where #ifdef HAS_SOURCE_LOCATIONS import GHC.Stack #endif import Test.Hspec import Test.QuickCheck import Test.Hspec.Core.QuickCheck -- | -- > prop ".." $ -- > .. -- -- is a shortcut for -- -- > it ".." $ property $ -- > .. #ifdef HAS_SOURCE_LOCATIONS prop :: (?loc :: CallStack, Testable prop) => String -> prop -> Spec #else prop :: (Testable prop) => String -> prop -> Spec #endif prop s = it s . property hspec-2.2.1/src/Test/Hspec/Formatters.hs0000644000000000000000000000016312627366732016254 0ustar0000000000000000module Test.Hspec.Formatters (module Test.Hspec.Core.Formatters) where import Test.Hspec.Core.Formatters hspec-2.2.1/src/Test/Hspec/HUnit.hs0000644000000000000000000000136112627366732015156 0ustar0000000000000000module Test.Hspec.HUnit {-# DEPRECATED "use \"Test.Hspec.Contrib.HUnit\" from package @hspec-contrib@ instead" #-} ( -- * Interoperability with HUnit fromHUnitTest ) where import Test.Hspec.Core.Spec import Test.HUnit (Test (..)) -- | -- Convert a HUnit test suite to a spec. This can be used to run existing -- HUnit tests with Hspec. fromHUnitTest :: Test -> Spec fromHUnitTest t = case t of TestList xs -> mapM_ go xs x -> go x where go :: Test -> Spec go t_ = case t_ of TestLabel s (TestCase e) -> it s e TestLabel s (TestList xs) -> describe s (mapM_ go xs) TestLabel s x -> describe s (go x) TestList xs -> describe "" (mapM_ go xs) TestCase e -> it "" e hspec-2.2.1/src/Test/Hspec/Discover.hs0000644000000000000000000000641512627366732015712 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} module Test.Hspec.Discover {-# WARNING "This module is used by @hspec-discover@. It is not part of the public API and may change at any time." #-} ( Spec , hspec , IsFormatter (..) , hspecWithFormatter , postProcessSpec , describe , module Prelude ) where import Prelude hiding (mapM) import Control.Applicative import Data.Maybe import Data.List import Data.Traversable import Control.Monad.Trans.State import Test.Hspec.Core.Spec import Test.Hspec.Core.Runner import Test.Hspec.Formatters import Test.Hspec.Core.Util (safeTry) class IsFormatter a where toFormatter :: a -> IO Formatter instance IsFormatter (IO Formatter) where toFormatter = id instance IsFormatter Formatter where toFormatter = return hspecWithFormatter :: IsFormatter a => a -> Spec -> IO () hspecWithFormatter formatter spec = do f <- toFormatter formatter hspecWith defaultConfig {configFormatter = Just f} spec postProcessSpec :: FilePath -> Spec -> Spec postProcessSpec = locationHeuristicFromFile locationHeuristicFromFile :: FilePath -> Spec -> Spec locationHeuristicFromFile file spec = do mInput <- either (const Nothing) Just <$> (runIO . safeTry . readFile) file let lookupLoc = maybe (\_ _ _ -> Nothing) (lookupLocation file) mInput runIO (runSpecM spec) >>= fromSpecList . addLoctions lookupLoc addLoctions :: (Int -> Int -> String -> Maybe Location) -> [SpecTree a] -> [SpecTree a] addLoctions lookupLoc = map (fmap f) . enumerate where f :: ((Int, Int), Item a) -> Item a f ((n, total), item) = item {itemLocation = itemLocation item <|> lookupLoc n total (itemRequirement item)} type EnumerateM = State [(String, Int)] enumerate :: [SpecTree a] -> [Tree (ActionWith a) ((Int, Int), (Item a))] enumerate tree = (mapM (traverse addPosition) tree >>= mapM (traverse addTotal)) `evalState` [] where addPosition :: Item a -> EnumerateM (Int, Item a) addPosition item = (,) <$> getOccurrence (itemRequirement item) <*> pure item addTotal :: (Int, Item a) -> EnumerateM ((Int, Int), Item a) addTotal (n, item) = do total <- getTotal (itemRequirement item) return ((n, total), item) getTotal :: String -> EnumerateM Int getTotal requirement = do gets $ fromMaybe err . lookup requirement where err = error ("Test.Hspec.Discover.getTotal: No entry for requirement " ++ show requirement ++ "!") getOccurrence :: String -> EnumerateM Int getOccurrence requirement = do xs <- get let n = maybe 1 succ (lookup requirement xs) put ((requirement, n) : filter ((/= requirement) . fst) xs) return n lookupLocation :: FilePath -> String -> Int -> Int -> String -> Maybe Location lookupLocation file input n total requirement = loc where loc :: Maybe Location loc = Location file <$> line <*> pure 0 <*> pure BestEffort line :: Maybe Int line = case occurrences of xs | length xs == total -> Just (xs !! pred n) _ -> Nothing occurrences :: [Int] occurrences = map fst (filter p inputLines) where p :: (Int, String) -> Bool p = isInfixOf (show requirement) . snd inputLines :: [(Int, String)] inputLines = zip [1..] (lines input)