"unless" 的单子递归抽象

Question

我正在尝试确定是否可以为以下情况编写抽象。假设我有一个类型 a 和函数 a -> m Bool 例如MVar Bool 和 readMVar。为了抽象出这个概念，我为类型及其函数创建了一个新类型包装器：

newtype MPredicate m a = MPredicate (a,a -> m Bool)

我可以像这样定义一个相当简单的操作：

doUnless :: (Monad m) => Predicate m a -> m () -> m ()
doUnless (MPredicate (a,mg)) g = mg a >>= \b -> unless b g

main = do
   b <- newMVar False
   let mpred = MPredicate (b,readMVar)
   doUnless mpred (print "foo")

在这种情况下 doUnless 将打印 "foo"。 旁白：我不确定 class 类型是否比新类型更合适。

现在看下面的代码，它输出一个递增的数字然后等待一秒钟并重复。它会一直这样做，直到它通过 MVar 接收到 "turn off" 指令。

foobar :: MVar Bool -> IO ()
foobar mvb = foobar' 0
    where
        foobar' :: Int -> IO ()
        foobar' x = readMVar mvb >>= \b -> unless b $ do
            let x' = x + 1
            print x'
            threadDelay 1000000
            foobar' x'

goTillEnter :: MVar Bool -> IO ()
goTillEnter mv = do
    _ <- getLine
    _ <- takeMVar mv
    putMVar mv True

main = do
   mvb <- newMVar False
   forkIO $ foobar mvb
   goTillEnter mvb

是否可以重构 foobar 以便它使用 MPredicate 和 doUnless？

忽略 foobar' 的实际实现我可以想到一个简单的方法来做类似的事情：

cycleUnless :: x -> (x -> x) -> MPredicate m a -> m ()
cycleUnless x g mp = let g' x' = doUnless mp (g' $ g x')
                     in  g' $ g x

旁白：我觉得 fix 可以用来使上面的内容更整洁，尽管我仍然不知道如何使用它

但是 cycleUnless 对 foobar 不起作用，因为 foobar' 的类型实际上是 Int -> IO ()（来自 print x' 的使用）。

我还想进一步进行这种抽象，以便它可以围绕 Monad 进行线程化。对于有状态的 Monad，它变得更加困难。例如

-- EDIT: Updated the below to show an example of how the code is used
{- ^^ some parent function which has the MVar ^^ -}
cycleST :: (forall s. ST s (STArray s Int Int)) -> IO ()
cycleST sta = readMVar mvb >>= \b -> unless b $ do
    n <- readMVar someMVar
    i <- readMVar someOtherMVar
    let sta' = do
            arr <- sta
            x <- readArray arr n
            writeArray arr n (x + i)
            return arr
        y = runSTArray sta'
    print y
    cycleST sta'

我有与上述类似的使用 RankNTypes 的东西。现在还有一个额外的问题，那就是尝试线程化存在 s，如果像 cycleUnless 这样的抽象线程化，则不太可能进行类型检查。

此外，为了使问题更容易回答，这被简化了。我还使用了一组从 MVar [MVar ()] 构建的信号量，类似于 the MVar module 中的跳过通道示例。如果我能解决上述问题，我也打算将信号量泛化。

最终这不是什么阻塞问题。我有 3 个应用程序组件在同一个 MVar Bool 周期内运行，但执行完全不同的异步任务。在每一个中，我都编写了一个执行适当循环的自定义函数。

我正在尝试学习 "don't write large programs" 方法。我想做的是将代码块重构到它们自己的迷你库中，这样我就不会构建大型程序，而是组装许多小程序。但到目前为止，这种特殊的抽象正在逃避我。

非常感谢任何关于我如何解决这个问题的想法！

Answer 1

我不确定你的 MPredicate 在做什么。首先，与其对元组进行新类型化，不如使用普通代数数据类型

data MPredicate a m = MPredicate a (a -> m Bool)

其次，你的使用方式，MPredicate等同于m Bool。 Haskell 是懒惰的，因此不需要传递函数及其参数（即使它对严格的语言很有用）。传递结果即可，函数会在需要的时候调用

我的意思是，不是传递 (x, f)，而是传递 f x 当然，如果您不想延迟求值并且在某些时候确实需要参数或函数以及结果，元组就可以了。

