正如其他人所指出的那样,IO
如果您已经在使用类似getLine
和putStrLn
. 你必须修改greeter
. 您可以使用hGetLine
andhPutStr
版本并IO
使用 fake 进行模拟Handle
,或者您可以使用Purify Code with Free Monads方法。
它要复杂得多,但也更通用,通常非常适合这种模拟,尤其是当它变得更复杂时。我将在下面简要解释一下,尽管细节有些复杂。
这个想法是您将创建自己的“假 IO”monad,它可以以多种方式“解释”。主要解释只是使用常规IO
。嘲弄的解释getLine
用一些虚假的台词代替,并与stdout
.
我们将使用该free
软件包。第一步是用Functor
. 基本概念是每个命令都是函子数据类型的一个分支,函子的“槽”代表“下一个动作”。
{-# LANGUAGE DeriveFunctor #-}
import Control.Monad.Trans.Free
data FakeIOF next = PutStr String next
| GetLine (String -> next)
deriving Functor
如果你忽略下一个动作IO
,从构建 a 的人的角度来看,这些构造函数几乎就像常规函数。FakeIOF
如果我们愿意,PutStr
我们必须提供一个String
. 如果我们愿意,GetLine
我们提供一个函数,只在给定 a 时给出下一个动作String
。
现在我们需要一些令人困惑的样板文件。我们使用该liftF
函数将我们的函子变成一个FreeT
单子。请注意,我们提供了作为我们的功能的下()
一个操作。事实证明,如果我们考虑自己的行为方式,这些会给我们正确的“返回值”。PutStr
id
String -> next
FakeIO
Monad
-- Our FakeIO monad
type FakeIO a = FreeT FakeIOF IO a
fPutStr :: String -> FakeIO ()
fPutStr s = liftF (PutStr s ())
fGetLine :: FakeIO String
fGetLine = liftF (GetLine id)
使用这些我们可以构建我们喜欢的任何功能,并greeter
以非常小的更改进行重写。
fPutStrLn :: String -> FakeIO ()
fPutStrLn s = fPutStr (s ++ "\n")
greeter :: FakeIO ()
greeter = do
fPutStr "What's your name? "
name <- fGetLine
fPutStrLn $ "Hi, " ++ name
这可能看起来有点神奇——我们使用do
符号而不定义Monad
实例。诀窍是对于任何和f`FreeT f m
都是 a 。Monad
Monad
m
Functor
这样就完成了我们的“模拟”greeter
功能。现在我们必须以某种方式解释它,因为到目前为止我们几乎没有实现任何功能。要编写解释器,我们使用iterT
函数 from Control.Monad.Trans.Free
。它的完全通用类型如下
iterT
:: (Monad m, Functor f) => (f (m a) -> m a) -> FreeT f m a -> m a
但是当我们将它应用到我们的FakeIO
monad 时,它看起来
iterT
:: (FakeIOF (IO a) -> IO a) -> FakeIO a -> IO a
这要好得多。我们为它提供了一个函数,它将在“下一个动作”位置(这就是它的名字)中FakeIOF
充满动作的函子转换为一个简单的动作,并将魔法变成真正的.IO
IO
iterT
FakeIO
IO
对于我们的默认解释器来说,这真的很容易。
interpretNormally :: FakeIO a -> IO a
interpretNormally = iterT go where
go (PutStr s next) = putStr s >> next -- next :: IO a
go (GetLine doNext) = getLine >>= doNext -- doNext :: String -> IO a
但我们也可以制作一个 mocked 解释器。我们将使用 的工具IO
来存储一些状态,特别是虚假响应的循环队列。
newQ :: [a] -> IO (IORef [a])
newQ = newIORef . cycle
popQ :: IORef [a] -> IO a
popQ ref = atomicModifyIORef ref (\(a:as) -> (as, a))
interpretMocked :: [String] -> FakeIO a -> IO a
interpretMocked greetings fakeIO = do
queue <- newQ greetings
iterT (go queue) fakeIO
where
go _ (PutStr s next) = putStr s >> next
go q (GetLine getNext) = do
greeting <- popQ q -- first we pop a fresh greeting
putStrLn greeting -- then we print it
getNext greeting -- finally we pass it to the next IO action
现在我们可以测试这些功能
λ> interpretNormally greeter
What's your name? Joseph
Hi, Joseph.
λ> interpretMocked ["Jabberwocky", "Frumious"] (greeter >> greeter >> greeter)
What's your name?
Jabberwocky
Hi, Jabberwocky
What's your name?
Frumious
Hi, Frumious
What's your name?
Jabberwocky
Hi, Jabberwocky