packages feed

hspec-core 2.10.7 → 2.10.8

raw patch · 39 files changed

+274/−208 lines, 39 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

hspec-core.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:             hspec-core-version:          2.10.7+version:          2.10.8 license:          MIT license-file:     LICENSE copyright:        (c) 2011-2022 Simon Hengel,
src/Test/Hspec/Core/Compat.hs view
@@ -4,6 +4,7 @@ , module Test.Hspec.Core.Compat ) where +import           Control.Exception as Imports import           Control.Arrow as Imports ((>>>), (&&&), first, second) import           Control.Applicative as Imports import           Control.Monad as Imports hiding (@@ -16,6 +17,7 @@   , sequence_   ) import           Data.Foldable as Imports+import           Data.CallStack as Imports (HasCallStack)  #if MIN_VERSION_base(4,11,0) import           Data.Functor as Imports@@ -70,7 +72,6 @@ import           Text.Read as Imports (readMaybe) import           System.Environment as Imports (lookupEnv) #else-import           Control.Exception import           Text.Read import           System.Environment import qualified Text.ParserCombinators.ReadP as P@@ -83,9 +84,7 @@ import           Data.Typeable (tyConModule, tyConName) import           Control.Concurrent -#if MIN_VERSION_base(4,9,0)-import           Control.Exception as Imports (interruptible)-#else+#if !MIN_VERSION_base(4,9,0) import           GHC.IO #endif @@ -105,7 +104,7 @@ atomicWriteIORef :: IORef a -> a -> IO () atomicWriteIORef ref a = do     x <- atomicModifyIORef ref (\_ -> (a, ()))-    x `seq` return ()+    x `seq` pass  -- | Parse a string using the 'Read' instance. -- Succeeds if there is exactly one valid result.@@ -175,3 +174,11 @@  endsWith :: Eq a => [a] -> [a] -> Bool endsWith = flip isSuffixOf++#if MIN_VERSION_base(4,8,0)+pass :: Applicative m => m ()+pass = pure ()+#else+pass :: Monad m => m ()+pass = return ()+#endif
src/Test/Hspec/Core/Config.hs view
@@ -18,7 +18,6 @@ import           Prelude () import           Test.Hspec.Core.Compat -import           Control.Exception import           Data.Maybe import           System.IO import           System.IO.Error
src/Test/Hspec/Core/Config/Definition.hs view
@@ -20,7 +20,6 @@ import           Prelude () import           Test.Hspec.Core.Compat -import           Control.Exception (bracket) import           System.Directory (getTemporaryDirectory, removeFile) import           System.IO (openTempFile, hClose) import           System.Process (system)
src/Test/Hspec/Core/Example.hs view
@@ -21,6 +21,7 @@ , safeEvaluateExample -- END RE-EXPORTED from Test.Hspec.Core.Spec , safeEvaluateResultStatus+, toLocation ) where  import           Prelude ()@@ -28,9 +29,8 @@  import qualified Test.HUnit.Lang as HUnit -import           Data.CallStack+import           Data.CallStack (SrcLoc(..)) -import           Control.Exception import           Control.DeepSeq import           Data.Typeable (Typeable) import qualified Test.QuickCheck as QC@@ -90,37 +90,44 @@     NoReason -> ()     Reason r -> r `deepseq` ()     ExpectedButGot p e a  -> p `deepseq` e `deepseq` a `deepseq` ()-    Error m e -> m `deepseq` e `seq` ()+    Error m e -> m `deepseq` show e `deepseq` ()  instance Exception ResultStatus -safeEvaluateExample :: Example e => e -> Params -> (ActionWith (Arg e) -> IO ()) -> ProgressCallback -> IO Result-safeEvaluateExample example params around progress = safeEvaluate $ forceResult <$> evaluateExample example params around progress-  where-    forceResult :: Result -> Result-    forceResult r@(Result info status) = info `deepseq` (forceResultStatus status) `seq` r+forceResult :: Result -> Result+forceResult r@(Result info status) = info `deepseq` (forceResultStatus status) `seq` r -    forceResultStatus :: ResultStatus -> ResultStatus-    forceResultStatus r = case r of-      Success -> r-      Pending _ m -> m `deepseq` r-      Failure _ m -> m `deepseq` r+forceResultStatus :: ResultStatus -> ResultStatus+forceResultStatus r = case r of+  Success -> r+  Pending _ m -> m `deepseq` r+  Failure _ m -> m `deepseq` r +safeEvaluateExample :: Example e => e -> Params -> (ActionWith (Arg e) -> IO ()) -> ProgressCallback -> IO Result+safeEvaluateExample example params around progress = safeEvaluate $ evaluateExample example params around progress+ safeEvaluate :: IO Result -> IO Result safeEvaluate action = do-  r <- safeTry action-  return $ case r of-    Left e -> Result "" (toResultStatus e)-    Right result -> result+  r <- safeTry $ forceResult <$> action+  case r of+    Left e -> Result "" <$> exceptionToResultStatus e+    Right result -> return result  safeEvaluateResultStatus :: IO ResultStatus -> IO ResultStatus-safeEvaluateResultStatus action = either toResultStatus id <$> safeTry action+safeEvaluateResultStatus action = do+  r <- safeTry $ forceResultStatus <$> action+  case r of+    Left e -> exceptionToResultStatus e+    Right status -> return status -toResultStatus :: SomeException -> ResultStatus-toResultStatus e-  | Just result <- fromException e = result-  | Just hunit <- fromException e = hunitFailureToResult Nothing hunit-  | otherwise = Failure Nothing $ Error Nothing e+exceptionToResultStatus :: SomeException -> IO ResultStatus+exceptionToResultStatus = safeEvaluateResultStatus . pure . toResultStatus+  where+    toResultStatus :: SomeException -> ResultStatus+    toResultStatus e+      | Just result <- fromException e = result+      | Just hunit <- fromException e = hunitFailureToResult Nothing hunit+      | otherwise = Failure Nothing $ Error Nothing e  instance Example Result where   type Arg Result = ()@@ -128,10 +135,8 @@  instance Example (a -> Result) where   type Arg (a -> Result) = a-  evaluateExample example _params action _callback = do-    ref <- newIORef (Result "" Success)-    action (evaluate . example >=> writeIORef ref)-    readIORef ref+  evaluateExample example _params hook _callback = do+    liftHook (Result "" Success) hook (evaluate . example)  instance Example Bool where   type Arg Bool = ()@@ -139,10 +144,8 @@  instance Example (a -> Bool) where   type Arg (a -> Bool) = a-  evaluateExample p _params action _callback = do-    ref <- newIORef (Result "" Success)-    action (evaluate . example >=> writeIORef ref)-    readIORef ref+  evaluateExample p _params hook _callback = do+    liftHook (Result "" Success) hook (evaluate . example)     where       example a         | p a = Result "" Success@@ -166,16 +169,19 @@     where       location = case mLoc of         Nothing -> Nothing-        Just loc -> Just $ Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc)+        Just loc -> Just $ toLocation loc   where     addPre :: String -> String     addPre xs = case pre of       Just x -> x ++ "\n" ++ xs       Nothing -> xs +toLocation :: SrcLoc -> Location+toLocation loc = Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc)+ instance Example (a -> Expectation) where   type Arg (a -> Expectation) = a-  evaluateExample e _ action _ = action e >> return (Result "" Success)+  evaluateExample e _ hook _ = hook e >> return (Result "" Success)  instance Example QC.Property where   type Arg QC.Property = ()@@ -183,8 +189,8 @@  instance Example (a -> QC.Property) where   type Arg (a -> QC.Property) = a-  evaluateExample p c action progressCallback = do-    r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) {QC.chatty = False} (QCP.callback qcProgressCallback $ aroundProperty action p)+  evaluateExample p c hook progressCallback = do+    r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) {QC.chatty = False} (QCP.callback qcProgressCallback $ aroundProperty hook p)     return $ fromQuickCheckResult r     where       qcProgressCallback = QCP.PostTest QCP.NotCounterexample $
src/Test/Hspec/Core/Example/Location.hs view
@@ -16,7 +16,6 @@ import           Prelude () import           Test.Hspec.Core.Compat -import           Control.Exception import           Data.Char import           Data.Maybe import           GHC.IO.Exception
src/Test/Hspec/Core/FailureReport.hs view
@@ -35,7 +35,7 @@     -- into the environment is a non-essential feature we just disable this to be     -- able to run hspec test-suites with ghcjs at all. Should be reverted once     -- the issue is fixed.-    return ()+    pass #else     -- on Windows this can throw an exception when the input is too large, hence     -- we use `safeTry` here
src/Test/Hspec/Core/Format.hs view
@@ -19,9 +19,8 @@ import           Prelude () import           Test.Hspec.Core.Compat -import           Control.Exception import           Control.Concurrent-import           Control.Concurrent.Async (async)+import           Control.Concurrent.Async (Async, async) import qualified Control.Concurrent.Async as Async import           Control.Monad.IO.Class @@ -94,23 +93,24 @@       event <- takeEvent       format event       case event of-        Done {} -> return ()+        Done {} -> pass         _ -> do           signal Ok           go -  t <- async $ do+  worker <- async $ do     (run go >> signal Ok) `catch` (signal . NotOk)    return $ \ event -> do-    running <- Async.poll t-    case running of-      Just _ -> return ()-      Nothing -> do-        putEvent event-        r <- wait-        case r of-          Ok -> return ()-          NotOk err -> do-            Async.wait t-            throwIO err+    running <- asyncRunning worker+    when running $ do+      putEvent event+      r <- wait+      case r of+        Ok -> pass+        NotOk err -> do+          Async.wait worker+          throwIO err++asyncRunning :: Async () -> IO Bool+asyncRunning worker = maybe True (const False) <$> Async.poll worker
src/Test/Hspec/Core/Formatters/Internal.hs view
@@ -53,7 +53,6 @@  import qualified System.IO as IO import           System.IO (Handle, stdout)-import           Control.Exception (bracket_, bracket) import           System.Console.ANSI import           Control.Monad.Trans.State hiding (state, gets, modify) import           Control.Monad.IO.Class
src/Test/Hspec/Core/Formatters/Pretty.hs view
@@ -52,6 +52,7 @@         go value = case value of           Char _ -> False           String _ -> True+          Rational _ _ -> False           Number _ -> False           Record _ _ -> True           Constructor _ xs -> any go xs@@ -92,6 +93,7 @@     render value = case value of       Char c -> shows c       String str -> if unicode then Builder $ ushows str else shows str+      Rational n d -> render n <> " % " <> render d       Number n -> fromString n       Record name fields -> fromString name <> " {\n  " <> (intercalate ",\n  " $ map renderField fields) <> "\n}"       Constructor name values -> intercalate " " (fromString name : map render values)
src/Test/Hspec/Core/Formatters/Pretty/Parser.hs view
@@ -16,6 +16,7 @@ data Value =     Char Char   | String String+  | Rational Value Value   | Number String   | Record Name [(Name, Value)]   | Constructor Name [Value]@@ -34,6 +35,7 @@ value =       char   <|> string+  <|> rational   <|> number   <|> record   <|> constructor@@ -45,6 +47,9 @@  string :: Parser Value string = String <$> (token StringLit >>= readA)++rational :: Parser Value+rational = Rational <$> (number <|> tuple) <* require (Varsym, "%") <*> number  number :: Parser Value number = integer <|> float
src/Test/Hspec/Core/Formatters/V1.hs view
@@ -68,7 +68,6 @@ import           Test.Hspec.Core.Example (Location(..)) import           Text.Printf import           Control.Monad.IO.Class-import           Control.Exception  -- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make -- sure, that we only use the public API to implement formatters.@@ -153,16 +152,16 @@  silent :: Formatter silent = Formatter {-  headerFormatter     = return ()-, exampleGroupStarted = \_ _ -> return ()-, exampleGroupDone    = return ()-, exampleStarted      = \_ -> return ()-, exampleProgress     = \_ _ -> return ()-, exampleSucceeded    = \ _ _ -> return ()-, exampleFailed       = \_ _ _ -> return ()-, examplePending      = \_ _ _ -> return ()-, failedFormatter     = return ()-, footerFormatter     = return ()+  headerFormatter     = pass+, exampleGroupStarted = \_ _ -> pass+, exampleGroupDone    = pass+, exampleStarted      = \_ -> pass+, exampleProgress     = \_ _ -> pass+, exampleSucceeded    = \ _ _ -> pass+, exampleFailed       = \_ _ _ -> pass+, examplePending      = \_ _ _ -> pass+, failedFormatter     = pass+, footerFormatter     = pass }  checks :: Formatter@@ -278,7 +277,7 @@       write ("  " ++ show n ++ ") ")       writeLine (formatRequirement path)       case reason of-        NoReason -> return ()+        NoReason -> pass         Reason err -> withFailColor $ indent err         ExpectedButGot preface expected actual -> do           mapM_ indent preface@@ -306,16 +305,16 @@               forM_ chunks $ \ chunk -> case chunk of                 Both a -> indented write a                 First a -> indented extra a-                Second _ -> return ()-                Omitted _ -> return ()+                Second _ -> pass+                Omitted _ -> pass               writeLine ""                withFailColor $ write (indentation ++ " but got: ")               forM_ chunks $ \ chunk -> case chunk of                 Both a -> indented write a-                First _ -> return ()+                First _ -> pass                 Second a -> indented missing a-                Omitted _ -> return ()+                Omitted _ -> pass               writeLine ""          Error _ e -> withFailColor . indent $ (("uncaught exception: " ++) . formatException) e
src/Test/Hspec/Core/Formatters/V2.hs view
@@ -87,7 +87,6 @@ import           Text.Printf import           Test.Hspec.Core.Formatters.Pretty.Unicode (ushow) import           Control.Monad.IO.Class-import           Control.Exception  -- We use an explicit import list for "Test.Hspec.Formatters.Monad", to make -- sure, that we only use the public API to implement formatters.@@ -140,13 +139,13 @@  silent :: Formatter silent = Formatter {-  formatterStarted      = return ()-, formatterGroupStarted = \ _ -> return ()-, formatterGroupDone    = \ _ -> return ()-, formatterProgress     = \ _ _ -> return ()-, formatterItemStarted  = \ _ -> return ()-, formatterItemDone     = \ _ _ -> return ()-, formatterDone         = return ()+  formatterStarted      = pass+, formatterGroupStarted = \ _ -> pass+, formatterGroupDone    = \ _ -> pass+, formatterProgress     = \ _ _ -> pass+, formatterItemStarted  = \ _ -> pass+, formatterItemDone     = \ _ _ -> pass+, formatterDone         = pass }  checks :: Formatter@@ -165,8 +164,8 @@       Pending {} -> (withPendingColor, fallback "‐" "-")       Failure {} -> (withFailColor,    fallback "✘" "x")     case itemResult item of-      Success {} -> return ()-      Failure {} -> return ()+      Success {} -> pass+      Failure {} -> pass       Pending _ reason -> withPendingColor $ do         writeLine $ indentationFor ("" : nesting) ++ "# PENDING: " ++ fromMaybe "No reason given" reason } where@@ -277,7 +276,7 @@       write ("  " ++ show n ++ ") ")       writeLine (formatRequirement path)       case reason of-        NoReason -> return ()+        NoReason -> pass         Reason err -> withFailColor $ indent err         ExpectedButGot preface expected_ actual_ -> do           pretty <- prettyPrintFunction
src/Test/Hspec/Core/Hooks.hs view
@@ -31,9 +31,7 @@  import           Prelude () import           Test.Hspec.Core.Compat-import           Data.CallStack (HasCallStack) -import           Control.Exception (SomeException, finally, throwIO, try) import           Control.Concurrent  import           Test.Hspec.Core.Example@@ -178,7 +176,7 @@         signal doCleanupNow         r <- takeMVar released         case r of-          Released -> return ()+          Released -> pass           ExceptionDuringRelease err -> throwIO err    return (acquire, release)
src/Test/Hspec/Core/QuickCheckUtil.hs view
@@ -1,10 +1,27 @@ {-# LANGUAGE RecordWildCards #-}-module Test.Hspec.Core.QuickCheckUtil where+{-# LANGUAGE CPP #-}+module Test.Hspec.Core.QuickCheckUtil (+  liftHook+, aroundProperty +, QuickCheckResult(..)+, Status(..)+, QuickCheckFailure(..)+, parseQuickCheckResult++, formatNumbers++, mkGen+, newSeed+#ifdef TEST+, stripSuffix+, splitBy+#endif+) where+ import           Prelude () import           Test.Hspec.Core.Compat -import           Control.Exception import           Data.Maybe import           Data.Int import           System.Random@@ -21,17 +38,21 @@  import           Test.Hspec.Core.Util +liftHook :: r -> ((a -> IO ()) -> IO ()) -> (a -> IO r) -> IO r+liftHook def hook inner = do+  ref <- newIORef def+  hook $ inner >=> writeIORef ref+  readIORef ref+ aroundProperty :: ((a -> IO ()) -> IO ()) -> (a -> Property) -> Property-aroundProperty action p = MkProperty . MkGen $ \r n -> aroundProp action $ \a -> (unGen . unProperty $ p a) r n+aroundProperty hook p = MkProperty . MkGen $ \r n -> aroundProp hook $ \a -> (unGen . unProperty $ p a) r n  aroundProp :: ((a -> IO ()) -> IO ()) -> (a -> Prop) -> Prop-aroundProp action p = MkProp $ aroundRose action (\a -> unProp $ p a)+aroundProp hook p = MkProp $ aroundRose hook (\a -> unProp $ p a)  aroundRose :: ((a -> IO ()) -> IO ()) -> (a -> Rose QCP.Result) -> Rose QCP.Result-aroundRose action r = ioRose $ do-  ref <- newIORef (return QCP.succeeded)-  action $ \a -> reduceRose (r a) >>= writeIORef ref-  readIORef ref+aroundRose hook r = ioRose $ do+  liftHook (return QCP.succeeded) hook $ \ a -> reduceRose (r a)  newSeed :: IO Int newSeed = fst . randomR (0, fromIntegral (maxBound :: Int32)) <$>
src/Test/Hspec/Core/Runner.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}  -- | -- Stability: provisional@@ -90,7 +91,6 @@ import           System.IO import           System.Environment (getArgs, withArgs) import           System.Exit-import qualified Control.Exception as E import           System.Random import           Control.Monad.ST import           Data.STRef@@ -147,7 +147,7 @@   | otherwise = id   where     removeCleanup :: IO () -> IO ()-    removeCleanup _ = return ()+    removeCleanup _ = pass      markSuccess :: EvalItem -> EvalItem     markSuccess item = item {evalItemAction = \ _ -> return $ Result "" Success}@@ -284,10 +284,13 @@   | configFailOnFocused config = mapItem failFocused   | otherwise = id -failFocused :: Item a -> Item a+failFocused :: forall a. Item a -> Item a failFocused item = item {itemExample = example}   where+    failure :: ResultStatus     failure = Failure Nothing (Reason "item is focused; failing due to --fail-on=focused")++    example :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result     example       | itemIsFocused item = \ params hook p -> do           Result info status <- itemExample item params hook p@@ -302,9 +305,10 @@   | configFailOnPending config = mapItem failPending   | otherwise = id -failPending :: Item a -> Item a+failPending :: forall a. Item a -> Item a failPending item = item {itemExample = example}   where+    example :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result     example params hook p = do       Result info status <- itemExample item params hook p       return $ Result info $ case status of@@ -431,7 +435,7 @@  withHiddenCursor :: Bool -> Handle -> IO a -> IO a withHiddenCursor useColor h-  | useColor  = E.bracket_ (hHideCursor h) (hShowCursor h)+  | useColor  = bracket_ (hHideCursor h) (hShowCursor h)   | otherwise = id  colorOutputSupported :: ColorMode -> IO Bool -> IO (Bool, Bool)
src/Test/Hspec/Core/Runner/Eval.hs view
@@ -28,7 +28,6 @@ import           Test.Hspec.Core.Compat hiding (Monad) import qualified Test.Hspec.Core.Compat as M -import qualified Control.Exception as E import           Control.Concurrent import           Control.Concurrent.Async hiding (cancel) @@ -132,11 +131,11 @@     start = parallelizeTree (evalConfigConcurrentJobs config) specs     cancel = cancelMany . concatMap toList . map (fmap fst) -  E.bracket start cancel $ \ runningSpecs -> do+  bracket start cancel $ \ runningSpecs -> do     withTimer 0.05 $ \ timer -> do        format Format.Started-      runReaderT (run . applyCleanup $ map (fmap (fmap (. reportProgress timer) . snd)) runningSpecs) (Env config ref) `E.finally` do+      runReaderT (run . applyCleanup $ map (fmap (fmap (. reportProgress timer) . snd)) runningSpecs) (Env config ref) `finally` do         results <- reverse <$> readIORef ref         format (Format.Done results) @@ -161,7 +160,7 @@ , itemAction :: a } deriving Functor -type Job m p a = (p -> m ()) -> m a+type Job m progress a = (progress -> m ()) -> m a  type RunningItem = Item (Path -> IO (Seconds, Result)) type RunningTree c = Tree c RunningItem@@ -170,9 +169,9 @@ applyCleanup = map go   where     go t = case t of-      Leaf a -> Leaf a       Node label xs -> Node label (go <$> xs)       NodeWithCleanup loc cleanup xs -> NodeWithCleanup loc () (addCleanupToLastLeaf loc cleanup $ go <$> xs)+      Leaf a -> Leaf a  addCleanupToLastLeaf :: Maybe (String, Location) -> IO () -> NonEmpty (RunningTree ()) -> NonEmpty (RunningTree ()) addCleanupToLastLeaf loc cleanup = go@@ -180,9 +179,9 @@     go = NonEmpty.reverse . mapHead goNode . NonEmpty.reverse      goNode node = case node of+      Node description xs -> Node description (go xs)+      NodeWithCleanup loc_ () xs -> NodeWithCleanup loc_ () (go xs)       Leaf item -> Leaf (addCleanupToItem loc cleanup item)-      NodeWithCleanup loc_ () zs -> NodeWithCleanup loc_ () (go zs)-      Node description zs -> Node description (go zs)  mapHead :: (a -> a) -> NonEmpty a -> NonEmpty a mapHead f xs = case xs of@@ -230,31 +229,32 @@   (asyncAction, evalAction) <- parallelize (Semaphore (waitQSem sem) (signalQSem sem)) evalItemParallelize (interruptible . evalItemAction)   return (asyncAction, Item evalItemDescription evalItemLocation evalAction) -parallelize :: MonadIO m => Semaphore -> Bool -> Job IO p a -> IO (Async (), Job m p (Seconds, a))+parallelize :: MonadIO m => Semaphore -> Bool -> Job IO progress a -> IO (Async (), Job m progress (Seconds, a)) parallelize sem isParallelizable   | isParallelizable = runParallel sem   | otherwise = runSequentially -runSequentially :: MonadIO m => Job IO p a -> IO (Async (), Job m p (Seconds, a))+runSequentially :: MonadIO m => Job IO progress a -> IO (Async (), Job m progress (Seconds, a)) runSequentially action = do   mvar <- newEmptyMVar-  (asyncAction, evalAction) <- runParallel (Semaphore (takeMVar mvar) (return ())) action+  (asyncAction, evalAction) <- runParallel (Semaphore (takeMVar mvar) pass) action   return (asyncAction, \ notifyPartial -> liftIO (putMVar mvar ()) >> evalAction notifyPartial) -data Parallel p a = Partial p | Return a+data Parallel progress a = Partial progress | Return a -runParallel :: forall m p a. MonadIO m => Semaphore -> Job IO p a -> IO (Async (), Job m p (Seconds, a))+runParallel :: forall m progress a. MonadIO m => Semaphore -> Job IO progress a -> IO (Async (), Job m progress (Seconds, a)) runParallel Semaphore{..} action = do   mvar <- newEmptyMVar-  asyncAction <- async $ E.bracket_ semaphoreWait semaphoreSignal (worker mvar)+  asyncAction <- async $ bracket_ semaphoreWait semaphoreSignal (worker mvar)   return (asyncAction, eval mvar)   where+    worker :: MVar (Parallel progress (Seconds, a)) -> IO ()     worker mvar = do       let partialCallback = replaceMVar mvar . Partial       result <- measure $ action partialCallback       replaceMVar mvar (Return result) -    eval :: MVar (Parallel p (Seconds, a)) -> (p -> m ()) -> m (Seconds, a)+    eval :: MVar (Parallel progress (Seconds, a)) -> (progress -> m ()) -> m (Seconds, a)     eval mvar notifyPartial = do       r <- liftIO (takeMVar mvar)       case r of@@ -315,7 +315,7 @@ sequenceActions failFast = go   where     go :: [EvalM ()] -> EvalM ()-    go [] = return ()+    go [] = pass     go (action : actions) = do       action       stopNow <- case failFast of
src/Test/Hspec/Core/Runner/PrintSlowSpecItems.hs view
@@ -28,7 +28,7 @@       unless (null xs) $ do         putStrLn "\nSlow spec items:"         mapM_ printSlowSpecItem xs-    _ -> return ()+    _ -> pass  toSlowItem :: (Path, Item) -> SlowItem toSlowItem (path, item) = SlowItem (itemLocation item)  path (toMilliseconds $ itemDuration item)
src/Test/Hspec/Core/Shuffle.hs view
@@ -16,16 +16,16 @@ import           Data.STRef import           Data.Array.ST -shuffleForest :: STRef s StdGen -> [Tree c a] -> ST s [Tree c a]+shuffleForest :: STRef st StdGen -> [Tree c a] -> ST st [Tree c a] shuffleForest ref xs = (shuffle ref xs >>= mapM (shuffleTree ref)) -shuffleTree :: STRef s StdGen -> Tree c a -> ST s (Tree c a)+shuffleTree :: STRef st StdGen -> Tree c a -> ST st (Tree c a) shuffleTree ref t = case t of   Node d xs -> Node d <$> shuffleForest ref xs   NodeWithCleanup loc c xs -> NodeWithCleanup loc c <$> shuffleForest ref xs   Leaf {} -> return t -shuffle :: STRef s StdGen -> [a] -> ST s [a]+shuffle :: STRef st StdGen -> [a] -> ST st [a] shuffle ref xs = do   arr <- mkArray xs   bounds@(_, n) <- getBounds arr@@ -41,5 +41,5 @@       writeSTRef ref gen       return a -mkArray :: [a] -> ST s (STArray s Int a)+mkArray :: [a] -> ST st (STArray st Int a) mkArray xs = newListArray (1, length xs) xs
src/Test/Hspec/Core/Spec.hs view
@@ -78,8 +78,6 @@ import           Prelude () import           Test.Hspec.Core.Compat -import qualified Control.Exception as E-import           Data.CallStack import           Control.Monad.Trans.Class (lift) import           Control.Monad.Trans.Reader (asks) @@ -188,16 +186,16 @@ -- >   it "can format text in a way that everyone likes" $ -- >     pending pending :: HasCallStack => Expectation-pending = E.throwIO (Pending location Nothing)+pending = throwIO (Pending location Nothing)  pending_ :: Expectation-pending_ = (E.throwIO (Pending Nothing Nothing))+pending_ = (throwIO (Pending Nothing Nothing))  -- | -- `pendingWith` is similar to `pending`, but it takes an additional string -- argument that can be used to specify the reason for why the spec item is pending. pendingWith :: HasCallStack => String -> Expectation-pendingWith = E.throwIO . Pending location . Just+pendingWith = throwIO . Pending location . Just  -- | Get the path of `describe` labels, from the root all the way in to the -- call-site of this function.
src/Test/Hspec/Core/Timer.hs view
@@ -3,7 +3,6 @@ import           Prelude () import           Test.Hspec.Core.Compat -import           Control.Exception import           Control.Concurrent.Async  import           Test.Hspec.Core.Clock
src/Test/Hspec/Core/Tree.hs view
@@ -27,7 +27,7 @@ import           Prelude () import           Test.Hspec.Core.Compat -import           Data.CallStack (HasCallStack, SrcLoc(..))+import           Data.CallStack (SrcLoc(..)) import qualified Data.CallStack as CallStack import           Data.Maybe @@ -52,7 +52,7 @@   where     go spec = case spec of       Node d xs -> Node d (map go xs)-      NodeWithCleanup loc cleanup xs -> NodeWithCleanup loc (g cleanup) (map go xs)+      NodeWithCleanup loc action xs -> NodeWithCleanup loc (g action) (map go xs)       Leaf item -> Leaf (f item)  filterTree :: (a -> Bool) -> Tree c a -> Maybe (Tree c a)@@ -144,6 +144,3 @@ defaultDescription = case CallStack.callSite of   Just (_, loc) -> Just (srcLocModule loc ++ "[" ++ show (srcLocStartLine loc) ++ ":" ++ show (srcLocStartCol loc) ++ "]")   Nothing -> Nothing--toLocation :: SrcLoc -> Location-toLocation loc = Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc)
src/Test/Hspec/Core/Util.hs view
@@ -21,7 +21,6 @@  import           Data.Char (isSpace) import           GHC.IO.Exception-import           Control.Exception import           Control.Concurrent.Async  -- |
test/Helper.hs view
@@ -41,8 +41,6 @@ import           Data.Char import           System.Environment (withArgs, getEnvironment) import           System.Exit-import qualified Control.Exception as E-import           Control.Exception import           System.IO.Silently import           System.SetEnv import           System.FilePath@@ -64,10 +62,10 @@  import           Data.Orphans() -exceptionEq :: E.SomeException -> E.SomeException -> Bool+exceptionEq :: SomeException -> SomeException -> Bool exceptionEq a b-  | Just ea <- E.fromException a, Just eb <- E.fromException b = ea == (eb :: E.ErrorCall)-  | Just ea <- E.fromException a, Just eb <- E.fromException b = ea == (eb :: E.ArithException)+  | Just ea <- fromException a, Just eb <- fromException b = ea == (eb :: ErrorCall)+  | Just ea <- fromException a, Just eb <- fromException b = ea == (eb :: ArithException)   | otherwise = throw (HUnit.HUnitFailure Nothing $ HUnit.ExpectedButGot Nothing (formatException b) (formatException a))  deriving instance Eq FailureReason@@ -81,16 +79,16 @@   (==) = exceptionEq  throwException :: IO a-throwException = E.throwIO DivideByZero+throwException = throwIO DivideByZero  throwException_ :: IO () throwException_ = throwException  ignoreExitCode :: IO () -> IO ()-ignoreExitCode action = action `E.catch` \e -> let _ = e :: ExitCode in return ()+ignoreExitCode action = action `catch` \e -> let _ = e :: ExitCode in pass  ignoreUserInterrupt :: IO () -> IO ()-ignoreUserInterrupt action = E.catchJust (guard . (== E.UserInterrupt)) action return+ignoreUserInterrupt action = catchJust (guard . (== UserInterrupt)) action return  captureLines :: IO a -> IO [String] captureLines = fmap lines . capture_@@ -116,7 +114,7 @@ defaultParams = H.defaultParams {H.paramsQuickCheckArgs = stdArgs {replay = Just (mkGen 23, 0), maxSuccess = 1000}}  noOpProgressCallback :: H.ProgressCallback-noOpProgressCallback _ = return ()+noOpProgressCallback _ = pass  shouldUseArgs :: HasCallStack => [String] -> (Args -> Bool) -> Expectation shouldUseArgs args p = do
test/Test/Hspec/Core/Example/LocationSpec.hs view
@@ -10,8 +10,6 @@ import           Prelude () import           Helper -import           Control.Exception- import           Test.Hspec.Core.Example import           Test.Hspec.Core.Example.Location @@ -50,7 +48,7 @@             foo :: Either () ()             foo = do               23 <- Right (42 :: Int)-              return ()+              pass           Left e <- try (evaluate foo)           extractLocation e `shouldBe` location #endif@@ -93,7 +91,7 @@     context "with NoMethodError" $ do       it "extracts Location" $ do         Left e <- try $ someMethod ()-        extractLocation e `shouldBe` Just (Location file 21 10)+        extractLocation e `shouldBe` Just (Location file 19 10)      context "with AssertionFailed" $ do       it "extracts Location" $ do
test/Test/Hspec/Core/ExampleSpec.hs view
@@ -9,7 +9,6 @@ import           Helper  import           Mock-import           Control.Exception import           Test.HUnit (assertFailure, assertEqual)  import           Test.Hspec.Core.Example (Result(..), ResultStatus(..), FailureReason(..))@@ -30,8 +29,54 @@ evaluateExampleWithArgument :: H.Example e => (ActionWith (H.Arg e) -> IO ()) -> e -> IO Result evaluateExampleWithArgument action e = H.evaluateExample e defaultParams action noOpProgressCallback +bottom :: a+bottom = throw DivideByZero+ spec :: Spec spec = do+  describe "safeEvaluate" $ do+    let+      status :: ResultStatus+      status = Failure Nothing (Error Nothing $ toException DivideByZero)++      err :: Result+      err = Result "" status++    it "forces Result" $ do+      H.safeEvaluate (return $ Result "" bottom) `shouldReturn` err++    it "handles ResultStatus exceptions" $ do+      H.safeEvaluate (throwIO status) `shouldReturn` err++    it "forces ResultStatus exceptions" $ do+      H.safeEvaluate (throwIO $ Failure Nothing bottom) `shouldReturn` err++    it "handles other exceptions" $ do+      H.safeEvaluate (throwIO DivideByZero) `shouldReturn` err++    it "forces other exceptions" $ do+      H.safeEvaluate (throwIO $ ErrorCall bottom) `shouldReturn` err++  describe "safeEvaluateResultStatus" $ do+    let+      err :: ResultStatus+      err = Failure Nothing (Error Nothing $ toException DivideByZero)++    it "forces ResultStatus" $ do+      H.safeEvaluateResultStatus (return $ Failure Nothing bottom) `shouldReturn` err++    it "handles ResultStatus exceptions" $ do+      H.safeEvaluateResultStatus (throwIO err) `shouldReturn` err++    it "forces ResultStatus exceptions" $ do+      H.safeEvaluateResultStatus (throwIO $ Failure Nothing bottom) `shouldReturn` err++    it "handles other exceptions" $ do+      H.safeEvaluateResultStatus (throwIO DivideByZero) `shouldReturn` err++    it "forces other exceptions" $ do+      H.safeEvaluateResultStatus (throwIO $ ErrorCall bottom) `shouldReturn` err+   describe "safeEvaluateExample" $ do     context "for Expectation" $ do       it "returns Failure if an expectation does not hold" $ do@@ -131,7 +176,7 @@        it "returns Failure if property does not hold" $ do         Result "" (Failure _ _) <- evaluateExample $ property $ \n -> n /= (n :: Int)-        return ()+        pass        it "shows what falsified it" $ do         Result "" (Failure _ r) <- evaluateExample $ property $ \ (x :: Int) (y :: Int) -> (x == 0 && y == 1) ==> False
test/Test/Hspec/Core/FailureReportSpec.hs view
@@ -4,7 +4,6 @@ import           Helper  import           System.IO-import qualified Control.Exception as E import           Test.Hspec.Core.FailureReport import           Test.Hspec.Core.Config @@ -12,7 +11,7 @@ spec = do   describe "writeFailureReport" $ do     it "prints a warning on unexpected exceptions" $ do-      r <- hCapture_ [stderr] $ writeFailureReport defaultConfig (E.throw (E.ErrorCall "some error"))+      r <- hCapture_ [stderr] $ writeFailureReport defaultConfig (throw (ErrorCall "some error"))       r `shouldBe` "WARNING: Could not write environment variable HSPEC_FAILURES (some error)\n"    describe "readFailureReport" $ do
test/Test/Hspec/Core/FormatSpec.hs view
@@ -3,8 +3,6 @@ import           Prelude () import           Helper -import           Control.Exception- import           Test.Hspec.Core.Format  spec :: Spec
test/Test/Hspec/Core/Formatters/Pretty/ParserSpec.hs view
@@ -35,18 +35,23 @@     it "parses strings" $ do       show "foo" `shouldParseAs` String "foo" -    context "when parsing numbers" $ do-      it "accepts integers" $ do-        "23" `shouldParseAs` Number "23"+    it "accepts rationals" $ do+      show (0.5 :: Rational) `shouldParseAs` Rational (Number "1") (Number "2") -      it "accepts negative integers" $ do-        "-23" `shouldParseAs` Number "-23"+    it "accepts negative rationals" $ do+      show (-0.5 :: Rational) `shouldParseAs` Rational (parentheses $ Number "-1") (Number "2") -      it "accepts floats" $ do-        show (23.0 :: Float) `shouldParseAs` Number "23.0"+    it "accepts integers" $ do+      "23" `shouldParseAs` Number "23" -      it "accepts negative floats" $ do-        show (-23.0 :: Float) `shouldParseAs` Number "-23.0"+    it "accepts negative integers" $ do+      "-23" `shouldParseAs` Number "-23"++    it "accepts floats" $ do+      show (23.0 :: Float) `shouldParseAs` Number "23.0"++    it "accepts negative floats" $ do+      show (-23.0 :: Float) `shouldParseAs` Number "-23.0"      it "parses lists" $ do       show ["foo", "bar", "baz"] `shouldParseAs` List [String "foo", String "bar", String "baz"]
test/Test/Hspec/Core/Formatters/PrettySpec.hs view
@@ -57,11 +57,11 @@         ]      it "pretty-prints tuples" $ do-      pretty True (show (person, 23 :: Double)) `shouldBe` just [+      pretty True (show (person, -0.5 :: Rational)) `shouldBe` just [           "(Person {"         , "  personName = \"Joe\","         , "  personAge = 23"-        , "}, 23.0)"+        , "}, (-1) % 2)"         ]      it "pretty-prints lists" $ do
test/Test/Hspec/Core/Formatters/V1Spec.hs view
@@ -6,8 +6,7 @@ import           Helper import           Data.String import           Control.Monad.IO.Class-import           Control.Monad.Trans.Writer-import qualified Control.Exception as E+import           Control.Monad.Trans.Writer hiding (pass)  import qualified Test.Hspec.Core.Spec as H import qualified Test.Hspec.Core.Runner as H@@ -192,7 +191,7 @@           H.describe "foo" $ do             H.it "example 1" True           H.describe "bar" $ do-            return ()+            pass           H.describe "baz" $ do             H.it "example 2" True @@ -283,7 +282,7 @@      it "prints the exception type for requirements that fail due to an uncaught exception" $ do       r <- runSpec $ do-        H.it "foobar" (E.throw (E.ErrorCall "baz") :: Bool)+        H.it "foobar" (throw (ErrorCall "baz") :: Bool)       r `shouldContain` [           "  1) foobar"         , "       uncaught exception: ErrorCall"
test/Test/Hspec/Core/Formatters/V2Spec.hs view
@@ -2,7 +2,6 @@  import           Prelude () import           Helper-import qualified Control.Exception as E  import qualified Test.Hspec.Core.Spec as H import qualified Test.Hspec.Core.Spec as Spec@@ -192,7 +191,7 @@           H.describe "foo" $ do             H.it "example 1" True           H.describe "bar" $ do-            return ()+            pass           H.describe "baz" $ do             H.it "example 2" True @@ -292,7 +291,7 @@      it "prints the exception type for requirements that fail due to an uncaught exception" $ do       r <- runSpec $ do-        H.it "foobar" (E.throw (E.ErrorCall "baz") :: Bool)+        H.it "foobar" (throw (ErrorCall "baz") :: Bool)       r `shouldContain` [           "  1) foobar"         , "       uncaught exception: ErrorCall"
test/Test/Hspec/Core/HooksSpec.hs view
@@ -6,8 +6,6 @@ import           Helper import           Mock -import           Control.Exception- import qualified Test.Hspec.Core.Runner as H import qualified Test.Hspec.Core.Spec as H import           Test.Hspec.Core.Format@@ -23,7 +21,7 @@ evalSpec = fmap normalize . (toEvalForest >=> runFormatter config)   where     config = EvalConfig {-      evalConfigFormat = \ _ -> return ()+      evalConfigFormat = \ _ -> pass     , evalConfigConcurrentJobs = 1     , evalConfigFailFast = False     }@@ -154,7 +152,7 @@       it "does not run specified action" $ do         (rec, retrieve) <- mkAppend         evalSpec_ $ H.beforeAll (rec "beforeAll" >> return "value") $ do-          return ()+          pass         retrieve `shouldReturn` []    describe "beforeAll_" $ do@@ -246,7 +244,7 @@         (rec, retrieve) <- mkAppend         evalSpec_ $ H.beforeAll (return (23 :: Int)) $           H.beforeAllWith (\_ -> rec "beforeAllWith" >> return "value") $ do-            return ()+            pass         retrieve `shouldReturn` []    describe "after" $ do@@ -328,7 +326,7 @@     context "when used with an empty list of examples" $ do       it "does not run specified action" $ do         evalSpec $ H.before undefined $ H.afterAll undefined $ do-          return ()+          pass         `shouldReturn` []      context "when action throws an exception" $ do@@ -373,7 +371,7 @@       it "does not run specified action" $ do         (rec, retrieve) <- mkAppend         evalSpec_ $ H.afterAll_ (rec "afterAll_") $ do-          return ()+          pass         retrieve `shouldReturn` []      context "when action is pending" $ do@@ -401,7 +399,7 @@     context "when action is successful" $ do       it "does not report anything" $ do         evalSpec $ do-          H.afterAll_ (return ()) $ do+          H.afterAll_ pass $ do             H.it "foo" True         `shouldReturn` [           item ["foo"] Success
test/Test/Hspec/Core/Runner/EvalSpec.hs view
@@ -4,7 +4,6 @@ import           Prelude () import           Helper -import           Control.Exception import           NonEmpty (fromList)  import           Test.Hspec.Core.Spec (FailureReason(..), Result(..), ResultStatus(..), Location(..))@@ -80,7 +79,7 @@       ref <- newIORef []       (_, actionA) <- runSequentially $ \ _ -> modifyIORef ref (23 :)       (_, actionB) <- runSequentially $ \ _ -> modifyIORef ref (42 :)-      (_, ()) <- actionB (\_ -> return ())+      (_, ()) <- actionB (\_ -> pass)       readIORef ref `shouldReturn` [42 :: Int]-      (_, ()) <- actionA (\_ -> return ())+      (_, ()) <- actionA (\_ -> pass)       readIORef ref `shouldReturn` [23, 42]
test/Test/Hspec/Core/Runner/PrintSlowSpecItemsSpec.hs view
@@ -25,7 +25,7 @@ spec :: Spec spec = do   describe "printSlowSpecItems" $ do-    let format = printSlowSpecItems 2 $ \ _ -> return ()+    let format = printSlowSpecItems 2 $ \ _ -> pass     it "prints slow spec items" $ do       capture_ $ format $ Done [             ((["foo", "bar"], "one"), item {itemDuration = 0.100})
test/Test/Hspec/Core/RunnerSpec.hs view
@@ -16,7 +16,6 @@ import           System.Environment (withArgs, withProgName, getArgs) import           System.Exit import           Control.Concurrent-import qualified Control.Exception as E import           Control.Concurrent.Async import           Mock import           System.SetEnv@@ -59,15 +58,15 @@       mvar <- newEmptyMVar       hspec_ $ do         H.it "foo" $ do-          E.getMaskingState >>= putMVar mvar-      takeMVar mvar `shouldReturn` E.Unmasked+          getMaskingState >>= putMVar mvar+      takeMVar mvar `shouldReturn` Unmasked      it "runs finalizers" $ do       mvar <- newEmptyMVar       ref <- newIORef "did not run finalizer"       a <- async $ hspec_ $ do           H.it "foo" $ do-            (putMVar mvar () >> threadDelay 10000000) `E.finally`+            (putMVar mvar () >> threadDelay 10000000) `finally`               writeIORef ref "ran finalizer"       takeMVar mvar       cancel a@@ -195,7 +194,7 @@             H.it "baz" True           putMVar mvar r         takeMVar sync-        throwTo threadId E.UserInterrupt+        throwTo threadId UserInterrupt         r <- takeMVar mvar         normalizeSummary r `shouldBe` [             ""@@ -221,10 +220,10 @@             H.it "foo" $ do               putMVar sync ()               threadDelay 1000000-          `E.catch` putMVar mvar+          `catch` putMVar mvar         takeMVar sync-        throwTo threadId E.UserInterrupt-        takeMVar mvar `shouldReturn` E.UserInterrupt+        throwTo threadId UserInterrupt+        takeMVar mvar `shouldReturn` UserInterrupt      context "with --dry-run" $ do       let withDryRun = captureLines . withArgs ["--dry-run"] . H.hspec@@ -271,7 +270,7 @@      context "with --fail-on=empty" $ do       it "fails if no spec items have been run" $ do-        (out, r) <- capture . E.try . withArgs ["--skip=", "--fail-on=empty"] . H.hspec $ do+        (out, r) <- capture . try . withArgs ["--skip=", "--fail-on=empty"] . H.hspec $ do           H.it "foo" True           H.it "bar" True           H.it "baz" True@@ -312,7 +311,7 @@         r <- run $ do           H.it "foo" True           H.it "bar" $ do-            void $ E.throwIO (H.Pending Nothing Nothing)+            void $ throwIO (H.Pending Nothing Nothing)          normalizeSummary r `shouldBe` [             ""@@ -368,7 +367,7 @@             H.it "bar" $ do               -- NOTE: waitQSem should never return here, as we want to               -- guarantee that the thread is killed before hspec returns-              (signalQSem child1 >> waitQSem child2 >> writeIORef ref "foo") `E.finally` signalQSem parent+              (signalQSem child1 >> waitQSem child2 >> writeIORef ref "foo") `finally` signalQSem parent         signalQSem child2         waitQSem parent         readIORef ref `shouldReturn` ""@@ -737,7 +736,7 @@               atomicModifyIORef highRef $ \x -> (max x current, ())             stop = atomicModifyIORef currentRef $ \x -> (pred x, ())         r <- hspecResult ["-j", show j] . H.parallel $ do-          replicateM_ n $ H.it "foo" $ E.bracket_ start stop $ sleep t+          replicateM_ n $ H.it "foo" $ bracket_ start stop $ sleep t         r `shouldBe` H.Summary n 0         high <- readIORef highRef         high `shouldBe` j
test/Test/Hspec/Core/TimerSpec.hs view
@@ -8,7 +8,7 @@ spec :: Spec spec = do   describe "timer action provided by withTimer" $ do-    return () -- this test is fragile, see e.g. https://github.com/hspec/hspec/issues/352+    pass -- this test is fragile, see e.g. https://github.com/hspec/hspec/issues/352  {-     let
test/Test/Hspec/Core/UtilSpec.hs view
@@ -4,7 +4,6 @@ import           Helper  import           Control.Concurrent-import qualified Control.Exception as E  import           Test.Hspec.Core.Util @@ -22,12 +21,12 @@    describe "formatException" $ do     it "converts exception to string" $ do-      formatException (E.toException E.DivideByZero) `shouldBe` "ArithException\ndivide by zero"+      formatException (toException DivideByZero) `shouldBe` "ArithException\ndivide by zero"      context "when used with an IOException" $ do       it "includes the IOErrorType" $ do         inTempDirectory $ do-          Left e <- E.try (readFile "foo")+          Left e <- try (readFile "foo")           formatException e `shouldBe` intercalate "\n" [               "IOException of type NoSuchThing"             , "foo: openFile: does not exist (No such file or directory)"@@ -59,21 +58,21 @@      it "returns Left on exception" $ do       Left e <- safeTry throwException-      E.fromException e `shouldBe` Just E.DivideByZero+      fromException e `shouldBe` Just DivideByZero      it "evaluates result to weak head normal form" $ do-      Left e <- safeTry (return $ E.throw $ E.ErrorCall "foo")+      Left e <- safeTry (return $ throw $ ErrorCall "foo")       show e `shouldBe` "foo"      it "does not catch asynchronous exceptions" $ do       mvar <- newEmptyMVar       sync <- newEmptyMVar       threadId <- forkIO $ do-        safeTry (putMVar sync () >> threadDelay 1000000) >> return ()-        `E.catch` putMVar mvar+        safeTry (putMVar sync () >> threadDelay 1000000) >> pass+        `catch` putMVar mvar       takeMVar sync-      throwTo threadId E.UserInterrupt-      readMVar mvar `shouldReturn` E.UserInterrupt+      throwTo threadId UserInterrupt+      readMVar mvar `shouldReturn` UserInterrupt    describe "filterPredicate" $ do     it "tries to match a pattern against a path" $ do
version.yaml view
@@ -1,1 +1,1 @@-&version 2.10.7+&version 2.10.8