Haskell 免费单子是否也能快速应用？

我想我已经为您提供了一个有趣的“zippy”

Applicative

示例

我以前没见过有人提到过这个例子。它是否违反了任何适用的法律？（当然，它不符合通常的

Monad

实例，即“substitutey”而不是“zippy”。

来自：

如果

f

也是一个

Monad

，它应该满足

• pure

  =

  return

• （）

  =

  ap

• （*>）

  =

  （>>）

因此，此实现将打破应用程序规则，即它必须与

Monad

实例一致

也就是说，没有理由不为

FreeMonad

提供一个没有monad实例但有上述应用程序实例的新类型包装器

newtype Zip f a=Zip{runZip:：FreeMonad f a}
派生函子
实例Applicative f=>Applicative（Zip f），其中--。。。

是，看起来这是合法的

应用程序

。奇怪

如图所示，您可以立即从定义中读取恒等式、同态和交换定律。唯一棘手的是构图法则

pure (.) <*> u <*> v <*> w = u <*> (v <*> w)

pure（.）Return f Return g Free w

• 立即减少到

  fmap（f.g）（自由w）

  ，因此遵循函子定律

三个案例，其中一个

返回

：

• 在归纳假设下，我使用了各种函子和应用定律

  ---

  证明这一点很有趣！我希望看到Coq或Agda中的正式证明（尽管我怀疑终止/正性检查程序可能会把它搞糟）。
  为了完整性，我将使用此答案展开：

  ---

  虽然我并没有写下证据，但我相信，由于参数的原因，和解法中的自由和返还混合案例必须成立。我还怀疑这应该更容易显示使用
  这里的

  应用程序

  实例的单向表示是：

  unit = Return ()
  
  Return x *&* v = (x,) <$> v
  u *&* Return y = (,y) <$> u
  -- I will also piggyback on the `Compose` applicative, as suggested above.
  Free u *&* Free v = Free (getCompose (Compose u *&* Compose v))
  

  现在让我们考虑一个混合案例；比如说，

  免费

  -

  返回

  -

  免费

  一个：

  (Free fu *&* Return y) *&* Free fw ~ Free fu *&* (Return y *&* Free fw)
  
  (Free fu *&* Return y) *&* Free fw -- LHS
  ((,y) <$> Free fu) *&* Free fw
  
  Free fu *&* (Return y *&* Free fw) -- RHS
  Free fu *&* ((y,) <$> Free fw)
  

  类似地，右侧变为：

  second (y,) <$> (Free fu *&* Free fw)
  

  ---

  其他混合情况也可作类似处理。至于其余的证明，请参见。
  当然，现在让我们先忘掉

  Monad

  。

  Applicative

  实例本身合法吗？当然，它看起来应该满足我的要求，但使用等式推理写出证明可能是一个很好的检查。证明恒等式、同态和交换定律都成立并不重要。构图法更为严格。在把它分成几个案例之后，看起来最难的部分将是证明

  liftA2（）（Free$liftA2（）（fmap（.）fu）fv）fw=liftA2（）fu（liftA2（）fv fw）

  ，其中

  fu

  、

  fv

  和

  fw

  都是

  Applicative f=>f（FreeMonad f a）类型

  @JosephSible我一直在考虑这个问题。由于
  的

  自由

  /

  自由

  情况的RHS与

  组合

  的RHS相同，组合法则的

  自由

  /

  自由

  情况直接来自于

  组合

  实例的正确性（以及归纳假设）。如果有错误，我想应该是当一个或多个值是一个

  返回值时。虽然我没有写下证据，但我相信由于参数性，合成法则的混合-
  自由-
  和-
  返回值必须成立。我还怀疑使用@duplode应该更容易显示。@duplode在我看来，Parametericity说，
  返回
  案例只有一种类型正确的实现（即映射到另一棵树上），但这并不一定意味着它是合法的。除非有自由定理？
  pure (.) <*> Return f <*> Free v <*> Free w
  Free $ fmap (<*>) (fmap (fmap (f.)) v) <*> w
  Free $ fmap (\y z -> fmap (f.) y <*> z) v <*> w                  -- functor law
  Free $ fmap (\y z -> fmap (.) <*> Return f <*> y <*> z) v <*> w  -- definition of fmap, twice
  Free $ fmap (\y z -> Return f <*> (y <*> z)) v <*> w             -- composition
  Free $ fmap (\y z -> fmap f (y <*> z)) v <*> w                   -- RHS of fmap, definition of liftA2
  Free $ fmap (fmap f) $ fmap (<*>) v <*> w                        -- functor law, eta reduce
  fmap f $ Free $ liftA2 (<*>) v w                                 -- RHS of fmap
  Return f <*> Free v <*> Free w                                   -- RHS of <*>
  QED.
  
  pure (.) <*> Free u <*> Return g <*> Free w
  Free ((fmap (fmap ($g))) (fmap (fmap (.)) u)) <*> Free w
  Free (fmap (fmap (\f -> f . g) u)) <*> Free w                    -- functor law, twice
  Free $ fmap (<*>) (fmap (fmap (\f -> f . g)) u) <*> w
  Free $ fmap (\x z -> fmap (\f -> f . g) x <*> z) u <*> w         -- functor law
  Free $ fmap (\x z -> pure (.) <*> x <*> Return g <*> z) u <*> w
  Free $ fmap (\x z -> x <*> (Return g <*> z)) u <*> w             -- composition
  Free $ fmap (<*>) u <*> fmap (Return g <*>) w                    -- https://gist.github.com/benjamin-hodgson/5b36259986055d32adea56d0a7fa688f
  Free u <*> fmap g w                                              -- RHS of <*> and fmap
  Free u <*> (Return g <*> w)
  QED.
  
  pure (.) <*> Free u <*> Free v <*> Return z
  Free (fmap (<*>) (fmap (fmap (.)) u) <*> v) <*> Return z
  Free (fmap (\x y -> fmap (.) x <*> y) u <*> v) <*> Return z        -- functor law
  Free $ fmap (fmap ($z)) (fmap (\x y -> fmap (.) x <*> y) u <*> v)
  Free $ liftA2 (\x y -> (fmap ($z)) (fmap (.) x <*> y)) u v         -- see Lemma, with f = fmap ($z) and g x y = fmap (.) x <*> y
  Free $ liftA2 (\x y -> fmap (.) x <*> y <*> Return z) u v          -- interchange
  Free $ liftA2 (\x y -> x <*> (y <*> Return z)) u v                 -- composition
  Free $ liftA2 (\f g -> f <*> fmap ($z) g) u v                      -- interchange
  Free $ fmap (<*>) u <*> (fmap (fmap ($z)) v)                       -- https://gist.github.com/benjamin-hodgson/5b36259986055d32adea56d0a7fa688f
  Free u <*> Free (fmap (fmap ($z)) v)
  Free u <*> (Free v <*> Return z)
  QED.
  
  fmap f (fmap g u <*> v)
  pure (.) <*> pure f <*> fmap g u <*> v  -- composition
  fmap (f .) (fmap g u) <*> v             -- homomorphism
  fmap ((f .) . g) u <*> v                -- functor law
  liftA2 (\x y -> f (g x y)) u v          -- eta expand
  QED.
  
  unit = Return ()
  
  Return x *&* v = (x,) <$> v
  u *&* Return y = (,y) <$> u
  -- I will also piggyback on the `Compose` applicative, as suggested above.
  Free u *&* Free v = Free (getCompose (Compose u *&* Compose v))
  
  (u *&* v) *&* w ~ u *&* (v *&* w)
  
  (Free fu *&* Return y) *&* Free fw ~ Free fu *&* (Return y *&* Free fw)
  
  (Free fu *&* Return y) *&* Free fw -- LHS
  ((,y) <$> Free fu) *&* Free fw
  
  Free fu *&* (Return y *&* Free fw) -- RHS
  Free fu *&* ((y,) <$> Free fw)
  
  first (,y) <$> (Free fu *&* Free fw)
  
  second (y,) <$> (Free fu *&* Free fw)
  
  first (,y) <$> (Free fu *&* Free fw) ~ second (y,) <$> (Free fu *&* Free fw)
  -- LHS ~ RHS