Re: Proposal: Make Semigroup and Monoid instances for Data.Functor.Compose

Hi, You may find the discussion at https://mail.haskell.org/pipermail/libraries/2018-February/028571.html interesting. The summarized version of that post is that Data.Functor.Compose was originally brought over from the transformers library, which adheres to a very Haskell98 mindset in its design. In particular, the maintainer of transformers would likely not have added the Semigroup or Monoid instances you propose, since they require the FlexibleContexts language extension. This explains why there exists an `instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a)` and not an `instance Eq (f (g a)) => Eq (Compose f g a)`, among other things. Of course, Data.Functor.Compose now lives in the base library, not transformers, so we need not prescribe to the same design philosophy. I don't feel too strongly about the issue, so if other people feel like adding Semigroup/Monoid instances that require FlexibleContexts is a good idea, I could get on board with that. What do others think? Ryan S.

I'm do not believe that that the FlexibleContexts-based instance is the
best available option. The available options are:
instance Semigroup (f (g a)) => Semigroup (Compose f g a) --
FlexibleContexts
OR
instance (forall x. Semigroup x => Semigroup (f x), forall x. Semigroup
x => Semigroup (g x), Semigroup a) => Semigroup (Compose f g a) --
QuantifiedConstraints
There is a third option available which is to add Semigroup1 and Monoid1
typeclasses, but since the QuantifiedConstraints extension obsoletes such
boilerplate, this option is not be considered here. David Feuer has pointed
out in another thread that this context is satisfied by strictly more types
than the context on the QuantifiedContstraints-based instance. However, I
argue that the cost of this flexibility is composition. That is, the
context does not break down into smaller contexts that can be satisfied
individually. By constrast, the QuantifiedConstraints-based instance offers
a context comprised of three distinct constraints. This is the same
strategy employed by the Eq, Ord, Show, and Read instances. That is to say
that the QuantifiedConstraints-based instances is consistent in spirit with
the existing instances. And as the the Eq1/Ord1/...-based instances for
Compose enable reasoning compositionally about constraints, so does
QuantifiedConstraints-based Semigroup instance. Consider this contrived
example that illustrates the principle:
foo :: ??? => Compose IO Maybe a -> Compose IO Maybe a -> Compose IO Maybe a
foo = (<>)
What context should fill in the question marks? With the
QuantifiedConstraints-based instance, we would write `Semigroup a` (since
the other two constraints are satisfied), but with the
FlexibleContexts-based instance, we would write `Semigroup (IO (Maybe a))`.
Bummer. I've encountered real scenarios where this is actually a problem
although it would be tedious to explain them here. I'm happy to hear
differing opinions or agreement. One way or another, we really ought to add
something.
On Fri, Jul 26, 2019 at 9:17 AM Ryan Scott
Hi,
You may find the discussion at https://mail.haskell.org/pipermail/libraries/2018-February/028571.html interesting. The summarized version of that post is that Data.Functor.Compose was originally brought over from the transformers library, which adheres to a very Haskell98 mindset in its design. In particular, the maintainer of transformers would likely not have added the Semigroup or Monoid instances you propose, since they require the FlexibleContexts language extension. This explains why there exists an `instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a)` and not an `instance Eq (f (g a)) => Eq (Compose f g a)`, among other things.
Of course, Data.Functor.Compose now lives in the base library, not transformers, so we need not prescribe to the same design philosophy. I don't feel too strongly about the issue, so if other people feel like adding Semigroup/Monoid instances that require FlexibleContexts is a good idea, I could get on board with that. What do others think?
Ryan S. _______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
-- -Andrew Thaddeus Martin

I see no benefit to the version with quantified constraints, which only
restricts things more tightly. Remember, among other things, that f must
have kind k -> Type for some k, but all other kinds are up in the air.
On Fri, Jul 26, 2019, 1:12 PM Andrew Martin
I'm do not believe that that the FlexibleContexts-based instance is the best available option. The available options are:
instance Semigroup (f (g a)) => Semigroup (Compose f g a) -- FlexibleContexts OR instance (forall x. Semigroup x => Semigroup (f x), forall x. Semigroup x => Semigroup (g x), Semigroup a) => Semigroup (Compose f g a) -- QuantifiedConstraints
There is a third option available which is to add Semigroup1 and Monoid1 typeclasses, but since the QuantifiedConstraints extension obsoletes such boilerplate, this option is not be considered here. David Feuer has pointed out in another thread that this context is satisfied by strictly more types than the context on the QuantifiedContstraints-based instance. However, I argue that the cost of this flexibility is composition. That is, the context does not break down into smaller contexts that can be satisfied individually. By constrast, the QuantifiedConstraints-based instance offers a context comprised of three distinct constraints. This is the same strategy employed by the Eq, Ord, Show, and Read instances. That is to say that the QuantifiedConstraints-based instances is consistent in spirit with the existing instances. And as the the Eq1/Ord1/...-based instances for Compose enable reasoning compositionally about constraints, so does QuantifiedConstraints-based Semigroup instance. Consider this contrived example that illustrates the principle:
foo :: ??? => Compose IO Maybe a -> Compose IO Maybe a -> Compose IO Maybe a foo = (<>)
What context should fill in the question marks? With the QuantifiedConstraints-based instance, we would write `Semigroup a` (since the other two constraints are satisfied), but with the FlexibleContexts-based instance, we would write `Semigroup (IO (Maybe a))`. Bummer. I've encountered real scenarios where this is actually a problem although it would be tedious to explain them here. I'm happy to hear differing opinions or agreement. One way or another, we really ought to add something.
On Fri, Jul 26, 2019 at 9:17 AM Ryan Scott
wrote: Hi,
You may find the discussion at https://mail.haskell.org/pipermail/libraries/2018-February/028571.html interesting. The summarized version of that post is that Data.Functor.Compose was originally brought over from the transformers library, which adheres to a very Haskell98 mindset in its design. In particular, the maintainer of transformers would likely not have added the Semigroup or Monoid instances you propose, since they require the FlexibleContexts language extension. This explains why there exists an `instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a)` and not an `instance Eq (f (g a)) => Eq (Compose f g a)`, among other things.
Of course, Data.Functor.Compose now lives in the base library, not transformers, so we need not prescribe to the same design philosophy. I don't feel too strongly about the issue, so if other people feel like adding Semigroup/Monoid instances that require FlexibleContexts is a good idea, I could get on board with that. What do others think?
Ryan S. _______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
-- -Andrew Thaddeus Martin _______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

Ryan, sounds good to me
On Fri, Jul 26, 2019 at 9:17 AM Ryan Scott
Hi,
You may find the discussion at https://mail.haskell.org/pipermail/libraries/2018-February/028571.html interesting. The summarized version of that post is that Data.Functor.Compose was originally brought over from the transformers library, which adheres to a very Haskell98 mindset in its design. In particular, the maintainer of transformers would likely not have added the Semigroup or Monoid instances you propose, since they require the FlexibleContexts language extension. This explains why there exists an `instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a)` and not an `instance Eq (f (g a)) => Eq (Compose f g a)`, among other things.
Of course, Data.Functor.Compose now lives in the base library, not transformers, so we need not prescribe to the same design philosophy. I don't feel too strongly about the issue, so if other people feel like adding Semigroup/Monoid instances that require FlexibleContexts is a good idea, I could get on board with that. What do others think?
Ryan S. _______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
participants (4)
-
Andrew Martin
-
Carter Schonwald
-
David Feuer
-
Ryan Scott