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.
Foldable1 is something which "could move into base without pain" [1], so let's do that first.

- Oleg

[1]: https://www.reddit.com/r/haskell/comments/6d0vgt/could_we_have_foldable1_and_traversable1_in_base/dhz42ie/

On 18.10.2019 10.26, Tony Morris wrote:
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

I second the comment about the issue related to addressing the names, etc in semigroupoids, in preparation for inclusion to base.

On Fri, Oct 18, 2019 at 11:12 AM Oleg Grenrus <oleg.grenrus@iki.fi> wrote:

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
and if after this proposal is accepted, extrapolate for the rest of `semigroupoids`.

So if someone can propose a concrete list how to rename symbols in https://oleg.fi/haddocks/foldable1/Data-Foldable1.html, I'll make a separate branch & haddock page.

Is the wanted renaming s/1//; s/^/semi/:

- Foldable1    -> Semifoldable
- fold1        -> semifold
- foldMap1     -> semifoldMap
- foldr1       -> semifoldr
- foldr1map    -> semifoldr1map
- toNonEmpty   -> toNonEmpty
- ...
- head1        -> semihead
- last1        -> semilast
- minimum1     -> semiminimum
- maximum1     -> semimaximum

- intercalate1 -> semiintercalate
- foldl1M      -> semifoldl
- ...
- maximum1By   -> semimaximumBy
- ...

I'm fine with this.
The head1/semihead are both silly, but the suffix was there to avoid name clash, so prefix is fine for that purpose too.

---

The synopsis of current state of proposed Data.Foldable1

module Data.Foldable1 where

class Foldable t => Foldable1 t
  fold1      :: (Foldable1 t, Semigroup m) => t m -> m
  foldMap1   :: (Foldable1 t, Semigroup m) => (a -> m) -> t a -> m
  foldMap1'  :: (Foldable1 t, Semigroup m) => (a -> m) -> t a -> m
  foldr1     :: Foldable1 t => (a -> a -> a) -> t a -> a
  foldr1'    :: Foldable1 t => (a -> a -> a) -> t a -> a
  foldl1     :: Foldable1 t => (a -> a -> a) -> t a -> a
  foldl1'    :: Foldable1 t => (a -> a -> a) -> t a -> a
  toNonEmpty :: Foldable1 t => t a -> NonEmpty a
  maximum1   :: forall a. (Foldable1 t, Ord a) => t a -> a
  minimum1   :: forall a. (Foldable1 t, Ord a) => t a -> a
  head1      :: Foldable1 t => t a -> a
  last1      :: Foldable1 t => t a -> a
  foldr1map  :: Foldable1 t => (a -> b) -> (b -> b -> b) -> t a -> b
  foldl1'map :: Foldable1 t => (a -> b) -> (b -> b -> b) -> t a -> b
  foldl1map  :: Foldable1 t => (a -> b) -> (b -> b -> b) -> t a -> b
  foldr1'map :: Foldable1 t => (a -> b) -> (b -> b -> b) -> t a -> b

intercalate1 :: (Foldable1 t, Semigroup m) => m -> t m -> m
foldrM1      :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a
foldlM1      :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a
maximum1By   :: Foldable1 t => (a -> a -> Ordering) -> t a -> a
minimum1By   :: Foldable1 t => (a -> a -> Ordering) -> t a -> a

- Oleg

On 18.10.2019 3.06, Edward Kmett wrote:
I’m happy to take patches to move things along in semigroupoids. My focus has been elsewhere, I admit.

-Edward

On Oct 17, 2019, at 5:03 PM, Andrew Martin <andrew.thaddeus@gmail.com> wrote:

 While I want this abstraction in base, I don’t want it there yet. There is an open issue on semigroupoids about renaming everything: https://github.com/ekmett/semigroupoids/issues/26

This needs to be handled before the abstraction is brought into base. Also, foldr1 is awful in common situations. See https://github.com/ekmett/semigroupoids/issues/77

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.

Sent from my iPhone

On Oct 17, 2019, at 10:42 AM, Oleg Grenrus <oleg.grenrus@iki.fi> wrote:

I propose adding `Foldable1` type-class into `base1`.

Add Foldable1
=============


Motivation
----------

It's regularly asked whether `Foldable1` could be added to `base`
(e.g. on reddit[^ref1], there're also GHC issue[^ref2] and old
phabricator diff[^ref3])
Also there's work towards non-empty maps and sets[^ref4],
which would benefit from `Foldable1`.

As commented on reddit, `Foldable1` could be added without any pain
to the `base` as it's pure addition - no modifications needed in
existing modules.

[^ref1]:
https://www.reddit.com/r/haskell/comments/6d0vgt/could_we_have_foldable1_and_traversable1_in_base/
[^ref2]: https://gitlab.haskell.org/ghc/ghc/issues/13573
[^ref3]: https://phabricator.haskell.org/D4812
[^ref4]: https://github.com/haskell/containers/pull/616

Change
------

The change exist as merge request[^ref4] on gitlab.haskell.org.

Importantly, this change **doesn't change** anything in other modules
of `base`, except of adding a `Foldable` instance to `Data.Complex`.
In particular, `foldl1` and `foldr1` in `Data.Foldable` remain partial, etc.

