Proposal: refactor Arrow class
Twan van Laarhoven
twanvl at gmail.com
Mon Jul 16 18:14:05 CEST 2012
On 15/07/12 19:22, Ross Paterson wrote:
> I propose to refactor the Arrow class, so that GHC's arrow notation can
> be a bit more general. (The module Control.Arrow itself would remain
> standard Haskell.)
When we start refactoring the Arrow class, might I humbly request that the
`first` function and its friends be moved to a separate class that doesn't need
`arr` or `premap`, but rather `arrIso`:
class (Category a) => IsoArrow where
arrIso :: Iso (->) b c -> a b c
-- Laws:
-- arrIso id = id
-- arrIso f . arrIso g = arrIso (f . g)
data Iso a b c = Iso { fw :: a b c, bw :: a c b }
instance Category a => Category (Iso a) where ...
Then the Arrow classes would be:
class (ProductCategory a, PreArrow a) => Arrow a where
...
-- a symmetric monoidal category,
-- with (,) as product and () as identity
class IsoArrow a => ProductCategory a where
(***) :: a b c -> a d e -> a (b,d) (c,e)
first :: a b c -> a (b,d) (c,d)
second :: a c d -> a (b,c) (b,d)
swap :: a (b,c) (c,b)
swap = arrIso (Iso swap swap)
-- Laws as usual:
-- first f = f *** id
-- second f = id *** f
-- second f = first f . swap
-- id *** id = id
The reason for wanting this class separate is that bijections (i.e. Iso) and
lenses can be an instance of IsoArrow and ProductCategory, but not of Arrow or
PreArrow. Similarly, we could have a class before ArrowChoice:
class IsoArrow a => SumCategory a where
(+++) :: a b c -> a d e -> a (Either b d) (Either c e)
left :: a b c -> a (Either b d) (Either c d)
right :: a c d -> a (Either b c) (Either b d)
left f = f +++ id
right f = id +++ f
Is either of these classes enough for the do/if sugar? Or do you also need (&&&)
and (|||) for those?
class ProductCategory a => DupCategory a where
dup :: a b (b,b)
(&&&) :: a b c -> a b d -> a b (c,d)
f &&& g = (f *** g) . dup
dup = id &&& id
class SumCategory a => MergeCategory a where
mergeEither :: a (Either b b) c
(|||) :: a b d -> a c d -> a (Either b c) d
f ||| g = mergeEither . (f +++ g)
mergeEither = id ||| id
Or the injections/projections?
class ProductCategory a => ProjectCategory a where
fst :: a (b,c) b
snd :: a (b,c) c
snd = fst . swap
class SumCategory a => InjectCategory a where
left :: a b (Either b c)
right :: a c (Either b c)
It seems that MergeCategory is enough for if statements:
if x then y else z = (z ||| y) . arrIso boolIso . x
where
boolIso = Iso boolIn boolOut
boolIn b = if b then Right () else Left ()
boolOut = either (const False) (const True)
And I suspect that either ProductCategory, DupCategory or ProjectCategory is
enough for do notation.
And for recursive bindings:
class ProductCategory a => TracedMonoidalCategory a where
loop :: a (b,u) (c,u) -> a b c
> in particularcomposing a PreArrow with a Functor yields another PreArrow
What do you mean by 'composition'? If you want to go the way of PreArrow, then
PreIsoArrow would be:
class IsoPreArrow a where
isoPremap :: Iso (->) b c -> a b d -> a c d
which is still slightly weaker than either IsoArrow or PreArrow. Or perhaps
class IsoProfunctor h where
ilmap :: Iso (->) a b -> h b c -> h a c
irmap :: Iso (->) b c -> h a b -> h a c
Of course IsoProfunctor is just another profunctor, categorically speaking. Just
like SumCategory and ProductCategory are both monoidal categories. But you can't
express that in Haskell 98/2010. That requires MPTCs:
class Category g => Profunctor g h where
lmap :: g a b -> h b c -> h a c
rmap :: g b c -> h a b -> h a c
class (Category h, Profunctor g h) => ArrowLift g h where
arr :: g a b -> h a b
arr = lmap f id
There are some interesting relations between the classes (read (==>) as
implication):
SumCategory && PreArrow ==> MergeCategory.
ProductCategory && PostArrow ==> DupCategory,
where PostArrow is the other half of a Profunctor. Similarly:
ProductCategory && PreArrow ==> ProjectCategory
SumCategory && PostArrow ==> InjectCategory.
I also think that now
(IsoPreArrow || IsoPostArrow) && Category ==> IsoArrow
(PreArrow || PostArrow) && ProductCategory ==> Arrow
There is now a diamond in the superclasses of Arrow, one path goes through
Profunctor/PreArrow, the other through IsoArrow.
Finally, it might be sensible to disconnect SumCategory from MergeCategory,
since the latter has an instance for lenses, while the former does not. And are
there any types that are an instance of DupCategory but not of ProductCategory?
But maybe I am wanting too much at once. :)
Twan
More information about the Libraries
mailing list