Полезные операции над бесплатными стрелками

Мы знаем, что свободные монады полезны, а пакеты, такие как Operational, позволяют легко определять новые монады, только заботясь о специфических для приложения эффектах, а не о монадических самой структуры.

Мы можем легко определить "свободные стрелки", аналогичные тому, как определяются свободные монады:

{-# 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

но у меня нет теоретических аргументов в пользу того, почему эти (а не другие) были бы полезными.

Ответ 1

Свободный функтор слева сопряжен с забывчивым функтором. Для присоединения вам нужно иметь изоморфизм (естественный в x и y):

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

В какой категории это должно быть? Забывающий функтор забывает экземпляр Arrow, поэтому он переходит из категории экземпляров Arrow в категорию всех бифунтеров. И свободный функтор переходит в другую сторону, превращает любой бифунтер в свободный экземпляр Arrow.

Тип стрелок типа Хеккеля в категории бифунторов:

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 из пакет редукторов.

Изменить: я почти забыл, FreeA должен быть функтором более высокого порядка! Edit2: Который, с другой стороны, также может быть реализован с помощью rightAdjunct и unit.

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

Кстати, существует еще один способ определения свободных функторов, для которого я недавно разместил пакет в Hackage. Он не поддерживает добрый * -> * -> * (Edit: теперь он!), Но код можно адаптировать к свободным стрелкам:

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, вероятно, быстрее.