我想在 haskell 中构建一个不确定的 monad 转换器，我相信它的行为与 ListT 和http://www.haskell.org/haskellwiki/ListT_done_right提出的替代 ListT 不同。其中第一个将 monad 与项目列表相关联；第二个将 monad 与单个项目相关联，但具有给定元素中的 monadic 动作影响列表后续槽中的 monadic 元素的属性。目标是建立一个单子变压器的形式
data Amb m a = Cons (m a) (Amb m a) | Empty
这样列表中的每个元素都有自己的 monad 与之关联，并且连续的元素具有独立的 monad。在这篇文章的最后，我稍微演示了这个 monad 应该给出的那种行为。如果您知道如何获得 ListT 的一些变体来提供这种行为，那也会很有帮助。
下面是我的尝试。它不完整，因为unpack函数未定义。我该如何定义它？这是定义它的一次不完整的尝试，但它没有处理 monad m 包含EmptyAmb 列表的情况：
unpack :: (Monad m) => m (Amb m a) -> Amb m a
unpack m = let first = join $ do (Cons x ys) <- m
return x
rest = do (Cons x ys) <- m
return ys
in Cons first (unpack rest)
完整（不完整）代码：
import Prelude hiding (map, concat)
import Control.Monad
import Control.Monad.Trans
data Amb m a = Cons (m a) (Amb m a) | Empty
infixr 4 <:>
(<:>) = Cons
map :: Monad m => (a -> b) -> Amb m a -> Amb m b
map f (Cons m xs) = Cons y (map f xs)
where y = do a <- m
return $ f a
map f Empty = Empty
unpack :: m (Amb m a) -> Amb m a
unpack m = undefined
concat :: (Monad m) => Amb m (Amb m a) -> Amb m a
concat (Cons m xs) = (unpack m) `mplus` (concat xs)
concat Empty = Empty
instance Monad m => Monad (Amb m) where
return x = Cons (return x) Empty
xs >>= f = let yss = map f xs
in concat yss
instance Monad m => MonadPlus (Amb m) where
mzero = Empty
(Cons m xs) `mplus` ys = Cons m (xs `mplus` ys)
Empty `mplus` ys = ys
instance MonadTrans Amb where
lift m = Cons m Empty
期望行为示例
在这里，基本单子是State Int
instance Show a => Show (Amb (State Int) a) where
show m = (show . toList) m
toList :: Amb (State Int) a -> [a]
toList Empty = []
toList (n `Cons` xs) = (runState n 0 : toList xs)
x = (list $ incr) >> (incr <:> incr <:> Empty)
y = (list $ incr) >> (incr <:> (incr >> incr) <:> Empty)
main = do
putStr $ show x -- | should be [2, 2]
putStr $ show y -- | should be [2, 3]
谢谢。
更新：为什么 LogicT 不做我想做的事的一个例子。
这是 LogicT 在上面的简单示例中所做的：
import Control.Monad
import Control.Monad.Logic
import Control.Monad.State
type LogicState = LogicT (State Int)
incr :: State Int Int
incr = do i <- get
put (i + 1)
i' <- get
return i'
incr' = lift incr
y = incr' >> (incr' `mplus` incr')
main = do
putStrLn $ show (fst $ runState (observeAllT y) 0) -- | returns [2,3], not [2,2]