Question

如果可以为以下情况编写抽象，我试图解决问题。假设我有一个a类型，其函数为a -> m Bool，例如MVar Bool和readMVar。为了抽象出这个概念，我为类型及其函数创建了一个newtype包装器：

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将打印＆＃34; foo＆＃34;。 旁白：我不确定类型类是否更适合使用而不是新类型。

现在使用下面的代码，它输出一个递增的数字，然后等待一秒钟并重复。这样做直到它收到＆＃34;关闭＆＃34;通过MVar进行指导。

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'的使用）。< / p>

我还希望进一步采用这种抽象，以便它可以在Monad周围进行线程化。有状态的Monads变得更加困难。 E.g。

-- 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的一个循环中运行但执行相当不同的异步任务。在每一篇文章中，我都编写了一个执行适当循环的自定义函数。

我试图学习“不要写大型课程”＃34;做法。我想要做的是将代码块重构到他们自己的迷你库中，这样我就不会构建一个大型程序，而是组装许多小程序。但到目前为止，这种特殊的抽象正在逃避我。

非常感谢任何关于我如何做到这一点的想法！

Answer 1

您希望干净地结合具有副作用，延迟和独立停止条件的有状态动作。

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

这个monad变换器允许您将（可能是无限的）计算描述为一系列离散步骤。更好的是，它让你使用mplus交错“步进”计算。当任何单个计算停止时，组合计算停止。

一些初步进口：

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

您的foobar功能可以被理解为三件事的“总和”：

除了在每个步骤中从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)

关于这一点的好处是你可以很容易地改变或消除“停止条件”和延迟。

一些澄清：

delay函数不是IO中的延迟，它只是告诉迭代monad变换器“将参数放在一个单独的步骤中”。
retract将您从迭代monad变换器带回基本monad。这就像说“我不关心步骤，只是运行计算”。如果要限制最大迭代次数，可以将retract与cutoff合并。
untilJust通过在每个步骤中重试，将基本monad的值m (Maybe a)转换为IterT m a，直到返回Just为止。当然，这有可能不会终止！

Answer 2

MPredicate在这里是多余的;可以使用m Bool代替。 monad-loops包中包含大量具有m Bool条件的控制结构。 whileM_特别适用于此处，但我们需要为我们正在线索的State添加Int 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

在monadic环境中，它更方便，更模块化，因为我们总是可以从纯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;有时人们确实将它用于特殊的monadic循环，例如：

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

我不确定你MPredicate正在做什么。首先，不是对元组进行newtyping，而是使用普通的代数数据类型可能更好

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

其次，您使用它的方式，MPredicate相当于m Bool。 Haskell是lazzy，因此没有必要传递，函数和它的参数（即使它对严格的语言很有用）。只需传递结果，就可以在需要时调用该函数。

我的意思是，不要传递(x, f)，而是传递f x 当然，如果你没有试图延迟评估并且在某些时候确实需要，参数或函数以及结果，那么元组就可以了。

无论如何，如果您的MPredicate仅用于延迟功能评估，MPredicat会缩减为m Bool，doUnless会缩短为unless。

你的第一个例子完全等同于：

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

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

使用“除非”进行monadic递归的抽象

3 个答案: