-- | 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
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 :: Microspec () -> IO ()
microspec = MArgs -> Microspec () -> IO ()
microspecWith MArgs
defaultMArgs

-- | 'microspec' with 'MArgs'
microspecWith :: MArgs -> Microspec () -> IO ()
microspecWith :: MArgs -> Microspec () -> IO ()
microspecWith MArgs
args (Microspec [TestTree Property]
specs ()) = do
   String -> IO ()
putStrLn String
""
   UTCTime
startTime <- IO UTCTime
getCurrentTime

   [TestTree Result]
results <- [TestTree Property]
-> (TestTree Property -> IO (TestTree Result))
-> IO [TestTree Result]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TestTree Property]
specs ((TestTree Property -> IO (TestTree Result))
 -> IO [TestTree Result])
-> (TestTree Property -> IO (TestTree Result))
-> IO [TestTree Result]
forall a b. (a -> b) -> a -> b
$ \TestTree Property
test -> do
      MArgs -> Int -> TestTree Property -> IO (TestTree Result)
runTestWith MArgs
args Int
0 TestTree Property
test

   let resultCount :: ResultCounts
       resultCount :: ResultCounts
resultCount = [ResultCounts] -> ResultCounts
joinResultList {- mconcat -} ([ResultCounts] -> ResultCounts) -> [ResultCounts] -> ResultCounts
forall a b. (a -> b) -> a -> b
$ (TestTree Result -> ResultCounts)
-> [TestTree Result] -> [ResultCounts]
forall a b. (a -> b) -> [a] -> [b]
map TestTree Result -> ResultCounts
countResults [TestTree Result]
results
   UTCTime
endTime <- IO UTCTime
getCurrentTime
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((ResultCounts -> Int
numPending ResultCounts
resultCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ResultCounts -> Int
numFailures ResultCounts
resultCount) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> IO ()
putStrLn String
"\n  ----- Failures and pending:\n"

   [TestTree Result] -> (TestTree Result -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([TestTree Result] -> [TestTree Result]
pruneOutSuccesses [TestTree Result]
results) ((TestTree Result -> IO ()) -> IO ())
-> (TestTree Result -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TestTree Result
x -> do
      Int -> TestTree Result -> IO ()
printAllTestResults Int
0 TestTree Result
x
      String -> IO ()
putStrLn String
""

   String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\n  -----\nRuntime: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NominalDiffTime -> String
forall a. Show a => a -> String
show (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
endTime UTCTime
startTime)
   let colorF :: String -> String
       colorF :: String -> String
colorF = case ResultCounts
resultCount of
          ResultCounts { numPending :: ResultCounts -> Int
numPending = Int
0, numFailures :: ResultCounts -> Int
numFailures = Int
0 } -> String -> String
inGreen
          ResultCounts { numFailures :: ResultCounts -> Int
numFailures = Int
0 } -> String -> String
inYellow
          ResultCounts
_ -> String -> String
inRed
   String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
colorF (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
         String
"Successes: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (ResultCounts -> Int
numSuccesses ResultCounts
resultCount)
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", Pending: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (ResultCounts -> Int
numPending ResultCounts
resultCount)
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", Failures: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (ResultCounts -> Int
numFailures ResultCounts
resultCount)
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ResultCounts -> Int
numFailures ResultCounts
resultCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
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 :: MArgs -> Int -> TestTree Property -> IO (TestTree Result)
runTestWith MArgs
args Int
depth = \case
   TestLeaf String
testLabel (Right Property
aProp) -> do
      let timeoutMaybe :: Property -> Property
timeoutMaybe = case MArgs -> Maybe Double
_mArgs_timeoutSecs MArgs
args of
           Maybe Double
Nothing -> Property -> Property
forall a. a -> a
id
           Just Double
numSecs -> Int -> Property -> Property
forall prop. Testable prop => Int -> prop -> Property
within (Int -> Property -> Property) -> Int -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a. Enum a => a -> Int
fromEnum (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
numSecs Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
10Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6::Int))
      Result
result <- Args -> Property -> IO Result
forall prop. Testable prop => Args -> prop -> IO Result
quickCheckWithResult (MArgs -> Args
_mArgs_qcArgs MArgs
args) (Property -> IO Result) -> Property -> IO Result
forall a b. (a -> b) -> a -> b
$ Property -> Property
timeoutMaybe Property
aProp
      let r :: TestTree Result
r = String -> Either Pending Result -> TestTree Result
forall x. String -> Either Pending x -> TestTree x
TestLeaf String
testLabel (Result -> Either Pending Result
forall a b. b -> Either a b
Right Result
result)
      Int -> TestTree Result -> IO ()
