[Haskell-cafe] Combine `StateT` and `InputT` to maintain state on Ctrl-C interrupt

[haskell at stefan-klinger.de]

Hi,

I'm stuck with maintaining a State in a Haskeline program that would
survive an interrupt with Ctrl-C.

The following is a MWE I have distilled out of a bigger project.  It
revolves around a simple (I guess) read-eval-print loop using
Haskeline, and a stacked StateT to maintain a state.

This MWE reads a line from the user, calculates its `length`, and adds
the length to an Int forming the state.  If the user types the special
input "sleep" the program sleeps for 5 seconds, simulating a longer
computation.  Every time the user presses Ctrl-C

  * a running computation should be interrupted, or

  * when at the prompt, the current input should be cleared.

  * In any case, the state must be maintained!

Unfortunately, Ctrl-C also clears the state.

At first I thought I had stacked the `StateT` and `InputT` in the
wrong order.  But changing from `InputT (StateT Int IO) ()` to `StateT
Int (InputT IO) ()` seems not to change anything (which really gives
me the creeps).

This message contains both versions (one commented out), they compile
with

    $ ghc --version
    The Glorious Glasgow Haskell Compilation System, version 7.10.1
    $ ghc --make -Wall -outputdir tmp -o mwe StateMwe.lhs

Example run, comments (`<--...`) added later:

    $ ./mwe

    type> arglschluargl
    Adding length of "arglschluargl"
    13

    type> lalala
    Adding length of "lalala"
    19

    type>                           <--no input, state unchanged
    Adding length of ""
    19

    type> sleep
    Sleeping 5 seconds...
    ^C                              <--Here I have hit C-c
    type>                           <--no input, state unchanged
    Adding length of ""
    0                               <--WRONG: that should be 19


Here we go:

> import Control.Monad.State.Strict
> import Control.Concurrent ( threadDelay )
> import System.Console.Haskeline


  > {-

Version one: `StateT` inside `InputT`

> main :: IO ()
> main = evalStateT (runInputT defaultSettings $ noesc repl) 0


This catches an interrupt via Ctrl-C and restarts the passed
operation.

> noesc :: MonadException m => InputT m a -> InputT m a
> noesc w = withInterrupt $ let loop = handle (\Interrupt -> loop) w in loop


The read-eval-print loop: EOF terminates, `sleep` delays, and any
other input modifies the integer state.

> repl :: InputT (StateT Int IO) ()
> repl = do x <- getInputLine "\ntype> "
>           case x of
>             Nothing -> return ()
>             Just "sleep"
>               -> do outputStrLn "Sleeping 5 seconds..."
>                     lift . lift . threadDelay $ 5 * 10^(6::Int)
>                     outputStrLn "...not interrupted"
>                     repl
>             Just t
>               -> do outputStrLn $ "Adding length of " ++ show t
>                     lift $ modify (+ length t)
>                     v <- lift get
>                     outputStrLn $ show v
>                     repl

  > -}


> {-

Version two: `InputT` inside `StateT`

> main :: IO ()
> main = runInputT defaultSettings . noesc $ evalStateT repl 0


This catches an interrupt via Ctrl-C and restarts the passed
operation.  I suspect that I have to rearrange this to accommodate the
modified stacking, but I could not come up with anything that
compiles...

> noesc :: MonadException m => InputT m a -> InputT m a
> noesc w = withInterrupt $ let loop = handle (\Interrupt -> loop) w in loop


As above, with `lift` in different places.  To get a better
understanding of what's going on, I do not want to use mtl's
lift-to-the-right-monad magic (yet).

> repl :: StateT Int (InputT IO) ()
> repl = do x <- lift $ getInputLine "\ntype> "
>           case x of
>             Nothing -> return ()
>             Just "sleep"
>               -> do lift $ outputStrLn "Sleeping 5 seconds..."
>                     lift . lift . threadDelay $ 5 * 10^(6::Int)
>                     lift $ outputStrLn "...not interrupted"
>                     repl
>             Just t
>               -> do lift . outputStrLn $ "Adding length of " ++ show t
>                     modify (+ length t)
>                     v <- get
>                     lift . outputStrLn $ show v
>                     repl

> -}



Any help would be welcome...

Stefan


--
http://stefan-klinger.de                                      o/X
                                                              /\/
                                                                \