在 RWS monad 中解释 Teletype free monad

Question

我目前正在学习免费的 monad，我正在玩弄可能是最简单和最常见的例子 - Teletype:

{-# LANGUAGE DeriveFunctor #-}

import Control.Monad.Free

data TeletypeF a = Put String a
                 | Get (String -> a)
    deriving Functor

type Teletype = Free TeletypeF

许多教程解释IO monad 中的Teletype 程序。例如：

-- Utilities
get   = liftF $ Get id
put s = liftF $ Put s ()

-- Sample programs
echo :: Teletype ()
echo = do word <- get
          if word == "\04"  -- Ctrl-D
          then return ()
          else put word >> echo

hello :: Teletype ()
hello = do put "What is your name?"
           name <- get
           put "What is your age?"
           age <- get
           put ("Hello, " ++ name ++ "!")
           put ("You are " ++ age ++ " years old!")

-- Interpret to IO
interpIO :: Teletype a -> IO a
interpIO = foldFree lift
    where
        lift (Put s a) = putStrLn s >> return a
        lift (Get f)   = getLine >>= return . f

我试图用不同的 monad 来解释它，即 RWS monad。 这个想法是由this assignment 的最后一个练习激发的。 我正在使用RWS 数据类型从Reader 部分获取输入并在State 部分中累积输出。 但是，不幸的是，我无法让它工作。到目前为止，这是我的尝试：

import Control.Monad.Trans.RWS.Lazy hiding (get, put)

type TeletypeRWS = RWS [String] () [String]

-- Interpret to TeletypeRWS
interpRWS :: Teletype a -> TeletypeRWS a
interpRWS = foldFree lift
    where
        lift (Put s a) = state (\t -> ((), t ++ [s])) >> return a
        lift (Get f)   = reader head >>= local tail . return . f  -- This is wrong

mockConsole :: Teletype a -> [String] -> (a, [String])
mockConsole p inp = (a, s)
    where
        (a, s, _) = runRWS (interpRWS p) inp []

运行TeletypeRWS“程序”时，环境中的第一个值不会被移除：

*Main> mockConsole hello ["john", "18"]
((),["What is your name?","What is your age?","Hello, john!","You are john years old!"])

我对更新Reader 有点不安，但我不知道我还能如何访问列表中的下一个值。 TeletypeRWS 的类型是根据上面提到的练习选择的——所以我认为应该可以实现 interpRWS。

Answer 1

我们不能使用foldFree：它需要在延续中是参数的，所以我们不能在那里应用local。相比之下，iterM 明确地为我们提供了没有泛化的实际延续，所以这将起作用。

interpRWS = iterM lift where
  lift (Put s a) = modify (\t -> t ++ [s]) >> a
  lift (Get f)   = reader head >>= local tail . f