Interrupting lengthy pure computation in MonadState

Question

I can't grasp the correct way of interrupting lengthy pure computation on SIGINT signal.

In the simple example below, I have slowFib function that simulates lengthy computation. When it is run just in IO monad I can terminate it with C-c (using async to spawn worker).

However, when I put computation inside MonadState, MonadIO stack it no longer work... On the other hand, simple threadDelay in the same stack still can be terminated.

The code is following:

{-# LANGUAGE FlexibleContexts #-}
module Main where

import Data.Monoid

import Control.DeepSeq
import Control.Concurrent
import Control.Concurrent.Async

import Control.Monad.State
-- import Control.Monad.State.Strict

import System.Posix.Signals

slowFib :: Integer -> Integer
slowFib 0 = 0
slowFib 1 = 1
slowFib n = slowFib (n - 2 ) + slowFib (n - 1)

data St = St { x :: Integer } deriving (Show)

stateFib :: (MonadState St m, MonadIO m) => Integer -> m Integer
stateFib n = do
  let f = slowFib n
  modify $ \st -> st{x=f}
  return f

stateWait :: (MonadState St m, MonadIO m) => Integer -> m Integer
stateWait n = do
  liftIO $ threadDelay 5000000
  return 41

interruptable n act = do
  putStrLn $ "STARTING EVALUATION: " <> n
  e <- async act
  installHandler sigINT (Catch (cancel e)) Nothing
  putStrLn "WAITING FOR RESULT"
  waitCatch e

main = do
  let s0 = St 0

  r <- interruptable "slowFib" $ do
    let f = slowFib 41
    f `deepseq` return ()
    return f

  r <- interruptable "threadDelay in StateT" $ runStateT (stateWait 41) s0
  putStrLn $ show r

  r <- interruptable "slowFib in StateT" $ runStateT (stateFib 41) s0
  putStrLn $ show r

I suspected that it has something to do with lazy evaluation. I already figured out that in the first example (with just the IO monad) I have to force the result. Otherwise async computation just returns a thunk.

However all my attempts to do something analogous in MonadState failed. Anyway, it seems to be more complicated, since async thread does not return immediately. It waits until the result is computed. For some reason I just cannot terminate it when the pure computation is "blocking".

Any clues?

PS. My use case is too add ability to abort computation in custom Jupyter kernel made using jupyter package. Functions evaluating user input are exactly in MonadState and MonadIO.

Answer 1

The computation seems to be blocked on putStrLn $ show r, i.e. outside the interruptable function. Note that stateFib doesn't force the result, so the async exits almost immediately. The whole work is delayed until putStrLn tries to print the result. Try to force the computation earlier:

stateFib :: (MonadState St m, MonadIO m) => Integer -> m Integer
stateFib n = do
  let f = slowFib n
  modify $ \st -> st{x=f}
  f `seq` return f