{-# LANGUAGE Unsafe #-}
module Yaya.Hedgehog
( evalNonterminating,
nonterminatingProperty,
)
where
import safe "base" Control.Category (Category ((.)))
import safe "base" Control.Monad ((<=<))
import safe "base" Control.Monad.IO.Class (MonadIO)
import safe "base" Data.Function (const)
import safe "base" Data.Maybe (maybe)
import "base" GHC.IO (evaluate)
import safe "base" GHC.Stack (HasCallStack)
import safe "base" System.Timeout (timeout)
import safe "base" Text.Show (Show)
import qualified "hedgehog" Hedgehog as HH
evalNonterminating ::
(HasCallStack, MonadIO m, HH.MonadTest m, Show a) => a -> m ()
evalNonterminating :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, MonadTest m, Show a) =>
a -> m ()
evalNonterminating =
m () -> (a -> m ()) -> Maybe a -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m ()
forall (m :: * -> *). MonadTest m => m ()
HH.success (m () -> () -> m ()
forall a b. a -> b -> a
const m ()
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a
HH.failure (() -> m ()) -> (a -> m ()) -> a -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> m ()
forall (m :: * -> *) a.
(MonadTest m, Show a, HasCallStack) =>
a -> m ()
HH.annotateShow)
(Maybe a -> m ()) -> (a -> m (Maybe a)) -> a -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
HH.evalIO (IO (Maybe a) -> m (Maybe a))
-> (a -> IO (Maybe a)) -> a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> IO a -> IO (Maybe a)
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
1_000_000 (IO a -> IO (Maybe a)) -> (a -> IO a) -> a -> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> IO a
forall a. a -> IO a
evaluate
nonterminatingProperty :: (HasCallStack, Show a) => a -> HH.Property
nonterminatingProperty :: forall a. (HasCallStack, Show a) => a -> Property
nonterminatingProperty = TestLimit -> Property -> Property
HH.withTests TestLimit
1 (Property -> Property) -> (a -> Property) -> a -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
HH.property (PropertyT IO () -> Property)
-> (a -> PropertyT IO ()) -> a -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> PropertyT IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, MonadTest m, Show a) =>
a -> m ()
evalNonterminating