chell 0.1 → 0.1.1

raw patch · 2 files changed

+28/−10 lines, 2 files

Files

• chell.cabal +1/−1
• src/Test/Chell.hs +27/−9

@@ -1,5 +1,5 @@ name: chell-version: 0.1+version: 0.1.1 synopsis: Quiet test runner license: MIT license-file: license.txt

@@ -36,6 +36,8 @@ 	, equalWithin 	, just 	, nothing+	, left+	, right 	, throws 	, throwsEq 	, greater@@ -63,7 +65,7 @@ import qualified Control.Applicative import qualified Control.Exception import           Control.Exception (Exception)-import           Control.Monad (ap, liftM)+import           Control.Monad (ap, liftM, when) import           Control.Monad.IO.Class (MonadIO, liftIO) import qualified Data.Algorithm.Patience as Patience import qualified Data.ByteString.Char8@@ -198,8 +200,8 @@ 		 		handleJankyIO opts getResult getNotes -addFailure :: Maybe TH.Loc -> Bool -> Text -> Assertions ()-addFailure maybe_loc fatal msg = Assertions $ \(notes, fs) -> do+addFailure :: Maybe TH.Loc -> Text -> Assertions ()+addFailure maybe_loc msg = Assertions $ \(notes, fs) -> do 	let loc = do 		th_loc <- maybe_loc 		return $ Location@@ -207,22 +209,24 @@ 			, locationModule = Data.Text.pack (TH.loc_module th_loc) 			, locationLine = toInteger (fst (TH.loc_start th_loc)) 			}-	return ( if fatal then Nothing else Just ()-	       , (notes, Failure loc msg : fs))+	return (Just (), (notes, Failure loc msg : fs)) +die :: Assertions a+die = Assertions (\s -> return (Nothing, s))+ -- | Cause a test to immediately fail, with a message. -- -- 'fail' is a Template Haskell macro, to retain the source-file location -- from which it was used. Its effective type is: -- -- @--- $fail :: 'Text' -> 'Assertions' ()+-- $fail :: 'Text' -> 'Assertions' a -- @-fail :: TH.Q TH.Exp -- :: Text -> Assertions ()+fail :: TH.Q TH.Exp -- :: Text -> Assertions a fail = do 	loc <- TH.location 	let qloc = liftLoc loc-	[| addFailure (Just $qloc) True |]+	[| \msg -> addFailure (Just $qloc) msg >> die |]  -- | Print a message from within a test. This is just a helper for debugging, -- so you don't have to import @Debug.Trace@.@@ -249,7 +253,9 @@ 	result <- liftIO io 	case result of 		AssertionPassed -> return ()-		AssertionFailed err -> addFailure (Just loc) fatal err+		AssertionFailed err -> do+			addFailure (Just loc) err+			when fatal die  -- | Run an 'Assertion'. If the assertion fails, the test will immediately -- fail.@@ -308,6 +314,18 @@ -- | Assert that some value is @Nothing@. nothing :: Maybe a -> Assertion nothing x = pure (isNothing x) ("nothing: received Just")++-- | Assert that some value is @Left@.+left :: Either a b -> Assertion+left x = pure (isLeft x) ("left: received Right") where+	isLeft (Left _) = True+	isLeft (Right _) = False++-- | Assert that some value is @Right@.+right :: Either a b -> Assertion+right x = pure (isRight x) ("right: received Left") where+	isRight (Left _) = False+	isRight (Right _) = True  -- | Assert that some computation throws an exception matching the provided -- predicate. This is mostly useful for exception types which do not have an