microspec 0.1.0.0 → 0.2.0.0

raw patch · 2 files changed

+155/−70 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Test/Microspec.hs +149/−64
• microspec.cabal +6/−6

@@ -6,11 +6,11 @@ --   >    describe "plus" $ do --   >       it "adds positive numbers" $ do --   >          it "does 1 + 1" $---   >             1 + 1 == 2+--   >             1 + 1 === 2 --   >          it "does 2 + 2" $---   >             2 + 2 == 4+--   >             2 + 2 === 4 --   >       it "is commutative" $---   >          \x y -> x + y == y + (x :: Int)+--   >          \x y -> x + y === y + (x :: Int) --  --   ...which will return, nicely in green instead of bold: -- @@ -20,10 +20,15 @@ --       __does 1 + 1__ --       __does 2 + 2__ --     __is commutative__+-- +--   -----+--   Successes: 3, Pending: 0, Failures: 0 --   @ -{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE+     FlexibleInstances+   , LambdaCase+   #-}  module Test.Microspec (      -- * Specification@@ -50,7 +55,10 @@    -- , module Test.QuickCheck.Property    ) where +import Data.Char (isSpace)+import Data.Maybe (mapMaybe) import Control.Monad+import System.Exit (exitWith, ExitCode(ExitFailure)) -- import Data.Time (getCurrentTime, diffUTCTime) import Test.QuickCheck as QC import Test.QuickCheck@@ -58,13 +66,32 @@ import Test.QuickCheck.Monadic -- import Test.QuickCheck.Property ++-- Basically a writer monad:++-- | A series of tests, to run with 'microspec'+data Microspec a = Microspec [TestTree Property] a++data TestTree x+   = TestBranch String [TestTree x]+   | TestLeaf String (Either Pending x)++-- If you like the word 'pending', this is the place for you!:+data Pending = Pending+-- | Describe a test as unwritten, e.g.:+-- +--   > describe "meaning of life" $ pending+pending :: Pending+pending = Pending++ ---------- User-facing:  -- | Run your spec. Put this at the top level, e.g.: --  --   > main = microspec $ do --   >    describe "plus 1" $---   >       3 + 1 == 4+--   >       3 + 1 === 4 microspec :: Microspec () -> IO () microspec = microspecWith defaultMArgs @@ -72,23 +99,67 @@ microspecWith :: MArgs -> Microspec () -> IO () microspecWith args spec = do    putStrLn ""-   forM_ (buildTestTrees spec) $ \test -> do-      (runTestWith args {- 1 -} 0) test+   results <- forM (buildTestTrees spec) $ \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+   when ((numPend + numFail) /= 0) $+      putStrLn "\n  ----- Failures and pending:\n"+   forM_ (filterPendingAndFails results) $ \x -> do+      printAllTestResults 0 x       putStrLn ""+   putStrLn "\n  -----\n"+   let colorF :: String -> String+       colorF = case (numSucc, numPend, numFail) of+          (_, 0, 0) -> inGreen+          (_, _, 0) -> inYellow+          _ -> inRed+   putStrLn $ colorF $+         "Successes: " ++ show numSucc+      ++ ", Pending: " ++ show numPend+      ++ ", Failures: " ++ show numFail+   when (numFail /= 0) $ exitWith $ ExitFailure 1 -runTestWith :: MArgs -> Int -> TestTree -> IO ()+-- TODO: maybe can separate producer and consumer here+-- Only reason not to is if we wouldn't get incremental printing of results+runTestWith :: MArgs -> Int -> TestTree Property -> IO (TestTree QC.Result) runTestWith args depth = \case    TestLeaf testLabel (Right aProp) -> do       let timeoutMaybe = case _mArgs_timeoutSecs args of            Nothing -> id            Just numSecs -> within $ fromEnum $ numSecs * (10^(6::Int))       result <- quickCheckWithResult (_mArgs_qcArgs args) $ timeoutMaybe aProp-      putStrLn $ showResult testLabel result-   TestLeaf testLabel (Left Pending) ->-      putStrLn $ indentationFor depth ++ inYellow (testLabel ++ " - PENDING")+      let r = TestLeaf testLabel (Right result)+      printSingleTestResult depth r+      pure r+   TestLeaf testLabel (Left Pending) -> do+      let r = TestLeaf testLabel (Left Pending)+      printSingleTestResult depth r+      pure r    TestBranch testLabel forest -> do-      putStrLn $ indentationFor depth ++ testLabel-      forM_ forest $ runTestWith args (depth + 1)+      printSingleTestResult depth $ TestBranch testLabel [] -- Kinda kludge+      results <- forM forest $ runTestWith args (depth + 1)+      pure $ TestBranch testLabel results++printAllTestResults :: Int -> TestTree QC.Result -> IO ()+printAllTestResults depth = \case+   b@(TestBranch _ forest) -> do+      printSingleTestResult depth b+      mapM_ (printAllTestResults (depth + 1)) forest+   l@(TestLeaf{}) -> printSingleTestResult depth l++printSingleTestResult :: Int -> TestTree QC.Result -> IO ()+printSingleTestResult depth resultTree = do+   putStr $ indentationFor depth+   case resultTree of+      TestLeaf testLabel (Right result) -> do+         putStrLn $ showResult (labelStr testLabel) result+      TestLeaf testLabel (Left Pending) -> do+         putStrLn $ inYellow (labelStr testLabel ++ " - PENDING")+      TestBranch testLabel _ -> do+         putStrLn $ labelStr testLabel  where    indentationFor :: Int -> String    indentationFor n = replicate (n*2) ' ' -- ++ "- "@@ -97,28 +168,30 @@    showResult testLabel = \case        -- note: if we wanted to show quickcheck labels, this is where we would:       Success _ _ _ ->-         indentationFor depth ++ inGreen testLabel+         inGreen testLabel       failure@(Failure{theException=Nothing}) ->-         indentationFor depth-           ++ inRed (testLabel ++ " - "++replaceNewline (output failure))-{--           ++ "\n"-           ++ indentationFor (depth + 1) ++ inRed (show $ usedSeed failure)--}+         inRed (testLabel ++ " - "++replaceNewline (output failure))       failure {- @(Failure{}) -} ->-         indentationFor depth-           ++ inRed (testLabel ++" - "++replaceNewline (output failure))+         inRed (testLabel ++" - "++replaceNewline (output failure))    replaceNewline = concatMap $ \case '\n' -> " | " ; x -> [x]----- If you like the word 'pending', this is the place for you!:-data Pending = Pending--- | Describe a test as unwritten, e.g.:--- ---   > describe "meaning of life" $ pending-pending :: Pending-pending = Pending+   labelStr :: String -> String+   labelStr s = case filter (not . isSpace) s of+      "" -> "(untitled)"+      _ -> s +filterPendingAndFails :: [TestTree QC.Result] -> [TestTree QC.Result]+filterPendingAndFails l = mapMaybe f l+ where+   f :: TestTree QC.Result -> Maybe (TestTree QC.Result)+   f = \case+      TestLeaf _ (Right Success{}) -> Nothing+       -- 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+         [] -> Nothing+         leftover -> Just $ TestBranch theLabel leftover+        ---------- Handy @@ -128,24 +201,14 @@ --   >     it "doubles with 2" $ --   >        replicate 2 'x' === "xx" --   >     it "creates a list of the right size" $---   >        \(Positive n) -> length (replicate n 'x') == n+--   >        \(Positive n) -> length (replicate n 'x') === n it :: MTestable t => String -> t -> Microspec () it = describe --- | Make a test case from a QuickCheck function. Alias for 'Test.QuickCheck.property'.--- ---   Note that you don't need to use this to create a test, e.g.:--- ---   > describe "reverse preserves length" $---   >    \l -> length (reverse l) == length l-prop :: Testable prop => prop -> Property-prop = property -- ---------- Constructing a test tree: -addTestTree :: TestTree -> Microspec ()+addTestTree :: TestTree Property -> Microspec () addTestTree tree = Microspec [tree] ()  -- | Something which can be tested@@ -185,33 +248,48 @@    --   >    reverse "foo" === "oof"    describe :: String -> t -> Microspec () instance MTestable Property where-   describe testLabel aProp = addTestTree $ TestLeaf testLabel (Right aProp)+   describe testLabel aProp =+      addTestTree $ TestLeaf testLabel (Right aProp) instance MTestable Bool where-   describe testLabel bool = describe testLabel $ property bool-instance MTestable TestTree where-   describe testLabel x = addTestTree $ TestBranch testLabel [x]+   describe testLabel bool =+      describe testLabel $ property bool+instance MTestable (TestTree Property) where+   describe testLabel x =+      addTestTree $ TestBranch testLabel [x] instance MTestable Pending where-   describe testLabel pend = addTestTree $ TestLeaf testLabel (Left pend)+   describe testLabel pend =+      addTestTree $ TestLeaf testLabel (Left pend) instance MTestable (Microspec ()) where    describe testLabel x =       let forest = buildTestTrees x       in addTestTree $ TestBranch testLabel forest instance (Arbitrary a, Show a, Testable prop) => MTestable (a -> prop) where-   describe testLabel f = describe testLabel $ property f+   describe testLabel f =+      describe testLabel $ property f -data TestTree-   = TestBranch String [TestTree]-   | TestLeaf String (Either Pending Property)+-- 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 -instance Show TestTree where+instance Show (TestTree x) where  show = \case-   TestBranch testLabel subs -> "Branch "++show testLabel++" "++show subs-   TestLeaf testLabel _ -> "Leaf " ++ show testLabel---- Basically a writer monad:---- | A series of tests, to run with 'microspec'-data Microspec a = Microspec [TestTree] a+   TestBranch testLabel subs ->+      "Branch "++show testLabel++" "++show subs+   TestLeaf testLabel _ ->+      "Leaf " ++ show testLabel  instance Functor Microspec where    fmap f (Microspec forest a) = Microspec forest (f a)@@ -228,7 +306,7 @@           Microspec forest1 b = f a       in Microspec (forest0 ++ forest1) b -buildTestTrees :: Microspec () -> [TestTree]+buildTestTrees :: Microspec () -> [TestTree Property] buildTestTrees (Microspec x _) = x  @@ -259,8 +337,9 @@ ---------- Pretty-printing:  inRed, inGreen, inYellow :: String -> String-[inRed,inGreen, inYellow] = (`map` [31,32,33]) $ \colorNum ->-   \s -> "\ESC["++show (colorNum::Int)++"m"++s++"\ESC[m"+[inRed,inGreen, inYellow] =+   (`map` [31,32,33]) $ \colorNum ->+      \s -> "\ESC["++show (colorNum::Int)++"m"++s++"\ESC[m"   @@ -270,3 +349,9 @@ shouldBe :: (Eq x, Show x) => x -> x -> Property shouldBe = (===) +-- | Note that you don't need to use this to create a test, e.g.:+-- +--   > describe "reverse preserves length" $+--   >    \l -> length (reverse l) === length l+prop :: MTestable prop => String -> prop -> Microspec ()+prop = describe

@@ -1,5 +1,5 @@ name:                microspec-version:             0.1.0.0+version:             0.2.0.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.@@ -15,17 +15,17 @@   > main = microspec $ do   >    describe "replicate" $ do   >       it "doubles with 2" $-  >          replicate 2 'x' == "xx"+  >          replicate 2 'x' === "xx"   >       it "creates a list of the right size" $-  >          \(Positive n) -> length (replicate n 'x') == n+  >          \(Positive n) -> length (replicate n 'x') === n   >    >    describe "reverse" $ do-  >       it "reverse . reverse == id" $ \l ->-  >          reverse (reverse l) == (l :: [Int])+  >       it "reverse . reverse === id" $ \l ->+  >          reverse (reverse l) === (l :: [Int])   >    >    describe "tail" $   >       it "length is -1" $ \(NonEmpty l) ->-  >          length (tail l :: [Int]) == length l - 1+  >          length (tail l :: [Int]) === length l - 1   >    >    describe "solve the halting problem" $   >       pending