2020-09-13 20:42:23 +03:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE TypeApplications #-}
|
|
|
|
|
|
|
|
import qualified Foo
|
2020-09-14 19:07:17 +03:00
|
|
|
import qualified Headers
|
2020-09-14 03:29:51 +03:00
|
|
|
import Hedgehog (Group (..), checkSequential, withTests)
|
2020-09-13 20:42:23 +03:00
|
|
|
import qualified Roboservant as RS
|
|
|
|
import qualified UnsafeIO
|
2020-09-21 23:10:50 +03:00
|
|
|
import Control.Monad(when)
|
2020-09-13 20:42:23 +03:00
|
|
|
|
|
|
|
-- | this is pretty bad. hopefully Jacob knows a better way of doing this.
|
|
|
|
-- https://twitter.com/mwotton/status/1305189249646460933
|
|
|
|
assert :: String -> Bool -> IO ()
|
|
|
|
assert _ True = pure ()
|
|
|
|
assert err False = ioError $ userError err
|
2020-06-06 17:24:56 +03:00
|
|
|
|
2020-09-13 21:04:46 +03:00
|
|
|
-- | This is horribly laid out, sorry. Will fix at some point.
|
2020-06-05 19:01:44 +03:00
|
|
|
main :: IO ()
|
2020-09-13 20:42:23 +03:00
|
|
|
main = do
|
|
|
|
assert "should find an error in Foo" . not
|
2020-09-14 18:57:26 +03:00
|
|
|
=<< checkSequential (Group "Foo" [("Foo", withTests 100000 $ RS.prop_sequential @Foo.FooApi Foo.fooServer)])
|
2020-09-21 23:10:50 +03:00
|
|
|
when False $ do
|
|
|
|
assert "should find an error in Headers" . not
|
|
|
|
=<< checkSequential (Group "Headers" [("Headers", withTests 10000 $ RS.prop_sequential @Headers.Api Headers.server)])
|
2020-09-14 19:07:17 +03:00
|
|
|
|
2020-09-13 21:04:46 +03:00
|
|
|
-- The UnsafeIO checker does not actually really use the contextually aware stuff, though it
|
|
|
|
-- could: it's mostly here to show how to test for concurrency problems.
|
2020-09-13 20:42:23 +03:00
|
|
|
unsafeServer <- UnsafeIO.makeServer
|
|
|
|
-- this will not detect the error, as it requires concurrency.
|
2020-09-13 22:41:52 +03:00
|
|
|
assert "should find nothing" =<< checkSequential (Group "Unsafe" [("Sequential", RS.prop_sequential @UnsafeIO.UnsafeApi unsafeServer)])
|
2020-09-13 21:04:46 +03:00
|
|
|
-- this will!
|
2020-09-13 20:42:23 +03:00
|
|
|
assert "should find with parallel check" . not
|
2020-09-14 03:36:13 +03:00
|
|
|
=<< checkSequential (Group "Unsafe" [("Parallel", withTests 100000 $ RS.prop_concurrent @UnsafeIO.UnsafeApi unsafeServer)])
|