module PropUnit
  ( DependencyType (..)
  , Gen
  , MonadTest
  , Property
  , PropertyT
  , Range
  , TestLimit
  , TestName
  , TestTree
  , (===)
  , (/==)
  , after
  , assert
  , forAll
  , testProp
  , testUnit
  , defaultTestLimit
  , setupTests
  , testGroup
  , testMain
  , withResource
  )
where

import Control.Monad (when)
import Hedgehog
  ( DiscardLimit
  , Gen
  , MonadTest
  , Property
  , PropertyT
  , Range
  , ShrinkLimit
  , ShrinkRetries
  , TestLimit
  , assert
  , forAll
  , property
  , withDiscards
  , withRetries
  , withShrinks
  , withTests
  , (/==)
  , (===)
  )
import System.Environment (lookupEnv, setEnv)
import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
import Test.Tasty (DependencyType (..), TestName, TestTree, after, defaultMain, testGroup, withResource)
import Test.Tasty.Hedgehog (testProperty)

unitProperty :: PropertyT IO () -> Property
unitProperty :: PropertyT IO () -> Property
unitProperty =
  TestLimit -> Property -> Property
withTests (TestLimit
1 :: TestLimit)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiscardLimit -> Property -> Property
withDiscards (DiscardLimit
1 :: DiscardLimit)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShrinkLimit -> Property -> Property
withShrinks (ShrinkLimit
0 :: ShrinkLimit)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShrinkRetries -> Property -> Property
withRetries (ShrinkRetries
0 :: ShrinkRetries)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PropertyT IO () -> Property
property

testUnit :: TestName -> PropertyT IO () -> TestTree
testUnit :: String -> PropertyT IO () -> TestTree
testUnit String
name = String -> Property -> TestTree
testProperty String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. PropertyT IO () -> Property
unitProperty

testProp :: TestName -> TestLimit -> PropertyT IO () -> TestTree
testProp :: String -> TestLimit -> PropertyT IO () -> TestTree
testProp String
name TestLimit
lim = String -> Property -> TestTree
testProperty String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> Property -> Property
withTests TestLimit
lim forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PropertyT IO () -> Property
property

-- 100 is Hedgehog's defaultMinTests
defaultTestLimit :: TestLimit
defaultTestLimit :: TestLimit
defaultTestLimit = TestLimit
100

setupTests :: IO TestLimit
setupTests :: IO TestLimit
setupTests = do
  Maybe String
mayDebugStr <- String -> IO (Maybe String)
lookupEnv String
"PROP_UNIT_DEBUG"
  let debug :: Bool
debug = forall a. a -> Maybe a
Just String
"1" forall a. Eq a => a -> a -> Bool
== Maybe String
mayDebugStr
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug forall a b. (a -> b) -> a -> b
$ do
    String -> String -> IO ()
setEnv String
"TASTY_NUM_THREADS" String
"1"
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
NoBuffering
  Maybe String
mayLimStr <- String -> IO (Maybe String)
lookupEnv String
"PROP_UNIT_LIMIT"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall b a. b -> (a -> b) -> Maybe a -> b
maybe TestLimit
defaultTestLimit (forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read) Maybe String
mayLimStr)

testMain :: (TestLimit -> TestTree) -> IO ()
testMain :: (TestLimit -> TestTree) -> IO ()
testMain TestLimit -> TestTree
f = do
  TestLimit
lim <- IO TestLimit
setupTests
  TestTree -> IO ()
defaultMain (TestLimit -> TestTree
f TestLimit
lim)