Haskell:如何在状态monad之上编写交互式解释器？

Question

我们正在开发一个内部使用状态monad的模型文件系统.我们有一个类型类,其操作如下:

class Monad m => FS m where
  isDirectory  :: Path -> m Bool
  children     :: Path -> m [Path]
  ...

我们正在努力一点点交互式解释,将提供类似的命令cd,ls,cat,等等.解释器中的操作可以这样写:

fsop :: FS m => Operation -> m Response

定义Operation和Response不重要; 如果你愿意,把它们当作弦乐.

我试图解决的问题是在I/O monad中编写一个顶层循环来解释文件系统Operation并打印响应.如果IO是FS的一个实例(也就是说,如果我们直接使用IO monad),生活会很简单:我们可以写

loop :: Path -> IO ()
loop currentDir = do
        op <- getLine
        case read op of
          ChangeDir d -> loop d -- should test 'isDirectory d', but let's not
          Ls -> do { files <- children currentDir
                   ; mapM_ putStrLn files
                   ; loop currentDir }
          Exit -> return ()

但这不是我想要的.我想用Control.Monad.State:

newtype Filesystem a = Filesystem (State (Data.Map.Map Path Contents) a)

并宣布

instance Monad Filesystem ...
instance FS Filesystem ...

使用FS抽象,我可以编写一个应该适用于任何实例的单步函数,实际上下面的代码编译:

step :: FS fs => Path -> Operation -> fs (Path, Response)
step currentDir op = 
        case op of
          ChangeDir d -> return (d, "")
          Ls -> do { files <- children currentDir
                   ; return (currentDir, unlines files) }

此时我完全卡住了. 我想要做的就是写在单子IO,它可以读取一个互动的循环OperationS和打印ResponseS,但它的工作原理上的状态单子是不是一定IO.(使模型不在IO中的原因之一是我们可以测试QuickCheck属性.)

我觉得这必须是一个标准问题 - 在状态抽象之上的交互式阅读 - 评估 - 打印循环不是 IO - 但我必须错过一些令人惊讶的显而易见的东西,因为我似乎无法弄明白.我看过网上但没有开悟过.

任何编写可以调用的交互式IO执行计算的帮助step都将非常感激.

Answer 1

使用monad变形金刚怎么样？它们或多或少是组合monad的标准方法.这是一个简单的例子:

type Foo a = StateT String IO a

replT :: Foo ()
replT = do
  str   <- liftIO getLine
  state <- get
  liftIO $ putStrLn ("current state: " ++ state)
  liftIO $ putStrLn ("setting state: " ++ str)
  put str
  replT

以下是从ghci中运行replT的结果.

*Main> runStateT replT "Initial state"
asd
current state: Initial state
setting state: asd
zxc
current state: asd
setting state: zxc
asdasd

有三个monad变换器库.mtl,变形金刚和monadLib.因为我不使用它们,我不能推荐它们中的任何一个.

Answer 2

免责声明:我不能保证以下是一个很好的方法,但通过它听起来很有趣.让我们把它旋转一下,好吗？

一些强制性进口

首先,让我们抛出一些数据类型.我将填写一些细节并稍微调整一下,以便定义一个我们可以实际交互的简单"文件系统".

type Path = String
type Response = Maybe String
type Contents = [String]

data Operation = Cd Path 
               | Ls 
               | MkDir Path
               | Quit
    deriving (Read, Show)

接下来,我们会做一些有点前卫的事情......去除所有的monad.什么？这太疯狂了!也许,但有时所有的隐藏的管道是>>=提供隐藏的东西只是有点太多了.

对于文件系统本身,我们只存储当前工作目录和路径到其子节点的映射.我们还需要一些功能来与它进行交互.

data Filesystem = Filesystem { wd :: Path, files :: M.Map Path Contents }
    deriving Show

newFS = Filesystem "/" (M.singleton "/" [])

isDirectory p fs = M.member p $ files fs
children p fs = fromMaybe [] . M.lookup p $ files fs
cd p fs = fs { wd = p }
create p fs = let newPath = wd fs ++ p ++ "/"
                  addPath = M.insert newPath [] . M.adjust (p:) (wd fs)
              in (newPath, fs { files = addPath $ files fs })

现在为monad-less版本的step功能.它需要带a Operation和a Filesystem,并返回a Response和a(可能已修改)Filesystem:

step :: Operation -> Filesystem -> (Response, Filesystem)
step (Cd d) fs = (Just "Ok\n", cd d fs)
step (MkDir d) fs = first (\d -> Just $ "Created " ++ d ++ "\n") $ create d fs
step Ls fs = let files = children (wd fs) fs
             in (Just $ unlines files, fs)
step Quit fs = (Nothing, fs)

......嗯,那种类型的签名看起来很像Statemonad 的胆量.哦,好吧,暂时忽略它,然后盲目地向前充电.

现在,我们想要的是一个为解释器提供通用接口的函数Filesystem.特别是,我们希望接口至少在某种程度上是独立的,这样无论使用什么接口都不需要手动操作,但我们希望接口对使用它的代码充分遗忘,我们可以将其连接到该IO单子,其他的一些Monad,甚至没有单子都没有.

