Memoizing and repeating IO monads

Question

EDITED 2015-11-29: see bottom

I'm trying to write an application that has a do-last-action-again button. The command in question can ask for input, and my thought for how to accomplish this was to just rerun the resulting monad with memoized IO.

There are lots of posts on SO with similar questions, but none of the solutions seem to work here.

I lifted the memoIO code from this SO answer, and changed the implementation to run over MonadIO.

-- Memoize an IO function
memoIO :: MonadIO m => m a -> m (m a)
memoIO action = do
  ref <- liftIO $ newMVar Nothing
  return $ do
      x <- maybe action return =<< liftIO (takeMVar ref)
      liftIO . putMVar ref $ Just x
      return x

I've got a small repro of my app's approach, the only real difference being my app has a big transformer stack instead of just running in IO:

-- Global variable to contain the action we want to repeat
actionToRepeat :: IORef (IO String)
actionToRepeat = unsafePerformIO . newIORef $ return ""

-- Run an action and store it as the action to repeat
repeatable :: IO String -> IO String
repeatable action = do
    writeIORef actionToRepeat action
    action

-- Run the last action stored by repeatable
doRepeat :: IO String
doRepeat = do
    x <- readIORef actionToRepeat
    x

The idea being I can store an action with memoized IO in an IORef (via repeatable) when I record what was last done, and then do it again it out with doRepeat.

I test this via:

-- IO function to memoize
getName :: IO String
getName = do
    putStr "name> "
    getLine

main :: IO ()
main = do
    repeatable $ do
        memoized <- memoIO getName
        name <- memoized
        putStr "hello "
        putStrLn name
        return name
    doRepeat
    return ()

with expected output:

name> isovector
hello isovector
hello isovector

but actual output:

name> isovector
hello isovector
name> wasnt memoized
hello wasnt memoized

I'm not entirely sure what the issue is, or even how to go about debugging this. Gun to my head, I'd assume lazy evaluation is biting me somewhere, but I can't figure out where.

Thanks in advance!

---

EDIT 2015-11-29: My intended use case for this is to implement the repeat last change operator in a vim-clone. Each action can perform an arbitrary number of arbitrary IO calls, and I would like it to be able to specify which ones should be memoized (reading a file, probably not. asking the user for input, yes).

Answer 1

the problem is in main you are creating a new memo each time you call the action

you need to move memoized <- memoIO getName up above the action

main :: IO ()
main = do
    memoized <- memoIO getName --moved above repeatable $ do
    repeatable $ do
                               --it was here 
        name <- memoized
        putStr "hello "
        putStrLn name
        return name
    doRepeat
    return ()

edit: is this acceptable

import Data.IORef
import System.IO.Unsafe

{-# NOINLINE actionToRepeat #-}
actionToRepeat :: IORef (IO String)
actionToRepeat = unsafePerformIO . newIORef $ return ""

type Repeatable a = IO (IO a)

-- Run an action and store the Repeatable part of the action
repeatable :: Repeatable String -> IO String
repeatable action = do
    repeatAction <- action
    writeIORef actionToRepeat repeatAction
    repeatAction

-- Run the last action stored by repeatable
doRepeat :: IO String
doRepeat = do
    x <- readIORef actionToRepeat
    x

-- everything before (return $ do) is run just once
hello :: Repeatable String
hello = do
    putStr "name> "
    name <- getLine
    return $ do
        putStr "hello "
        putStrLn name
        return name

main :: IO ()
main = do
    repeatable hello
    doRepeat
    return ()

Answer 2

I came up with a solution. It requires wrapping the original monad in a new transformer which records the results of IO and injects them the next time the underlying monad is run.

Posting it here so my answer is complete.

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}

import Control.Applicative (Applicative(..))
import Data.Dynamic
import Data.Maybe (fromJust)
import Control.Monad.RWS

-- | A monad transformer adding the ability to record the results
-- of IO actions and later replay them.
newtype ReplayT m a =
    ReplayT { runReplayT :: RWST () [Dynamic] [Dynamic] m a }
    deriving ( Functor
             , Applicative
             , Monad
             , MonadIO
             , MonadState  [Dynamic]
             , MonadWriter [Dynamic]
             , MonadTrans
             )

-- | Removes the first element from a list State and returns it.
dequeue :: MonadState [r] m
        => m (Maybe r)
dequeue = do
    get >>= \case
        []     -> return Nothing
        (x:xs) -> do
            put xs
            return $ Just x

-- | Marks an IO action to be memoized after its first invocation.
sample :: ( MonadIO m
          , Typeable r)
       => IO r
       -> ReplayT m r
sample action = do
    a <- dequeue >>= \case
        Just x  -> return . fromJust $ fromDynamic x
        Nothing -> liftIO action
    tell [toDyn a]
    return a

-- | Runs an action and records all of its sampled IO. Returns a
-- action which when invoked will use the recorded IO.
record :: Monad m
       => ReplayT m a
       -> m (m a)
record action = do
    (a, w) <- evalRWST (runReplayT action) () []
    return $ do
        evalRWST (runReplayT action) () w
        return a