printSingleTestResult Int
depth TestTree Result
r
      TestTree Result -> IO (TestTree Result)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestTree Result
r
   TestLeaf String
testLabel (Left Pending
Pending) -> do
      let r :: TestTree x
r = String -> Either Pending x -> TestTree x
forall x. String -> Either Pending x -> TestTree x
TestLeaf String
testLabel (Pending -> Either Pending x
forall a b. a -> Either a b
Left Pending
Pending)
      Int -> TestTree Result -> IO ()
printSingleTestResult Int
depth TestTree Result
forall {x}. TestTree x
r
      TestTree Result -> IO (TestTree Result)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestTree Result
forall {x}. TestTree x
r
   TestBranch String
testLabel [TestTree Property]
forest -> do
      Int -> TestTree Result -> IO ()
printSingleTestResult Int
depth (TestTree Result -> IO ()) -> TestTree Result -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [TestTree Result] -> TestTree Result
forall x. String -> [TestTree x] -> TestTree x
TestBranch String
testLabel [] -- Kinda kludge
      [TestTree Result]
results <- [TestTree Property]
-> (TestTree Property -> IO (TestTree Result))
-> IO [TestTree Result]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TestTree Property]
forest ((TestTree Property -> IO (TestTree Result))
 -> IO [TestTree Result])
-> (TestTree Property -> IO (TestTree Result))
-> IO [TestTree Result]
forall a b. (a -> b) -> a -> b
$ MArgs -> Int -> TestTree Property -> IO (TestTree Result)
runTestWith MArgs
args (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      TestTree Result -> IO (TestTree Result)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestTree Result -> IO (TestTree Result))
-> TestTree Result -> IO (TestTree Result)
forall a b. (a -> b) -> a -> b
$ String -> [TestTree Result] -> TestTree Result
forall x. String -> [TestTree x] -> TestTree x
TestBranch String
testLabel [TestTree Result]
results

printAllTestResults :: Int -> TestTree QC.Result -> IO ()
printAllTestResults :: Int -> TestTree Result -> IO ()
printAllTestResults Int
depth = \case
   b :: TestTree Result
b@(TestBranch String
_ [TestTree Result]
forest) -> do
      Int -> TestTree Result -> IO ()
printSingleTestResult Int
depth TestTree Result
b
      (TestTree Result -> IO ()) -> [TestTree Result] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int -> TestTree Result -> IO ()
printAllTestResults (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [TestTree Result]
forest
   l :: TestTree Result
l@(TestLeaf{}) -> Int -> TestTree Result -> IO ()
printSingleTestResult Int
depth TestTree Result
l

printSingleTestResult :: Int -> TestTree QC.Result -> IO ()
printSingleTestResult :: Int -> TestTree Result -> IO ()
printSingleTestResult Int
depth TestTree Result
resultTree = do
   String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> String
indentationFor Int
depth
   case TestTree Result
resultTree of
      TestLeaf String
testLabel (Right Result
result) -> do
         String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Result -> String
showResult (String -> String
labelStr String
testLabel) Result
result
      TestLeaf String
testLabel (Left Pending
Pending) -> do
         String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
inYellow (String -> String
labelStr String
testLabel) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
inYellow String
"PENDING"
      TestBranch String
testLabel [TestTree Result]
_ -> do
         String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
labelStr String
testLabel
 where
   indentationFor :: Int -> String
   indentationFor :: Int -> String
indentationFor Int
n = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) Char
' ' -- ++ "- "

   showResult :: String -> QC.Result -> String
   showResult :: String -> Result -> String
showResult String
testLabel = \case
       -- note: if we wanted to show quickcheck labels, this is where we would:
      Success {} ->
         String -> String
inGreen String
testLabel
      failure :: Result
failure@(Failure{theException :: Result -> Maybe AnException
theException=Maybe AnException
Nothing}) ->
         String -> String
inRed String
testLabel String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" - "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
inRed (String -> String
replaceNewline (Result -> String
output Result
failure))
      Result
failure {- @(Failure{}) -} ->
         String -> String
inRed String
testLabel String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" - "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
inRed (String -> String
replaceNewline (Result -> String
output Result
failure))
   replaceNewline :: String -> String
   replaceNewline :: String -> String
replaceNewline = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char -> String) -> String -> String)
-> (Char -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ \case Char
'\n' -> String
" | " ; Char
x -> [Char
x]
   labelStr :: String -> String
   labelStr :: String -> String
labelStr String
s = case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) String
s of
      String
"" -> String
"(untitled)"
      String
