<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
</head>
<body text="#000000" bgcolor="#FFFFFF">
<p>Thanks for the support and comments Dmitrii.<br>
<br>
1. I can add usage examples, that's no brainer.<br>
2. Yes, implementing selected members manually can help, that's
the point of having a lot of members, and not bare foldMap1.<br>
- Yet I hope that is not a blocker<br>
- This may be motivated by GHC.Generics, but I don't see
instances in `relude`?<br>
- Non trivial manual implementations should be backed up by
some benchmark that shows it's worth having more code (which one
have test, that it's coherent!).<br>
- That said, I'll add more manual members when I have test
setup ready. E.g. `head1 :: Compose f g a -> a`, and for
`Product` (and Generics variants).<br>
- {-# INLINE #-} everywhere doesn't imply more performance.<br>
- The `foldable1` package is simple enough playground to add
benchmarks, there are some already.<br>
3. There is no prior art of disallowing instances with TypeErrors
in `base`, so I'm wont consider it here either.<br>
- That's worth an own separate library proposal<br>
</p>
<p>- Oleg<br>
</p>
<div class="moz-cite-prefix">On 17.10.2019 19.26, Dmitrii Kovanikov
wrote:<br>
</div>
<blockquote type="cite"
cite="mid:CAMdbBiGGo0hHSV8k_46f1QjY3GEjzMF59==GReYf9yovPSw8-Q@mail.gmail.com">
<meta http-equiv="content-type" content="text/html; charset=UTF-8">
<div dir="ltr">I support this change and I would love to have
`Foldable1` in the `base` as well. I find it so useful that we
even have it in our alternative prelude called `relude`:
<div><br>
</div>
<div>* <a
href="https://github.com/kowainik/relude/blob/45e112677c6e23759e4742cb695eed20a2cb964a/src/Relude/Extra/Foldable1.hs"
moz-do-not-send="true">https://github.com/kowainik/relude/blob/45e112677c6e23759e4742cb695eed20a2cb964a/src/Relude/Extra/Foldable1.hs</a></div>
<div><br>
</div>
<div>I would love to reexport this typeclass by default from
`base` instead of maintaining one more `Extra.*` module in
`relude`. However, at this point, I like the implementation in
`relude` more because:</div>
<div><br>
</div>
<div>1. It has usage examples tested with `doctest`.</div>
<div>2. Implements (almost) each function manually and uses {-#
INLINE #-} pragmas for better performance.</div>
<div>3. In the next release, we're also going to add custom type
errors of `Foldable1` instances for data types like ordinary
lists to improve UX.</div>
<div><br>
</div>
<div>These improvements don't rely on anything `relude`-specific
and can be done in `base` as well.</div>
</div>
<br>
<div class="gmail_quote">
<div dir="ltr" class="gmail_attr">On Thu, Oct 17, 2019 at 5:43
PM 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">I
propose adding `Foldable1` type-class into `base1`.<br>
<br>
Add Foldable1<br>
=============<br>
<br>
<br>
Motivation<br>
----------<br>
<br>
It's regularly asked whether `Foldable1` could be added to
`base`<br>
(e.g. on reddit[^ref1], there're also GHC issue[^ref2] and old<br>
phabricator diff[^ref3])<br>
Also there's work towards non-empty maps and sets[^ref4],<br>
which would benefit from `Foldable1`.<br>
<br>
As commented on reddit, `Foldable1` could be added without any
pain<br>
to the `base` as it's pure addition - no modifications needed
in<br>
existing modules.<br>
<br>
[^ref1]:<br>
<a
href="https://www.reddit.com/r/haskell/comments/6d0vgt/could_we_have_foldable1_and_traversable1_in_base/"
rel="noreferrer" target="_blank" moz-do-not-send="true">https://www.reddit.com/r/haskell/comments/6d0vgt/could_we_have_foldable1_and_traversable1_in_base/</a><br>
[^ref2]: <a
href="https://gitlab.haskell.org/ghc/ghc/issues/13573"
rel="noreferrer" target="_blank" moz-do-not-send="true">https://gitlab.haskell.org/ghc/ghc/issues/13573</a><br>
[^ref3]: <a href="https://phabricator.haskell.org/D4812"
rel="noreferrer" target="_blank" moz-do-not-send="true">https://phabricator.haskell.org/D4812</a><br>
[^ref4]: <a
href="https://github.com/haskell/containers/pull/616"
rel="noreferrer" target="_blank" moz-do-not-send="true">https://github.com/haskell/containers/pull/616</a><br>
<br>
Change<br>
------<br>
<br>
The change exist as merge request[^ref4] on <a
href="http://gitlab.haskell.org" rel="noreferrer"
target="_blank" moz-do-not-send="true">gitlab.haskell.org</a>.<br>
<br>
Importantly, this change **doesn't change** anything in other
modules<br>
of `base`, except of adding a `Foldable` instance to
`Data.Complex`.<br>
In particular, `foldl1` and `foldr1` in `Data.Foldable` remain
partial, etc.<br>
<br>
My version of `Foldable1` class is big, so I'll comment the
motivation<br>
for each member<br>
<br>
```haskell<br>
class Foldable t => Foldable1 t where<br>
{-# MINIMAL foldMap1 | toNonEmpty | foldr1map #-}<br>
<br>
-- the defining member, like foldMap but only asking for
Semigroup<br>
foldMap1 :: Semigroup m => (a -> m) -> t a ->
m<br>
<br>
fold1 :: Semigroup m => t m -> m#<br>
<br>
-- strict foldMap1, cf foldMap'<br>
foldMap1' :: Semigroup m => (a -> m) -> t a ->
m<br>
<br>
-- analogue of toList<br>
toNonEmpty :: t a -> NonEmpty a<br>
<br>
-- left&right, strict&non-strict folds<br>
foldr1 :: (a -> a -> a) -> t a -> a<br>
foldr1' :: (a -> a -> a) -> t a -> a<br>
foldl1 :: (a -> a -> a) -> t a -> a<br>
foldl1' :: (a -> a -> a) -> t a -> a<br>
<br>
-- these can have efficient implementation for NonEmptySet<br>
maximum1 :: forall a. Ord a => t a -> a<br>
minimum1 :: forall a. Ord a => t a -> a<br>
<br>
-- head1 have efficient implementation for NonEmpty and
Tree<br>
-- last1 for symmetry<br>
head1 :: t a -> a<br>
last1 :: t a -> a<br>
<br>
-- fold variants with premap.<br>
-- Without this map, we cannot implement foldl using foldr
etc.<br>
foldr1map :: (a -> b) -> (b -> b -> b) ->
t a -> b<br>
foldl1'map :: (a -> b) -> (b -> b -> b) ->
t a -> b<br>
foldl1map :: (a -> b) -> (b -> b -> b) ->
t a -> b<br>
foldr1'map :: (a -> b) -> (b -> b -> b) ->
t a -> b<br>
```<br>
<br>
The merge request also adds instances for everything non-empty
in `base`.<br>
<br>
I propose the `Data.Foldable1` as the module name.<br>
`semigroupoids`[^ref6] uses `Data.Semigroup.Foldable`,<br>
but it's confusing; and using different name could help
migration.<br>
<br>
The module contains five top-level functions, which should<br>
be self-explanatory:<br>
<br>
```haskell<br>
intercalate1 :: (Foldable1 t, Semigroup m) => m -> t m
-> m<br>
<br>
foldrM1 :: (Foldable1 t, Monad m) => (a -> a -> m a)
-> t a -> m a<br>
foldlM1 :: (Foldable1 t, Monad m) => (a -> a -> m a)
-> t a -> m a<br>
<br>
maximum1By :: Foldable1 t => (a -> a -> Ordering)
-> t a -> a<br>
minimum1By :: Foldable1 t => (a -> a -> Ordering)
-> t a -> a<br>
```<br>
<br>
This is less than in `Data.Semigroup.Foldable`[^ref9],<br>
as without `Apply` they don't make sense.<br>
For example:<br>
<br>
```haskell<br>
-- needs Apply, not in Data.Foldable1<br>
traverse1_ :: (Foldable1 t, Apply f) => (a -> f b) ->
t a -> f ()<br>
```<br>
<br>
And if we relax `Apply` to `Applicative`, we get `traverse_`.<br>
<br>
[^ref5]: <a
href="https://gitlab.haskell.org/ghc/ghc/merge_requests/1973"
rel="noreferrer" target="_blank" moz-do-not-send="true">https://gitlab.haskell.org/ghc/ghc/merge_requests/1973</a><br>
[^ref9]:<br>
<a
href="https://hackage.haskell.org/package/semigroupoids-5.3.3/docs/Data-Semigroup-Foldable-Class.html"
rel="noreferrer" target="_blank" moz-do-not-send="true">https://hackage.haskell.org/package/semigroupoids-5.3.3/docs/Data-Semigroup-Foldable-Class.html</a><br>
<br>
[^ref5]: <a
href="https://gitlab.haskell.org/ghc/ghc/merge_requests/1973"
rel="noreferrer" target="_blank" moz-do-not-send="true">https://gitlab.haskell.org/ghc/ghc/merge_requests/1973</a><br>
<br>
Compatibility & migration<br>
-------------------------<br>
<br>
I drafted a compatibility package `foldable1` (github[^ref6],<br>
haddocks[^ref7]),<br>
which I hope could be maintained under <a
href="http://github.com/haskell" rel="noreferrer"
target="_blank" moz-do-not-send="true">github.com/haskell</a>
organization.<br>
I can act as a maintainer, with a hope that there won't be a
lot<br>
of changes happening in `Data.Foldable1`.<br>
<br>
To my surprise, there's already a package with this name on<br>
Hackage[^ref8] by<br>
M Farkas-Dyck (cc'd). I hope they would donate the name to
Haskell.org /<br>
CLC;<br>
the package won't have any other good use when
`Data.Foldable1` is in<br>
`base`,<br>
then act as a compat package.<br>
<br>
`Data.Foldable1` contains also instances for `Lift`,
`Backwards` and<br>
`Reverse`<br>
data types from `transformers`. Perfectly, the `transformers`
bundled<br>
with GHC with this change would implement the instances as
well.<br>
This change should propage to `transformers-compat` too.<br>
<br>
Similarly, `containers` would have an instance for `Tree` (and
non-empty<br>
`Set` and `Map` when they are added).<br>
<br>
`semigroupoids` would need a bit of work, to depend on
`foldable1`,<br>
yet the public changes can be kept quite minimal.<br>
I don't think that anything in reverse dependencies of `lens`
will be<br>
broken by<br>
this change, if "new" `Foldable1` is re-exported from
`semigroupoids`'<br>
`Data.Semigroup.Foldable`[^ref9]<br>
<br>
Other "compat" packages -- like `tagged`, `bifunctors` -- have
to be<br>
dealt with<br>
case by case. For example whether they should depend on
`foldable1` or<br>
other way around.<br>
<br>
[^ref6]: <a href="https://github.com/phadej/foldable1"
rel="noreferrer" target="_blank" moz-do-not-send="true">https://github.com/phadej/foldable1</a><br>
[^ref7]: <a href="https://oleg.fi/haddocks/foldable1/"
rel="noreferrer" target="_blank" moz-do-not-send="true">https://oleg.fi/haddocks/foldable1/</a><br>
[^ref8]: <a
href="https://hackage.haskell.org/package/foldable1"
rel="noreferrer" target="_blank" moz-do-not-send="true">https://hackage.haskell.org/package/foldable1</a><br>
[^ref9]:<br>
<a
href="https://hackage.haskell.org/package/semigroupoids-5.3.3/docs/Data-Semigroup-Foldable-Class.html"
rel="noreferrer" target="_blank" moz-do-not-send="true">https://hackage.haskell.org/package/semigroupoids-5.3.3/docs/Data-Semigroup-Foldable-Class.html</a><br>
<br>
Unresolved questions<br>
--------------------<br>
<br>
- Should we add `Bifoldable1` too. That should be trivial.<br>
- GHC-8.10 freeze is quite soon, is targeting
GHC-8.12/base-4.15 more<br>
realistic?<br>
<br>
<br>
_______________________________________________<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>