<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
</head>
<body text="#000000" bgcolor="#FFFFFF">
<p>I won't try to include Traversable1, nor Apply, Bind, Alt; not
yet. It would extend the scope of a patch way too much, and rise
AMP-like questions, which I don't have answers to.<br>
Foldable1 is something which "could move into base without pain"
[1], so let's do that first.<br>
<br>
- Oleg</p>
<p>[1]: <a
href="https://www.reddit.com/r/haskell/comments/6d0vgt/could_we_have_foldable1_and_traversable1_in_base/dhz42ie/">https://www.reddit.com/r/haskell/comments/6d0vgt/could_we_have_foldable1_and_traversable1_in_base/dhz42ie/</a></p>
<div class="moz-cite-prefix">On 18.10.2019 10.26, Tony Morris wrote:<br>
</div>
<blockquote type="cite"
cite="mid:CAJf6UsgT-_ArtoRFc_c9Kydb=4no3-d+Mv4d-SqUkcAgcY9SpA@mail.gmail.com">
<meta http-equiv="content-type" content="text/html; charset=UTF-8">
<div dir="ltr">
<div>I agree Foldable1 in base would be great, but I think the
most bang for buck would be to include several others; at
least also Traversable1 and possibly even Apply,Bind,Alt<br>
<br>
</div>
I second the comment about the issue related to addressing the
names, etc in semigroupoids, in preparation for inclusion to
base.<br>
</div>
<br>
<div class="gmail_quote">
<div dir="ltr" class="gmail_attr">On Fri, Oct 18, 2019 at 11:12
AM Oleg Grenrus <<a href="mailto:oleg.grenrus@iki.fi"
moz-do-not-send="true">oleg.grenrus@iki.fi</a>> wrote:<br>
</div>
<blockquote class="gmail_quote" style="margin:0px 0px 0px
0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">
<div bgcolor="#FFFFFF">
<p>What is the proposed change in semigroupoids, I don't see
any decisive conclusion comment. To get this going, I
suggest limiting discussion to the Foldable1 only<br>
and if after this proposal is accepted, extrapolate for
the rest of `semigroupoids`.<br>
<br>
So if someone can propose a concrete list how to rename
symbols in <a
href="http://oleg.fi/haddocks/foldable1/Data-Foldable1.html"
target="_blank" moz-do-not-send="true">https://oleg.fi/haddocks/foldable1/Data-Foldable1.html</a>,
I'll make a separate branch & haddock page.<br>
<br>
Is the wanted renaming s/1//; s/^/semi/:<br>
<br>
<tt>- Foldable1 -> Semifoldable</tt><tt><br>
</tt><tt>- fold1 -> semifold</tt><tt><br>
</tt><tt>- foldMap1 -> semifoldMap</tt><tt><br>
</tt><tt>- foldr1 -> semifoldr</tt><tt><br>
</tt><tt>- foldr1map -> semifoldr1map</tt><tt><br>
</tt><tt>- toNonEmpty -> toNonEmpty</tt><tt><br>
</tt><tt>- ...</tt><tt><br>
</tt><tt>- head1 -> semihead</tt><tt><br>
</tt><tt>- last1 -> semilast</tt><tt><br>
</tt><tt>- minimum1 -> semiminimum</tt><tt><br>
</tt><tt>- maximum1 -> semimaximum</tt><tt><br>
</tt><tt><br>
</tt><tt>- intercalate1 -> semiintercalate</tt><tt><br>
</tt><tt>- foldl1M -> semifoldl</tt><tt><br>
</tt><tt>- ...</tt><tt><br>
</tt><tt>- maximum1By -> semimaximumBy</tt><br>
- ...<br>
<br>
I'm fine with this.<br>
The head1/semihead are both silly, but the suffix was
there to avoid name clash, so prefix is fine for that
purpose too.<br>
<br>
---<br>
<br>
The synopsis of current state of proposed Data.Foldable1<br>
<br>
<tt>module Data.Foldable1</tt><tt> where<br>
<br>
</tt><tt>class Foldable t => Foldable1 t</tt><tt><br>
</tt><tt> fold1 :: (Foldable1 t, Semigroup m) =>
t m -> m</tt><tt><br>
</tt><tt> foldMap1 :: (Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m</tt><tt><br>
</tt><tt> foldMap1' :: (Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m</tt><tt><br>
</tt><tt> foldr1 :: Foldable1 t => (a -> a
-> a) -> t a -> a</tt><tt><br>
</tt><tt> foldr1' :: Foldable1 t => (a -> a
-> a) -> t a -> a</tt><tt><br>
</tt><tt> foldl1 :: Foldable1 t => (a -> a
-> a) -> t a -> a</tt><tt><br>
</tt><tt> foldl1' :: Foldable1 t => (a -> a
-> a) -> t a -> a</tt><tt><br>
</tt><tt> toNonEmpty :: Foldable1 t => t a ->
NonEmpty a</tt><tt><br>
</tt><tt> maximum1 :: forall a. (Foldable1 t, Ord a)
=> t a -> a</tt><tt><br>
</tt><tt> minimum1 :: forall a. (Foldable1 t, Ord a)
=> t a -> a</tt><tt><br>
</tt><tt> head1 :: Foldable1 t => t a -> a</tt><tt><br>
</tt><tt> last1 :: Foldable1 t => t a -> a</tt><tt><br>
</tt><tt> foldr1map :: Foldable1 t => (a -> b)
-> (b -> b -> b) -> t a -> b</tt><tt><br>
</tt><tt> foldl1'map :: Foldable1 t => (a -> b)
-> (b -> b -> b) -> t a -> b</tt><tt><br>
</tt><tt> foldl1map :: Foldable1 t => (a -> b)
-> (b -> b -> b) -> t a -> b</tt><tt><br>
</tt><tt> foldr1'map :: Foldable1 t => (a -> b)
-> (b -> b -> b) -> t a -> b</tt><tt><br>
</tt><tt><br>
</tt><tt>intercalate1 :: (Foldable1 t, Semigroup m) =>
m -> t m -> m</tt><tt><br>
</tt><tt>foldrM1 :: (Foldable1 t, Monad m) => (a
-> a -> m a) -> t a -> m a</tt><tt><br>
</tt><tt>foldlM1 :: (Foldable1 t, Monad m) => (a
-> a -> m a) -> t a -> m a</tt><tt><br>
</tt><tt>maximum1By :: Foldable1 t => (a -> a
-> Ordering) -> t a -> a</tt><tt><br>
</tt><tt>minimum1By :: Foldable1 t => (a -> a
-> Ordering) -> t a -> a</tt></p>
<p>- Oleg<br>
</p>
<div>On 18.10.2019 3.06, Edward Kmett wrote:<br>
</div>
<blockquote type="cite"> I’m happy to take patches to move
things along in semigroupoids. My focus has been
elsewhere, I admit.
<div><br>
</div>
<div>-Edward<br>
<div dir="ltr"><br>
<blockquote type="cite">On Oct 17, 2019, at 5:03 PM,
Andrew Martin <a
href="mailto:andrew.thaddeus@gmail.com"
target="_blank" moz-do-not-send="true"><andrew.thaddeus@gmail.com></a>
wrote:<br>
<br>
</blockquote>
</div>
<blockquote type="cite">
<div dir="ltr"> While I want this abstraction in
base, I don’t want it there yet. There is an open
issue on semigroupoids about renaming everything: <a
href="https://github.com/ekmett/semigroupoids/issues/26" target="_blank"
moz-do-not-send="true">https://github.com/ekmett/semigroupoids/issues/26</a>
<div><br>
</div>
<div>This needs to be handled before the abstraction
is brought into base. Also, foldr1 is awful in
common situations. See <a
href="https://github.com/ekmett/semigroupoids/issues/77"
target="_blank" moz-do-not-send="true">https://github.com/ekmett/semigroupoids/issues/77</a></div>
<div><br>
</div>
<div>The problem is that refinements of this
abstraction seem to have stalled in semigroupoids,
but these are desperately needed before the
abstraction is brought into base.<br>
<br>
<div
id="gmail-m_-829105700172531108AppleMailSignature"
dir="ltr">Sent from my iPhone</div>
<div dir="ltr"><br>
On Oct 17, 2019, at 10:42 AM, Oleg Grenrus <<a
href="mailto:oleg.grenrus@iki.fi"
target="_blank" moz-do-not-send="true">oleg.grenrus@iki.fi</a>>
wrote:<br>
<br>
</div>
<blockquote type="cite">
<div dir="ltr"><span>I propose adding
`Foldable1` type-class into `base1`.</span><br>
<span></span><br>
<span>Add Foldable1</span><br>
<span>=============</span><br>
<span></span><br>
<span></span><br>
<span>Motivation</span><br>
<span>----------</span><br>
<span></span><br>
<span>It's regularly asked whether `Foldable1`
could be added to `base`</span><br>
<span>(e.g. on reddit[^ref1], there're also
GHC issue[^ref2] and old</span><br>
<span>phabricator diff[^ref3])</span><br>
<span>Also there's work towards non-empty maps
and sets[^ref4],</span><br>
<span>which would benefit from `Foldable1`.</span><br>
<span></span><br>
<span>As commented on reddit, `Foldable1`
could be added without any pain</span><br>
<span>to the `base` as it's pure addition - no
modifications needed in</span><br>
<span>existing modules.</span><br>
<span></span><br>
<span>[^ref1]:</span><br>
<span><a
href="https://www.reddit.com/r/haskell/comments/6d0vgt/could_we_have_foldable1_and_traversable1_in_base/"
target="_blank" moz-do-not-send="true">https://www.reddit.com/r/haskell/comments/6d0vgt/could_we_have_foldable1_and_traversable1_in_base/</a></span><br>
<span>[^ref2]: <a
href="https://gitlab.haskell.org/ghc/ghc/issues/13573"
target="_blank" moz-do-not-send="true">https://gitlab.haskell.org/ghc/ghc/issues/13573</a></span><br>
<span>[^ref3]: <a
href="https://phabricator.haskell.org/D4812"
target="_blank" moz-do-not-send="true">https://phabricator.haskell.org/D4812</a></span><br>
<span>[^ref4]: <a
href="https://github.com/haskell/containers/pull/616"
target="_blank" moz-do-not-send="true">https://github.com/haskell/containers/pull/616</a></span><br>
<span></span><br>
<span>Change</span><br>
<span>------</span><br>
<span></span><br>
<span>The change exist as merge request[^ref4]
on <a href="http://gitlab.haskell.org"
target="_blank" moz-do-not-send="true">gitlab.haskell.org</a>.</span><br>
<span></span><br>
<span>Importantly, this change **doesn't
change** anything in other modules</span><br>
<span>of `base`, except of adding a `Foldable`
instance to `Data.Complex`.</span><br>
<span>In particular, `foldl1` and `foldr1` in
`Data.Foldable` remain partial, etc.</span><br>
<span></span><br>
<span>My version of `Foldable1` class is big,
so I'll comment the motivation</span><br>
<span>for each member</span><br>
<span></span><br>
<span>```haskell</span><br>
<span>class Foldable t => Foldable1 t where</span><br>
<span> {-# MINIMAL foldMap1 | toNonEmpty |
foldr1map #-}</span><br>
<span></span><br>
<span> -- the defining member, like foldMap
but only asking for Semigroup</span><br>
<span> foldMap1 :: Semigroup m => (a
-> m) -> t a -> m</span><br>
<span></span><br>
<span> fold1 :: Semigroup m => t m ->
m#</span><br>
<span></span><br>
<span> -- strict foldMap1, cf foldMap'</span><br>
<span> foldMap1' :: Semigroup m => (a
-> m) -> t a -> m</span><br>
<span></span><br>
<span> -- analogue of toList</span><br>
<span> toNonEmpty :: t a -> NonEmpty a</span><br>
<span></span><br>
<span> -- left&right,
strict&non-strict folds</span><br>
<span> foldr1 :: (a -> a -> a) ->
t a -> a</span><br>
<span> foldr1' :: (a -> a -> a) ->
t a -> a</span><br>
<span> foldl1 :: (a -> a -> a) ->
t a -> a</span><br>
<span> foldl1' :: (a -> a -> a) ->
t a -> a</span><br>
<span></span><br>
<span> -- these can have efficient
implementation for NonEmptySet</span><br>
<span> maximum1 :: forall a. Ord a => t
a -> a</span><br>
<span> minimum1 :: forall a. Ord a => t
a -> a</span><br>
<span></span><br>
<span> -- head1 have efficient
implementation for NonEmpty and Tree</span><br>
<span> -- last1 for symmetry</span><br>
<span> head1 :: t a -> a</span><br>
<span> last1 :: t a -> a</span><br>
<span></span><br>
<span> -- fold variants with premap.</span><br>
<span> -- Without this map, we cannot
implement foldl using foldr etc.</span><br>
<span> foldr1map :: (a -> b) -> (b
-> b -> b) -> t a -> b</span><br>
<span> foldl1'map :: (a -> b) -> (b
-> b -> b) -> t a -> b</span><br>
<span> foldl1map :: (a -> b) -> (b
-> b -> b) -> t a -> b</span><br>
<span> foldr1'map :: (a -> b) -> (b
-> b -> b) -> t a -> b</span><br>
<span>```</span><br>
<span></span><br>
<span>The merge request also adds instances
for everything non-empty in `base`.</span><br>
<span></span><br>
<span>I propose the `Data.Foldable1` as the
module name.</span><br>
<span>`semigroupoids`[^ref6] uses
`Data.Semigroup.Foldable`,</span><br>
<span>but it's confusing; and using different
name could help migration.</span><br>
<span></span><br>
<span>The module contains five top-level
functions, which should</span><br>
<span>be self-explanatory:</span><br>
<span></span><br>
<span>```haskell</span><br>
<span>intercalate1 :: (Foldable1 t, Semigroup
m) => m -> t m -> m</span><br>
<span></span><br>
<span>foldrM1 :: (Foldable1 t, Monad m) =>
(a -> a -> m a) -> t a -> m a</span><br>
<span>foldlM1 :: (Foldable1 t, Monad m) =>
(a -> a -> m a) -> t a -> m a</span><br>
<span></span><br>
<span>maximum1By :: Foldable1 t => (a ->
a -> Ordering) -> t a -> a</span><br>
<span>minimum1By :: Foldable1 t => (a ->
a -> Ordering) -> t a -> a</span><br>
<span>```</span><br>
<span></span><br>
<span>This is less than in
`Data.Semigroup.Foldable`[^ref9],</span><br>
<span>as without `Apply` they don't make
sense.</span><br>
<span>For example:</span><br>
<span></span><br>
<span>```haskell</span><br>
<span>-- needs Apply, not in Data.Foldable1</span><br>
<span>traverse1_ :: (Foldable1 t, Apply f)
=> (a -> f b) -> t a -> f ()</span><br>
<span>```</span><br>
<span></span><br>
<span>And if we relax `Apply` to
`Applicative`, we get `traverse_`.</span><br>
<span> </span><br>
<span>[^ref5]: <a
href="https://gitlab.haskell.org/ghc/ghc/merge_requests/1973"
target="_blank" moz-do-not-send="true">https://gitlab.haskell.org/ghc/ghc/merge_requests/1973</a></span><br>
<span>[^ref9]:</span><br>
<span><a
href="https://hackage.haskell.org/package/semigroupoids-5.3.3/docs/Data-Semigroup-Foldable-Class.html"
target="_blank" moz-do-not-send="true">https://hackage.haskell.org/package/semigroupoids-5.3.3/docs/Data-Semigroup-Foldable-Class.html</a></span><br>
<span></span><br>
<span>[^ref5]: <a
href="https://gitlab.haskell.org/ghc/ghc/merge_requests/1973"
target="_blank" moz-do-not-send="true">https://gitlab.haskell.org/ghc/ghc/merge_requests/1973</a></span><br>
<span></span><br>
<span>Compatibility & migration</span><br>
<span>-------------------------</span><br>
<span></span><br>
<span>I drafted a compatibility package
`foldable1` (github[^ref6],</span><br>
<span>haddocks[^ref7]),</span><br>
<span>which I hope could be maintained under <a
href="http://github.com/haskell"
target="_blank" moz-do-not-send="true">github.com/haskell</a>
organization.</span><br>
<span>I can act as a maintainer, with a hope
that there won't be a lot</span><br>
<span>of changes happening in
`Data.Foldable1`.</span><br>
<span></span><br>
<span>To my surprise, there's already a
package with this name on</span><br>
<span>Hackage[^ref8] by</span><br>
<span>M Farkas-Dyck (cc'd). I hope they would
donate the name to <a
href="http://Haskell.org" target="_blank"
moz-do-not-send="true">Haskell.org</a> /</span><br>
<span>CLC;</span><br>
<span>the package won't have any other good
use when `Data.Foldable1` is in</span><br>
<span>`base`,</span><br>
<span>then act as a compat package.</span><br>
<span></span><br>
<span>`Data.Foldable1` contains also instances
for `Lift`, `Backwards` and</span><br>
<span>`Reverse`</span><br>
<span>data types from `transformers`.
Perfectly, the `transformers` bundled</span><br>
<span>with GHC with this change would
implement the instances as well.</span><br>
<span>This change should propage to
`transformers-compat` too.</span><br>
<span></span><br>
<span>Similarly, `containers` would have an
instance for `Tree` (and non-empty</span><br>
<span>`Set` and `Map` when they are added).</span><br>
<span></span><br>
<span>`semigroupoids` would need a bit of
work, to depend on `foldable1`,</span><br>
<span>yet the public changes can be kept quite
minimal.</span><br>
<span>I don't think that anything in reverse
dependencies of `lens` will be</span><br>
<span>broken by</span><br>
<span>this change, if "new" `Foldable1` is
re-exported from `semigroupoids`'</span><br>
<span>`Data.Semigroup.Foldable`[^ref9]</span><br>
<span></span><br>
<span>Other "compat" packages -- like
`tagged`, `bifunctors` -- have to be</span><br>
<span>dealt with</span><br>
<span>case by case. For example whether they
should depend on `foldable1` or</span><br>
<span>other way around.</span><br>
<span></span><br>
<span>[^ref6]: <a
href="https://github.com/phadej/foldable1"
target="_blank" moz-do-not-send="true">https://github.com/phadej/foldable1</a></span><br>
<span>[^ref7]: <a
href="https://oleg.fi/haddocks/foldable1/"
target="_blank" moz-do-not-send="true">https://oleg.fi/haddocks/foldable1/</a></span><br>
<span>[^ref8]: <a
href="https://hackage.haskell.org/package/foldable1"
target="_blank" moz-do-not-send="true">https://hackage.haskell.org/package/foldable1</a></span><br>
<span>[^ref9]:</span><br>
<span><a
href="https://hackage.haskell.org/package/semigroupoids-5.3.3/docs/Data-Semigroup-Foldable-Class.html"
target="_blank" moz-do-not-send="true">https://hackage.haskell.org/package/semigroupoids-5.3.3/docs/Data-Semigroup-Foldable-Class.html</a></span><br>
<span></span><br>
<span>Unresolved questions</span><br>
<span>--------------------</span><br>
<span></span><br>
<span>- Should we add `Bifoldable1` too. That
should be trivial.</span><br>
<span>- GHC-8.10 freeze is quite soon, is
targeting GHC-8.12/base-4.15 more</span><br>
<span>realistic?</span><br>
<span></span><br>
<span></span><br>
</div>
</blockquote>
<blockquote type="cite">
<div dir="ltr"><span>_______________________________________________</span><br>
<span>Libraries mailing list</span><br>
<span><a href="mailto:Libraries@haskell.org"
target="_blank" moz-do-not-send="true">Libraries@haskell.org</a></span><br>
<span><a
href="http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries"
target="_blank" moz-do-not-send="true">http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries</a></span><br>
</div>
</blockquote>
</div>
<span>_______________________________________________</span><br>
<span>Libraries mailing list</span><br>
<span><a href="mailto:Libraries@haskell.org"
target="_blank" moz-do-not-send="true">Libraries@haskell.org</a></span><br>
<span><a
href="http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries"
target="_blank" moz-do-not-send="true">http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries</a></span><br>
</div>
</blockquote>
</div>
</blockquote>
</div>
_______________________________________________<br>
Libraries mailing list<br>
<a href="mailto:Libraries@haskell.org" target="_blank"
moz-do-not-send="true">Libraries@haskell.org</a><br>
<a
href="http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries"
rel="noreferrer" target="_blank" moz-do-not-send="true">http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries</a><br>
</blockquote>
</div>
</blockquote>
</body>
</html>