generics - 自由箭头的有用操作

Question

我们知道免费的单子(monad)很有用，而像 Operational 这样的包通过只关心特定于应用程序的效果，而不是单子(monad)结构本身，可以轻松定义新的单子(monad)。

我们可以很容易地定义“自由箭头”，类似于定义自由单子(monad)的方式:

{-# LANGUAGE GADTs #-}
module FreeA
       ( FreeA, effect
       ) where

import Prelude hiding ((.), id)
import Control.Category
import Control.Arrow
import Control.Applicative
import Data.Monoid

data FreeA eff a b where
    Pure :: (a -> b) -> FreeA eff a b
    Effect :: eff a b -> FreeA eff a b
    Seq :: FreeA eff a b -> FreeA eff b c -> FreeA eff a c
    Par :: FreeA eff a₁ b₁ -> FreeA eff a₂ b₂ -> FreeA eff (a₁, a₂) (b₁, b₂)

effect :: eff a b -> FreeA eff a b
effect = Effect

instance Category (FreeA eff) where
    id = Pure id
    (.) = flip Seq

instance Arrow (FreeA eff) where
    arr = Pure
    first f = Par f id
    second f = Par id f
    (***) = Par

我的问题是，对自由箭头最有用的通用操作是什么？对于我的特定应用程序，我需要这两种情况的特殊情况:

{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
analyze :: forall f eff a₀ b₀ r. (Applicative f, Monoid r)
        => (forall a b. eff a b -> f r)
        -> FreeA eff a₀ b₀ -> f r
analyze visit = go
  where
    go :: forall a b. FreeA eff a b -> f r
    go arr = case arr of
        Pure _ -> pure mempty
        Seq f₁ f₂ -> mappend <$> go f₁ <*> go f₂
        Par f₁ f₂ -> mappend <$> go f₁ <*> go f₂
        Effect eff -> visit eff

evalA :: forall eff arr a₀ b₀. (Arrow arr) => (forall a b. eff a b -> arr a b) -> FreeA eff a₀ b₀ -> arr a₀ b₀
evalA exec = go
  where
    go :: forall a b. FreeA eff a b -> arr a b
    go freeA = case freeA of
        Pure f -> arr f
        Seq f₁ f₂ -> go f₂ . go f₁
        Par f₁ f₂ -> go f₁ *** go f₂
        Effect eff -> exec eff

但是对于为什么这些(而不是其他)有用的，我没有任何理论论据。

Answer 1

一个自由仿函数与一个健忘仿函数相伴。对于附加词，您需要具有同构(自然在 x 和 y 中):

(Free y :~> x) <-> (y :~> Forget x)

这应该属于什么类别？健忘仿函数忘记了 Arrow例如，所以它来自 Arrow 的类别所有双仿函数类别的实例。而自由仿函数则相反，它将任何双仿函数变成自由的 Arrow实例。
双仿函数类别中的 haskell 箭头类型是:

type x :~> y = forall a b. x a b -> y a b

Arrow 类别中的箭头也是如此。实例，但添加了 Arrow约束。由于健忘仿函数只忘记约束，我们不需要在 Haskell 中表示它。这将上述同构变成了两个函数:

leftAdjunct :: (FreeA x :~> y) -> x :~> y
rightAdjunct :: Arrow y => (x :~> y) -> FreeA x :~> y

leftAdjunct还应该有 Arrow y约束，但事实证明在实现中从来不需要它。就更有用的 unit 而言，实际上有一个非常简单的实现。 :

unit :: x :~> FreeA x

leftAdjunct f = f . unit

unit是你的 effect和 rightAdjunct是你的 evalA .所以你完全有附件所需的功能!您需要证明 leftAdjunct和 rightAdjunct是同构的。最简单的方法是证明 rightAdjunct unit = id , 在你的情况下 evalA effect = id ，这很简单。 analyze 呢？ ?那是 evalA专门用于常量箭头，结果为 Monoid专用于应用幺半群的约束。 IE。

analyze visit = getApp . getConstArr . evalA (ConstArr . Ap . visit)

和

newtype ConstArr m a b = ConstArr { getConstArr :: m }

和 Ap来自 the reducers package . (编辑:从 GHC 8.6 开始，它也在 Data.Monoid 中)
编辑:我差点忘了，FreeA 应该是高阶仿函数! Edit2:再想一想，也可以用 rightAdjunct 来实现和 unit .

hfmap :: (x :~> y) -> FreeA x :~> FreeA y
hfmap f = evalA (effect . f)

顺便说一句:还有另一种定义自由仿函数的方法，我为此设置了 package on Hackage最近。不支持种类 * -> * -> * (编辑:现在可以了!)，但代码可以适应自由箭头:

newtype FreeA eff a b = FreeA { runFreeA :: forall arr. Arrow arr => (eff :~> arr) -> arr a b }
evalA f a = runFreeA a f
effect a = FreeA $ \k -> k a

instance Category (FreeA f) where
  id = FreeA $ const id
  FreeA f . FreeA g = FreeA $ \k -> f k . g k

instance Arrow (FreeA f) where
  arr f = FreeA $ const (arr f)
  first (FreeA f) = FreeA $ \k -> first (f k)
  second (FreeA f) = FreeA $ \k -> second (f k)
  FreeA f *** FreeA g = FreeA $ \k -> f k *** g k
  FreeA f &&& FreeA g = FreeA $ \k -> f k &&& g k

如果你不需要内省(introspection)你的 FreeA提供，这个 FreeA可能更快。