记忆和重复IO monad

Question

编辑2015-11-29:见底部

我正在尝试编写一个具有do-last-action-again按钮的应用程序.有问题的命令可以请求输入,我对如何实现这一点的想法就是用memoized IO重新运行生成的monad.

SO上有很多关于类似问题的帖子,但这些解决方案似乎都没有.

我memoIO从这个SO答案中解除了代码,并将实现改为运行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

我有一个小应用程序的方法,唯一真正的区别是我的应用程序有一个大的变压器堆栈而不是只是运行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

我的想法是,当我记录上次完成的内容时,我可以存储一个记录IO在IORef(via repeatable)中的动作,然后再将其重新执行doRepeat.

我通过以下方式测试:

-- 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 ()

预期产量:

name> isovector
hello isovector
hello isovector

但实际输出:

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

我不完全确定问题是什么,甚至不知道如何进行调试.枪到我的头,我认为懒惰的评价是在咬我某个地方,但我无法弄清楚在哪里.

提前致谢!

---

编辑2015-11-29:我的预期用例是在vim-clone中实现重复上一次更改操作符.每个动作可以执行任意IO调用任意数量的,我希望它能够指定哪些应该memoized(读取文件时,可能不会.要求输入用户,是).

Answer 1

问题是主要是你每次调用动作时都会创建一个新的备忘录

你需要memoized <- memoIO getName向上移动

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 ()

编辑:这是可以接受的

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

我想出了一个解决方案。它需要将原始 monad 包装在一个新的变压器中，该变压器记录 IO 的结果并在底层 monad 下次运行时注入它们。

将其发布在这里，以便我的答案完整。

{-# 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