module Test.QuickCheck.Bottoms (bottom,infiniteComp) where

import Test.QuickCheck

import Control.Monad (forever)
import System.IO.Unsafe
import Control.Concurrent

bottom :: Gen a
bottom :: Gen a
bottom = a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. HasCallStack => a
undefined

infiniteComp :: Gen a
infiniteComp :: Gen a
infiniteComp = a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. a
hang

-- Without using unsafePerformIO, is there a way to define a
-- non-terminating but non-erroring pure value that consume very little
-- resources while not terminating?

-- | Never yield an answer.  Like 'undefined' or 'error "whatever"', but
-- don't raise an error, and don't consume computational resources.
hang :: a
hang :: a
hang = IO a -> a
forall a. IO a -> a
unsafePerformIO IO a
forall a. IO a
hangIO

-- | Block forever
hangIO :: IO a
hangIO :: IO a
hangIO = do -- putStrLn "warning: blocking forever."
            -- Any never-terminating computation goes here
            -- This one can yield an exception "thread blocked indefinitely"
            -- newEmptyMVar >>= takeMVar
            -- sjanssen suggests this alternative:
            Any
_ <- IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO Any) -> IO () -> IO Any
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
forall a. Bounded a => a
maxBound
            -- forever's return type is (), though it could be fully
            -- polymorphic.  Until it's fixed, I need the following line.
            a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. HasCallStack => a
undefined