这是一个有效的 monad 实例吗？

Question

这是我的类型，它是建议的 monad 实例。

newtype Inf m a = Inf { getInf :: m (a, Inf m a) }

instance (Monad m, Alternative m) => Monad (Inf m) where
    return a = Inf (pure (a, Inf empty))
    m >>= f = Inf $ do
        (st1, inf1) <- getInf m
        go (Left st1) inf1
        where
        go newStateOrInf inf1 = do
            let inf2 = case newStateOrInf of
                    Left st1 -> f st1
                    Right inf2 -> inf2
            res <- Left <$> getInf inf1 <|> Right <$> getInf inf2
            case res of
                Left (st1', inf1') -> go (Left st1') inf1'
                Right (st2, inf2') -> pure (st2, Inf (go (Right inf2') inf1))

我想知道这是否是一个有效的 monad 实例。我有点证明了前两个定律（如果你眯着眼睛），但我在结合性方面遇到了问题，如果有人想试一试的话。

Inf 类型的想法偶尔会产生新的 a 和新的 Inf 延续。然后，使用 >>=，您可以构造一个新的 Inf，它取决于第一个的结果。在这种情况下，每当第一个 Inf 产生一个新值（Left 结果）时，第二个 Inf 就会重新生成。但是当第二个 Inf 产生一个新值时，只有它被更新，而不是第一个

Answer 1

快查一下，结合律的反例很快就出现了Inf []。

我也试过 Inf Maybe 并且我试过的几千次测试都通过了。
正确的恒等式法则(u >>= pure) = u对于Inf []和Inf Maybe也是失败的。

反例

通过一些手动格式粘贴 QuickCheck 的输出，定律 ((u >>= k) >>= h) = (u >>= \x -> k x >>= h) 失败：

u = Inf {getInf = [(0,Inf {getInf = [(0,Inf {getInf = []})]})]}
k = \case
  0 -> Inf {getInf = [(0,Inf {getInf = []})]}
  _ -> Inf {getInf = []}
h = \case
  0 -> Inf {getInf = [(0,Inf {getInf = []})]}
  _ -> Inf {getInf = []}

等式两边的计算结果为：

(u >>= k) >>= h
=
Inf {getInf = [(0,Inf {getInf = []}),(0,Inf {getInf = []}),(0,Inf {getInf = [(0,Inf {getInf = []})]})]}
/=
Inf {getInf = [(0,Inf {getInf = []}),(0,Inf {getInf = [(0,Inf {getInf = []})]})]}
=
u >>= \x -> k x >>= h

代码

完整实施如下。我只需要添加几行代码：

Functor 和 Applicative 个实例，Monad
Eq 和 Show，用于 QuickCheck（如果您明确提供正确的上下文，则可推导）
Arbitrary（必须稍微调整一下以获得合理大小的示例，还必须将大小参数减小到非常小的值 (5)，因为这大致是生成的分支因子Inf [] 树，所以很容易炸毁）
作为可测试函数的法则（这里我们只需要用 Eq 和 Show 的 monad 进行测试以找到反例，这需要用更高级的 monad 来改变）

{-# LANGUAGE DeriveFunctor, StandaloneDeriving, FlexibleContexts, ScopedTypeVariables, TypeApplications, GeneralizedNewtypeDeriving, DerivingStrategies, UndecidableInstances #-}

import Control.Monad
import Control.Applicative
import Test.QuickCheck

newtype Inf m a = Inf { getInf :: m (a, Inf m a) }
  deriving Functor

deriving stock instance (Eq a, Eq (Inf m a)) => Eq (m (a, Inf m a))) => Eq (Inf m a)
deriving stock instance (Show a, Show (Inf m a)) => Show (m (a, Inf m a))) => Show (Inf m a)

instance (Monad m, Alternative m) => Applicative (Inf m) where
  (<*>) = ap
  pure = return

instance (Monad m, Alternative m) => Monad (Inf m) where
    return a = Inf (pure (a, Inf empty))
    m >>= f = Inf $ do
        (st1, inf1) <- getInf m
        go (Left st1) inf1
        where
        go newStateOrInf inf1 = do
            let inf2 = case newStateOrInf of
                    Left st1 -> f st1
                    Right inf2 -> inf2
            res <- Left <$> getInf inf1 <|> Right <$> getInf inf2
            case res of
                Left (st1', inf1') -> go (Left st1') inf1'
                Right (st2, inf2') -> pure (st2, Inf (go (Right inf2') inf1))

instance (Arbitrary a, Alternative m, Arbitrary (Inf m a)) => Arbitrary (m (a, Inf m a))) => Arbitrary (Inf m a) where
  arbitrary = Inf <$> oneof
    [ pure empty
    , arbitrary
    ]
  shrink (Inf xs) = Inf <$> shrink xs

assoc :: forall m a b c. (Monad m, Eq (m c), Show (m c)) => m a -> Fun a (m b) -> Fun b (m c) -> Property
assoc u (Fn k) (Fn h) = (u >>= k >>= h) === (u >>= \x -> k x >>= h)

leftId :: forall m a b. (Monad m, Eq (m b), Show (m b)) => a -> Fun a (m b) -> Property
leftId x (Fn k) = (pure x >>= k) === k x

rightId :: forall m a. (Monad m, Eq (m a), Show (m a)) => m a -> Property
rightId u = u === (u >>= pure)

main :: IO ()
main = do
  quickCheckWith stdArgs{maxSuccess=100000} (leftId @(Inf Maybe) @Int @Int)
  quickCheckWith stdArgs{maxSize=5}         (leftId @(Inf []) @Int @Int)
  quickCheckWith stdArgs{maxSuccess=100000} (rightId @(Inf Maybe) @Int)
  quickCheckWith stdArgs{maxSize=5}         (rightId @(Inf []) @Int)
  quickCheckWith stdArgs{maxSuccess=100000} (assoc @(Inf Maybe) @Int @Int @Int)
  quickCheckWith stdArgs{maxSize=5}         (assoc @(Inf []) @Int @Int @Int)

这是一个有效的 monad 实例吗？

Is this a valid monad instance?

monads

haskell

反例

代码