[Haskell-cafe] Foldable for (,)

Dmitry Olshansky olshanskydr at gmail.com
Wed May 3 18:35:34 UTC 2017


Hmm, you are right! My objections were invalid.

So I don't know an answer... Really, why we have this constraint? The same
question is about Functor.



2017-05-03 17:43 GMT+03:00 Richard Eisenberg <rae at cs.brynmawr.edu>:

> To me, the fact that DeriveTraversable requires a Foldable instance is not
> an argument saying that Foldable needs to be a superclass of Traversable.
> It just restricts the usefulness of DeriveTraversable. We could always
> advertise that DeriveTraversable works only on types with Foldable
> instances -- no need to bake this restriction into the superclass
> constraints of Traversable.
>
> To be clear, I'm *not* arguing that Foldable shouldn't be a superclass of
> Traversable. I'm not knowledgeable enough on the specifics to make that
> claim. I *am* arguing that support for DeriveTraversable doesn't seem to a
> great argument for putting Foldable as a superclass of Traversable, though.
>
> Richard
>
> On May 3, 2017, at 10:38 AM, Dmitry Olshansky <olshanskydr at gmail.com>
> wrote:
>
> Traversable instances (for "singletons" or not) can be implemented
> _uniformly_ using Functor and Foldable instances.
> And they are implemented in such way when you derive Traversable. So we
> need Foldable constraint for the class.
>
> E.g.
> {-# LANGUAGE DeriveFunctor, DeriveFoldable,DeriveTraversable #-}
> > data D a = D { f1 :: [a], f2 :: (String, a) } deriving (Show, Eq,
> Functor, Foldable, Traversable)
> > sum $ D [1..3] ("test",4)
> 10
> > mapM_ print $ sequenceA $ D [[1,2],[3,4]] ("test",[5,6])
> D {f1 = [1,3], f2 = ("test",5)}
> D {f1 = [1,3], f2 = ("test",6)}
> D {f1 = [1,4], f2 = ("test",5)}
> D {f1 = [1,4], f2 = ("test",6)}
> D {f1 = [2,3], f2 = ("test",5)}
> D {f1 = [2,3], f2 = ("test",6)}
> D {f1 = [2,4], f2 = ("test",5)}
> D {f1 = [2,4], f2 = ("test",6)}
>
>
>
> 2017-05-03 14:34 GMT+03:00 Jonathon Delgado <voldermort at hotmail.com>:
>
>> Interesting, that's not the one linked to from Dmitry's code.
>>
>> In any case, is this correct?
>>
>> 1) Traversable is useful for all containers, including ones which can
>> only hold a single value, such as (,) a.
>> 2) The traversable definition for containers which can hold multiple
>> versions requires Foldable.
>> 3) So Traversable has to depend on Foldable.
>> 4) So singleton containers also have to implement Foldable, even when it
>> doesn't really make sense to do so.
>>
>> Is there some kind of refactoring which would "fix" this, other than two
>> unrelated Traversable classes? I understand that it might be impractical to
>> refactor a widely-used standard library, but I would be interested in how
>> such a situation could be avoided when starting from scratch.
>>
>>
>>
>> From: Haskell-Cafe <haskell-cafe-bounces at haskell.org> on behalf of Tony
>> Morris <tonymorris at gmail.com>
>> Sent: 03 May 2017 11:21
>> To: haskell-cafe at haskell.org
>> Subject: Re: [Haskell-cafe] Foldable for (,)
>>
>> https://i.imgur.com/A2enuhq.png
>>
>>
>> On 03/05/17 21:17, Jonathon Delgado wrote:
>> > List.foldr has signature (a -> b -> b) -> b -> [a] -> b, i.e. an actual
>> list? How is this effected by the Foldable constraint?
>> >
>> >
>> >
>> > From: Dmitry Olshansky <olshanskydr at gmail.com>
>> > Sent: 03 May 2017 10:47
>> > To: Jonathon Delgado
>> > Cc: haskell-cafe at haskell.org
>> > Subject: Re: [Haskell-cafe] Foldable for (,)
>> >
>> >
>> >
>> > Look how instance for List is defined.
>> >
>> > instance Traversable [] where     {-# INLINE traverse #-} -- so that
>> traverse can fuse     traverse f = List.foldr cons_f (pure [])       where
>> cons_f x ys = (:) <$> f x <*> ys It uses List.foldr. Many other instances
>> do the same.
>> > Functions in all instances of class should have the same signatures. So
>> we have to add Foldable constraint to the class.
>> > Of cause we can implement 'foldr' internaly in 'traverse' if needed (as
>> well as fmap).
>> > But this is not so good and more important that in this case we don't
>> know how to derive Traversable instances automatically.
>> >
>> > So the answer - many instances wouldn't compile and DeriveTraversable
>> wouldn't work.
>> >
>> >
>> >
>> > 2017-05-03 12:56 GMT+03:00 Jonathon Delgado  <voldermort at hotmail.com>:
>> >  OK, I understand why Traversable is useful here - thank you Chris and
>> Dmitry!
>> >
>> > The next question is why Traversable requires Foldable. I looked at the
>> source, and couldn't see where Foldable is being used, other than as a
>> constraint on Traversable. To put the question differently, what would fail
>> to compile if this constraint was removed?
>> >
>> >
>> >
>> > From: Dmitry Olshansky <olshanskydr at gmail.com>
>> > Sent: 03 May 2017 09:53
>> > To: Jonathon Delgado
>> >
>> >
>> > Cc: haskell-cafe at haskell.org
>> > Subject: Re: [Haskell-cafe] Foldable for (,)
>> >
>> >
>> >
>> >
>> >
>> > With fmap you can only change all values in some "container".
>> >
>> >  With Foldable you can "fold" it, i.e. calculate some "scalar" result.
>> >
>> >  With Traversable you can "change order of two containers":
>> >> sequenceA [[1,2,3],[4,5]]
>> > [[1,4],[1,5],[2,4],[2,5],[3,4],[3,5]]
>> >> sequenceA ("test",[2,3,4])
>> > [("test",2),("test",3),("test",4)]
>> >> sequenceA ("test",([1,2,3],[4,5,6]))
>> > ([1,2,3],("test",[4,5,6]))
>> >
>> >
>> >
>> >
>> >
>> > 2017-05-03 12:12 GMT+03:00 Jonathon Delgado  <voldermort at hotmail.com>:
>> >  Why do you want to traverse a tuple instead of fmap? i.e. what can you
>> do with Foldable/Traversable for (,) that you can't do with Functor?
>> >
>> > My background, as you can probably guess, is beginner.
>> >
>> >
>> > From: Haskell-Cafe <haskell-cafe-bounces at haskell.org> on behalf of
>> Chris Smith <cdsmith at gmail.com>
>> > Sent: 03 May 2017 08:51
>> > To: Tony Morris
>> > Cc: haskell-cafe at haskell.org
>> > Subject: Re: [Haskell-cafe] Foldable for (,)
>> >
>> >
>> >
>> >
>> > Replying to myself, I suppose one good answer is that whether or not
>> you care about Foldable instances for tuples, you might care about
>> Traversable instances, and those require Foldable as a superclass.
>> >
>> >
>> > For example, one possible specialization of `traverse` is:
>> >
>> >
>> >     traverse :: (a -> IO b) -> (SideValue, a) -> IO (SideValue, b)
>> >
>> >
>> > Jonathon, I don't know how much background you're coming from, so I'd
>> be happy to explain that in more detail if you need it.
>> >
>> >
>> > On Wed, May 3, 2017 at 1:44 AM, Chris Smith  <cdsmith at gmail.com> wrote:
>> >
>> > I'm also interested in Jonathon's question, so let me try to bring
>> things back to the question.  Everyone agrees that there's only one
>> reasonable way to define this instance if it exists.  But the question is:
>> why is it defined at all?
>> >
>> >
>> > That's an easy question to answer for Functor, Applicative, and Monad.
>> But I am having trouble giving a simple or accessible answer for Foldable.
>> Do you know one?
>> >
>> >
>> >
>> >
>> > On Wed, May 3, 2017 at 1:32 AM, Tony Morris  <tonymorris at gmail.com>
>> wrote:
>> >  It's Foldable for ((,) a).
>> >
>> > It is not Foldable for any of these things:
>> >
>> > * (,)
>> > * tuples
>> > * pairs
>> >
>> > In fact, to talk about a Foldable for (,) or "tuples" is itself a kind
>> > error. There is no good English name for the type constructor ((,) a)
>> > which I suspect, along with being unfamiliar with utilising the
>> > practical purpose of types (and types of types) is the root cause of all
>> > the confusion in this discussion.
>> >
>> > Ask yourself what the length of this value is:
>> >
>> > [[1,2,3], [4,5,6]]
>> >
>> > Is it 6? What about this one:
>> >
>> > [(1, 'a'), (undefined, 77)]
>> >
>> > Is it 4? No, obviously not, which we can determine by:
>> >
>> > :kind Foldable :: (* -> *) -> Constraint
>> > :kind [] :: * -> *
>> >
>> > Therefore, there is no possible way that the Foldable instance for []
>> > can inspect the elements (and determine that they are pairs in this
>> > case). By this method, we conclude that the length of the value is 2. It
>> > cannot be anything else, some assumptions about length itself put aside.
>> >
>> > By this ubiquitous and very practical method of reasoning, the length of
>> > any ((,) a) is not only one, but very obviously so.
>> >
>> >
>> >
>> > On 03/05/17 17:21, Jonathon Delgado wrote:
>> >> I sent the following post to the Beginners list a couple of weeks ago
>> (which failed to furnish an actual concrete example that answered the
>> question). Upon request I'm reposting it to Café:
>> >>
>> >> I've seen many threads, including the one going on now, about why we
>> need to have:
>> >>
>> >> length (2,3) = 1
>> >> product (2,3) = 3
>> >> sum (2,3) = 3
>> >> or (True,False) = False
>> >>
>> >> but the justifications all go over my head. Is there a
>> beginner-friendly explanation for why such seemingly unintuitive operations
>> should be allowed by default?
>> >> _______________________________________________
>> >> Haskell-Cafe mailing list
>> >> To (un)subscribe, modify options or view archives go to:
>> >>     http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>>
>>
>> Haskell-Cafe Info Page
>> mail.haskell.org
>> This mailing list is for the discussion of topics related to Haskell. The
>> volume may at times be high, as the scope is broader than the main Haskell
>> mailing list.
>>
>> >> Only members subscribed via the mailman list are allowed to post.
>> >
>> >
>> > _______________________________________________
>> > Haskell-Cafe mailing list
>> > To (un)subscribe, modify options or view archives go to:
>> > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>>
>>
>> Haskell-Cafe Info Page
>> mail.haskell.org
>> This mailing list is for the discussion of topics related to Haskell. The
>> volume may at times be high, as the scope is broader than the main Haskell
>> mailing list.
>>
>> > Only members subscribed via the mailman list are allowed to post.
>> >
>> >
>> >
>> > _______________________________________________
>> > Haskell-Cafe mailing list
>> > To (un)subscribe, modify options or view archives go to:
>> > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>> > Only members subscribed via the mailman list are allowed to post.
>> >
>> > _______________________________________________
>> > Haskell-Cafe mailing list
>> > To (un)subscribe, modify options or view archives go to:
>> > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>> > Only members subscribed via the mailman list are allowed to post.
>> >
>> > _______________________________________________
>> > Haskell-Cafe mailing list
>> > To (un)subscribe, modify options or view archives go to:
>> > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>> > Only members subscribed via the mailman list are allowed to post.
>>
>>
>> https://i.imgur.com/A2enuhq.png
>>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> To (un)subscribe, modify options or view archives go to:
>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>> Only members subscribed via the mailman list are allowed to post.
>>
>
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
>
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20170503/a297d447/attachment.html>


More information about the Haskell-Cafe mailing list