这告诉我们的主要是我们需要以某种方式将外部代码与解释器交错,而不是让任何一部分处于控制之下.现在,Haskell是一种函数式语言,这意味着使用大量高阶函数是好的,对吧？对我来说听起来似乎有道理,所以这里是我们将要使用的策略:如果一个函数不知道下一步该做什么,我们将把它交给另一个我们假设的函数.重复,直到每个人都知道发生了什么.一个完美的计划,不是吗？

这一切的核心都是step功能,所以我们先从调用它开始.

interp1 :: Operation -> Filesystem -> (Response, Filesystem)
interp1 op fs = step op fs

......好吧,这是一个开始.我猜.但等等,Operation来自哪里？我们需要外部代码来提供它,但我们不能只是要求它,而不是让所有的东西与令人讨厌的字符混淆IO.所以我们得到另一个功能来为我们做脏工作:

interp2 :: ((Operation -> (Response, Filesystem)) -> t) -> Filesystem -> t
interp2 inp fs = inp (\op -> step op fs)

当然,现在我们所拥有的只是一些愚蠢的t事情,我们甚至不知道它是什么.我们知道它必须在某个地方有一个Response和一个Filesystem,但是我们不能对它做任何事情,所以我们将把它交还给另一个函数,以及关于如何继续的一些指示......这当然会涉及到传入更多功能.你知道,它的功能一直在下降.

interp3 :: ((Operation -> (Response, Filesystem)) -> a)
           -> (a -> ((Response, Filesystem) -> b) -> c)
           -> (Filesystem -> b)
           -> (String -> Filesystem -> b) 
           -> Filesystem 
           -> c
interp3 inp check done out fs = check (inp (\op -> step op fs)) test
    where test (Nothing, fs) = done fs
          test (Just s, fs)  = out s fs

......那太难看了.但不要担心,一切都按计划进行.接下来我们可以做一些观察:

• 类型a只存在于inp和之间check,所以事后看来,我们也可以提前将它们组合起来,然后将组合函数传递给解释器.
• 当我们打电话时done,它应该完全意味着它在锡上的含义.因此,返回类型done应该是一样的全解释,意义b和c应该是同一类型.

现在,如果done结束整个事情,那是out什么？正如名字所暗示的那样,它正在为外部代码提供输出,但在那之后它会去哪里？它需要以某种方式循环回解释器,我们可能会注意到我们的解释器还没有递归.前进的道路很明确 - 翻译就像Jormungand一样,抓住自己的尾巴; 无限循环回到解释完成(或直到拉格纳罗克,以先到者为准).

interp4 :: ((Operation -> (Response, Filesystem)) 
               -> ((Response, Filesystem) -> r) -> r)
           -> (Filesystem -> r)
           -> (String -> Filesystem -> (Filesystem -> r) -> r)
           -> Filesystem
           -> r
interp4 checkInp done out fs = checkInp (\op -> step op fs) test
    where loop = interp4 checkInp done out
          test (Nothing, fs) = done fs
          test (Just s, fs)  = out s fs loop

...哦,我提到它现在有效吗？不,真的!

以下是IO使用该界面的一些代码:

ioIn f k = putStr "> " >> (k . f =<< readLn)
ioDone fs = putStrLn "Done" >> return fs 
ioOut x fs k = putStr x >> k fs

ioInterp :: IO Filesystem
ioInterp = interp4 ioIn ioDone ioOut newFS

这是运行命令列表的代码,生成输出字符串列表:

scriptIn f k (x:xs) = k (f x) xs
scriptDone fs xs = ["Done\n"]
scriptOut r fs k xs = r : k fs xs

scriptInterp :: [Operation] -> [String]
scriptInterp = interp4 scriptIn scriptDone scriptOut newFS

的实例在运行GHCI都在这里,如果只是代码不充分刺激您的想象力.

那就是那个.或者是吗？坦率地说,那个翻译只是一个母亲可以爱的代码.有什么东西能把它们优雅地结合在一起吗？有什么东西可以揭示代码的底层结构？

......好吧,所以这一点非常明显.在圆圈中相互尾调用的函数的整体设计看起来非常像延续传递样式,并且在解释器的类型签名中不是一次而是两次可以找到特征模式(foo -> r) -> r,更好地称为延续monad.

不幸的是,即使在所有这些之后,继续让我的头部受到伤害,而且我不确定如何最好地将解释器的ad-hoc结构解析为运行中的计算MonadCont.

Answer 3

要求您的实例FS是 的实例MonadIO，而不仅仅是Monad：

class MonadIO m => FS m where ...

然后您将可以使用以下liftIO方法进入：FSIO

liftIO :: MonadIO m => m a -> IO a

所以你可以在 monad 中写IO：

files <- liftIO $ children currentDir

当然，这意味着您需要在编写 FS 实例之前实现liftIO 每一个FS，但对于这个应用程序（没有看到实际的细节），听起来应该很简单。