Proposal: Add Compositor class as superclass of Arrow
Conal Elliott
conal at conal.net
Mon Oct 22 15:18:03 EDT 2007
I'm delighted to see these interfaces being explored. Question: why
separate fan-out (&&&) from pair? Do you know of type constructors that
have fst & snd but not &&&? Similarly for CategoryAssoc. - Conal
On 10/21/07, Twan van Laarhoven <twanvl at gmail.com> wrote:
>
> Ashley Yakeley wrote:
> > 3. There might be another useful class that's a subclass of Category and
> > a superclass of Arrow, that essentially includes first but not arr. If
> > someone wants to name it and define it, we can put it in the class
> > hierarchy.
>
>
> My proposal would be the following. The important things are that:
> 1. It incorporates Conal's deep arrow,
> 2. as well as everything that is needed for functional
> references/lenses and bijective/invertible functions.
> I have chosen to reuse prelude names where possible.
>
>
> class Category cat where
> id :: cat a a
> (.) :: cat b c -> cat a b -> cat a c
>
>
> -- | 'cat' can work with pairs
> class Category cat => CategoryPair cat where
> fst :: cat (a,b) a
> snd :: cat (a,b) b
> swap :: cat (a,b) (b,a)
> first :: cat a b -> cat (a,c) (b,c)
> second :: cat a b -> cat (c,a) (c,b)
> (***) :: cat a b -> cat c d -> cat (a,c) (b,d)
>
> snd = fst . swap
> second f = swap . first f . swap
> f *** g = second g . first f
>
> class CategoryPair cat => CategoryFanOut cat where
> (&&&) :: cat a b -> cat a c -> cat a (b,c)
> dup :: cat a (a,a)
>
> f &&& g = f *** g . dup
>
>
> -- | 'cat' can work with eithers
> -- Dual to CategoryPair
> class Category cat => CategoryChoice cat where
> inl :: cat a (Either a b)
> inr :: cat b (Either a b)
> mirror :: cat (Either a b) (Either b a)
> left :: cat a b -> cat (Either a c) (Either b c)
> right :: cat a b -> cat (Either c a) (Either c b)
> (+++) :: cat a b -> cat c d -> cat (a,c) (b,d)
>
> inr = mirror . inl
> right f = mirror . left f . mirror
> f +++ g = right g . left f
>
> class CategoryChoice cat => CategoryFanIn cat where
> (|||) :: cat a c -> cat b c -> cat (Either a b) c
> untag :: cat (Either a a) a
>
> f ||| g = untag . f +++ g
>
>
> class Category cat => CategoryZero cat where
> zeroCat :: cat a b
>
> class CategoryZero cat => CategoryPlus cat where
> (<+>) :: cat a b -> cat a b -> cat a b
> -- this is what ArrowPlus uses, but perhaps
> -- (///) is a better choice, because it looks more like the others.
>
>
> class CategoryPair cat => CategoryApply cat where
> app :: cat (cat a b, a) b
>
>
> class CategoryPair cat => CategoryLoop cat where
> loop :: cat (a,c) (b,c) -> cat a b
>
> -- no idea how useful this is, but it is nice for symmetry
> class CategoryChoice cat => CategoryCoLoop cat where
> coloop :: cat (Either a c) (Either b c) -> cat a b
>
>
> -- | Categories that can manipulate functions.
> -- This is most of 'DeepArrow'.
> class Category cat => CategoryFun cat where
> result :: cat b c -> cat (a -> b) (a -> c)
> curry :: cat ((a, b) -> c) (a -> b -> c)
> uncurry :: cat (a -> b -> c) ((a, b) -> c)
> funF :: cat (c -> a, b) (c -> (a, b))
> funS :: cat (a, c -> b) (c -> (a, b))
> funR :: cat (a -> c -> b) (c -> a -> b)
>
> -- instances for t = Either and/or t = (,)
> -- If h98 compatability is important, it could be split into two classes
> -- or the functions lrAssocP and lrAssocE (specialized to pair/either)
> -- could be put into CategoryPair and CategoryChoice respectively.
> -- Maybe this should be a super class of those two classes:
> -- class CategoryAssoc cat (,) => CategoryPair cat
> -- class CategoryAssoc cat Either => CategoryChoice cat
> -- Then we also have that rAssocP = swap . lAssocP . swap
> class Category cat => CategoryAssoc cat t where
> lAssoc :: cat (t a (t b c)) (t (t a b) c)
> rAssoc :: cat (t (t a b) c) (t a (t b c))
>
>
> -- | 'cat' contains all invertible functions (bijections)
> class Category cat => InvArrow cat where
> arrInv :: (a -> b) -> (b -> a) -> cat a b
>
> -- | 'cat' contains all functional references
> class InvArrow cat => RefArrow cat where
> arrRef :: (a -> b) -> (b -> a -> a) -> cat a b
>
> -- | 'cat' contains all Haskell functions
> class RefArrow cat => FunArrow cat where
> arr :: (a -> b) -> cat a b
>
>
> -- For backwards compatability:
> -- These should be class aliases
> class (FunArrow cat, CategoryPair cat) => Arrow cat
> class (Arrow cat, CategoryChoice cat) => ArrowChoice cat
> class (Arrow cat, CategoryZero cat) => ArrowZero cat
> class (Arrow cat, CategoryPlus cat) => ArrowPlus cat
> class (Arrow cat, CategoryApply cat) => ArrowApply cat
> class (Arrow cat, CategoryLoop cat) => ArrowLoop cat
>
>
> I would further propose that all classes named Category* go into
> Control.Category, while Arrow* goes into Control.Arrow. The latter can
> re-export the Control.Category module.
>
> And while we are busy messing with the arrows, I think the Kleisli type
> should change, it can be an instance of most of Category* with just
> Functor or Applicative instead of requiring the type to be a Monad.
>
> Twan
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://www.haskell.org/mailman/listinfo/libraries
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/libraries/attachments/20071022/d42d75da/attachment.htm
More information about the Libraries
mailing list