记忆和重复 IO monad

Memoizing and repeating IO monads

2015-11-29 编辑:见底部

我正在尝试编写一个具有“再次执行最后一个操作”按钮的应用程序。有问题的命令可以要求输入,我对如何实现这一点的想法是重新运行生成的带有记忆 IO 的 monad。

SO 上有很多帖子提出了类似的问题,但 none 的解决方案似乎在这里有效。

我从 this SO answer 中提取了 memoIO 代码,并将实现更改为 运行 而不是 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

我对我的应用程序的方法做了一个小的复现,唯一真正的区别是我的应用程序有一个 转换器堆栈,而不是 运行ning 在 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 中(通过 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 克隆中实现 repeat last change 运算符。每个动作都可以执行任意数量的任意 IO 调用,我希望它能够指定应该记住哪些(读取文件,可能不是。要求用户输入,是的)。

问题主要在于您每次调用操作时都在创建新备忘录

您需要将 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 ()

我想出了一个解决办法。它需要将原始 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