无论如何，如果您的 MPredicate 只是为了延迟函数计算，MPredicat 会减少到 m Bool，doUnless 会减少到 unless。

你的第一个例子是严格等价的：

main = do
   b <- newMVar False
   unless (readMVar b) (print "foo")

现在，如果你想循环一个 monad 直到达到（或等效）条件，你应该看看 monad-loop 包。您正在查看的内容可能是 untilM_ 或等效内容。

Answer 2

MPredicate 在这里是多余的； m Bool 可以改用。 monad-loops 包包含大量带有 m Bool 条件的控制结构。 whileM_ 在这里尤其适用，尽管我们需要为我们正在处理的 Int 包含一个 State monad：

import Control.Monad.State
import Control.Monad.Loops
import Control.Applicative

foobar :: MVar Bool -> IO ()
foobar mvb = (`evalStateT` (0 :: Int)) $ 
  whileM_ (not <$> lift (readMVar mvb)) $ do
    modify (+1) 
    lift . print =<< get    
    lift $ threadDelay 1000000

或者，我们可以使用 unless 的 monadic 版本。由于某些原因monad-loops没有导出这样的函数，所以我们写一下：

unlessM :: Monad m => m Bool -> m () -> m ()
unlessM mb action = do
  b <- mb
  unless b action

它在一元设置中更方便也更模块化，因为我们总是可以从纯 Bool 到 m Bool，但反之则不行。

foobar :: MVar Bool -> IO ()
foobar mvb = go 0
    where
        go :: Int -> IO ()
        go x = unlessM (readMVar mvb) $ do 
            let x' = x + 1
            print x'
            threadDelay 1000000
            go x'

你提到了fix；有时人们确实将它用于临时单子循环，例如：

printUntil0 :: IO ()
printUntil0 = 
  putStrLn "hello"

  fix $ \loop -> do
    n <- fmap read getLine :: IO Int
    print n
    when (n /= 0) loop

  putStrLn "bye"

通过一些杂耍，可以将 fix 与多参数函数一起使用。在foobar的情况下：

foobar :: MVar Bool -> IO ()
foobar mvb = ($(0 :: Int)) $ fix $ \loop x -> do
    unlessM (readMVar mvb) $ do
      let x' = x + 1
      print x'
      threadDelay 1000000
      loop x'

Answer 3

您想干净地组合具有副作用、延迟和独立停止条件的有状态操作。

free 包中的 iterative monad transformer 在这些情况下很有用。

这个 monad 转换器可以让您将（可能是无休止的）计算描述为一系列离散的步骤。更好的是，它让您可以使用 mplus 交错 "stepped" 计算。当任何一个单独的计算停止时，组合计算也停止。

一些初步导入：

import Data.Bool
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Iter (delay,untilJust,IterT,retract,cutoff)
import Control.Concurrent

您的 foobar 函数可以理解为 "sum" 三件事：

一个计算，除了在每一步从 MVar 中读取外什么都不做，并在 Mvar 为 True 时完成。

untilTrue :: (MonadIO m) => MVar Bool -> IterT m ()  
untilTrue = untilJust . liftM guard . liftIO . readMVar

每一步都有延迟的无限计算。

delays :: (MonadIO m) => Int -> IterT m a
delays = forever . delay . liftIO . threadDelay

打印递增数字序列的无限计算。

foobar' :: (MonadIO m) => Int -> IterT m a 
foobar' x = do
    let x' = x + 1
    liftIO (print x')
    delay (foobar' x')

有了这个，我们可以把 foobar 写成：

foobar :: (MonadIO m) => MVar Bool -> m ()
foobar v =  retract (delays 1000000 `mplus` untilTrue v `mplus` foobar' 0)

关于此的巧妙之处在于您可以非常轻松地更改或删除 "stopping condition" 和延迟。

一些说明：

delay函数不是IO延迟，它只是告诉迭代monad transformer去"put the argument in a separate step".
retract 将您从迭代 monad 转换器带回到基本 monad。这就像说 "I don't care about the steps, just run the computation"。如果要限制最大迭代次数，可以将 retract 与 cutoff 结合使用。
untilJust 通过在每个步骤中重试直到返回 Just 将基本 monad 的值 m (Maybe a) 转换为 IterT m a。当然，这有无法终止的风险！

"unless" 的单子递归抽象

Abstraction for monadic recursion with "unless"

monads

haskell