module Test.Hspec.LeanCheck
( property
, propertyFor
, prop
, Property
, module Test.LeanCheck
)
where
import Test.Hspec.Core.Spec
import Test.LeanCheck
import Test.LeanCheck.Core (resultiers)
import Control.Exception (try)
import System.IO.Unsafe (unsafePerformIO)
import qualified Test.HUnit.Lang as HUnit
import Data.Maybe (fromMaybe)
data Property = Ok
| Failed String
propertyFor :: Testable a => Int -> a -> Property
propertyFor :: Int -> a -> Property
propertyFor Int
m a
p = case Int -> a -> Maybe [String]
forall a. Testable a => Int -> a -> Maybe [String]
counterExample Int
m a
p of
Maybe [String]
Nothing -> Property
Ok
Just [String]
ce -> String -> Property
Failed (String -> Property) -> String -> Property
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String]
ce
property :: Testable a => a -> Property
property :: a -> Property
property = Int -> a -> Property
forall a. Testable a => Int -> a -> Property
propertyFor Int
200
prop :: Testable a => String -> a -> Spec
prop :: String -> a -> Spec
prop String
s = String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
s (Property -> Spec) -> (a -> Property) -> a -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Property
forall a. Testable a => a -> Property
property
instance Example Property where
evaluateExample :: Property
-> Params
-> (ActionWith (Arg Property) -> IO ())
-> ProgressCallback
-> IO Result
evaluateExample Property
p Params
_ ActionWith (Arg Property) -> IO ()
_ ProgressCallback
_ = Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result)
-> (ResultStatus -> Result) -> ResultStatus -> IO Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ResultStatus -> Result
Result String
""
(ResultStatus -> IO Result) -> ResultStatus -> IO Result
forall a b. (a -> b) -> a -> b
$ case Property
p of
Property
Ok -> ResultStatus
Success
Failed String
s -> Maybe Location -> FailureReason -> ResultStatus
Failure Maybe Location
forall a. Maybe a
Nothing (String -> FailureReason
Reason String
s)
instance Testable (IO a) where
resultiers :: IO a -> [[([String], Bool)]]
resultiers IO a
action = IO [[([String], Bool)]] -> [[([String], Bool)]]
forall a. IO a -> a
unsafePerformIO (IO [[([String], Bool)]] -> [[([String], Bool)]])
-> IO [[([String], Bool)]] -> [[([String], Bool)]]
forall a b. (a -> b) -> a -> b
$ do
Either HUnitFailure a
r <- IO a -> IO (Either HUnitFailure a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
action
[[([String], Bool)]] -> IO [[([String], Bool)]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[([String], Bool)]] -> IO [[([String], Bool)]])
-> (([String], Bool) -> [[([String], Bool)]])
-> ([String], Bool)
-> IO [[([String], Bool)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([([String], Bool)] -> [[([String], Bool)]] -> [[([String], Bool)]]
forall a. a -> [a] -> [a]
:[]) ([([String], Bool)] -> [[([String], Bool)]])
-> (([String], Bool) -> [([String], Bool)])
-> ([String], Bool)
-> [[([String], Bool)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], Bool) -> [([String], Bool)] -> [([String], Bool)]
forall a. a -> [a] -> [a]
:[]) (([String], Bool) -> IO [[([String], Bool)]])
-> ([String], Bool) -> IO [[([String], Bool)]]
forall a b. (a -> b) -> a -> b
$ case Either HUnitFailure a
r of
Right a
_ -> ([],Bool
True)
Left (HUnit.HUnitFailure Maybe SrcLoc
loc FailureReason
reason) ->
case FailureReason
reason of
HUnit.Reason String
s -> ([String
"--", String
s],Bool
False)
HUnit.ExpectedButGot Maybe String
prefix String
expected String
actual ->
([String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
prefix, String
"--", String
"expected", String
expected, String
"but got", String
actual], Bool
False)