hspec 0.6.1 → 0.8
raw patch · 10 files changed
+756/−161 lines, 10 filesdep +directorydep +filepathdep +hspecdep ~basesetup-changednew-component:exe:hspec
Dependencies added: directory, filepath, hspec, plugins, regex-posix
Dependency ranges changed: base
Files
- Setup.lhs +11/−6
- Specs.hs +30/−24
- Test/Hspec/Core.hs +59/−44
- Test/Hspec/Formatters.hs +40/−28
- Test/Hspec/HUnit.hs +7/−7
- Test/Hspec/Monadic.hs +10/−11
- Test/Hspec/QuickCheck.hs +6/−7
- Test/Hspec/Runner.hs +19/−16
- hspec.cabal +36/−18
- hspec.hs +538/−0
Setup.lhs view
@@ -1,14 +1,19 @@-#!/usr/bin/runhaskell +#!/usr/bin/runhaskell > module Main where+> import System > import Distribution.Simple-> import Distribution.PackageDescription(PackageDescription)-> import Distribution.Simple.LocalBuildInfo(LocalBuildInfo)+> import Distribution.Simple.Setup+> import Distribution.PackageDescription+> import Distribution.Simple.LocalBuildInfo > import System.Cmd(system) > import Distribution.Simple.LocalBuildInfo+> import Test.Hspec+> import Specs (specs) > > main :: IO () > main = defaultMainWithHooks hooks-> where hooks = simpleUserHooks { runTests = runspecs }+> where hooks = simpleUserHooks { runTests = \ _ _ _ _ -> runspecs,+> preSDist = \ _ _ -> runspecs >> return emptyHookedBuildInfo } >-> runspecs :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()-> runspecs _ _ _ lbi = system "runhaskell ./Specs.hs" >> return ()+> runspecs :: IO ()+> runspecs = specs >>= hspecX
Specs.hs view
@@ -17,10 +17,11 @@ main :: IO () main = do ar <- getArgs+ specs' <- specs ss <- case ar of- ["README"] -> withFile "README" WriteMode (\ h -> hPutStrLn h preamble >> hHspec h specs)- [filename] -> withFile filename WriteMode (\ h -> hHspec h specs)- _ -> hspec specs+ ["README"] -> withFile "README" WriteMode (\ h -> hPutStrLn h preamble >> hHspec h specs')+ [filename] -> withFile filename WriteMode (\ h -> hHspec h specs')+ _ -> hspec specs' exitWith $ toExitCode (failedCount ss == 0) preamble :: String@@ -28,6 +29,9 @@ "hspec aims to be a simple, extendable, and useful tool for Behavior Driven Development in Haskell.", "", "", "Step 1, write descriptions and examples of your desired behavior",+ "> module Myabs where",+ ">",+ "> specs :: IO Specs", "> specs = describe \"myabs\" [", "> it \"returns the original number when given a positive input\"", "> (myabs 1 == 1),",@@ -42,12 +46,13 @@ "Step 2, write whatever you are describing", "> myabs n = undefined", "",- "Step 3, watch your examples fail with red text",- "> hspec specs",+ "Step 3, watch your examples fail with red text by running from the .hs file itself",+ "> main = hspec specs",+ "", "myabs",- " x returns the original number when given a positive input FAILED [1]",- " x returns a positive number when given a negative input FAILED [2]",- " x returns zero when given zero FAILED [3]",+ " - returns the original number when given a positive input FAILED [1]",+ " - returns a positive number when given a negative input FAILED [2]",+ " - returns zero when given zero FAILED [3]", "", "1) myabs returns the original number when given a positive input FAILED", "Prelude.undefined",@@ -62,11 +67,14 @@ "", "3 examples, 3 failures", "",+ "",+ "Specs can also be run from the command line using the hspec program",+ " $ hspec myabs.hs",+ "", "Step 4, implement your desired behavior", "> myabs n = if n < 0 then negate n else n", "",- "Step 5, watch your examples pass with green text",- "> hspec specs",+ "Step 5, watch your examples pass with green text when rerun", "myabs", " - returns the original number when given a positive input", " - returns a positive number when given a negative input",@@ -98,26 +106,31 @@ let report = lines reportContents - descriptions [+ return $ descriptions [ describe "the \"describe\" function" [ it "takes a description of what the behavior is for" ((=="Example") . name . head $ exampleSpecs), it "groups behaviors for what's being described"- (all ((=="Example").name) exampleSpecs)+ (all ((=="Example").name) exampleSpecs),++ describe "a nested description" [+ it "has it's own specs"+ (True)+ ] ], describe "the \"it\" function" [ it "takes a description of a desired behavior"- (requirement (Spec "Example" "whatever" Success) == "whatever" ),+ (requirement (Spec "Example" "whatever" Success 0) == "whatever" ), it "takes an example of that behavior"- (result (Spec "Example" "whatever" Success) == Success),+ (result (Spec "Example" "whatever" Success 0) == Success), it "can use a Bool, HUnit Test, QuickCheck property, or \"pending\" as an example" (True), it "will treat exceptions as failures"- (any (==" x exceptions FAILED [3]") report)+ (any (==" - exceptions FAILED [3]") report) ], describe "the \"hspec\" function" [ it "displays a header for each thing being described"@@ -126,18 +139,12 @@ it "displays one row for each behavior" (HUnit.assertEqual "" 29 (length report)), - it "displays a '-' for successfull examples"+ it "displays a row for successfull examples" (any (==" - pass") report), - it "displays an 'x' for failed examples"- (any (==" x fail 1 FAILED [1]") report),- it "displays a detailed list of failed examples" (any (=="1) Example fail 1 FAILED") report), - it "displays a '-' for pending examples"- (any (==" - pending") report ),- it "displays a '#' and an additional message for pending examples" (any (==" # pending message") report ), @@ -199,7 +206,7 @@ (HUnit.assertEqual "" "Example" (lines reportContents !! 1)), it "can use the \"failed_examples\" formatter to show only failed examples"- (HUnit.assertEqual "" " x fail 1 FAILED [1]" (head $ lines failed_examplesReportContents))+ (HUnit.assertEqual "" "1) Example fail 1 FAILED" (lines failed_examplesReportContents !! 1)) ], describe "quantify (an internal function)" [ it "returns an amount and a word given an amount and word"@@ -214,4 +221,3 @@ it "returns a plural word given the number 0" (quantify (0::Int) "thing" == "0 things") ]]-
Test/Hspec/Core.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -XFlexibleInstances #-}+{-# OPTIONS -XFlexibleInstances -XExistentialQuantification #-} -- | This module contains the core types, constructors, classes, -- instances, and utility functions common to hspec.@@ -8,29 +8,67 @@ import System.IO import System.IO.Silently import Control.Exception-import Control.Monad (liftM) -- | The result of running an example.-data Result = Success | Fail String | Pending String+data Result = Success | Pending String | Fail String deriving Eq + -- | Everything needed to specify and show a specific behavior. data Spec = Spec { -- | What is being tested, usually the name of a type. name::String, -- | The specific behavior being tested. requirement::String,- -- | The status of this behavior.- result::Result }+ -- | The status of the example of this behavior.+ result::Result,+ -- | The level of nestedness.+ depth :: Int }+ | UnevaluatedSpec {+ -- | What is being tested, usually the name of a type.+ name::String,+ -- | The specific behavior being tested.+ requirement::String,+ -- | An example of this behavior.+ example::AnyExample,+ -- | The level of nestedness.+ depth :: Int } -data Formatter = Formatter { exampleGroupStarted :: Handle -> Spec -> IO (),++data Formatter = Formatter { formatterName :: String,+ exampleGroupStarted :: Handle -> Spec -> IO (), examplePassed :: Handle -> Spec -> [String] -> IO (), exampleFailed :: Handle -> Spec -> [String] -> IO (), examplePending :: Handle -> Spec -> [String] -> IO (), errorsFormatter :: Handle -> [String] -> IO (),- footerFormatter :: Handle -> [Spec] -> Double -> IO () }+ footerFormatter :: Handle -> [Spec] -> Double -> IO (),+ usesFormatting :: Bool } +describe :: String -> [[Spec]] -> [Spec]+describe label specs = map desc (concat specs)+ where desc spec+ | null $ name spec = spec { name = label }+ | otherwise = spec { depth = depth spec + 1 }++-- | Combine a list of descriptions.+descriptions :: [[Spec]] -> [Spec]+descriptions = concat++-- | Evaluate a Result. Any exceptions (undefined, etc.) are treated as failures.+safely :: Result -> IO Result+safely f = Control.Exception.catch ok failed+ where ok = silence $ f `seq` return f+ failed e = return $ Fail (show (e :: SomeException))+++evaluateSpec :: Spec -> IO Spec+evaluateSpec (UnevaluatedSpec name' requirement' example' depth') = do+ r <- evaluateExample example'+ return $ Spec name' requirement' r depth'+evaluateSpec spec = return spec++ -- | Create a set of specifications for a specific type being described. -- Once you know what you want specs for, use this. --@@ -39,48 +77,26 @@ -- > (abs (-1) == 1) -- > ] ---describe :: String -- ^ The name of what is being described, usually a function or type.- -> [IO (String, Result)] -- ^ A list of behaviors and examples, created by a list of 'it'.- -> IO [IO Spec]-describe n = return . map (>>= \ (req, res) -> return (Spec n req res))+it :: Example a => String -> a -> [Spec]+it requirement' example' = [UnevaluatedSpec "" requirement' (AnyExample example') 0] --- | Combine a list of descriptions.-descriptions :: [IO [IO Spec]] -> IO [IO Spec]-descriptions = liftM concat . sequence+class Example a where+ evaluateExample :: a -> IO Result --- | Evaluate a Result. Any exceptions (undefined, etc.) are treated as failures.-safely :: Result -> IO Result-safely f = Control.Exception.catch ok failed- where ok = silence $ f `seq` return f- failed e = return $ Fail (show (e :: SomeException))+instance Example Bool where+ evaluateExample bool = safely $ if bool then Success else Fail "" --- | Anything that can be used as an example of a behavior.-class SpecVerifier a where- -- | Create a description and example of a behavior, a list of these- -- is used by 'describe'. Once you know what you want to specify, use this.- --- -- > describe "closeEnough" [- -- > it "is true if two numbers are almost the same"- -- > (1.001 `closeEnough` 1.002),- -- >- -- > it "is false if two numbers are not almost the same"- -- > (not $ 1.001 `closeEnough` 1.003)- -- > ]- --- it :: String -- ^ A description of this behavior.- -> a -- ^ An example for this behavior.- -> IO (String, Result)+instance Example Result where+ evaluateExample result' = safely result' -instance SpecVerifier Bool where- it description example = do- r <- safely (if example then Success else Fail "")- return (description, r)+-- | An existentially quantified @Example@. This way they can be mixed within the same set of Specs+data AnyExample = forall a. Example a => AnyExample a -instance SpecVerifier Result where- it description example = do- r <- safely example- return (description, r)+instance Example AnyExample where+ evaluateExample (AnyExample a) = evaluateExample a ++ -- | Declare an example as not successful or failing but pending some other work. -- If you want to report on a behavior but don't have an example yet, use this. --@@ -102,7 +118,6 @@ success :: [Spec] -> Bool success = not . failure- isFailure :: Result -> Bool isFailure (Fail _) = True
Test/Hspec/Formatters.hs view
@@ -2,6 +2,7 @@ -- They follow a structure similar to RSpec formatters. -- module Test.Hspec.Formatters (+ restoreFormat, silent, specdoc, progress, failed_examples ) where @@ -13,39 +14,50 @@ import System.Console.ANSI silent :: Bool -> Formatter-silent _ = Formatter {+silent useColor = Formatter {+ formatterName = "silent", exampleGroupStarted = \ _ _ -> return (), examplePassed = \ _ _ _ -> return (), exampleFailed = \ _ _ _ -> return (), examplePending = \ _ _ _ -> return (), errorsFormatter = \ _ _ -> return (),- footerFormatter = \ _ _ _ -> return ()+ footerFormatter = \ _ _ _ -> return (),+ usesFormatting = useColor } +indentationFor :: Spec -> String+indentationFor spec = replicate (depth spec * 2) ' ' specdoc :: Bool -> Formatter-specdoc useColor = Formatter {+specdoc useColor = (silent useColor) {+ formatterName = "specdoc",+ exampleGroupStarted = \ h spec -> do when useColor (normalColor h)- hPutStr h ('\n' : name spec ++ "\n"),+ hPutStrLn h ("\n" ++ indentationFor spec ++ name spec)+ when useColor (restoreFormat h), examplePassed = \ h spec _ -> do when useColor (passColor h)- hPutStrLn h $ " - " ++ requirement spec,+ hPutStrLn h $ indentationFor spec ++ " - " ++ requirement spec+ when useColor (restoreFormat h), exampleFailed = \ h spec errors -> do when useColor (failColor h)- hPutStrLn h $ " x " ++ requirement spec ++ " FAILED [" ++ (show $ (length errors) + 1) ++ "]",+ hPutStrLn h $ indentationFor spec ++ " - " ++ requirement spec ++ " FAILED [" ++ (show $ (length errors) + 1) ++ "]"+ when useColor (restoreFormat h), examplePending = \ h spec _ -> do when useColor (pendingColor h) let (Pending s) = result spec- hPutStrLn h $ " - " ++ requirement spec ++ "\n # " ++ s,+ hPutStrLn h $ indentationFor spec ++ " - " ++ requirement spec ++ "\n # " ++ s+ when useColor (restoreFormat h), errorsFormatter = \ h errors -> do when useColor (failColor h) mapM_ (hPutStrLn h) ("" : intersperse "" errors)- when (not $ null errors) (hPutStrLn h ""),+ when (not $ null errors) (hPutStrLn h "")+ when useColor (restoreFormat h), footerFormatter = \ h specs time -> do when useColor (if failedCount specs == 0 then passColor h else failColor h)@@ -53,30 +65,34 @@ hPutStrLn h "" hPutStr h $ quantify (length specs) "example" ++ ", " hPutStrLn h $ quantify (failedCount specs) "failure"- when useColor (normalColor h)+ when useColor (restoreFormat h) } progress :: Bool -> Formatter-progress useColor = Formatter {- exampleGroupStarted = \ _ _ -> return (),+progress useColor = (silent useColor) {+ formatterName = "progress", examplePassed = \ h _ _ -> do when useColor (passColor h)- hPutStr h ".",+ hPutStr h "."+ when useColor (restoreFormat h), exampleFailed = \ h _ _ -> do when useColor (failColor h)- hPutStr h "F",+ hPutStr h "F"+ when useColor (restoreFormat h), examplePending = \ h _ _ -> do when useColor (pendingColor h)- hPutStr h $ ".",+ hPutStr h $ "."+ when useColor (restoreFormat h), errorsFormatter = \ h errors -> do when useColor (failColor h) mapM_ (hPutStrLn h) ("" : intersperse "" errors)- when (not $ null errors) (hPutStrLn h ""),+ when (not $ null errors) (hPutStrLn h "")+ when useColor (restoreFormat h), footerFormatter = \ h specs time -> do when useColor (if failedCount specs == 0 then passColor h else failColor h)@@ -84,26 +100,19 @@ hPutStrLn h "" hPutStr h $ quantify (length specs) "example" ++ ", " hPutStrLn h $ quantify (failedCount specs) "failure"- when useColor (normalColor h)+ when useColor (restoreFormat h) } failed_examples :: Bool -> Formatter-failed_examples useColor = Formatter {- exampleGroupStarted = \ _ _ -> return (),-- examplePassed = \ _ _ _ -> return (),-- exampleFailed = \ h spec errors -> do- when useColor (failColor h)- hPutStrLn h $ " x " ++ requirement spec ++ " FAILED [" ++ (show $ (length errors) + 1) ++ "]",-- examplePending = \ _ _ _ -> return (),+failed_examples useColor = (silent useColor) {+ formatterName = "failed_examples", errorsFormatter = \ h errors -> do when useColor (failColor h) mapM_ (hPutStrLn h) ("" : intersperse "" errors)- when (not $ null errors) (hPutStrLn h ""),+ when (not $ null errors) (hPutStrLn h "")+ when useColor (restoreFormat h), footerFormatter = \ h specs time -> do when useColor (if failedCount specs == 0 then passColor h else failColor h)@@ -111,7 +120,7 @@ hPutStrLn h "" hPutStr h $ quantify (length specs) "example" ++ ", " hPutStrLn h $ quantify (failedCount specs) "failure"- when useColor (normalColor h)+ when useColor (restoreFormat h) } @@ -126,3 +135,6 @@ normalColor :: Handle -> IO() normalColor h = hSetSGR h [ Reset ]++restoreFormat :: Handle -> IO()+restoreFormat h = hSetSGR h [ Reset ]
Test/Hspec/HUnit.hs view
@@ -21,16 +21,16 @@ import qualified Test.HUnit as HU import Data.List (intersperse) -instance SpecVerifier (IO ()) where- it description example = it description (HU.TestCase example)+instance Example (IO ()) where+ evaluateExample io = evaluateExample (HU.TestCase io) -instance SpecVerifier HU.Test where- it description example = do- (counts, fails) <- silence $ HU.runTestText HU.putTextToShowS example- let r' = if HU.errors counts + HU.failures counts == 0+instance Example HU.Test where+ evaluateExample test = do+ (counts, fails) <- silence $ HU.runTestText HU.putTextToShowS test+ let r = if HU.errors counts + HU.failures counts == 0 then Success else Fail (details $ fails "")- return (description, r')+ return r details :: String -> String details = concat . intersperse "\n" . tail . init . lines
Test/Hspec/Monadic.hs view
@@ -63,6 +63,7 @@ -- > nums <- elements [7,10,11,12,13,14,15] -- > vectorOf nums (elements "0123456789") --+ module Test.Hspec.Monadic ( -- types Spec(), Result(),Specs,@@ -71,8 +72,7 @@ -- alternate "runner" functions hHspec, -- this is just for internal use- ItSpec-+ runSpecM ) where import System.IO@@ -82,9 +82,7 @@ import Control.Monad.Trans.Writer (Writer, execWriter, tell) -type ItSpec = IO (String, Result)--type Specs = Writer [IO [IO Spec]] ()+type Specs = Writer [Spec] () -- | Create a document of the given specs and write it to stdout. hspec :: Specs -> IO [Spec]@@ -105,16 +103,17 @@ hHspec :: Handle -> Specs -> IO [Spec] hHspec h = Runner.hHspec h . runSpecM -runSpecM :: Specs -> IO [IO Spec]-runSpecM specs = Core.descriptions $ execWriter specs+runSpecM :: Specs -> [Spec]+runSpecM specs = execWriter specs -describe :: String -> Writer [ItSpec] () -> Specs-describe label action = tell [Core.describe label (execWriter action)]+describe :: String -> Writer [Spec] () -> Specs+describe label action = tell $ Core.describe label [execWriter action] -- | Combine a list of descriptions. (Note that descriptions can also -- be combined with monadic sequencing.) descriptions :: [Specs] -> Specs descriptions = sequence_ -it :: SpecVerifier v => String -> v -> Writer [ItSpec] ()-it label action = tell [Core.it label action]+it :: Example v => String -> v -> Writer [Spec] ()+it label action = tell $ Core.it label action+
Test/Hspec/QuickCheck.hs view
@@ -13,9 +13,7 @@ -- > ] -- module Test.Hspec.QuickCheck (- property,- -- shortcut for the Monadic DSL- prop+ property, prop ) where import System.IO.Silently@@ -32,15 +30,16 @@ property = QuickCheckProperty -- | Monadic DSL shortcut, use this instead of @it@-prop :: QC.Testable t => String -> t -> Writer [DSL.ItSpec] ()+prop :: QC.Testable t => String -> t -> Writer [Spec] () prop n p = DSL.it n (QuickCheckProperty p) -instance QC.Testable t => SpecVerifier (QuickCheckProperty t) where- it description (QuickCheckProperty p) = do++instance QC.Testable t => Example (QuickCheckProperty t) where+ evaluateExample (QuickCheckProperty p) = do r <- silence $ QC.quickCheckResult p let r' = case r of QC.Success {} -> Success f@(QC.Failure {}) -> Fail (QC.output f) g@(QC.GaveUp {}) -> Fail ("Gave up after " ++ quantify (QC.numTests g) "test" ) QC.NoExpectedFailure {} -> Fail ("No expected failure")- return (description, r')+ return r'
Test/Hspec/Runner.hs view
@@ -12,16 +12,17 @@ import System.CPUTime (getCPUTime) import Control.Monad (when) import System.Exit+import Control.Exception (bracket_) -type Specs = [IO Spec]+type Specs = [Spec] -- | Evaluate and print the result of checking the spec examples.-runFormatter :: Formatter -> Handle -> String -> [String] -> Specs -> IO [Spec]+runFormatter :: Formatter -> Handle -> String -> [String] -> Specs -> IO Specs runFormatter formatter h _ errors [] = do errorsFormatter formatter h (reverse errors) return [] runFormatter formatter h group errors (iospec:ioss) = do- spec <- iospec+ spec <- evaluateSpec iospec when (group /= name spec) (exampleGroupStarted formatter h spec) case result spec of (Success ) -> examplePassed formatter h spec errors@@ -39,35 +40,37 @@ _ -> "" -- | Use in place of @hspec@ to also exit the program with an @ExitCode@-hspecX :: IO Specs -> IO a+hspecX :: Specs -> IO a hspecX ss = hspecB ss >>= exitWith . toExitCode -- | Use in place of hspec to also give a @Bool@ success indication-hspecB :: IO Specs -> IO Bool+hspecB :: Specs -> IO Bool hspecB ss = hspec ss >>= return . success -- | Create a document of the given specs and write it to stdout.-hspec :: IO Specs -> IO [Spec]+hspec :: Specs -> IO [Spec] hspec ss = hHspec stdout ss -- | Create a document of the given specs and write it to the given handle. -- -- > writeReport filename specs = withFile filename WriteMode (\ h -> hHspec h specs) ---hHspec :: Handle -> IO Specs -> IO [Spec]+hHspec :: Handle -> Specs -> IO Specs hHspec h = hHspecWithFormat (specdoc $ h == stdout) h -- | Create a document of the given specs and write it to the given handle. -- THIS IS LIKELY TO CHANGE-hHspecWithFormat :: Formatter -> Handle -> IO Specs -> IO [Spec]-hHspecWithFormat formatter h ss = do- t0 <- getCPUTime- ioSpecList <- ss- specList <- (runFormatter formatter) h "" [] ioSpecList- t1 <- getCPUTime- let runTime = ((fromIntegral $ t1 - t0) / (10.0^(12::Integer)) :: Double)- (footerFormatter formatter) h specList runTime- return specList+hHspecWithFormat :: Formatter -> Handle -> Specs -> IO Specs+hHspecWithFormat formatter h ss =+ bracket_ (when (usesFormatting formatter) $ restoreFormat h)+ (when (usesFormatting formatter) $ restoreFormat h)+ (do+ t0 <- getCPUTime+ specList <- runFormatter formatter h "" [] ss+ t1 <- getCPUTime+ let runTime = ((fromIntegral $ t1 - t0) / (10.0^(12::Integer)) :: Double)+ (footerFormatter formatter) h specList runTime+ return specList) toExitCode :: Bool -> ExitCode toExitCode True = ExitSuccess
hspec.cabal view
@@ -1,6 +1,6 @@ name: hspec-version: 0.6.1-cabal-version: -any+version: 0.8+cabal-version: >= 1.8 build-type: Custom license: BSD3 license-file: LICENSE@@ -17,24 +17,42 @@ . Hspec is roughly based on the Ruby library RSpec. However, Hspec is just a framework for running HUnit and QuickCheck tests. Compared to other options, it provides a much nicer syntax that makes tests very easy to read. -exposed: True-buildable: True-extensions: FlexibleInstances-other-modules: Specs-ghc-options: -Wall--build-depends: HUnit >=1 && <=2,- QuickCheck >=2.4.0.1 && <=2.5,- base >=4 && <=5,- silently >= 1.1.1 && < 2,- ansi-terminal == 0.5.5,- transformers >= 0.2.0 && < 0.3.0- extra-source-files: ./Specs.hs ./Test/Hspec/HUnit.hs ./Test/Hspec/Runner.hs ./Test/Hspec/Monadic.hs ./Test/Hspec/Formatters.hs ./Test/Hspec/Core.hs ./Test/Hspec/QuickCheck.hs -exposed-modules: Test.Hspec Test.Hspec.HUnit Test.Hspec.Core- Test.Hspec.Runner Test.Hspec.Monadic- Test.Hspec.Formatters Test.Hspec.QuickCheck+Executable hspec+ ghc-options: -Wall -fno-warn-hi-shadowing+ main-is: hspec.hs+ build-depends: hspec == 0.7,+ base >=4 && <=5,+ regex-posix >= 0.9,+ plugins == 1.5.1.4,+ HUnit >=1 && <=2,+ QuickCheck >=2.4.0.1 && <=2.5,+ base >=4 && <=5,+ silently >= 1.1.1 && < 2,+ ansi-terminal == 0.5.5,+ transformers >= 0.2.0 && < 0.3.0,+ filepath >= 1.1,+ directory >= 1++Library+ exposed: True+ buildable: True+ extensions: FlexibleInstances+ other-modules: Specs+ ghc-options: -Wall -fno-warn-hi-shadowing++ build-depends: HUnit >=1 && <=2,+ QuickCheck >=2.4.0.1 && <=2.5,+ base >=4 && <=5,+ silently >= 1.1.1 && < 2,+ ansi-terminal == 0.5.5,+ transformers >= 0.2.0 && < 0.3.0++ exposed-modules: Test.Hspec Test.Hspec.HUnit Test.Hspec.Core+ Test.Hspec.Runner Test.Hspec.Monadic+ Test.Hspec.Formatters Test.Hspec.QuickCheck+
+ hspec.hs view
@@ -0,0 +1,538 @@+module Main where++import Test.Hspec+import Test.Hspec.Core+import Test.Hspec.Runner+import Test.Hspec.Formatters+import Test.Hspec.HUnit ()+import qualified Test.HUnit as HUnit+import qualified Test.Hspec.Monadic+import qualified Test.Hspec.Monadic as Monadic+import Text.Regex.Posix+import System.Environment+import System.IO+import System.Directory+import System.FilePath+import System.Exit+import System.Plugins+import System.Console.GetOpt+import Control.Exception+import Data.Char (toLower,toUpper,isAlphaNum)+++debug :: Options -> String -> IO ()+debug opts msg = if verbose opts then putStrLn (" [verbose] " ++ msg) else return ()++main :: IO ()+main = do+ result <- getArgs >>= runWithArgs+ case result of+ Left results -> exitWith . toExitCode . success $ results+ Right message -> putStrLn message >> exitFailure+++runWithArgs :: [String] -> IO (Either Specs String)+runWithArgs args = do+ let (targets, errors, opts) = getOptions args+ if help opts+ then printHelp >> return (Left [])+ else if not $ null errors+ then return $ Right $ unlines errors+ else runWithTargetsAndOptions targets opts++runWithTargetsAndOptions :: [String] -> Options -> IO (Either Specs String)+runWithTargetsAndOptions targets opts = do+ allSpecsFound <- getAllSpecs targets opts+ if null allSpecsFound+ then return $ Right "no valid *.hs files found\n"+ else do+ result <- runSpecsWithOptions allSpecsFound opts+ case result of+ Left results -> do+ updateLastRunFile opts results+ return $ Left results+ Right message -> return $ Right message++getAllSpecs :: [String] -> Options -> IO Specs+getAllSpecs targets opts = do+ filenames <- getFileNamesToSearchFromTargets (getTargets opts targets)+ specs <- getAllSpecsFromFiles filenames opts+ return $ includeSelfSpecs specs opts++runSpecsWithOptions :: Specs -> Options -> IO (Either Specs String)+runSpecsWithOptions allFoundSpecs opts = do+ result <- filterSpecs allFoundSpecs opts+ case result of+ Left specsToRun -> runSpecs opts specsToRun >>= return . Left+ Right noneMessage -> return $ Right noneMessage++runSpecs :: Options -> Specs -> IO Specs+runSpecs opts specs = withHandle (output opts) work+ where work h = hHspecWithFormat formatter h specs+ formatter = getFormatter (formatterToUse opts) (useColor opts)++updateLastRunFile :: Options -> [Spec] -> IO ()+updateLastRunFile opts results = do+ let fileName = lastRunFile opts+ failedExamples = unlines [ requirement s | s <- results, isFailure (result s)]+ isFile <- doesFileExist fileName+ case (failedCount results, isFile) of+ (0, True) -> do+ debug opts $ "removing " ++ fileName ++ " since there are no failed examples"+ removeFile fileName+ (0, False) -> debug opts $ "skipping " ++ fileName ++ " since file doesn't exist and there are no failed examples"+ (_, _ ) -> do+ debug opts $ "writing failed examples to " ++ fileName+ writeFile fileName failedExamples++getFileNamesToSearchFromTargets :: [String] -> IO [String]+getFileNamesToSearchFromTargets names = do+ files <- mapM getFileNamesToSearchFromTarget names+ return $ concat files++getFileNamesToSearchFromTarget :: String -> IO [String]+getFileNamesToSearchFromTarget pathName = do+ isFile <- doesFileExist pathName+ isDir <- doesDirectoryExist pathName+ if isFile+ then if takeExtension pathName == ".hs"+ then return [pathName]+ else return []+ else if isDir+ then do+ names <- getDirectoryContents pathName+ let validNames = map (combine pathName) $ filter ((/='.').head) names+ getFileNamesToSearchFromTargets validNames+ else fail $ pathName ++ " is not a valid *.hs file or directory name"+++-- Parsing haskell files+hasModuleHeader :: String -> Bool+hasModuleHeader contents = getFirstWord contents == "module" -- lame++getFirstWord :: String -> String+getFirstWord xs@('{':'-':_) = getFirstWord (removeBlockComment xs 0)+getFirstWord xs@('-':'-':_) = getFirstWord (removeLineComment xs)+getFirstWord (' ':xs) = getFirstWord xs+getFirstWord ('\t':xs) = getFirstWord xs+getFirstWord ('\n':xs) = getFirstWord xs+getFirstWord xs = takeWhile isAlphaNum xs++removeBlockComment :: String -> Int -> String+removeBlockComment ('-':'}':xs) d+ | d == 1 = xs+ | otherwise = removeBlockComment xs (d-1)+removeBlockComment ('{':'-':xs) d = removeBlockComment xs (d+1)+removeBlockComment (_:xs) d = removeBlockComment xs d+removeBlockComment [] _ = fail "bad block comment"++removeLineComment :: String -> String+removeLineComment ('\n':xs) = xs+removeLineComment ('-':'-':xs) = removeLineComment xs+removeLineComment (_:xs) = removeLineComment xs+removeLineComment [] = fail "bad line comment"++++-- Loading specs from files+getAllSpecsFromFiles :: [String] -> Options -> IO [Spec]+getAllSpecsFromFiles filenames opts = fmap concat $ mapM (getAllSpecsFromFile opts) filenames++getAllSpecsFromFile :: Options -> String -> IO Specs+getAllSpecsFromFile opts filename = do+ contents <- readFile filename+ if contents =~ "^module Main where$"+ then do+ debug opts $ "skipping " ++ filename ++ " because it is a Main module and those can't be dynamically loaded."+ return []+ else if hasModuleHeader contents+ then do+ debug opts $ "seaching " ++ filename+ (s1,n1) <- getSpecsFromFile filename contents+ (s2,n2) <- getIOSpecsFromFile filename contents+ (ms1,n3) <- getMonadicSpecsFromFile filename contents+ (ms2,n4) <- getMonadicIOSpecsFromFile filename contents+ mapM_ (debug opts) (map (" "++) (concat $ [n1, n2, n3, n4]))+ return (s1 ++ s2 ++ ms1 ++ ms2)+ else do+ let justName = takeFileName filename+ cleanName = dropExtension $ toUpper (head justName) : tail justName+ debug opts $ "skipping " ++ filename ++ " because only library modules (like \"module " ++ cleanName ++ " where\") can be dynamically loaded."+ return []++getName :: String -> String+getName = takeWhile (`notElem`" :")++getDeclariations :: String -> String -> [String]+getDeclariations pattern contents = map head matches+ where matches = (contents =~ pattern) :: [[String]]+++getSpecDeclariations :: String -> [String]+getSpecDeclariations = getDeclariations "^[^ ]+ *:: *(Test\\.Hspec\\.)?Specs\\w*$"++getSpecsFromFile :: String -> String -> IO (Specs,[String])+getSpecsFromFile filename contents = do+ let names = getSpecDeclariations contents+ specs <- mapM (\ n -> loadSpecsFromFile filename (getName n) :: IO Specs) names+ return (concat specs, names)+++getIOSpecDeclariations :: String -> [String]+getIOSpecDeclariations = getDeclariations "^[^ ]+ *:: *IO +(Test\\.Hspec\\.)?Specs\\w*$"++getIOSpecsFromFile :: String -> String -> IO (Specs,[String])+getIOSpecsFromFile filename contents = do+ let names = getIOSpecDeclariations contents+ specs <- sequence =<< mapM (\ n -> loadSpecsFromFile filename (getName n) :: IO (IO Specs)) names+ return (concat specs, names)++getMonadicSpecDeclariations :: String -> [String]+getMonadicSpecDeclariations = getDeclariations "^[^ ]+ *:: *Test\\.Hspec\\.Monadic\\.Specs\\w*$"++getMonadicSpecsFromFile :: String -> String -> IO (Specs,[String])+getMonadicSpecsFromFile filename contents = do+ let names = getMonadicSpecDeclariations contents+ specs <- mapM (\ n -> loadSpecsFromFile filename (getName n) :: IO Monadic.Specs) names+ return (concatMap Monadic.runSpecM specs, names)+++getMonadicIOSpecDeclariations :: String -> [String]+getMonadicIOSpecDeclariations = getDeclariations "^[^ ]+ *:: *IO +Test\\.Hspec\\.Monadic\\.Specs\\w*$"++getMonadicIOSpecsFromFile :: String -> String -> IO (Specs,[String])+getMonadicIOSpecsFromFile filename contents = do+ let names = getMonadicIOSpecDeclariations contents+ specs <- sequence =<< mapM (\ n -> loadSpecsFromFile filename (getName n) :: IO (IO Monadic.Specs)) names+ return (concatMap Monadic.runSpecM specs, names)++loadSpecsFromFile :: String -> String -> IO a+loadSpecsFromFile filename specName = do+ status <- makeAll filename []+ obj <- case status of+ MakeSuccess _ o -> return o+ MakeFailure e -> mapM_ putStrLn e >> fail "can't make"+ mv <- load obj ["."] [] specName+ case mv of+ LoadFailure msgs -> putStrLn (unwords msgs) >> fail "can't load"+ LoadSuccess _ v -> return v++++-- excluding from loaded specs+filterSpecs :: [Spec] -> Options -> IO (Either [Spec] String)+filterSpecs allSpecsFound opts = do+ (matchingSpecs, noneMessage) <- filterByExampleOption opts allSpecsFound+ specsToRun <- filterByRerunOption opts matchingSpecs+ return $ if null specsToRun then Right noneMessage else Left specsToRun++filterByExampleOption :: Options -> Specs -> IO (Specs, String)+filterByExampleOption opts specs =+ case specificExample opts of+ Nothing -> return (specs, "no specs found")+ Just pattern -> do+ debug opts $ "only running descriptions matching \"" ++ pattern ++ "\""+ let s = filterSpecsByRegex pattern specs+ return (s, "no specs matching \"" ++ pattern ++ "\" found")++filterByRerunOption :: Options -> Specs -> IO Specs+filterByRerunOption opts specs+ | lastRunOption opts == RunFailed = do+ isFile <- doesFileExist (lastRunFile opts)+ if isFile+ then do+ failedDescriptions <- readFile (lastRunFile opts)+ return $ filterExactSpecs (lines failedDescriptions) specs+ else return specs+ | otherwise = return specs++filterSpecsByRegex :: String -> Specs -> Specs+filterSpecsByRegex pattern = filter p+ where p s = requirement s =~ pattern++filterExactSpecs :: [String] -> Specs -> Specs+filterExactSpecs ok = filter p+ where p s = requirement s `elem` ok++++-- getting specific options+getTargets :: Options -> [String] -> [String]+getTargets opts xs+ | runSelfSpecs opts = xs+getTargets _ [] = ["."]+getTargets _ xs = xs++getFormatter :: String -> (Bool -> Formatter)+getFormatter "silent" = silent+getFormatter "progress" = progress+getFormatter "specdoc" = specdoc+getFormatter "failed_examples" = failed_examples+getFormatter _ = specdoc++useColor :: Options -> Bool+useColor opts = case color opts of+ Nothing -> output opts `elem` ["stdout","stderr"]+ Just x -> x++withHandle :: String -> (Handle -> IO a) -> IO a+withHandle "stdout" f = f stdout+withHandle "stderr" f = f stderr+withHandle filename f = bracket (openFile filename WriteMode)+ (hClose)+ (f)++includeSelfSpecs :: Specs -> Options -> Specs+includeSelfSpecs specs opts+ | runSelfSpecs opts = specs ++ Monadic.runSpecM allSpecs+ | otherwise = specs++++-- getting Options+getOptions :: [String] -> ([String], [String], Options)+getOptions args = (filenames, errors, opts)+ where (actions, filenames, errors) = getOpt RequireOrder options args+ opts = (foldl (.) id actions) startOptions++data LastRunOption = RunAll | RunFailed+ deriving Eq++data Options = Options {+ formatterToUse :: String,+ output :: String,+ specificExample :: Maybe String,+ color :: Maybe Bool,+ help :: Bool,+ runSelfSpecs :: Bool,+ verbose :: Bool,+ lastRunFile :: String,+ lastRunOption :: LastRunOption }++startOptions :: Options+startOptions = Options {+ formatterToUse = "specdoc",+ output = "stdout",+ specificExample = Nothing,+ color = Nothing,+ help = False,+ runSelfSpecs = False,+ verbose = False,+ lastRunFile = ".hspecLastRun",+ lastRunOption = RunAll }++trim :: String -> String+trim = reverse . dropWhile (==' ') . reverse . dropWhile (==' ')++options :: [OptDescr (Options -> Options)]+options =+ [ Option "f" ["format"]+ (ReqArg (\x s -> s { formatterToUse = trim $ map toLower x }) "FORMAT")+ "Specifies what format to use for output.\n\+ \By default the specdoc format is used.\n\+ \FORMAT can be silent, progress, specdoc, or failed_examples."+ , Option "o" ["output"]+ (ReqArg (\x s -> s { output = trim $ x }) "FILE_NAME")+ "Specifies the file to use for output.\n\+ \By default output is directed to stdout.\n\+ \FILE_NAME can be stdout or stderr for those handles."+ , Option "e" ["example"]+ (ReqArg (\x s -> s { specificExample = Just x }) "REGEX")+ "Only execute examples with a matching description.\n\+ \By default all examples are executed."+ , Option "c" ["color"]+ (ReqArg (\ x s -> s { color = Just (map toLower (trim x) == "true") }) "TRUE|FALSE")+ "Force output to have or not have red and green color.\n\+ \By default color is only used when output is directed to stdout."+ , Option "" ["runfile"]+ (ReqArg (\ x s -> s { lastRunFile = x }) "FILE_NAME")+ "Use a specific file to log the last run results. This is read when using the --rerun option.\n\+ \By default the file \".hspecLastRun\" logs the last run results."+ , Option "r" ["rerun"]+ (ReqArg (\ x s -> let opt = case map toLower (trim x) of+ "all" -> RunAll+ "failed" -> RunFailed+ _ -> error $ "unsupported run option \"" ++ x ++ "\""+ in s { lastRunOption = opt }) "RERUNOPT")+ "Rerun a specific subset of specs. This looks at the last run file specified by --runfile.\n\+ \RERUNOPT can be \"all\" or \"failed\".\n\+ \By default the last run file is ignored and all specs are run."+ , Option "h?" ["help"]+ (NoArg (\ s -> s { help = True }))+ "Display this help."+ , Option "v" ["verbose"]+ (NoArg (\ s -> s { verbose = True }))+ "Display detailed information about what hspec is doing."+ , Option "" ["specs"]+ (NoArg (\ s -> s { runSelfSpecs = True }))+ "Include the specs for the hspec command line runner itself. When used, the target list \n\+ \will not default to the current directory. A non-empty target list will still be \n\+ \searched though."+ ]++helpInfo :: String+helpInfo = "hspec searches through files or folders and runs any top level declarations with \+ \a type of `Specs` or `IO Specs`. Monadic specs must be fully qualified, \+ \list-based specs may be qualified or not. You can specify specific *.hs \+ \files or directories to search through or let hspec search the current \+ \directory tree for specs to run.\n\n\+ \usage: hspec [OPTIONS] [TARGET_LIST]"++printHelp :: IO ()+printHelp = putStrLn $ usageInfo helpInfo options++++++-- Specs+allSpecs :: Test.Hspec.Monadic.Specs+allSpecs =+ Monadic.describe "hspec command line runner" $ do++ Monadic.it "searches target files for specs and runs them"+ (True)++ Monadic.describe "options" $ do+ let test :: (Eq a, Show a) => String -> a -> (Options -> a) -> IO ()+ test arg expected func = HUnit.assertEqual arg expected (func opts)+ where (_, _, opts) = getOptions (words arg)++ Monadic.it "accepts -h, -?, and --help to get help"+ (do+ test "-h" True help+ test "-?" True help+ test "--help" True help+ test "" False help)++ Monadic.it "accepts -c or --color to set weather or not to color the output"+ (do+ test "-c false" (Just False) color+ test "-c true" (Just True) color+ test "--color false" (Just False) color+ test "--color true" (Just True) color+ test "" Nothing color)++ Monadic.it "accepts -f or --format and a formatter name to use"+ (do+ test "-f progress" "progress" formatterToUse+ test "--format progress" "progress" formatterToUse+ test "" "specdoc" formatterToUse)++ Monadic.it "accepts -o or --output and a filename to output to"+ (do+ test "-o foo.txt" "foo.txt" output+ test "--output foo.txt" "foo.txt" output+ test "" "stdout" output)++ Monadic.it "accepts -o or --output and stdout or stderr to output to"+ (do+ test "-o stderr" "stderr" output+ test "--output stdout" "stdout" output)++ Monadic.it "accepts --specs to display it's own specs"+ (do+ test "--specs" True runSelfSpecs+ test "" False runSelfSpecs)++ Monadic.it "accepts -v or --verbose to display extra details"+ (do+ test "-v" True verbose+ test "--verbose" True verbose+ test "" False verbose)++ Monadic.it "accepts one or more targets to search"+ (let args = ["a", "b"]+ (files, _, _) = getOptions args+ in HUnit.assertEqual (unwords args) args files)++ Monadic.it "defaults to the current directory tree if no targets are specified and not running --specs"+ (HUnit.assertEqual "" ["."] (getTargets startOptions []))++ Monadic.describe "an hspec target" $ do++ Monadic.it "can be a file name to run all specs in that file"+ (do+ filenames <- getFileNamesToSearchFromTargets ["hspec.hs"]+ HUnit.assertEqual "hspec.hs" ["hspec.hs"] filenames)++ Monadic.it "can be a directory name to run all specs in that directory tree"+ (do+ filenames <- getFileNamesToSearchFromTargets ["."]+ HUnit.assertBool "hspec.hs" ("./hspec.hs" `elem` filenames))++ Monadic.describe "the --format option" $ do++ let test :: String -> (Bool -> Formatter) -> IO ()+ test arg expected = HUnit.assertEqual arg (formatterName $ expected False) (formatterName $ getFormatter (formatterToUse opts) $ False)+ where (_, _, opts) = getOptions ["--format", arg]++ Monadic.it "allows the \"silent\" formatter"+ (test "silent" silent)++ Monadic.it "allows the \"progress\" formatter"+ (test "progress" progress)++ Monadic.it "allows the \"specdoc\" formatter"+ (test "specdoc" specdoc)++ Monadic.it "allows the \"failed_examples\" formatter"+ (test "failed_examples" failed_examples)++ Monadic.it "uses \"specdoc\" by default"+ (test "" specdoc)++ Monadic.describe "the --color option" $ do++ let test :: String -> String -> Bool -> IO ()+ test colorArg outputArg expected = HUnit.assertEqual (unwords args) expected (useColor opts)+ where args = if colorArg == "" then ["-o", outputArg] else ["-c", colorArg, "-o", outputArg]+ (_, _, opts) = getOptions args++ Monadic.it "allows \"true\" to force color output"+ (test "true" "stdout" True)++ Monadic.it "allows \"false\" to force non-color output"+ (test "false" "stdout" False)++ Monadic.it "by default, uses color when outputing to stdout"+ (test "" "stdout" True)++ Monadic.it "by default, uses color when outputing to stderr"+ (test "" "stderr" True)++ Monadic.it "by default, doesn't color when outputing to a file"+ (test "" "foo.txt" False)++ Monadic.describe "searching for specs to run" $ do++ let test :: String -> [String] -> IO ()+ test contents expected = HUnit.assertEqual contents expected decs+ where decs = concat [ getSpecDeclariations contents,+ getIOSpecDeclariations contents,+ getMonadicSpecDeclariations contents,+ getMonadicIOSpecDeclariations contents ]++ Monadic.it "finds top level definitions of type \"Specs\""+ (test "\ntest :: Specs\ntest = undefined\n"+ ["test :: Specs"])++ Monadic.it "finds top level definitions of type \"IO Specs\""+ (test "\ntest :: IO Specs\ntest = undefined\n"+ ["test :: IO Specs"])++ Monadic.it "finds top level definitions of type \"Test.Hspec.Specs\""+ (test "\ntest :: Test.Hspec.Specs\ntest = undefined\n"+ ["test :: Test.Hspec.Specs"])++ Monadic.it "finds top level definitions of type \"IO Test.Hspec.Specs\""+ (test "\ntest :: IO Test.Hspec.Specs\ntest = undefined\n"+ ["test :: IO Test.Hspec.Specs"])++ Monadic.it "finds top level definitions of type \"Test.Hspec.Monadic.Specs\""+ (test "\ntest :: Test.Hspec.Monadic.Specs\ntest = undefined\n"+ ["test :: Test.Hspec.Monadic.Specs"])++ Monadic.it "finds top level definitions of type \"IO Test.Hspec.Monadic.Specs\""+ (test "\ntest :: IO Test.Hspec.Monadic.Specs\ntest = undefined\n"+ ["test :: IO Test.Hspec.Monadic.Specs"])