_ -> String
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 :: [TestTree Result] -> [TestTree Result]
pruneOutSuccesses [TestTree Result]
l = (TestTree Result -> Maybe (TestTree Result))
-> [TestTree Result] -> [TestTree Result]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TestTree Result -> Maybe (TestTree Result)
f [TestTree Result]
l
 where
   f :: TestTree QC.Result -> Maybe (TestTree QC.Result)
   f :: TestTree Result -> Maybe (TestTree Result)
f = \case
      TestLeaf String
_ (Right Success{}) -> Maybe (TestTree Result)
forall a. Maybe a
Nothing
       -- TODO: might want to explicitly pattern-match here:
      x :: TestTree Result
x@(TestLeaf String
_ (Right Result
_)) -> TestTree Result -> Maybe (TestTree Result)
forall a. a -> Maybe a
Just TestTree Result
x
      x :: TestTree Result
x@(TestLeaf String
_ (Left Pending
Pending)) -> TestTree Result -> Maybe (TestTree Result)
forall a. a -> Maybe a
Just TestTree Result
x
      TestBranch String
theLabel [TestTree Result]
xs -> case [TestTree Result] -> [TestTree Result]
pruneOutSuccesses [TestTree Result]
xs of
         [] -> Maybe (TestTree Result)
forall a. Maybe a
Nothing
         [TestTree Result]
leftover -> TestTree Result -> Maybe (TestTree Result)
forall a. a -> Maybe a
Just (TestTree Result -> Maybe (TestTree Result))
-> TestTree Result -> Maybe (TestTree Result)
forall a b. (a -> b) -> a -> b
$ String -> [TestTree Result] -> TestTree Result
forall x. String -> [TestTree x] -> TestTree x
TestBranch String
theLabel [TestTree Result]
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 :: forall t. MTestable t => String -> t -> Microspec ()
it = String -> t -> Microspec ()
forall t. MTestable t => String -> t -> Microspec ()
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 :: String -> Property -> Microspec ()
describe String
testLabel Property
aProp =
      [TestTree Property] -> () -> Microspec ()
forall a. [TestTree Property] -> a -> Microspec a
Microspec [String -> Either Pending Property -> TestTree Property
forall x. String -> Either Pending x -> TestTree x
TestLeaf String
testLabel (Property -> Either Pending Property
forall a b. b -> Either a b
Right Property
aProp)] ()
instance MTestable Bool where
   describe :: String -> Bool -> Microspec ()
describe String
testLabel Bool
bool =
      String -> Property -> Microspec ()
forall t. MTestable t => String -> t -> Microspec ()
describe String
testLabel (Property -> Microspec ()) -> Property -> Microspec ()
forall a b. (a -> b) -> a -> b
$ Bool -> Property
forall prop. Testable prop => prop -> Property
QC.property Bool
bool
instance MTestable (TestTree Property) where
   describe :: String -> TestTree Property -> Microspec ()
describe String
testLabel TestTree Property
x =
      [TestTree Property] -> () -> Microspec ()
forall a. [TestTree Property] -> a -> Microspec a
Microspec [String -> [TestTree Property] -> TestTree Property
forall x. String -> [TestTree x] -> TestTree x
TestBranch String
testLabel [TestTree Property
x]] ()
instance MTestable Pending where
   describe :: String -> Pending -> Microspec ()
describe String
testLabel Pending
pend =
      [TestTree Property] -> () -> Microspec ()
forall a. [TestTree Property] -> a -> Microspec a
Microspec [String -> Either Pending Property -> TestTree Property
forall x. String -> Either Pending x -> TestTree x
TestLeaf String
testLabel (Pending -> Either Pending Property
forall a b. a -> Either a b
Left Pending
pend)] ()
instance MTestable (Microspec ()) where
   describe :: String -> Microspec () -> Microspec ()
describe String
testLabel (Microspec [TestTree Property]
forest ()) =
      [TestTree Property] -> () -> Microspec ()
forall a. [TestTree Property] -> a -> Microspec a
Microspec [String -> [TestTree Property] -> TestTree Property
forall x. String -> [TestTree x] -> TestTree x
TestBranch String
testLabel [TestTree Property]
forest] ()
instance (Arbitrary a, Show a, Testable prop) => MTestable (a -> prop) where
   describe :: String -> (a -> prop) -> Microspec ()
describe String
testLabel a -> prop
f =
      String -> Property -> Microspec ()
forall t. MTestable t => String -> t -> Microspec ()
describe String
testLabel (Property -> Microspec ()) -> Property -> Microspec ()
forall a b. (a -> b) -> a -> b
$ (a -> prop) -> Property
forall prop. Testable prop => prop -> Property
QC.property a -> prop
f

