generics - Operaciones útiles en flechas libres

haskell arrows

Question

Sabemos que las mónadas libres son útiles, y paquetes como Operational facilitan la definición de nuevas mónadas al preocuparse solo por los efectos específicos de la aplicación, no por la estructura monádica en sí misma.

Podemos definir fácilmente "flechas libres" análogas a cómo se definen las mónadas libres:

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

Mi pregunta es, ¿cuáles serían las operaciones genéricas más útiles en las flechas libres? Para mi aplicación particular, necesitaba casos especiales de estos dos:

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

pero no tengo ningún argumento teórico sobre por qué estos (y no otros) serían los útiles.

Answer 1

Un functor gratuito se deja adjunto a un functor olvidadizo. Para la adjunción necesitas tener el isomorfismo (natural en y ):

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

¿En qué categoría debería ser esto? El functor olvidadizo olvida la instancia de Arrow , por lo que pasa de la categoría de instancias de Arrow a la categoría de todos los bifunctores. Y el functor libre va en dirección opuesta, convierte cualquier bifunctor en una instancia libre de Arrow .

El tipo de flechas de haskell en la categoría de bifuncionantes es:

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

Es lo mismo para las flechas en la categoría de instancias de Arrow , pero con la adición de restricciones de Arrow . Como el functor olvidadizo solo olvida la restricción, no es necesario que lo representemos en Haskell. Esto convierte el isomorfismo anterior en dos funciones:

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

leftAdjunct también debería tener una restricción Arrow y , pero resulta que nunca es necesaria en la implementación. De hecho, hay una implementación muy simple en términos de la unit más útil:

unit :: x :~> FreeA x

leftAdjunct f = f . unit

unit es tu effect y rightAdjunct es tu evalA . ¡Así que tienes exactamente las funciones necesarias para la adjunción! leftAdjunct mostrar que leftAdjunct y rightAdjunct son isomorfos. La forma más fácil de hacerlo es probar que rightAdjunct unit = id , en su caso evalA effect = id , que es sencillo.

¿Qué hay de analyze ? Eso es evalA especializado para la flecha constante, con la restricción de Monoid resultante especializada para el monoide aplicativo. Es decir

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

con

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

y Ap del paquete de reductores .

Editar: ¡Casi lo olvido, FreeA debería ser un functor de orden superior! Edit2: Lo cual, pensándolo bien, también se puede implementar con rightAdjunct y unit .

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

Por cierto: hay otra manera de definir funtores gratuitos, para lo cual puse un paquete recientemente en Hackage . No admite kind * -> * -> * (Edit: it now now!), Pero el código se puede adaptar a flechas gratuitas:

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

Si no necesita la introspección que ofrece su FreeA , este FreeA es probablemente más rápido.