{-# LANGUAGE
FlexibleInstances
, LambdaCase
#-}
module Test.Microspec (
microspec
, microspecWith
, describe
, it
, pending
, prop
, Microspec
, MTestable
, MArgs(..)
, defaultMArgs
, shouldBe
, shouldSatisfy
, module Test.QuickCheck
, module Test.QuickCheck.Modifiers
, module Test.QuickCheck.Monadic
) where
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 Test.QuickCheck as QC
import Test.QuickCheck
import Test.QuickCheck.Modifiers
import Test.QuickCheck.Monadic
data Microspec a = Microspec [TestTree Property] a
data TestTree x
= TestBranch String [TestTree x]
| TestLeaf String (Either Pending x)
data Pending = Pending
pending :: Pending
pending :: Pending
pending = Pending
Pending
microspec :: Microspec () -> IO ()
microspec :: Microspec () -> IO ()
microspec = MArgs -> Microspec () -> IO ()
microspecWith MArgs
defaultMArgs
microspecWith :: MArgs -> Microspec () -> IO ()
microspecWith :: MArgs -> Microspec () -> IO ()
microspecWith args :: MArgs
args (Microspec specs :: [TestTree Property]
specs ()) = do
String -> IO ()
putStrLn ""
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
$ \test :: TestTree Property
test -> do
MArgs -> Int -> TestTree Property -> IO (TestTree Result)
runTestWith MArgs
args 0 TestTree Property
test
let resultCount :: ResultCounts
resultCount :: ResultCounts
resultCount = [ResultCounts] -> ResultCounts
joinResultList ([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
/= 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn "\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
$ \x :: TestTree Result
x -> do
Int -> TestTree Result -> IO ()
printAllTestResults 0 TestTree Result
x
String -> IO ()
putStrLn ""
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "\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
_ -> 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
$
"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]
++ ", 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]
++ ", 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
/= 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 1
runTestWith :: MArgs -> Int -> TestTree Property -> IO (TestTree QC.Result)
runTestWith :: MArgs -> Int -> TestTree Property -> IO (TestTree Result)
runTestWith args :: MArgs
args depth :: Int
depth = \case
TestLeaf testLabel :: String
testLabel (Right aProp :: Property
aProp) -> do
let timeoutMaybe :: Property -> Property
timeoutMaybe = case MArgs -> Maybe Double
_mArgs_timeoutSecs MArgs
args of
Nothing -> Property -> Property
forall a. a -> a
id
Just numSecs :: 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
* (10Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(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 testLabel :: String
testLabel (Left 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 testLabel :: String
testLabel forest :: [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 []
[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
+ 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 depth :: Int
depth = \case
b :: TestTree Result
b@(TestBranch _ forest :: [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
+ 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 depth :: Int
depth resultTree :: 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 testLabel :: String
testLabel (Right result :: 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 testLabel :: String
testLabel (Left 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
forall a. [a] -> [a] -> [a]
++ String -> String
inYellow "PENDING"
TestBranch testLabel :: String
testLabel _ -> 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 n :: Int
n = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*2) ' '
showResult :: String -> QC.Result -> String
showResult :: String -> Result -> String
showResult testLabel :: String
testLabel = \case
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
forall a. [a] -> [a] -> [a]
++String -> String
inRed (String -> String
replaceNewline (Result -> String
output Result
failure))
failure :: Result
failure ->
String -> String
inRed String
testLabel String -> String -> String
forall a. [a] -> [a] -> [a]
++" - "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 '\n' -> " | " ; x :: Char
x -> [Char
x]
labelStr :: String -> String
labelStr :: String -> String
labelStr s :: 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
"" -> "(untitled)"
_ -> String
s
pruneOutSuccesses :: [TestTree QC.Result] -> [TestTree QC.Result]
pruneOutSuccesses :: [TestTree Result] -> [TestTree Result]
pruneOutSuccesses l :: [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 _ (Right Success{}) -> Maybe (TestTree Result)
forall a. Maybe a
Nothing
x :: TestTree Result
x@(TestLeaf _ (Right _)) -> TestTree Result -> Maybe (TestTree Result)
forall a. a -> Maybe a
Just TestTree Result
x
x :: TestTree Result
x@(TestLeaf _ (Left Pending)) -> TestTree Result -> Maybe (TestTree Result)
forall a. a -> Maybe a
Just TestTree Result
x
TestBranch theLabel :: String
theLabel xs :: [TestTree Result]
xs -> case [TestTree Result] -> [TestTree Result]
pruneOutSuccesses [TestTree Result]
xs of
[] -> Maybe (TestTree Result)
forall a. Maybe a
Nothing
leftover :: [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
it :: MTestable t => String -> t -> Microspec ()
it :: String -> t -> Microspec ()
it = String -> t -> Microspec ()
forall t. MTestable t => String -> t -> Microspec ()
describe
class MTestable t where
describe :: String -> t -> Microspec ()
instance MTestable Property where
describe :: String -> Property -> Microspec ()
describe testLabel :: String
testLabel aProp :: 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 testLabel :: String
testLabel bool :: 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 testLabel :: String
testLabel x :: 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 testLabel :: String
testLabel pend :: 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 testLabel :: String
testLabel (Microspec forest :: [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 testLabel :: String
testLabel f :: 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)
emptyResults :: ResultCounts
emptyResults :: ResultCounts
emptyResults =
Int -> Int -> Int -> ResultCounts
ResultCounts 0 0 0
joinResults :: ResultCounts -> ResultCounts -> ResultCounts
(ResultCounts a0 :: Int
a0 b0 :: Int
b0 c0 :: Int
c0) joinResults :: ResultCounts -> ResultCounts -> ResultCounts
`joinResults` (ResultCounts a1 :: Int
a1 b1 :: Int
b1 c1 :: 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)
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 0 0 0)
countResults :: TestTree QC.Result -> ResultCounts
countResults :: TestTree Result -> ResultCounts
countResults = \case
TestLeaf _ (Right Success{}) ->
ResultCounts
emptyResults { numSuccesses :: Int
numSuccesses = 1 }
TestLeaf _ (Right _) ->
ResultCounts
emptyResults { numFailures :: Int
numFailures = 1 }
TestLeaf _ (Left Pending) ->
ResultCounts
emptyResults { numPending :: Int
numPending = 1 }
TestBranch _ ts :: [TestTree Result]
ts ->
[ResultCounts] -> ResultCounts
joinResultList ([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 testLabel :: String
testLabel subs :: [TestTree x]
subs ->
"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
forall a. [a] -> [a] -> [a]
++[TestTree x] -> String
forall a. Show a => a -> String
show [TestTree x]
subs
TestLeaf testLabel :: String
testLabel _ ->
"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 :: (a -> b) -> Microspec a -> Microspec b
fmap f :: a -> b
f (Microspec forest :: [TestTree Property]
forest a :: 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 :: a -> Microspec a
pure a :: a
a = [TestTree Property] -> a -> Microspec a
forall a. [TestTree Property] -> a -> Microspec a
Microspec [] a
a
f :: Microspec (a -> b)
f <*> :: Microspec (a -> b) -> Microspec a -> Microspec b
<*> a :: Microspec a
a =
let Microspec forest0 :: [TestTree Property]
forest0 f' :: a -> b
f' = Microspec (a -> b)
f
Microspec forest1 :: [TestTree Property]
forest1 a' :: 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 :: a -> Microspec a
return = a -> Microspec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
ma :: Microspec a
ma >>= :: Microspec a -> (a -> Microspec b) -> Microspec b
>>= f :: a -> Microspec b
f =
let Microspec forest0 :: [TestTree Property]
forest0 a :: a
a = Microspec a
ma
Microspec forest1 :: [TestTree Property]
forest1 b :: 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
defaultMArgs :: MArgs
defaultMArgs :: MArgs
defaultMArgs = MArgs :: Maybe Double -> Args -> MArgs
MArgs {
_mArgs_timeoutSecs :: Maybe Double
_mArgs_timeoutSecs = Maybe Double
forall a. Maybe a
Nothing
,_mArgs_qcArgs :: Args
_mArgs_qcArgs = Args
QC.stdArgs { chatty :: Bool
chatty = Bool
False }
}
data MArgs = MArgs {
MArgs -> Maybe Double
_mArgs_timeoutSecs :: Maybe Double
,MArgs -> Args
_mArgs_qcArgs :: QC.Args
}
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)
inRed, inGreen, inYellow :: String -> String
[inRed :: String -> String
inRed,inGreen :: String -> String
inGreen, inYellow :: String -> String
inYellow] =
((Int -> String -> String) -> [Int] -> [String -> String]
forall a b. (a -> b) -> [a] -> [b]
`map` [31,32,33]) ((Int -> String -> String) -> [String -> String])
-> (Int -> String -> String) -> [String -> String]
forall a b. (a -> b) -> a -> b
$ \colorNum :: Int
colorNum ->
\s :: String
s -> "\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]
++"m"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++"\ESC[m"
shouldBe :: (Eq x, Show x) => x -> x -> Property
shouldBe :: x -> x -> Property
shouldBe = x -> x -> Property
forall a. (Eq a, Show a) => a -> a -> Property
(===)
shouldSatisfy :: Show x => x -> (x -> Bool) -> Property
shouldSatisfy :: x -> (x -> Bool) -> Property
shouldSatisfy x :: x
x predicate :: x -> Bool
predicate =
String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample ("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)
prop :: MTestable prop => String -> prop -> Microspec ()
prop :: String -> prop -> Microspec ()
prop = String -> prop -> Microspec ()
forall t. MTestable t => String -> t -> Microspec ()
describe