Как создать аппликативный экземпляр с ограничениями (аналогично построению экземпляров Monad с использованием ContT)

Этот вопрос посвящен построению правильного экземпляра Monad из чего-то, что является монадой, но только при определенных ограничениях - например Set. Трюк состоит в том, чтобы обернуть его в ContT, который отбрасывает ограничения на обертку/разворачивание его значений.

Теперь я хотел бы сделать то же самое с Applicative s. В частности, у меня есть экземпляр Applicative, чья чистая имеет ограничение типа-типа. Есть ли аналогичный трюк, как построить действительный экземпляр Applicative?

(Существует ли "мать всех аппликативных функторов" так же, как есть для монады?)

Ответ 1

Какой может быть наиболее последовательный доступный путь, начиная с Category, где вполне естественно иметь ограничение на объекты: Object!

class Category k where
  type Object k :: * -> Constraint
  id :: Object k a => k a a
  (.) :: (Object k a, Object k b, Object k c)
     => k b c -> k a b -> k a c

Затем мы определяем функторы, подобные как это делает Эдвард

class (Category r, Category t) => Functor f r t | f r -> t, f t -> r where
  fmap :: (Object r a, Object t (f a), Object r b, Object t (f b))
             => r a b -> t (f a) (f b)

Все это прекрасно работает и реализовано в библиотеке ограниченных категорий, которая - стыдно за меня! - все еще не находится в Hackage.

Applicative, к сожалению, немного менее прост. Математически это моноидальные функторы, поэтому нам сначала нужно > моноидальные категории. categories имеет этот класс, но он не работает с версией на основе ограничений, потому что наши объекты всегда имеют что-то вроде * с ограничением. Итак, что я сделал, это Curry класс, который приближает это.

Затем мы можем сделать Monoidal functors:

class (Functor f r t, Curry r, Curry t) => Monoidal f r t where
  pure :: (Object r a, Object t (f a)) => a `t` f a
  fzipWith :: (PairObject r a b, Object r c, PairObject t (f a) (f b), Object t (f c))
              => r (a, b) c -> t (f a, f b) (f c)

Это фактически эквивалентно Applicative, когда у нас есть правильные замкнутые декартовы категории. В версии с ограниченными категориями, к сожалению, подписи выглядят очень ужасно:

  (<*>) :: ( Applicative f r t
           , MorphObject r a b, Object r (r a b)
           , MorphObject t (f a) (f b), Object t (t (f a) (f b)), Object t (f (r a b))
           , PairObject r (r a b) a, PairObject t (f (r a b)) (f a)
           , Object r a, Object r b, Object t (f a), Object t (f b))
       => f (r a b) `t` t (f a) (f b)

Тем не менее, это действительно работает - для безусловного случая, duh! Я еще не нашел удобный способ использовать его с нетривиальными ограничениями.

Но опять же, Applicative эквивалентно Monoidal, и это можно использовать, как показано в пример Set.

Ответ 2

Я не уверен, что понятие "ограниченный аппликативный" уникально, поскольку разные презентации не изоморфны. Здесь сказано одно и что-то, по крайней мере, несколько по линии Codensity. Идея состоит в том, чтобы иметь "свободный функтор" вместе с единицей

{-# LANGUAGE TypeFamilies, ConstraintKinds, ExistentialQuantification #-}

import GHC.Prim (Constraint)
import Control.Applicative

class RFunctor f where
  type C f :: * -> Constraint
  rfmap :: C f b => (a -> b) -> f a -> f b

class RFunctor f => RApplicative f where
  rpure :: C f a => a -> f a
  rzip :: f a -> f b -> f (a,b)

data UAp f a
  = Pure  a
  | forall b. Embed (f b) (b -> a)

toUAp :: C f a => f a -> UAp f a
toUAp x = Embed x id

fromUAp :: (RApplicative f, C f a) => UAp f a -> f a
fromUAp (Pure x) = rpure x
fromUAp (Embed x f) = rfmap f x

zipUAp :: RApplicative f => UAp f a -> UAp f b -> UAp f (a,b)
zipUAp (Pure a) (Pure b) = Pure (a,b)
zipUAp (Pure a) (Embed b f) = Embed b (\x -> (a,f x))
zipUAp (Embed a f) (Pure b) = Embed a (\x -> (f x,b))
zipUAp (Embed a f) (Embed b g) = Embed (rzip a b) (\(x,y) -> (f x,g y))

instance Functor (UAp f) where
  fmap f (Pure a) = Pure (f a)
  fmap f (Embed a g) = Embed a (f . g)

instance RApplicative f => Applicative (UAp f) where
  pure = Pure
  af <*> ax = fmap (\(f,x) -> f x) $ zipUAp af ax

EDIT: Исправлены некоторые ошибки. Это то, что происходит, когда вы не компилируете перед публикацией.

Ответ 3

Поскольку каждая Монада - это Functor, вы можете использовать тот же трюк ContT.

pure становится return

fmap f x становится x >>= (return . f)