data ResultCounts
   = ResultCounts {
     ResultCounts -> Int
numSuccesses :: Int
   , ResultCounts -> Int
numFailures :: Int
   , ResultCounts -> Int
numPending :: Int
   } deriving (Int -> ResultCounts -> String -> String
[ResultCounts] -> String -> String
ResultCounts -> String
(Int -> ResultCounts -> String -> String)
-> (ResultCounts -> String)
-> ([ResultCounts] -> String -> String)
-> Show ResultCounts
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ResultCounts] -> String -> String
$cshowList :: [ResultCounts] -> String -> String
show :: ResultCounts -> String
$cshow :: ResultCounts -> String
showsPrec :: Int -> ResultCounts -> String -> String
$cshowsPrec :: Int -> ResultCounts -> String -> String
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
emptyResults =
   Int -> Int -> Int -> ResultCounts
ResultCounts Int
0 Int
0 Int
0

-- "mappend":
joinResults :: ResultCounts -> ResultCounts -> ResultCounts
(ResultCounts Int
a0 Int
b0 Int
c0) joinResults :: ResultCounts -> ResultCounts -> ResultCounts
`joinResults` (ResultCounts Int
a1 Int
b1 Int
c1) =
   Int -> Int -> Int -> ResultCounts
ResultCounts (Int
a0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
a1) (Int
b0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b1) (Int
c0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
c1)


-- This is obv mconcat:
joinResultList :: [ResultCounts] -> ResultCounts
joinResultList :: [ResultCounts] -> ResultCounts
joinResultList = (ResultCounts -> ResultCounts -> ResultCounts)
-> ResultCounts -> [ResultCounts] -> ResultCounts
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ResultCounts -> ResultCounts -> ResultCounts
joinResults (Int -> Int -> Int -> ResultCounts
ResultCounts Int
0 Int
0 Int
0)

countResults :: TestTree QC.Result -> ResultCounts
countResults :: TestTree Result -> ResultCounts
countResults = \case
   TestLeaf String
_ (Right Success{}) ->
      ResultCounts
emptyResults {- mempty -} { numSuccesses :: Int
numSuccesses = Int
1 }
   TestLeaf String
_ (Right Result
_) ->
      ResultCounts
emptyResults {- mempty -} { numFailures :: Int
numFailures = Int
1 }
   TestLeaf String
_ (Left Pending
Pending) ->
      ResultCounts
emptyResults {- mempty -} { numPending :: Int
numPending = Int
1 }
   TestBranch String
_ [TestTree Result]
ts ->
      [ResultCounts] -> ResultCounts
joinResultList {- mconcat -} ([ResultCounts] -> ResultCounts) -> [ResultCounts] -> ResultCounts
forall a b. (a -> b) -> a -> b
$ (TestTree Result -> ResultCounts)
-> [TestTree Result] -> [ResultCounts]
forall a b. (a -> b) -> [a] -> [b]
map TestTree Result -> ResultCounts
countResults [TestTree Result]
ts

instance Show (TestTree x) where
 show :: TestTree x -> String
show = \case
   TestBranch String
testLabel [TestTree x]
subs ->
      String
"Branch "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
show String
testLabelString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++[TestTree x] -> String
forall a. Show a => a -> String
show [TestTree x]
subs
   TestLeaf String
testLabel Either Pending x
_ ->
      String
"Leaf " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
testLabel

instance Functor Microspec where
   fmap :: forall a b. (a -> b) -> Microspec a -> Microspec b
fmap a -> b
f (Microspec [TestTree Property]
forest a
a) =
      [TestTree Property] -> b -> Microspec b
forall a. [TestTree Property] -> a -> Microspec a
Microspec [TestTree Property]
forest (a -> b
f a
a)
instance Applicative Microspec where
   pure :: forall a. a -> Microspec a
pure a
a = [TestTree Property] -> a -> Microspec a
forall a. [TestTree Property] -> a -> Microspec a
Microspec [] a
a
   Microspec (a -> b)
f <*> :: forall a b. Microspec (a -> b) -> Microspec a -> Microspec b
<*> Microspec a
a =
      let Microspec [TestTree Property]
forest0 a -> b
f' = Microspec (a -> b)
f
          Microspec [TestTree Property]
forest1 a
a' = Microspec a
a
      in [TestTree Property] -> b -> Microspec b
