自由箭头的有用操作

Question

我们知道免费的monad是有用的,像Operational这样的包可以很容易地定义新的monad,只关注特定于应用程序的效果,而不是monadic结构本身.

我们可以很容易地定义"自由箭头",类似于如何定义自由单子:

{-# 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实例类别变为所有bifunctors的类别.而另一种方式是自由仿函数,它将任何bifunctor变成一个自由的Arrow实例.

bifunctors类别中的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从Redurs包中.

编辑:我差点忘了,FreeA应该是一个更高阶的函子!编辑2:第二个想法,也可以用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可能会更快.