Haskell -- Forcing strict evaluation with a weird, recursive type

Question

I previously asked a question about how to force strict evaluation to create a timeout. Using seq/$! is sufficient most of the time, and deepseq works for anything that is a member of NFData, but what if we are using a weird recursive type? Suppose we have the following:

import Control.DeepSeq
import Control.Monad.Random
import Data.Maybe
import System.Timeout

newtype A = A { runA :: A -> Int -> Rand StdGen Bool }

-- a call to runA with this as the first input will always terminate
example1 :: A
example1 = A (\_ i -> (if i > 0 then getRandomR (True, False) else return False))

-- a call to runA with this as the first input will never terminate
example2 :: A
example2 = A (\_ _ -> runA example2 example2 0)

-- here it depends on the other input 
-- will terminate with example1, not with example2 or 3
example3 :: A
example3 = A (\a _ -> runA a a 0)

Can we write a timeout function that determines whether some value x of type A will terminate within a given amount of time when we call runA x x 0? We can try using seq like so:

testTimeout :: A -> IO (Maybe Bool)
testTimeout x = timeout 1000 . evalRandIO $! runA x x 0

However, this does not work for example2 and example3 because the call to runA gets evaluated to WHNF, but then hangs because the computation never finishes. Trying the same thing with deepseq (i.e. $!!) won't even compile, because we need an NFData instance for Rand StdGen Bool. So, how can we implement this instance such that the strict evaluation/timeout works as intended? Or is there some other way to do this?

Answer 1

It appears that timeout just executes the action in a certain amount of time without evaluating the result. It does not evaluate the resulting insides. That is okay. If we use

(>>= (return $!)) :: Monad m => m a -> m a

As you know, return creates a value of type m a. By doing return $!, we are saying that we won't make m a, and therefore complete the action, until the result is evaluated. Here is a more verbose function.

evalM m = do
    result <- m
    result `seq` return result

You could also do this with NFData (which is not necessary for Bool but would be if you where using [a] instead) you could do:

(>>= (return $!!)) :: (Monad m, NFData a) => m a -> m a

More verbosely:

forceM m = do
    result <- m
    result `deepseq` return result

Answer 2

Huh. That is an odd little type there. Maybe this?

instance NFData A where
    rnf (A !runA) = ()

strictify :: A -> A
strictify (A !runA) = A $ \a i -> strictify a `deepSeq` i `deepSeq` runA a i

testTimeout x = timeout 1000 . evalRandIO $! runA x' x' 0
 where x' = strictify x

That might even be "too strict" and redundantly strict, not sure.