forall a. [TestTree Property] -> a -> Microspec a
Microspec ([TestTree Property]
forest0 [TestTree Property] -> [TestTree Property] -> [TestTree Property]
forall a. [a] -> [a] -> [a]
++ [TestTree Property]
forest1) (a -> b
f' a
a')
instance Monad Microspec where
   return :: forall a. a -> Microspec a
return = a -> Microspec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
   Microspec a
ma >>= :: forall a b. Microspec a -> (a -> Microspec b) -> Microspec b
>>= a -> Microspec b
f =
      let Microspec [TestTree Property]
forest0 a
a = Microspec a
ma
          Microspec [TestTree Property]
forest1 b
b = a -> Microspec b
f a
a
      in [TestTree Property] -> b -> Microspec b
forall a. [TestTree Property] -> a -> Microspec a
Microspec ([TestTree Property]
forest0 [TestTree Property] -> [TestTree Property] -> [TestTree Property]
forall a. [a] -> [a] -> [a]
++ [TestTree Property]
forest1) b
b



---------- Configuration:

-- | Default arguments. Calling \"microspec\" is the same as calling
--   \"microspecWith defaultMArgs\".
defaultMArgs :: MArgs
defaultMArgs :: MArgs
defaultMArgs = MArgs :: Maybe Double -> Args -> MArgs
MArgs {
    _mArgs_timeoutSecs :: Maybe Double
_mArgs_timeoutSecs = Maybe Double
forall a. Maybe a
Nothing -- Just 60
   ,_mArgs_qcArgs :: Args
_mArgs_qcArgs = Args
QC.stdArgs { chatty :: Bool
chatty = Bool
False }
   }

-- | Tweak how tests are run, with 'microspecWith'.
data MArgs = MArgs {
    MArgs -> Maybe Double
_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 -> Args
_mArgs_qcArgs :: QC.Args -- ^ Arguments to use with QuickCheck tests
   }
 deriving (Int -> MArgs -> String -> String
[MArgs] -> String -> String
MArgs -> String
(Int -> MArgs -> String -> String)
-> (MArgs -> String) -> ([MArgs] -> String -> String) -> Show MArgs
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [MArgs] -> String -> String
$cshowList :: [MArgs] -> String -> String
show :: MArgs -> String
$cshow :: MArgs -> String
showsPrec :: Int -> MArgs -> String -> String
$cshowsPrec :: Int -> MArgs -> String -> String
Show, ReadPrec [MArgs]
ReadPrec MArgs
Int -> ReadS MArgs
ReadS [MArgs]
(Int -> ReadS MArgs)
-> ReadS [MArgs]
-> ReadPrec MArgs
-> ReadPrec [MArgs]
-> Read MArgs
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MArgs]
$creadListPrec :: ReadPrec [MArgs]
readPrec :: ReadPrec MArgs
$creadPrec :: ReadPrec MArgs
readList :: ReadS [MArgs]
$creadList :: ReadS [MArgs]
readsPrec :: Int -> ReadS MArgs
$creadsPrec :: Int -> ReadS MArgs
Read) -- , Eq, Ord)



---------- Pretty-printing:

inRed, inGreen, inYellow :: String -> String
[String -> String
inRed,String -> String
inGreen, String -> String
inYellow] =
   ((Int -> String -> String) -> [Int] -> [String -> String]
forall a b. (a -> b) -> [a] -> [b]
`map` [Int
31,Int
32,Int
33]) ((Int -> String -> String) -> [String -> String])
-> (Int -> String -> String) -> [String -> String]
forall a b. (a -> b) -> a -> b
$ \Int
colorNum ->
      \String
s -> String
"\ESC["String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show (Int
colorNum::Int)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"m"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\ESC[m"



---------- HSpec compatibility

-- | Hspec compatibility. Equivalent to using 'Test.QuickCheck.==='
shouldBe :: (Eq x, Show x) => x -> x -> Property
shouldBe :: forall x. (Eq x, Show x) => x -> x -> Property
shouldBe = x -> x -> Property
forall x. (Eq x, Show x) => x -> x -> Property
(===)

-- | @since 0.2.1.0
shouldSatisfy :: Show x => x -> (x -> Bool) -> Property
shouldSatisfy :: forall x. Show x => x -> (x -> Bool) -> Property
shouldSatisfy x
x x -> Bool
predicate =
   String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Predicate failed on: "String -> String -> String
forall a. [a] -> [a] -> [a]
++x -> String
forall a. Show a => a -> String
show x
x) (x -> Bool
predicate x
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 :: forall t. MTestable t => String -> t -> Microspec ()
prop = String -> prop -> Microspec ()
forall t. MTestable t => String -> t -> Microspec ()
describe