Memoizing và lặp lại IO monads

Question

EDITED 2015/11/29: xem dưới

Tôi đang cố gắng để viết một ứng dụng mà có một nút do-cuối-action-một lần nữa. Lệnh được đề cập có thể yêu cầu đầu vào, và suy nghĩ của tôi về cách thực hiện điều này là chỉ chạy lại đơn vị kết quả với IO ghi nhớ.

Có rất nhiều bài đăng trên SO với các câu hỏi tương tự, nhưng không có giải pháp nào có vẻ hoạt động ở đây.

Tôi đã nâng mã memoIO từ this SO answer và thay đổi triển khai để chạy trên 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 

Tôi đã có một repro nhỏ của phương pháp ứng dụng của tôi, sự khác biệt duy nhất là ứng dụng của tôi có một lớn ngăn xếp biến thay vì chỉ chạy trong 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 

Ý tưởng hạnh phúc Tôi có thể lưu trữ một hành động với ghi nhớ IO trong một IORef (qua repeatable) khi tôi ghi lại những gì đã được thực hiện lần cuối và sau đó thực hiện lại nó với doRepeat.

tôi thử nghiệm này qua:

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

với sản lượng dự kiến:

name> isovector 
hello isovector 
hello isovector 

nhưng đầu ra thực tế:

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

Tôi không hoàn toàn chắc chắn những gì vấn đề là, hoặc thậm chí làm thế nào để đi về gỡ lỗi này. Gun vào đầu tôi, tôi cho rằng việc đánh giá lười biếng đang cắn tôi ở đâu đó, nhưng tôi không thể tìm ra được đâu.

Cảm ơn trước!

---

EDIT 2015/11/29: trường hợp mục đích sử dụng của tôi cho điều này là để thực hiện các repeat last change nhà điều hành trong một vim-clone. Mỗi hành động có thể thực hiện một số tùy ý các cuộc gọi IO tùy ý, và tôi muốn nó có thể xác định những cái nào cần được ghi nhớ (đọc một tập tin, có lẽ không. Yêu cầu người dùng nhập liệu, có).

Answer 1

Tôi đã đưa ra giải pháp. Nó đòi hỏi phải gói đơn nguyên bản trong một máy biến áp mới ghi lại các kết quả của IO và tiêm chúng vào lần sau khi đơn nguyên cơ bản được chạy.

Đăng tại đây để câu trả lời của tôi hoàn tất.

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

Answer 2

vấn đề là ở chính bạn đang tạo một bản ghi nhớ mới mỗi lần bạn gọi hành động

bạn cần phải di chuyển memoized <- memoIO getName lên trên hành động

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

chỉnh sửa: có thể chấp nhận

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

này