1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
module Helper (
module Test.Hspec.Meta
, module Test.QuickCheck
, module Control.Applicative
, module System.IO.Silently
, sleep
, timeout
, defaultParams
, noOpProgressCallback
, captureLines
, normalizeSummary
, ignoreExitCode
, ignoreUserInterrupt
, shouldStartWith
, shouldEndWith
, shouldUseArgs
) where
import Data.List
import Data.Char
import Data.IORef
import Control.Monad
import Control.Applicative
import System.Environment (withArgs)
import System.Exit
import Control.Concurrent
import qualified Control.Exception as E
import qualified System.Timeout as System
import Data.Time.Clock.POSIX
import System.IO.Silently
import Test.Hspec.Meta
import Test.QuickCheck hiding (Result(..))
import qualified Test.Hspec as H
import qualified Test.Hspec.Core as H (Params(..), Item(..), ProgressCallback, mapSpecItem)
import qualified Test.Hspec.Runner as H
import Test.Hspec.Core.QuickCheckUtil (mkGen)
ignoreExitCode :: IO () -> IO ()
ignoreExitCode action = action `E.catch` \e -> let _ = e :: ExitCode in return ()
ignoreUserInterrupt :: IO () -> IO ()
ignoreUserInterrupt action = E.catchJust (guard . (== E.UserInterrupt)) action return
captureLines :: IO a -> IO [String]
captureLines = fmap lines . capture_
shouldStartWith :: (Eq a, Show a) => [a] -> [a] -> Expectation
x `shouldStartWith` y = x `shouldSatisfy` isPrefixOf y
shouldEndWith :: (Eq a, Show a) => [a] -> [a] -> Expectation
x `shouldEndWith` y = x `shouldSatisfy` isSuffixOf y
-- replace times in summary with zeroes
normalizeSummary :: [String] -> [String]
normalizeSummary xs = map f xs
where
f x | "Finished in " `isPrefixOf` x = map g x
| otherwise = x
g x | isNumber x = '0'
| otherwise = x
defaultParams :: H.Params
defaultParams = H.Params stdArgs {replay = Just (mkGen 23, 0)} (H.configSmallCheckDepth H.defaultConfig)
noOpProgressCallback :: H.ProgressCallback
noOpProgressCallback _ = return ()
sleep :: POSIXTime -> IO ()
sleep = threadDelay . floor . (* 1000000)
timeout :: POSIXTime -> IO a -> IO (Maybe a)
timeout = System.timeout . floor . (* 1000000)
shouldUseArgs :: [String] -> (Args -> Bool) -> Expectation
shouldUseArgs args p = do
spy <- newIORef (H.paramsQuickCheckArgs defaultParams)
let interceptArgs item = item {H.itemExample = \params action progressCallback -> writeIORef spy (H.paramsQuickCheckArgs params) >> H.itemExample item params action progressCallback}
spec = H.mapSpecItem interceptArgs $
H.it "foo" False
(silence . ignoreExitCode . withArgs args . H.hspec) spec
readIORef spy >>= (`shouldSatisfy` p)
|