My version of `Foldable1` class is big, so I'll comment the motivation
for each member

```haskell
class Foldable t => Foldable1 t where
    {-# MINIMAL foldMap1 | toNonEmpty | foldr1map #-}

    -- the defining member, like foldMap but only asking for Semigroup
    foldMap1 :: Semigroup m => (a -> m) -> t a -> m

    fold1 :: Semigroup m => t m -> m#

    -- strict foldMap1, cf foldMap'
    foldMap1' :: Semigroup m => (a -> m) -> t a -> m

    -- analogue of toList
    toNonEmpty :: t a -> NonEmpty a

    -- left&right, strict&non-strict folds
    foldr1  :: (a -> a -> a) -> t a -> a
    foldr1' :: (a -> a -> a) -> t a -> a
    foldl1  :: (a -> a -> a) -> t a -> a
    foldl1' :: (a -> a -> a) -> t a -> a

    -- these can have efficient implementation for NonEmptySet
    maximum1 :: forall a. Ord a => t a -> a
    minimum1 :: forall a. Ord a => t a -> a

    -- head1 have efficient implementation for NonEmpty and Tree
    -- last1 for symmetry
    head1 :: t a -> a
    last1 :: t a -> a

    -- fold variants with premap.
    -- Without this map, we cannot implement foldl using foldr etc.
    foldr1map  :: (a -> b) -> (b -> b -> b) -> t a -> b
    foldl1'map :: (a -> b) -> (b -> b -> b) -> t a -> b
    foldl1map  :: (a -> b) -> (b -> b -> b) -> t a -> b
    foldr1'map :: (a -> b) -> (b -> b -> b) -> t a -> b
```

The merge request also adds instances for everything non-empty in `base`.

I propose the `Data.Foldable1` as the module name.
`semigroupoids`[^ref6] uses `Data.Semigroup.Foldable`,
but it's confusing; and using different name could help migration.

The module contains five top-level functions, which should
be self-explanatory:

```haskell
intercalate1 :: (Foldable1 t, Semigroup m) => m -> t m -> m

foldrM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a
foldlM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a

maximum1By :: Foldable1 t => (a -> a -> Ordering) -> t a -> a
minimum1By :: Foldable1 t => (a -> a -> Ordering) -> t a -> a
```

This is less than in `Data.Semigroup.Foldable`[^ref9],
as without `Apply` they don't make sense.
For example:

```haskell
-- needs Apply, not in Data.Foldable1
traverse1_ :: (Foldable1 t, Apply f) => (a -> f b) -> t a -> f ()
```

And if we relax `Apply` to `Applicative`, we get `traverse_`.
 
[^ref5]: https://gitlab.haskell.org/ghc/ghc/merge_requests/1973
[^ref9]:
https://hackage.haskell.org/package/semigroupoids-5.3.3/docs/Data-Semigroup-Foldable-Class.html

[^ref5]: https://gitlab.haskell.org/ghc/ghc/merge_requests/1973

Compatibility & migration
-------------------------

I drafted a compatibility package `foldable1` (github[^ref6],
haddocks[^ref7]),
which I hope could be maintained under github.com/haskell organization.
I can act as a maintainer, with a hope that there won't be a lot
of changes happening in `Data.Foldable1`.

To my surprise, there's already a package with this name on
Hackage[^ref8] by
M Farkas-Dyck (cc'd). I hope they would donate the name to Haskell.org /
CLC;
the package won't have any other good use when `Data.Foldable1` is in
`base`,
then act as a compat package.

`Data.Foldable1` contains also instances for `Lift`, `Backwards` and
`Reverse`
data types from `transformers`. Perfectly, the `transformers` bundled
with GHC with this change would implement the instances as well.
This change should propage to `transformers-compat` too.

Similarly, `containers` would have an instance for `Tree` (and non-empty
`Set` and `Map` when they are added).

`semigroupoids` would need a bit of work, to depend on `foldable1`,
yet the public changes can be kept quite minimal.
I don't think that anything in reverse dependencies of `lens` will be
broken by
this change, if "new" `Foldable1` is re-exported from `semigroupoids`'
`Data.Semigroup.Foldable`[^ref9]

Other "compat" packages -- like `tagged`, `bifunctors` -- have to be
dealt with
case by case. For example whether they should depend on `foldable1` or
other way around.

[^ref6]: https://github.com/phadej/foldable1
[^ref7]: https://oleg.fi/haddocks/foldable1/
[^ref8]: https://hackage.haskell.org/package/foldable1
[^ref9]:
https://hackage.haskell.org/package/semigroupoids-5.3.3/docs/Data-Semigroup-Foldable-Class.html

Unresolved questions
--------------------

- Should we add `Bifoldable1` too. That should be trivial.
- GHC-8.10 freeze is quite soon, is targeting GHC-8.12/base-4.15 more
realistic?


_______________________________________________
Libraries mailing list
Libraries@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
_______________________________________________
Libraries mailing list
Libraries@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
_______________________________________________
Libraries mailing list
Libraries@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries