自由箭头的有用操作

Question

我们知道免费的 monad 很有用，像 Operational 这样的包可以通过只关心特定于应用程序的效果而不是 monadic 结构本身来轻松定义新的 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

约束专用于应用幺半群。即

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

与

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

和

Ap

来自减速器包。 （编辑：自 GHC 8.6 以来，它也位于

Data.Monoid

的基础中）

编辑：我差点忘了，FreeA 应该是一个高阶函子！ Edit2：再想一想，也可以用

rightAdjunct

和

unit

来实现。

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

顺便说一句：还有另一种方法来定义自由函子，我最近在 Hackage 上放了一个包。它不支持 kind * -> * -> *

（编辑：现在支持！），但代码可以适应自由箭头：

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

如果您不需要

FreeA

 提供的内省，这个 

FreeA

 可能会更快。