microspec-0.2.1.3/0000755000000000000000000000000013371635512012033 5ustar0000000000000000microspec-0.2.1.3/microspec.cabal0000644000000000000000000000323613371635512015007 0ustar0000000000000000name: microspec version: 0.2.1.3 synopsis: Tiny QuickCheck test library with minimal dependencies description: A tiny (1 module, <500 lines) property-based (and unit) testing library with minimal dependencies. . Instead of reinventing the wheel (), we use a RSpec/HSpec-like DSL and run tests with QuickCheck. . For many use-cases, microspec is a drop-in replacement for hspec. . > import Test.Microspec > > main :: IO () > main = microspec $ do > describe "replicate" $ do > it "doubles with 2" $ > replicate 2 'x' === "xx" > it "creates a list of the right size" $ > \(Positive n) -> length (replicate n 'x') === n > > describe "reverse" $ do > 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 > > describe "solve the halting problem" $ > pending license: BSD3 license-file: LICENSE author: Tom Murphy maintainer: Tom Murphy -- copyright: category: Test, Testing build-type: Simple cabal-version: >=1.10 stability: experimental library exposed-modules: Test.Microspec -- other-modules: other-extensions: FlexibleInstances , LambdaCase build-depends: -- PVP compat: -- base >=4.9 && <5 -- , QuickCheck >=2.9 && <2.10 base <5 , time , QuickCheck -- hs-source-dirs: default-language: Haskell2010 microspec-0.2.1.3/Setup.hs0000644000000000000000000000005613371635512013470 0ustar0000000000000000import Distribution.Simple main = defaultMain microspec-0.2.1.3/LICENSE0000644000000000000000000000275613371635512013052 0ustar0000000000000000Copyright (c) 2016, Tom Murphy All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Tom Murphy nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. microspec-0.2.1.3/Test/0000755000000000000000000000000013371635512012752 5ustar0000000000000000microspec-0.2.1.3/Test/Microspec.hs0000644000000000000000000002777613371635512015255 0ustar0000000000000000-- | Tests can be structured as nested 'it' / 'describe' statements -- -- E.g. -- -- > microspec $ do -- > describe "plus" $ do -- > it "adds positive numbers" $ do -- > it "does 1 + 1" $ -- > 1 + 1 === 2 -- > it "does 2 + 2" $ -- > 2 + 2 === 4 -- > it "is commutative" $ -- > \x y -> x + y === y + (x :: Int) -- -- ...which will return, nicely in green instead of bold: -- -- @ -- plus -- adds positive numbers -- __does 1 + 1__ -- __does 2 + 2__ -- __is commutative__ -- -- ----- -- Runtime: 0.00943336s -- __Successes: 3, Pending: 0, Failures: 0__ -- @ {-# LANGUAGE FlexibleInstances , LambdaCase #-} module Test.Microspec ( -- * Specification microspec , microspecWith , describe , it , pending , prop , Microspec , MTestable -- * Configuration , MArgs(..) , defaultMArgs -- * Compatibility , shouldBe , shouldSatisfy -- Reexports , module Test.QuickCheck , module Test.QuickCheck.Modifiers , module Test.QuickCheck.Monadic -- , module Test.QuickCheck.Property ) where -- For older GHCs (7.8 and below). -- When we stop supporting them, remove: import Control.Applicative (Applicative(..)) import Control.Monad import Data.Char (isSpace) import Data.List (foldl') import Data.Maybe (mapMaybe) import Data.Time (getCurrentTime, diffUTCTime) import System.Exit (exitWith, ExitCode(ExitFailure)) -- import Data.Time (getCurrentTime, diffUTCTime) import Test.QuickCheck as QC import Test.QuickCheck import Test.QuickCheck.Modifiers 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 microspec :: Microspec () -> IO () microspec = microspecWith defaultMArgs -- | 'microspec' with 'MArgs' microspecWith :: MArgs -> Microspec () -> IO () microspecWith args (Microspec specs ()) = do putStrLn "" startTime <- getCurrentTime results <- forM specs $ \test -> do runTestWith args 0 test let resultCount :: ResultCounts resultCount = joinResultList {- mconcat -} $ map countResults results endTime <- getCurrentTime when ((numPending resultCount + numFailures resultCount) /= 0) $ putStrLn "\n ----- Failures and pending:\n" forM_ (pruneOutSuccesses results) $ \x -> do printAllTestResults 0 x putStrLn "" putStrLn $ "\n -----\nRuntime: " ++ show (diffUTCTime endTime startTime) let colorF :: String -> String colorF = case resultCount of ResultCounts { numPending = 0, numFailures = 0 } -> inGreen ResultCounts { numFailures = 0 } -> inYellow _ -> inRed putStrLn $ colorF $ "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 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 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 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) ++ " - " ++ inYellow "PENDING" TestBranch testLabel _ -> do putStrLn $ labelStr testLabel where indentationFor :: Int -> String indentationFor n = replicate (n*2) ' ' -- ++ "- " showResult :: String -> QC.Result -> String showResult testLabel = \case -- note: if we wanted to show quickcheck labels, this is where we would: Success {} -> inGreen testLabel failure@(Failure{theException=Nothing}) -> inRed testLabel ++ " - "++inRed (replaceNewline (output failure)) failure {- @(Failure{}) -} -> inRed testLabel ++" - "++inRed (replaceNewline (output failure)) replaceNewline :: String -> String replaceNewline = concatMap $ \case '\n' -> " | " ; x -> [x] labelStr :: String -> String labelStr s = case filter (not . isSpace) s of "" -> "(untitled)" _ -> s -- 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 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 pruneOutSuccesses xs of [] -> Nothing leftover -> Just $ TestBranch theLabel leftover ---------- Handy -- | An alias for 'describe'. Usually used inside a 'describe' block: -- -- > describe "replicate" $ do -- > it "doubles with 2" $ -- > replicate 2 'x' === "xx" -- > it "creates a list of the right size" $ -- > \(Positive n) -> length (replicate n 'x') === n it :: MTestable t => String -> t -> Microspec () it = describe ---------- Constructing a test tree: -- | Something which can be tested -- -- Note both Bools and Properties can be tested, but only Properties show -- the values that weren't equal -- -- For both unit tests and property tests, if you want to see the outputs -- of failed tests use 'Test.QuickCheck.==='. If you just want to test for -- equality, use 'Prelude.=='. -- -- For example, the outputs of running: -- -- @ -- microspec $ do -- describe "baddies" $ do -- it "isn't 1 ==" $ 0 == (1 :: Int) -- it "isn't 1 ===" $ 0 === (1 :: Int) -- it "isn't always 1 ==" $ \x -> x == (1 :: Int) -- it "isn't always 1 ===" $ \x -> x === (1 :: Int) -- @ -- -- are: -- -- @ -- isn't 1 == - *** Failed! Falsifiable (after 1 test) -- isn't 1 === - *** Failed! Falsifiable (after 1 test): | 0 /= 1 -- isn't always 1 == - *** Failed! Falsifiable (after 1 test): | 0 -- isn't always 1 === - *** Failed! Falsifiable (after 1 test): | 0 | 0 /= 1 -- @ class MTestable t where -- | Describe a test, e.g.: -- -- > describe "reverse 'foo' is 'oof'" $ -- > reverse "foo" === "oof" describe :: String -> t -> Microspec () instance MTestable Property where describe testLabel aProp = Microspec [TestLeaf testLabel (Right aProp)] () instance MTestable Bool where describe testLabel bool = describe testLabel $ QC.property bool instance MTestable (TestTree Property) where describe testLabel x = Microspec [TestBranch testLabel [x]] () instance MTestable Pending where describe testLabel pend = Microspec [TestLeaf testLabel (Left pend)] () instance MTestable (Microspec ()) where describe testLabel (Microspec forest ()) = Microspec [TestBranch testLabel forest] () instance (Arbitrary a, Show a, Testable prop) => MTestable (a -> prop) where describe testLabel f = describe testLabel $ QC.property f data ResultCounts = ResultCounts { numSuccesses :: Int , numFailures :: Int , numPending :: Int } deriving (Show) -- For later, when we don't need to import 'semigroup' for older packages: {- -- This might not be the most efficient, but a quick idea: instance Monoid ResultCounts where -} -- "mempty": emptyResults :: ResultCounts emptyResults = ResultCounts 0 0 0 -- "mappend": joinResults :: ResultCounts -> ResultCounts -> ResultCounts (ResultCounts a0 b0 c0) `joinResults` (ResultCounts a1 b1 c1) = ResultCounts (a0+a1) (b0+b1) (c0+c1) -- This is obv mconcat: joinResultList :: [ResultCounts] -> ResultCounts joinResultList = foldl' joinResults (ResultCounts 0 0 0) countResults :: TestTree QC.Result -> ResultCounts countResults = \case TestLeaf _ (Right Success{}) -> emptyResults {- mempty -} { numSuccesses = 1 } TestLeaf _ (Right _) -> emptyResults {- mempty -} { numFailures = 1 } TestLeaf _ (Left Pending) -> emptyResults {- mempty -} { numPending = 1 } TestBranch _ ts -> joinResultList {- mconcat -} $ map countResults ts instance Show (TestTree x) where show = \case 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) instance Applicative Microspec where pure a = Microspec [] a f <*> a = let Microspec forest0 f' = f Microspec forest1 a' = a in Microspec (forest0 ++ forest1) (f' a') instance Monad Microspec where return = pure ma >>= f = let Microspec forest0 a = ma Microspec forest1 b = f a in Microspec (forest0 ++ forest1) b ---------- Configuration: -- | Default arguments. Calling \"microspec\" is the same as calling -- \"microspecWith defaultMArgs\". defaultMArgs :: MArgs defaultMArgs = MArgs { _mArgs_timeoutSecs = Nothing -- Just 60 ,_mArgs_qcArgs = QC.stdArgs { chatty = False } } -- | Tweak how tests are run, with 'microspecWith'. data MArgs = MArgs { _mArgs_timeoutSecs :: Maybe Double -- ^ Number of seconds before each -- test times out. If you want to -- do this on a per-test basis, try -- 'Test.QuickCheck.Property.within' ,_mArgs_qcArgs :: QC.Args -- ^ Arguments to use with QuickCheck tests } deriving (Show, Read) -- , Eq, Ord) ---------- Pretty-printing: inRed, inGreen, inYellow :: String -> String [inRed,inGreen, inYellow] = (`map` [31,32,33]) $ \colorNum -> \s -> "\ESC["++show (colorNum::Int)++"m"++s++"\ESC[m" ---------- HSpec compatibility -- | 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.: -- -- > describe "reverse preserves length" $ -- > \l -> length (reverse l) === length l prop :: MTestable prop => String -> prop -> Microspec () prop = describe