microspec 0.2.0.1 → 0.2.1.0
raw patch · 2 files changed
+63/−51 lines, 2 files
Files
- Test/Microspec.hs +62/−50
- microspec.cabal +1/−1
Test/Microspec.hs view
@@ -47,6 +47,7 @@ -- * Compatibility , shouldBe+ , shouldSatisfy -- Reexports , module Test.QuickCheck@@ -98,32 +99,35 @@ -- | 'microspec' with 'MArgs' microspecWith :: MArgs -> Microspec () -> IO ()-microspecWith args spec = do+microspecWith args (Microspec specs ()) = do putStrLn "" startTime <- getCurrentTime- results <- forM (buildTestTrees spec) $ \test -> do++ results <- forM specs $ \test -> do runTestWith args 0 test- let numSucc, numPend, numFail :: Int- numSucc = (sum::[Int]->Int) $ map numSuccesses results- numPend = (sum::[Int]->Int) $ map numPending results- numFail = (sum::[Int]->Int) $ map numFailures results++ let resultCount :: ResultCounts+ resultCount = mconcat $ map countResults results endTime <- getCurrentTime- when ((numPend + numFail) /= 0) $+ when ((numPending resultCount + numFailures resultCount) /= 0) $ putStrLn "\n ----- Failures and pending:\n"- forM_ (filterPendingAndFails results) $ \x -> do++ forM_ (pruneOutSuccesses results) $ \x -> do printAllTestResults 0 x putStrLn ""+ putStrLn $ "\n -----\nRuntime: " ++ show (diffUTCTime endTime startTime) let colorF :: String -> String- colorF = case (numSucc, numPend, numFail) of- (_, 0, 0) -> inGreen- (_, _, 0) -> inYellow+ colorF = case resultCount of+ ResultCounts { numPending = 0, numFailures = 0 } -> inGreen+ ResultCounts { numFailures = 0 } -> inYellow _ -> inRed putStrLn $ colorF $- "Successes: " ++ show numSucc- ++ ", Pending: " ++ show numPend- ++ ", Failures: " ++ show numFail- when (numFail /= 0) $ exitWith $ ExitFailure 1+ "Successes: " ++ show (numSuccesses resultCount)+ ++ ", Pending: " ++ show (numPending resultCount)+ ++ ", Failures: " ++ show (numFailures resultCount)+ when (numFailures resultCount /= 0) $+ exitWith $ ExitFailure 1 -- TODO: maybe can separate producer and consumer here -- Only reason not to is if we wouldn't get incremental printing of results@@ -183,8 +187,10 @@ "" -> "(untitled)" _ -> s -filterPendingAndFails :: [TestTree QC.Result] -> [TestTree QC.Result]-filterPendingAndFails l = mapMaybe f l+-- At the end of the test run, after printing the full results, we print all of+-- the tests which didn't succeed. We get those here:+pruneOutSuccesses :: [TestTree QC.Result] -> [TestTree QC.Result]+pruneOutSuccesses l = mapMaybe f l where f :: TestTree QC.Result -> Maybe (TestTree QC.Result) f = \case@@ -192,7 +198,7 @@ -- TODO: might want to explicitly pattern-match here: x@(TestLeaf _ (Right _)) -> Just x x@(TestLeaf _ (Left Pending)) -> Just x- TestBranch theLabel xs -> case filterPendingAndFails xs of+ TestBranch theLabel xs -> case pruneOutSuccesses xs of [] -> Nothing leftover -> Just $ TestBranch theLabel leftover @@ -212,9 +218,6 @@ ---------- Constructing a test tree: -addTestTree :: TestTree Property -> Microspec ()-addTestTree tree = Microspec [tree] ()- -- | Something which can be tested -- -- Note both Bools and Properties can be tested, but only Properties show@@ -253,41 +256,48 @@ describe :: String -> t -> Microspec () instance MTestable Property where describe testLabel aProp =- addTestTree $ TestLeaf testLabel (Right aProp)+ Microspec [TestLeaf testLabel (Right aProp)] () instance MTestable Bool where describe testLabel bool =- describe testLabel $ property bool+ describe testLabel $ QC.property bool instance MTestable (TestTree Property) where describe testLabel x =- addTestTree $ TestBranch testLabel [x]+ Microspec [TestBranch testLabel [x]] () instance MTestable Pending where describe testLabel pend =- addTestTree $ TestLeaf testLabel (Left pend)+ Microspec [TestLeaf testLabel (Left pend)] () instance MTestable (Microspec ()) where- describe testLabel x =- let forest = buildTestTrees x- in addTestTree $ TestBranch testLabel forest+ describe testLabel (Microspec forest ()) =+ Microspec [TestBranch testLabel forest] () instance (Arbitrary a, Show a, Testable prop) => MTestable (a -> prop) where describe testLabel f =- describe testLabel $ property f+ describe testLabel $ QC.property f --- TODO: general function for these 3:-numSuccesses, numFailures, numPending :: TestTree QC.Result -> Int-numSuccesses = \case- TestBranch _ ts -> (sum::[Int]->Int) $ map numSuccesses ts- TestLeaf _ (Right Success{}) -> 1- TestLeaf _ (Right _) -> 0- TestLeaf _ (Left _) -> 0-numFailures = \case- TestBranch _ ts -> (sum::[Int]->Int) $ map numFailures ts- TestLeaf _ (Right Success{}) -> 0- TestLeaf _ (Right _) -> 1- TestLeaf _ (Left _) -> 0-numPending = \case- TestBranch _ ts -> (sum::[Int]->Int) $ map numPending ts- TestLeaf _ (Right _) -> 0- TestLeaf _ (Left _) -> 1+data ResultCounts+ = ResultCounts {+ numSuccesses :: Int+ , numFailures :: Int+ , numPending :: Int+ } deriving (Show) +-- This might not be the most efficient, but a quick idea:+instance Monoid ResultCounts where+ -- TODO: semigroup/monoid?:+ mempty = ResultCounts 0 0 0+ (ResultCounts a0 b0 c0) `mappend` (ResultCounts a1 b1 c1) =+ ResultCounts (a0+a1) (b0+b1) (c0+c1)++countResults :: TestTree QC.Result -> ResultCounts+countResults = \case+ TestLeaf _ (Right Success{}) ->+ mempty { numSuccesses = 1 }+ TestLeaf _ (Right _) ->+ mempty { numFailures = 1 }+ TestLeaf _ (Left Pending) ->+ mempty { numPending = 1 }+ TestBranch _ ts ->+ mconcat $ map countResults ts+ instance Show (TestTree x) where show = \case TestBranch testLabel subs ->@@ -296,7 +306,8 @@ "Leaf " ++ show testLabel instance Functor Microspec where- fmap f (Microspec forest a) = Microspec forest (f a)+ fmap f (Microspec forest a) =+ Microspec forest (f a) instance Applicative Microspec where pure a = Microspec [] a f <*> a =@@ -310,12 +321,8 @@ Microspec forest1 b = f a in Microspec (forest0 ++ forest1) b -buildTestTrees :: Microspec () -> [TestTree Property]-buildTestTrees (Microspec x _) = x -- ---------- Configuration: -- | Default arguments. Calling \"microspec\" is the same as calling@@ -352,6 +359,11 @@ -- | Hspec compatibility. Equivalent to using 'Test.QuickCheck.===' shouldBe :: (Eq x, Show x) => x -> x -> Property shouldBe = (===)++-- | @since 0.2.1.0+shouldSatisfy :: Show x => x -> (x -> Bool) -> Property+shouldSatisfy x predicate =+ counterexample ("Predicate failed on: "++show x) (predicate x) -- | Note that you don't need to use this to create a test, e.g.: --
microspec.cabal view
@@ -1,5 +1,5 @@ name: microspec-version: 0.2.0.1+version: 0.2.1.0 synopsis: Tiny QuickCheck test library with minimal dependencies description: A tiny (1 module, <500 lines) property-based (and unit) testing library with minimal dependencies.